{-# 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.CodeStar.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 in AWS CodeStar and the user attributes across all
-- projects.
module Amazonka.CodeStar.DescribeUserProfile
  ( -- * Creating a Request
    DescribeUserProfile (..),
    newDescribeUserProfile,

    -- * Request Lenses
    describeUserProfile_userArn,

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

    -- * Response Lenses
    describeUserProfileResponse_displayName,
    describeUserProfileResponse_emailAddress,
    describeUserProfileResponse_sshPublicKey,
    describeUserProfileResponse_httpStatus,
    describeUserProfileResponse_userArn,
    describeUserProfileResponse_createdTimestamp,
    describeUserProfileResponse_lastModifiedTimestamp,
  )
where

import Amazonka.CodeStar.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:/ 'newDescribeUserProfile' smart constructor.
data DescribeUserProfile = DescribeUserProfile'
  { -- | The Amazon Resource Name (ARN) of the user.
    DescribeUserProfile -> Text
userArn :: 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:
--
-- 'userArn', 'describeUserProfile_userArn' - The Amazon Resource Name (ARN) of the user.
newDescribeUserProfile ::
  -- | 'userArn'
  Prelude.Text ->
  DescribeUserProfile
newDescribeUserProfile :: Text -> DescribeUserProfile
newDescribeUserProfile Text
pUserArn_ =
  DescribeUserProfile' {$sel:userArn:DescribeUserProfile' :: Text
userArn = Text
pUserArn_}

-- | The Amazon Resource Name (ARN) of the user.
describeUserProfile_userArn :: Lens.Lens' DescribeUserProfile Prelude.Text
describeUserProfile_userArn :: Lens' DescribeUserProfile Text
describeUserProfile_userArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfile' {Text
userArn :: Text
$sel:userArn:DescribeUserProfile' :: DescribeUserProfile -> Text
userArn} -> Text
userArn) (\s :: DescribeUserProfile
s@DescribeUserProfile' {} Text
a -> DescribeUserProfile
s {$sel:userArn:DescribeUserProfile' :: Text
userArn = 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 (Sensitive Text)
-> Maybe (Sensitive Text)
-> Maybe Text
-> Int
-> Text
-> POSIX
-> POSIX
-> 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
"displayName")
            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
"sshPublicKey")
            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
"userArn")
            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
"createdTimestamp")
            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
"lastModifiedTimestamp")
      )

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

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

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
"CodeStar_20170419.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
userArn :: Text
$sel:userArn:DescribeUserProfile' :: DescribeUserProfile -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"userArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userArn)]
      )

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 display name shown for the user in AWS CodeStar projects. For
    -- example, this could be set to both first and last name (\"Mary Major\")
    -- or a single name (\"Mary\"). The display name is also used to generate
    -- the initial icon associated with the user in AWS CodeStar projects. If
    -- spaces are included in the display name, the first character that
    -- appears after the space will be used as the second character in the user
    -- initial icon. The initial icon displays a maximum of two characters, so
    -- a display name with more than one space (for example \"Mary Jane
    -- Major\") would generate an initial icon using the first character and
    -- the first character after the space (\"MJ\", not \"MM\").
    DescribeUserProfileResponse -> Maybe (Sensitive Text)
displayName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The email address for the user. Optional.
    DescribeUserProfileResponse -> Maybe (Sensitive Text)
emailAddress :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The SSH public key associated with the user. This SSH public key is
    -- associated with the user profile, and can be used in conjunction with
    -- the associated private key for access to project resources, such as
    -- Amazon EC2 instances, if a project owner grants remote access to those
    -- resources.
    DescribeUserProfileResponse -> Maybe Text
sshPublicKey :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeUserProfileResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the user.
    DescribeUserProfileResponse -> Text
userArn :: Prelude.Text,
    -- | The date and time when the user profile was created in AWS CodeStar, in
    -- timestamp format.
    DescribeUserProfileResponse -> POSIX
createdTimestamp :: Data.POSIX,
    -- | The date and time when the user profile was last modified, in timestamp
    -- format.
    DescribeUserProfileResponse -> POSIX
lastModifiedTimestamp :: Data.POSIX
  }
  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, 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:
--
-- 'displayName', 'describeUserProfileResponse_displayName' - The display name shown for the user in AWS CodeStar projects. For
-- example, this could be set to both first and last name (\"Mary Major\")
-- or a single name (\"Mary\"). The display name is also used to generate
-- the initial icon associated with the user in AWS CodeStar projects. If
-- spaces are included in the display name, the first character that
-- appears after the space will be used as the second character in the user
-- initial icon. The initial icon displays a maximum of two characters, so
-- a display name with more than one space (for example \"Mary Jane
-- Major\") would generate an initial icon using the first character and
-- the first character after the space (\"MJ\", not \"MM\").
--
-- 'emailAddress', 'describeUserProfileResponse_emailAddress' - The email address for the user. Optional.
--
-- 'sshPublicKey', 'describeUserProfileResponse_sshPublicKey' - The SSH public key associated with the user. This SSH public key is
-- associated with the user profile, and can be used in conjunction with
-- the associated private key for access to project resources, such as
-- Amazon EC2 instances, if a project owner grants remote access to those
-- resources.
--
-- 'httpStatus', 'describeUserProfileResponse_httpStatus' - The response's http status code.
--
-- 'userArn', 'describeUserProfileResponse_userArn' - The Amazon Resource Name (ARN) of the user.
--
-- 'createdTimestamp', 'describeUserProfileResponse_createdTimestamp' - The date and time when the user profile was created in AWS CodeStar, in
-- timestamp format.
--
-- 'lastModifiedTimestamp', 'describeUserProfileResponse_lastModifiedTimestamp' - The date and time when the user profile was last modified, in timestamp
-- format.
newDescribeUserProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'userArn'
  Prelude.Text ->
  -- | 'createdTimestamp'
  Prelude.UTCTime ->
  -- | 'lastModifiedTimestamp'
  Prelude.UTCTime ->
  DescribeUserProfileResponse
newDescribeUserProfileResponse :: Int -> Text -> UTCTime -> UTCTime -> DescribeUserProfileResponse
newDescribeUserProfileResponse
  Int
pHttpStatus_
  Text
pUserArn_
  UTCTime
pCreatedTimestamp_
  UTCTime
pLastModifiedTimestamp_ =
    DescribeUserProfileResponse'
      { $sel:displayName:DescribeUserProfileResponse' :: Maybe (Sensitive Text)
displayName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:emailAddress:DescribeUserProfileResponse' :: Maybe (Sensitive Text)
emailAddress = forall a. Maybe a
Prelude.Nothing,
        $sel:sshPublicKey:DescribeUserProfileResponse' :: Maybe Text
sshPublicKey = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeUserProfileResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:userArn:DescribeUserProfileResponse' :: Text
userArn = Text
pUserArn_,
        $sel:createdTimestamp:DescribeUserProfileResponse' :: POSIX
createdTimestamp =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedTimestamp_,
        $sel:lastModifiedTimestamp:DescribeUserProfileResponse' :: POSIX
lastModifiedTimestamp =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastModifiedTimestamp_
      }

-- | The display name shown for the user in AWS CodeStar projects. For
-- example, this could be set to both first and last name (\"Mary Major\")
-- or a single name (\"Mary\"). The display name is also used to generate
-- the initial icon associated with the user in AWS CodeStar projects. If
-- spaces are included in the display name, the first character that
-- appears after the space will be used as the second character in the user
-- initial icon. The initial icon displays a maximum of two characters, so
-- a display name with more than one space (for example \"Mary Jane
-- Major\") would generate an initial icon using the first character and
-- the first character after the space (\"MJ\", not \"MM\").
describeUserProfileResponse_displayName :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe Prelude.Text)
describeUserProfileResponse_displayName :: Lens' DescribeUserProfileResponse (Maybe Text)
describeUserProfileResponse_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe (Sensitive Text)
displayName :: Maybe (Sensitive Text)
$sel:displayName:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe (Sensitive Text)
displayName} -> Maybe (Sensitive Text)
displayName) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe (Sensitive Text)
a -> DescribeUserProfileResponse
s {$sel:displayName:DescribeUserProfileResponse' :: Maybe (Sensitive Text)
displayName = Maybe (Sensitive Text)
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. Iso' (Sensitive a) a
Data._Sensitive

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

-- | The SSH public key associated with the user. This SSH public key is
-- associated with the user profile, and can be used in conjunction with
-- the associated private key for access to project resources, such as
-- Amazon EC2 instances, if a project owner grants remote access to those
-- resources.
describeUserProfileResponse_sshPublicKey :: Lens.Lens' DescribeUserProfileResponse (Prelude.Maybe Prelude.Text)
describeUserProfileResponse_sshPublicKey :: Lens' DescribeUserProfileResponse (Maybe Text)
describeUserProfileResponse_sshPublicKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Maybe Text
sshPublicKey :: Maybe Text
$sel:sshPublicKey:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
sshPublicKey} -> Maybe Text
sshPublicKey) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Maybe Text
a -> DescribeUserProfileResponse
s {$sel:sshPublicKey:DescribeUserProfileResponse' :: Maybe Text
sshPublicKey = Maybe Text
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)

-- | The Amazon Resource Name (ARN) of the user.
describeUserProfileResponse_userArn :: Lens.Lens' DescribeUserProfileResponse Prelude.Text
describeUserProfileResponse_userArn :: Lens' DescribeUserProfileResponse Text
describeUserProfileResponse_userArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {Text
userArn :: Text
$sel:userArn:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Text
userArn} -> Text
userArn) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} Text
a -> DescribeUserProfileResponse
s {$sel:userArn:DescribeUserProfileResponse' :: Text
userArn = Text
a} :: DescribeUserProfileResponse)

-- | The date and time when the user profile was created in AWS CodeStar, in
-- timestamp format.
describeUserProfileResponse_createdTimestamp :: Lens.Lens' DescribeUserProfileResponse Prelude.UTCTime
describeUserProfileResponse_createdTimestamp :: Lens' DescribeUserProfileResponse UTCTime
describeUserProfileResponse_createdTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {POSIX
createdTimestamp :: POSIX
$sel:createdTimestamp:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> POSIX
createdTimestamp} -> POSIX
createdTimestamp) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} POSIX
a -> DescribeUserProfileResponse
s {$sel:createdTimestamp:DescribeUserProfileResponse' :: POSIX
createdTimestamp = POSIX
a} :: DescribeUserProfileResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The date and time when the user profile was last modified, in timestamp
-- format.
describeUserProfileResponse_lastModifiedTimestamp :: Lens.Lens' DescribeUserProfileResponse Prelude.UTCTime
describeUserProfileResponse_lastModifiedTimestamp :: Lens' DescribeUserProfileResponse UTCTime
describeUserProfileResponse_lastModifiedTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserProfileResponse' {POSIX
lastModifiedTimestamp :: POSIX
$sel:lastModifiedTimestamp:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> POSIX
lastModifiedTimestamp} -> POSIX
lastModifiedTimestamp) (\s :: DescribeUserProfileResponse
s@DescribeUserProfileResponse' {} POSIX
a -> DescribeUserProfileResponse
s {$sel:lastModifiedTimestamp:DescribeUserProfileResponse' :: POSIX
lastModifiedTimestamp = POSIX
a} :: DescribeUserProfileResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData DescribeUserProfileResponse where
  rnf :: DescribeUserProfileResponse -> ()
rnf DescribeUserProfileResponse' {Int
Maybe Text
Maybe (Sensitive Text)
Text
POSIX
lastModifiedTimestamp :: POSIX
createdTimestamp :: POSIX
userArn :: Text
httpStatus :: Int
sshPublicKey :: Maybe Text
emailAddress :: Maybe (Sensitive Text)
displayName :: Maybe (Sensitive Text)
$sel:lastModifiedTimestamp:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> POSIX
$sel:createdTimestamp:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> POSIX
$sel:userArn:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Text
$sel:httpStatus:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Int
$sel:sshPublicKey:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe Text
$sel:emailAddress:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe (Sensitive Text)
$sel:displayName:DescribeUserProfileResponse' :: DescribeUserProfileResponse -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
displayName
      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 Text
sshPublicKey
      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 Text
userArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
createdTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastModifiedTimestamp