{-# 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.VerifyUserAttribute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Verifies the specified user attributes in the user pool.
--
-- If your user pool requires verification before Amazon Cognito updates
-- the attribute value, VerifyUserAttribute updates the affected attribute
-- to its pending value. For more information, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_UserAttributeUpdateSettingsType.html UserAttributeUpdateSettingsType>.
module Amazonka.CognitoIdentityProvider.VerifyUserAttribute
  ( -- * Creating a Request
    VerifyUserAttribute (..),
    newVerifyUserAttribute,

    -- * Request Lenses
    verifyUserAttribute_accessToken,
    verifyUserAttribute_attributeName,
    verifyUserAttribute_code,

    -- * Destructuring the Response
    VerifyUserAttributeResponse (..),
    newVerifyUserAttributeResponse,

    -- * Response Lenses
    verifyUserAttributeResponse_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 verify user attributes.
--
-- /See:/ 'newVerifyUserAttribute' smart constructor.
data VerifyUserAttribute = VerifyUserAttribute'
  { -- | A valid access token that Amazon Cognito issued to the user whose user
    -- attributes you want to verify.
    VerifyUserAttribute -> Sensitive Text
accessToken :: Data.Sensitive Prelude.Text,
    -- | The attribute name in the request to verify user attributes.
    VerifyUserAttribute -> Text
attributeName :: Prelude.Text,
    -- | The verification code in the request to verify user attributes.
    VerifyUserAttribute -> Text
code :: Prelude.Text
  }
  deriving (VerifyUserAttribute -> VerifyUserAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerifyUserAttribute -> VerifyUserAttribute -> Bool
$c/= :: VerifyUserAttribute -> VerifyUserAttribute -> Bool
== :: VerifyUserAttribute -> VerifyUserAttribute -> Bool
$c== :: VerifyUserAttribute -> VerifyUserAttribute -> Bool
Prelude.Eq, Int -> VerifyUserAttribute -> ShowS
[VerifyUserAttribute] -> ShowS
VerifyUserAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerifyUserAttribute] -> ShowS
$cshowList :: [VerifyUserAttribute] -> ShowS
show :: VerifyUserAttribute -> String
$cshow :: VerifyUserAttribute -> String
showsPrec :: Int -> VerifyUserAttribute -> ShowS
$cshowsPrec :: Int -> VerifyUserAttribute -> ShowS
Prelude.Show, forall x. Rep VerifyUserAttribute x -> VerifyUserAttribute
forall x. VerifyUserAttribute -> Rep VerifyUserAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VerifyUserAttribute x -> VerifyUserAttribute
$cfrom :: forall x. VerifyUserAttribute -> Rep VerifyUserAttribute x
Prelude.Generic)

-- |
-- Create a value of 'VerifyUserAttribute' 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:
--
-- 'accessToken', 'verifyUserAttribute_accessToken' - A valid access token that Amazon Cognito issued to the user whose user
-- attributes you want to verify.
--
-- 'attributeName', 'verifyUserAttribute_attributeName' - The attribute name in the request to verify user attributes.
--
-- 'code', 'verifyUserAttribute_code' - The verification code in the request to verify user attributes.
newVerifyUserAttribute ::
  -- | 'accessToken'
  Prelude.Text ->
  -- | 'attributeName'
  Prelude.Text ->
  -- | 'code'
  Prelude.Text ->
  VerifyUserAttribute
newVerifyUserAttribute :: Text -> Text -> Text -> VerifyUserAttribute
newVerifyUserAttribute
  Text
pAccessToken_
  Text
pAttributeName_
  Text
pCode_ =
    VerifyUserAttribute'
      { $sel:accessToken:VerifyUserAttribute' :: Sensitive Text
accessToken =
          forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pAccessToken_,
        $sel:attributeName:VerifyUserAttribute' :: Text
attributeName = Text
pAttributeName_,
        $sel:code:VerifyUserAttribute' :: Text
code = Text
pCode_
      }

-- | A valid access token that Amazon Cognito issued to the user whose user
-- attributes you want to verify.
verifyUserAttribute_accessToken :: Lens.Lens' VerifyUserAttribute Prelude.Text
verifyUserAttribute_accessToken :: Lens' VerifyUserAttribute Text
verifyUserAttribute_accessToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VerifyUserAttribute' {Sensitive Text
accessToken :: Sensitive Text
$sel:accessToken:VerifyUserAttribute' :: VerifyUserAttribute -> Sensitive Text
accessToken} -> Sensitive Text
accessToken) (\s :: VerifyUserAttribute
s@VerifyUserAttribute' {} Sensitive Text
a -> VerifyUserAttribute
s {$sel:accessToken:VerifyUserAttribute' :: Sensitive Text
accessToken = Sensitive Text
a} :: VerifyUserAttribute) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The attribute name in the request to verify user attributes.
verifyUserAttribute_attributeName :: Lens.Lens' VerifyUserAttribute Prelude.Text
verifyUserAttribute_attributeName :: Lens' VerifyUserAttribute Text
verifyUserAttribute_attributeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VerifyUserAttribute' {Text
attributeName :: Text
$sel:attributeName:VerifyUserAttribute' :: VerifyUserAttribute -> Text
attributeName} -> Text
attributeName) (\s :: VerifyUserAttribute
s@VerifyUserAttribute' {} Text
a -> VerifyUserAttribute
s {$sel:attributeName:VerifyUserAttribute' :: Text
attributeName = Text
a} :: VerifyUserAttribute)

-- | The verification code in the request to verify user attributes.
verifyUserAttribute_code :: Lens.Lens' VerifyUserAttribute Prelude.Text
verifyUserAttribute_code :: Lens' VerifyUserAttribute Text
verifyUserAttribute_code = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\VerifyUserAttribute' {Text
code :: Text
$sel:code:VerifyUserAttribute' :: VerifyUserAttribute -> Text
code} -> Text
code) (\s :: VerifyUserAttribute
s@VerifyUserAttribute' {} Text
a -> VerifyUserAttribute
s {$sel:code:VerifyUserAttribute' :: Text
code = Text
a} :: VerifyUserAttribute)

instance Core.AWSRequest VerifyUserAttribute where
  type
    AWSResponse VerifyUserAttribute =
      VerifyUserAttributeResponse
  request :: (Service -> Service)
-> VerifyUserAttribute -> Request VerifyUserAttribute
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 VerifyUserAttribute
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse VerifyUserAttribute)))
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 -> VerifyUserAttributeResponse
VerifyUserAttributeResponse'
            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 VerifyUserAttribute where
  hashWithSalt :: Int -> VerifyUserAttribute -> Int
hashWithSalt Int
_salt VerifyUserAttribute' {Text
Sensitive Text
code :: Text
attributeName :: Text
accessToken :: Sensitive Text
$sel:code:VerifyUserAttribute' :: VerifyUserAttribute -> Text
$sel:attributeName:VerifyUserAttribute' :: VerifyUserAttribute -> Text
$sel:accessToken:VerifyUserAttribute' :: VerifyUserAttribute -> Sensitive Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
accessToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attributeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
code

instance Prelude.NFData VerifyUserAttribute where
  rnf :: VerifyUserAttribute -> ()
rnf VerifyUserAttribute' {Text
Sensitive Text
code :: Text
attributeName :: Text
accessToken :: Sensitive Text
$sel:code:VerifyUserAttribute' :: VerifyUserAttribute -> Text
$sel:attributeName:VerifyUserAttribute' :: VerifyUserAttribute -> Text
$sel:accessToken:VerifyUserAttribute' :: VerifyUserAttribute -> Sensitive Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
accessToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
attributeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
code

instance Data.ToHeaders VerifyUserAttribute where
  toHeaders :: VerifyUserAttribute -> 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.VerifyUserAttribute" ::
                          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 VerifyUserAttribute where
  toJSON :: VerifyUserAttribute -> Value
toJSON VerifyUserAttribute' {Text
Sensitive Text
code :: Text
attributeName :: Text
accessToken :: Sensitive Text
$sel:code:VerifyUserAttribute' :: VerifyUserAttribute -> Text
$sel:attributeName:VerifyUserAttribute' :: VerifyUserAttribute -> Text
$sel:accessToken:VerifyUserAttribute' :: VerifyUserAttribute -> Sensitive Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"AccessToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
accessToken),
            forall a. a -> Maybe a
Prelude.Just (Key
"AttributeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
attributeName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
code)
          ]
      )

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

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

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

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

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

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