{-# 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.CognitoIdentityProvider.SetUICustomization
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the user interface (UI) customization information for a user
-- pool\'s built-in app UI.
--
-- You can specify app UI customization settings for a single client (with
-- a specific @clientId@) or for all clients (by setting the @clientId@ to
-- @ALL@). If you specify @ALL@, the default configuration is used for
-- every client that has no previously set UI customization. If you specify
-- UI customization settings for a particular client, it will no longer
-- return to the @ALL@ configuration.
--
-- To use this API, your user pool must have a domain associated with it.
-- Otherwise, there is no place to host the app\'s pages, and the service
-- will throw an error.
module Amazonka.CognitoIdentityProvider.SetUICustomization
  ( -- * Creating a Request
    SetUICustomization (..),
    newSetUICustomization,

    -- * Request Lenses
    setUICustomization_css,
    setUICustomization_clientId,
    setUICustomization_imageFile,
    setUICustomization_userPoolId,

    -- * Destructuring the Response
    SetUICustomizationResponse (..),
    newSetUICustomizationResponse,

    -- * Response Lenses
    setUICustomizationResponse_httpStatus,
    setUICustomizationResponse_uICustomization,
  )
where

import Amazonka.CognitoIdentityProvider.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:/ 'newSetUICustomization' smart constructor.
data SetUICustomization = SetUICustomization'
  { -- | The CSS values in the UI customization.
    SetUICustomization -> Maybe Text
css :: Prelude.Maybe Prelude.Text,
    -- | The client ID for the client app.
    SetUICustomization -> Maybe (Sensitive Text)
clientId :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The uploaded logo image for the UI customization.
    SetUICustomization -> Maybe Base64
imageFile :: Prelude.Maybe Data.Base64,
    -- | The user pool ID for the user pool.
    SetUICustomization -> Text
userPoolId :: Prelude.Text
  }
  deriving (SetUICustomization -> SetUICustomization -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetUICustomization -> SetUICustomization -> Bool
$c/= :: SetUICustomization -> SetUICustomization -> Bool
== :: SetUICustomization -> SetUICustomization -> Bool
$c== :: SetUICustomization -> SetUICustomization -> Bool
Prelude.Eq, Int -> SetUICustomization -> ShowS
[SetUICustomization] -> ShowS
SetUICustomization -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetUICustomization] -> ShowS
$cshowList :: [SetUICustomization] -> ShowS
show :: SetUICustomization -> String
$cshow :: SetUICustomization -> String
showsPrec :: Int -> SetUICustomization -> ShowS
$cshowsPrec :: Int -> SetUICustomization -> ShowS
Prelude.Show, forall x. Rep SetUICustomization x -> SetUICustomization
forall x. SetUICustomization -> Rep SetUICustomization x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetUICustomization x -> SetUICustomization
$cfrom :: forall x. SetUICustomization -> Rep SetUICustomization x
Prelude.Generic)

-- |
-- Create a value of 'SetUICustomization' 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:
--
-- 'css', 'setUICustomization_css' - The CSS values in the UI customization.
--
-- 'clientId', 'setUICustomization_clientId' - The client ID for the client app.
--
-- 'imageFile', 'setUICustomization_imageFile' - The uploaded logo image for the UI customization.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'userPoolId', 'setUICustomization_userPoolId' - The user pool ID for the user pool.
newSetUICustomization ::
  -- | 'userPoolId'
  Prelude.Text ->
  SetUICustomization
newSetUICustomization :: Text -> SetUICustomization
newSetUICustomization Text
pUserPoolId_ =
  SetUICustomization'
    { $sel:css:SetUICustomization' :: Maybe Text
css = forall a. Maybe a
Prelude.Nothing,
      $sel:clientId:SetUICustomization' :: Maybe (Sensitive Text)
clientId = forall a. Maybe a
Prelude.Nothing,
      $sel:imageFile:SetUICustomization' :: Maybe Base64
imageFile = forall a. Maybe a
Prelude.Nothing,
      $sel:userPoolId:SetUICustomization' :: Text
userPoolId = Text
pUserPoolId_
    }

-- | The CSS values in the UI customization.
setUICustomization_css :: Lens.Lens' SetUICustomization (Prelude.Maybe Prelude.Text)
setUICustomization_css :: Lens' SetUICustomization (Maybe Text)
setUICustomization_css = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUICustomization' {Maybe Text
css :: Maybe Text
$sel:css:SetUICustomization' :: SetUICustomization -> Maybe Text
css} -> Maybe Text
css) (\s :: SetUICustomization
s@SetUICustomization' {} Maybe Text
a -> SetUICustomization
s {$sel:css:SetUICustomization' :: Maybe Text
css = Maybe Text
a} :: SetUICustomization)

-- | The client ID for the client app.
setUICustomization_clientId :: Lens.Lens' SetUICustomization (Prelude.Maybe Prelude.Text)
setUICustomization_clientId :: Lens' SetUICustomization (Maybe Text)
setUICustomization_clientId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUICustomization' {Maybe (Sensitive Text)
clientId :: Maybe (Sensitive Text)
$sel:clientId:SetUICustomization' :: SetUICustomization -> Maybe (Sensitive Text)
clientId} -> Maybe (Sensitive Text)
clientId) (\s :: SetUICustomization
s@SetUICustomization' {} Maybe (Sensitive Text)
a -> SetUICustomization
s {$sel:clientId:SetUICustomization' :: Maybe (Sensitive Text)
clientId = Maybe (Sensitive Text)
a} :: SetUICustomization) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The uploaded logo image for the UI customization.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
setUICustomization_imageFile :: Lens.Lens' SetUICustomization (Prelude.Maybe Prelude.ByteString)
setUICustomization_imageFile :: Lens' SetUICustomization (Maybe ByteString)
setUICustomization_imageFile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUICustomization' {Maybe Base64
imageFile :: Maybe Base64
$sel:imageFile:SetUICustomization' :: SetUICustomization -> Maybe Base64
imageFile} -> Maybe Base64
imageFile) (\s :: SetUICustomization
s@SetUICustomization' {} Maybe Base64
a -> SetUICustomization
s {$sel:imageFile:SetUICustomization' :: Maybe Base64
imageFile = Maybe Base64
a} :: SetUICustomization) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping Iso' Base64 ByteString
Data._Base64

-- | The user pool ID for the user pool.
setUICustomization_userPoolId :: Lens.Lens' SetUICustomization Prelude.Text
setUICustomization_userPoolId :: Lens' SetUICustomization Text
setUICustomization_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUICustomization' {Text
userPoolId :: Text
$sel:userPoolId:SetUICustomization' :: SetUICustomization -> Text
userPoolId} -> Text
userPoolId) (\s :: SetUICustomization
s@SetUICustomization' {} Text
a -> SetUICustomization
s {$sel:userPoolId:SetUICustomization' :: Text
userPoolId = Text
a} :: SetUICustomization)

instance Core.AWSRequest SetUICustomization where
  type
    AWSResponse SetUICustomization =
      SetUICustomizationResponse
  request :: (Service -> Service)
-> SetUICustomization -> Request SetUICustomization
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy SetUICustomization
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetUICustomization)))
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 ->
          Int -> UICustomizationType -> SetUICustomizationResponse
SetUICustomizationResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"UICustomization")
      )

instance Prelude.Hashable SetUICustomization where
  hashWithSalt :: Int -> SetUICustomization -> Int
hashWithSalt Int
_salt SetUICustomization' {Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Text
userPoolId :: Text
imageFile :: Maybe Base64
clientId :: Maybe (Sensitive Text)
css :: Maybe Text
$sel:userPoolId:SetUICustomization' :: SetUICustomization -> Text
$sel:imageFile:SetUICustomization' :: SetUICustomization -> Maybe Base64
$sel:clientId:SetUICustomization' :: SetUICustomization -> Maybe (Sensitive Text)
$sel:css:SetUICustomization' :: SetUICustomization -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
css
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
clientId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Base64
imageFile
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId

instance Prelude.NFData SetUICustomization where
  rnf :: SetUICustomization -> ()
rnf SetUICustomization' {Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Text
userPoolId :: Text
imageFile :: Maybe Base64
clientId :: Maybe (Sensitive Text)
css :: Maybe Text
$sel:userPoolId:SetUICustomization' :: SetUICustomization -> Text
$sel:imageFile:SetUICustomization' :: SetUICustomization -> Maybe Base64
$sel:clientId:SetUICustomization' :: SetUICustomization -> Maybe (Sensitive Text)
$sel:css:SetUICustomization' :: SetUICustomization -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
css
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
clientId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Base64
imageFile
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userPoolId

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

instance Data.ToJSON SetUICustomization where
  toJSON :: SetUICustomization -> Value
toJSON SetUICustomization' {Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Text
userPoolId :: Text
imageFile :: Maybe Base64
clientId :: Maybe (Sensitive Text)
css :: Maybe Text
$sel:userPoolId:SetUICustomization' :: SetUICustomization -> Text
$sel:imageFile:SetUICustomization' :: SetUICustomization -> Maybe Base64
$sel:clientId:SetUICustomization' :: SetUICustomization -> Maybe (Sensitive Text)
$sel:css:SetUICustomization' :: SetUICustomization -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CSS" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
css,
            (Key
"ClientId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Sensitive Text)
clientId,
            (Key
"ImageFile" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Base64
imageFile,
            forall a. a -> Maybe a
Prelude.Just (Key
"UserPoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userPoolId)
          ]
      )

instance Data.ToPath SetUICustomization where
  toPath :: SetUICustomization -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery SetUICustomization where
  toQuery :: SetUICustomization -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newSetUICustomizationResponse' smart constructor.
data SetUICustomizationResponse = SetUICustomizationResponse'
  { -- | The response's http status code.
    SetUICustomizationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The UI customization information.
    SetUICustomizationResponse -> UICustomizationType
uICustomization :: UICustomizationType
  }
  deriving (SetUICustomizationResponse -> SetUICustomizationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetUICustomizationResponse -> SetUICustomizationResponse -> Bool
$c/= :: SetUICustomizationResponse -> SetUICustomizationResponse -> Bool
== :: SetUICustomizationResponse -> SetUICustomizationResponse -> Bool
$c== :: SetUICustomizationResponse -> SetUICustomizationResponse -> Bool
Prelude.Eq, Int -> SetUICustomizationResponse -> ShowS
[SetUICustomizationResponse] -> ShowS
SetUICustomizationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetUICustomizationResponse] -> ShowS
$cshowList :: [SetUICustomizationResponse] -> ShowS
show :: SetUICustomizationResponse -> String
$cshow :: SetUICustomizationResponse -> String
showsPrec :: Int -> SetUICustomizationResponse -> ShowS
$cshowsPrec :: Int -> SetUICustomizationResponse -> ShowS
Prelude.Show, forall x.
Rep SetUICustomizationResponse x -> SetUICustomizationResponse
forall x.
SetUICustomizationResponse -> Rep SetUICustomizationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetUICustomizationResponse x -> SetUICustomizationResponse
$cfrom :: forall x.
SetUICustomizationResponse -> Rep SetUICustomizationResponse x
Prelude.Generic)

-- |
-- Create a value of 'SetUICustomizationResponse' 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:
--
-- 'httpStatus', 'setUICustomizationResponse_httpStatus' - The response's http status code.
--
-- 'uICustomization', 'setUICustomizationResponse_uICustomization' - The UI customization information.
newSetUICustomizationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'uICustomization'
  UICustomizationType ->
  SetUICustomizationResponse
newSetUICustomizationResponse :: Int -> UICustomizationType -> SetUICustomizationResponse
newSetUICustomizationResponse
  Int
pHttpStatus_
  UICustomizationType
pUICustomization_ =
    SetUICustomizationResponse'
      { $sel:httpStatus:SetUICustomizationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:uICustomization:SetUICustomizationResponse' :: UICustomizationType
uICustomization = UICustomizationType
pUICustomization_
      }

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

-- | The UI customization information.
setUICustomizationResponse_uICustomization :: Lens.Lens' SetUICustomizationResponse UICustomizationType
setUICustomizationResponse_uICustomization :: Lens' SetUICustomizationResponse UICustomizationType
setUICustomizationResponse_uICustomization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUICustomizationResponse' {UICustomizationType
uICustomization :: UICustomizationType
$sel:uICustomization:SetUICustomizationResponse' :: SetUICustomizationResponse -> UICustomizationType
uICustomization} -> UICustomizationType
uICustomization) (\s :: SetUICustomizationResponse
s@SetUICustomizationResponse' {} UICustomizationType
a -> SetUICustomizationResponse
s {$sel:uICustomization:SetUICustomizationResponse' :: UICustomizationType
uICustomization = UICustomizationType
a} :: SetUICustomizationResponse)

instance Prelude.NFData SetUICustomizationResponse where
  rnf :: SetUICustomizationResponse -> ()
rnf SetUICustomizationResponse' {Int
UICustomizationType
uICustomization :: UICustomizationType
httpStatus :: Int
$sel:uICustomization:SetUICustomizationResponse' :: SetUICustomizationResponse -> UICustomizationType
$sel:httpStatus:SetUICustomizationResponse' :: SetUICustomizationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UICustomizationType
uICustomization