{-# 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.ConfirmDevice
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Confirms tracking of the device. This API call is the call that begins
-- device tracking.
module Amazonka.CognitoIdentityProvider.ConfirmDevice
  ( -- * Creating a Request
    ConfirmDevice (..),
    newConfirmDevice,

    -- * Request Lenses
    confirmDevice_deviceName,
    confirmDevice_deviceSecretVerifierConfig,
    confirmDevice_accessToken,
    confirmDevice_deviceKey,

    -- * Destructuring the Response
    ConfirmDeviceResponse (..),
    newConfirmDeviceResponse,

    -- * Response Lenses
    confirmDeviceResponse_userConfirmationNecessary,
    confirmDeviceResponse_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

-- | Confirms the device request.
--
-- /See:/ 'newConfirmDevice' smart constructor.
data ConfirmDevice = ConfirmDevice'
  { -- | The device name.
    ConfirmDevice -> Maybe Text
deviceName :: Prelude.Maybe Prelude.Text,
    -- | The configuration of the device secret verifier.
    ConfirmDevice -> Maybe DeviceSecretVerifierConfigType
deviceSecretVerifierConfig :: Prelude.Maybe DeviceSecretVerifierConfigType,
    -- | A valid access token that Amazon Cognito issued to the user whose device
    -- you want to confirm.
    ConfirmDevice -> Sensitive Text
accessToken :: Data.Sensitive Prelude.Text,
    -- | The device key.
    ConfirmDevice -> Text
deviceKey :: Prelude.Text
  }
  deriving (ConfirmDevice -> ConfirmDevice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfirmDevice -> ConfirmDevice -> Bool
$c/= :: ConfirmDevice -> ConfirmDevice -> Bool
== :: ConfirmDevice -> ConfirmDevice -> Bool
$c== :: ConfirmDevice -> ConfirmDevice -> Bool
Prelude.Eq, Int -> ConfirmDevice -> ShowS
[ConfirmDevice] -> ShowS
ConfirmDevice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfirmDevice] -> ShowS
$cshowList :: [ConfirmDevice] -> ShowS
show :: ConfirmDevice -> String
$cshow :: ConfirmDevice -> String
showsPrec :: Int -> ConfirmDevice -> ShowS
$cshowsPrec :: Int -> ConfirmDevice -> ShowS
Prelude.Show, forall x. Rep ConfirmDevice x -> ConfirmDevice
forall x. ConfirmDevice -> Rep ConfirmDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfirmDevice x -> ConfirmDevice
$cfrom :: forall x. ConfirmDevice -> Rep ConfirmDevice x
Prelude.Generic)

-- |
-- Create a value of 'ConfirmDevice' 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:
--
-- 'deviceName', 'confirmDevice_deviceName' - The device name.
--
-- 'deviceSecretVerifierConfig', 'confirmDevice_deviceSecretVerifierConfig' - The configuration of the device secret verifier.
--
-- 'accessToken', 'confirmDevice_accessToken' - A valid access token that Amazon Cognito issued to the user whose device
-- you want to confirm.
--
-- 'deviceKey', 'confirmDevice_deviceKey' - The device key.
newConfirmDevice ::
  -- | 'accessToken'
  Prelude.Text ->
  -- | 'deviceKey'
  Prelude.Text ->
  ConfirmDevice
newConfirmDevice :: Text -> Text -> ConfirmDevice
newConfirmDevice Text
pAccessToken_ Text
pDeviceKey_ =
  ConfirmDevice'
    { $sel:deviceName:ConfirmDevice' :: Maybe Text
deviceName = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceSecretVerifierConfig:ConfirmDevice' :: Maybe DeviceSecretVerifierConfigType
deviceSecretVerifierConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:accessToken:ConfirmDevice' :: Sensitive Text
accessToken = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pAccessToken_,
      $sel:deviceKey:ConfirmDevice' :: Text
deviceKey = Text
pDeviceKey_
    }

-- | The device name.
confirmDevice_deviceName :: Lens.Lens' ConfirmDevice (Prelude.Maybe Prelude.Text)
confirmDevice_deviceName :: Lens' ConfirmDevice (Maybe Text)
confirmDevice_deviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfirmDevice' {Maybe Text
deviceName :: Maybe Text
$sel:deviceName:ConfirmDevice' :: ConfirmDevice -> Maybe Text
deviceName} -> Maybe Text
deviceName) (\s :: ConfirmDevice
s@ConfirmDevice' {} Maybe Text
a -> ConfirmDevice
s {$sel:deviceName:ConfirmDevice' :: Maybe Text
deviceName = Maybe Text
a} :: ConfirmDevice)

-- | The configuration of the device secret verifier.
confirmDevice_deviceSecretVerifierConfig :: Lens.Lens' ConfirmDevice (Prelude.Maybe DeviceSecretVerifierConfigType)
confirmDevice_deviceSecretVerifierConfig :: Lens' ConfirmDevice (Maybe DeviceSecretVerifierConfigType)
confirmDevice_deviceSecretVerifierConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfirmDevice' {Maybe DeviceSecretVerifierConfigType
deviceSecretVerifierConfig :: Maybe DeviceSecretVerifierConfigType
$sel:deviceSecretVerifierConfig:ConfirmDevice' :: ConfirmDevice -> Maybe DeviceSecretVerifierConfigType
deviceSecretVerifierConfig} -> Maybe DeviceSecretVerifierConfigType
deviceSecretVerifierConfig) (\s :: ConfirmDevice
s@ConfirmDevice' {} Maybe DeviceSecretVerifierConfigType
a -> ConfirmDevice
s {$sel:deviceSecretVerifierConfig:ConfirmDevice' :: Maybe DeviceSecretVerifierConfigType
deviceSecretVerifierConfig = Maybe DeviceSecretVerifierConfigType
a} :: ConfirmDevice)

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

-- | The device key.
confirmDevice_deviceKey :: Lens.Lens' ConfirmDevice Prelude.Text
confirmDevice_deviceKey :: Lens' ConfirmDevice Text
confirmDevice_deviceKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfirmDevice' {Text
deviceKey :: Text
$sel:deviceKey:ConfirmDevice' :: ConfirmDevice -> Text
deviceKey} -> Text
deviceKey) (\s :: ConfirmDevice
s@ConfirmDevice' {} Text
a -> ConfirmDevice
s {$sel:deviceKey:ConfirmDevice' :: Text
deviceKey = Text
a} :: ConfirmDevice)

instance Core.AWSRequest ConfirmDevice where
  type
    AWSResponse ConfirmDevice =
      ConfirmDeviceResponse
  request :: (Service -> Service) -> ConfirmDevice -> Request ConfirmDevice
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 ConfirmDevice
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ConfirmDevice)))
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 Bool -> Int -> ConfirmDeviceResponse
ConfirmDeviceResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"UserConfirmationNecessary")
            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 ConfirmDevice where
  hashWithSalt :: Int -> ConfirmDevice -> Int
hashWithSalt Int
_salt ConfirmDevice' {Maybe Text
Maybe DeviceSecretVerifierConfigType
Text
Sensitive Text
deviceKey :: Text
accessToken :: Sensitive Text
deviceSecretVerifierConfig :: Maybe DeviceSecretVerifierConfigType
deviceName :: Maybe Text
$sel:deviceKey:ConfirmDevice' :: ConfirmDevice -> Text
$sel:accessToken:ConfirmDevice' :: ConfirmDevice -> Sensitive Text
$sel:deviceSecretVerifierConfig:ConfirmDevice' :: ConfirmDevice -> Maybe DeviceSecretVerifierConfigType
$sel:deviceName:ConfirmDevice' :: ConfirmDevice -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deviceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeviceSecretVerifierConfigType
deviceSecretVerifierConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
accessToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deviceKey

instance Prelude.NFData ConfirmDevice where
  rnf :: ConfirmDevice -> ()
rnf ConfirmDevice' {Maybe Text
Maybe DeviceSecretVerifierConfigType
Text
Sensitive Text
deviceKey :: Text
accessToken :: Sensitive Text
deviceSecretVerifierConfig :: Maybe DeviceSecretVerifierConfigType
deviceName :: Maybe Text
$sel:deviceKey:ConfirmDevice' :: ConfirmDevice -> Text
$sel:accessToken:ConfirmDevice' :: ConfirmDevice -> Sensitive Text
$sel:deviceSecretVerifierConfig:ConfirmDevice' :: ConfirmDevice -> Maybe DeviceSecretVerifierConfigType
$sel:deviceName:ConfirmDevice' :: ConfirmDevice -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deviceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeviceSecretVerifierConfigType
deviceSecretVerifierConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
deviceKey

instance Data.ToHeaders ConfirmDevice where
  toHeaders :: ConfirmDevice -> 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.ConfirmDevice" ::
                          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 ConfirmDevice where
  toJSON :: ConfirmDevice -> Value
toJSON ConfirmDevice' {Maybe Text
Maybe DeviceSecretVerifierConfigType
Text
Sensitive Text
deviceKey :: Text
accessToken :: Sensitive Text
deviceSecretVerifierConfig :: Maybe DeviceSecretVerifierConfigType
deviceName :: Maybe Text
$sel:deviceKey:ConfirmDevice' :: ConfirmDevice -> Text
$sel:accessToken:ConfirmDevice' :: ConfirmDevice -> Sensitive Text
$sel:deviceSecretVerifierConfig:ConfirmDevice' :: ConfirmDevice -> Maybe DeviceSecretVerifierConfigType
$sel:deviceName:ConfirmDevice' :: ConfirmDevice -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeviceName" 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
deviceName,
            (Key
"DeviceSecretVerifierConfig" 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 DeviceSecretVerifierConfigType
deviceSecretVerifierConfig,
            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
"DeviceKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
deviceKey)
          ]
      )

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

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

-- | Confirms the device response.
--
-- /See:/ 'newConfirmDeviceResponse' smart constructor.
data ConfirmDeviceResponse = ConfirmDeviceResponse'
  { -- | Indicates whether the user confirmation must confirm the device
    -- response.
    ConfirmDeviceResponse -> Maybe Bool
userConfirmationNecessary :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    ConfirmDeviceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ConfirmDeviceResponse -> ConfirmDeviceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfirmDeviceResponse -> ConfirmDeviceResponse -> Bool
$c/= :: ConfirmDeviceResponse -> ConfirmDeviceResponse -> Bool
== :: ConfirmDeviceResponse -> ConfirmDeviceResponse -> Bool
$c== :: ConfirmDeviceResponse -> ConfirmDeviceResponse -> Bool
Prelude.Eq, ReadPrec [ConfirmDeviceResponse]
ReadPrec ConfirmDeviceResponse
Int -> ReadS ConfirmDeviceResponse
ReadS [ConfirmDeviceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfirmDeviceResponse]
$creadListPrec :: ReadPrec [ConfirmDeviceResponse]
readPrec :: ReadPrec ConfirmDeviceResponse
$creadPrec :: ReadPrec ConfirmDeviceResponse
readList :: ReadS [ConfirmDeviceResponse]
$creadList :: ReadS [ConfirmDeviceResponse]
readsPrec :: Int -> ReadS ConfirmDeviceResponse
$creadsPrec :: Int -> ReadS ConfirmDeviceResponse
Prelude.Read, Int -> ConfirmDeviceResponse -> ShowS
[ConfirmDeviceResponse] -> ShowS
ConfirmDeviceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfirmDeviceResponse] -> ShowS
$cshowList :: [ConfirmDeviceResponse] -> ShowS
show :: ConfirmDeviceResponse -> String
$cshow :: ConfirmDeviceResponse -> String
showsPrec :: Int -> ConfirmDeviceResponse -> ShowS
$cshowsPrec :: Int -> ConfirmDeviceResponse -> ShowS
Prelude.Show, forall x. Rep ConfirmDeviceResponse x -> ConfirmDeviceResponse
forall x. ConfirmDeviceResponse -> Rep ConfirmDeviceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfirmDeviceResponse x -> ConfirmDeviceResponse
$cfrom :: forall x. ConfirmDeviceResponse -> Rep ConfirmDeviceResponse x
Prelude.Generic)

-- |
-- Create a value of 'ConfirmDeviceResponse' 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:
--
-- 'userConfirmationNecessary', 'confirmDeviceResponse_userConfirmationNecessary' - Indicates whether the user confirmation must confirm the device
-- response.
--
-- 'httpStatus', 'confirmDeviceResponse_httpStatus' - The response's http status code.
newConfirmDeviceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ConfirmDeviceResponse
newConfirmDeviceResponse :: Int -> ConfirmDeviceResponse
newConfirmDeviceResponse Int
pHttpStatus_ =
  ConfirmDeviceResponse'
    { $sel:userConfirmationNecessary:ConfirmDeviceResponse' :: Maybe Bool
userConfirmationNecessary =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ConfirmDeviceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Indicates whether the user confirmation must confirm the device
-- response.
confirmDeviceResponse_userConfirmationNecessary :: Lens.Lens' ConfirmDeviceResponse (Prelude.Maybe Prelude.Bool)
confirmDeviceResponse_userConfirmationNecessary :: Lens' ConfirmDeviceResponse (Maybe Bool)
confirmDeviceResponse_userConfirmationNecessary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfirmDeviceResponse' {Maybe Bool
userConfirmationNecessary :: Maybe Bool
$sel:userConfirmationNecessary:ConfirmDeviceResponse' :: ConfirmDeviceResponse -> Maybe Bool
userConfirmationNecessary} -> Maybe Bool
userConfirmationNecessary) (\s :: ConfirmDeviceResponse
s@ConfirmDeviceResponse' {} Maybe Bool
a -> ConfirmDeviceResponse
s {$sel:userConfirmationNecessary:ConfirmDeviceResponse' :: Maybe Bool
userConfirmationNecessary = Maybe Bool
a} :: ConfirmDeviceResponse)

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

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