{-# 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.FinSpaceData.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)
--
-- Retrieves details for a specific user.
module Amazonka.FinSpaceData.GetUser
  ( -- * Creating a Request
    GetUser (..),
    newGetUser,

    -- * Request Lenses
    getUser_userId,

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

    -- * Response Lenses
    getUserResponse_apiAccess,
    getUserResponse_apiAccessPrincipalArn,
    getUserResponse_createTime,
    getUserResponse_emailAddress,
    getUserResponse_firstName,
    getUserResponse_lastDisabledTime,
    getUserResponse_lastEnabledTime,
    getUserResponse_lastLoginTime,
    getUserResponse_lastModifiedTime,
    getUserResponse_lastName,
    getUserResponse_status,
    getUserResponse_type,
    getUserResponse_userId,
    getUserResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.FinSpaceData.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetUser' smart constructor.
data GetUser = GetUser'
  { -- | The unique identifier of the user to get data for.
    GetUser -> Text
userId :: 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, ReadPrec [GetUser]
ReadPrec GetUser
Int -> ReadS GetUser
ReadS [GetUser]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUser]
$creadListPrec :: ReadPrec [GetUser]
readPrec :: ReadPrec GetUser
$creadPrec :: ReadPrec GetUser
readList :: ReadS [GetUser]
$creadList :: ReadS [GetUser]
readsPrec :: Int -> ReadS GetUser
$creadsPrec :: Int -> ReadS GetUser
Prelude.Read, 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:
--
-- 'userId', 'getUser_userId' - The unique identifier of the user to get data for.
newGetUser ::
  -- | 'userId'
  Prelude.Text ->
  GetUser
newGetUser :: Text -> GetUser
newGetUser Text
pUserId_ = GetUser' {$sel:userId:GetUser' :: Text
userId = Text
pUserId_}

-- | The unique identifier of the user to get data for.
getUser_userId :: Lens.Lens' GetUser Prelude.Text
getUser_userId :: Lens' GetUser Text
getUser_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUser' {Text
userId :: Text
$sel:userId:GetUser' :: GetUser -> Text
userId} -> Text
userId) (\s :: GetUser
s@GetUser' {} Text
a -> GetUser
s {$sel:userId:GetUser' :: Text
userId = Text
a} :: GetUser)

instance Core.AWSRequest GetUser where
  type AWSResponse GetUser = GetUserResponse
  request :: (Service -> Service) -> GetUser -> Request GetUser
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (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 ApiAccess
-> Maybe Text
-> Maybe Integer
-> Maybe (Sensitive Text)
-> Maybe (Sensitive Text)
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe (Sensitive Text)
-> Maybe UserStatus
-> Maybe UserType
-> Maybe Text
-> Int
-> 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
"apiAccess")
            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
"apiAccessPrincipalArn")
            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
"createTime")
            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
"emailAddress")
            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
"firstName")
            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
"lastDisabledTime")
            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
"lastEnabledTime")
            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
"lastLoginTime")
            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
"lastModifiedTime")
            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
"lastName")
            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
"status")
            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
"type")
            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
"userId")
            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 GetUser where
  hashWithSalt :: Int -> GetUser -> Int
hashWithSalt Int
_salt GetUser' {Text
userId :: Text
$sel:userId:GetUser' :: GetUser -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userId

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

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
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetUser where
  toPath :: GetUser -> ByteString
toPath GetUser' {Text
userId :: Text
$sel:userId:GetUser' :: GetUser -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/user/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
userId]

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

-- | /See:/ 'newGetUserResponse' smart constructor.
data GetUserResponse = GetUserResponse'
  { -- | Indicates whether the user can use the
    -- @GetProgrammaticAccessCredentials@ API to obtain credentials that can
    -- then be used to access other FinSpace Data API operations.
    --
    -- -   @ENABLED@ – The user has permissions to use the APIs.
    --
    -- -   @DISABLED@ – The user does not have permissions to use any APIs.
    GetUserResponse -> Maybe ApiAccess
apiAccess :: Prelude.Maybe ApiAccess,
    -- | The ARN identifier of an AWS user or role that is allowed to call the
    -- @GetProgrammaticAccessCredentials@ API to obtain a credentials token for
    -- a specific FinSpace user. This must be an IAM role within your FinSpace
    -- account.
    GetUserResponse -> Maybe Text
apiAccessPrincipalArn :: Prelude.Maybe Prelude.Text,
    -- | The timestamp at which the user account was created in FinSpace. The
    -- value is determined as epoch time in milliseconds.
    GetUserResponse -> Maybe Integer
createTime :: Prelude.Maybe Prelude.Integer,
    -- | The email address that is associated with the user.
    GetUserResponse -> Maybe (Sensitive Text)
emailAddress :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The first name of the user.
    GetUserResponse -> Maybe (Sensitive Text)
firstName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Describes the last time the user account was disabled. The value is
    -- determined as epoch time in milliseconds.
    GetUserResponse -> Maybe Integer
lastDisabledTime :: Prelude.Maybe Prelude.Integer,
    -- | Describes the last time the user account was enabled. The value is
    -- determined as epoch time in milliseconds.
    GetUserResponse -> Maybe Integer
lastEnabledTime :: Prelude.Maybe Prelude.Integer,
    -- | Describes the last time that the user logged into their account. The
    -- value is determined as epoch time in milliseconds.
    GetUserResponse -> Maybe Integer
lastLoginTime :: Prelude.Maybe Prelude.Integer,
    -- | Describes the last time the user account was updated. The value is
    -- determined as epoch time in milliseconds.
    GetUserResponse -> Maybe Integer
lastModifiedTime :: Prelude.Maybe Prelude.Integer,
    -- | The last name of the user.
    GetUserResponse -> Maybe (Sensitive Text)
lastName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The current status of the user account.
    --
    -- -   @CREATING@ – The user account creation is in progress.
    --
    -- -   @ENABLED@ – The user account is created and is currently active.
    --
    -- -   @DISABLED@ – The user account is currently inactive.
    GetUserResponse -> Maybe UserStatus
status :: Prelude.Maybe UserStatus,
    -- | Indicates the type of user.
    --
    -- -   @SUPER_USER@ – A user with permission to all the functionality and
    --     data in FinSpace.
    --
    -- -   @APP_USER@ – A user with specific permissions in FinSpace. The users
    --     are assigned permissions by adding them to a permission group.
    GetUserResponse -> Maybe UserType
type' :: Prelude.Maybe UserType,
    -- | The unique identifier for the user account that is retrieved.
    GetUserResponse -> Maybe Text
userId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetUserResponse -> Int
httpStatus :: Prelude.Int
  }
  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:
--
-- 'apiAccess', 'getUserResponse_apiAccess' - Indicates whether the user can use the
-- @GetProgrammaticAccessCredentials@ API to obtain credentials that can
-- then be used to access other FinSpace Data API operations.
--
-- -   @ENABLED@ – The user has permissions to use the APIs.
--
-- -   @DISABLED@ – The user does not have permissions to use any APIs.
--
-- 'apiAccessPrincipalArn', 'getUserResponse_apiAccessPrincipalArn' - The ARN identifier of an AWS user or role that is allowed to call the
-- @GetProgrammaticAccessCredentials@ API to obtain a credentials token for
-- a specific FinSpace user. This must be an IAM role within your FinSpace
-- account.
--
-- 'createTime', 'getUserResponse_createTime' - The timestamp at which the user account was created in FinSpace. The
-- value is determined as epoch time in milliseconds.
--
-- 'emailAddress', 'getUserResponse_emailAddress' - The email address that is associated with the user.
--
-- 'firstName', 'getUserResponse_firstName' - The first name of the user.
--
-- 'lastDisabledTime', 'getUserResponse_lastDisabledTime' - Describes the last time the user account was disabled. The value is
-- determined as epoch time in milliseconds.
--
-- 'lastEnabledTime', 'getUserResponse_lastEnabledTime' - Describes the last time the user account was enabled. The value is
-- determined as epoch time in milliseconds.
--
-- 'lastLoginTime', 'getUserResponse_lastLoginTime' - Describes the last time that the user logged into their account. The
-- value is determined as epoch time in milliseconds.
--
-- 'lastModifiedTime', 'getUserResponse_lastModifiedTime' - Describes the last time the user account was updated. The value is
-- determined as epoch time in milliseconds.
--
-- 'lastName', 'getUserResponse_lastName' - The last name of the user.
--
-- 'status', 'getUserResponse_status' - The current status of the user account.
--
-- -   @CREATING@ – The user account creation is in progress.
--
-- -   @ENABLED@ – The user account is created and is currently active.
--
-- -   @DISABLED@ – The user account is currently inactive.
--
-- 'type'', 'getUserResponse_type' - Indicates the type of user.
--
-- -   @SUPER_USER@ – A user with permission to all the functionality and
--     data in FinSpace.
--
-- -   @APP_USER@ – A user with specific permissions in FinSpace. The users
--     are assigned permissions by adding them to a permission group.
--
-- 'userId', 'getUserResponse_userId' - The unique identifier for the user account that is retrieved.
--
-- 'httpStatus', 'getUserResponse_httpStatus' - The response's http status code.
newGetUserResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetUserResponse
newGetUserResponse :: Int -> GetUserResponse
newGetUserResponse Int
pHttpStatus_ =
  GetUserResponse'
    { $sel:apiAccess:GetUserResponse' :: Maybe ApiAccess
apiAccess = forall a. Maybe a
Prelude.Nothing,
      $sel:apiAccessPrincipalArn:GetUserResponse' :: Maybe Text
apiAccessPrincipalArn = forall a. Maybe a
Prelude.Nothing,
      $sel:createTime:GetUserResponse' :: Maybe Integer
createTime = forall a. Maybe a
Prelude.Nothing,
      $sel:emailAddress:GetUserResponse' :: Maybe (Sensitive Text)
emailAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:firstName:GetUserResponse' :: Maybe (Sensitive Text)
firstName = forall a. Maybe a
Prelude.Nothing,
      $sel:lastDisabledTime:GetUserResponse' :: Maybe Integer
lastDisabledTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lastEnabledTime:GetUserResponse' :: Maybe Integer
lastEnabledTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lastLoginTime:GetUserResponse' :: Maybe Integer
lastLoginTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTime:GetUserResponse' :: Maybe Integer
lastModifiedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lastName:GetUserResponse' :: Maybe (Sensitive Text)
lastName = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetUserResponse' :: Maybe UserStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:type':GetUserResponse' :: Maybe UserType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:userId:GetUserResponse' :: Maybe Text
userId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetUserResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Indicates whether the user can use the
-- @GetProgrammaticAccessCredentials@ API to obtain credentials that can
-- then be used to access other FinSpace Data API operations.
--
-- -   @ENABLED@ – The user has permissions to use the APIs.
--
-- -   @DISABLED@ – The user does not have permissions to use any APIs.
getUserResponse_apiAccess :: Lens.Lens' GetUserResponse (Prelude.Maybe ApiAccess)
getUserResponse_apiAccess :: Lens' GetUserResponse (Maybe ApiAccess)
getUserResponse_apiAccess = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe ApiAccess
apiAccess :: Maybe ApiAccess
$sel:apiAccess:GetUserResponse' :: GetUserResponse -> Maybe ApiAccess
apiAccess} -> Maybe ApiAccess
apiAccess) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe ApiAccess
a -> GetUserResponse
s {$sel:apiAccess:GetUserResponse' :: Maybe ApiAccess
apiAccess = Maybe ApiAccess
a} :: GetUserResponse)

-- | The ARN identifier of an AWS user or role that is allowed to call the
-- @GetProgrammaticAccessCredentials@ API to obtain a credentials token for
-- a specific FinSpace user. This must be an IAM role within your FinSpace
-- account.
getUserResponse_apiAccessPrincipalArn :: Lens.Lens' GetUserResponse (Prelude.Maybe Prelude.Text)
getUserResponse_apiAccessPrincipalArn :: Lens' GetUserResponse (Maybe Text)
getUserResponse_apiAccessPrincipalArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe Text
apiAccessPrincipalArn :: Maybe Text
$sel:apiAccessPrincipalArn:GetUserResponse' :: GetUserResponse -> Maybe Text
apiAccessPrincipalArn} -> Maybe Text
apiAccessPrincipalArn) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe Text
a -> GetUserResponse
s {$sel:apiAccessPrincipalArn:GetUserResponse' :: Maybe Text
apiAccessPrincipalArn = Maybe Text
a} :: GetUserResponse)

-- | The timestamp at which the user account was created in FinSpace. The
-- value is determined as epoch time in milliseconds.
getUserResponse_createTime :: Lens.Lens' GetUserResponse (Prelude.Maybe Prelude.Integer)
getUserResponse_createTime :: Lens' GetUserResponse (Maybe Integer)
getUserResponse_createTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe Integer
createTime :: Maybe Integer
$sel:createTime:GetUserResponse' :: GetUserResponse -> Maybe Integer
createTime} -> Maybe Integer
createTime) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe Integer
a -> GetUserResponse
s {$sel:createTime:GetUserResponse' :: Maybe Integer
createTime = Maybe Integer
a} :: GetUserResponse)

-- | The email address that is associated with the user.
getUserResponse_emailAddress :: Lens.Lens' GetUserResponse (Prelude.Maybe Prelude.Text)
getUserResponse_emailAddress :: Lens' GetUserResponse (Maybe Text)
getUserResponse_emailAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe (Sensitive Text)
emailAddress :: Maybe (Sensitive Text)
$sel:emailAddress:GetUserResponse' :: GetUserResponse -> Maybe (Sensitive Text)
emailAddress} -> Maybe (Sensitive Text)
emailAddress) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe (Sensitive Text)
a -> GetUserResponse
s {$sel:emailAddress:GetUserResponse' :: Maybe (Sensitive Text)
emailAddress = Maybe (Sensitive 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The first name of the user.
getUserResponse_firstName :: Lens.Lens' GetUserResponse (Prelude.Maybe Prelude.Text)
getUserResponse_firstName :: Lens' GetUserResponse (Maybe Text)
getUserResponse_firstName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe (Sensitive Text)
firstName :: Maybe (Sensitive Text)
$sel:firstName:GetUserResponse' :: GetUserResponse -> Maybe (Sensitive Text)
firstName} -> Maybe (Sensitive Text)
firstName) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe (Sensitive Text)
a -> GetUserResponse
s {$sel:firstName:GetUserResponse' :: Maybe (Sensitive Text)
firstName = Maybe (Sensitive 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | Describes the last time the user account was disabled. The value is
-- determined as epoch time in milliseconds.
getUserResponse_lastDisabledTime :: Lens.Lens' GetUserResponse (Prelude.Maybe Prelude.Integer)
getUserResponse_lastDisabledTime :: Lens' GetUserResponse (Maybe Integer)
getUserResponse_lastDisabledTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe Integer
lastDisabledTime :: Maybe Integer
$sel:lastDisabledTime:GetUserResponse' :: GetUserResponse -> Maybe Integer
lastDisabledTime} -> Maybe Integer
lastDisabledTime) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe Integer
a -> GetUserResponse
s {$sel:lastDisabledTime:GetUserResponse' :: Maybe Integer
lastDisabledTime = Maybe Integer
a} :: GetUserResponse)

-- | Describes the last time the user account was enabled. The value is
-- determined as epoch time in milliseconds.
getUserResponse_lastEnabledTime :: Lens.Lens' GetUserResponse (Prelude.Maybe Prelude.Integer)
getUserResponse_lastEnabledTime :: Lens' GetUserResponse (Maybe Integer)
getUserResponse_lastEnabledTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe Integer
lastEnabledTime :: Maybe Integer
$sel:lastEnabledTime:GetUserResponse' :: GetUserResponse -> Maybe Integer
lastEnabledTime} -> Maybe Integer
lastEnabledTime) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe Integer
a -> GetUserResponse
s {$sel:lastEnabledTime:GetUserResponse' :: Maybe Integer
lastEnabledTime = Maybe Integer
a} :: GetUserResponse)

-- | Describes the last time that the user logged into their account. The
-- value is determined as epoch time in milliseconds.
getUserResponse_lastLoginTime :: Lens.Lens' GetUserResponse (Prelude.Maybe Prelude.Integer)
getUserResponse_lastLoginTime :: Lens' GetUserResponse (Maybe Integer)
getUserResponse_lastLoginTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe Integer
lastLoginTime :: Maybe Integer
$sel:lastLoginTime:GetUserResponse' :: GetUserResponse -> Maybe Integer
lastLoginTime} -> Maybe Integer
lastLoginTime) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe Integer
a -> GetUserResponse
s {$sel:lastLoginTime:GetUserResponse' :: Maybe Integer
lastLoginTime = Maybe Integer
a} :: GetUserResponse)

-- | Describes the last time the user account was updated. The value is
-- determined as epoch time in milliseconds.
getUserResponse_lastModifiedTime :: Lens.Lens' GetUserResponse (Prelude.Maybe Prelude.Integer)
getUserResponse_lastModifiedTime :: Lens' GetUserResponse (Maybe Integer)
getUserResponse_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe Integer
lastModifiedTime :: Maybe Integer
$sel:lastModifiedTime:GetUserResponse' :: GetUserResponse -> Maybe Integer
lastModifiedTime} -> Maybe Integer
lastModifiedTime) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe Integer
a -> GetUserResponse
s {$sel:lastModifiedTime:GetUserResponse' :: Maybe Integer
lastModifiedTime = Maybe Integer
a} :: GetUserResponse)

-- | The last name of the user.
getUserResponse_lastName :: Lens.Lens' GetUserResponse (Prelude.Maybe Prelude.Text)
getUserResponse_lastName :: Lens' GetUserResponse (Maybe Text)
getUserResponse_lastName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe (Sensitive Text)
lastName :: Maybe (Sensitive Text)
$sel:lastName:GetUserResponse' :: GetUserResponse -> Maybe (Sensitive Text)
lastName} -> Maybe (Sensitive Text)
lastName) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe (Sensitive Text)
a -> GetUserResponse
s {$sel:lastName:GetUserResponse' :: Maybe (Sensitive Text)
lastName = Maybe (Sensitive 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The current status of the user account.
--
-- -   @CREATING@ – The user account creation is in progress.
--
-- -   @ENABLED@ – The user account is created and is currently active.
--
-- -   @DISABLED@ – The user account is currently inactive.
getUserResponse_status :: Lens.Lens' GetUserResponse (Prelude.Maybe UserStatus)
getUserResponse_status :: Lens' GetUserResponse (Maybe UserStatus)
getUserResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe UserStatus
status :: Maybe UserStatus
$sel:status:GetUserResponse' :: GetUserResponse -> Maybe UserStatus
status} -> Maybe UserStatus
status) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe UserStatus
a -> GetUserResponse
s {$sel:status:GetUserResponse' :: Maybe UserStatus
status = Maybe UserStatus
a} :: GetUserResponse)

-- | Indicates the type of user.
--
-- -   @SUPER_USER@ – A user with permission to all the functionality and
--     data in FinSpace.
--
-- -   @APP_USER@ – A user with specific permissions in FinSpace. The users
--     are assigned permissions by adding them to a permission group.
getUserResponse_type :: Lens.Lens' GetUserResponse (Prelude.Maybe UserType)
getUserResponse_type :: Lens' GetUserResponse (Maybe UserType)
getUserResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe UserType
type' :: Maybe UserType
$sel:type':GetUserResponse' :: GetUserResponse -> Maybe UserType
type'} -> Maybe UserType
type') (\s :: GetUserResponse
s@GetUserResponse' {} Maybe UserType
a -> GetUserResponse
s {$sel:type':GetUserResponse' :: Maybe UserType
type' = Maybe UserType
a} :: GetUserResponse)

-- | The unique identifier for the user account that is retrieved.
getUserResponse_userId :: Lens.Lens' GetUserResponse (Prelude.Maybe Prelude.Text)
getUserResponse_userId :: Lens' GetUserResponse (Maybe Text)
getUserResponse_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {Maybe Text
userId :: Maybe Text
$sel:userId:GetUserResponse' :: GetUserResponse -> Maybe Text
userId} -> Maybe Text
userId) (\s :: GetUserResponse
s@GetUserResponse' {} Maybe Text
a -> GetUserResponse
s {$sel:userId:GetUserResponse' :: Maybe Text
userId = Maybe Text
a} :: GetUserResponse)

-- | 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)

instance Prelude.NFData GetUserResponse where
  rnf :: GetUserResponse -> ()
rnf GetUserResponse' {Int
Maybe Integer
Maybe Text
Maybe (Sensitive Text)
Maybe ApiAccess
Maybe UserStatus
Maybe UserType
httpStatus :: Int
userId :: Maybe Text
type' :: Maybe UserType
status :: Maybe UserStatus
lastName :: Maybe (Sensitive Text)
lastModifiedTime :: Maybe Integer
lastLoginTime :: Maybe Integer
lastEnabledTime :: Maybe Integer
lastDisabledTime :: Maybe Integer
firstName :: Maybe (Sensitive Text)
emailAddress :: Maybe (Sensitive Text)
createTime :: Maybe Integer
apiAccessPrincipalArn :: Maybe Text
apiAccess :: Maybe ApiAccess
$sel:httpStatus:GetUserResponse' :: GetUserResponse -> Int
$sel:userId:GetUserResponse' :: GetUserResponse -> Maybe Text
$sel:type':GetUserResponse' :: GetUserResponse -> Maybe UserType
$sel:status:GetUserResponse' :: GetUserResponse -> Maybe UserStatus
$sel:lastName:GetUserResponse' :: GetUserResponse -> Maybe (Sensitive Text)
$sel:lastModifiedTime:GetUserResponse' :: GetUserResponse -> Maybe Integer
$sel:lastLoginTime:GetUserResponse' :: GetUserResponse -> Maybe Integer
$sel:lastEnabledTime:GetUserResponse' :: GetUserResponse -> Maybe Integer
$sel:lastDisabledTime:GetUserResponse' :: GetUserResponse -> Maybe Integer
$sel:firstName:GetUserResponse' :: GetUserResponse -> Maybe (Sensitive Text)
$sel:emailAddress:GetUserResponse' :: GetUserResponse -> Maybe (Sensitive Text)
$sel:createTime:GetUserResponse' :: GetUserResponse -> Maybe Integer
$sel:apiAccessPrincipalArn:GetUserResponse' :: GetUserResponse -> Maybe Text
$sel:apiAccess:GetUserResponse' :: GetUserResponse -> Maybe ApiAccess
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ApiAccess
apiAccess
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
apiAccessPrincipalArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
createTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
emailAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
firstName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
lastDisabledTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
lastEnabledTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
lastLoginTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
lastModifiedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
lastName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UserStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UserType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus