{-# 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.AddCustomAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds additional user attributes to the user pool schema.
module Amazonka.CognitoIdentityProvider.AddCustomAttributes
  ( -- * Creating a Request
    AddCustomAttributes (..),
    newAddCustomAttributes,

    -- * Request Lenses
    addCustomAttributes_userPoolId,
    addCustomAttributes_customAttributes,

    -- * Destructuring the Response
    AddCustomAttributesResponse (..),
    newAddCustomAttributesResponse,

    -- * Response Lenses
    addCustomAttributesResponse_httpStatus,
  )
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

-- | Represents the request to add custom attributes.
--
-- /See:/ 'newAddCustomAttributes' smart constructor.
data AddCustomAttributes = AddCustomAttributes'
  { -- | The user pool ID for the user pool where you want to add custom
    -- attributes.
    AddCustomAttributes -> Text
userPoolId :: Prelude.Text,
    -- | An array of custom attributes, such as Mutable and Name.
    AddCustomAttributes -> NonEmpty SchemaAttributeType
customAttributes :: Prelude.NonEmpty SchemaAttributeType
  }
  deriving (AddCustomAttributes -> AddCustomAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddCustomAttributes -> AddCustomAttributes -> Bool
$c/= :: AddCustomAttributes -> AddCustomAttributes -> Bool
== :: AddCustomAttributes -> AddCustomAttributes -> Bool
$c== :: AddCustomAttributes -> AddCustomAttributes -> Bool
Prelude.Eq, ReadPrec [AddCustomAttributes]
ReadPrec AddCustomAttributes
Int -> ReadS AddCustomAttributes
ReadS [AddCustomAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddCustomAttributes]
$creadListPrec :: ReadPrec [AddCustomAttributes]
readPrec :: ReadPrec AddCustomAttributes
$creadPrec :: ReadPrec AddCustomAttributes
readList :: ReadS [AddCustomAttributes]
$creadList :: ReadS [AddCustomAttributes]
readsPrec :: Int -> ReadS AddCustomAttributes
$creadsPrec :: Int -> ReadS AddCustomAttributes
Prelude.Read, Int -> AddCustomAttributes -> ShowS
[AddCustomAttributes] -> ShowS
AddCustomAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddCustomAttributes] -> ShowS
$cshowList :: [AddCustomAttributes] -> ShowS
show :: AddCustomAttributes -> String
$cshow :: AddCustomAttributes -> String
showsPrec :: Int -> AddCustomAttributes -> ShowS
$cshowsPrec :: Int -> AddCustomAttributes -> ShowS
Prelude.Show, forall x. Rep AddCustomAttributes x -> AddCustomAttributes
forall x. AddCustomAttributes -> Rep AddCustomAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddCustomAttributes x -> AddCustomAttributes
$cfrom :: forall x. AddCustomAttributes -> Rep AddCustomAttributes x
Prelude.Generic)

-- |
-- Create a value of 'AddCustomAttributes' 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:
--
-- 'userPoolId', 'addCustomAttributes_userPoolId' - The user pool ID for the user pool where you want to add custom
-- attributes.
--
-- 'customAttributes', 'addCustomAttributes_customAttributes' - An array of custom attributes, such as Mutable and Name.
newAddCustomAttributes ::
  -- | 'userPoolId'
  Prelude.Text ->
  -- | 'customAttributes'
  Prelude.NonEmpty SchemaAttributeType ->
  AddCustomAttributes
newAddCustomAttributes :: Text -> NonEmpty SchemaAttributeType -> AddCustomAttributes
newAddCustomAttributes
  Text
pUserPoolId_
  NonEmpty SchemaAttributeType
pCustomAttributes_ =
    AddCustomAttributes'
      { $sel:userPoolId:AddCustomAttributes' :: Text
userPoolId = Text
pUserPoolId_,
        $sel:customAttributes:AddCustomAttributes' :: NonEmpty SchemaAttributeType
customAttributes =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty SchemaAttributeType
pCustomAttributes_
      }

-- | The user pool ID for the user pool where you want to add custom
-- attributes.
addCustomAttributes_userPoolId :: Lens.Lens' AddCustomAttributes Prelude.Text
addCustomAttributes_userPoolId :: Lens' AddCustomAttributes Text
addCustomAttributes_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddCustomAttributes' {Text
userPoolId :: Text
$sel:userPoolId:AddCustomAttributes' :: AddCustomAttributes -> Text
userPoolId} -> Text
userPoolId) (\s :: AddCustomAttributes
s@AddCustomAttributes' {} Text
a -> AddCustomAttributes
s {$sel:userPoolId:AddCustomAttributes' :: Text
userPoolId = Text
a} :: AddCustomAttributes)

-- | An array of custom attributes, such as Mutable and Name.
addCustomAttributes_customAttributes :: Lens.Lens' AddCustomAttributes (Prelude.NonEmpty SchemaAttributeType)
addCustomAttributes_customAttributes :: Lens' AddCustomAttributes (NonEmpty SchemaAttributeType)
addCustomAttributes_customAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddCustomAttributes' {NonEmpty SchemaAttributeType
customAttributes :: NonEmpty SchemaAttributeType
$sel:customAttributes:AddCustomAttributes' :: AddCustomAttributes -> NonEmpty SchemaAttributeType
customAttributes} -> NonEmpty SchemaAttributeType
customAttributes) (\s :: AddCustomAttributes
s@AddCustomAttributes' {} NonEmpty SchemaAttributeType
a -> AddCustomAttributes
s {$sel:customAttributes:AddCustomAttributes' :: NonEmpty SchemaAttributeType
customAttributes = NonEmpty SchemaAttributeType
a} :: AddCustomAttributes) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest AddCustomAttributes where
  type
    AWSResponse AddCustomAttributes =
      AddCustomAttributesResponse
  request :: (Service -> Service)
-> AddCustomAttributes -> Request AddCustomAttributes
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 AddCustomAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AddCustomAttributes)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AddCustomAttributesResponse
AddCustomAttributesResponse'
            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))
      )

instance Prelude.Hashable AddCustomAttributes where
  hashWithSalt :: Int -> AddCustomAttributes -> Int
hashWithSalt Int
_salt AddCustomAttributes' {NonEmpty SchemaAttributeType
Text
customAttributes :: NonEmpty SchemaAttributeType
userPoolId :: Text
$sel:customAttributes:AddCustomAttributes' :: AddCustomAttributes -> NonEmpty SchemaAttributeType
$sel:userPoolId:AddCustomAttributes' :: AddCustomAttributes -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty SchemaAttributeType
customAttributes

instance Prelude.NFData AddCustomAttributes where
  rnf :: AddCustomAttributes -> ()
rnf AddCustomAttributes' {NonEmpty SchemaAttributeType
Text
customAttributes :: NonEmpty SchemaAttributeType
userPoolId :: Text
$sel:customAttributes:AddCustomAttributes' :: AddCustomAttributes -> NonEmpty SchemaAttributeType
$sel:userPoolId:AddCustomAttributes' :: AddCustomAttributes -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
userPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty SchemaAttributeType
customAttributes

instance Data.ToHeaders AddCustomAttributes where
  toHeaders :: AddCustomAttributes -> 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.AddCustomAttributes" ::
                          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 AddCustomAttributes where
  toJSON :: AddCustomAttributes -> Value
toJSON AddCustomAttributes' {NonEmpty SchemaAttributeType
Text
customAttributes :: NonEmpty SchemaAttributeType
userPoolId :: Text
$sel:customAttributes:AddCustomAttributes' :: AddCustomAttributes -> NonEmpty SchemaAttributeType
$sel:userPoolId:AddCustomAttributes' :: AddCustomAttributes -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"UserPoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userPoolId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CustomAttributes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty SchemaAttributeType
customAttributes)
          ]
      )

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

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

-- | Represents the response from the server for the request to add custom
-- attributes.
--
-- /See:/ 'newAddCustomAttributesResponse' smart constructor.
data AddCustomAttributesResponse = AddCustomAttributesResponse'
  { -- | The response's http status code.
    AddCustomAttributesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AddCustomAttributesResponse -> AddCustomAttributesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddCustomAttributesResponse -> AddCustomAttributesResponse -> Bool
$c/= :: AddCustomAttributesResponse -> AddCustomAttributesResponse -> Bool
== :: AddCustomAttributesResponse -> AddCustomAttributesResponse -> Bool
$c== :: AddCustomAttributesResponse -> AddCustomAttributesResponse -> Bool
Prelude.Eq, ReadPrec [AddCustomAttributesResponse]
ReadPrec AddCustomAttributesResponse
Int -> ReadS AddCustomAttributesResponse
ReadS [AddCustomAttributesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddCustomAttributesResponse]
$creadListPrec :: ReadPrec [AddCustomAttributesResponse]
readPrec :: ReadPrec AddCustomAttributesResponse
$creadPrec :: ReadPrec AddCustomAttributesResponse
readList :: ReadS [AddCustomAttributesResponse]
$creadList :: ReadS [AddCustomAttributesResponse]
readsPrec :: Int -> ReadS AddCustomAttributesResponse
$creadsPrec :: Int -> ReadS AddCustomAttributesResponse
Prelude.Read, Int -> AddCustomAttributesResponse -> ShowS
[AddCustomAttributesResponse] -> ShowS
AddCustomAttributesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddCustomAttributesResponse] -> ShowS
$cshowList :: [AddCustomAttributesResponse] -> ShowS
show :: AddCustomAttributesResponse -> String
$cshow :: AddCustomAttributesResponse -> String
showsPrec :: Int -> AddCustomAttributesResponse -> ShowS
$cshowsPrec :: Int -> AddCustomAttributesResponse -> ShowS
Prelude.Show, forall x.
Rep AddCustomAttributesResponse x -> AddCustomAttributesResponse
forall x.
AddCustomAttributesResponse -> Rep AddCustomAttributesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AddCustomAttributesResponse x -> AddCustomAttributesResponse
$cfrom :: forall x.
AddCustomAttributesResponse -> Rep AddCustomAttributesResponse x
Prelude.Generic)

-- |
-- Create a value of 'AddCustomAttributesResponse' 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', 'addCustomAttributesResponse_httpStatus' - The response's http status code.
newAddCustomAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddCustomAttributesResponse
newAddCustomAttributesResponse :: Int -> AddCustomAttributesResponse
newAddCustomAttributesResponse Int
pHttpStatus_ =
  AddCustomAttributesResponse'
    { $sel:httpStatus:AddCustomAttributesResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData AddCustomAttributesResponse where
  rnf :: AddCustomAttributesResponse -> ()
rnf AddCustomAttributesResponse' {Int
httpStatus :: Int
$sel:httpStatus:AddCustomAttributesResponse' :: AddCustomAttributesResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus