{-# 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.Kinesis.ListStreamConsumers
-- 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 consumers registered to receive data from a stream using
-- enhanced fan-out, and provides information about each consumer.
--
-- This operation has a limit of 5 transactions per second per stream.
--
-- This operation returns paginated results.
module Amazonka.Kinesis.ListStreamConsumers
  ( -- * Creating a Request
    ListStreamConsumers (..),
    newListStreamConsumers,

    -- * Request Lenses
    listStreamConsumers_maxResults,
    listStreamConsumers_nextToken,
    listStreamConsumers_streamCreationTimestamp,
    listStreamConsumers_streamARN,

    -- * Destructuring the Response
    ListStreamConsumersResponse (..),
    newListStreamConsumersResponse,

    -- * Response Lenses
    listStreamConsumersResponse_consumers,
    listStreamConsumersResponse_nextToken,
    listStreamConsumersResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListStreamConsumers' smart constructor.
data ListStreamConsumers = ListStreamConsumers'
  { -- | The maximum number of consumers that you want a single call of
    -- @ListStreamConsumers@ to return. The default value is 100. If you
    -- specify a value greater than 100, at most 100 results are returned.
    ListStreamConsumers -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | When the number of consumers that are registered with the data stream is
    -- greater than the default value for the @MaxResults@ parameter, or if you
    -- explicitly specify a value for @MaxResults@ that is less than the number
    -- of consumers that are registered with the data stream, the response
    -- includes a pagination token named @NextToken@. You can specify this
    -- @NextToken@ value in a subsequent call to @ListStreamConsumers@ to list
    -- the next set of registered consumers.
    --
    -- Don\'t specify @StreamName@ or @StreamCreationTimestamp@ if you specify
    -- @NextToken@ because the latter unambiguously identifies the stream.
    --
    -- You can optionally specify a value for the @MaxResults@ parameter when
    -- you specify @NextToken@. If you specify a @MaxResults@ value that is
    -- less than the number of consumers that the operation returns if you
    -- don\'t specify @MaxResults@, the response will contain a new @NextToken@
    -- value. You can use the new @NextToken@ value in a subsequent call to the
    -- @ListStreamConsumers@ operation to list the next set of consumers.
    --
    -- Tokens expire after 300 seconds. When you obtain a value for @NextToken@
    -- in the response to a call to @ListStreamConsumers@, you have 300 seconds
    -- to use that value. If you specify an expired token in a call to
    -- @ListStreamConsumers@, you get @ExpiredNextTokenException@.
    ListStreamConsumers -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Specify this input parameter to distinguish data streams that have the
    -- same name. For example, if you create a data stream and then delete it,
    -- and you later create another data stream with the same name, you can use
    -- this input parameter to specify which of the two streams you want to
    -- list the consumers for.
    --
    -- You can\'t specify this parameter if you specify the NextToken
    -- parameter.
    ListStreamConsumers -> Maybe POSIX
streamCreationTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The ARN of the Kinesis data stream for which you want to list the
    -- registered consumers. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#arn-syntax-kinesis-streams Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
    ListStreamConsumers -> Text
streamARN :: Prelude.Text
  }
  deriving (ListStreamConsumers -> ListStreamConsumers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStreamConsumers -> ListStreamConsumers -> Bool
$c/= :: ListStreamConsumers -> ListStreamConsumers -> Bool
== :: ListStreamConsumers -> ListStreamConsumers -> Bool
$c== :: ListStreamConsumers -> ListStreamConsumers -> Bool
Prelude.Eq, ReadPrec [ListStreamConsumers]
ReadPrec ListStreamConsumers
Int -> ReadS ListStreamConsumers
ReadS [ListStreamConsumers]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStreamConsumers]
$creadListPrec :: ReadPrec [ListStreamConsumers]
readPrec :: ReadPrec ListStreamConsumers
$creadPrec :: ReadPrec ListStreamConsumers
readList :: ReadS [ListStreamConsumers]
$creadList :: ReadS [ListStreamConsumers]
readsPrec :: Int -> ReadS ListStreamConsumers
$creadsPrec :: Int -> ReadS ListStreamConsumers
Prelude.Read, Int -> ListStreamConsumers -> ShowS
[ListStreamConsumers] -> ShowS
ListStreamConsumers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStreamConsumers] -> ShowS
$cshowList :: [ListStreamConsumers] -> ShowS
show :: ListStreamConsumers -> String
$cshow :: ListStreamConsumers -> String
showsPrec :: Int -> ListStreamConsumers -> ShowS
$cshowsPrec :: Int -> ListStreamConsumers -> ShowS
Prelude.Show, forall x. Rep ListStreamConsumers x -> ListStreamConsumers
forall x. ListStreamConsumers -> Rep ListStreamConsumers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListStreamConsumers x -> ListStreamConsumers
$cfrom :: forall x. ListStreamConsumers -> Rep ListStreamConsumers x
Prelude.Generic)

-- |
-- Create a value of 'ListStreamConsumers' 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', 'listStreamConsumers_maxResults' - The maximum number of consumers that you want a single call of
-- @ListStreamConsumers@ to return. The default value is 100. If you
-- specify a value greater than 100, at most 100 results are returned.
--
-- 'nextToken', 'listStreamConsumers_nextToken' - When the number of consumers that are registered with the data stream is
-- greater than the default value for the @MaxResults@ parameter, or if you
-- explicitly specify a value for @MaxResults@ that is less than the number
-- of consumers that are registered with the data stream, the response
-- includes a pagination token named @NextToken@. You can specify this
-- @NextToken@ value in a subsequent call to @ListStreamConsumers@ to list
-- the next set of registered consumers.
--
-- Don\'t specify @StreamName@ or @StreamCreationTimestamp@ if you specify
-- @NextToken@ because the latter unambiguously identifies the stream.
--
-- You can optionally specify a value for the @MaxResults@ parameter when
-- you specify @NextToken@. If you specify a @MaxResults@ value that is
-- less than the number of consumers that the operation returns if you
-- don\'t specify @MaxResults@, the response will contain a new @NextToken@
-- value. You can use the new @NextToken@ value in a subsequent call to the
-- @ListStreamConsumers@ operation to list the next set of consumers.
--
-- Tokens expire after 300 seconds. When you obtain a value for @NextToken@
-- in the response to a call to @ListStreamConsumers@, you have 300 seconds
-- to use that value. If you specify an expired token in a call to
-- @ListStreamConsumers@, you get @ExpiredNextTokenException@.
--
-- 'streamCreationTimestamp', 'listStreamConsumers_streamCreationTimestamp' - Specify this input parameter to distinguish data streams that have the
-- same name. For example, if you create a data stream and then delete it,
-- and you later create another data stream with the same name, you can use
-- this input parameter to specify which of the two streams you want to
-- list the consumers for.
--
-- You can\'t specify this parameter if you specify the NextToken
-- parameter.
--
-- 'streamARN', 'listStreamConsumers_streamARN' - The ARN of the Kinesis data stream for which you want to list the
-- registered consumers. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#arn-syntax-kinesis-streams Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
newListStreamConsumers ::
  -- | 'streamARN'
  Prelude.Text ->
  ListStreamConsumers
newListStreamConsumers :: Text -> ListStreamConsumers
newListStreamConsumers Text
pStreamARN_ =
  ListStreamConsumers'
    { $sel:maxResults:ListStreamConsumers' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListStreamConsumers' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:streamCreationTimestamp:ListStreamConsumers' :: Maybe POSIX
streamCreationTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:streamARN:ListStreamConsumers' :: Text
streamARN = Text
pStreamARN_
    }

-- | The maximum number of consumers that you want a single call of
-- @ListStreamConsumers@ to return. The default value is 100. If you
-- specify a value greater than 100, at most 100 results are returned.
listStreamConsumers_maxResults :: Lens.Lens' ListStreamConsumers (Prelude.Maybe Prelude.Natural)
listStreamConsumers_maxResults :: Lens' ListStreamConsumers (Maybe Natural)
listStreamConsumers_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamConsumers' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListStreamConsumers' :: ListStreamConsumers -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListStreamConsumers
s@ListStreamConsumers' {} Maybe Natural
a -> ListStreamConsumers
s {$sel:maxResults:ListStreamConsumers' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListStreamConsumers)

-- | When the number of consumers that are registered with the data stream is
-- greater than the default value for the @MaxResults@ parameter, or if you
-- explicitly specify a value for @MaxResults@ that is less than the number
-- of consumers that are registered with the data stream, the response
-- includes a pagination token named @NextToken@. You can specify this
-- @NextToken@ value in a subsequent call to @ListStreamConsumers@ to list
-- the next set of registered consumers.
--
-- Don\'t specify @StreamName@ or @StreamCreationTimestamp@ if you specify
-- @NextToken@ because the latter unambiguously identifies the stream.
--
-- You can optionally specify a value for the @MaxResults@ parameter when
-- you specify @NextToken@. If you specify a @MaxResults@ value that is
-- less than the number of consumers that the operation returns if you
-- don\'t specify @MaxResults@, the response will contain a new @NextToken@
-- value. You can use the new @NextToken@ value in a subsequent call to the
-- @ListStreamConsumers@ operation to list the next set of consumers.
--
-- Tokens expire after 300 seconds. When you obtain a value for @NextToken@
-- in the response to a call to @ListStreamConsumers@, you have 300 seconds
-- to use that value. If you specify an expired token in a call to
-- @ListStreamConsumers@, you get @ExpiredNextTokenException@.
listStreamConsumers_nextToken :: Lens.Lens' ListStreamConsumers (Prelude.Maybe Prelude.Text)
listStreamConsumers_nextToken :: Lens' ListStreamConsumers (Maybe Text)
listStreamConsumers_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamConsumers' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListStreamConsumers' :: ListStreamConsumers -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListStreamConsumers
s@ListStreamConsumers' {} Maybe Text
a -> ListStreamConsumers
s {$sel:nextToken:ListStreamConsumers' :: Maybe Text
nextToken = Maybe Text
a} :: ListStreamConsumers)

-- | Specify this input parameter to distinguish data streams that have the
-- same name. For example, if you create a data stream and then delete it,
-- and you later create another data stream with the same name, you can use
-- this input parameter to specify which of the two streams you want to
-- list the consumers for.
--
-- You can\'t specify this parameter if you specify the NextToken
-- parameter.
listStreamConsumers_streamCreationTimestamp :: Lens.Lens' ListStreamConsumers (Prelude.Maybe Prelude.UTCTime)
listStreamConsumers_streamCreationTimestamp :: Lens' ListStreamConsumers (Maybe UTCTime)
listStreamConsumers_streamCreationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamConsumers' {Maybe POSIX
streamCreationTimestamp :: Maybe POSIX
$sel:streamCreationTimestamp:ListStreamConsumers' :: ListStreamConsumers -> Maybe POSIX
streamCreationTimestamp} -> Maybe POSIX
streamCreationTimestamp) (\s :: ListStreamConsumers
s@ListStreamConsumers' {} Maybe POSIX
a -> ListStreamConsumers
s {$sel:streamCreationTimestamp:ListStreamConsumers' :: Maybe POSIX
streamCreationTimestamp = Maybe POSIX
a} :: ListStreamConsumers) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The ARN of the Kinesis data stream for which you want to list the
-- registered consumers. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#arn-syntax-kinesis-streams Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
listStreamConsumers_streamARN :: Lens.Lens' ListStreamConsumers Prelude.Text
listStreamConsumers_streamARN :: Lens' ListStreamConsumers Text
listStreamConsumers_streamARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamConsumers' {Text
streamARN :: Text
$sel:streamARN:ListStreamConsumers' :: ListStreamConsumers -> Text
streamARN} -> Text
streamARN) (\s :: ListStreamConsumers
s@ListStreamConsumers' {} Text
a -> ListStreamConsumers
s {$sel:streamARN:ListStreamConsumers' :: Text
streamARN = Text
a} :: ListStreamConsumers)

instance Core.AWSPager ListStreamConsumers where
  page :: ListStreamConsumers
-> AWSResponse ListStreamConsumers -> Maybe ListStreamConsumers
page ListStreamConsumers
rq AWSResponse ListStreamConsumers
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListStreamConsumers
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStreamConsumersResponse (Maybe Text)
listStreamConsumersResponse_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 ListStreamConsumers
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStreamConsumersResponse (Maybe [Consumer])
listStreamConsumersResponse_consumers
            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.$ ListStreamConsumers
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListStreamConsumers (Maybe Text)
listStreamConsumers_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListStreamConsumers
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStreamConsumersResponse (Maybe Text)
listStreamConsumersResponse_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 ListStreamConsumers where
  type
    AWSResponse ListStreamConsumers =
      ListStreamConsumersResponse
  request :: (Service -> Service)
-> ListStreamConsumers -> Request ListStreamConsumers
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListStreamConsumers
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListStreamConsumers)))
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 [Consumer]
-> Maybe Text -> Int -> ListStreamConsumersResponse
ListStreamConsumersResponse'
            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
"Consumers" 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 ListStreamConsumers where
  hashWithSalt :: Int -> ListStreamConsumers -> Int
hashWithSalt Int
_salt ListStreamConsumers' {Maybe Natural
Maybe Text
Maybe POSIX
Text
streamARN :: Text
streamCreationTimestamp :: Maybe POSIX
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:streamARN:ListStreamConsumers' :: ListStreamConsumers -> Text
$sel:streamCreationTimestamp:ListStreamConsumers' :: ListStreamConsumers -> Maybe POSIX
$sel:nextToken:ListStreamConsumers' :: ListStreamConsumers -> Maybe Text
$sel:maxResults:ListStreamConsumers' :: ListStreamConsumers -> 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 POSIX
streamCreationTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
streamARN

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

instance Data.ToHeaders ListStreamConsumers where
  toHeaders :: ListStreamConsumers -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Kinesis_20131202.ListStreamConsumers" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListStreamConsumers where
  toJSON :: ListStreamConsumers -> Value
toJSON ListStreamConsumers' {Maybe Natural
Maybe Text
Maybe POSIX
Text
streamARN :: Text
streamCreationTimestamp :: Maybe POSIX
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:streamARN:ListStreamConsumers' :: ListStreamConsumers -> Text
$sel:streamCreationTimestamp:ListStreamConsumers' :: ListStreamConsumers -> Maybe POSIX
$sel:nextToken:ListStreamConsumers' :: ListStreamConsumers -> Maybe Text
$sel:maxResults:ListStreamConsumers' :: ListStreamConsumers -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxResults,
            (Key
"NextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken,
            (Key
"StreamCreationTimestamp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe POSIX
streamCreationTimestamp,
            forall a. a -> Maybe a
Prelude.Just (Key
"StreamARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
streamARN)
          ]
      )

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

instance Data.ToQuery ListStreamConsumers where
  toQuery :: ListStreamConsumers -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newListStreamConsumersResponse' smart constructor.
data ListStreamConsumersResponse = ListStreamConsumersResponse'
  { -- | An array of JSON objects. Each object represents one registered
    -- consumer.
    ListStreamConsumersResponse -> Maybe [Consumer]
consumers :: Prelude.Maybe [Consumer],
    -- | When the number of consumers that are registered with the data stream is
    -- greater than the default value for the @MaxResults@ parameter, or if you
    -- explicitly specify a value for @MaxResults@ that is less than the number
    -- of registered consumers, the response includes a pagination token named
    -- @NextToken@. You can specify this @NextToken@ value in a subsequent call
    -- to @ListStreamConsumers@ to list the next set of registered consumers.
    -- For more information about the use of this pagination token when calling
    -- the @ListStreamConsumers@ operation, see
    -- ListStreamConsumersInput$NextToken.
    --
    -- Tokens expire after 300 seconds. When you obtain a value for @NextToken@
    -- in the response to a call to @ListStreamConsumers@, you have 300 seconds
    -- to use that value. If you specify an expired token in a call to
    -- @ListStreamConsumers@, you get @ExpiredNextTokenException@.
    ListStreamConsumersResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListStreamConsumersResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListStreamConsumersResponse -> ListStreamConsumersResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStreamConsumersResponse -> ListStreamConsumersResponse -> Bool
$c/= :: ListStreamConsumersResponse -> ListStreamConsumersResponse -> Bool
== :: ListStreamConsumersResponse -> ListStreamConsumersResponse -> Bool
$c== :: ListStreamConsumersResponse -> ListStreamConsumersResponse -> Bool
Prelude.Eq, ReadPrec [ListStreamConsumersResponse]
ReadPrec ListStreamConsumersResponse
Int -> ReadS ListStreamConsumersResponse
ReadS [ListStreamConsumersResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStreamConsumersResponse]
$creadListPrec :: ReadPrec [ListStreamConsumersResponse]
readPrec :: ReadPrec ListStreamConsumersResponse
$creadPrec :: ReadPrec ListStreamConsumersResponse
readList :: ReadS [ListStreamConsumersResponse]
$creadList :: ReadS [ListStreamConsumersResponse]
readsPrec :: Int -> ReadS ListStreamConsumersResponse
$creadsPrec :: Int -> ReadS ListStreamConsumersResponse
Prelude.Read, Int -> ListStreamConsumersResponse -> ShowS
[ListStreamConsumersResponse] -> ShowS
ListStreamConsumersResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStreamConsumersResponse] -> ShowS
$cshowList :: [ListStreamConsumersResponse] -> ShowS
show :: ListStreamConsumersResponse -> String
$cshow :: ListStreamConsumersResponse -> String
showsPrec :: Int -> ListStreamConsumersResponse -> ShowS
$cshowsPrec :: Int -> ListStreamConsumersResponse -> ShowS
Prelude.Show, forall x.
Rep ListStreamConsumersResponse x -> ListStreamConsumersResponse
forall x.
ListStreamConsumersResponse -> Rep ListStreamConsumersResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListStreamConsumersResponse x -> ListStreamConsumersResponse
$cfrom :: forall x.
ListStreamConsumersResponse -> Rep ListStreamConsumersResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListStreamConsumersResponse' 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:
--
-- 'consumers', 'listStreamConsumersResponse_consumers' - An array of JSON objects. Each object represents one registered
-- consumer.
--
-- 'nextToken', 'listStreamConsumersResponse_nextToken' - When the number of consumers that are registered with the data stream is
-- greater than the default value for the @MaxResults@ parameter, or if you
-- explicitly specify a value for @MaxResults@ that is less than the number
-- of registered consumers, the response includes a pagination token named
-- @NextToken@. You can specify this @NextToken@ value in a subsequent call
-- to @ListStreamConsumers@ to list the next set of registered consumers.
-- For more information about the use of this pagination token when calling
-- the @ListStreamConsumers@ operation, see
-- ListStreamConsumersInput$NextToken.
--
-- Tokens expire after 300 seconds. When you obtain a value for @NextToken@
-- in the response to a call to @ListStreamConsumers@, you have 300 seconds
-- to use that value. If you specify an expired token in a call to
-- @ListStreamConsumers@, you get @ExpiredNextTokenException@.
--
-- 'httpStatus', 'listStreamConsumersResponse_httpStatus' - The response's http status code.
newListStreamConsumersResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListStreamConsumersResponse
newListStreamConsumersResponse :: Int -> ListStreamConsumersResponse
newListStreamConsumersResponse Int
pHttpStatus_ =
  ListStreamConsumersResponse'
    { $sel:consumers:ListStreamConsumersResponse' :: Maybe [Consumer]
consumers =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListStreamConsumersResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListStreamConsumersResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of JSON objects. Each object represents one registered
-- consumer.
listStreamConsumersResponse_consumers :: Lens.Lens' ListStreamConsumersResponse (Prelude.Maybe [Consumer])
listStreamConsumersResponse_consumers :: Lens' ListStreamConsumersResponse (Maybe [Consumer])
listStreamConsumersResponse_consumers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamConsumersResponse' {Maybe [Consumer]
consumers :: Maybe [Consumer]
$sel:consumers:ListStreamConsumersResponse' :: ListStreamConsumersResponse -> Maybe [Consumer]
consumers} -> Maybe [Consumer]
consumers) (\s :: ListStreamConsumersResponse
s@ListStreamConsumersResponse' {} Maybe [Consumer]
a -> ListStreamConsumersResponse
s {$sel:consumers:ListStreamConsumersResponse' :: Maybe [Consumer]
consumers = Maybe [Consumer]
a} :: ListStreamConsumersResponse) 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

-- | When the number of consumers that are registered with the data stream is
-- greater than the default value for the @MaxResults@ parameter, or if you
-- explicitly specify a value for @MaxResults@ that is less than the number
-- of registered consumers, the response includes a pagination token named
-- @NextToken@. You can specify this @NextToken@ value in a subsequent call
-- to @ListStreamConsumers@ to list the next set of registered consumers.
-- For more information about the use of this pagination token when calling
-- the @ListStreamConsumers@ operation, see
-- ListStreamConsumersInput$NextToken.
--
-- Tokens expire after 300 seconds. When you obtain a value for @NextToken@
-- in the response to a call to @ListStreamConsumers@, you have 300 seconds
-- to use that value. If you specify an expired token in a call to
-- @ListStreamConsumers@, you get @ExpiredNextTokenException@.
listStreamConsumersResponse_nextToken :: Lens.Lens' ListStreamConsumersResponse (Prelude.Maybe Prelude.Text)
listStreamConsumersResponse_nextToken :: Lens' ListStreamConsumersResponse (Maybe Text)
listStreamConsumersResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamConsumersResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListStreamConsumersResponse' :: ListStreamConsumersResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListStreamConsumersResponse
s@ListStreamConsumersResponse' {} Maybe Text
a -> ListStreamConsumersResponse
s {$sel:nextToken:ListStreamConsumersResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListStreamConsumersResponse)

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

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