{-# 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.SQS.ListDeadLetterSourceQueues
-- 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 your queues that have the @RedrivePolicy@ queue
-- attribute configured with a dead-letter queue.
--
-- The @ListDeadLetterSourceQueues@ methods supports pagination. Set
-- parameter @MaxResults@ in the request to specify the maximum number of
-- results to be returned in the response. If you do not set @MaxResults@,
-- the response includes a maximum of 1,000 results. If you set
-- @MaxResults@ and there are additional results to display, the response
-- includes a value for @NextToken@. Use @NextToken@ as a parameter in your
-- next request to @ListDeadLetterSourceQueues@ to receive the next page of
-- results.
--
-- For more information about using dead-letter queues, see
-- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-dead-letter-queues.html Using Amazon SQS Dead-Letter Queues>
-- in the /Amazon SQS Developer Guide/.
--
-- This operation returns paginated results.
module Amazonka.SQS.ListDeadLetterSourceQueues
  ( -- * Creating a Request
    ListDeadLetterSourceQueues (..),
    newListDeadLetterSourceQueues,

    -- * Request Lenses
    listDeadLetterSourceQueues_maxResults,
    listDeadLetterSourceQueues_nextToken,
    listDeadLetterSourceQueues_queueUrl,

    -- * Destructuring the Response
    ListDeadLetterSourceQueuesResponse (..),
    newListDeadLetterSourceQueuesResponse,

    -- * Response Lenses
    listDeadLetterSourceQueuesResponse_nextToken,
    listDeadLetterSourceQueuesResponse_httpStatus,
    listDeadLetterSourceQueuesResponse_queueUrls,
  )
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.SQS.Types

-- |
--
-- /See:/ 'newListDeadLetterSourceQueues' smart constructor.
data ListDeadLetterSourceQueues = ListDeadLetterSourceQueues'
  { -- | Maximum number of results to include in the response. Value range is 1
    -- to 1000. You must set @MaxResults@ to receive a value for @NextToken@ in
    -- the response.
    ListDeadLetterSourceQueues -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | Pagination token to request the next set of results.
    ListDeadLetterSourceQueues -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The URL of a dead-letter queue.
    --
    -- Queue URLs and names are case-sensitive.
    ListDeadLetterSourceQueues -> Text
queueUrl :: Prelude.Text
  }
  deriving (ListDeadLetterSourceQueues -> ListDeadLetterSourceQueues -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDeadLetterSourceQueues -> ListDeadLetterSourceQueues -> Bool
$c/= :: ListDeadLetterSourceQueues -> ListDeadLetterSourceQueues -> Bool
== :: ListDeadLetterSourceQueues -> ListDeadLetterSourceQueues -> Bool
$c== :: ListDeadLetterSourceQueues -> ListDeadLetterSourceQueues -> Bool
Prelude.Eq, ReadPrec [ListDeadLetterSourceQueues]
ReadPrec ListDeadLetterSourceQueues
Int -> ReadS ListDeadLetterSourceQueues
ReadS [ListDeadLetterSourceQueues]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDeadLetterSourceQueues]
$creadListPrec :: ReadPrec [ListDeadLetterSourceQueues]
readPrec :: ReadPrec ListDeadLetterSourceQueues
$creadPrec :: ReadPrec ListDeadLetterSourceQueues
readList :: ReadS [ListDeadLetterSourceQueues]
$creadList :: ReadS [ListDeadLetterSourceQueues]
readsPrec :: Int -> ReadS ListDeadLetterSourceQueues
$creadsPrec :: Int -> ReadS ListDeadLetterSourceQueues
Prelude.Read, Int -> ListDeadLetterSourceQueues -> ShowS
[ListDeadLetterSourceQueues] -> ShowS
ListDeadLetterSourceQueues -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDeadLetterSourceQueues] -> ShowS
$cshowList :: [ListDeadLetterSourceQueues] -> ShowS
show :: ListDeadLetterSourceQueues -> String
$cshow :: ListDeadLetterSourceQueues -> String
showsPrec :: Int -> ListDeadLetterSourceQueues -> ShowS
$cshowsPrec :: Int -> ListDeadLetterSourceQueues -> ShowS
Prelude.Show, forall x.
Rep ListDeadLetterSourceQueues x -> ListDeadLetterSourceQueues
forall x.
ListDeadLetterSourceQueues -> Rep ListDeadLetterSourceQueues x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListDeadLetterSourceQueues x -> ListDeadLetterSourceQueues
$cfrom :: forall x.
ListDeadLetterSourceQueues -> Rep ListDeadLetterSourceQueues x
Prelude.Generic)

-- |
-- Create a value of 'ListDeadLetterSourceQueues' 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', 'listDeadLetterSourceQueues_maxResults' - Maximum number of results to include in the response. Value range is 1
-- to 1000. You must set @MaxResults@ to receive a value for @NextToken@ in
-- the response.
--
-- 'nextToken', 'listDeadLetterSourceQueues_nextToken' - Pagination token to request the next set of results.
--
-- 'queueUrl', 'listDeadLetterSourceQueues_queueUrl' - The URL of a dead-letter queue.
--
-- Queue URLs and names are case-sensitive.
newListDeadLetterSourceQueues ::
  -- | 'queueUrl'
  Prelude.Text ->
  ListDeadLetterSourceQueues
newListDeadLetterSourceQueues :: Text -> ListDeadLetterSourceQueues
newListDeadLetterSourceQueues Text
pQueueUrl_ =
  ListDeadLetterSourceQueues'
    { $sel:maxResults:ListDeadLetterSourceQueues' :: Maybe Int
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListDeadLetterSourceQueues' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:queueUrl:ListDeadLetterSourceQueues' :: Text
queueUrl = Text
pQueueUrl_
    }

-- | Maximum number of results to include in the response. Value range is 1
-- to 1000. You must set @MaxResults@ to receive a value for @NextToken@ in
-- the response.
listDeadLetterSourceQueues_maxResults :: Lens.Lens' ListDeadLetterSourceQueues (Prelude.Maybe Prelude.Int)
listDeadLetterSourceQueues_maxResults :: Lens' ListDeadLetterSourceQueues (Maybe Int)
listDeadLetterSourceQueues_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeadLetterSourceQueues' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListDeadLetterSourceQueues' :: ListDeadLetterSourceQueues -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListDeadLetterSourceQueues
s@ListDeadLetterSourceQueues' {} Maybe Int
a -> ListDeadLetterSourceQueues
s {$sel:maxResults:ListDeadLetterSourceQueues' :: Maybe Int
maxResults = Maybe Int
a} :: ListDeadLetterSourceQueues)

-- | Pagination token to request the next set of results.
listDeadLetterSourceQueues_nextToken :: Lens.Lens' ListDeadLetterSourceQueues (Prelude.Maybe Prelude.Text)
listDeadLetterSourceQueues_nextToken :: Lens' ListDeadLetterSourceQueues (Maybe Text)
listDeadLetterSourceQueues_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeadLetterSourceQueues' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDeadLetterSourceQueues' :: ListDeadLetterSourceQueues -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListDeadLetterSourceQueues
s@ListDeadLetterSourceQueues' {} Maybe Text
a -> ListDeadLetterSourceQueues
s {$sel:nextToken:ListDeadLetterSourceQueues' :: Maybe Text
nextToken = Maybe Text
a} :: ListDeadLetterSourceQueues)

-- | The URL of a dead-letter queue.
--
-- Queue URLs and names are case-sensitive.
listDeadLetterSourceQueues_queueUrl :: Lens.Lens' ListDeadLetterSourceQueues Prelude.Text
listDeadLetterSourceQueues_queueUrl :: Lens' ListDeadLetterSourceQueues Text
listDeadLetterSourceQueues_queueUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeadLetterSourceQueues' {Text
queueUrl :: Text
$sel:queueUrl:ListDeadLetterSourceQueues' :: ListDeadLetterSourceQueues -> Text
queueUrl} -> Text
queueUrl) (\s :: ListDeadLetterSourceQueues
s@ListDeadLetterSourceQueues' {} Text
a -> ListDeadLetterSourceQueues
s {$sel:queueUrl:ListDeadLetterSourceQueues' :: Text
queueUrl = Text
a} :: ListDeadLetterSourceQueues)

instance Core.AWSPager ListDeadLetterSourceQueues where
  page :: ListDeadLetterSourceQueues
-> AWSResponse ListDeadLetterSourceQueues
-> Maybe ListDeadLetterSourceQueues
page ListDeadLetterSourceQueues
rq AWSResponse ListDeadLetterSourceQueues
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListDeadLetterSourceQueues
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDeadLetterSourceQueuesResponse (Maybe Text)
listDeadLetterSourceQueuesResponse_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 ListDeadLetterSourceQueues
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListDeadLetterSourceQueuesResponse [Text]
listDeadLetterSourceQueuesResponse_queueUrls
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListDeadLetterSourceQueues
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListDeadLetterSourceQueues (Maybe Text)
listDeadLetterSourceQueues_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListDeadLetterSourceQueues
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDeadLetterSourceQueuesResponse (Maybe Text)
listDeadLetterSourceQueuesResponse_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 ListDeadLetterSourceQueues where
  type
    AWSResponse ListDeadLetterSourceQueues =
      ListDeadLetterSourceQueuesResponse
  request :: (Service -> Service)
-> ListDeadLetterSourceQueues -> Request ListDeadLetterSourceQueues
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 ListDeadLetterSourceQueues
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListDeadLetterSourceQueues)))
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
"ListDeadLetterSourceQueuesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> [Text] -> ListDeadLetterSourceQueuesResponse
ListDeadLetterSourceQueuesResponse'
            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.<*> (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.<*> (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"QueueUrl" [Node]
x)
      )

instance Prelude.Hashable ListDeadLetterSourceQueues where
  hashWithSalt :: Int -> ListDeadLetterSourceQueues -> Int
hashWithSalt Int
_salt ListDeadLetterSourceQueues' {Maybe Int
Maybe Text
Text
queueUrl :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:queueUrl:ListDeadLetterSourceQueues' :: ListDeadLetterSourceQueues -> Text
$sel:nextToken:ListDeadLetterSourceQueues' :: ListDeadLetterSourceQueues -> Maybe Text
$sel:maxResults:ListDeadLetterSourceQueues' :: ListDeadLetterSourceQueues -> 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
queueUrl

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

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

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

instance Data.ToQuery ListDeadLetterSourceQueues where
  toQuery :: ListDeadLetterSourceQueues -> QueryString
toQuery ListDeadLetterSourceQueues' {Maybe Int
Maybe Text
Text
queueUrl :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:queueUrl:ListDeadLetterSourceQueues' :: ListDeadLetterSourceQueues -> Text
$sel:nextToken:ListDeadLetterSourceQueues' :: ListDeadLetterSourceQueues -> Maybe Text
$sel:maxResults:ListDeadLetterSourceQueues' :: ListDeadLetterSourceQueues -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ListDeadLetterSourceQueues" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-11-05" :: Prelude.ByteString),
        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
"QueueUrl" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
queueUrl
      ]

-- | A list of your dead letter source queues.
--
-- /See:/ 'newListDeadLetterSourceQueuesResponse' smart constructor.
data ListDeadLetterSourceQueuesResponse = ListDeadLetterSourceQueuesResponse'
  { -- | Pagination token to include in the next request. Token value is @null@
    -- if there are no additional results to request, or if you did not set
    -- @MaxResults@ in the request.
    ListDeadLetterSourceQueuesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListDeadLetterSourceQueuesResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of source queue URLs that have the @RedrivePolicy@ queue
    -- attribute configured with a dead-letter queue.
    ListDeadLetterSourceQueuesResponse -> [Text]
queueUrls :: [Prelude.Text]
  }
  deriving (ListDeadLetterSourceQueuesResponse
-> ListDeadLetterSourceQueuesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDeadLetterSourceQueuesResponse
-> ListDeadLetterSourceQueuesResponse -> Bool
$c/= :: ListDeadLetterSourceQueuesResponse
-> ListDeadLetterSourceQueuesResponse -> Bool
== :: ListDeadLetterSourceQueuesResponse
-> ListDeadLetterSourceQueuesResponse -> Bool
$c== :: ListDeadLetterSourceQueuesResponse
-> ListDeadLetterSourceQueuesResponse -> Bool
Prelude.Eq, ReadPrec [ListDeadLetterSourceQueuesResponse]
ReadPrec ListDeadLetterSourceQueuesResponse
Int -> ReadS ListDeadLetterSourceQueuesResponse
ReadS [ListDeadLetterSourceQueuesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDeadLetterSourceQueuesResponse]
$creadListPrec :: ReadPrec [ListDeadLetterSourceQueuesResponse]
readPrec :: ReadPrec ListDeadLetterSourceQueuesResponse
$creadPrec :: ReadPrec ListDeadLetterSourceQueuesResponse
readList :: ReadS [ListDeadLetterSourceQueuesResponse]
$creadList :: ReadS [ListDeadLetterSourceQueuesResponse]
readsPrec :: Int -> ReadS ListDeadLetterSourceQueuesResponse
$creadsPrec :: Int -> ReadS ListDeadLetterSourceQueuesResponse
Prelude.Read, Int -> ListDeadLetterSourceQueuesResponse -> ShowS
[ListDeadLetterSourceQueuesResponse] -> ShowS
ListDeadLetterSourceQueuesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDeadLetterSourceQueuesResponse] -> ShowS
$cshowList :: [ListDeadLetterSourceQueuesResponse] -> ShowS
show :: ListDeadLetterSourceQueuesResponse -> String
$cshow :: ListDeadLetterSourceQueuesResponse -> String
showsPrec :: Int -> ListDeadLetterSourceQueuesResponse -> ShowS
$cshowsPrec :: Int -> ListDeadLetterSourceQueuesResponse -> ShowS
Prelude.Show, forall x.
Rep ListDeadLetterSourceQueuesResponse x
-> ListDeadLetterSourceQueuesResponse
forall x.
ListDeadLetterSourceQueuesResponse
-> Rep ListDeadLetterSourceQueuesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListDeadLetterSourceQueuesResponse x
-> ListDeadLetterSourceQueuesResponse
$cfrom :: forall x.
ListDeadLetterSourceQueuesResponse
-> Rep ListDeadLetterSourceQueuesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListDeadLetterSourceQueuesResponse' 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', 'listDeadLetterSourceQueuesResponse_nextToken' - Pagination token to include in the next request. Token value is @null@
-- if there are no additional results to request, or if you did not set
-- @MaxResults@ in the request.
--
-- 'httpStatus', 'listDeadLetterSourceQueuesResponse_httpStatus' - The response's http status code.
--
-- 'queueUrls', 'listDeadLetterSourceQueuesResponse_queueUrls' - A list of source queue URLs that have the @RedrivePolicy@ queue
-- attribute configured with a dead-letter queue.
newListDeadLetterSourceQueuesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListDeadLetterSourceQueuesResponse
newListDeadLetterSourceQueuesResponse :: Int -> ListDeadLetterSourceQueuesResponse
newListDeadLetterSourceQueuesResponse Int
pHttpStatus_ =
  ListDeadLetterSourceQueuesResponse'
    { $sel:nextToken:ListDeadLetterSourceQueuesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListDeadLetterSourceQueuesResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:queueUrls:ListDeadLetterSourceQueuesResponse' :: [Text]
queueUrls = forall a. Monoid a => a
Prelude.mempty
    }

-- | Pagination token to include in the next request. Token value is @null@
-- if there are no additional results to request, or if you did not set
-- @MaxResults@ in the request.
listDeadLetterSourceQueuesResponse_nextToken :: Lens.Lens' ListDeadLetterSourceQueuesResponse (Prelude.Maybe Prelude.Text)
listDeadLetterSourceQueuesResponse_nextToken :: Lens' ListDeadLetterSourceQueuesResponse (Maybe Text)
listDeadLetterSourceQueuesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeadLetterSourceQueuesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDeadLetterSourceQueuesResponse' :: ListDeadLetterSourceQueuesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListDeadLetterSourceQueuesResponse
s@ListDeadLetterSourceQueuesResponse' {} Maybe Text
a -> ListDeadLetterSourceQueuesResponse
s {$sel:nextToken:ListDeadLetterSourceQueuesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListDeadLetterSourceQueuesResponse)

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

-- | A list of source queue URLs that have the @RedrivePolicy@ queue
-- attribute configured with a dead-letter queue.
listDeadLetterSourceQueuesResponse_queueUrls :: Lens.Lens' ListDeadLetterSourceQueuesResponse [Prelude.Text]
listDeadLetterSourceQueuesResponse_queueUrls :: Lens' ListDeadLetterSourceQueuesResponse [Text]
listDeadLetterSourceQueuesResponse_queueUrls = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeadLetterSourceQueuesResponse' {[Text]
queueUrls :: [Text]
$sel:queueUrls:ListDeadLetterSourceQueuesResponse' :: ListDeadLetterSourceQueuesResponse -> [Text]
queueUrls} -> [Text]
queueUrls) (\s :: ListDeadLetterSourceQueuesResponse
s@ListDeadLetterSourceQueuesResponse' {} [Text]
a -> ListDeadLetterSourceQueuesResponse
s {$sel:queueUrls:ListDeadLetterSourceQueuesResponse' :: [Text]
queueUrls = [Text]
a} :: ListDeadLetterSourceQueuesResponse) 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
    ListDeadLetterSourceQueuesResponse
  where
  rnf :: ListDeadLetterSourceQueuesResponse -> ()
rnf ListDeadLetterSourceQueuesResponse' {Int
[Text]
Maybe Text
queueUrls :: [Text]
httpStatus :: Int
nextToken :: Maybe Text
$sel:queueUrls:ListDeadLetterSourceQueuesResponse' :: ListDeadLetterSourceQueuesResponse -> [Text]
$sel:httpStatus:ListDeadLetterSourceQueuesResponse' :: ListDeadLetterSourceQueuesResponse -> Int
$sel:nextToken:ListDeadLetterSourceQueuesResponse' :: ListDeadLetterSourceQueuesResponse -> 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 [Text]
queueUrls