{-# 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.IoTWireless.ListQueuedMessages
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List queued messages in the downlink queue.
module Amazonka.IoTWireless.ListQueuedMessages
  ( -- * Creating a Request
    ListQueuedMessages (..),
    newListQueuedMessages,

    -- * Request Lenses
    listQueuedMessages_maxResults,
    listQueuedMessages_nextToken,
    listQueuedMessages_wirelessDeviceType,
    listQueuedMessages_id,

    -- * Destructuring the Response
    ListQueuedMessagesResponse (..),
    newListQueuedMessagesResponse,

    -- * Response Lenses
    listQueuedMessagesResponse_downlinkQueueMessagesList,
    listQueuedMessagesResponse_nextToken,
    listQueuedMessagesResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTWireless.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newListQueuedMessages' smart constructor.
data ListQueuedMessages = ListQueuedMessages'
  { -- | The maximum number of results to return in this operation.
    ListQueuedMessages -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | To retrieve the next set of results, the @nextToken@ value from a
    -- previous response; otherwise __null__ to receive the first set of
    -- results.
    ListQueuedMessages -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The wireless device type, whic can be either Sidewalk or LoRaWAN.
    ListQueuedMessages -> Maybe WirelessDeviceType
wirelessDeviceType :: Prelude.Maybe WirelessDeviceType,
    -- | The ID of a given wireless device which the downlink message packets are
    -- being sent.
    ListQueuedMessages -> Text
id :: Prelude.Text
  }
  deriving (ListQueuedMessages -> ListQueuedMessages -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListQueuedMessages -> ListQueuedMessages -> Bool
$c/= :: ListQueuedMessages -> ListQueuedMessages -> Bool
== :: ListQueuedMessages -> ListQueuedMessages -> Bool
$c== :: ListQueuedMessages -> ListQueuedMessages -> Bool
Prelude.Eq, ReadPrec [ListQueuedMessages]
ReadPrec ListQueuedMessages
Int -> ReadS ListQueuedMessages
ReadS [ListQueuedMessages]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListQueuedMessages]
$creadListPrec :: ReadPrec [ListQueuedMessages]
readPrec :: ReadPrec ListQueuedMessages
$creadPrec :: ReadPrec ListQueuedMessages
readList :: ReadS [ListQueuedMessages]
$creadList :: ReadS [ListQueuedMessages]
readsPrec :: Int -> ReadS ListQueuedMessages
$creadsPrec :: Int -> ReadS ListQueuedMessages
Prelude.Read, Int -> ListQueuedMessages -> ShowS
[ListQueuedMessages] -> ShowS
ListQueuedMessages -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListQueuedMessages] -> ShowS
$cshowList :: [ListQueuedMessages] -> ShowS
show :: ListQueuedMessages -> String
$cshow :: ListQueuedMessages -> String
showsPrec :: Int -> ListQueuedMessages -> ShowS
$cshowsPrec :: Int -> ListQueuedMessages -> ShowS
Prelude.Show, forall x. Rep ListQueuedMessages x -> ListQueuedMessages
forall x. ListQueuedMessages -> Rep ListQueuedMessages x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListQueuedMessages x -> ListQueuedMessages
$cfrom :: forall x. ListQueuedMessages -> Rep ListQueuedMessages x
Prelude.Generic)

-- |
-- Create a value of 'ListQueuedMessages' 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', 'listQueuedMessages_maxResults' - The maximum number of results to return in this operation.
--
-- 'nextToken', 'listQueuedMessages_nextToken' - To retrieve the next set of results, the @nextToken@ value from a
-- previous response; otherwise __null__ to receive the first set of
-- results.
--
-- 'wirelessDeviceType', 'listQueuedMessages_wirelessDeviceType' - The wireless device type, whic can be either Sidewalk or LoRaWAN.
--
-- 'id', 'listQueuedMessages_id' - The ID of a given wireless device which the downlink message packets are
-- being sent.
newListQueuedMessages ::
  -- | 'id'
  Prelude.Text ->
  ListQueuedMessages
newListQueuedMessages :: Text -> ListQueuedMessages
newListQueuedMessages Text
pId_ =
  ListQueuedMessages'
    { $sel:maxResults:ListQueuedMessages' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListQueuedMessages' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:wirelessDeviceType:ListQueuedMessages' :: Maybe WirelessDeviceType
wirelessDeviceType = forall a. Maybe a
Prelude.Nothing,
      $sel:id:ListQueuedMessages' :: Text
id = Text
pId_
    }

-- | The maximum number of results to return in this operation.
listQueuedMessages_maxResults :: Lens.Lens' ListQueuedMessages (Prelude.Maybe Prelude.Natural)
listQueuedMessages_maxResults :: Lens' ListQueuedMessages (Maybe Natural)
listQueuedMessages_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueuedMessages' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListQueuedMessages' :: ListQueuedMessages -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListQueuedMessages
s@ListQueuedMessages' {} Maybe Natural
a -> ListQueuedMessages
s {$sel:maxResults:ListQueuedMessages' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListQueuedMessages)

-- | To retrieve the next set of results, the @nextToken@ value from a
-- previous response; otherwise __null__ to receive the first set of
-- results.
listQueuedMessages_nextToken :: Lens.Lens' ListQueuedMessages (Prelude.Maybe Prelude.Text)
listQueuedMessages_nextToken :: Lens' ListQueuedMessages (Maybe Text)
listQueuedMessages_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueuedMessages' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListQueuedMessages' :: ListQueuedMessages -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListQueuedMessages
s@ListQueuedMessages' {} Maybe Text
a -> ListQueuedMessages
s {$sel:nextToken:ListQueuedMessages' :: Maybe Text
nextToken = Maybe Text
a} :: ListQueuedMessages)

-- | The wireless device type, whic can be either Sidewalk or LoRaWAN.
listQueuedMessages_wirelessDeviceType :: Lens.Lens' ListQueuedMessages (Prelude.Maybe WirelessDeviceType)
listQueuedMessages_wirelessDeviceType :: Lens' ListQueuedMessages (Maybe WirelessDeviceType)
listQueuedMessages_wirelessDeviceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueuedMessages' {Maybe WirelessDeviceType
wirelessDeviceType :: Maybe WirelessDeviceType
$sel:wirelessDeviceType:ListQueuedMessages' :: ListQueuedMessages -> Maybe WirelessDeviceType
wirelessDeviceType} -> Maybe WirelessDeviceType
wirelessDeviceType) (\s :: ListQueuedMessages
s@ListQueuedMessages' {} Maybe WirelessDeviceType
a -> ListQueuedMessages
s {$sel:wirelessDeviceType:ListQueuedMessages' :: Maybe WirelessDeviceType
wirelessDeviceType = Maybe WirelessDeviceType
a} :: ListQueuedMessages)

-- | The ID of a given wireless device which the downlink message packets are
-- being sent.
listQueuedMessages_id :: Lens.Lens' ListQueuedMessages Prelude.Text
listQueuedMessages_id :: Lens' ListQueuedMessages Text
listQueuedMessages_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueuedMessages' {Text
id :: Text
$sel:id:ListQueuedMessages' :: ListQueuedMessages -> Text
id} -> Text
id) (\s :: ListQueuedMessages
s@ListQueuedMessages' {} Text
a -> ListQueuedMessages
s {$sel:id:ListQueuedMessages' :: Text
id = Text
a} :: ListQueuedMessages)

instance Core.AWSRequest ListQueuedMessages where
  type
    AWSResponse ListQueuedMessages =
      ListQueuedMessagesResponse
  request :: (Service -> Service)
-> ListQueuedMessages -> Request ListQueuedMessages
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 ListQueuedMessages
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListQueuedMessages)))
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 [DownlinkQueueMessage]
-> Maybe Text -> Int -> ListQueuedMessagesResponse
ListQueuedMessagesResponse'
            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
"DownlinkQueueMessagesList"
                            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.<*> (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))
      )

instance Prelude.Hashable ListQueuedMessages where
  hashWithSalt :: Int -> ListQueuedMessages -> Int
hashWithSalt Int
_salt ListQueuedMessages' {Maybe Natural
Maybe Text
Maybe WirelessDeviceType
Text
id :: Text
wirelessDeviceType :: Maybe WirelessDeviceType
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:id:ListQueuedMessages' :: ListQueuedMessages -> Text
$sel:wirelessDeviceType:ListQueuedMessages' :: ListQueuedMessages -> Maybe WirelessDeviceType
$sel:nextToken:ListQueuedMessages' :: ListQueuedMessages -> Maybe Text
$sel:maxResults:ListQueuedMessages' :: ListQueuedMessages -> 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` Maybe WirelessDeviceType
wirelessDeviceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData ListQueuedMessages where
  rnf :: ListQueuedMessages -> ()
rnf ListQueuedMessages' {Maybe Natural
Maybe Text
Maybe WirelessDeviceType
Text
id :: Text
wirelessDeviceType :: Maybe WirelessDeviceType
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:id:ListQueuedMessages' :: ListQueuedMessages -> Text
$sel:wirelessDeviceType:ListQueuedMessages' :: ListQueuedMessages -> Maybe WirelessDeviceType
$sel:nextToken:ListQueuedMessages' :: ListQueuedMessages -> Maybe Text
$sel:maxResults:ListQueuedMessages' :: ListQueuedMessages -> 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 Maybe WirelessDeviceType
wirelessDeviceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

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

instance Data.ToPath ListQueuedMessages where
  toPath :: ListQueuedMessages -> ByteString
toPath ListQueuedMessages' {Maybe Natural
Maybe Text
Maybe WirelessDeviceType
Text
id :: Text
wirelessDeviceType :: Maybe WirelessDeviceType
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:id:ListQueuedMessages' :: ListQueuedMessages -> Text
$sel:wirelessDeviceType:ListQueuedMessages' :: ListQueuedMessages -> Maybe WirelessDeviceType
$sel:nextToken:ListQueuedMessages' :: ListQueuedMessages -> Maybe Text
$sel:maxResults:ListQueuedMessages' :: ListQueuedMessages -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/wireless-devices/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id, ByteString
"/data"]

instance Data.ToQuery ListQueuedMessages where
  toQuery :: ListQueuedMessages -> QueryString
toQuery ListQueuedMessages' {Maybe Natural
Maybe Text
Maybe WirelessDeviceType
Text
id :: Text
wirelessDeviceType :: Maybe WirelessDeviceType
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:id:ListQueuedMessages' :: ListQueuedMessages -> Text
$sel:wirelessDeviceType:ListQueuedMessages' :: ListQueuedMessages -> Maybe WirelessDeviceType
$sel:nextToken:ListQueuedMessages' :: ListQueuedMessages -> Maybe Text
$sel:maxResults:ListQueuedMessages' :: ListQueuedMessages -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"WirelessDeviceType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe WirelessDeviceType
wirelessDeviceType
      ]

-- | /See:/ 'newListQueuedMessagesResponse' smart constructor.
data ListQueuedMessagesResponse = ListQueuedMessagesResponse'
  { -- | The messages in the downlink queue.
    ListQueuedMessagesResponse -> Maybe [DownlinkQueueMessage]
downlinkQueueMessagesList :: Prelude.Maybe [DownlinkQueueMessage],
    -- | To retrieve the next set of results, the @nextToken@ value from a
    -- previous response; otherwise __null__ to receive the first set of
    -- results.
    ListQueuedMessagesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListQueuedMessagesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListQueuedMessagesResponse -> ListQueuedMessagesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListQueuedMessagesResponse -> ListQueuedMessagesResponse -> Bool
$c/= :: ListQueuedMessagesResponse -> ListQueuedMessagesResponse -> Bool
== :: ListQueuedMessagesResponse -> ListQueuedMessagesResponse -> Bool
$c== :: ListQueuedMessagesResponse -> ListQueuedMessagesResponse -> Bool
Prelude.Eq, ReadPrec [ListQueuedMessagesResponse]
ReadPrec ListQueuedMessagesResponse
Int -> ReadS ListQueuedMessagesResponse
ReadS [ListQueuedMessagesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListQueuedMessagesResponse]
$creadListPrec :: ReadPrec [ListQueuedMessagesResponse]
readPrec :: ReadPrec ListQueuedMessagesResponse
$creadPrec :: ReadPrec ListQueuedMessagesResponse
readList :: ReadS [ListQueuedMessagesResponse]
$creadList :: ReadS [ListQueuedMessagesResponse]
readsPrec :: Int -> ReadS ListQueuedMessagesResponse
$creadsPrec :: Int -> ReadS ListQueuedMessagesResponse
Prelude.Read, Int -> ListQueuedMessagesResponse -> ShowS
[ListQueuedMessagesResponse] -> ShowS
ListQueuedMessagesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListQueuedMessagesResponse] -> ShowS
$cshowList :: [ListQueuedMessagesResponse] -> ShowS
show :: ListQueuedMessagesResponse -> String
$cshow :: ListQueuedMessagesResponse -> String
showsPrec :: Int -> ListQueuedMessagesResponse -> ShowS
$cshowsPrec :: Int -> ListQueuedMessagesResponse -> ShowS
Prelude.Show, forall x.
Rep ListQueuedMessagesResponse x -> ListQueuedMessagesResponse
forall x.
ListQueuedMessagesResponse -> Rep ListQueuedMessagesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListQueuedMessagesResponse x -> ListQueuedMessagesResponse
$cfrom :: forall x.
ListQueuedMessagesResponse -> Rep ListQueuedMessagesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListQueuedMessagesResponse' 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:
--
-- 'downlinkQueueMessagesList', 'listQueuedMessagesResponse_downlinkQueueMessagesList' - The messages in the downlink queue.
--
-- 'nextToken', 'listQueuedMessagesResponse_nextToken' - To retrieve the next set of results, the @nextToken@ value from a
-- previous response; otherwise __null__ to receive the first set of
-- results.
--
-- 'httpStatus', 'listQueuedMessagesResponse_httpStatus' - The response's http status code.
newListQueuedMessagesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListQueuedMessagesResponse
newListQueuedMessagesResponse :: Int -> ListQueuedMessagesResponse
newListQueuedMessagesResponse Int
pHttpStatus_ =
  ListQueuedMessagesResponse'
    { $sel:downlinkQueueMessagesList:ListQueuedMessagesResponse' :: Maybe [DownlinkQueueMessage]
downlinkQueueMessagesList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListQueuedMessagesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListQueuedMessagesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The messages in the downlink queue.
listQueuedMessagesResponse_downlinkQueueMessagesList :: Lens.Lens' ListQueuedMessagesResponse (Prelude.Maybe [DownlinkQueueMessage])
listQueuedMessagesResponse_downlinkQueueMessagesList :: Lens' ListQueuedMessagesResponse (Maybe [DownlinkQueueMessage])
listQueuedMessagesResponse_downlinkQueueMessagesList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueuedMessagesResponse' {Maybe [DownlinkQueueMessage]
downlinkQueueMessagesList :: Maybe [DownlinkQueueMessage]
$sel:downlinkQueueMessagesList:ListQueuedMessagesResponse' :: ListQueuedMessagesResponse -> Maybe [DownlinkQueueMessage]
downlinkQueueMessagesList} -> Maybe [DownlinkQueueMessage]
downlinkQueueMessagesList) (\s :: ListQueuedMessagesResponse
s@ListQueuedMessagesResponse' {} Maybe [DownlinkQueueMessage]
a -> ListQueuedMessagesResponse
s {$sel:downlinkQueueMessagesList:ListQueuedMessagesResponse' :: Maybe [DownlinkQueueMessage]
downlinkQueueMessagesList = Maybe [DownlinkQueueMessage]
a} :: ListQueuedMessagesResponse) 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

-- | To retrieve the next set of results, the @nextToken@ value from a
-- previous response; otherwise __null__ to receive the first set of
-- results.
listQueuedMessagesResponse_nextToken :: Lens.Lens' ListQueuedMessagesResponse (Prelude.Maybe Prelude.Text)
listQueuedMessagesResponse_nextToken :: Lens' ListQueuedMessagesResponse (Maybe Text)
listQueuedMessagesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQueuedMessagesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListQueuedMessagesResponse' :: ListQueuedMessagesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListQueuedMessagesResponse
s@ListQueuedMessagesResponse' {} Maybe Text
a -> ListQueuedMessagesResponse
s {$sel:nextToken:ListQueuedMessagesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListQueuedMessagesResponse)

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

instance Prelude.NFData ListQueuedMessagesResponse where
  rnf :: ListQueuedMessagesResponse -> ()
rnf ListQueuedMessagesResponse' {Int
Maybe [DownlinkQueueMessage]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
downlinkQueueMessagesList :: Maybe [DownlinkQueueMessage]
$sel:httpStatus:ListQueuedMessagesResponse' :: ListQueuedMessagesResponse -> Int
$sel:nextToken:ListQueuedMessagesResponse' :: ListQueuedMessagesResponse -> Maybe Text
$sel:downlinkQueueMessagesList:ListQueuedMessagesResponse' :: ListQueuedMessagesResponse -> Maybe [DownlinkQueueMessage]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DownlinkQueueMessage]
downlinkQueueMessagesList
      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 Int
httpStatus