{-# 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.SES.ListReceiptRuleSets
-- 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 receipt rule sets that exist under your AWS account in the
-- current AWS Region. If there are additional receipt rule sets to be
-- retrieved, you will receive a @NextToken@ that you can provide to the
-- next call to @ListReceiptRuleSets@ to retrieve the additional entries.
--
-- For information about managing receipt rule sets, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/receiving-email-managing-receipt-rule-sets.html Amazon SES Developer Guide>.
--
-- You can execute this operation no more than once per second.
--
-- This operation returns paginated results.
module Amazonka.SES.ListReceiptRuleSets
  ( -- * Creating a Request
    ListReceiptRuleSets (..),
    newListReceiptRuleSets,

    -- * Request Lenses
    listReceiptRuleSets_nextToken,

    -- * Destructuring the Response
    ListReceiptRuleSetsResponse (..),
    newListReceiptRuleSetsResponse,

    -- * Response Lenses
    listReceiptRuleSetsResponse_nextToken,
    listReceiptRuleSetsResponse_ruleSets,
    listReceiptRuleSetsResponse_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.SES.Types

-- | Represents a request to list the receipt rule sets that exist under your
-- AWS account. You use receipt rule sets to receive email with Amazon SES.
-- For more information, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/receiving-email-concepts.html Amazon SES Developer Guide>.
--
-- /See:/ 'newListReceiptRuleSets' smart constructor.
data ListReceiptRuleSets = ListReceiptRuleSets'
  { -- | A token returned from a previous call to @ListReceiptRuleSets@ to
    -- indicate the position in the receipt rule set list.
    ListReceiptRuleSets -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListReceiptRuleSets -> ListReceiptRuleSets -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListReceiptRuleSets -> ListReceiptRuleSets -> Bool
$c/= :: ListReceiptRuleSets -> ListReceiptRuleSets -> Bool
== :: ListReceiptRuleSets -> ListReceiptRuleSets -> Bool
$c== :: ListReceiptRuleSets -> ListReceiptRuleSets -> Bool
Prelude.Eq, ReadPrec [ListReceiptRuleSets]
ReadPrec ListReceiptRuleSets
Int -> ReadS ListReceiptRuleSets
ReadS [ListReceiptRuleSets]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListReceiptRuleSets]
$creadListPrec :: ReadPrec [ListReceiptRuleSets]
readPrec :: ReadPrec ListReceiptRuleSets
$creadPrec :: ReadPrec ListReceiptRuleSets
readList :: ReadS [ListReceiptRuleSets]
$creadList :: ReadS [ListReceiptRuleSets]
readsPrec :: Int -> ReadS ListReceiptRuleSets
$creadsPrec :: Int -> ReadS ListReceiptRuleSets
Prelude.Read, Int -> ListReceiptRuleSets -> ShowS
[ListReceiptRuleSets] -> ShowS
ListReceiptRuleSets -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListReceiptRuleSets] -> ShowS
$cshowList :: [ListReceiptRuleSets] -> ShowS
show :: ListReceiptRuleSets -> String
$cshow :: ListReceiptRuleSets -> String
showsPrec :: Int -> ListReceiptRuleSets -> ShowS
$cshowsPrec :: Int -> ListReceiptRuleSets -> ShowS
Prelude.Show, forall x. Rep ListReceiptRuleSets x -> ListReceiptRuleSets
forall x. ListReceiptRuleSets -> Rep ListReceiptRuleSets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListReceiptRuleSets x -> ListReceiptRuleSets
$cfrom :: forall x. ListReceiptRuleSets -> Rep ListReceiptRuleSets x
Prelude.Generic)

-- |
-- Create a value of 'ListReceiptRuleSets' 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', 'listReceiptRuleSets_nextToken' - A token returned from a previous call to @ListReceiptRuleSets@ to
-- indicate the position in the receipt rule set list.
newListReceiptRuleSets ::
  ListReceiptRuleSets
newListReceiptRuleSets :: ListReceiptRuleSets
newListReceiptRuleSets =
  ListReceiptRuleSets' {$sel:nextToken:ListReceiptRuleSets' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing}

-- | A token returned from a previous call to @ListReceiptRuleSets@ to
-- indicate the position in the receipt rule set list.
listReceiptRuleSets_nextToken :: Lens.Lens' ListReceiptRuleSets (Prelude.Maybe Prelude.Text)
listReceiptRuleSets_nextToken :: Lens' ListReceiptRuleSets (Maybe Text)
listReceiptRuleSets_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListReceiptRuleSets' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListReceiptRuleSets' :: ListReceiptRuleSets -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListReceiptRuleSets
s@ListReceiptRuleSets' {} Maybe Text
a -> ListReceiptRuleSets
s {$sel:nextToken:ListReceiptRuleSets' :: Maybe Text
nextToken = Maybe Text
a} :: ListReceiptRuleSets)

instance Core.AWSPager ListReceiptRuleSets where
  page :: ListReceiptRuleSets
-> AWSResponse ListReceiptRuleSets -> Maybe ListReceiptRuleSets
page ListReceiptRuleSets
rq AWSResponse ListReceiptRuleSets
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListReceiptRuleSets
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListReceiptRuleSetsResponse (Maybe Text)
listReceiptRuleSetsResponse_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 ListReceiptRuleSets
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListReceiptRuleSetsResponse (Maybe [ReceiptRuleSetMetadata])
listReceiptRuleSetsResponse_ruleSets
            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.$ ListReceiptRuleSets
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListReceiptRuleSets (Maybe Text)
listReceiptRuleSets_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListReceiptRuleSets
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListReceiptRuleSetsResponse (Maybe Text)
listReceiptRuleSetsResponse_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 ListReceiptRuleSets where
  type
    AWSResponse ListReceiptRuleSets =
      ListReceiptRuleSetsResponse
  request :: (Service -> Service)
-> ListReceiptRuleSets -> Request ListReceiptRuleSets
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListReceiptRuleSets
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListReceiptRuleSets)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ListReceiptRuleSetsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [ReceiptRuleSetMetadata]
-> Int
-> ListReceiptRuleSetsResponse
ListReceiptRuleSetsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"NextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"RuleSets"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            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 ListReceiptRuleSets where
  hashWithSalt :: Int -> ListReceiptRuleSets -> Int
hashWithSalt Int
_salt ListReceiptRuleSets' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListReceiptRuleSets' :: ListReceiptRuleSets -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListReceiptRuleSets where
  rnf :: ListReceiptRuleSets -> ()
rnf ListReceiptRuleSets' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListReceiptRuleSets' :: ListReceiptRuleSets -> Maybe Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders ListReceiptRuleSets where
  toHeaders :: ListReceiptRuleSets -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ListReceiptRuleSets where
  toQuery :: ListReceiptRuleSets -> QueryString
toQuery ListReceiptRuleSets' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListReceiptRuleSets' :: ListReceiptRuleSets -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ListReceiptRuleSets" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | A list of receipt rule sets that exist under your AWS account.
--
-- /See:/ 'newListReceiptRuleSetsResponse' smart constructor.
data ListReceiptRuleSetsResponse = ListReceiptRuleSetsResponse'
  { -- | A token indicating that there are additional receipt rule sets available
    -- to be listed. Pass this token to successive calls of
    -- @ListReceiptRuleSets@ to retrieve up to 100 receipt rule sets at a time.
    ListReceiptRuleSetsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The metadata for the currently active receipt rule set. The metadata
    -- consists of the rule set name and the timestamp of when the rule set was
    -- created.
    ListReceiptRuleSetsResponse -> Maybe [ReceiptRuleSetMetadata]
ruleSets :: Prelude.Maybe [ReceiptRuleSetMetadata],
    -- | The response's http status code.
    ListReceiptRuleSetsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListReceiptRuleSetsResponse -> ListReceiptRuleSetsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListReceiptRuleSetsResponse -> ListReceiptRuleSetsResponse -> Bool
$c/= :: ListReceiptRuleSetsResponse -> ListReceiptRuleSetsResponse -> Bool
== :: ListReceiptRuleSetsResponse -> ListReceiptRuleSetsResponse -> Bool
$c== :: ListReceiptRuleSetsResponse -> ListReceiptRuleSetsResponse -> Bool
Prelude.Eq, ReadPrec [ListReceiptRuleSetsResponse]
ReadPrec ListReceiptRuleSetsResponse
Int -> ReadS ListReceiptRuleSetsResponse
ReadS [ListReceiptRuleSetsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListReceiptRuleSetsResponse]
$creadListPrec :: ReadPrec [ListReceiptRuleSetsResponse]
readPrec :: ReadPrec ListReceiptRuleSetsResponse
$creadPrec :: ReadPrec ListReceiptRuleSetsResponse
readList :: ReadS [ListReceiptRuleSetsResponse]
$creadList :: ReadS [ListReceiptRuleSetsResponse]
readsPrec :: Int -> ReadS ListReceiptRuleSetsResponse
$creadsPrec :: Int -> ReadS ListReceiptRuleSetsResponse
Prelude.Read, Int -> ListReceiptRuleSetsResponse -> ShowS
[ListReceiptRuleSetsResponse] -> ShowS
ListReceiptRuleSetsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListReceiptRuleSetsResponse] -> ShowS
$cshowList :: [ListReceiptRuleSetsResponse] -> ShowS
show :: ListReceiptRuleSetsResponse -> String
$cshow :: ListReceiptRuleSetsResponse -> String
showsPrec :: Int -> ListReceiptRuleSetsResponse -> ShowS
$cshowsPrec :: Int -> ListReceiptRuleSetsResponse -> ShowS
Prelude.Show, forall x.
Rep ListReceiptRuleSetsResponse x -> ListReceiptRuleSetsResponse
forall x.
ListReceiptRuleSetsResponse -> Rep ListReceiptRuleSetsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListReceiptRuleSetsResponse x -> ListReceiptRuleSetsResponse
$cfrom :: forall x.
ListReceiptRuleSetsResponse -> Rep ListReceiptRuleSetsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListReceiptRuleSetsResponse' 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', 'listReceiptRuleSetsResponse_nextToken' - A token indicating that there are additional receipt rule sets available
-- to be listed. Pass this token to successive calls of
-- @ListReceiptRuleSets@ to retrieve up to 100 receipt rule sets at a time.
--
-- 'ruleSets', 'listReceiptRuleSetsResponse_ruleSets' - The metadata for the currently active receipt rule set. The metadata
-- consists of the rule set name and the timestamp of when the rule set was
-- created.
--
-- 'httpStatus', 'listReceiptRuleSetsResponse_httpStatus' - The response's http status code.
newListReceiptRuleSetsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListReceiptRuleSetsResponse
newListReceiptRuleSetsResponse :: Int -> ListReceiptRuleSetsResponse
newListReceiptRuleSetsResponse Int
pHttpStatus_ =
  ListReceiptRuleSetsResponse'
    { $sel:nextToken:ListReceiptRuleSetsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:ruleSets:ListReceiptRuleSetsResponse' :: Maybe [ReceiptRuleSetMetadata]
ruleSets = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListReceiptRuleSetsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A token indicating that there are additional receipt rule sets available
-- to be listed. Pass this token to successive calls of
-- @ListReceiptRuleSets@ to retrieve up to 100 receipt rule sets at a time.
listReceiptRuleSetsResponse_nextToken :: Lens.Lens' ListReceiptRuleSetsResponse (Prelude.Maybe Prelude.Text)
listReceiptRuleSetsResponse_nextToken :: Lens' ListReceiptRuleSetsResponse (Maybe Text)
listReceiptRuleSetsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListReceiptRuleSetsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListReceiptRuleSetsResponse' :: ListReceiptRuleSetsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListReceiptRuleSetsResponse
s@ListReceiptRuleSetsResponse' {} Maybe Text
a -> ListReceiptRuleSetsResponse
s {$sel:nextToken:ListReceiptRuleSetsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListReceiptRuleSetsResponse)

-- | The metadata for the currently active receipt rule set. The metadata
-- consists of the rule set name and the timestamp of when the rule set was
-- created.
listReceiptRuleSetsResponse_ruleSets :: Lens.Lens' ListReceiptRuleSetsResponse (Prelude.Maybe [ReceiptRuleSetMetadata])
listReceiptRuleSetsResponse_ruleSets :: Lens' ListReceiptRuleSetsResponse (Maybe [ReceiptRuleSetMetadata])
listReceiptRuleSetsResponse_ruleSets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListReceiptRuleSetsResponse' {Maybe [ReceiptRuleSetMetadata]
ruleSets :: Maybe [ReceiptRuleSetMetadata]
$sel:ruleSets:ListReceiptRuleSetsResponse' :: ListReceiptRuleSetsResponse -> Maybe [ReceiptRuleSetMetadata]
ruleSets} -> Maybe [ReceiptRuleSetMetadata]
ruleSets) (\s :: ListReceiptRuleSetsResponse
s@ListReceiptRuleSetsResponse' {} Maybe [ReceiptRuleSetMetadata]
a -> ListReceiptRuleSetsResponse
s {$sel:ruleSets:ListReceiptRuleSetsResponse' :: Maybe [ReceiptRuleSetMetadata]
ruleSets = Maybe [ReceiptRuleSetMetadata]
a} :: ListReceiptRuleSetsResponse) 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.
listReceiptRuleSetsResponse_httpStatus :: Lens.Lens' ListReceiptRuleSetsResponse Prelude.Int
listReceiptRuleSetsResponse_httpStatus :: Lens' ListReceiptRuleSetsResponse Int
listReceiptRuleSetsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListReceiptRuleSetsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListReceiptRuleSetsResponse' :: ListReceiptRuleSetsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListReceiptRuleSetsResponse
s@ListReceiptRuleSetsResponse' {} Int
a -> ListReceiptRuleSetsResponse
s {$sel:httpStatus:ListReceiptRuleSetsResponse' :: Int
httpStatus = Int
a} :: ListReceiptRuleSetsResponse)

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