{-# 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.ListPermissions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List all permissions on a private CA, if any, granted to the Certificate
-- Manager (ACM) service principal (acm.amazonaws.com).
--
-- These permissions allow ACM to issue and renew ACM certificates that
-- reside in the same Amazon Web Services account as the CA.
--
-- Permissions can be granted with the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_CreatePermission.html CreatePermission>
-- action and revoked with the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_DeletePermission.html DeletePermission>
-- action.
--
-- __About Permissions__
--
-- -   If the private CA and the certificates it issues reside in the same
--     account, you can use @CreatePermission@ to grant permissions for ACM
--     to carry out automatic certificate renewals.
--
-- -   For automatic certificate renewal to succeed, the ACM service
--     principal needs permissions to create, retrieve, and list
--     certificates.
--
-- -   If the private CA and the ACM certificates reside in different
--     accounts, then permissions cannot be used to enable automatic
--     renewals. Instead, the ACM certificate owner must set up a
--     resource-based policy to enable cross-account issuance and renewals.
--     For more information, see
--     <https://docs.aws.amazon.com/privateca/latest/userguide/pca-rbp.html Using a Resource Based Policy with Amazon Web Services Private CA>.
--
-- This operation returns paginated results.
module Amazonka.CertificateManagerPCA.ListPermissions
  ( -- * Creating a Request
    ListPermissions (..),
    newListPermissions,

    -- * Request Lenses
    listPermissions_maxResults,
    listPermissions_nextToken,
    listPermissions_certificateAuthorityArn,

    -- * Destructuring the Response
    ListPermissionsResponse (..),
    newListPermissionsResponse,

    -- * Response Lenses
    listPermissionsResponse_nextToken,
    listPermissionsResponse_permissions,
    listPermissionsResponse_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:/ 'newListPermissions' smart constructor.
data ListPermissions = ListPermissions'
  { -- | When paginating results, use this parameter to specify the maximum
    -- number of items to return in the response. 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.
    ListPermissions -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | When paginating results, use this parameter in a subsequent request
    -- after you receive a response with truncated results. Set it to the value
    -- of __NextToken__ from the response you just received.
    ListPermissions -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Number (ARN) of the private CA to inspect. You can
    -- find the ARN by calling the
    -- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
    -- action. This must be of the form:
    -- @arn:aws:acm-pca:region:account:certificate-authority\/12345678-1234-1234-1234-123456789012@
    -- You can get a private CA\'s ARN by running the
    -- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
    -- action.
    ListPermissions -> Text
certificateAuthorityArn :: Prelude.Text
  }
  deriving (ListPermissions -> ListPermissions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPermissions -> ListPermissions -> Bool
$c/= :: ListPermissions -> ListPermissions -> Bool
== :: ListPermissions -> ListPermissions -> Bool
$c== :: ListPermissions -> ListPermissions -> Bool
Prelude.Eq, ReadPrec [ListPermissions]
ReadPrec ListPermissions
Int -> ReadS ListPermissions
ReadS [ListPermissions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPermissions]
$creadListPrec :: ReadPrec [ListPermissions]
readPrec :: ReadPrec ListPermissions
$creadPrec :: ReadPrec ListPermissions
readList :: ReadS [ListPermissions]
$creadList :: ReadS [ListPermissions]
readsPrec :: Int -> ReadS ListPermissions
$creadsPrec :: Int -> ReadS ListPermissions
Prelude.Read, Int -> ListPermissions -> ShowS
[ListPermissions] -> ShowS
ListPermissions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPermissions] -> ShowS
$cshowList :: [ListPermissions] -> ShowS
show :: ListPermissions -> String
$cshow :: ListPermissions -> String
showsPrec :: Int -> ListPermissions -> ShowS
$cshowsPrec :: Int -> ListPermissions -> ShowS
Prelude.Show, forall x. Rep ListPermissions x -> ListPermissions
forall x. ListPermissions -> Rep ListPermissions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPermissions x -> ListPermissions
$cfrom :: forall x. ListPermissions -> Rep ListPermissions x
Prelude.Generic)

-- |
-- Create a value of 'ListPermissions' 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', 'listPermissions_maxResults' - When paginating results, use this parameter to specify the maximum
-- number of items to return in the response. 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', 'listPermissions_nextToken' - When paginating results, use this parameter in a subsequent request
-- after you receive a response with truncated results. Set it to the value
-- of __NextToken__ from the response you just received.
--
-- 'certificateAuthorityArn', 'listPermissions_certificateAuthorityArn' - The Amazon Resource Number (ARN) of the private CA to inspect. You can
-- find the ARN by calling the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
-- action. This must be of the form:
-- @arn:aws:acm-pca:region:account:certificate-authority\/12345678-1234-1234-1234-123456789012@
-- You can get a private CA\'s ARN by running the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
-- action.
newListPermissions ::
  -- | 'certificateAuthorityArn'
  Prelude.Text ->
  ListPermissions
newListPermissions :: Text -> ListPermissions
newListPermissions Text
pCertificateAuthorityArn_ =
  ListPermissions'
    { $sel:maxResults:ListPermissions' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListPermissions' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:certificateAuthorityArn:ListPermissions' :: Text
certificateAuthorityArn = Text
pCertificateAuthorityArn_
    }

-- | When paginating results, use this parameter to specify the maximum
-- number of items to return in the response. 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.
listPermissions_maxResults :: Lens.Lens' ListPermissions (Prelude.Maybe Prelude.Natural)
listPermissions_maxResults :: Lens' ListPermissions (Maybe Natural)
listPermissions_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPermissions' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListPermissions' :: ListPermissions -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListPermissions
s@ListPermissions' {} Maybe Natural
a -> ListPermissions
s {$sel:maxResults:ListPermissions' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListPermissions)

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

-- | The Amazon Resource Number (ARN) of the private CA to inspect. You can
-- find the ARN by calling the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
-- action. This must be of the form:
-- @arn:aws:acm-pca:region:account:certificate-authority\/12345678-1234-1234-1234-123456789012@
-- You can get a private CA\'s ARN by running the
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_ListCertificateAuthorities.html ListCertificateAuthorities>
-- action.
listPermissions_certificateAuthorityArn :: Lens.Lens' ListPermissions Prelude.Text
listPermissions_certificateAuthorityArn :: Lens' ListPermissions Text
listPermissions_certificateAuthorityArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPermissions' {Text
certificateAuthorityArn :: Text
$sel:certificateAuthorityArn:ListPermissions' :: ListPermissions -> Text
certificateAuthorityArn} -> Text
certificateAuthorityArn) (\s :: ListPermissions
s@ListPermissions' {} Text
a -> ListPermissions
s {$sel:certificateAuthorityArn:ListPermissions' :: Text
certificateAuthorityArn = Text
a} :: ListPermissions)

instance Core.AWSPager ListPermissions where
  page :: ListPermissions
-> AWSResponse ListPermissions -> Maybe ListPermissions
page ListPermissions
rq AWSResponse ListPermissions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListPermissions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPermissionsResponse (Maybe Text)
listPermissionsResponse_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 ListPermissions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPermissionsResponse (Maybe [Permission])
listPermissionsResponse_permissions
            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.$ ListPermissions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListPermissions (Maybe Text)
listPermissions_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListPermissions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPermissionsResponse (Maybe Text)
listPermissionsResponse_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 ListPermissions where
  type
    AWSResponse ListPermissions =
      ListPermissionsResponse
  request :: (Service -> Service) -> ListPermissions -> Request ListPermissions
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 ListPermissions
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListPermissions)))
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 [Permission] -> Int -> ListPermissionsResponse
ListPermissionsResponse'
            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
"Permissions" 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 ListPermissions where
  hashWithSalt :: Int -> ListPermissions -> Int
hashWithSalt Int
_salt ListPermissions' {Maybe Natural
Maybe Text
Text
certificateAuthorityArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:certificateAuthorityArn:ListPermissions' :: ListPermissions -> Text
$sel:nextToken:ListPermissions' :: ListPermissions -> Maybe Text
$sel:maxResults:ListPermissions' :: ListPermissions -> 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` Text
certificateAuthorityArn

instance Prelude.NFData ListPermissions where
  rnf :: ListPermissions -> ()
rnf ListPermissions' {Maybe Natural
Maybe Text
Text
certificateAuthorityArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:certificateAuthorityArn:ListPermissions' :: ListPermissions -> Text
$sel:nextToken:ListPermissions' :: ListPermissions -> Maybe Text
$sel:maxResults:ListPermissions' :: ListPermissions -> 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 Text
certificateAuthorityArn

instance Data.ToHeaders ListPermissions where
  toHeaders :: ListPermissions -> 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.ListPermissions" ::
                          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 ListPermissions where
  toJSON :: ListPermissions -> Value
toJSON ListPermissions' {Maybe Natural
Maybe Text
Text
certificateAuthorityArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:certificateAuthorityArn:ListPermissions' :: ListPermissions -> Text
$sel:nextToken:ListPermissions' :: ListPermissions -> Maybe Text
$sel:maxResults:ListPermissions' :: ListPermissions -> 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,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"CertificateAuthorityArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
certificateAuthorityArn
              )
          ]
      )

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

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

-- | /See:/ 'newListPermissionsResponse' smart constructor.
data ListPermissionsResponse = ListPermissionsResponse'
  { -- | When the list is truncated, this value is present and should be used for
    -- the __NextToken__ parameter in a subsequent pagination request.
    ListPermissionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Summary information about each permission assigned by the specified
    -- private CA, including the action enabled, the policy provided, and the
    -- time of creation.
    ListPermissionsResponse -> Maybe [Permission]
permissions :: Prelude.Maybe [Permission],
    -- | The response's http status code.
    ListPermissionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListPermissionsResponse -> ListPermissionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPermissionsResponse -> ListPermissionsResponse -> Bool
$c/= :: ListPermissionsResponse -> ListPermissionsResponse -> Bool
== :: ListPermissionsResponse -> ListPermissionsResponse -> Bool
$c== :: ListPermissionsResponse -> ListPermissionsResponse -> Bool
Prelude.Eq, ReadPrec [ListPermissionsResponse]
ReadPrec ListPermissionsResponse
Int -> ReadS ListPermissionsResponse
ReadS [ListPermissionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPermissionsResponse]
$creadListPrec :: ReadPrec [ListPermissionsResponse]
readPrec :: ReadPrec ListPermissionsResponse
$creadPrec :: ReadPrec ListPermissionsResponse
readList :: ReadS [ListPermissionsResponse]
$creadList :: ReadS [ListPermissionsResponse]
readsPrec :: Int -> ReadS ListPermissionsResponse
$creadsPrec :: Int -> ReadS ListPermissionsResponse
Prelude.Read, Int -> ListPermissionsResponse -> ShowS
[ListPermissionsResponse] -> ShowS
ListPermissionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPermissionsResponse] -> ShowS
$cshowList :: [ListPermissionsResponse] -> ShowS
show :: ListPermissionsResponse -> String
$cshow :: ListPermissionsResponse -> String
showsPrec :: Int -> ListPermissionsResponse -> ShowS
$cshowsPrec :: Int -> ListPermissionsResponse -> ShowS
Prelude.Show, forall x. Rep ListPermissionsResponse x -> ListPermissionsResponse
forall x. ListPermissionsResponse -> Rep ListPermissionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPermissionsResponse x -> ListPermissionsResponse
$cfrom :: forall x. ListPermissionsResponse -> Rep ListPermissionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListPermissionsResponse' 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', 'listPermissionsResponse_nextToken' - When the list is truncated, this value is present and should be used for
-- the __NextToken__ parameter in a subsequent pagination request.
--
-- 'permissions', 'listPermissionsResponse_permissions' - Summary information about each permission assigned by the specified
-- private CA, including the action enabled, the policy provided, and the
-- time of creation.
--
-- 'httpStatus', 'listPermissionsResponse_httpStatus' - The response's http status code.
newListPermissionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListPermissionsResponse
newListPermissionsResponse :: Int -> ListPermissionsResponse
newListPermissionsResponse Int
pHttpStatus_ =
  ListPermissionsResponse'
    { $sel:nextToken:ListPermissionsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:permissions:ListPermissionsResponse' :: Maybe [Permission]
permissions = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListPermissionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | Summary information about each permission assigned by the specified
-- private CA, including the action enabled, the policy provided, and the
-- time of creation.
listPermissionsResponse_permissions :: Lens.Lens' ListPermissionsResponse (Prelude.Maybe [Permission])
listPermissionsResponse_permissions :: Lens' ListPermissionsResponse (Maybe [Permission])
listPermissionsResponse_permissions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPermissionsResponse' {Maybe [Permission]
permissions :: Maybe [Permission]
$sel:permissions:ListPermissionsResponse' :: ListPermissionsResponse -> Maybe [Permission]
permissions} -> Maybe [Permission]
permissions) (\s :: ListPermissionsResponse
s@ListPermissionsResponse' {} Maybe [Permission]
a -> ListPermissionsResponse
s {$sel:permissions:ListPermissionsResponse' :: Maybe [Permission]
permissions = Maybe [Permission]
a} :: ListPermissionsResponse) 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.
listPermissionsResponse_httpStatus :: Lens.Lens' ListPermissionsResponse Prelude.Int
listPermissionsResponse_httpStatus :: Lens' ListPermissionsResponse Int
listPermissionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPermissionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListPermissionsResponse' :: ListPermissionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListPermissionsResponse
s@ListPermissionsResponse' {} Int
a -> ListPermissionsResponse
s {$sel:httpStatus:ListPermissionsResponse' :: Int
httpStatus = Int
a} :: ListPermissionsResponse)

instance Prelude.NFData ListPermissionsResponse where
  rnf :: ListPermissionsResponse -> ()
rnf ListPermissionsResponse' {Int
Maybe [Permission]
Maybe Text
httpStatus :: Int
permissions :: Maybe [Permission]
nextToken :: Maybe Text
$sel:httpStatus:ListPermissionsResponse' :: ListPermissionsResponse -> Int
$sel:permissions:ListPermissionsResponse' :: ListPermissionsResponse -> Maybe [Permission]
$sel:nextToken:ListPermissionsResponse' :: ListPermissionsResponse -> 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 [Permission]
permissions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus