{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.AmplifyUiBuilder.UpdateTheme
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing theme.
module Amazonka.AmplifyUiBuilder.UpdateTheme
  ( -- * Creating a Request
    UpdateTheme (..),
    newUpdateTheme,

    -- * Request Lenses
    updateTheme_clientToken,
    updateTheme_appId,
    updateTheme_environmentName,
    updateTheme_id,
    updateTheme_updatedTheme,

    -- * Destructuring the Response
    UpdateThemeResponse (..),
    newUpdateThemeResponse,

    -- * Response Lenses
    updateThemeResponse_entity,
    updateThemeResponse_httpStatus,
  )
where

import Amazonka.AmplifyUiBuilder.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateTheme' smart constructor.
data UpdateTheme = UpdateTheme'
  { -- | The unique client token.
    UpdateTheme -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The unique ID for the Amplify app.
    UpdateTheme -> Text
appId :: Prelude.Text,
    -- | The name of the backend environment that is part of the Amplify app.
    UpdateTheme -> Text
environmentName :: Prelude.Text,
    -- | The unique ID for the theme.
    UpdateTheme -> Text
id :: Prelude.Text,
    -- | The configuration of the updated theme.
    UpdateTheme -> UpdateThemeData
updatedTheme :: UpdateThemeData
  }
  deriving (UpdateTheme -> UpdateTheme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTheme -> UpdateTheme -> Bool
$c/= :: UpdateTheme -> UpdateTheme -> Bool
== :: UpdateTheme -> UpdateTheme -> Bool
$c== :: UpdateTheme -> UpdateTheme -> Bool
Prelude.Eq, ReadPrec [UpdateTheme]
ReadPrec UpdateTheme
Int -> ReadS UpdateTheme
ReadS [UpdateTheme]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTheme]
$creadListPrec :: ReadPrec [UpdateTheme]
readPrec :: ReadPrec UpdateTheme
$creadPrec :: ReadPrec UpdateTheme
readList :: ReadS [UpdateTheme]
$creadList :: ReadS [UpdateTheme]
readsPrec :: Int -> ReadS UpdateTheme
$creadsPrec :: Int -> ReadS UpdateTheme
Prelude.Read, Int -> UpdateTheme -> ShowS
[UpdateTheme] -> ShowS
UpdateTheme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTheme] -> ShowS
$cshowList :: [UpdateTheme] -> ShowS
show :: UpdateTheme -> String
$cshow :: UpdateTheme -> String
showsPrec :: Int -> UpdateTheme -> ShowS
$cshowsPrec :: Int -> UpdateTheme -> ShowS
Prelude.Show, forall x. Rep UpdateTheme x -> UpdateTheme
forall x. UpdateTheme -> Rep UpdateTheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTheme x -> UpdateTheme
$cfrom :: forall x. UpdateTheme -> Rep UpdateTheme x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTheme' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'clientToken', 'updateTheme_clientToken' - The unique client token.
--
-- 'appId', 'updateTheme_appId' - The unique ID for the Amplify app.
--
-- 'environmentName', 'updateTheme_environmentName' - The name of the backend environment that is part of the Amplify app.
--
-- 'id', 'updateTheme_id' - The unique ID for the theme.
--
-- 'updatedTheme', 'updateTheme_updatedTheme' - The configuration of the updated theme.
newUpdateTheme ::
  -- | 'appId'
  Prelude.Text ->
  -- | 'environmentName'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  -- | 'updatedTheme'
  UpdateThemeData ->
  UpdateTheme
newUpdateTheme :: Text -> Text -> Text -> UpdateThemeData -> UpdateTheme
newUpdateTheme
  Text
pAppId_
  Text
pEnvironmentName_
  Text
pId_
  UpdateThemeData
pUpdatedTheme_ =
    UpdateTheme'
      { $sel:clientToken:UpdateTheme' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:appId:UpdateTheme' :: Text
appId = Text
pAppId_,
        $sel:environmentName:UpdateTheme' :: Text
environmentName = Text
pEnvironmentName_,
        $sel:id:UpdateTheme' :: Text
id = Text
pId_,
        $sel:updatedTheme:UpdateTheme' :: UpdateThemeData
updatedTheme = UpdateThemeData
pUpdatedTheme_
      }

-- | The unique client token.
updateTheme_clientToken :: Lens.Lens' UpdateTheme (Prelude.Maybe Prelude.Text)
updateTheme_clientToken :: Lens' UpdateTheme (Maybe Text)
updateTheme_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTheme' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:UpdateTheme' :: UpdateTheme -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: UpdateTheme
s@UpdateTheme' {} Maybe Text
a -> UpdateTheme
s {$sel:clientToken:UpdateTheme' :: Maybe Text
clientToken = Maybe Text
a} :: UpdateTheme)

-- | The unique ID for the Amplify app.
updateTheme_appId :: Lens.Lens' UpdateTheme Prelude.Text
updateTheme_appId :: Lens' UpdateTheme Text
updateTheme_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTheme' {Text
appId :: Text
$sel:appId:UpdateTheme' :: UpdateTheme -> Text
appId} -> Text
appId) (\s :: UpdateTheme
s@UpdateTheme' {} Text
a -> UpdateTheme
s {$sel:appId:UpdateTheme' :: Text
appId = Text
a} :: UpdateTheme)

-- | The name of the backend environment that is part of the Amplify app.
updateTheme_environmentName :: Lens.Lens' UpdateTheme Prelude.Text
updateTheme_environmentName :: Lens' UpdateTheme Text
updateTheme_environmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTheme' {Text
environmentName :: Text
$sel:environmentName:UpdateTheme' :: UpdateTheme -> Text
environmentName} -> Text
environmentName) (\s :: UpdateTheme
s@UpdateTheme' {} Text
a -> UpdateTheme
s {$sel:environmentName:UpdateTheme' :: Text
environmentName = Text
a} :: UpdateTheme)

-- | The unique ID for the theme.
updateTheme_id :: Lens.Lens' UpdateTheme Prelude.Text
updateTheme_id :: Lens' UpdateTheme Text
updateTheme_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTheme' {Text
id :: Text
$sel:id:UpdateTheme' :: UpdateTheme -> Text
id} -> Text
id) (\s :: UpdateTheme
s@UpdateTheme' {} Text
a -> UpdateTheme
s {$sel:id:UpdateTheme' :: Text
id = Text
a} :: UpdateTheme)

-- | The configuration of the updated theme.
updateTheme_updatedTheme :: Lens.Lens' UpdateTheme UpdateThemeData
updateTheme_updatedTheme :: Lens' UpdateTheme UpdateThemeData
updateTheme_updatedTheme = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTheme' {UpdateThemeData
updatedTheme :: UpdateThemeData
$sel:updatedTheme:UpdateTheme' :: UpdateTheme -> UpdateThemeData
updatedTheme} -> UpdateThemeData
updatedTheme) (\s :: UpdateTheme
s@UpdateTheme' {} UpdateThemeData
a -> UpdateTheme
s {$sel:updatedTheme:UpdateTheme' :: UpdateThemeData
updatedTheme = UpdateThemeData
a} :: UpdateTheme)

instance Core.AWSRequest UpdateTheme where
  type AWSResponse UpdateTheme = UpdateThemeResponse
  request :: (Service -> Service) -> UpdateTheme -> Request UpdateTheme
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateTheme
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateTheme)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Theme -> Int -> UpdateThemeResponse
UpdateThemeResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateTheme where
  hashWithSalt :: Int -> UpdateTheme -> Int
hashWithSalt Int
_salt UpdateTheme' {Maybe Text
Text
UpdateThemeData
updatedTheme :: UpdateThemeData
id :: Text
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:updatedTheme:UpdateTheme' :: UpdateTheme -> UpdateThemeData
$sel:id:UpdateTheme' :: UpdateTheme -> Text
$sel:environmentName:UpdateTheme' :: UpdateTheme -> Text
$sel:appId:UpdateTheme' :: UpdateTheme -> Text
$sel:clientToken:UpdateTheme' :: UpdateTheme -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
environmentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UpdateThemeData
updatedTheme

instance Prelude.NFData UpdateTheme where
  rnf :: UpdateTheme -> ()
rnf UpdateTheme' {Maybe Text
Text
UpdateThemeData
updatedTheme :: UpdateThemeData
id :: Text
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:updatedTheme:UpdateTheme' :: UpdateTheme -> UpdateThemeData
$sel:id:UpdateTheme' :: UpdateTheme -> Text
$sel:environmentName:UpdateTheme' :: UpdateTheme -> Text
$sel:appId:UpdateTheme' :: UpdateTheme -> Text
$sel:clientToken:UpdateTheme' :: UpdateTheme -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
appId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
environmentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UpdateThemeData
updatedTheme

instance Data.ToHeaders UpdateTheme where
  toHeaders :: UpdateTheme -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateTheme where
  toJSON :: UpdateTheme -> Value
toJSON UpdateTheme' {Maybe Text
Text
UpdateThemeData
updatedTheme :: UpdateThemeData
id :: Text
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:updatedTheme:UpdateTheme' :: UpdateTheme -> UpdateThemeData
$sel:id:UpdateTheme' :: UpdateTheme -> Text
$sel:environmentName:UpdateTheme' :: UpdateTheme -> Text
$sel:appId:UpdateTheme' :: UpdateTheme -> Text
$sel:clientToken:UpdateTheme' :: UpdateTheme -> Maybe Text
..} = forall a. ToJSON a => a -> Value
Data.toJSON UpdateThemeData
updatedTheme

instance Data.ToPath UpdateTheme where
  toPath :: UpdateTheme -> ByteString
toPath UpdateTheme' {Maybe Text
Text
UpdateThemeData
updatedTheme :: UpdateThemeData
id :: Text
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:updatedTheme:UpdateTheme' :: UpdateTheme -> UpdateThemeData
$sel:id:UpdateTheme' :: UpdateTheme -> Text
$sel:environmentName:UpdateTheme' :: UpdateTheme -> Text
$sel:appId:UpdateTheme' :: UpdateTheme -> Text
$sel:clientToken:UpdateTheme' :: UpdateTheme -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/app/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
appId,
        ByteString
"/environment/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
environmentName,
        ByteString
"/themes/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
id
      ]

instance Data.ToQuery UpdateTheme where
  toQuery :: UpdateTheme -> QueryString
toQuery UpdateTheme' {Maybe Text
Text
UpdateThemeData
updatedTheme :: UpdateThemeData
id :: Text
environmentName :: Text
appId :: Text
clientToken :: Maybe Text
$sel:updatedTheme:UpdateTheme' :: UpdateTheme -> UpdateThemeData
$sel:id:UpdateTheme' :: UpdateTheme -> Text
$sel:environmentName:UpdateTheme' :: UpdateTheme -> Text
$sel:appId:UpdateTheme' :: UpdateTheme -> Text
$sel:clientToken:UpdateTheme' :: UpdateTheme -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"clientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken]

-- | /See:/ 'newUpdateThemeResponse' smart constructor.
data UpdateThemeResponse = UpdateThemeResponse'
  { -- | Describes the configuration of the updated theme.
    UpdateThemeResponse -> Maybe Theme
entity :: Prelude.Maybe Theme,
    -- | The response's http status code.
    UpdateThemeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateThemeResponse -> UpdateThemeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateThemeResponse -> UpdateThemeResponse -> Bool
$c/= :: UpdateThemeResponse -> UpdateThemeResponse -> Bool
== :: UpdateThemeResponse -> UpdateThemeResponse -> Bool
$c== :: UpdateThemeResponse -> UpdateThemeResponse -> Bool
Prelude.Eq, ReadPrec [UpdateThemeResponse]
ReadPrec UpdateThemeResponse
Int -> ReadS UpdateThemeResponse
ReadS [UpdateThemeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateThemeResponse]
$creadListPrec :: ReadPrec [UpdateThemeResponse]
readPrec :: ReadPrec UpdateThemeResponse
$creadPrec :: ReadPrec UpdateThemeResponse
readList :: ReadS [UpdateThemeResponse]
$creadList :: ReadS [UpdateThemeResponse]
readsPrec :: Int -> ReadS UpdateThemeResponse
$creadsPrec :: Int -> ReadS UpdateThemeResponse
Prelude.Read, Int -> UpdateThemeResponse -> ShowS
[UpdateThemeResponse] -> ShowS
UpdateThemeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateThemeResponse] -> ShowS
$cshowList :: [UpdateThemeResponse] -> ShowS
show :: UpdateThemeResponse -> String
$cshow :: UpdateThemeResponse -> String
showsPrec :: Int -> UpdateThemeResponse -> ShowS
$cshowsPrec :: Int -> UpdateThemeResponse -> ShowS
Prelude.Show, forall x. Rep UpdateThemeResponse x -> UpdateThemeResponse
forall x. UpdateThemeResponse -> Rep UpdateThemeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateThemeResponse x -> UpdateThemeResponse
$cfrom :: forall x. UpdateThemeResponse -> Rep UpdateThemeResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateThemeResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'entity', 'updateThemeResponse_entity' - Describes the configuration of the updated theme.
--
-- 'httpStatus', 'updateThemeResponse_httpStatus' - The response's http status code.
newUpdateThemeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateThemeResponse
newUpdateThemeResponse :: Int -> UpdateThemeResponse
newUpdateThemeResponse Int
pHttpStatus_ =
  UpdateThemeResponse'
    { $sel:entity:UpdateThemeResponse' :: Maybe Theme
entity = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateThemeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Describes the configuration of the updated theme.
updateThemeResponse_entity :: Lens.Lens' UpdateThemeResponse (Prelude.Maybe Theme)
updateThemeResponse_entity :: Lens' UpdateThemeResponse (Maybe Theme)
updateThemeResponse_entity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateThemeResponse' {Maybe Theme
entity :: Maybe Theme
$sel:entity:UpdateThemeResponse' :: UpdateThemeResponse -> Maybe Theme
entity} -> Maybe Theme
entity) (\s :: UpdateThemeResponse
s@UpdateThemeResponse' {} Maybe Theme
a -> UpdateThemeResponse
s {$sel:entity:UpdateThemeResponse' :: Maybe Theme
entity = Maybe Theme
a} :: UpdateThemeResponse)

-- | The response's http status code.
updateThemeResponse_httpStatus :: Lens.Lens' UpdateThemeResponse Prelude.Int
updateThemeResponse_httpStatus :: Lens' UpdateThemeResponse Int
updateThemeResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateThemeResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateThemeResponse' :: UpdateThemeResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateThemeResponse
s@UpdateThemeResponse' {} Int
a -> UpdateThemeResponse
s {$sel:httpStatus:UpdateThemeResponse' :: Int
httpStatus = Int
a} :: UpdateThemeResponse)

instance Prelude.NFData UpdateThemeResponse where
  rnf :: UpdateThemeResponse -> ()
rnf UpdateThemeResponse' {Int
Maybe Theme
httpStatus :: Int
entity :: Maybe Theme
$sel:httpStatus:UpdateThemeResponse' :: UpdateThemeResponse -> Int
$sel:entity:UpdateThemeResponse' :: UpdateThemeResponse -> Maybe Theme
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Theme
entity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus