{-# 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.ListAccessKeys
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about the access key IDs associated with the
-- specified IAM user. If there is none, the operation returns an empty
-- list.
--
-- Although each user is limited to a small number of keys, you can still
-- paginate the results using the @MaxItems@ and @Marker@ parameters.
--
-- If the @UserName@ is not specified, the user name is determined
-- implicitly based on the Amazon Web Services access key ID used to sign
-- the request. If a temporary access key is used, then @UserName@ is
-- required. If a long-term key is assigned to the user, then @UserName@ is
-- not required. This operation works for access keys under the Amazon Web
-- Services account. Consequently, you can use this operation to manage
-- Amazon Web Services account root user credentials even if the Amazon Web
-- Services account has no associated users.
--
-- To ensure the security of your Amazon Web Services account, the secret
-- access key is accessible only during key and user creation.
--
-- This operation returns paginated results.
module Amazonka.IAM.ListAccessKeys
  ( -- * Creating a Request
    ListAccessKeys (..),
    newListAccessKeys,

    -- * Request Lenses
    listAccessKeys_marker,
    listAccessKeys_maxItems,
    listAccessKeys_userName,

    -- * Destructuring the Response
    ListAccessKeysResponse (..),
    newListAccessKeysResponse,

    -- * Response Lenses
    listAccessKeysResponse_isTruncated,
    listAccessKeysResponse_marker,
    listAccessKeysResponse_httpStatus,
    listAccessKeysResponse_accessKeyMetadata,
  )
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:/ 'newListAccessKeys' smart constructor.
data ListAccessKeys = ListAccessKeys'
  { -- | Use this parameter only when paginating results and only after you
    -- receive a response indicating that the results are truncated. Set it to
    -- the value of the @Marker@ element in the response that you received to
    -- indicate where the next call should start.
    ListAccessKeys -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | Use this only when paginating results to indicate the maximum number of
    -- items you want in the response. If additional items exist beyond the
    -- maximum you specify, the @IsTruncated@ response element is @true@.
    --
    -- If you do not include this parameter, the number of items defaults to
    -- 100. Note that IAM might return fewer results, even when there are more
    -- results available. In that case, the @IsTruncated@ response element
    -- returns @true@, and @Marker@ contains a value to include in the
    -- subsequent call that tells the service where to continue from.
    ListAccessKeys -> Maybe Natural
maxItems :: Prelude.Maybe Prelude.Natural,
    -- | The name of the user.
    --
    -- 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: _+=,.\@-
    ListAccessKeys -> Maybe Text
userName :: Prelude.Maybe Prelude.Text
  }
  deriving (ListAccessKeys -> ListAccessKeys -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAccessKeys -> ListAccessKeys -> Bool
$c/= :: ListAccessKeys -> ListAccessKeys -> Bool
== :: ListAccessKeys -> ListAccessKeys -> Bool
$c== :: ListAccessKeys -> ListAccessKeys -> Bool
Prelude.Eq, ReadPrec [ListAccessKeys]
ReadPrec ListAccessKeys
Int -> ReadS ListAccessKeys
ReadS [ListAccessKeys]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAccessKeys]
$creadListPrec :: ReadPrec [ListAccessKeys]
readPrec :: ReadPrec ListAccessKeys
$creadPrec :: ReadPrec ListAccessKeys
readList :: ReadS [ListAccessKeys]
$creadList :: ReadS [ListAccessKeys]
readsPrec :: Int -> ReadS ListAccessKeys
$creadsPrec :: Int -> ReadS ListAccessKeys
Prelude.Read, Int -> ListAccessKeys -> ShowS
[ListAccessKeys] -> ShowS
ListAccessKeys -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAccessKeys] -> ShowS
$cshowList :: [ListAccessKeys] -> ShowS
show :: ListAccessKeys -> String
$cshow :: ListAccessKeys -> String
showsPrec :: Int -> ListAccessKeys -> ShowS
$cshowsPrec :: Int -> ListAccessKeys -> ShowS
Prelude.Show, forall x. Rep ListAccessKeys x -> ListAccessKeys
forall x. ListAccessKeys -> Rep ListAccessKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListAccessKeys x -> ListAccessKeys
$cfrom :: forall x. ListAccessKeys -> Rep ListAccessKeys x
Prelude.Generic)

-- |
-- Create a value of 'ListAccessKeys' 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:
--
-- 'marker', 'listAccessKeys_marker' - Use this parameter only when paginating results and only after you
-- receive a response indicating that the results are truncated. Set it to
-- the value of the @Marker@ element in the response that you received to
-- indicate where the next call should start.
--
-- 'maxItems', 'listAccessKeys_maxItems' - Use this only when paginating results to indicate the maximum number of
-- items you want in the response. If additional items exist beyond the
-- maximum you specify, the @IsTruncated@ response element is @true@.
--
-- If you do not include this parameter, the number of items defaults to
-- 100. Note that IAM might return fewer results, even when there are more
-- results available. In that case, the @IsTruncated@ response element
-- returns @true@, and @Marker@ contains a value to include in the
-- subsequent call that tells the service where to continue from.
--
-- 'userName', 'listAccessKeys_userName' - The name of the user.
--
-- 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: _+=,.\@-
newListAccessKeys ::
  ListAccessKeys
newListAccessKeys :: ListAccessKeys
newListAccessKeys =
  ListAccessKeys'
    { $sel:marker:ListAccessKeys' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxItems:ListAccessKeys' :: Maybe Natural
maxItems = forall a. Maybe a
Prelude.Nothing,
      $sel:userName:ListAccessKeys' :: Maybe Text
userName = forall a. Maybe a
Prelude.Nothing
    }

-- | Use this parameter only when paginating results and only after you
-- receive a response indicating that the results are truncated. Set it to
-- the value of the @Marker@ element in the response that you received to
-- indicate where the next call should start.
listAccessKeys_marker :: Lens.Lens' ListAccessKeys (Prelude.Maybe Prelude.Text)
listAccessKeys_marker :: Lens' ListAccessKeys (Maybe Text)
listAccessKeys_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccessKeys' {Maybe Text
marker :: Maybe Text
$sel:marker:ListAccessKeys' :: ListAccessKeys -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListAccessKeys
s@ListAccessKeys' {} Maybe Text
a -> ListAccessKeys
s {$sel:marker:ListAccessKeys' :: Maybe Text
marker = Maybe Text
a} :: ListAccessKeys)

-- | Use this only when paginating results to indicate the maximum number of
-- items you want in the response. If additional items exist beyond the
-- maximum you specify, the @IsTruncated@ response element is @true@.
--
-- If you do not include this parameter, the number of items defaults to
-- 100. Note that IAM might return fewer results, even when there are more
-- results available. In that case, the @IsTruncated@ response element
-- returns @true@, and @Marker@ contains a value to include in the
-- subsequent call that tells the service where to continue from.
listAccessKeys_maxItems :: Lens.Lens' ListAccessKeys (Prelude.Maybe Prelude.Natural)
listAccessKeys_maxItems :: Lens' ListAccessKeys (Maybe Natural)
listAccessKeys_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccessKeys' {Maybe Natural
maxItems :: Maybe Natural
$sel:maxItems:ListAccessKeys' :: ListAccessKeys -> Maybe Natural
maxItems} -> Maybe Natural
maxItems) (\s :: ListAccessKeys
s@ListAccessKeys' {} Maybe Natural
a -> ListAccessKeys
s {$sel:maxItems:ListAccessKeys' :: Maybe Natural
maxItems = Maybe Natural
a} :: ListAccessKeys)

-- | The name of the user.
--
-- 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: _+=,.\@-
listAccessKeys_userName :: Lens.Lens' ListAccessKeys (Prelude.Maybe Prelude.Text)
listAccessKeys_userName :: Lens' ListAccessKeys (Maybe Text)
listAccessKeys_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccessKeys' {Maybe Text
userName :: Maybe Text
$sel:userName:ListAccessKeys' :: ListAccessKeys -> Maybe Text
userName} -> Maybe Text
userName) (\s :: ListAccessKeys
s@ListAccessKeys' {} Maybe Text
a -> ListAccessKeys
s {$sel:userName:ListAccessKeys' :: Maybe Text
userName = Maybe Text
a} :: ListAccessKeys)

instance Core.AWSPager ListAccessKeys where
  page :: ListAccessKeys
-> AWSResponse ListAccessKeys -> Maybe ListAccessKeys
page ListAccessKeys
rq AWSResponse ListAccessKeys
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListAccessKeys
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAccessKeysResponse (Maybe Bool)
listAccessKeysResponse_isTruncated
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. Maybe a -> Bool
Prelude.isNothing
        ( AWSResponse ListAccessKeys
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAccessKeysResponse (Maybe Text)
listAccessKeysResponse_marker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListAccessKeys
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListAccessKeys (Maybe Text)
listAccessKeys_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListAccessKeys
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAccessKeysResponse (Maybe Text)
listAccessKeysResponse_marker
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListAccessKeys where
  type
    AWSResponse ListAccessKeys =
      ListAccessKeysResponse
  request :: (Service -> Service) -> ListAccessKeys -> Request ListAccessKeys
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 ListAccessKeys
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListAccessKeys)))
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
"ListAccessKeysResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Bool
-> Maybe Text
-> Int
-> [AccessKeyMetadata]
-> ListAccessKeysResponse
ListAccessKeysResponse'
            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
"IsTruncated")
            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
"Marker")
            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.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"AccessKeyMetadata"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member"
                        )
      )

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

instance Prelude.NFData ListAccessKeys where
  rnf :: ListAccessKeys -> ()
rnf ListAccessKeys' {Maybe Natural
Maybe Text
userName :: Maybe Text
maxItems :: Maybe Natural
marker :: Maybe Text
$sel:userName:ListAccessKeys' :: ListAccessKeys -> Maybe Text
$sel:maxItems:ListAccessKeys' :: ListAccessKeys -> Maybe Natural
$sel:marker:ListAccessKeys' :: ListAccessKeys -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxItems
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userName

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

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

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

-- | Contains the response to a successful ListAccessKeys request.
--
-- /See:/ 'newListAccessKeysResponse' smart constructor.
data ListAccessKeysResponse = ListAccessKeysResponse'
  { -- | A flag that indicates whether there are more items to return. If your
    -- results were truncated, you can make a subsequent pagination request
    -- using the @Marker@ request parameter to retrieve more items. Note that
    -- IAM might return fewer than the @MaxItems@ number of results even when
    -- there are more results available. We recommend that you check
    -- @IsTruncated@ after every call to ensure that you receive all your
    -- results.
    ListAccessKeysResponse -> Maybe Bool
isTruncated :: Prelude.Maybe Prelude.Bool,
    -- | When @IsTruncated@ is @true@, this element is present and contains the
    -- value to use for the @Marker@ parameter in a subsequent pagination
    -- request.
    ListAccessKeysResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListAccessKeysResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of objects containing metadata about the access keys.
    ListAccessKeysResponse -> [AccessKeyMetadata]
accessKeyMetadata :: [AccessKeyMetadata]
  }
  deriving (ListAccessKeysResponse -> ListAccessKeysResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAccessKeysResponse -> ListAccessKeysResponse -> Bool
$c/= :: ListAccessKeysResponse -> ListAccessKeysResponse -> Bool
== :: ListAccessKeysResponse -> ListAccessKeysResponse -> Bool
$c== :: ListAccessKeysResponse -> ListAccessKeysResponse -> Bool
Prelude.Eq, ReadPrec [ListAccessKeysResponse]
ReadPrec ListAccessKeysResponse
Int -> ReadS ListAccessKeysResponse
ReadS [ListAccessKeysResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAccessKeysResponse]
$creadListPrec :: ReadPrec [ListAccessKeysResponse]
readPrec :: ReadPrec ListAccessKeysResponse
$creadPrec :: ReadPrec ListAccessKeysResponse
readList :: ReadS [ListAccessKeysResponse]
$creadList :: ReadS [ListAccessKeysResponse]
readsPrec :: Int -> ReadS ListAccessKeysResponse
$creadsPrec :: Int -> ReadS ListAccessKeysResponse
Prelude.Read, Int -> ListAccessKeysResponse -> ShowS
[ListAccessKeysResponse] -> ShowS
ListAccessKeysResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAccessKeysResponse] -> ShowS
$cshowList :: [ListAccessKeysResponse] -> ShowS
show :: ListAccessKeysResponse -> String
$cshow :: ListAccessKeysResponse -> String
showsPrec :: Int -> ListAccessKeysResponse -> ShowS
$cshowsPrec :: Int -> ListAccessKeysResponse -> ShowS
Prelude.Show, forall x. Rep ListAccessKeysResponse x -> ListAccessKeysResponse
forall x. ListAccessKeysResponse -> Rep ListAccessKeysResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListAccessKeysResponse x -> ListAccessKeysResponse
$cfrom :: forall x. ListAccessKeysResponse -> Rep ListAccessKeysResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListAccessKeysResponse' 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:
--
-- 'isTruncated', 'listAccessKeysResponse_isTruncated' - A flag that indicates whether there are more items to return. If your
-- results were truncated, you can make a subsequent pagination request
-- using the @Marker@ request parameter to retrieve more items. Note that
-- IAM might return fewer than the @MaxItems@ number of results even when
-- there are more results available. We recommend that you check
-- @IsTruncated@ after every call to ensure that you receive all your
-- results.
--
-- 'marker', 'listAccessKeysResponse_marker' - When @IsTruncated@ is @true@, this element is present and contains the
-- value to use for the @Marker@ parameter in a subsequent pagination
-- request.
--
-- 'httpStatus', 'listAccessKeysResponse_httpStatus' - The response's http status code.
--
-- 'accessKeyMetadata', 'listAccessKeysResponse_accessKeyMetadata' - A list of objects containing metadata about the access keys.
newListAccessKeysResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListAccessKeysResponse
newListAccessKeysResponse :: Int -> ListAccessKeysResponse
newListAccessKeysResponse Int
pHttpStatus_ =
  ListAccessKeysResponse'
    { $sel:isTruncated:ListAccessKeysResponse' :: Maybe Bool
isTruncated =
        forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListAccessKeysResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListAccessKeysResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:accessKeyMetadata:ListAccessKeysResponse' :: [AccessKeyMetadata]
accessKeyMetadata = forall a. Monoid a => a
Prelude.mempty
    }

-- | A flag that indicates whether there are more items to return. If your
-- results were truncated, you can make a subsequent pagination request
-- using the @Marker@ request parameter to retrieve more items. Note that
-- IAM might return fewer than the @MaxItems@ number of results even when
-- there are more results available. We recommend that you check
-- @IsTruncated@ after every call to ensure that you receive all your
-- results.
listAccessKeysResponse_isTruncated :: Lens.Lens' ListAccessKeysResponse (Prelude.Maybe Prelude.Bool)
listAccessKeysResponse_isTruncated :: Lens' ListAccessKeysResponse (Maybe Bool)
listAccessKeysResponse_isTruncated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccessKeysResponse' {Maybe Bool
isTruncated :: Maybe Bool
$sel:isTruncated:ListAccessKeysResponse' :: ListAccessKeysResponse -> Maybe Bool
isTruncated} -> Maybe Bool
isTruncated) (\s :: ListAccessKeysResponse
s@ListAccessKeysResponse' {} Maybe Bool
a -> ListAccessKeysResponse
s {$sel:isTruncated:ListAccessKeysResponse' :: Maybe Bool
isTruncated = Maybe Bool
a} :: ListAccessKeysResponse)

-- | When @IsTruncated@ is @true@, this element is present and contains the
-- value to use for the @Marker@ parameter in a subsequent pagination
-- request.
listAccessKeysResponse_marker :: Lens.Lens' ListAccessKeysResponse (Prelude.Maybe Prelude.Text)
listAccessKeysResponse_marker :: Lens' ListAccessKeysResponse (Maybe Text)
listAccessKeysResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccessKeysResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:ListAccessKeysResponse' :: ListAccessKeysResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListAccessKeysResponse
s@ListAccessKeysResponse' {} Maybe Text
a -> ListAccessKeysResponse
s {$sel:marker:ListAccessKeysResponse' :: Maybe Text
marker = Maybe Text
a} :: ListAccessKeysResponse)

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

-- | A list of objects containing metadata about the access keys.
listAccessKeysResponse_accessKeyMetadata :: Lens.Lens' ListAccessKeysResponse [AccessKeyMetadata]
listAccessKeysResponse_accessKeyMetadata :: Lens' ListAccessKeysResponse [AccessKeyMetadata]
listAccessKeysResponse_accessKeyMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccessKeysResponse' {[AccessKeyMetadata]
accessKeyMetadata :: [AccessKeyMetadata]
$sel:accessKeyMetadata:ListAccessKeysResponse' :: ListAccessKeysResponse -> [AccessKeyMetadata]
accessKeyMetadata} -> [AccessKeyMetadata]
accessKeyMetadata) (\s :: ListAccessKeysResponse
s@ListAccessKeysResponse' {} [AccessKeyMetadata]
a -> ListAccessKeysResponse
s {$sel:accessKeyMetadata:ListAccessKeysResponse' :: [AccessKeyMetadata]
accessKeyMetadata = [AccessKeyMetadata]
a} :: ListAccessKeysResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData ListAccessKeysResponse where
  rnf :: ListAccessKeysResponse -> ()
rnf ListAccessKeysResponse' {Int
[AccessKeyMetadata]
Maybe Bool
Maybe Text
accessKeyMetadata :: [AccessKeyMetadata]
httpStatus :: Int
marker :: Maybe Text
isTruncated :: Maybe Bool
$sel:accessKeyMetadata:ListAccessKeysResponse' :: ListAccessKeysResponse -> [AccessKeyMetadata]
$sel:httpStatus:ListAccessKeysResponse' :: ListAccessKeysResponse -> Int
$sel:marker:ListAccessKeysResponse' :: ListAccessKeysResponse -> Maybe Text
$sel:isTruncated:ListAccessKeysResponse' :: ListAccessKeysResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isTruncated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      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 [AccessKeyMetadata]
accessKeyMetadata