{-# 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.AssociateSoftwareToken
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Begins setup of time-based one-time password (TOTP) multi-factor
-- authentication (MFA) for a user, with a unique private key that Amazon
-- Cognito generates and returns in the API response. You can authorize an
-- @AssociateSoftwareToken@ request with either the user\'s access token,
-- or a session string from a challenge response that you received from
-- Amazon Cognito.
--
-- Amazon Cognito disassociates an existing software token when you verify
-- the new token in a
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_VerifySoftwareToken.html VerifySoftwareToken>
-- API request. If you don\'t verify the software token and your user pool
-- doesn\'t require MFA, the user can then authenticate with user name and
-- password credentials alone. If your user pool requires TOTP MFA, Amazon
-- Cognito generates an @MFA_SETUP@ or @SOFTWARE_TOKEN_SETUP@ challenge
-- each time your user signs. Complete setup with @AssociateSoftwareToken@
-- and @VerifySoftwareToken@.
--
-- After you set up software token MFA for your user, Amazon Cognito
-- generates a @SOFTWARE_TOKEN_MFA@ challenge when they authenticate.
-- Respond to this challenge with your user\'s TOTP.
module Amazonka.CognitoIdentityProvider.AssociateSoftwareToken
  ( -- * Creating a Request
    AssociateSoftwareToken (..),
    newAssociateSoftwareToken,

    -- * Request Lenses
    associateSoftwareToken_accessToken,
    associateSoftwareToken_session,

    -- * Destructuring the Response
    AssociateSoftwareTokenResponse (..),
    newAssociateSoftwareTokenResponse,

    -- * Response Lenses
    associateSoftwareTokenResponse_secretCode,
    associateSoftwareTokenResponse_session,
    associateSoftwareTokenResponse_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

-- | /See:/ 'newAssociateSoftwareToken' smart constructor.
data AssociateSoftwareToken = AssociateSoftwareToken'
  { -- | A valid access token that Amazon Cognito issued to the user whose
    -- software token you want to generate.
    AssociateSoftwareToken -> Maybe (Sensitive Text)
accessToken :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The session that should be passed both ways in challenge-response calls
    -- to the service. This allows authentication of the user as part of the
    -- MFA setup process.
    AssociateSoftwareToken -> Maybe Text
session :: Prelude.Maybe Prelude.Text
  }
  deriving (AssociateSoftwareToken -> AssociateSoftwareToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateSoftwareToken -> AssociateSoftwareToken -> Bool
$c/= :: AssociateSoftwareToken -> AssociateSoftwareToken -> Bool
== :: AssociateSoftwareToken -> AssociateSoftwareToken -> Bool
$c== :: AssociateSoftwareToken -> AssociateSoftwareToken -> Bool
Prelude.Eq, Int -> AssociateSoftwareToken -> ShowS
[AssociateSoftwareToken] -> ShowS
AssociateSoftwareToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateSoftwareToken] -> ShowS
$cshowList :: [AssociateSoftwareToken] -> ShowS
show :: AssociateSoftwareToken -> String
$cshow :: AssociateSoftwareToken -> String
showsPrec :: Int -> AssociateSoftwareToken -> ShowS
$cshowsPrec :: Int -> AssociateSoftwareToken -> ShowS
Prelude.Show, forall x. Rep AssociateSoftwareToken x -> AssociateSoftwareToken
forall x. AssociateSoftwareToken -> Rep AssociateSoftwareToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateSoftwareToken x -> AssociateSoftwareToken
$cfrom :: forall x. AssociateSoftwareToken -> Rep AssociateSoftwareToken x
Prelude.Generic)

-- |
-- Create a value of 'AssociateSoftwareToken' 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', 'associateSoftwareToken_accessToken' - A valid access token that Amazon Cognito issued to the user whose
-- software token you want to generate.
--
-- 'session', 'associateSoftwareToken_session' - The session that should be passed both ways in challenge-response calls
-- to the service. This allows authentication of the user as part of the
-- MFA setup process.
newAssociateSoftwareToken ::
  AssociateSoftwareToken
newAssociateSoftwareToken :: AssociateSoftwareToken
newAssociateSoftwareToken =
  AssociateSoftwareToken'
    { $sel:accessToken:AssociateSoftwareToken' :: Maybe (Sensitive Text)
accessToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:session:AssociateSoftwareToken' :: Maybe Text
session = forall a. Maybe a
Prelude.Nothing
    }

-- | A valid access token that Amazon Cognito issued to the user whose
-- software token you want to generate.
associateSoftwareToken_accessToken :: Lens.Lens' AssociateSoftwareToken (Prelude.Maybe Prelude.Text)
associateSoftwareToken_accessToken :: Lens' AssociateSoftwareToken (Maybe Text)
associateSoftwareToken_accessToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateSoftwareToken' {Maybe (Sensitive Text)
accessToken :: Maybe (Sensitive Text)
$sel:accessToken:AssociateSoftwareToken' :: AssociateSoftwareToken -> Maybe (Sensitive Text)
accessToken} -> Maybe (Sensitive Text)
accessToken) (\s :: AssociateSoftwareToken
s@AssociateSoftwareToken' {} Maybe (Sensitive Text)
a -> AssociateSoftwareToken
s {$sel:accessToken:AssociateSoftwareToken' :: Maybe (Sensitive Text)
accessToken = Maybe (Sensitive Text)
a} :: AssociateSoftwareToken) 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 session that should be passed both ways in challenge-response calls
-- to the service. This allows authentication of the user as part of the
-- MFA setup process.
associateSoftwareToken_session :: Lens.Lens' AssociateSoftwareToken (Prelude.Maybe Prelude.Text)
associateSoftwareToken_session :: Lens' AssociateSoftwareToken (Maybe Text)
associateSoftwareToken_session = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateSoftwareToken' {Maybe Text
session :: Maybe Text
$sel:session:AssociateSoftwareToken' :: AssociateSoftwareToken -> Maybe Text
session} -> Maybe Text
session) (\s :: AssociateSoftwareToken
s@AssociateSoftwareToken' {} Maybe Text
a -> AssociateSoftwareToken
s {$sel:session:AssociateSoftwareToken' :: Maybe Text
session = Maybe Text
a} :: AssociateSoftwareToken)

instance Core.AWSRequest AssociateSoftwareToken where
  type
    AWSResponse AssociateSoftwareToken =
      AssociateSoftwareTokenResponse
  request :: (Service -> Service)
-> AssociateSoftwareToken -> Request AssociateSoftwareToken
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 AssociateSoftwareToken
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateSoftwareToken)))
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 (Sensitive Text)
-> Maybe Text -> Int -> AssociateSoftwareTokenResponse
AssociateSoftwareTokenResponse'
            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
"SecretCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Session")
            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 AssociateSoftwareToken where
  hashWithSalt :: Int -> AssociateSoftwareToken -> Int
hashWithSalt Int
_salt AssociateSoftwareToken' {Maybe Text
Maybe (Sensitive Text)
session :: Maybe Text
accessToken :: Maybe (Sensitive Text)
$sel:session:AssociateSoftwareToken' :: AssociateSoftwareToken -> Maybe Text
$sel:accessToken:AssociateSoftwareToken' :: AssociateSoftwareToken -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
accessToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
session

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

instance Data.ToHeaders AssociateSoftwareToken where
  toHeaders :: AssociateSoftwareToken -> 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.AssociateSoftwareToken" ::
                          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 AssociateSoftwareToken where
  toJSON :: AssociateSoftwareToken -> Value
toJSON AssociateSoftwareToken' {Maybe Text
Maybe (Sensitive Text)
session :: Maybe Text
accessToken :: Maybe (Sensitive Text)
$sel:session:AssociateSoftwareToken' :: AssociateSoftwareToken -> Maybe Text
$sel:accessToken:AssociateSoftwareToken' :: AssociateSoftwareToken -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccessToken" 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)
accessToken,
            (Key
"Session" 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
session
          ]
      )

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

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

-- | /See:/ 'newAssociateSoftwareTokenResponse' smart constructor.
data AssociateSoftwareTokenResponse = AssociateSoftwareTokenResponse'
  { -- | A unique generated shared secret code that is used in the TOTP algorithm
    -- to generate a one-time code.
    AssociateSoftwareTokenResponse -> Maybe (Sensitive Text)
secretCode :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The session that should be passed both ways in challenge-response calls
    -- to the service. This allows authentication of the user as part of the
    -- MFA setup process.
    AssociateSoftwareTokenResponse -> Maybe Text
session :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    AssociateSoftwareTokenResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AssociateSoftwareTokenResponse
-> AssociateSoftwareTokenResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateSoftwareTokenResponse
-> AssociateSoftwareTokenResponse -> Bool
$c/= :: AssociateSoftwareTokenResponse
-> AssociateSoftwareTokenResponse -> Bool
== :: AssociateSoftwareTokenResponse
-> AssociateSoftwareTokenResponse -> Bool
$c== :: AssociateSoftwareTokenResponse
-> AssociateSoftwareTokenResponse -> Bool
Prelude.Eq, Int -> AssociateSoftwareTokenResponse -> ShowS
[AssociateSoftwareTokenResponse] -> ShowS
AssociateSoftwareTokenResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateSoftwareTokenResponse] -> ShowS
$cshowList :: [AssociateSoftwareTokenResponse] -> ShowS
show :: AssociateSoftwareTokenResponse -> String
$cshow :: AssociateSoftwareTokenResponse -> String
showsPrec :: Int -> AssociateSoftwareTokenResponse -> ShowS
$cshowsPrec :: Int -> AssociateSoftwareTokenResponse -> ShowS
Prelude.Show, forall x.
Rep AssociateSoftwareTokenResponse x
-> AssociateSoftwareTokenResponse
forall x.
AssociateSoftwareTokenResponse
-> Rep AssociateSoftwareTokenResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateSoftwareTokenResponse x
-> AssociateSoftwareTokenResponse
$cfrom :: forall x.
AssociateSoftwareTokenResponse
-> Rep AssociateSoftwareTokenResponse x
Prelude.Generic)

-- |
-- Create a value of 'AssociateSoftwareTokenResponse' 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:
--
-- 'secretCode', 'associateSoftwareTokenResponse_secretCode' - A unique generated shared secret code that is used in the TOTP algorithm
-- to generate a one-time code.
--
-- 'session', 'associateSoftwareTokenResponse_session' - The session that should be passed both ways in challenge-response calls
-- to the service. This allows authentication of the user as part of the
-- MFA setup process.
--
-- 'httpStatus', 'associateSoftwareTokenResponse_httpStatus' - The response's http status code.
newAssociateSoftwareTokenResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateSoftwareTokenResponse
newAssociateSoftwareTokenResponse :: Int -> AssociateSoftwareTokenResponse
newAssociateSoftwareTokenResponse Int
pHttpStatus_ =
  AssociateSoftwareTokenResponse'
    { $sel:secretCode:AssociateSoftwareTokenResponse' :: Maybe (Sensitive Text)
secretCode =
        forall a. Maybe a
Prelude.Nothing,
      $sel:session:AssociateSoftwareTokenResponse' :: Maybe Text
session = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AssociateSoftwareTokenResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A unique generated shared secret code that is used in the TOTP algorithm
-- to generate a one-time code.
associateSoftwareTokenResponse_secretCode :: Lens.Lens' AssociateSoftwareTokenResponse (Prelude.Maybe Prelude.Text)
associateSoftwareTokenResponse_secretCode :: Lens' AssociateSoftwareTokenResponse (Maybe Text)
associateSoftwareTokenResponse_secretCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateSoftwareTokenResponse' {Maybe (Sensitive Text)
secretCode :: Maybe (Sensitive Text)
$sel:secretCode:AssociateSoftwareTokenResponse' :: AssociateSoftwareTokenResponse -> Maybe (Sensitive Text)
secretCode} -> Maybe (Sensitive Text)
secretCode) (\s :: AssociateSoftwareTokenResponse
s@AssociateSoftwareTokenResponse' {} Maybe (Sensitive Text)
a -> AssociateSoftwareTokenResponse
s {$sel:secretCode:AssociateSoftwareTokenResponse' :: Maybe (Sensitive Text)
secretCode = Maybe (Sensitive Text)
a} :: AssociateSoftwareTokenResponse) 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 session that should be passed both ways in challenge-response calls
-- to the service. This allows authentication of the user as part of the
-- MFA setup process.
associateSoftwareTokenResponse_session :: Lens.Lens' AssociateSoftwareTokenResponse (Prelude.Maybe Prelude.Text)
associateSoftwareTokenResponse_session :: Lens' AssociateSoftwareTokenResponse (Maybe Text)
associateSoftwareTokenResponse_session = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateSoftwareTokenResponse' {Maybe Text
session :: Maybe Text
$sel:session:AssociateSoftwareTokenResponse' :: AssociateSoftwareTokenResponse -> Maybe Text
session} -> Maybe Text
session) (\s :: AssociateSoftwareTokenResponse
s@AssociateSoftwareTokenResponse' {} Maybe Text
a -> AssociateSoftwareTokenResponse
s {$sel:session:AssociateSoftwareTokenResponse' :: Maybe Text
session = Maybe Text
a} :: AssociateSoftwareTokenResponse)

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

instance
  Prelude.NFData
    AssociateSoftwareTokenResponse
  where
  rnf :: AssociateSoftwareTokenResponse -> ()
rnf AssociateSoftwareTokenResponse' {Int
Maybe Text
Maybe (Sensitive Text)
httpStatus :: Int
session :: Maybe Text
secretCode :: Maybe (Sensitive Text)
$sel:httpStatus:AssociateSoftwareTokenResponse' :: AssociateSoftwareTokenResponse -> Int
$sel:session:AssociateSoftwareTokenResponse' :: AssociateSoftwareTokenResponse -> Maybe Text
$sel:secretCode:AssociateSoftwareTokenResponse' :: AssociateSoftwareTokenResponse -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
secretCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
session
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus