{-# 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.SageMaker.DescribeUserProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes a user profile. For more information, see @CreateUserProfile@.
module Amazonka.SageMaker.DescribeUserProfile
  ( -- * Creating a Request
    DescribeUserProfile (..),
    newDescribeUserProfile,

    -- * Request Lenses
    describeUserProfile_domainId,
    describeUserProfile_userProfileName,

    -- * Destructuring the Response
    DescribeUserProfileResponse (..),
    newDescribeUserProfileResponse,

    -- * Response Lenses
    describeUserProfileResponse_creationTime,
    describeUserProfileResponse_domainId,
    describeUserProfileResponse_failureReason,
    describeUserProfileResponse_homeEfsFileSystemUid,
    describeUserProfileResponse_lastModifiedTime,
    describeUserProfileResponse_singleSignOnUserIdentifier,
    describeUserProfileResponse_singleSignOnUserValue,
    describeUserProfileResponse_status,
    describeUserProfileResponse_userProfileArn,
    describeUserProfileResponse_userProfileName,
    describeUserProfileResponse_userSettings,
    describeUserProfileResponse_httpStatus,
  )
where

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
import Amazonka.SageMaker.Types

-- | /See:/ 'newDescribeUserProfile' smart constructor.
data DescribeUserProfile = DescribeUserProfile'
  { -- | The domain ID.
    DescribeUserProfile -> Text
domainId :: Prelude.Text,
    -- | The user profile name. This value is not case sensitive.
    DescribeUserProfile -> Text
userProfileName :: Prelude.Text
  }
  deriving (DescribeUserProfile -> DescribeUserProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeUserProfile -> DescribeUserProfile -> Bool
$c/= :: DescribeUserProfile -> DescribeUserProfile -> Bool
== :: DescribeUserProfile -> DescribeUserProfile -> Bool
$c== :: DescribeUserProfile -> DescribeUserProfile -> Bool
Prelude.Eq, ReadPrec [DescribeUserProfile]
ReadPrec DescribeUserProfile
Int -> ReadS DescribeUserProfile
ReadS [DescribeUserProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeUserProfile]
$creadListPrec :: ReadPrec [DescribeUserProfile]
readPrec :: ReadPrec DescribeUserProfile
$creadPrec :: ReadPrec DescribeUserProfile
readList :: ReadS [DescribeUserProfile]
$creadList :: ReadS [DescribeUserProfile]
readsPrec :: Int -> ReadS DescribeUserProfile
$creadsPrec :: Int -> ReadS DescribeUserProfile
Prelude.Read, Int -> DescribeUserProfile -> ShowS
[DescribeUserProfile] -> ShowS
DescribeUserProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeUserProfile] -> ShowS
$cshowList :: [DescribeUserProfile] -> ShowS
show :: DescribeUserProfile -> String
$cshow :: DescribeUserProfile -> String
showsPrec :: Int -> DescribeUserProfile -> ShowS
$cshowsPrec :: Int -> DescribeUserProfile -> ShowS
Prelude.Show, forall x. Rep DescribeUserProfile x -> DescribeUserProfile
forall x. DescribeUserProfile -> Rep DescribeUserProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeUserProfile x -> DescribeUserProfile
$cfrom :: forall x. DescribeUserProfile -> Rep DescribeUserProfile x
Prelude.Generic)

-- |
-- Create a value of 'DescribeUserProfile' 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:
--
-- 'domainId', 'describeUserProfile_domainId' - The domain ID.
--
-- 'userProfileName', 'describeUserProfile_userProfileName' - The user profile name. This value is not case sensitive.
newDescribeUserProfile ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'userProfileName'
  Prelude.Text ->
  DescribeUserProfile
newDescribeUserProfile :: Text -> Text -> DescribeUserProfile
newDescribeUserProfile Text
pDomainId_ Text
pUserProfileName_ =
  DescribeUserProfile'
    { $sel:domainId:DescribeUserProfile' :: Text
domainId = Text
pDomainId_,
      $sel:userProfileName:DescribeUserProfile' :: Text
userProfileName = Text
pUserProfileName_
    }

-- | The domain ID.
describeUserProfile_domainId :: Lens.Lens' DescribeUserProfile Prelude.Text
describeUserProfile_domainId :: Lens' DescribeUserProfile Text
describeUserProfile_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfile' {Text
domainId :: Text
$sel:domainId:DescribeUserProfile' :: DescribeUserProfile -> Text
domainId} -> Text
domainId) (\s :: DescribeUserProfile
s@DescribeUserProfile' {} Text
a -> DescribeUserProfile
s {$sel:domainId:DescribeUserProfile' :: Text
domainId = Text
a} :: DescribeUserProfile)

-- | The user profile name. This value is not case sensitive.
describeUserProfile_userProfileName :: Lens.Lens' DescribeUserProfile Prelude.Text
describeUserProfile_userProfileName :: Lens' DescribeUserProfile Text
describeUserProfile_userProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfile' {Text
userProfileName :: Text
$sel:userProfileName:DescribeUserProfile' :: DescribeUserProfile -> Text
userProfileName} -> Text
userProfileName) (\s :: DescribeUserProfile
s@DescribeUserProfile' {} Text
a -> DescribeUserProfile
s {$sel:userProfileName:DescribeUserProfile' :: Text
userProfileName = Text
a} :: DescribeUserProfile)

instance Core.AWSRequest DescribeUserProfile where
  type
    AWSResponse DescribeUserProfile =
      DescribeUserProfileResponse
  request :: (Service -> Service)
-> DescribeUserProfile -> Request DescribeUserProfile
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 DescribeUserProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeUserProfile)))
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 POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe UserProfileStatus
-> Maybe Text
-> Maybe Text
-> Maybe UserSettings
-> Int
-> DescribeUserProfileResponse
DescribeUserProfileResponse'
            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
"CreationTime")
            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
"DomainId")
            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
"FailureReason")
            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
"HomeEfsFileSystemUid")
            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
"SingleSignOnUserIdentifier")
            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
"SingleSignOnUserValue")
            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
"UserProfileArn")
            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
"UserProfileName")
            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
"UserSettings")
            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 DescribeUserProfile where
  hashWithSalt :: Int -> DescribeUserProfile -> Int
hashWithSalt Int
_salt DescribeUserProfile' {Text
userProfileName :: Text
domainId :: Text
$sel:userProfileName:DescribeUserProfile' :: DescribeUserProfile -> Text
$sel:domainId:DescribeUserProfile' :: DescribeUserProfile -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userProfileName

instance Prelude.NFData DescribeUserProfile where
  rnf :: DescribeUserProfile -> ()
rnf DescribeUserProfile' {Text
userProfileName :: Text
domainId :: Text
$sel:userProfileName:DescribeUserProfile' :: DescribeUserProfile -> Text
$sel:domainId:DescribeUserProfile' :: DescribeUserProfile -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userProfileName

instance Data.ToHeaders DescribeUserProfile where
  toHeaders :: DescribeUserProfile -> 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
"SageMaker.DescribeUserProfile" ::
                          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 DescribeUserProfile where
  toJSON :: DescribeUserProfile -> Value
toJSON DescribeUserProfile' {Text
userProfileName :: Text
domainId :: Text
$sel:userProfileName:DescribeUserProfile' :: DescribeUserProfile -> Text
$sel:domainId:DescribeUserProfile' :: DescribeUserProfile -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"DomainId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"UserProfileName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userProfileName)
          ]
      )

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

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

-- | /See:/ 'newDescribeUserProfileResponse' smart constructor.
data DescribeUserProfileResponse = DescribeUserProfileResponse'
  { -- | The creation time.
    DescribeUserProfileResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The ID of the domain that contains the profile.
    DescribeUserProfileResponse -> Maybe Text
domainId :: Prelude.Maybe Prelude.Text,
    -- | The failure reason.
    DescribeUserProfileResponse -> Maybe Text
failureReason :: Prelude.Maybe Prelude.Text,
    -- | The ID of the user\'s profile in the Amazon Elastic File System (EFS)
    -- volume.
    DescribeUserProfileResponse -> Maybe Text
homeEfsFileSystemUid :: Prelude.Maybe Prelude.Text,
    -- | The last modified time.
    DescribeUserProfileResponse -> Maybe POSIX
lastModifiedTime :: Prelude.Maybe Data.POSIX,
    -- | The IAM Identity Center user identifier.
    DescribeUserProfileResponse -> Maybe Text
singleSignOnUserIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The IAM Identity Center user value.
    DescribeUserProfileResponse -> Maybe Text
singleSignOnUserValue :: Prelude.Maybe Prelude.Text,
    -- | The status.
    DescribeUserProfileResponse -> Maybe UserProfileStatus
status :: Prelude.Maybe UserProfileStatus,
    -- | The user profile Amazon Resource Name (ARN).
    DescribeUserProfileResponse -> Maybe Text
userProfileArn :: Prelude.Maybe Prelude.Text,
    -- | The user profile name.
    DescribeUserProfileResponse -> Maybe Text
userProfileName :: Prelude.Maybe Prelude.Text,
    -- | A collection of settings.
    DescribeUserProfileResponse -> Maybe UserSettings
userSettings :: Prelude.Maybe UserSettings,
    -- | The response's http status code.
    DescribeUserProfileResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeUserProfileResponse -> DescribeUserProfileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeUserProfileResponse -> DescribeUserProfileResponse -> Bool
$c/= :: DescribeUserProfileResponse -> DescribeUserProfileResponse -> Bool
== :: DescribeUserProfileResponse -> DescribeUserProfileResponse -> Bool
$c== :: DescribeUserProfileResponse -> DescribeUserProfileResponse -> Bool
Prelude.Eq, ReadPrec [DescribeUserProfileResponse]
ReadPrec DescribeUserProfileResponse
Int -> ReadS DescribeUserProfileResponse
ReadS [DescribeUserProfileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeUserProfileResponse]
$creadListPrec :: ReadPrec [DescribeUserProfileResponse]
readPrec :: ReadPrec DescribeUserProfileResponse
$creadPrec :: ReadPrec DescribeUserProfileResponse
readList :: ReadS [DescribeUserProfileResponse]
$creadList :: ReadS [DescribeUserProfileResponse]
readsPrec :: Int -> ReadS DescribeUserProfileResponse
$creadsPrec :: Int -> ReadS DescribeUserProfileResponse
Prelude.Read, Int -> DescribeUserProfileResponse -> ShowS
[DescribeUserProfileResponse] -> ShowS
DescribeUserProfileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeUserProfileResponse] -> ShowS
$cshowList :: [DescribeUserProfileResponse] -> ShowS
show :: DescribeUserProfileResponse -> String
$cshow :: DescribeUserProfileResponse -> String
showsPrec :: Int -> DescribeUserProfileResponse -> ShowS
$cshowsPrec :: Int -> DescribeUserProfileResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeUserProfileResponse x -> DescribeUserProfileResponse
forall x.
DescribeUserProfileResponse -> Rep DescribeUserProfileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeUserProfileResponse x -> DescribeUserProfileResponse
$cfrom :: forall x.
DescribeUserProfileResponse -> Rep DescribeUserProfileResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeUserProfileResponse' 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:
--
-- 'creationTime', 'describeUserProfileResponse_creationTime' - The creation time.
--
-- 'domainId', 'describeUserProfileResponse_domainId' - The ID of the domain that contains the profile.
--
-- 'failureReason', 'describeUserProfileResponse_failureReason' - The failure reason.
--
-- 'homeEfsFileSystemUid', 'describeUserProfileResponse_homeEfsFileSystemUid' - The ID of the user\'s profile in the Amazon Elastic File System (EFS)
-- volume.
--
-- 'lastModifiedTime', 'describeUserProfileResponse_lastModifiedTime' - The last modified time.
--
-- 'singleSignOnUserIdentifier', 'describeUserProfileResponse_singleSignOnUserIdentifier' - The IAM Identity Center user identifier.
--
-- 'singleSignOnUserValue', 'describeUserProfileResponse_singleSignOnUserValue' - The IAM Identity Center user value.
--
-- 'status', 'describeUserProfileResponse_status' - The status.
--
-- 'userProfileArn', 'describeUserProfileResponse_userProfileArn' - The user profile Amazon Resource Name (ARN).
--
-- 'userProfileName', 'describeUserProfileResponse_userProfileName' - The user profile name.
--
-- 'userSettings', 'describeUserProfileResponse_userSettings' - A collection of settings.
--
-- 'httpStatus', 'describeUserProfileResponse_httpStatus' - The response's http status code.
newDescribeUserProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeUserProfileResponse
newDescribeUserProfileResponse :: Int -> DescribeUserProfileResponse
newDescribeUserProfileResponse Int
pHttpStatus_ =
  DescribeUserProfileResponse'
    { $sel:creationTime:DescribeUserProfileResponse' :: Maybe POSIX
creationTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainId:DescribeUserProfileResponse' :: Maybe Text
domainId = forall a. Maybe a
Prelude.Nothing,
      $sel:failureReason:DescribeUserProfileResponse' :: Maybe Text
failureReason = forall a. Maybe a
Prelude.Nothing,
      $sel:homeEfsFileSystemUid:DescribeUserProfileResponse' :: Maybe Text
homeEfsFileSystemUid = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTime:DescribeUserProfileResponse' :: Maybe POSIX
lastModifiedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:singleSignOnUserIdentifier:DescribeUserProfileResponse' :: Maybe Text
singleSignOnUserIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:singleSignOnUserValue:DescribeUserProfileResponse' :: Maybe Text
singleSignOnUserValue = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeUserProfileResponse' :: Maybe UserProfileStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:userProfileArn:DescribeUserProfileResponse' :: Maybe Text
userProfileArn = forall a. Maybe a
Prelude.Nothing,
      $sel:userProfileName:DescribeUserProfileResponse' :: Maybe Text
userProfileName = forall a. Maybe a
Prelude.Nothing,
      $sel:userSettings:DescribeUserProfileResponse' :: Maybe UserSettings
userSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeUserProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The creation time.
describeUserProfileResponse_creationTime :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe Prelude.UTCTime)
describeUserProfileResponse_creationTime :: Lens' DescribeUserProfileResponse (Maybe UTCTime)
describeUserProfileResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe POSIX
a -> DescribeUserProfileResponse
s {$sel:creationTime:DescribeUserProfileResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: DescribeUserProfileResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The ID of the domain that contains the profile.
describeUserProfileResponse_domainId :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe Prelude.Text)
describeUserProfileResponse_domainId :: Lens' DescribeUserProfileResponse (Maybe Text)
describeUserProfileResponse_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe Text
domainId :: Maybe Text
$sel:domainId:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
domainId} -> Maybe Text
domainId) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe Text
a -> DescribeUserProfileResponse
s {$sel:domainId:DescribeUserProfileResponse' :: Maybe Text
domainId = Maybe Text
a} :: DescribeUserProfileResponse)

-- | The failure reason.
describeUserProfileResponse_failureReason :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe Prelude.Text)
describeUserProfileResponse_failureReason :: Lens' DescribeUserProfileResponse (Maybe Text)
describeUserProfileResponse_failureReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe Text
failureReason :: Maybe Text
$sel:failureReason:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
failureReason} -> Maybe Text
failureReason) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe Text
a -> DescribeUserProfileResponse
s {$sel:failureReason:DescribeUserProfileResponse' :: Maybe Text
failureReason = Maybe Text
a} :: DescribeUserProfileResponse)

-- | The ID of the user\'s profile in the Amazon Elastic File System (EFS)
-- volume.
describeUserProfileResponse_homeEfsFileSystemUid :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe Prelude.Text)
describeUserProfileResponse_homeEfsFileSystemUid :: Lens' DescribeUserProfileResponse (Maybe Text)
describeUserProfileResponse_homeEfsFileSystemUid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe Text
homeEfsFileSystemUid :: Maybe Text
$sel:homeEfsFileSystemUid:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
homeEfsFileSystemUid} -> Maybe Text
homeEfsFileSystemUid) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe Text
a -> DescribeUserProfileResponse
s {$sel:homeEfsFileSystemUid:DescribeUserProfileResponse' :: Maybe Text
homeEfsFileSystemUid = Maybe Text
a} :: DescribeUserProfileResponse)

-- | The last modified time.
describeUserProfileResponse_lastModifiedTime :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe Prelude.UTCTime)
describeUserProfileResponse_lastModifiedTime :: Lens' DescribeUserProfileResponse (Maybe UTCTime)
describeUserProfileResponse_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe POSIX
lastModifiedTime :: Maybe POSIX
$sel:lastModifiedTime:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe POSIX
lastModifiedTime} -> Maybe POSIX
lastModifiedTime) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe POSIX
a -> DescribeUserProfileResponse
s {$sel:lastModifiedTime:DescribeUserProfileResponse' :: Maybe POSIX
lastModifiedTime = Maybe POSIX
a} :: DescribeUserProfileResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The IAM Identity Center user identifier.
describeUserProfileResponse_singleSignOnUserIdentifier :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe Prelude.Text)
describeUserProfileResponse_singleSignOnUserIdentifier :: Lens' DescribeUserProfileResponse (Maybe Text)
describeUserProfileResponse_singleSignOnUserIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe Text
singleSignOnUserIdentifier :: Maybe Text
$sel:singleSignOnUserIdentifier:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
singleSignOnUserIdentifier} -> Maybe Text
singleSignOnUserIdentifier) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe Text
a -> DescribeUserProfileResponse
s {$sel:singleSignOnUserIdentifier:DescribeUserProfileResponse' :: Maybe Text
singleSignOnUserIdentifier = Maybe Text
a} :: DescribeUserProfileResponse)

-- | The IAM Identity Center user value.
describeUserProfileResponse_singleSignOnUserValue :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe Prelude.Text)
describeUserProfileResponse_singleSignOnUserValue :: Lens' DescribeUserProfileResponse (Maybe Text)
describeUserProfileResponse_singleSignOnUserValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe Text
singleSignOnUserValue :: Maybe Text
$sel:singleSignOnUserValue:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
singleSignOnUserValue} -> Maybe Text
singleSignOnUserValue) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe Text
a -> DescribeUserProfileResponse
s {$sel:singleSignOnUserValue:DescribeUserProfileResponse' :: Maybe Text
singleSignOnUserValue = Maybe Text
a} :: DescribeUserProfileResponse)

-- | The status.
describeUserProfileResponse_status :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe UserProfileStatus)
describeUserProfileResponse_status :: Lens' DescribeUserProfileResponse (Maybe UserProfileStatus)
describeUserProfileResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe UserProfileStatus
status :: Maybe UserProfileStatus
$sel:status:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe UserProfileStatus
status} -> Maybe UserProfileStatus
status) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe UserProfileStatus
a -> DescribeUserProfileResponse
s {$sel:status:DescribeUserProfileResponse' :: Maybe UserProfileStatus
status = Maybe UserProfileStatus
a} :: DescribeUserProfileResponse)

-- | The user profile Amazon Resource Name (ARN).
describeUserProfileResponse_userProfileArn :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe Prelude.Text)
describeUserProfileResponse_userProfileArn :: Lens' DescribeUserProfileResponse (Maybe Text)
describeUserProfileResponse_userProfileArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe Text
userProfileArn :: Maybe Text
$sel:userProfileArn:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
userProfileArn} -> Maybe Text
userProfileArn) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe Text
a -> DescribeUserProfileResponse
s {$sel:userProfileArn:DescribeUserProfileResponse' :: Maybe Text
userProfileArn = Maybe Text
a} :: DescribeUserProfileResponse)

-- | The user profile name.
describeUserProfileResponse_userProfileName :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe Prelude.Text)
describeUserProfileResponse_userProfileName :: Lens' DescribeUserProfileResponse (Maybe Text)
describeUserProfileResponse_userProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe Text
userProfileName :: Maybe Text
$sel:userProfileName:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
userProfileName} -> Maybe Text
userProfileName) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe Text
a -> DescribeUserProfileResponse
s {$sel:userProfileName:DescribeUserProfileResponse' :: Maybe Text
userProfileName = Maybe Text
a} :: DescribeUserProfileResponse)

-- | A collection of settings.
describeUserProfileResponse_userSettings :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe UserSettings)
describeUserProfileResponse_userSettings :: Lens' DescribeUserProfileResponse (Maybe UserSettings)
describeUserProfileResponse_userSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe UserSettings
userSettings :: Maybe UserSettings
$sel:userSettings:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe UserSettings
userSettings} -> Maybe UserSettings
userSettings) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe UserSettings
a -> DescribeUserProfileResponse
s {$sel:userSettings:DescribeUserProfileResponse' :: Maybe UserSettings
userSettings = Maybe UserSettings
a} :: DescribeUserProfileResponse)

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

instance Prelude.NFData DescribeUserProfileResponse where
  rnf :: DescribeUserProfileResponse -> ()
rnf DescribeUserProfileResponse' {Int
Maybe Text
Maybe POSIX
Maybe UserProfileStatus
Maybe UserSettings
httpStatus :: Int
userSettings :: Maybe UserSettings
userProfileName :: Maybe Text
userProfileArn :: Maybe Text
status :: Maybe UserProfileStatus
singleSignOnUserValue :: Maybe Text
singleSignOnUserIdentifier :: Maybe Text
lastModifiedTime :: Maybe POSIX
homeEfsFileSystemUid :: Maybe Text
failureReason :: Maybe Text
domainId :: Maybe Text
creationTime :: Maybe POSIX
$sel:httpStatus:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Int
$sel:userSettings:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe UserSettings
$sel:userProfileName:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
$sel:userProfileArn:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
$sel:status:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe UserProfileStatus
$sel:singleSignOnUserValue:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
$sel:singleSignOnUserIdentifier:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
$sel:lastModifiedTime:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe POSIX
$sel:homeEfsFileSystemUid:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
$sel:failureReason:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
$sel:domainId:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
$sel:creationTime:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
failureReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
homeEfsFileSystemUid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
singleSignOnUserIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
singleSignOnUserValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UserProfileStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userProfileArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userProfileName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UserSettings
userSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus