{-# 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.AccessAnalyzer.ListAccessPreviews
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a list of access previews for the specified analyzer.
--
-- This operation returns paginated results.
module Amazonka.AccessAnalyzer.ListAccessPreviews
  ( -- * Creating a Request
    ListAccessPreviews (..),
    newListAccessPreviews,

    -- * Request Lenses
    listAccessPreviews_maxResults,
    listAccessPreviews_nextToken,
    listAccessPreviews_analyzerArn,

    -- * Destructuring the Response
    ListAccessPreviewsResponse (..),
    newListAccessPreviewsResponse,

    -- * Response Lenses
    listAccessPreviewsResponse_nextToken,
    listAccessPreviewsResponse_httpStatus,
    listAccessPreviewsResponse_accessPreviews,
  )
where

import Amazonka.AccessAnalyzer.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:/ 'newListAccessPreviews' smart constructor.
data ListAccessPreviews = ListAccessPreviews'
  { -- | The maximum number of results to return in the response.
    ListAccessPreviews -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | A token used for pagination of results returned.
    ListAccessPreviews -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
    -- used to generate the access preview.
    ListAccessPreviews -> Text
analyzerArn :: Prelude.Text
  }
  deriving (ListAccessPreviews -> ListAccessPreviews -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAccessPreviews -> ListAccessPreviews -> Bool
$c/= :: ListAccessPreviews -> ListAccessPreviews -> Bool
== :: ListAccessPreviews -> ListAccessPreviews -> Bool
$c== :: ListAccessPreviews -> ListAccessPreviews -> Bool
Prelude.Eq, ReadPrec [ListAccessPreviews]
ReadPrec ListAccessPreviews
Int -> ReadS ListAccessPreviews
ReadS [ListAccessPreviews]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAccessPreviews]
$creadListPrec :: ReadPrec [ListAccessPreviews]
readPrec :: ReadPrec ListAccessPreviews
$creadPrec :: ReadPrec ListAccessPreviews
readList :: ReadS [ListAccessPreviews]
$creadList :: ReadS [ListAccessPreviews]
readsPrec :: Int -> ReadS ListAccessPreviews
$creadsPrec :: Int -> ReadS ListAccessPreviews
Prelude.Read, Int -> ListAccessPreviews -> ShowS
[ListAccessPreviews] -> ShowS
ListAccessPreviews -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAccessPreviews] -> ShowS
$cshowList :: [ListAccessPreviews] -> ShowS
show :: ListAccessPreviews -> String
$cshow :: ListAccessPreviews -> String
showsPrec :: Int -> ListAccessPreviews -> ShowS
$cshowsPrec :: Int -> ListAccessPreviews -> ShowS
Prelude.Show, forall x. Rep ListAccessPreviews x -> ListAccessPreviews
forall x. ListAccessPreviews -> Rep ListAccessPreviews x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListAccessPreviews x -> ListAccessPreviews
$cfrom :: forall x. ListAccessPreviews -> Rep ListAccessPreviews x
Prelude.Generic)

-- |
-- Create a value of 'ListAccessPreviews' 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', 'listAccessPreviews_maxResults' - The maximum number of results to return in the response.
--
-- 'nextToken', 'listAccessPreviews_nextToken' - A token used for pagination of results returned.
--
-- 'analyzerArn', 'listAccessPreviews_analyzerArn' - The
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
-- used to generate the access preview.
newListAccessPreviews ::
  -- | 'analyzerArn'
  Prelude.Text ->
  ListAccessPreviews
newListAccessPreviews :: Text -> ListAccessPreviews
newListAccessPreviews Text
pAnalyzerArn_ =
  ListAccessPreviews'
    { $sel:maxResults:ListAccessPreviews' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListAccessPreviews' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:analyzerArn:ListAccessPreviews' :: Text
analyzerArn = Text
pAnalyzerArn_
    }

-- | The maximum number of results to return in the response.
listAccessPreviews_maxResults :: Lens.Lens' ListAccessPreviews (Prelude.Maybe Prelude.Int)
listAccessPreviews_maxResults :: Lens' ListAccessPreviews (Maybe Int)
listAccessPreviews_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccessPreviews' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListAccessPreviews' :: ListAccessPreviews -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListAccessPreviews
s@ListAccessPreviews' {} Maybe Int
a -> ListAccessPreviews
s {$sel:maxResults:ListAccessPreviews' :: Maybe Int
maxResults = Maybe Int
a} :: ListAccessPreviews)

-- | A token used for pagination of results returned.
listAccessPreviews_nextToken :: Lens.Lens' ListAccessPreviews (Prelude.Maybe Prelude.Text)
listAccessPreviews_nextToken :: Lens' ListAccessPreviews (Maybe Text)
listAccessPreviews_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccessPreviews' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAccessPreviews' :: ListAccessPreviews -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAccessPreviews
s@ListAccessPreviews' {} Maybe Text
a -> ListAccessPreviews
s {$sel:nextToken:ListAccessPreviews' :: Maybe Text
nextToken = Maybe Text
a} :: ListAccessPreviews)

-- | The
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
-- used to generate the access preview.
listAccessPreviews_analyzerArn :: Lens.Lens' ListAccessPreviews Prelude.Text
listAccessPreviews_analyzerArn :: Lens' ListAccessPreviews Text
listAccessPreviews_analyzerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccessPreviews' {Text
analyzerArn :: Text
$sel:analyzerArn:ListAccessPreviews' :: ListAccessPreviews -> Text
analyzerArn} -> Text
analyzerArn) (\s :: ListAccessPreviews
s@ListAccessPreviews' {} Text
a -> ListAccessPreviews
s {$sel:analyzerArn:ListAccessPreviews' :: Text
analyzerArn = Text
a} :: ListAccessPreviews)

instance Core.AWSPager ListAccessPreviews where
  page :: ListAccessPreviews
-> AWSResponse ListAccessPreviews -> Maybe ListAccessPreviews
page ListAccessPreviews
rq AWSResponse ListAccessPreviews
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListAccessPreviews
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAccessPreviewsResponse (Maybe Text)
listAccessPreviewsResponse_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 ListAccessPreviews
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListAccessPreviewsResponse [AccessPreviewSummary]
listAccessPreviewsResponse_accessPreviews
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListAccessPreviews
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListAccessPreviews (Maybe Text)
listAccessPreviews_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListAccessPreviews
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAccessPreviewsResponse (Maybe Text)
listAccessPreviewsResponse_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 ListAccessPreviews where
  type
    AWSResponse ListAccessPreviews =
      ListAccessPreviewsResponse
  request :: (Service -> Service)
-> ListAccessPreviews -> Request ListAccessPreviews
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 ListAccessPreviews
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListAccessPreviews)))
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
-> Int -> [AccessPreviewSummary] -> ListAccessPreviewsResponse
ListAccessPreviewsResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            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
"accessPreviews"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

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

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

instance Data.ToHeaders ListAccessPreviews where
  toHeaders :: ListAccessPreviews -> 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 ListAccessPreviews where
  toPath :: ListAccessPreviews -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/access-preview"

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

-- | /See:/ 'newListAccessPreviewsResponse' smart constructor.
data ListAccessPreviewsResponse = ListAccessPreviewsResponse'
  { -- | A token used for pagination of results returned.
    ListAccessPreviewsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListAccessPreviewsResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of access previews retrieved for the analyzer.
    ListAccessPreviewsResponse -> [AccessPreviewSummary]
accessPreviews :: [AccessPreviewSummary]
  }
  deriving (ListAccessPreviewsResponse -> ListAccessPreviewsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAccessPreviewsResponse -> ListAccessPreviewsResponse -> Bool
$c/= :: ListAccessPreviewsResponse -> ListAccessPreviewsResponse -> Bool
== :: ListAccessPreviewsResponse -> ListAccessPreviewsResponse -> Bool
$c== :: ListAccessPreviewsResponse -> ListAccessPreviewsResponse -> Bool
Prelude.Eq, ReadPrec [ListAccessPreviewsResponse]
ReadPrec ListAccessPreviewsResponse
Int -> ReadS ListAccessPreviewsResponse
ReadS [ListAccessPreviewsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAccessPreviewsResponse]
$creadListPrec :: ReadPrec [ListAccessPreviewsResponse]
readPrec :: ReadPrec ListAccessPreviewsResponse
$creadPrec :: ReadPrec ListAccessPreviewsResponse
readList :: ReadS [ListAccessPreviewsResponse]
$creadList :: ReadS [ListAccessPreviewsResponse]
readsPrec :: Int -> ReadS ListAccessPreviewsResponse
$creadsPrec :: Int -> ReadS ListAccessPreviewsResponse
Prelude.Read, Int -> ListAccessPreviewsResponse -> ShowS
[ListAccessPreviewsResponse] -> ShowS
ListAccessPreviewsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAccessPreviewsResponse] -> ShowS
$cshowList :: [ListAccessPreviewsResponse] -> ShowS
show :: ListAccessPreviewsResponse -> String
$cshow :: ListAccessPreviewsResponse -> String
showsPrec :: Int -> ListAccessPreviewsResponse -> ShowS
$cshowsPrec :: Int -> ListAccessPreviewsResponse -> ShowS
Prelude.Show, forall x.
Rep ListAccessPreviewsResponse x -> ListAccessPreviewsResponse
forall x.
ListAccessPreviewsResponse -> Rep ListAccessPreviewsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListAccessPreviewsResponse x -> ListAccessPreviewsResponse
$cfrom :: forall x.
ListAccessPreviewsResponse -> Rep ListAccessPreviewsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListAccessPreviewsResponse' 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', 'listAccessPreviewsResponse_nextToken' - A token used for pagination of results returned.
--
-- 'httpStatus', 'listAccessPreviewsResponse_httpStatus' - The response's http status code.
--
-- 'accessPreviews', 'listAccessPreviewsResponse_accessPreviews' - A list of access previews retrieved for the analyzer.
newListAccessPreviewsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListAccessPreviewsResponse
newListAccessPreviewsResponse :: Int -> ListAccessPreviewsResponse
newListAccessPreviewsResponse Int
pHttpStatus_ =
  ListAccessPreviewsResponse'
    { $sel:nextToken:ListAccessPreviewsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListAccessPreviewsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:accessPreviews:ListAccessPreviewsResponse' :: [AccessPreviewSummary]
accessPreviews = forall a. Monoid a => a
Prelude.mempty
    }

-- | A token used for pagination of results returned.
listAccessPreviewsResponse_nextToken :: Lens.Lens' ListAccessPreviewsResponse (Prelude.Maybe Prelude.Text)
listAccessPreviewsResponse_nextToken :: Lens' ListAccessPreviewsResponse (Maybe Text)
listAccessPreviewsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccessPreviewsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAccessPreviewsResponse' :: ListAccessPreviewsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAccessPreviewsResponse
s@ListAccessPreviewsResponse' {} Maybe Text
a -> ListAccessPreviewsResponse
s {$sel:nextToken:ListAccessPreviewsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListAccessPreviewsResponse)

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

-- | A list of access previews retrieved for the analyzer.
listAccessPreviewsResponse_accessPreviews :: Lens.Lens' ListAccessPreviewsResponse [AccessPreviewSummary]
listAccessPreviewsResponse_accessPreviews :: Lens' ListAccessPreviewsResponse [AccessPreviewSummary]
listAccessPreviewsResponse_accessPreviews = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccessPreviewsResponse' {[AccessPreviewSummary]
accessPreviews :: [AccessPreviewSummary]
$sel:accessPreviews:ListAccessPreviewsResponse' :: ListAccessPreviewsResponse -> [AccessPreviewSummary]
accessPreviews} -> [AccessPreviewSummary]
accessPreviews) (\s :: ListAccessPreviewsResponse
s@ListAccessPreviewsResponse' {} [AccessPreviewSummary]
a -> ListAccessPreviewsResponse
s {$sel:accessPreviews:ListAccessPreviewsResponse' :: [AccessPreviewSummary]
accessPreviews = [AccessPreviewSummary]
a} :: ListAccessPreviewsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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