{-# 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.GetUser
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the user attributes and metadata for a user.
module Amazonka.CognitoIdentityProvider.GetUser
  ( -- * Creating a Request
    GetUser (..),
    newGetUser,

    -- * Request Lenses
    getUser_accessToken,

    -- * Destructuring the Response
    GetUserResponse (..),
    newGetUserResponse,

    -- * Response Lenses
    getUserResponse_mfaOptions,
    getUserResponse_preferredMfaSetting,
    getUserResponse_userMFASettingList,
    getUserResponse_httpStatus,
    getUserResponse_username,
    getUserResponse_userAttributes,
  )
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 get information about the user.
--
-- /See:/ 'newGetUser' smart constructor.
data GetUser = GetUser'
  { -- | A non-expired access token for the user whose information you want to
    -- query.
    GetUser -> Sensitive Text
accessToken :: Data.Sensitive Prelude.Text
  }
  deriving (GetUser -> GetUser -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUser -> GetUser -> Bool
$c/= :: GetUser -> GetUser -> Bool
== :: GetUser -> GetUser -> Bool
$c== :: GetUser -> GetUser -> Bool
Prelude.Eq, Int -> GetUser -> ShowS
[GetUser] -> ShowS
GetUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUser] -> ShowS
$cshowList :: [GetUser] -> ShowS
show :: GetUser -> String
$cshow :: GetUser -> String
showsPrec :: Int -> GetUser -> ShowS
$cshowsPrec :: Int -> GetUser -> ShowS
Prelude.Show, forall x. Rep GetUser x -> GetUser
forall x. GetUser -> Rep GetUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetUser x -> GetUser
$cfrom :: forall x. GetUser -> Rep GetUser x
Prelude.Generic)

-- |
-- Create a value of 'GetUser' 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', 'getUser_accessToken' - A non-expired access token for the user whose information you want to
-- query.
newGetUser ::
  -- | 'accessToken'
  Prelude.Text ->
  GetUser
newGetUser :: Text -> GetUser
newGetUser Text
pAccessToken_ =
  GetUser'
    { $sel:accessToken:GetUser' :: Sensitive Text
accessToken =
        forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pAccessToken_
    }

-- | A non-expired access token for the user whose information you want to
-- query.
getUser_accessToken :: Lens.Lens' GetUser Prelude.Text
getUser_accessToken :: Lens' GetUser Text
getUser_accessToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUser' {Sensitive Text
accessToken :: Sensitive Text
$sel:accessToken:GetUser' :: GetUser -> Sensitive Text
accessToken} -> Sensitive Text
accessToken) (\s :: GetUser
s@GetUser' {} Sensitive Text
a -> GetUser
s {$sel:accessToken:GetUser' :: Sensitive Text
accessToken = Sensitive Text
a} :: GetUser) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest GetUser where
  type AWSResponse GetUser = GetUserResponse
  request :: (Service -> Service) -> GetUser -> Request GetUser
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 GetUser
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetUser)))
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 [MFAOptionType]
-> Maybe Text
-> Maybe [Text]
-> Int
-> Sensitive Text
-> [AttributeType]
-> GetUserResponse
GetUserResponse'
            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
"MFAOptions" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"PreferredMfaSetting")
            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
"UserMFASettingList"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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))
            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
"Username")
            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
"UserAttributes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable GetUser where
  hashWithSalt :: Int -> GetUser -> Int
hashWithSalt Int
_salt GetUser' {Sensitive Text
accessToken :: Sensitive Text
$sel:accessToken:GetUser' :: GetUser -> Sensitive Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
accessToken

instance Prelude.NFData GetUser where
  rnf :: GetUser -> ()
rnf GetUser' {Sensitive Text
accessToken :: Sensitive Text
$sel:accessToken:GetUser' :: GetUser -> Sensitive Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
accessToken

instance Data.ToHeaders GetUser where
  toHeaders :: GetUser -> 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.GetUser" ::
                          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 GetUser where
  toJSON :: GetUser -> Value
toJSON GetUser' {Sensitive Text
accessToken :: Sensitive Text
$sel:accessToken:GetUser' :: GetUser -> 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)]
      )

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

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

-- | Represents the response from the server from the request to get
-- information about the user.
--
-- /See:/ 'newGetUserResponse' smart constructor.
data GetUserResponse = GetUserResponse'
  { -- | /This response parameter is no longer supported./ It provides
    -- information only about SMS MFA configurations. It doesn\'t provide
    -- information about time-based one-time password (TOTP) software token MFA
    -- configurations. To look up information about either type of MFA
    -- configuration, use UserMFASettingList instead.
    GetUserResponse -> Maybe [MFAOptionType]
mfaOptions :: Prelude.Maybe [MFAOptionType],
    -- | The user\'s preferred MFA setting.
    GetUserResponse -> Maybe Text
preferredMfaSetting :: Prelude.Maybe Prelude.Text,
    -- | The MFA options that are activated for the user. The possible values in
    -- this list are @SMS_MFA@ and @SOFTWARE_TOKEN_MFA@.
    GetUserResponse -> Maybe [Text]
userMFASettingList :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    GetUserResponse -> Int
httpStatus :: Prelude.Int,
    -- | The user name of the user you want to retrieve from the get user
    -- request.
    GetUserResponse -> Sensitive Text
username :: Data.Sensitive Prelude.Text,
    -- | An array of name-value pairs representing user attributes.
    --
    -- For custom attributes, you must prepend the @custom:@ prefix to the
    -- attribute name.
    GetUserResponse -> [AttributeType]
userAttributes :: [AttributeType]
  }
  deriving (GetUserResponse -> GetUserResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUserResponse -> GetUserResponse -> Bool
$c/= :: GetUserResponse -> GetUserResponse -> Bool
== :: GetUserResponse -> GetUserResponse -> Bool
$c== :: GetUserResponse -> GetUserResponse -> Bool
Prelude.Eq, Int -> GetUserResponse -> ShowS
[GetUserResponse] -> ShowS
GetUserResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUserResponse] -> ShowS
$cshowList :: [GetUserResponse] -> ShowS
show :: GetUserResponse -> String
$cshow :: GetUserResponse -> String
showsPrec :: Int -> GetUserResponse -> ShowS
$cshowsPrec :: Int -> GetUserResponse -> ShowS
Prelude.Show, forall x. Rep GetUserResponse x -> GetUserResponse
forall x. GetUserResponse -> Rep GetUserResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetUserResponse x -> GetUserResponse
$cfrom :: forall x. GetUserResponse -> Rep GetUserResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetUserResponse' 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:
--
-- 'mfaOptions', 'getUserResponse_mfaOptions' - /This response parameter is no longer supported./ It provides
-- information only about SMS MFA configurations. It doesn\'t provide
-- information about time-based one-time password (TOTP) software token MFA
-- configurations. To look up information about either type of MFA
-- configuration, use UserMFASettingList instead.
--
-- 'preferredMfaSetting', 'getUserResponse_preferredMfaSetting' - The user\'s preferred MFA setting.
--
-- 'userMFASettingList', 'getUserResponse_userMFASettingList' - The MFA options that are activated for the user. The possible values in
-- this list are @SMS_MFA@ and @SOFTWARE_TOKEN_MFA@.
--
-- 'httpStatus', 'getUserResponse_httpStatus' - The response's http status code.
--
-- 'username', 'getUserResponse_username' - The user name of the user you want to retrieve from the get user
-- request.
--
-- 'userAttributes', 'getUserResponse_userAttributes' - An array of name-value pairs representing user attributes.
--
-- For custom attributes, you must prepend the @custom:@ prefix to the
-- attribute name.
newGetUserResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'username'
  Prelude.Text ->
  GetUserResponse
newGetUserResponse :: Int -> Text -> GetUserResponse
newGetUserResponse Int
pHttpStatus_ Text
pUsername_ =
  GetUserResponse'
    { $sel:mfaOptions:GetUserResponse' :: Maybe [MFAOptionType]
mfaOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredMfaSetting:GetUserResponse' :: Maybe Text
preferredMfaSetting = forall a. Maybe a
Prelude.Nothing,
      $sel:userMFASettingList:GetUserResponse' :: Maybe [Text]
userMFASettingList = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetUserResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:username:GetUserResponse' :: Sensitive Text
username = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pUsername_,
      $sel:userAttributes:GetUserResponse' :: [AttributeType]
userAttributes = forall a. Monoid a => a
Prelude.mempty
    }

-- | /This response parameter is no longer supported./ It provides
-- information only about SMS MFA configurations. It doesn\'t provide
-- information about time-based one-time password (TOTP) software token MFA
-- configurations. To look up information about either type of MFA
-- configuration, use UserMFASettingList instead.
getUserResponse_mfaOptions :: Lens.Lens' GetUserResponse (Prelude.Maybe [MFAOptionType])
getUserResponse_mfaOptions :: Lens' GetUserResponse (Maybe [MFAOptionType])
getUserResponse_mfaOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe [MFAOptionType]
mfaOptions :: Maybe [MFAOptionType]
$sel:mfaOptions:GetUserResponse' :: GetUserResponse -> Maybe [MFAOptionType]
mfaOptions} -> Maybe [MFAOptionType]
mfaOptions) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe [MFAOptionType]
a -> GetUserResponse
s {$sel:mfaOptions:GetUserResponse' :: Maybe [MFAOptionType]
mfaOptions = Maybe [MFAOptionType]
a} :: GetUserResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The user\'s preferred MFA setting.
getUserResponse_preferredMfaSetting :: Lens.Lens' GetUserResponse (Prelude.Maybe Prelude.Text)
getUserResponse_preferredMfaSetting :: Lens' GetUserResponse (Maybe Text)
getUserResponse_preferredMfaSetting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe Text
preferredMfaSetting :: Maybe Text
$sel:preferredMfaSetting:GetUserResponse' :: GetUserResponse -> Maybe Text
preferredMfaSetting} -> Maybe Text
preferredMfaSetting) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe Text
a -> GetUserResponse
s {$sel:preferredMfaSetting:GetUserResponse' :: Maybe Text
preferredMfaSetting = Maybe Text
a} :: GetUserResponse)

-- | The MFA options that are activated for the user. The possible values in
-- this list are @SMS_MFA@ and @SOFTWARE_TOKEN_MFA@.
getUserResponse_userMFASettingList :: Lens.Lens' GetUserResponse (Prelude.Maybe [Prelude.Text])
getUserResponse_userMFASettingList :: Lens' GetUserResponse (Maybe [Text])
getUserResponse_userMFASettingList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe [Text]
userMFASettingList :: Maybe [Text]
$sel:userMFASettingList:GetUserResponse' :: GetUserResponse -> Maybe [Text]
userMFASettingList} -> Maybe [Text]
userMFASettingList) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe [Text]
a -> GetUserResponse
s {$sel:userMFASettingList:GetUserResponse' :: Maybe [Text]
userMFASettingList = Maybe [Text]
a} :: GetUserResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

-- | The user name of the user you want to retrieve from the get user
-- request.
getUserResponse_username :: Lens.Lens' GetUserResponse Prelude.Text
getUserResponse_username :: Lens' GetUserResponse Text
getUserResponse_username = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Sensitive Text
username :: Sensitive Text
$sel:username:GetUserResponse' :: GetUserResponse -> Sensitive Text
username} -> Sensitive Text
username) (\s :: GetUserResponse
s@GetUserResponse' {} Sensitive Text
a -> GetUserResponse
s {$sel:username:GetUserResponse' :: Sensitive Text
username = Sensitive Text
a} :: GetUserResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | An array of name-value pairs representing user attributes.
--
-- For custom attributes, you must prepend the @custom:@ prefix to the
-- attribute name.
getUserResponse_userAttributes :: Lens.Lens' GetUserResponse [AttributeType]
getUserResponse_userAttributes :: Lens' GetUserResponse [AttributeType]
getUserResponse_userAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {[AttributeType]
userAttributes :: [AttributeType]
$sel:userAttributes:GetUserResponse' :: GetUserResponse -> [AttributeType]
userAttributes} -> [AttributeType]
userAttributes) (\s :: GetUserResponse
s@GetUserResponse' {} [AttributeType]
a -> GetUserResponse
s {$sel:userAttributes:GetUserResponse' :: [AttributeType]
userAttributes = [AttributeType]
a} :: GetUserResponse) 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 Prelude.NFData GetUserResponse where
  rnf :: GetUserResponse -> ()
rnf GetUserResponse' {Int
[AttributeType]
Maybe [Text]
Maybe [MFAOptionType]
Maybe Text
Sensitive Text
userAttributes :: [AttributeType]
username :: Sensitive Text
httpStatus :: Int
userMFASettingList :: Maybe [Text]
preferredMfaSetting :: Maybe Text
mfaOptions :: Maybe [MFAOptionType]
$sel:userAttributes:GetUserResponse' :: GetUserResponse -> [AttributeType]
$sel:username:GetUserResponse' :: GetUserResponse -> Sensitive Text
$sel:httpStatus:GetUserResponse' :: GetUserResponse -> Int
$sel:userMFASettingList:GetUserResponse' :: GetUserResponse -> Maybe [Text]
$sel:preferredMfaSetting:GetUserResponse' :: GetUserResponse -> Maybe Text
$sel:mfaOptions:GetUserResponse' :: GetUserResponse -> Maybe [MFAOptionType]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [MFAOptionType]
mfaOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preferredMfaSetting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
userMFASettingList
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Sensitive Text
username
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [AttributeType]
userAttributes