{-# 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.GetAccessKeyLastUsed
-- 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 when the specified access key was last used.
-- The information includes the date and time of last use, along with the
-- Amazon Web Services service and Region that were specified in the last
-- request made with that key.
module Amazonka.IAM.GetAccessKeyLastUsed
  ( -- * Creating a Request
    GetAccessKeyLastUsed (..),
    newGetAccessKeyLastUsed,

    -- * Request Lenses
    getAccessKeyLastUsed_accessKeyId,

    -- * Destructuring the Response
    GetAccessKeyLastUsedResponse (..),
    newGetAccessKeyLastUsedResponse,

    -- * Response Lenses
    getAccessKeyLastUsedResponse_accessKeyLastUsed,
    getAccessKeyLastUsedResponse_userName,
    getAccessKeyLastUsedResponse_httpStatus,
  )
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:/ 'newGetAccessKeyLastUsed' smart constructor.
data GetAccessKeyLastUsed = GetAccessKeyLastUsed'
  { -- | The identifier of an access key.
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- that can consist of any upper or lowercased letter or digit.
    GetAccessKeyLastUsed -> AccessKey
accessKeyId :: Core.AccessKey
  }
  deriving (GetAccessKeyLastUsed -> GetAccessKeyLastUsed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAccessKeyLastUsed -> GetAccessKeyLastUsed -> Bool
$c/= :: GetAccessKeyLastUsed -> GetAccessKeyLastUsed -> Bool
== :: GetAccessKeyLastUsed -> GetAccessKeyLastUsed -> Bool
$c== :: GetAccessKeyLastUsed -> GetAccessKeyLastUsed -> Bool
Prelude.Eq, ReadPrec [GetAccessKeyLastUsed]
ReadPrec GetAccessKeyLastUsed
Int -> ReadS GetAccessKeyLastUsed
ReadS [GetAccessKeyLastUsed]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAccessKeyLastUsed]
$creadListPrec :: ReadPrec [GetAccessKeyLastUsed]
readPrec :: ReadPrec GetAccessKeyLastUsed
$creadPrec :: ReadPrec GetAccessKeyLastUsed
readList :: ReadS [GetAccessKeyLastUsed]
$creadList :: ReadS [GetAccessKeyLastUsed]
readsPrec :: Int -> ReadS GetAccessKeyLastUsed
$creadsPrec :: Int -> ReadS GetAccessKeyLastUsed
Prelude.Read, Int -> GetAccessKeyLastUsed -> ShowS
[GetAccessKeyLastUsed] -> ShowS
GetAccessKeyLastUsed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAccessKeyLastUsed] -> ShowS
$cshowList :: [GetAccessKeyLastUsed] -> ShowS
show :: GetAccessKeyLastUsed -> String
$cshow :: GetAccessKeyLastUsed -> String
showsPrec :: Int -> GetAccessKeyLastUsed -> ShowS
$cshowsPrec :: Int -> GetAccessKeyLastUsed -> ShowS
Prelude.Show, forall x. Rep GetAccessKeyLastUsed x -> GetAccessKeyLastUsed
forall x. GetAccessKeyLastUsed -> Rep GetAccessKeyLastUsed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAccessKeyLastUsed x -> GetAccessKeyLastUsed
$cfrom :: forall x. GetAccessKeyLastUsed -> Rep GetAccessKeyLastUsed x
Prelude.Generic)

-- |
-- Create a value of 'GetAccessKeyLastUsed' 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:
--
-- 'accessKeyId', 'getAccessKeyLastUsed_accessKeyId' - The identifier of an access key.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- that can consist of any upper or lowercased letter or digit.
newGetAccessKeyLastUsed ::
  -- | 'accessKeyId'
  Core.AccessKey ->
  GetAccessKeyLastUsed
newGetAccessKeyLastUsed :: AccessKey -> GetAccessKeyLastUsed
newGetAccessKeyLastUsed AccessKey
pAccessKeyId_ =
  GetAccessKeyLastUsed' {$sel:accessKeyId:GetAccessKeyLastUsed' :: AccessKey
accessKeyId = AccessKey
pAccessKeyId_}

-- | The identifier of an access key.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- that can consist of any upper or lowercased letter or digit.
getAccessKeyLastUsed_accessKeyId :: Lens.Lens' GetAccessKeyLastUsed Core.AccessKey
getAccessKeyLastUsed_accessKeyId :: Lens' GetAccessKeyLastUsed AccessKey
getAccessKeyLastUsed_accessKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAccessKeyLastUsed' {AccessKey
accessKeyId :: AccessKey
$sel:accessKeyId:GetAccessKeyLastUsed' :: GetAccessKeyLastUsed -> AccessKey
accessKeyId} -> AccessKey
accessKeyId) (\s :: GetAccessKeyLastUsed
s@GetAccessKeyLastUsed' {} AccessKey
a -> GetAccessKeyLastUsed
s {$sel:accessKeyId:GetAccessKeyLastUsed' :: AccessKey
accessKeyId = AccessKey
a} :: GetAccessKeyLastUsed)

instance Core.AWSRequest GetAccessKeyLastUsed where
  type
    AWSResponse GetAccessKeyLastUsed =
      GetAccessKeyLastUsedResponse
  request :: (Service -> Service)
-> GetAccessKeyLastUsed -> Request GetAccessKeyLastUsed
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 GetAccessKeyLastUsed
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetAccessKeyLastUsed)))
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
"GetAccessKeyLastUsedResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe AccessKeyLastUsed
-> Maybe Text -> Int -> GetAccessKeyLastUsedResponse
GetAccessKeyLastUsedResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"AccessKeyLastUsed")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"UserName")
            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 GetAccessKeyLastUsed where
  hashWithSalt :: Int -> GetAccessKeyLastUsed -> Int
hashWithSalt Int
_salt GetAccessKeyLastUsed' {AccessKey
accessKeyId :: AccessKey
$sel:accessKeyId:GetAccessKeyLastUsed' :: GetAccessKeyLastUsed -> AccessKey
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AccessKey
accessKeyId

instance Prelude.NFData GetAccessKeyLastUsed where
  rnf :: GetAccessKeyLastUsed -> ()
rnf GetAccessKeyLastUsed' {AccessKey
accessKeyId :: AccessKey
$sel:accessKeyId:GetAccessKeyLastUsed' :: GetAccessKeyLastUsed -> AccessKey
..} =
    forall a. NFData a => a -> ()
Prelude.rnf AccessKey
accessKeyId

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

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

instance Data.ToQuery GetAccessKeyLastUsed where
  toQuery :: GetAccessKeyLastUsed -> QueryString
toQuery GetAccessKeyLastUsed' {AccessKey
accessKeyId :: AccessKey
$sel:accessKeyId:GetAccessKeyLastUsed' :: GetAccessKeyLastUsed -> AccessKey
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetAccessKeyLastUsed" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"AccessKeyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: AccessKey
accessKeyId
      ]

-- | Contains the response to a successful GetAccessKeyLastUsed request. It
-- is also returned as a member of the AccessKeyMetaData structure returned
-- by the ListAccessKeys action.
--
-- /See:/ 'newGetAccessKeyLastUsedResponse' smart constructor.
data GetAccessKeyLastUsedResponse = GetAccessKeyLastUsedResponse'
  { -- | Contains information about the last time the access key was used.
    GetAccessKeyLastUsedResponse -> Maybe AccessKeyLastUsed
accessKeyLastUsed :: Prelude.Maybe AccessKeyLastUsed,
    -- | The name of the IAM user that owns this access key.
    GetAccessKeyLastUsedResponse -> Maybe Text
userName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetAccessKeyLastUsedResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetAccessKeyLastUsedResponse
-> GetAccessKeyLastUsedResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAccessKeyLastUsedResponse
-> GetAccessKeyLastUsedResponse -> Bool
$c/= :: GetAccessKeyLastUsedResponse
-> GetAccessKeyLastUsedResponse -> Bool
== :: GetAccessKeyLastUsedResponse
-> GetAccessKeyLastUsedResponse -> Bool
$c== :: GetAccessKeyLastUsedResponse
-> GetAccessKeyLastUsedResponse -> Bool
Prelude.Eq, ReadPrec [GetAccessKeyLastUsedResponse]
ReadPrec GetAccessKeyLastUsedResponse
Int -> ReadS GetAccessKeyLastUsedResponse
ReadS [GetAccessKeyLastUsedResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAccessKeyLastUsedResponse]
$creadListPrec :: ReadPrec [GetAccessKeyLastUsedResponse]
readPrec :: ReadPrec GetAccessKeyLastUsedResponse
$creadPrec :: ReadPrec GetAccessKeyLastUsedResponse
readList :: ReadS [GetAccessKeyLastUsedResponse]
$creadList :: ReadS [GetAccessKeyLastUsedResponse]
readsPrec :: Int -> ReadS GetAccessKeyLastUsedResponse
$creadsPrec :: Int -> ReadS GetAccessKeyLastUsedResponse
Prelude.Read, Int -> GetAccessKeyLastUsedResponse -> ShowS
[GetAccessKeyLastUsedResponse] -> ShowS
GetAccessKeyLastUsedResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAccessKeyLastUsedResponse] -> ShowS
$cshowList :: [GetAccessKeyLastUsedResponse] -> ShowS
show :: GetAccessKeyLastUsedResponse -> String
$cshow :: GetAccessKeyLastUsedResponse -> String
showsPrec :: Int -> GetAccessKeyLastUsedResponse -> ShowS
$cshowsPrec :: Int -> GetAccessKeyLastUsedResponse -> ShowS
Prelude.Show, forall x.
Rep GetAccessKeyLastUsedResponse x -> GetAccessKeyLastUsedResponse
forall x.
GetAccessKeyLastUsedResponse -> Rep GetAccessKeyLastUsedResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetAccessKeyLastUsedResponse x -> GetAccessKeyLastUsedResponse
$cfrom :: forall x.
GetAccessKeyLastUsedResponse -> Rep GetAccessKeyLastUsedResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetAccessKeyLastUsedResponse' 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:
--
-- 'accessKeyLastUsed', 'getAccessKeyLastUsedResponse_accessKeyLastUsed' - Contains information about the last time the access key was used.
--
-- 'userName', 'getAccessKeyLastUsedResponse_userName' - The name of the IAM user that owns this access key.
--
-- 'httpStatus', 'getAccessKeyLastUsedResponse_httpStatus' - The response's http status code.
newGetAccessKeyLastUsedResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetAccessKeyLastUsedResponse
newGetAccessKeyLastUsedResponse :: Int -> GetAccessKeyLastUsedResponse
newGetAccessKeyLastUsedResponse Int
pHttpStatus_ =
  GetAccessKeyLastUsedResponse'
    { $sel:accessKeyLastUsed:GetAccessKeyLastUsedResponse' :: Maybe AccessKeyLastUsed
accessKeyLastUsed =
        forall a. Maybe a
Prelude.Nothing,
      $sel:userName:GetAccessKeyLastUsedResponse' :: Maybe Text
userName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetAccessKeyLastUsedResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains information about the last time the access key was used.
getAccessKeyLastUsedResponse_accessKeyLastUsed :: Lens.Lens' GetAccessKeyLastUsedResponse (Prelude.Maybe AccessKeyLastUsed)
getAccessKeyLastUsedResponse_accessKeyLastUsed :: Lens' GetAccessKeyLastUsedResponse (Maybe AccessKeyLastUsed)
getAccessKeyLastUsedResponse_accessKeyLastUsed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAccessKeyLastUsedResponse' {Maybe AccessKeyLastUsed
accessKeyLastUsed :: Maybe AccessKeyLastUsed
$sel:accessKeyLastUsed:GetAccessKeyLastUsedResponse' :: GetAccessKeyLastUsedResponse -> Maybe AccessKeyLastUsed
accessKeyLastUsed} -> Maybe AccessKeyLastUsed
accessKeyLastUsed) (\s :: GetAccessKeyLastUsedResponse
s@GetAccessKeyLastUsedResponse' {} Maybe AccessKeyLastUsed
a -> GetAccessKeyLastUsedResponse
s {$sel:accessKeyLastUsed:GetAccessKeyLastUsedResponse' :: Maybe AccessKeyLastUsed
accessKeyLastUsed = Maybe AccessKeyLastUsed
a} :: GetAccessKeyLastUsedResponse)

-- | The name of the IAM user that owns this access key.
getAccessKeyLastUsedResponse_userName :: Lens.Lens' GetAccessKeyLastUsedResponse (Prelude.Maybe Prelude.Text)
getAccessKeyLastUsedResponse_userName :: Lens' GetAccessKeyLastUsedResponse (Maybe Text)
getAccessKeyLastUsedResponse_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAccessKeyLastUsedResponse' {Maybe Text
userName :: Maybe Text
$sel:userName:GetAccessKeyLastUsedResponse' :: GetAccessKeyLastUsedResponse -> Maybe Text
userName} -> Maybe Text
userName) (\s :: GetAccessKeyLastUsedResponse
s@GetAccessKeyLastUsedResponse' {} Maybe Text
a -> GetAccessKeyLastUsedResponse
s {$sel:userName:GetAccessKeyLastUsedResponse' :: Maybe Text
userName = Maybe Text
a} :: GetAccessKeyLastUsedResponse)

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

instance Prelude.NFData GetAccessKeyLastUsedResponse where
  rnf :: GetAccessKeyLastUsedResponse -> ()
rnf GetAccessKeyLastUsedResponse' {Int
Maybe Text
Maybe AccessKeyLastUsed
httpStatus :: Int
userName :: Maybe Text
accessKeyLastUsed :: Maybe AccessKeyLastUsed
$sel:httpStatus:GetAccessKeyLastUsedResponse' :: GetAccessKeyLastUsedResponse -> Int
$sel:userName:GetAccessKeyLastUsedResponse' :: GetAccessKeyLastUsedResponse -> Maybe Text
$sel:accessKeyLastUsed:GetAccessKeyLastUsedResponse' :: GetAccessKeyLastUsedResponse -> Maybe AccessKeyLastUsed
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AccessKeyLastUsed
accessKeyLastUsed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus