{-# 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.Signer.ListProfilePermissions
-- 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 cross-account permissions associated with a signing profile.
module Amazonka.Signer.ListProfilePermissions
  ( -- * Creating a Request
    ListProfilePermissions (..),
    newListProfilePermissions,

    -- * Request Lenses
    listProfilePermissions_nextToken,
    listProfilePermissions_profileName,

    -- * Destructuring the Response
    ListProfilePermissionsResponse (..),
    newListProfilePermissionsResponse,

    -- * Response Lenses
    listProfilePermissionsResponse_nextToken,
    listProfilePermissionsResponse_permissions,
    listProfilePermissionsResponse_policySizeBytes,
    listProfilePermissionsResponse_revisionId,
    listProfilePermissionsResponse_httpStatus,
  )
where

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
import Amazonka.Signer.Types

-- | /See:/ 'newListProfilePermissions' smart constructor.
data ListProfilePermissions = ListProfilePermissions'
  { -- | String for specifying the next set of paginated results.
    ListProfilePermissions -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Name of the signing profile containing the cross-account permissions.
    ListProfilePermissions -> Text
profileName :: Prelude.Text
  }
  deriving (ListProfilePermissions -> ListProfilePermissions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListProfilePermissions -> ListProfilePermissions -> Bool
$c/= :: ListProfilePermissions -> ListProfilePermissions -> Bool
== :: ListProfilePermissions -> ListProfilePermissions -> Bool
$c== :: ListProfilePermissions -> ListProfilePermissions -> Bool
Prelude.Eq, ReadPrec [ListProfilePermissions]
ReadPrec ListProfilePermissions
Int -> ReadS ListProfilePermissions
ReadS [ListProfilePermissions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListProfilePermissions]
$creadListPrec :: ReadPrec [ListProfilePermissions]
readPrec :: ReadPrec ListProfilePermissions
$creadPrec :: ReadPrec ListProfilePermissions
readList :: ReadS [ListProfilePermissions]
$creadList :: ReadS [ListProfilePermissions]
readsPrec :: Int -> ReadS ListProfilePermissions
$creadsPrec :: Int -> ReadS ListProfilePermissions
Prelude.Read, Int -> ListProfilePermissions -> ShowS
[ListProfilePermissions] -> ShowS
ListProfilePermissions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListProfilePermissions] -> ShowS
$cshowList :: [ListProfilePermissions] -> ShowS
show :: ListProfilePermissions -> String
$cshow :: ListProfilePermissions -> String
showsPrec :: Int -> ListProfilePermissions -> ShowS
$cshowsPrec :: Int -> ListProfilePermissions -> ShowS
Prelude.Show, forall x. Rep ListProfilePermissions x -> ListProfilePermissions
forall x. ListProfilePermissions -> Rep ListProfilePermissions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListProfilePermissions x -> ListProfilePermissions
$cfrom :: forall x. ListProfilePermissions -> Rep ListProfilePermissions x
Prelude.Generic)

-- |
-- Create a value of 'ListProfilePermissions' 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', 'listProfilePermissions_nextToken' - String for specifying the next set of paginated results.
--
-- 'profileName', 'listProfilePermissions_profileName' - Name of the signing profile containing the cross-account permissions.
newListProfilePermissions ::
  -- | 'profileName'
  Prelude.Text ->
  ListProfilePermissions
newListProfilePermissions :: Text -> ListProfilePermissions
newListProfilePermissions Text
pProfileName_ =
  ListProfilePermissions'
    { $sel:nextToken:ListProfilePermissions' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:profileName:ListProfilePermissions' :: Text
profileName = Text
pProfileName_
    }

-- | String for specifying the next set of paginated results.
listProfilePermissions_nextToken :: Lens.Lens' ListProfilePermissions (Prelude.Maybe Prelude.Text)
listProfilePermissions_nextToken :: Lens' ListProfilePermissions (Maybe Text)
listProfilePermissions_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListProfilePermissions' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListProfilePermissions' :: ListProfilePermissions -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListProfilePermissions
s@ListProfilePermissions' {} Maybe Text
a -> ListProfilePermissions
s {$sel:nextToken:ListProfilePermissions' :: Maybe Text
nextToken = Maybe Text
a} :: ListProfilePermissions)

-- | Name of the signing profile containing the cross-account permissions.
listProfilePermissions_profileName :: Lens.Lens' ListProfilePermissions Prelude.Text
listProfilePermissions_profileName :: Lens' ListProfilePermissions Text
listProfilePermissions_profileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListProfilePermissions' {Text
profileName :: Text
$sel:profileName:ListProfilePermissions' :: ListProfilePermissions -> Text
profileName} -> Text
profileName) (\s :: ListProfilePermissions
s@ListProfilePermissions' {} Text
a -> ListProfilePermissions
s {$sel:profileName:ListProfilePermissions' :: Text
profileName = Text
a} :: ListProfilePermissions)

instance Core.AWSRequest ListProfilePermissions where
  type
    AWSResponse ListProfilePermissions =
      ListProfilePermissionsResponse
  request :: (Service -> Service)
-> ListProfilePermissions -> Request ListProfilePermissions
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListProfilePermissions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListProfilePermissions)))
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]
-> Maybe Int
-> Maybe Text
-> Int
-> ListProfilePermissionsResponse
ListProfilePermissionsResponse'
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"policySizeBytes")
            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
"revisionId")
            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 ListProfilePermissions where
  hashWithSalt :: Int -> ListProfilePermissions -> Int
hashWithSalt Int
_salt ListProfilePermissions' {Maybe Text
Text
profileName :: Text
nextToken :: Maybe Text
$sel:profileName:ListProfilePermissions' :: ListProfilePermissions -> Text
$sel:nextToken:ListProfilePermissions' :: ListProfilePermissions -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profileName

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

instance Data.ToHeaders ListProfilePermissions where
  toHeaders :: ListProfilePermissions -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath ListProfilePermissions where
  toPath :: ListProfilePermissions -> ByteString
toPath ListProfilePermissions' {Maybe Text
Text
profileName :: Text
nextToken :: Maybe Text
$sel:profileName:ListProfilePermissions' :: ListProfilePermissions -> Text
$sel:nextToken:ListProfilePermissions' :: ListProfilePermissions -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/signing-profiles/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
profileName,
        ByteString
"/permissions"
      ]

instance Data.ToQuery ListProfilePermissions where
  toQuery :: ListProfilePermissions -> QueryString
toQuery ListProfilePermissions' {Maybe Text
Text
profileName :: Text
nextToken :: Maybe Text
$sel:profileName:ListProfilePermissions' :: ListProfilePermissions -> Text
$sel:nextToken:ListProfilePermissions' :: ListProfilePermissions -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken]

-- | /See:/ 'newListProfilePermissionsResponse' smart constructor.
data ListProfilePermissionsResponse = ListProfilePermissionsResponse'
  { -- | String for specifying the next set of paginated results.
    ListProfilePermissionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | List of permissions associated with the Signing Profile.
    ListProfilePermissionsResponse -> Maybe [Permission]
permissions :: Prelude.Maybe [Permission],
    -- | Total size of the policy associated with the Signing Profile in bytes.
    ListProfilePermissionsResponse -> Maybe Int
policySizeBytes :: Prelude.Maybe Prelude.Int,
    -- | The identifier for the current revision of profile permissions.
    ListProfilePermissionsResponse -> Maybe Text
revisionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListProfilePermissionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListProfilePermissionsResponse
-> ListProfilePermissionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListProfilePermissionsResponse
-> ListProfilePermissionsResponse -> Bool
$c/= :: ListProfilePermissionsResponse
-> ListProfilePermissionsResponse -> Bool
== :: ListProfilePermissionsResponse
-> ListProfilePermissionsResponse -> Bool
$c== :: ListProfilePermissionsResponse
-> ListProfilePermissionsResponse -> Bool
Prelude.Eq, ReadPrec [ListProfilePermissionsResponse]
ReadPrec ListProfilePermissionsResponse
Int -> ReadS ListProfilePermissionsResponse
ReadS [ListProfilePermissionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListProfilePermissionsResponse]
$creadListPrec :: ReadPrec [ListProfilePermissionsResponse]
readPrec :: ReadPrec ListProfilePermissionsResponse
$creadPrec :: ReadPrec ListProfilePermissionsResponse
readList :: ReadS [ListProfilePermissionsResponse]
$creadList :: ReadS [ListProfilePermissionsResponse]
readsPrec :: Int -> ReadS ListProfilePermissionsResponse
$creadsPrec :: Int -> ReadS ListProfilePermissionsResponse
Prelude.Read, Int -> ListProfilePermissionsResponse -> ShowS
[ListProfilePermissionsResponse] -> ShowS
ListProfilePermissionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListProfilePermissionsResponse] -> ShowS
$cshowList :: [ListProfilePermissionsResponse] -> ShowS
show :: ListProfilePermissionsResponse -> String
$cshow :: ListProfilePermissionsResponse -> String
showsPrec :: Int -> ListProfilePermissionsResponse -> ShowS
$cshowsPrec :: Int -> ListProfilePermissionsResponse -> ShowS
Prelude.Show, forall x.
Rep ListProfilePermissionsResponse x
-> ListProfilePermissionsResponse
forall x.
ListProfilePermissionsResponse
-> Rep ListProfilePermissionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListProfilePermissionsResponse x
-> ListProfilePermissionsResponse
$cfrom :: forall x.
ListProfilePermissionsResponse
-> Rep ListProfilePermissionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListProfilePermissionsResponse' 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', 'listProfilePermissionsResponse_nextToken' - String for specifying the next set of paginated results.
--
-- 'permissions', 'listProfilePermissionsResponse_permissions' - List of permissions associated with the Signing Profile.
--
-- 'policySizeBytes', 'listProfilePermissionsResponse_policySizeBytes' - Total size of the policy associated with the Signing Profile in bytes.
--
-- 'revisionId', 'listProfilePermissionsResponse_revisionId' - The identifier for the current revision of profile permissions.
--
-- 'httpStatus', 'listProfilePermissionsResponse_httpStatus' - The response's http status code.
newListProfilePermissionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListProfilePermissionsResponse
newListProfilePermissionsResponse :: Int -> ListProfilePermissionsResponse
newListProfilePermissionsResponse Int
pHttpStatus_ =
  ListProfilePermissionsResponse'
    { $sel:nextToken:ListProfilePermissionsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:permissions:ListProfilePermissionsResponse' :: Maybe [Permission]
permissions = forall a. Maybe a
Prelude.Nothing,
      $sel:policySizeBytes:ListProfilePermissionsResponse' :: Maybe Int
policySizeBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:revisionId:ListProfilePermissionsResponse' :: Maybe Text
revisionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListProfilePermissionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | String for specifying the next set of paginated results.
listProfilePermissionsResponse_nextToken :: Lens.Lens' ListProfilePermissionsResponse (Prelude.Maybe Prelude.Text)
listProfilePermissionsResponse_nextToken :: Lens' ListProfilePermissionsResponse (Maybe Text)
listProfilePermissionsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListProfilePermissionsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListProfilePermissionsResponse' :: ListProfilePermissionsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListProfilePermissionsResponse
s@ListProfilePermissionsResponse' {} Maybe Text
a -> ListProfilePermissionsResponse
s {$sel:nextToken:ListProfilePermissionsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListProfilePermissionsResponse)

-- | List of permissions associated with the Signing Profile.
listProfilePermissionsResponse_permissions :: Lens.Lens' ListProfilePermissionsResponse (Prelude.Maybe [Permission])
listProfilePermissionsResponse_permissions :: Lens' ListProfilePermissionsResponse (Maybe [Permission])
listProfilePermissionsResponse_permissions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListProfilePermissionsResponse' {Maybe [Permission]
permissions :: Maybe [Permission]
$sel:permissions:ListProfilePermissionsResponse' :: ListProfilePermissionsResponse -> Maybe [Permission]
permissions} -> Maybe [Permission]
permissions) (\s :: ListProfilePermissionsResponse
s@ListProfilePermissionsResponse' {} Maybe [Permission]
a -> ListProfilePermissionsResponse
s {$sel:permissions:ListProfilePermissionsResponse' :: Maybe [Permission]
permissions = Maybe [Permission]
a} :: ListProfilePermissionsResponse) 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

-- | Total size of the policy associated with the Signing Profile in bytes.
listProfilePermissionsResponse_policySizeBytes :: Lens.Lens' ListProfilePermissionsResponse (Prelude.Maybe Prelude.Int)
listProfilePermissionsResponse_policySizeBytes :: Lens' ListProfilePermissionsResponse (Maybe Int)
listProfilePermissionsResponse_policySizeBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListProfilePermissionsResponse' {Maybe Int
policySizeBytes :: Maybe Int
$sel:policySizeBytes:ListProfilePermissionsResponse' :: ListProfilePermissionsResponse -> Maybe Int
policySizeBytes} -> Maybe Int
policySizeBytes) (\s :: ListProfilePermissionsResponse
s@ListProfilePermissionsResponse' {} Maybe Int
a -> ListProfilePermissionsResponse
s {$sel:policySizeBytes:ListProfilePermissionsResponse' :: Maybe Int
policySizeBytes = Maybe Int
a} :: ListProfilePermissionsResponse)

-- | The identifier for the current revision of profile permissions.
listProfilePermissionsResponse_revisionId :: Lens.Lens' ListProfilePermissionsResponse (Prelude.Maybe Prelude.Text)
listProfilePermissionsResponse_revisionId :: Lens' ListProfilePermissionsResponse (Maybe Text)
listProfilePermissionsResponse_revisionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListProfilePermissionsResponse' {Maybe Text
revisionId :: Maybe Text
$sel:revisionId:ListProfilePermissionsResponse' :: ListProfilePermissionsResponse -> Maybe Text
revisionId} -> Maybe Text
revisionId) (\s :: ListProfilePermissionsResponse
s@ListProfilePermissionsResponse' {} Maybe Text
a -> ListProfilePermissionsResponse
s {$sel:revisionId:ListProfilePermissionsResponse' :: Maybe Text
revisionId = Maybe Text
a} :: ListProfilePermissionsResponse)

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

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