{-# 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.SNS.ListPhoneNumbersOptedOut
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of phone numbers that are opted out, meaning you cannot
-- send SMS messages to them.
--
-- The results for @ListPhoneNumbersOptedOut@ are paginated, and each page
-- returns up to 100 phone numbers. If additional phone numbers are
-- available after the first page of results, then a @NextToken@ string
-- will be returned. To receive the next page, you call
-- @ListPhoneNumbersOptedOut@ again using the @NextToken@ string received
-- from the previous call. When there are no more records to return,
-- @NextToken@ will be null.
--
-- This operation returns paginated results.
module Amazonka.SNS.ListPhoneNumbersOptedOut
  ( -- * Creating a Request
    ListPhoneNumbersOptedOut (..),
    newListPhoneNumbersOptedOut,

    -- * Request Lenses
    listPhoneNumbersOptedOut_nextToken,

    -- * Destructuring the Response
    ListPhoneNumbersOptedOutResponse (..),
    newListPhoneNumbersOptedOutResponse,

    -- * Response Lenses
    listPhoneNumbersOptedOutResponse_nextToken,
    listPhoneNumbersOptedOutResponse_phoneNumbers,
    listPhoneNumbersOptedOutResponse_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.SNS.Types

-- | The input for the @ListPhoneNumbersOptedOut@ action.
--
-- /See:/ 'newListPhoneNumbersOptedOut' smart constructor.
data ListPhoneNumbersOptedOut = ListPhoneNumbersOptedOut'
  { -- | A @NextToken@ string is used when you call the
    -- @ListPhoneNumbersOptedOut@ action to retrieve additional records that
    -- are available after the first page of results.
    ListPhoneNumbersOptedOut -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListPhoneNumbersOptedOut -> ListPhoneNumbersOptedOut -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPhoneNumbersOptedOut -> ListPhoneNumbersOptedOut -> Bool
$c/= :: ListPhoneNumbersOptedOut -> ListPhoneNumbersOptedOut -> Bool
== :: ListPhoneNumbersOptedOut -> ListPhoneNumbersOptedOut -> Bool
$c== :: ListPhoneNumbersOptedOut -> ListPhoneNumbersOptedOut -> Bool
Prelude.Eq, ReadPrec [ListPhoneNumbersOptedOut]
ReadPrec ListPhoneNumbersOptedOut
Int -> ReadS ListPhoneNumbersOptedOut
ReadS [ListPhoneNumbersOptedOut]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPhoneNumbersOptedOut]
$creadListPrec :: ReadPrec [ListPhoneNumbersOptedOut]
readPrec :: ReadPrec ListPhoneNumbersOptedOut
$creadPrec :: ReadPrec ListPhoneNumbersOptedOut
readList :: ReadS [ListPhoneNumbersOptedOut]
$creadList :: ReadS [ListPhoneNumbersOptedOut]
readsPrec :: Int -> ReadS ListPhoneNumbersOptedOut
$creadsPrec :: Int -> ReadS ListPhoneNumbersOptedOut
Prelude.Read, Int -> ListPhoneNumbersOptedOut -> ShowS
[ListPhoneNumbersOptedOut] -> ShowS
ListPhoneNumbersOptedOut -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPhoneNumbersOptedOut] -> ShowS
$cshowList :: [ListPhoneNumbersOptedOut] -> ShowS
show :: ListPhoneNumbersOptedOut -> String
$cshow :: ListPhoneNumbersOptedOut -> String
showsPrec :: Int -> ListPhoneNumbersOptedOut -> ShowS
$cshowsPrec :: Int -> ListPhoneNumbersOptedOut -> ShowS
Prelude.Show, forall x.
Rep ListPhoneNumbersOptedOut x -> ListPhoneNumbersOptedOut
forall x.
ListPhoneNumbersOptedOut -> Rep ListPhoneNumbersOptedOut x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListPhoneNumbersOptedOut x -> ListPhoneNumbersOptedOut
$cfrom :: forall x.
ListPhoneNumbersOptedOut -> Rep ListPhoneNumbersOptedOut x
Prelude.Generic)

-- |
-- Create a value of 'ListPhoneNumbersOptedOut' 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', 'listPhoneNumbersOptedOut_nextToken' - A @NextToken@ string is used when you call the
-- @ListPhoneNumbersOptedOut@ action to retrieve additional records that
-- are available after the first page of results.
newListPhoneNumbersOptedOut ::
  ListPhoneNumbersOptedOut
newListPhoneNumbersOptedOut :: ListPhoneNumbersOptedOut
newListPhoneNumbersOptedOut =
  ListPhoneNumbersOptedOut'
    { $sel:nextToken:ListPhoneNumbersOptedOut' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing
    }

-- | A @NextToken@ string is used when you call the
-- @ListPhoneNumbersOptedOut@ action to retrieve additional records that
-- are available after the first page of results.
listPhoneNumbersOptedOut_nextToken :: Lens.Lens' ListPhoneNumbersOptedOut (Prelude.Maybe Prelude.Text)
listPhoneNumbersOptedOut_nextToken :: Lens' ListPhoneNumbersOptedOut (Maybe Text)
listPhoneNumbersOptedOut_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPhoneNumbersOptedOut' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPhoneNumbersOptedOut' :: ListPhoneNumbersOptedOut -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPhoneNumbersOptedOut
s@ListPhoneNumbersOptedOut' {} Maybe Text
a -> ListPhoneNumbersOptedOut
s {$sel:nextToken:ListPhoneNumbersOptedOut' :: Maybe Text
nextToken = Maybe Text
a} :: ListPhoneNumbersOptedOut)

instance Core.AWSPager ListPhoneNumbersOptedOut where
  page :: ListPhoneNumbersOptedOut
-> AWSResponse ListPhoneNumbersOptedOut
-> Maybe ListPhoneNumbersOptedOut
page ListPhoneNumbersOptedOut
rq AWSResponse ListPhoneNumbersOptedOut
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListPhoneNumbersOptedOut
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPhoneNumbersOptedOutResponse (Maybe Text)
listPhoneNumbersOptedOutResponse_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 ListPhoneNumbersOptedOut
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPhoneNumbersOptedOutResponse (Maybe [Text])
listPhoneNumbersOptedOutResponse_phoneNumbers
            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.$ ListPhoneNumbersOptedOut
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListPhoneNumbersOptedOut (Maybe Text)
listPhoneNumbersOptedOut_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListPhoneNumbersOptedOut
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPhoneNumbersOptedOutResponse (Maybe Text)
listPhoneNumbersOptedOutResponse_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 ListPhoneNumbersOptedOut where
  type
    AWSResponse ListPhoneNumbersOptedOut =
      ListPhoneNumbersOptedOutResponse
  request :: (Service -> Service)
-> ListPhoneNumbersOptedOut -> Request ListPhoneNumbersOptedOut
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 ListPhoneNumbersOptedOut
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListPhoneNumbersOptedOut)))
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
"ListPhoneNumbersOptedOutResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [Text] -> Int -> ListPhoneNumbersOptedOutResponse
ListPhoneNumbersOptedOutResponse'
            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
"phoneNumbers"
                            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 ListPhoneNumbersOptedOut where
  hashWithSalt :: Int -> ListPhoneNumbersOptedOut -> Int
hashWithSalt Int
_salt ListPhoneNumbersOptedOut' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPhoneNumbersOptedOut' :: ListPhoneNumbersOptedOut -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

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

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

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

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

-- | The response from the @ListPhoneNumbersOptedOut@ action.
--
-- /See:/ 'newListPhoneNumbersOptedOutResponse' smart constructor.
data ListPhoneNumbersOptedOutResponse = ListPhoneNumbersOptedOutResponse'
  { -- | A @NextToken@ string is returned when you call the
    -- @ListPhoneNumbersOptedOut@ action if additional records are available
    -- after the first page of results.
    ListPhoneNumbersOptedOutResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of phone numbers that are opted out of receiving SMS messages.
    -- The list is paginated, and each page can contain up to 100 phone
    -- numbers.
    ListPhoneNumbersOptedOutResponse -> Maybe [Text]
phoneNumbers :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    ListPhoneNumbersOptedOutResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListPhoneNumbersOptedOutResponse
-> ListPhoneNumbersOptedOutResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPhoneNumbersOptedOutResponse
-> ListPhoneNumbersOptedOutResponse -> Bool
$c/= :: ListPhoneNumbersOptedOutResponse
-> ListPhoneNumbersOptedOutResponse -> Bool
== :: ListPhoneNumbersOptedOutResponse
-> ListPhoneNumbersOptedOutResponse -> Bool
$c== :: ListPhoneNumbersOptedOutResponse
-> ListPhoneNumbersOptedOutResponse -> Bool
Prelude.Eq, ReadPrec [ListPhoneNumbersOptedOutResponse]
ReadPrec ListPhoneNumbersOptedOutResponse
Int -> ReadS ListPhoneNumbersOptedOutResponse
ReadS [ListPhoneNumbersOptedOutResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPhoneNumbersOptedOutResponse]
$creadListPrec :: ReadPrec [ListPhoneNumbersOptedOutResponse]
readPrec :: ReadPrec ListPhoneNumbersOptedOutResponse
$creadPrec :: ReadPrec ListPhoneNumbersOptedOutResponse
readList :: ReadS [ListPhoneNumbersOptedOutResponse]
$creadList :: ReadS [ListPhoneNumbersOptedOutResponse]
readsPrec :: Int -> ReadS ListPhoneNumbersOptedOutResponse
$creadsPrec :: Int -> ReadS ListPhoneNumbersOptedOutResponse
Prelude.Read, Int -> ListPhoneNumbersOptedOutResponse -> ShowS
[ListPhoneNumbersOptedOutResponse] -> ShowS
ListPhoneNumbersOptedOutResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPhoneNumbersOptedOutResponse] -> ShowS
$cshowList :: [ListPhoneNumbersOptedOutResponse] -> ShowS
show :: ListPhoneNumbersOptedOutResponse -> String
$cshow :: ListPhoneNumbersOptedOutResponse -> String
showsPrec :: Int -> ListPhoneNumbersOptedOutResponse -> ShowS
$cshowsPrec :: Int -> ListPhoneNumbersOptedOutResponse -> ShowS
Prelude.Show, forall x.
Rep ListPhoneNumbersOptedOutResponse x
-> ListPhoneNumbersOptedOutResponse
forall x.
ListPhoneNumbersOptedOutResponse
-> Rep ListPhoneNumbersOptedOutResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListPhoneNumbersOptedOutResponse x
-> ListPhoneNumbersOptedOutResponse
$cfrom :: forall x.
ListPhoneNumbersOptedOutResponse
-> Rep ListPhoneNumbersOptedOutResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListPhoneNumbersOptedOutResponse' 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', 'listPhoneNumbersOptedOutResponse_nextToken' - A @NextToken@ string is returned when you call the
-- @ListPhoneNumbersOptedOut@ action if additional records are available
-- after the first page of results.
--
-- 'phoneNumbers', 'listPhoneNumbersOptedOutResponse_phoneNumbers' - A list of phone numbers that are opted out of receiving SMS messages.
-- The list is paginated, and each page can contain up to 100 phone
-- numbers.
--
-- 'httpStatus', 'listPhoneNumbersOptedOutResponse_httpStatus' - The response's http status code.
newListPhoneNumbersOptedOutResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListPhoneNumbersOptedOutResponse
newListPhoneNumbersOptedOutResponse :: Int -> ListPhoneNumbersOptedOutResponse
newListPhoneNumbersOptedOutResponse Int
pHttpStatus_ =
  ListPhoneNumbersOptedOutResponse'
    { $sel:nextToken:ListPhoneNumbersOptedOutResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:phoneNumbers:ListPhoneNumbersOptedOutResponse' :: Maybe [Text]
phoneNumbers = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListPhoneNumbersOptedOutResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A @NextToken@ string is returned when you call the
-- @ListPhoneNumbersOptedOut@ action if additional records are available
-- after the first page of results.
listPhoneNumbersOptedOutResponse_nextToken :: Lens.Lens' ListPhoneNumbersOptedOutResponse (Prelude.Maybe Prelude.Text)
listPhoneNumbersOptedOutResponse_nextToken :: Lens' ListPhoneNumbersOptedOutResponse (Maybe Text)
listPhoneNumbersOptedOutResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPhoneNumbersOptedOutResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPhoneNumbersOptedOutResponse' :: ListPhoneNumbersOptedOutResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPhoneNumbersOptedOutResponse
s@ListPhoneNumbersOptedOutResponse' {} Maybe Text
a -> ListPhoneNumbersOptedOutResponse
s {$sel:nextToken:ListPhoneNumbersOptedOutResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListPhoneNumbersOptedOutResponse)

-- | A list of phone numbers that are opted out of receiving SMS messages.
-- The list is paginated, and each page can contain up to 100 phone
-- numbers.
listPhoneNumbersOptedOutResponse_phoneNumbers :: Lens.Lens' ListPhoneNumbersOptedOutResponse (Prelude.Maybe [Prelude.Text])
listPhoneNumbersOptedOutResponse_phoneNumbers :: Lens' ListPhoneNumbersOptedOutResponse (Maybe [Text])
listPhoneNumbersOptedOutResponse_phoneNumbers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPhoneNumbersOptedOutResponse' {Maybe [Text]
phoneNumbers :: Maybe [Text]
$sel:phoneNumbers:ListPhoneNumbersOptedOutResponse' :: ListPhoneNumbersOptedOutResponse -> Maybe [Text]
phoneNumbers} -> Maybe [Text]
phoneNumbers) (\s :: ListPhoneNumbersOptedOutResponse
s@ListPhoneNumbersOptedOutResponse' {} Maybe [Text]
a -> ListPhoneNumbersOptedOutResponse
s {$sel:phoneNumbers:ListPhoneNumbersOptedOutResponse' :: Maybe [Text]
phoneNumbers = Maybe [Text]
a} :: ListPhoneNumbersOptedOutResponse) 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.
listPhoneNumbersOptedOutResponse_httpStatus :: Lens.Lens' ListPhoneNumbersOptedOutResponse Prelude.Int
listPhoneNumbersOptedOutResponse_httpStatus :: Lens' ListPhoneNumbersOptedOutResponse Int
listPhoneNumbersOptedOutResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPhoneNumbersOptedOutResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListPhoneNumbersOptedOutResponse' :: ListPhoneNumbersOptedOutResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListPhoneNumbersOptedOutResponse
s@ListPhoneNumbersOptedOutResponse' {} Int
a -> ListPhoneNumbersOptedOutResponse
s {$sel:httpStatus:ListPhoneNumbersOptedOutResponse' :: Int
httpStatus = Int
a} :: ListPhoneNumbersOptedOutResponse)

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