{-# 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.SSOAdmin.ListPermissionSets
-- 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 PermissionSets in an IAM Identity Center instance.
--
-- This operation returns paginated results.
module Amazonka.SSOAdmin.ListPermissionSets
  ( -- * Creating a Request
    ListPermissionSets (..),
    newListPermissionSets,

    -- * Request Lenses
    listPermissionSets_maxResults,
    listPermissionSets_nextToken,
    listPermissionSets_instanceArn,

    -- * Destructuring the Response
    ListPermissionSetsResponse (..),
    newListPermissionSetsResponse,

    -- * Response Lenses
    listPermissionSetsResponse_nextToken,
    listPermissionSetsResponse_permissionSets,
    listPermissionSetsResponse_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.SSOAdmin.Types

-- | /See:/ 'newListPermissionSets' smart constructor.
data ListPermissionSets = ListPermissionSets'
  { -- | The maximum number of results to display for the assignment.
    ListPermissionSets -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The pagination token for the list API. Initially the value is null. Use
    -- the output of previous API calls to make subsequent calls.
    ListPermissionSets -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the IAM Identity Center instance under which the operation
    -- will be executed. For more information about ARNs, see
    -- </general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and AWS Service Namespaces>
    -- in the /AWS General Reference/.
    ListPermissionSets -> Text
instanceArn :: Prelude.Text
  }
  deriving (ListPermissionSets -> ListPermissionSets -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPermissionSets -> ListPermissionSets -> Bool
$c/= :: ListPermissionSets -> ListPermissionSets -> Bool
== :: ListPermissionSets -> ListPermissionSets -> Bool
$c== :: ListPermissionSets -> ListPermissionSets -> Bool
Prelude.Eq, ReadPrec [ListPermissionSets]
ReadPrec ListPermissionSets
Int -> ReadS ListPermissionSets
ReadS [ListPermissionSets]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPermissionSets]
$creadListPrec :: ReadPrec [ListPermissionSets]
readPrec :: ReadPrec ListPermissionSets
$creadPrec :: ReadPrec ListPermissionSets
readList :: ReadS [ListPermissionSets]
$creadList :: ReadS [ListPermissionSets]
readsPrec :: Int -> ReadS ListPermissionSets
$creadsPrec :: Int -> ReadS ListPermissionSets
Prelude.Read, Int -> ListPermissionSets -> ShowS
[ListPermissionSets] -> ShowS
ListPermissionSets -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPermissionSets] -> ShowS
$cshowList :: [ListPermissionSets] -> ShowS
show :: ListPermissionSets -> String
$cshow :: ListPermissionSets -> String
showsPrec :: Int -> ListPermissionSets -> ShowS
$cshowsPrec :: Int -> ListPermissionSets -> ShowS
Prelude.Show, forall x. Rep ListPermissionSets x -> ListPermissionSets
forall x. ListPermissionSets -> Rep ListPermissionSets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPermissionSets x -> ListPermissionSets
$cfrom :: forall x. ListPermissionSets -> Rep ListPermissionSets x
Prelude.Generic)

-- |
-- Create a value of 'ListPermissionSets' 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', 'listPermissionSets_maxResults' - The maximum number of results to display for the assignment.
--
-- 'nextToken', 'listPermissionSets_nextToken' - The pagination token for the list API. Initially the value is null. Use
-- the output of previous API calls to make subsequent calls.
--
-- 'instanceArn', 'listPermissionSets_instanceArn' - The ARN of the IAM Identity Center instance under which the operation
-- will be executed. For more information about ARNs, see
-- </general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and AWS Service Namespaces>
-- in the /AWS General Reference/.
newListPermissionSets ::
  -- | 'instanceArn'
  Prelude.Text ->
  ListPermissionSets
newListPermissionSets :: Text -> ListPermissionSets
newListPermissionSets Text
pInstanceArn_ =
  ListPermissionSets'
    { $sel:maxResults:ListPermissionSets' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListPermissionSets' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceArn:ListPermissionSets' :: Text
instanceArn = Text
pInstanceArn_
    }

-- | The maximum number of results to display for the assignment.
listPermissionSets_maxResults :: Lens.Lens' ListPermissionSets (Prelude.Maybe Prelude.Natural)
listPermissionSets_maxResults :: Lens' ListPermissionSets (Maybe Natural)
listPermissionSets_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPermissionSets' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListPermissionSets' :: ListPermissionSets -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListPermissionSets
s@ListPermissionSets' {} Maybe Natural
a -> ListPermissionSets
s {$sel:maxResults:ListPermissionSets' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListPermissionSets)

-- | The pagination token for the list API. Initially the value is null. Use
-- the output of previous API calls to make subsequent calls.
listPermissionSets_nextToken :: Lens.Lens' ListPermissionSets (Prelude.Maybe Prelude.Text)
listPermissionSets_nextToken :: Lens' ListPermissionSets (Maybe Text)
listPermissionSets_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPermissionSets' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPermissionSets' :: ListPermissionSets -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPermissionSets
s@ListPermissionSets' {} Maybe Text
a -> ListPermissionSets
s {$sel:nextToken:ListPermissionSets' :: Maybe Text
nextToken = Maybe Text
a} :: ListPermissionSets)

-- | The ARN of the IAM Identity Center instance under which the operation
-- will be executed. For more information about ARNs, see
-- </general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and AWS Service Namespaces>
-- in the /AWS General Reference/.
listPermissionSets_instanceArn :: Lens.Lens' ListPermissionSets Prelude.Text
listPermissionSets_instanceArn :: Lens' ListPermissionSets Text
listPermissionSets_instanceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPermissionSets' {Text
instanceArn :: Text
$sel:instanceArn:ListPermissionSets' :: ListPermissionSets -> Text
instanceArn} -> Text
instanceArn) (\s :: ListPermissionSets
s@ListPermissionSets' {} Text
a -> ListPermissionSets
s {$sel:instanceArn:ListPermissionSets' :: Text
instanceArn = Text
a} :: ListPermissionSets)

instance Core.AWSPager ListPermissionSets where
  page :: ListPermissionSets
-> AWSResponse ListPermissionSets -> Maybe ListPermissionSets
page ListPermissionSets
rq AWSResponse ListPermissionSets
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListPermissionSets
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPermissionSetsResponse (Maybe Text)
listPermissionSetsResponse_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 ListPermissionSets
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPermissionSetsResponse (Maybe [Text])
listPermissionSetsResponse_permissionSets
            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.$ ListPermissionSets
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListPermissionSets (Maybe Text)
listPermissionSets_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListPermissionSets
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPermissionSetsResponse (Maybe Text)
listPermissionSetsResponse_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 ListPermissionSets where
  type
    AWSResponse ListPermissionSets =
      ListPermissionSetsResponse
  request :: (Service -> Service)
-> ListPermissionSets -> Request ListPermissionSets
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 ListPermissionSets
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListPermissionSets)))
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 [Text] -> Int -> ListPermissionSetsResponse
ListPermissionSetsResponse'
            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
"PermissionSets" 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 ListPermissionSets where
  hashWithSalt :: Int -> ListPermissionSets -> Int
hashWithSalt Int
_salt ListPermissionSets' {Maybe Natural
Maybe Text
Text
instanceArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:instanceArn:ListPermissionSets' :: ListPermissionSets -> Text
$sel:nextToken:ListPermissionSets' :: ListPermissionSets -> Maybe Text
$sel:maxResults:ListPermissionSets' :: ListPermissionSets -> 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
instanceArn

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

instance Data.ToHeaders ListPermissionSets where
  toHeaders :: ListPermissionSets -> 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
"SWBExternalService.ListPermissionSets" ::
                          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 ListPermissionSets where
  toJSON :: ListPermissionSets -> Value
toJSON ListPermissionSets' {Maybe Natural
Maybe Text
Text
instanceArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:instanceArn:ListPermissionSets' :: ListPermissionSets -> Text
$sel:nextToken:ListPermissionSets' :: ListPermissionSets -> Maybe Text
$sel:maxResults:ListPermissionSets' :: ListPermissionSets -> 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
"InstanceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceArn)
          ]
      )

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

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

-- | /See:/ 'newListPermissionSetsResponse' smart constructor.
data ListPermissionSetsResponse = ListPermissionSetsResponse'
  { -- | The pagination token for the list API. Initially the value is null. Use
    -- the output of previous API calls to make subsequent calls.
    ListPermissionSetsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Defines the level of access on an AWS account.
    ListPermissionSetsResponse -> Maybe [Text]
permissionSets :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    ListPermissionSetsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListPermissionSetsResponse -> ListPermissionSetsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPermissionSetsResponse -> ListPermissionSetsResponse -> Bool
$c/= :: ListPermissionSetsResponse -> ListPermissionSetsResponse -> Bool
== :: ListPermissionSetsResponse -> ListPermissionSetsResponse -> Bool
$c== :: ListPermissionSetsResponse -> ListPermissionSetsResponse -> Bool
Prelude.Eq, ReadPrec [ListPermissionSetsResponse]
ReadPrec ListPermissionSetsResponse
Int -> ReadS ListPermissionSetsResponse
ReadS [ListPermissionSetsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPermissionSetsResponse]
$creadListPrec :: ReadPrec [ListPermissionSetsResponse]
readPrec :: ReadPrec ListPermissionSetsResponse
$creadPrec :: ReadPrec ListPermissionSetsResponse
readList :: ReadS [ListPermissionSetsResponse]
$creadList :: ReadS [ListPermissionSetsResponse]
readsPrec :: Int -> ReadS ListPermissionSetsResponse
$creadsPrec :: Int -> ReadS ListPermissionSetsResponse
Prelude.Read, Int -> ListPermissionSetsResponse -> ShowS
[ListPermissionSetsResponse] -> ShowS
ListPermissionSetsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPermissionSetsResponse] -> ShowS
$cshowList :: [ListPermissionSetsResponse] -> ShowS
show :: ListPermissionSetsResponse -> String
$cshow :: ListPermissionSetsResponse -> String
showsPrec :: Int -> ListPermissionSetsResponse -> ShowS
$cshowsPrec :: Int -> ListPermissionSetsResponse -> ShowS
Prelude.Show, forall x.
Rep ListPermissionSetsResponse x -> ListPermissionSetsResponse
forall x.
ListPermissionSetsResponse -> Rep ListPermissionSetsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListPermissionSetsResponse x -> ListPermissionSetsResponse
$cfrom :: forall x.
ListPermissionSetsResponse -> Rep ListPermissionSetsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListPermissionSetsResponse' 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', 'listPermissionSetsResponse_nextToken' - The pagination token for the list API. Initially the value is null. Use
-- the output of previous API calls to make subsequent calls.
--
-- 'permissionSets', 'listPermissionSetsResponse_permissionSets' - Defines the level of access on an AWS account.
--
-- 'httpStatus', 'listPermissionSetsResponse_httpStatus' - The response's http status code.
newListPermissionSetsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListPermissionSetsResponse
newListPermissionSetsResponse :: Int -> ListPermissionSetsResponse
newListPermissionSetsResponse Int
pHttpStatus_ =
  ListPermissionSetsResponse'
    { $sel:nextToken:ListPermissionSetsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:permissionSets:ListPermissionSetsResponse' :: Maybe [Text]
permissionSets = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListPermissionSetsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The pagination token for the list API. Initially the value is null. Use
-- the output of previous API calls to make subsequent calls.
listPermissionSetsResponse_nextToken :: Lens.Lens' ListPermissionSetsResponse (Prelude.Maybe Prelude.Text)
listPermissionSetsResponse_nextToken :: Lens' ListPermissionSetsResponse (Maybe Text)
listPermissionSetsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPermissionSetsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPermissionSetsResponse' :: ListPermissionSetsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPermissionSetsResponse
s@ListPermissionSetsResponse' {} Maybe Text
a -> ListPermissionSetsResponse
s {$sel:nextToken:ListPermissionSetsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListPermissionSetsResponse)

-- | Defines the level of access on an AWS account.
listPermissionSetsResponse_permissionSets :: Lens.Lens' ListPermissionSetsResponse (Prelude.Maybe [Prelude.Text])
listPermissionSetsResponse_permissionSets :: Lens' ListPermissionSetsResponse (Maybe [Text])
listPermissionSetsResponse_permissionSets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPermissionSetsResponse' {Maybe [Text]
permissionSets :: Maybe [Text]
$sel:permissionSets:ListPermissionSetsResponse' :: ListPermissionSetsResponse -> Maybe [Text]
permissionSets} -> Maybe [Text]
permissionSets) (\s :: ListPermissionSetsResponse
s@ListPermissionSetsResponse' {} Maybe [Text]
a -> ListPermissionSetsResponse
s {$sel:permissionSets:ListPermissionSetsResponse' :: Maybe [Text]
permissionSets = Maybe [Text]
a} :: ListPermissionSetsResponse) 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.
listPermissionSetsResponse_httpStatus :: Lens.Lens' ListPermissionSetsResponse Prelude.Int
listPermissionSetsResponse_httpStatus :: Lens' ListPermissionSetsResponse Int
listPermissionSetsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPermissionSetsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListPermissionSetsResponse' :: ListPermissionSetsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListPermissionSetsResponse
s@ListPermissionSetsResponse' {} Int
a -> ListPermissionSetsResponse
s {$sel:httpStatus:ListPermissionSetsResponse' :: Int
httpStatus = Int
a} :: ListPermissionSetsResponse)

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