{-# 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.CloudTrail.ListPublicKeys
-- 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 all public keys whose private keys were used to sign the digest
-- files within the specified time range. The public key is needed to
-- validate digest files that were signed with its corresponding private
-- key.
--
-- CloudTrail uses different private and public key pairs per region. Each
-- digest file is signed with a private key unique to its region. When you
-- validate a digest file from a specific region, you must look in the same
-- region for its corresponding public key.
--
-- This operation returns paginated results.
module Amazonka.CloudTrail.ListPublicKeys
  ( -- * Creating a Request
    ListPublicKeys (..),
    newListPublicKeys,

    -- * Request Lenses
    listPublicKeys_endTime,
    listPublicKeys_nextToken,
    listPublicKeys_startTime,

    -- * Destructuring the Response
    ListPublicKeysResponse (..),
    newListPublicKeysResponse,

    -- * Response Lenses
    listPublicKeysResponse_nextToken,
    listPublicKeysResponse_publicKeyList,
    listPublicKeysResponse_httpStatus,
  )
where

import Amazonka.CloudTrail.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

-- | Requests the public keys for a specified time range.
--
-- /See:/ 'newListPublicKeys' smart constructor.
data ListPublicKeys = ListPublicKeys'
  { -- | Optionally specifies, in UTC, the end of the time range to look up
    -- public keys for CloudTrail digest files. If not specified, the current
    -- time is used.
    ListPublicKeys -> Maybe POSIX
endTime :: Prelude.Maybe Data.POSIX,
    -- | Reserved for future use.
    ListPublicKeys -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Optionally specifies, in UTC, the start of the time range to look up
    -- public keys for CloudTrail digest files. If not specified, the current
    -- time is used, and the current public key is returned.
    ListPublicKeys -> Maybe POSIX
startTime :: Prelude.Maybe Data.POSIX
  }
  deriving (ListPublicKeys -> ListPublicKeys -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPublicKeys -> ListPublicKeys -> Bool
$c/= :: ListPublicKeys -> ListPublicKeys -> Bool
== :: ListPublicKeys -> ListPublicKeys -> Bool
$c== :: ListPublicKeys -> ListPublicKeys -> Bool
Prelude.Eq, ReadPrec [ListPublicKeys]
ReadPrec ListPublicKeys
Int -> ReadS ListPublicKeys
ReadS [ListPublicKeys]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPublicKeys]
$creadListPrec :: ReadPrec [ListPublicKeys]
readPrec :: ReadPrec ListPublicKeys
$creadPrec :: ReadPrec ListPublicKeys
readList :: ReadS [ListPublicKeys]
$creadList :: ReadS [ListPublicKeys]
readsPrec :: Int -> ReadS ListPublicKeys
$creadsPrec :: Int -> ReadS ListPublicKeys
Prelude.Read, Int -> ListPublicKeys -> ShowS
[ListPublicKeys] -> ShowS
ListPublicKeys -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPublicKeys] -> ShowS
$cshowList :: [ListPublicKeys] -> ShowS
show :: ListPublicKeys -> String
$cshow :: ListPublicKeys -> String
showsPrec :: Int -> ListPublicKeys -> ShowS
$cshowsPrec :: Int -> ListPublicKeys -> ShowS
Prelude.Show, forall x. Rep ListPublicKeys x -> ListPublicKeys
forall x. ListPublicKeys -> Rep ListPublicKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPublicKeys x -> ListPublicKeys
$cfrom :: forall x. ListPublicKeys -> Rep ListPublicKeys x
Prelude.Generic)

-- |
-- Create a value of 'ListPublicKeys' 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:
--
-- 'endTime', 'listPublicKeys_endTime' - Optionally specifies, in UTC, the end of the time range to look up
-- public keys for CloudTrail digest files. If not specified, the current
-- time is used.
--
-- 'nextToken', 'listPublicKeys_nextToken' - Reserved for future use.
--
-- 'startTime', 'listPublicKeys_startTime' - Optionally specifies, in UTC, the start of the time range to look up
-- public keys for CloudTrail digest files. If not specified, the current
-- time is used, and the current public key is returned.
newListPublicKeys ::
  ListPublicKeys
newListPublicKeys :: ListPublicKeys
newListPublicKeys =
  ListPublicKeys'
    { $sel:endTime:ListPublicKeys' :: Maybe POSIX
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListPublicKeys' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:ListPublicKeys' :: Maybe POSIX
startTime = forall a. Maybe a
Prelude.Nothing
    }

-- | Optionally specifies, in UTC, the end of the time range to look up
-- public keys for CloudTrail digest files. If not specified, the current
-- time is used.
listPublicKeys_endTime :: Lens.Lens' ListPublicKeys (Prelude.Maybe Prelude.UTCTime)
listPublicKeys_endTime :: Lens' ListPublicKeys (Maybe UTCTime)
listPublicKeys_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPublicKeys' {Maybe POSIX
endTime :: Maybe POSIX
$sel:endTime:ListPublicKeys' :: ListPublicKeys -> Maybe POSIX
endTime} -> Maybe POSIX
endTime) (\s :: ListPublicKeys
s@ListPublicKeys' {} Maybe POSIX
a -> ListPublicKeys
s {$sel:endTime:ListPublicKeys' :: Maybe POSIX
endTime = Maybe POSIX
a} :: ListPublicKeys) 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

-- | Reserved for future use.
listPublicKeys_nextToken :: Lens.Lens' ListPublicKeys (Prelude.Maybe Prelude.Text)
listPublicKeys_nextToken :: Lens' ListPublicKeys (Maybe Text)
listPublicKeys_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPublicKeys' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPublicKeys' :: ListPublicKeys -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPublicKeys
s@ListPublicKeys' {} Maybe Text
a -> ListPublicKeys
s {$sel:nextToken:ListPublicKeys' :: Maybe Text
nextToken = Maybe Text
a} :: ListPublicKeys)

-- | Optionally specifies, in UTC, the start of the time range to look up
-- public keys for CloudTrail digest files. If not specified, the current
-- time is used, and the current public key is returned.
listPublicKeys_startTime :: Lens.Lens' ListPublicKeys (Prelude.Maybe Prelude.UTCTime)
listPublicKeys_startTime :: Lens' ListPublicKeys (Maybe UTCTime)
listPublicKeys_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPublicKeys' {Maybe POSIX
startTime :: Maybe POSIX
$sel:startTime:ListPublicKeys' :: ListPublicKeys -> Maybe POSIX
startTime} -> Maybe POSIX
startTime) (\s :: ListPublicKeys
s@ListPublicKeys' {} Maybe POSIX
a -> ListPublicKeys
s {$sel:startTime:ListPublicKeys' :: Maybe POSIX
startTime = Maybe POSIX
a} :: ListPublicKeys) 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

instance Core.AWSPager ListPublicKeys where
  page :: ListPublicKeys
-> AWSResponse ListPublicKeys -> Maybe ListPublicKeys
page ListPublicKeys
rq AWSResponse ListPublicKeys
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListPublicKeys
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPublicKeysResponse (Maybe Text)
listPublicKeysResponse_nextToken
            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. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListPublicKeys
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPublicKeysResponse (Maybe [PublicKey])
listPublicKeysResponse_publicKeyList
            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.$ ListPublicKeys
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListPublicKeys (Maybe Text)
listPublicKeys_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListPublicKeys
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPublicKeysResponse (Maybe Text)
listPublicKeysResponse_nextToken
          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 ListPublicKeys where
  type
    AWSResponse ListPublicKeys =
      ListPublicKeysResponse
  request :: (Service -> Service) -> ListPublicKeys -> Request ListPublicKeys
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 ListPublicKeys
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListPublicKeys)))
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 Text -> Maybe [PublicKey] -> Int -> ListPublicKeysResponse
ListPublicKeysResponse'
            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
"NextToken")
            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
"PublicKeyList" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 ListPublicKeys where
  hashWithSalt :: Int -> ListPublicKeys -> Int
hashWithSalt Int
_salt ListPublicKeys' {Maybe Text
Maybe POSIX
startTime :: Maybe POSIX
nextToken :: Maybe Text
endTime :: Maybe POSIX
$sel:startTime:ListPublicKeys' :: ListPublicKeys -> Maybe POSIX
$sel:nextToken:ListPublicKeys' :: ListPublicKeys -> Maybe Text
$sel:endTime:ListPublicKeys' :: ListPublicKeys -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startTime

instance Prelude.NFData ListPublicKeys where
  rnf :: ListPublicKeys -> ()
rnf ListPublicKeys' {Maybe Text
Maybe POSIX
startTime :: Maybe POSIX
nextToken :: Maybe Text
endTime :: Maybe POSIX
$sel:startTime:ListPublicKeys' :: ListPublicKeys -> Maybe POSIX
$sel:nextToken:ListPublicKeys' :: ListPublicKeys -> Maybe Text
$sel:endTime:ListPublicKeys' :: ListPublicKeys -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startTime

instance Data.ToHeaders ListPublicKeys where
  toHeaders :: ListPublicKeys -> 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
"com.amazonaws.cloudtrail.v20131101.CloudTrail_20131101.ListPublicKeys" ::
                          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 ListPublicKeys where
  toJSON :: ListPublicKeys -> Value
toJSON ListPublicKeys' {Maybe Text
Maybe POSIX
startTime :: Maybe POSIX
nextToken :: Maybe Text
endTime :: Maybe POSIX
$sel:startTime:ListPublicKeys' :: ListPublicKeys -> Maybe POSIX
$sel:nextToken:ListPublicKeys' :: ListPublicKeys -> Maybe Text
$sel:endTime:ListPublicKeys' :: ListPublicKeys -> Maybe POSIX
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EndTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe POSIX
endTime,
            (Key
"NextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken,
            (Key
"StartTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe POSIX
startTime
          ]
      )

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

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

-- | Returns the objects or data listed below if successful. Otherwise,
-- returns an error.
--
-- /See:/ 'newListPublicKeysResponse' smart constructor.
data ListPublicKeysResponse = ListPublicKeysResponse'
  { -- | Reserved for future use.
    ListPublicKeysResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Contains an array of PublicKey objects.
    --
    -- The returned public keys may have validity time ranges that overlap.
    ListPublicKeysResponse -> Maybe [PublicKey]
publicKeyList :: Prelude.Maybe [PublicKey],
    -- | The response's http status code.
    ListPublicKeysResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListPublicKeysResponse -> ListPublicKeysResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPublicKeysResponse -> ListPublicKeysResponse -> Bool
$c/= :: ListPublicKeysResponse -> ListPublicKeysResponse -> Bool
== :: ListPublicKeysResponse -> ListPublicKeysResponse -> Bool
$c== :: ListPublicKeysResponse -> ListPublicKeysResponse -> Bool
Prelude.Eq, ReadPrec [ListPublicKeysResponse]
ReadPrec ListPublicKeysResponse
Int -> ReadS ListPublicKeysResponse
ReadS [ListPublicKeysResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPublicKeysResponse]
$creadListPrec :: ReadPrec [ListPublicKeysResponse]
readPrec :: ReadPrec ListPublicKeysResponse
$creadPrec :: ReadPrec ListPublicKeysResponse
readList :: ReadS [ListPublicKeysResponse]
$creadList :: ReadS [ListPublicKeysResponse]
readsPrec :: Int -> ReadS ListPublicKeysResponse
$creadsPrec :: Int -> ReadS ListPublicKeysResponse
Prelude.Read, Int -> ListPublicKeysResponse -> ShowS
[ListPublicKeysResponse] -> ShowS
ListPublicKeysResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPublicKeysResponse] -> ShowS
$cshowList :: [ListPublicKeysResponse] -> ShowS
show :: ListPublicKeysResponse -> String
$cshow :: ListPublicKeysResponse -> String
showsPrec :: Int -> ListPublicKeysResponse -> ShowS
$cshowsPrec :: Int -> ListPublicKeysResponse -> ShowS
Prelude.Show, forall x. Rep ListPublicKeysResponse x -> ListPublicKeysResponse
forall x. ListPublicKeysResponse -> Rep ListPublicKeysResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPublicKeysResponse x -> ListPublicKeysResponse
$cfrom :: forall x. ListPublicKeysResponse -> Rep ListPublicKeysResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListPublicKeysResponse' 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:
--
-- 'nextToken', 'listPublicKeysResponse_nextToken' - Reserved for future use.
--
-- 'publicKeyList', 'listPublicKeysResponse_publicKeyList' - Contains an array of PublicKey objects.
--
-- The returned public keys may have validity time ranges that overlap.
--
-- 'httpStatus', 'listPublicKeysResponse_httpStatus' - The response's http status code.
newListPublicKeysResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListPublicKeysResponse
newListPublicKeysResponse :: Int -> ListPublicKeysResponse
newListPublicKeysResponse Int
pHttpStatus_ =
  ListPublicKeysResponse'
    { $sel:nextToken:ListPublicKeysResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:publicKeyList:ListPublicKeysResponse' :: Maybe [PublicKey]
publicKeyList = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListPublicKeysResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Reserved for future use.
listPublicKeysResponse_nextToken :: Lens.Lens' ListPublicKeysResponse (Prelude.Maybe Prelude.Text)
listPublicKeysResponse_nextToken :: Lens' ListPublicKeysResponse (Maybe Text)
listPublicKeysResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPublicKeysResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPublicKeysResponse' :: ListPublicKeysResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPublicKeysResponse
s@ListPublicKeysResponse' {} Maybe Text
a -> ListPublicKeysResponse
s {$sel:nextToken:ListPublicKeysResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListPublicKeysResponse)

-- | Contains an array of PublicKey objects.
--
-- The returned public keys may have validity time ranges that overlap.
listPublicKeysResponse_publicKeyList :: Lens.Lens' ListPublicKeysResponse (Prelude.Maybe [PublicKey])
listPublicKeysResponse_publicKeyList :: Lens' ListPublicKeysResponse (Maybe [PublicKey])
listPublicKeysResponse_publicKeyList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPublicKeysResponse' {Maybe [PublicKey]
publicKeyList :: Maybe [PublicKey]
$sel:publicKeyList:ListPublicKeysResponse' :: ListPublicKeysResponse -> Maybe [PublicKey]
publicKeyList} -> Maybe [PublicKey]
publicKeyList) (\s :: ListPublicKeysResponse
s@ListPublicKeysResponse' {} Maybe [PublicKey]
a -> ListPublicKeysResponse
s {$sel:publicKeyList:ListPublicKeysResponse' :: Maybe [PublicKey]
publicKeyList = Maybe [PublicKey]
a} :: ListPublicKeysResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData ListPublicKeysResponse where
  rnf :: ListPublicKeysResponse -> ()
rnf ListPublicKeysResponse' {Int
Maybe [PublicKey]
Maybe Text
httpStatus :: Int
publicKeyList :: Maybe [PublicKey]
nextToken :: Maybe Text
$sel:httpStatus:ListPublicKeysResponse' :: ListPublicKeysResponse -> Int
$sel:publicKeyList:ListPublicKeysResponse' :: ListPublicKeysResponse -> Maybe [PublicKey]
$sel:nextToken:ListPublicKeysResponse' :: ListPublicKeysResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PublicKey]
publicKeyList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus