{-# 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.IAM.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 information about the specified IAM user, including the
-- user\'s creation date, path, unique ID, and ARN.
--
-- If you do not specify a user name, IAM determines the user name
-- implicitly based on the Amazon Web Services access key ID used to sign
-- the request to this operation.
module Amazonka.IAM.GetUser
  ( -- * Creating a Request
    GetUser (..),
    newGetUser,

    -- * Request Lenses
    getUser_userName,

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

    -- * Response Lenses
    getUserResponse_httpStatus,
    getUserResponse_user,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IAM.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 name of the user to get information about.
    --
    -- This parameter is optional. If it is not included, it defaults to the
    -- user making the request. This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of upper and lowercase alphanumeric characters with no
    -- spaces. You can also include any of the following characters: _+=,.\@-
    GetUser -> Maybe Text
userName :: Prelude.Maybe 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:
--
-- 'userName', 'getUser_userName' - The name of the user to get information about.
--
-- This parameter is optional. If it is not included, it defaults to the
-- user making the request. This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
newGetUser ::
  GetUser
newGetUser :: GetUser
newGetUser = GetUser' {$sel:userName:GetUser' :: Maybe Text
userName = forall a. Maybe a
Prelude.Nothing}

-- | The name of the user to get information about.
--
-- This parameter is optional. If it is not included, it defaults to the
-- user making the request. This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
getUser_userName :: Lens.Lens' GetUser (Prelude.Maybe Prelude.Text)
getUser_userName :: Lens' GetUser (Maybe Text)
getUser_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUser' {Maybe Text
userName :: Maybe Text
$sel:userName:GetUser' :: GetUser -> Maybe Text
userName} -> Maybe Text
userName) (\s :: GetUser
s@GetUser' {} Maybe Text
a -> GetUser
s {$sel:userName:GetUser' :: Maybe Text
userName = Maybe 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.postQuery (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 =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetUserResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> User -> GetUserResponse
GetUserResponse'
            forall (f :: * -> *) a b. Functor 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.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"User")
      )

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

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

instance Data.ToHeaders GetUser where
  toHeaders :: GetUser -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery GetUser where
  toQuery :: GetUser -> QueryString
toQuery GetUser' {Maybe Text
userName :: Maybe Text
$sel:userName:GetUser' :: GetUser -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetUser" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"UserName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
userName
      ]

-- | Contains the response to a successful GetUser request.
--
-- /See:/ 'newGetUserResponse' smart constructor.
data GetUserResponse = GetUserResponse'
  { -- | The response's http status code.
    GetUserResponse -> Int
httpStatus :: Prelude.Int,
    -- | A structure containing details about the IAM user.
    --
    -- Due to a service issue, password last used data does not include
    -- password use from May 3, 2018 22:50 PDT to May 23, 2018 14:08 PDT. This
    -- affects
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_finding-unused.html last sign-in>
    -- dates shown in the IAM console and password last used dates in the
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_getting-report.html IAM credential report>,
    -- and returned by this operation. If users signed in during the affected
    -- time, the password last used date that is returned is the date the user
    -- last signed in before May 3, 2018. For users that signed in after May
    -- 23, 2018 14:08 PDT, the returned password last used date is accurate.
    --
    -- You can use password last used information to identify unused
    -- credentials for deletion. For example, you might delete users who did
    -- not sign in to Amazon Web Services in the last 90 days. In cases like
    -- this, we recommend that you adjust your evaluation window to include
    -- dates after May 23, 2018. Alternatively, if your users use access keys
    -- to access Amazon Web Services programmatically you can refer to access
    -- key last used information because it is accurate for all dates.
    GetUserResponse -> User
user :: User
  }
  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, ReadPrec [GetUserResponse]
ReadPrec GetUserResponse
Int -> ReadS GetUserResponse
ReadS [GetUserResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUserResponse]
$creadListPrec :: ReadPrec [GetUserResponse]
readPrec :: ReadPrec GetUserResponse
$creadPrec :: ReadPrec GetUserResponse
readList :: ReadS [GetUserResponse]
$creadList :: ReadS [GetUserResponse]
readsPrec :: Int -> ReadS GetUserResponse
$creadsPrec :: Int -> ReadS GetUserResponse
Prelude.Read, 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:
--
-- 'httpStatus', 'getUserResponse_httpStatus' - The response's http status code.
--
-- 'user', 'getUserResponse_user' - A structure containing details about the IAM user.
--
-- Due to a service issue, password last used data does not include
-- password use from May 3, 2018 22:50 PDT to May 23, 2018 14:08 PDT. This
-- affects
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_finding-unused.html last sign-in>
-- dates shown in the IAM console and password last used dates in the
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_getting-report.html IAM credential report>,
-- and returned by this operation. If users signed in during the affected
-- time, the password last used date that is returned is the date the user
-- last signed in before May 3, 2018. For users that signed in after May
-- 23, 2018 14:08 PDT, the returned password last used date is accurate.
--
-- You can use password last used information to identify unused
-- credentials for deletion. For example, you might delete users who did
-- not sign in to Amazon Web Services in the last 90 days. In cases like
-- this, we recommend that you adjust your evaluation window to include
-- dates after May 23, 2018. Alternatively, if your users use access keys
-- to access Amazon Web Services programmatically you can refer to access
-- key last used information because it is accurate for all dates.
newGetUserResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'user'
  User ->
  GetUserResponse
newGetUserResponse :: Int -> User -> GetUserResponse
newGetUserResponse Int
pHttpStatus_ User
pUser_ =
  GetUserResponse'
    { $sel:httpStatus:GetUserResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:user:GetUserResponse' :: User
user = User
pUser_
    }

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

-- | A structure containing details about the IAM user.
--
-- Due to a service issue, password last used data does not include
-- password use from May 3, 2018 22:50 PDT to May 23, 2018 14:08 PDT. This
-- affects
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_finding-unused.html last sign-in>
-- dates shown in the IAM console and password last used dates in the
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_getting-report.html IAM credential report>,
-- and returned by this operation. If users signed in during the affected
-- time, the password last used date that is returned is the date the user
-- last signed in before May 3, 2018. For users that signed in after May
-- 23, 2018 14:08 PDT, the returned password last used date is accurate.
--
-- You can use password last used information to identify unused
-- credentials for deletion. For example, you might delete users who did
-- not sign in to Amazon Web Services in the last 90 days. In cases like
-- this, we recommend that you adjust your evaluation window to include
-- dates after May 23, 2018. Alternatively, if your users use access keys
-- to access Amazon Web Services programmatically you can refer to access
-- key last used information because it is accurate for all dates.
getUserResponse_user :: Lens.Lens' GetUserResponse User
getUserResponse_user :: Lens' GetUserResponse User
getUserResponse_user = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserResponse' {User
user :: User
$sel:user:GetUserResponse' :: GetUserResponse -> User
user} -> User
user) (\s :: GetUserResponse
s@GetUserResponse' {} User
a -> GetUserResponse
s {$sel:user:GetUserResponse' :: User
user = User
a} :: GetUserResponse)

instance Prelude.NFData GetUserResponse where
  rnf :: GetUserResponse -> ()
rnf GetUserResponse' {Int
User
user :: User
httpStatus :: Int
$sel:user:GetUserResponse' :: GetUserResponse -> User
$sel:httpStatus:GetUserResponse' :: GetUserResponse -> Int
..} =
    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 User
user