{-# 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.CertificateManagerPCA.ListCertificateAuthorities
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the private certificate authorities that you created by using the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_CreateCertificateAuthority.html CreateCertificateAuthority>
-- action.
--
-- This operation returns paginated results.
module Amazonka.CertificateManagerPCA.ListCertificateAuthorities
  ( -- * Creating a Request
    ListCertificateAuthorities (..),
    newListCertificateAuthorities,

    -- * Request Lenses
    listCertificateAuthorities_maxResults,
    listCertificateAuthorities_nextToken,
    listCertificateAuthorities_resourceOwner,

    -- * Destructuring the Response
    ListCertificateAuthoritiesResponse (..),
    newListCertificateAuthoritiesResponse,

    -- * Response Lenses
    listCertificateAuthoritiesResponse_certificateAuthorities,
    listCertificateAuthoritiesResponse_nextToken,
    listCertificateAuthoritiesResponse_httpStatus,
  )
where

import Amazonka.CertificateManagerPCA.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:/ 'newListCertificateAuthorities' smart constructor.
data ListCertificateAuthorities = ListCertificateAuthorities'
  { -- | Use this parameter when paginating results to specify the maximum number
    -- of items to return in the response on each page. If additional items
    -- exist beyond the number you specify, the @NextToken@ element is sent in
    -- the response. Use this @NextToken@ value in a subsequent request to
    -- retrieve additional items.
    ListCertificateAuthorities -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Use this parameter when paginating results in a subsequent request after
    -- you receive a response with truncated results. Set it to the value of
    -- the @NextToken@ parameter from the response you just received.
    ListCertificateAuthorities -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Use this parameter to filter the returned set of certificate authorities
    -- based on their owner. The default is SELF.
    ListCertificateAuthorities -> Maybe ResourceOwner
resourceOwner :: Prelude.Maybe ResourceOwner
  }
  deriving (ListCertificateAuthorities -> ListCertificateAuthorities -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCertificateAuthorities -> ListCertificateAuthorities -> Bool
$c/= :: ListCertificateAuthorities -> ListCertificateAuthorities -> Bool
== :: ListCertificateAuthorities -> ListCertificateAuthorities -> Bool
$c== :: ListCertificateAuthorities -> ListCertificateAuthorities -> Bool
Prelude.Eq, ReadPrec [ListCertificateAuthorities]
ReadPrec ListCertificateAuthorities
Int -> ReadS ListCertificateAuthorities
ReadS [ListCertificateAuthorities]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCertificateAuthorities]
$creadListPrec :: ReadPrec [ListCertificateAuthorities]
readPrec :: ReadPrec ListCertificateAuthorities
$creadPrec :: ReadPrec ListCertificateAuthorities
readList :: ReadS [ListCertificateAuthorities]
$creadList :: ReadS [ListCertificateAuthorities]
readsPrec :: Int -> ReadS ListCertificateAuthorities
$creadsPrec :: Int -> ReadS ListCertificateAuthorities
Prelude.Read, Int -> ListCertificateAuthorities -> ShowS
[ListCertificateAuthorities] -> ShowS
ListCertificateAuthorities -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCertificateAuthorities] -> ShowS
$cshowList :: [ListCertificateAuthorities] -> ShowS
show :: ListCertificateAuthorities -> String
$cshow :: ListCertificateAuthorities -> String
showsPrec :: Int -> ListCertificateAuthorities -> ShowS
$cshowsPrec :: Int -> ListCertificateAuthorities -> ShowS
Prelude.Show, forall x.
Rep ListCertificateAuthorities x -> ListCertificateAuthorities
forall x.
ListCertificateAuthorities -> Rep ListCertificateAuthorities x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCertificateAuthorities x -> ListCertificateAuthorities
$cfrom :: forall x.
ListCertificateAuthorities -> Rep ListCertificateAuthorities x
Prelude.Generic)

-- |
-- Create a value of 'ListCertificateAuthorities' 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:
--
-- 'maxResults', 'listCertificateAuthorities_maxResults' - Use this parameter when paginating results to specify the maximum number
-- of items to return in the response on each page. If additional items
-- exist beyond the number you specify, the @NextToken@ element is sent in
-- the response. Use this @NextToken@ value in a subsequent request to
-- retrieve additional items.
--
-- 'nextToken', 'listCertificateAuthorities_nextToken' - Use this parameter when paginating results in a subsequent request after
-- you receive a response with truncated results. Set it to the value of
-- the @NextToken@ parameter from the response you just received.
--
-- 'resourceOwner', 'listCertificateAuthorities_resourceOwner' - Use this parameter to filter the returned set of certificate authorities
-- based on their owner. The default is SELF.
newListCertificateAuthorities ::
  ListCertificateAuthorities
newListCertificateAuthorities :: ListCertificateAuthorities
newListCertificateAuthorities =
  ListCertificateAuthorities'
    { $sel:maxResults:ListCertificateAuthorities' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCertificateAuthorities' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceOwner:ListCertificateAuthorities' :: Maybe ResourceOwner
resourceOwner = forall a. Maybe a
Prelude.Nothing
    }

-- | Use this parameter when paginating results to specify the maximum number
-- of items to return in the response on each page. If additional items
-- exist beyond the number you specify, the @NextToken@ element is sent in
-- the response. Use this @NextToken@ value in a subsequent request to
-- retrieve additional items.
listCertificateAuthorities_maxResults :: Lens.Lens' ListCertificateAuthorities (Prelude.Maybe Prelude.Natural)
listCertificateAuthorities_maxResults :: Lens' ListCertificateAuthorities (Maybe Natural)
listCertificateAuthorities_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificateAuthorities' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListCertificateAuthorities
s@ListCertificateAuthorities' {} Maybe Natural
a -> ListCertificateAuthorities
s {$sel:maxResults:ListCertificateAuthorities' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListCertificateAuthorities)

-- | Use this parameter when paginating results in a subsequent request after
-- you receive a response with truncated results. Set it to the value of
-- the @NextToken@ parameter from the response you just received.
listCertificateAuthorities_nextToken :: Lens.Lens' ListCertificateAuthorities (Prelude.Maybe Prelude.Text)
listCertificateAuthorities_nextToken :: Lens' ListCertificateAuthorities (Maybe Text)
listCertificateAuthorities_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificateAuthorities' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCertificateAuthorities
s@ListCertificateAuthorities' {} Maybe Text
a -> ListCertificateAuthorities
s {$sel:nextToken:ListCertificateAuthorities' :: Maybe Text
nextToken = Maybe Text
a} :: ListCertificateAuthorities)

-- | Use this parameter to filter the returned set of certificate authorities
-- based on their owner. The default is SELF.
listCertificateAuthorities_resourceOwner :: Lens.Lens' ListCertificateAuthorities (Prelude.Maybe ResourceOwner)
listCertificateAuthorities_resourceOwner :: Lens' ListCertificateAuthorities (Maybe ResourceOwner)
listCertificateAuthorities_resourceOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificateAuthorities' {Maybe ResourceOwner
resourceOwner :: Maybe ResourceOwner
$sel:resourceOwner:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe ResourceOwner
resourceOwner} -> Maybe ResourceOwner
resourceOwner) (\s :: ListCertificateAuthorities
s@ListCertificateAuthorities' {} Maybe ResourceOwner
a -> ListCertificateAuthorities
s {$sel:resourceOwner:ListCertificateAuthorities' :: Maybe ResourceOwner
resourceOwner = Maybe ResourceOwner
a} :: ListCertificateAuthorities)

instance Core.AWSPager ListCertificateAuthorities where
  page :: ListCertificateAuthorities
-> AWSResponse ListCertificateAuthorities
-> Maybe ListCertificateAuthorities
page ListCertificateAuthorities
rq AWSResponse ListCertificateAuthorities
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCertificateAuthorities
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCertificateAuthoritiesResponse (Maybe Text)
listCertificateAuthoritiesResponse_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 ListCertificateAuthorities
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListCertificateAuthoritiesResponse (Maybe [CertificateAuthority])
listCertificateAuthoritiesResponse_certificateAuthorities
            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.$ ListCertificateAuthorities
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListCertificateAuthorities (Maybe Text)
listCertificateAuthorities_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListCertificateAuthorities
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCertificateAuthoritiesResponse (Maybe Text)
listCertificateAuthoritiesResponse_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 ListCertificateAuthorities where
  type
    AWSResponse ListCertificateAuthorities =
      ListCertificateAuthoritiesResponse
  request :: (Service -> Service)
-> ListCertificateAuthorities -> Request ListCertificateAuthorities
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 ListCertificateAuthorities
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListCertificateAuthorities)))
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 [CertificateAuthority]
-> Maybe Text -> Int -> ListCertificateAuthoritiesResponse
ListCertificateAuthoritiesResponse'
            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
"CertificateAuthorities"
                            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.<*> (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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListCertificateAuthorities where
  hashWithSalt :: Int -> ListCertificateAuthorities -> Int
hashWithSalt Int
_salt ListCertificateAuthorities' {Maybe Natural
Maybe Text
Maybe ResourceOwner
resourceOwner :: Maybe ResourceOwner
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:resourceOwner:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe ResourceOwner
$sel:nextToken:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe Text
$sel:maxResults:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourceOwner
resourceOwner

instance Prelude.NFData ListCertificateAuthorities where
  rnf :: ListCertificateAuthorities -> ()
rnf ListCertificateAuthorities' {Maybe Natural
Maybe Text
Maybe ResourceOwner
resourceOwner :: Maybe ResourceOwner
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:resourceOwner:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe ResourceOwner
$sel:nextToken:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe Text
$sel:maxResults:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      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 ResourceOwner
resourceOwner

instance Data.ToHeaders ListCertificateAuthorities where
  toHeaders :: ListCertificateAuthorities -> 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
"ACMPrivateCA.ListCertificateAuthorities" ::
                          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 ListCertificateAuthorities where
  toJSON :: ListCertificateAuthorities -> Value
toJSON ListCertificateAuthorities' {Maybe Natural
Maybe Text
Maybe ResourceOwner
resourceOwner :: Maybe ResourceOwner
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:resourceOwner:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe ResourceOwner
$sel:nextToken:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe Text
$sel:maxResults:ListCertificateAuthorities' :: ListCertificateAuthorities -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" 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 Natural
maxResults,
            (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
"ResourceOwner" 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 ResourceOwner
resourceOwner
          ]
      )

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

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

-- | /See:/ 'newListCertificateAuthoritiesResponse' smart constructor.
data ListCertificateAuthoritiesResponse = ListCertificateAuthoritiesResponse'
  { -- | Summary information about each certificate authority you have created.
    ListCertificateAuthoritiesResponse -> Maybe [CertificateAuthority]
certificateAuthorities :: Prelude.Maybe [CertificateAuthority],
    -- | When the list is truncated, this value is present and should be used for
    -- the @NextToken@ parameter in a subsequent pagination request.
    ListCertificateAuthoritiesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCertificateAuthoritiesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCertificateAuthoritiesResponse
-> ListCertificateAuthoritiesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCertificateAuthoritiesResponse
-> ListCertificateAuthoritiesResponse -> Bool
$c/= :: ListCertificateAuthoritiesResponse
-> ListCertificateAuthoritiesResponse -> Bool
== :: ListCertificateAuthoritiesResponse
-> ListCertificateAuthoritiesResponse -> Bool
$c== :: ListCertificateAuthoritiesResponse
-> ListCertificateAuthoritiesResponse -> Bool
Prelude.Eq, ReadPrec [ListCertificateAuthoritiesResponse]
ReadPrec ListCertificateAuthoritiesResponse
Int -> ReadS ListCertificateAuthoritiesResponse
ReadS [ListCertificateAuthoritiesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCertificateAuthoritiesResponse]
$creadListPrec :: ReadPrec [ListCertificateAuthoritiesResponse]
readPrec :: ReadPrec ListCertificateAuthoritiesResponse
$creadPrec :: ReadPrec ListCertificateAuthoritiesResponse
readList :: ReadS [ListCertificateAuthoritiesResponse]
$creadList :: ReadS [ListCertificateAuthoritiesResponse]
readsPrec :: Int -> ReadS ListCertificateAuthoritiesResponse
$creadsPrec :: Int -> ReadS ListCertificateAuthoritiesResponse
Prelude.Read, Int -> ListCertificateAuthoritiesResponse -> ShowS
[ListCertificateAuthoritiesResponse] -> ShowS
ListCertificateAuthoritiesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCertificateAuthoritiesResponse] -> ShowS
$cshowList :: [ListCertificateAuthoritiesResponse] -> ShowS
show :: ListCertificateAuthoritiesResponse -> String
$cshow :: ListCertificateAuthoritiesResponse -> String
showsPrec :: Int -> ListCertificateAuthoritiesResponse -> ShowS
$cshowsPrec :: Int -> ListCertificateAuthoritiesResponse -> ShowS
Prelude.Show, forall x.
Rep ListCertificateAuthoritiesResponse x
-> ListCertificateAuthoritiesResponse
forall x.
ListCertificateAuthoritiesResponse
-> Rep ListCertificateAuthoritiesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCertificateAuthoritiesResponse x
-> ListCertificateAuthoritiesResponse
$cfrom :: forall x.
ListCertificateAuthoritiesResponse
-> Rep ListCertificateAuthoritiesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCertificateAuthoritiesResponse' 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:
--
-- 'certificateAuthorities', 'listCertificateAuthoritiesResponse_certificateAuthorities' - Summary information about each certificate authority you have created.
--
-- 'nextToken', 'listCertificateAuthoritiesResponse_nextToken' - When the list is truncated, this value is present and should be used for
-- the @NextToken@ parameter in a subsequent pagination request.
--
-- 'httpStatus', 'listCertificateAuthoritiesResponse_httpStatus' - The response's http status code.
newListCertificateAuthoritiesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCertificateAuthoritiesResponse
newListCertificateAuthoritiesResponse :: Int -> ListCertificateAuthoritiesResponse
newListCertificateAuthoritiesResponse Int
pHttpStatus_ =
  ListCertificateAuthoritiesResponse'
    { $sel:certificateAuthorities:ListCertificateAuthoritiesResponse' :: Maybe [CertificateAuthority]
certificateAuthorities =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCertificateAuthoritiesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCertificateAuthoritiesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Summary information about each certificate authority you have created.
listCertificateAuthoritiesResponse_certificateAuthorities :: Lens.Lens' ListCertificateAuthoritiesResponse (Prelude.Maybe [CertificateAuthority])
listCertificateAuthoritiesResponse_certificateAuthorities :: Lens'
  ListCertificateAuthoritiesResponse (Maybe [CertificateAuthority])
listCertificateAuthoritiesResponse_certificateAuthorities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificateAuthoritiesResponse' {Maybe [CertificateAuthority]
certificateAuthorities :: Maybe [CertificateAuthority]
$sel:certificateAuthorities:ListCertificateAuthoritiesResponse' :: ListCertificateAuthoritiesResponse -> Maybe [CertificateAuthority]
certificateAuthorities} -> Maybe [CertificateAuthority]
certificateAuthorities) (\s :: ListCertificateAuthoritiesResponse
s@ListCertificateAuthoritiesResponse' {} Maybe [CertificateAuthority]
a -> ListCertificateAuthoritiesResponse
s {$sel:certificateAuthorities:ListCertificateAuthoritiesResponse' :: Maybe [CertificateAuthority]
certificateAuthorities = Maybe [CertificateAuthority]
a} :: ListCertificateAuthoritiesResponse) 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

-- | When the list is truncated, this value is present and should be used for
-- the @NextToken@ parameter in a subsequent pagination request.
listCertificateAuthoritiesResponse_nextToken :: Lens.Lens' ListCertificateAuthoritiesResponse (Prelude.Maybe Prelude.Text)
listCertificateAuthoritiesResponse_nextToken :: Lens' ListCertificateAuthoritiesResponse (Maybe Text)
listCertificateAuthoritiesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificateAuthoritiesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCertificateAuthoritiesResponse' :: ListCertificateAuthoritiesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCertificateAuthoritiesResponse
s@ListCertificateAuthoritiesResponse' {} Maybe Text
a -> ListCertificateAuthoritiesResponse
s {$sel:nextToken:ListCertificateAuthoritiesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListCertificateAuthoritiesResponse)

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

instance
  Prelude.NFData
    ListCertificateAuthoritiesResponse
  where
  rnf :: ListCertificateAuthoritiesResponse -> ()
rnf ListCertificateAuthoritiesResponse' {Int
Maybe [CertificateAuthority]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
certificateAuthorities :: Maybe [CertificateAuthority]
$sel:httpStatus:ListCertificateAuthoritiesResponse' :: ListCertificateAuthoritiesResponse -> Int
$sel:nextToken:ListCertificateAuthoritiesResponse' :: ListCertificateAuthoritiesResponse -> Maybe Text
$sel:certificateAuthorities:ListCertificateAuthoritiesResponse' :: ListCertificateAuthoritiesResponse -> Maybe [CertificateAuthority]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CertificateAuthority]
certificateAuthorities
      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 Int
httpStatus