{-# 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.ListTagsForStream
-- 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 tags for the specified Kinesis data stream. This operation has
-- a limit of five transactions per second per account.
--
-- When invoking this API, it is recommended you use the @StreamARN@ input
-- parameter rather than the @StreamName@ input parameter.
module Amazonka.Kinesis.ListTagsForStream
  ( -- * Creating a Request
    ListTagsForStream (..),
    newListTagsForStream,

    -- * Request Lenses
    listTagsForStream_exclusiveStartTagKey,
    listTagsForStream_limit,
    listTagsForStream_streamARN,
    listTagsForStream_streamName,

    -- * Destructuring the Response
    ListTagsForStreamResponse (..),
    newListTagsForStreamResponse,

    -- * Response Lenses
    listTagsForStreamResponse_httpStatus,
    listTagsForStreamResponse_tags,
    listTagsForStreamResponse_hasMoreTags,
  )
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

-- | Represents the input for @ListTagsForStream@.
--
-- /See:/ 'newListTagsForStream' smart constructor.
data ListTagsForStream = ListTagsForStream'
  { -- | The key to use as the starting point for the list of tags. If this
    -- parameter is set, @ListTagsForStream@ gets all tags that occur after
    -- @ExclusiveStartTagKey@.
    ListTagsForStream -> Maybe Text
exclusiveStartTagKey :: Prelude.Maybe Prelude.Text,
    -- | The number of tags to return. If this number is less than the total
    -- number of tags associated with the stream, @HasMoreTags@ is set to
    -- @true@. To list additional tags, set @ExclusiveStartTagKey@ to the last
    -- key in the response.
    ListTagsForStream -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | The ARN of the stream.
    ListTagsForStream -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The name of the stream.
    ListTagsForStream -> Maybe Text
streamName :: Prelude.Maybe Prelude.Text
  }
  deriving (ListTagsForStream -> ListTagsForStream -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTagsForStream -> ListTagsForStream -> Bool
$c/= :: ListTagsForStream -> ListTagsForStream -> Bool
== :: ListTagsForStream -> ListTagsForStream -> Bool
$c== :: ListTagsForStream -> ListTagsForStream -> Bool
Prelude.Eq, ReadPrec [ListTagsForStream]
ReadPrec ListTagsForStream
Int -> ReadS ListTagsForStream
ReadS [ListTagsForStream]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTagsForStream]
$creadListPrec :: ReadPrec [ListTagsForStream]
readPrec :: ReadPrec ListTagsForStream
$creadPrec :: ReadPrec ListTagsForStream
readList :: ReadS [ListTagsForStream]
$creadList :: ReadS [ListTagsForStream]
readsPrec :: Int -> ReadS ListTagsForStream
$creadsPrec :: Int -> ReadS ListTagsForStream
Prelude.Read, Int -> ListTagsForStream -> ShowS
[ListTagsForStream] -> ShowS
ListTagsForStream -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTagsForStream] -> ShowS
$cshowList :: [ListTagsForStream] -> ShowS
show :: ListTagsForStream -> String
$cshow :: ListTagsForStream -> String
showsPrec :: Int -> ListTagsForStream -> ShowS
$cshowsPrec :: Int -> ListTagsForStream -> ShowS
Prelude.Show, forall x. Rep ListTagsForStream x -> ListTagsForStream
forall x. ListTagsForStream -> Rep ListTagsForStream x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTagsForStream x -> ListTagsForStream
$cfrom :: forall x. ListTagsForStream -> Rep ListTagsForStream x
Prelude.Generic)

-- |
-- Create a value of 'ListTagsForStream' 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:
--
-- 'exclusiveStartTagKey', 'listTagsForStream_exclusiveStartTagKey' - The key to use as the starting point for the list of tags. If this
-- parameter is set, @ListTagsForStream@ gets all tags that occur after
-- @ExclusiveStartTagKey@.
--
-- 'limit', 'listTagsForStream_limit' - The number of tags to return. If this number is less than the total
-- number of tags associated with the stream, @HasMoreTags@ is set to
-- @true@. To list additional tags, set @ExclusiveStartTagKey@ to the last
-- key in the response.
--
-- 'streamARN', 'listTagsForStream_streamARN' - The ARN of the stream.
--
-- 'streamName', 'listTagsForStream_streamName' - The name of the stream.
newListTagsForStream ::
  ListTagsForStream
newListTagsForStream :: ListTagsForStream
newListTagsForStream =
  ListTagsForStream'
    { $sel:exclusiveStartTagKey:ListTagsForStream' :: Maybe Text
exclusiveStartTagKey =
        forall a. Maybe a
Prelude.Nothing,
      $sel:limit:ListTagsForStream' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:streamARN:ListTagsForStream' :: Maybe Text
streamARN = forall a. Maybe a
Prelude.Nothing,
      $sel:streamName:ListTagsForStream' :: Maybe Text
streamName = forall a. Maybe a
Prelude.Nothing
    }

-- | The key to use as the starting point for the list of tags. If this
-- parameter is set, @ListTagsForStream@ gets all tags that occur after
-- @ExclusiveStartTagKey@.
listTagsForStream_exclusiveStartTagKey :: Lens.Lens' ListTagsForStream (Prelude.Maybe Prelude.Text)
listTagsForStream_exclusiveStartTagKey :: Lens' ListTagsForStream (Maybe Text)
listTagsForStream_exclusiveStartTagKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForStream' {Maybe Text
exclusiveStartTagKey :: Maybe Text
$sel:exclusiveStartTagKey:ListTagsForStream' :: ListTagsForStream -> Maybe Text
exclusiveStartTagKey} -> Maybe Text
exclusiveStartTagKey) (\s :: ListTagsForStream
s@ListTagsForStream' {} Maybe Text
a -> ListTagsForStream
s {$sel:exclusiveStartTagKey:ListTagsForStream' :: Maybe Text
exclusiveStartTagKey = Maybe Text
a} :: ListTagsForStream)

-- | The number of tags to return. If this number is less than the total
-- number of tags associated with the stream, @HasMoreTags@ is set to
-- @true@. To list additional tags, set @ExclusiveStartTagKey@ to the last
-- key in the response.
listTagsForStream_limit :: Lens.Lens' ListTagsForStream (Prelude.Maybe Prelude.Natural)
listTagsForStream_limit :: Lens' ListTagsForStream (Maybe Natural)
listTagsForStream_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForStream' {Maybe Natural
limit :: Maybe Natural
$sel:limit:ListTagsForStream' :: ListTagsForStream -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: ListTagsForStream
s@ListTagsForStream' {} Maybe Natural
a -> ListTagsForStream
s {$sel:limit:ListTagsForStream' :: Maybe Natural
limit = Maybe Natural
a} :: ListTagsForStream)

-- | The ARN of the stream.
listTagsForStream_streamARN :: Lens.Lens' ListTagsForStream (Prelude.Maybe Prelude.Text)
listTagsForStream_streamARN :: Lens' ListTagsForStream (Maybe Text)
listTagsForStream_streamARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForStream' {Maybe Text
streamARN :: Maybe Text
$sel:streamARN:ListTagsForStream' :: ListTagsForStream -> Maybe Text
streamARN} -> Maybe Text
streamARN) (\s :: ListTagsForStream
s@ListTagsForStream' {} Maybe Text
a -> ListTagsForStream
s {$sel:streamARN:ListTagsForStream' :: Maybe Text
streamARN = Maybe Text
a} :: ListTagsForStream)

-- | The name of the stream.
listTagsForStream_streamName :: Lens.Lens' ListTagsForStream (Prelude.Maybe Prelude.Text)
listTagsForStream_streamName :: Lens' ListTagsForStream (Maybe Text)
listTagsForStream_streamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForStream' {Maybe Text
streamName :: Maybe Text
$sel:streamName:ListTagsForStream' :: ListTagsForStream -> Maybe Text
streamName} -> Maybe Text
streamName) (\s :: ListTagsForStream
s@ListTagsForStream' {} Maybe Text
a -> ListTagsForStream
s {$sel:streamName:ListTagsForStream' :: Maybe Text
streamName = Maybe Text
a} :: ListTagsForStream)

instance Core.AWSRequest ListTagsForStream where
  type
    AWSResponse ListTagsForStream =
      ListTagsForStreamResponse
  request :: (Service -> Service)
-> ListTagsForStream -> Request ListTagsForStream
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 ListTagsForStream
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListTagsForStream)))
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 ->
          Int -> [Tag] -> Bool -> ListTagsForStreamResponse
ListTagsForStreamResponse'
            forall (f :: * -> *) a b. Functor 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Tags" 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 a
Data..:> Key
"HasMoreTags")
      )

instance Prelude.Hashable ListTagsForStream where
  hashWithSalt :: Int -> ListTagsForStream -> Int
hashWithSalt Int
_salt ListTagsForStream' {Maybe Natural
Maybe Text
streamName :: Maybe Text
streamARN :: Maybe Text
limit :: Maybe Natural
exclusiveStartTagKey :: Maybe Text
$sel:streamName:ListTagsForStream' :: ListTagsForStream -> Maybe Text
$sel:streamARN:ListTagsForStream' :: ListTagsForStream -> Maybe Text
$sel:limit:ListTagsForStream' :: ListTagsForStream -> Maybe Natural
$sel:exclusiveStartTagKey:ListTagsForStream' :: ListTagsForStream -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
exclusiveStartTagKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamName

instance Prelude.NFData ListTagsForStream where
  rnf :: ListTagsForStream -> ()
rnf ListTagsForStream' {Maybe Natural
Maybe Text
streamName :: Maybe Text
streamARN :: Maybe Text
limit :: Maybe Natural
exclusiveStartTagKey :: Maybe Text
$sel:streamName:ListTagsForStream' :: ListTagsForStream -> Maybe Text
$sel:streamARN:ListTagsForStream' :: ListTagsForStream -> Maybe Text
$sel:limit:ListTagsForStream' :: ListTagsForStream -> Maybe Natural
$sel:exclusiveStartTagKey:ListTagsForStream' :: ListTagsForStream -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
exclusiveStartTagKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamName

instance Data.ToHeaders ListTagsForStream where
  toHeaders :: ListTagsForStream -> 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.ListTagsForStream" ::
                          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 ListTagsForStream where
  toJSON :: ListTagsForStream -> Value
toJSON ListTagsForStream' {Maybe Natural
Maybe Text
streamName :: Maybe Text
streamARN :: Maybe Text
limit :: Maybe Natural
exclusiveStartTagKey :: Maybe Text
$sel:streamName:ListTagsForStream' :: ListTagsForStream -> Maybe Text
$sel:streamARN:ListTagsForStream' :: ListTagsForStream -> Maybe Text
$sel:limit:ListTagsForStream' :: ListTagsForStream -> Maybe Natural
$sel:exclusiveStartTagKey:ListTagsForStream' :: ListTagsForStream -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ExclusiveStartTagKey" 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
exclusiveStartTagKey,
            (Key
"Limit" 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
limit,
            (Key
"StreamARN" 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
streamARN,
            (Key
"StreamName" 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
streamName
          ]
      )

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

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

-- | Represents the output for @ListTagsForStream@.
--
-- /See:/ 'newListTagsForStreamResponse' smart constructor.
data ListTagsForStreamResponse = ListTagsForStreamResponse'
  { -- | The response's http status code.
    ListTagsForStreamResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of tags associated with @StreamName@, starting with the first tag
    -- after @ExclusiveStartTagKey@ and up to the specified @Limit@.
    ListTagsForStreamResponse -> [Tag]
tags :: [Tag],
    -- | If set to @true@, more tags are available. To request additional tags,
    -- set @ExclusiveStartTagKey@ to the key of the last tag returned.
    ListTagsForStreamResponse -> Bool
hasMoreTags :: Prelude.Bool
  }
  deriving (ListTagsForStreamResponse -> ListTagsForStreamResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTagsForStreamResponse -> ListTagsForStreamResponse -> Bool
$c/= :: ListTagsForStreamResponse -> ListTagsForStreamResponse -> Bool
== :: ListTagsForStreamResponse -> ListTagsForStreamResponse -> Bool
$c== :: ListTagsForStreamResponse -> ListTagsForStreamResponse -> Bool
Prelude.Eq, ReadPrec [ListTagsForStreamResponse]
ReadPrec ListTagsForStreamResponse
Int -> ReadS ListTagsForStreamResponse
ReadS [ListTagsForStreamResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTagsForStreamResponse]
$creadListPrec :: ReadPrec [ListTagsForStreamResponse]
readPrec :: ReadPrec ListTagsForStreamResponse
$creadPrec :: ReadPrec ListTagsForStreamResponse
readList :: ReadS [ListTagsForStreamResponse]
$creadList :: ReadS [ListTagsForStreamResponse]
readsPrec :: Int -> ReadS ListTagsForStreamResponse
$creadsPrec :: Int -> ReadS ListTagsForStreamResponse
Prelude.Read, Int -> ListTagsForStreamResponse -> ShowS
[ListTagsForStreamResponse] -> ShowS
ListTagsForStreamResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTagsForStreamResponse] -> ShowS
$cshowList :: [ListTagsForStreamResponse] -> ShowS
show :: ListTagsForStreamResponse -> String
$cshow :: ListTagsForStreamResponse -> String
showsPrec :: Int -> ListTagsForStreamResponse -> ShowS
$cshowsPrec :: Int -> ListTagsForStreamResponse -> ShowS
Prelude.Show, forall x.
Rep ListTagsForStreamResponse x -> ListTagsForStreamResponse
forall x.
ListTagsForStreamResponse -> Rep ListTagsForStreamResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListTagsForStreamResponse x -> ListTagsForStreamResponse
$cfrom :: forall x.
ListTagsForStreamResponse -> Rep ListTagsForStreamResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTagsForStreamResponse' 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:
--
-- 'httpStatus', 'listTagsForStreamResponse_httpStatus' - The response's http status code.
--
-- 'tags', 'listTagsForStreamResponse_tags' - A list of tags associated with @StreamName@, starting with the first tag
-- after @ExclusiveStartTagKey@ and up to the specified @Limit@.
--
-- 'hasMoreTags', 'listTagsForStreamResponse_hasMoreTags' - If set to @true@, more tags are available. To request additional tags,
-- set @ExclusiveStartTagKey@ to the key of the last tag returned.
newListTagsForStreamResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'hasMoreTags'
  Prelude.Bool ->
  ListTagsForStreamResponse
newListTagsForStreamResponse :: Int -> Bool -> ListTagsForStreamResponse
newListTagsForStreamResponse
  Int
pHttpStatus_
  Bool
pHasMoreTags_ =
    ListTagsForStreamResponse'
      { $sel:httpStatus:ListTagsForStreamResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:tags:ListTagsForStreamResponse' :: [Tag]
tags = forall a. Monoid a => a
Prelude.mempty,
        $sel:hasMoreTags:ListTagsForStreamResponse' :: Bool
hasMoreTags = Bool
pHasMoreTags_
      }

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

-- | A list of tags associated with @StreamName@, starting with the first tag
-- after @ExclusiveStartTagKey@ and up to the specified @Limit@.
listTagsForStreamResponse_tags :: Lens.Lens' ListTagsForStreamResponse [Tag]
listTagsForStreamResponse_tags :: Lens' ListTagsForStreamResponse [Tag]
listTagsForStreamResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForStreamResponse' {[Tag]
tags :: [Tag]
$sel:tags:ListTagsForStreamResponse' :: ListTagsForStreamResponse -> [Tag]
tags} -> [Tag]
tags) (\s :: ListTagsForStreamResponse
s@ListTagsForStreamResponse' {} [Tag]
a -> ListTagsForStreamResponse
s {$sel:tags:ListTagsForStreamResponse' :: [Tag]
tags = [Tag]
a} :: ListTagsForStreamResponse) 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

-- | If set to @true@, more tags are available. To request additional tags,
-- set @ExclusiveStartTagKey@ to the key of the last tag returned.
listTagsForStreamResponse_hasMoreTags :: Lens.Lens' ListTagsForStreamResponse Prelude.Bool
listTagsForStreamResponse_hasMoreTags :: Lens' ListTagsForStreamResponse Bool
listTagsForStreamResponse_hasMoreTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsForStreamResponse' {Bool
hasMoreTags :: Bool
$sel:hasMoreTags:ListTagsForStreamResponse' :: ListTagsForStreamResponse -> Bool
hasMoreTags} -> Bool
hasMoreTags) (\s :: ListTagsForStreamResponse
s@ListTagsForStreamResponse' {} Bool
a -> ListTagsForStreamResponse
s {$sel:hasMoreTags:ListTagsForStreamResponse' :: Bool
hasMoreTags = Bool
a} :: ListTagsForStreamResponse)

instance Prelude.NFData ListTagsForStreamResponse where
  rnf :: ListTagsForStreamResponse -> ()
rnf ListTagsForStreamResponse' {Bool
Int
[Tag]
hasMoreTags :: Bool
tags :: [Tag]
httpStatus :: Int
$sel:hasMoreTags:ListTagsForStreamResponse' :: ListTagsForStreamResponse -> Bool
$sel:tags:ListTagsForStreamResponse' :: ListTagsForStreamResponse -> [Tag]
$sel:httpStatus:ListTagsForStreamResponse' :: ListTagsForStreamResponse -> Int
..} =
    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 [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
hasMoreTags