{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.StreamDescriptionSummary
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Kinesis.Types.StreamDescriptionSummary 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.EncryptionType
import Amazonka.Kinesis.Types.EnhancedMetrics
import Amazonka.Kinesis.Types.StreamModeDetails
import Amazonka.Kinesis.Types.StreamStatus
import qualified Amazonka.Prelude as Prelude

-- | Represents the output for DescribeStreamSummary
--
-- /See:/ 'newStreamDescriptionSummary' smart constructor.
data StreamDescriptionSummary = StreamDescriptionSummary'
  { -- | The number of enhanced fan-out consumers registered with the stream.
    StreamDescriptionSummary -> Maybe Natural
consumerCount :: Prelude.Maybe Prelude.Natural,
    -- | The encryption type used. This value is one of the following:
    --
    -- -   @KMS@
    --
    -- -   @NONE@
    StreamDescriptionSummary -> Maybe EncryptionType
encryptionType :: Prelude.Maybe EncryptionType,
    -- | The GUID for the customer-managed Amazon Web Services KMS key to use for
    -- encryption. This value can be a globally unique identifier, a fully
    -- specified ARN to either an alias or a key, or an alias name prefixed by
    -- \"alias\/\".You can also use a master key owned by Kinesis Data Streams
    -- by specifying the alias @aws\/kinesis@.
    --
    -- -   Key ARN example:
    --     @arn:aws:kms:us-east-1:123456789012:key\/12345678-1234-1234-1234-123456789012@
    --
    -- -   Alias ARN example:
    --     @ arn:aws:kms:us-east-1:123456789012:alias\/MyAliasName@
    --
    -- -   Globally unique key ID example:
    --     @12345678-1234-1234-1234-123456789012@
    --
    -- -   Alias name example: @alias\/MyAliasName@
    --
    -- -   Master key owned by Kinesis Data Streams: @alias\/aws\/kinesis@
    StreamDescriptionSummary -> Maybe Text
keyId :: Prelude.Maybe Prelude.Text,
    -- | Specifies the capacity mode to which you want to set your data stream.
    -- Currently, in Kinesis Data Streams, you can choose between an
    -- __on-demand__ ycapacity mode and a __provisioned__ capacity mode for
    -- your data streams.
    StreamDescriptionSummary -> Maybe StreamModeDetails
streamModeDetails :: Prelude.Maybe StreamModeDetails,
    -- | The name of the stream being described.
    StreamDescriptionSummary -> Text
streamName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) for the stream being described.
    StreamDescriptionSummary -> Text
streamARN :: Prelude.Text,
    -- | The current status of the stream being described. The stream status is
    -- one of the following states:
    --
    -- -   @CREATING@ - The stream is being created. Kinesis Data Streams
    --     immediately returns and sets @StreamStatus@ to @CREATING@.
    --
    -- -   @DELETING@ - The stream is being deleted. The specified stream is in
    --     the @DELETING@ state until Kinesis Data Streams completes the
    --     deletion.
    --
    -- -   @ACTIVE@ - The stream exists and is ready for read and write
    --     operations or deletion. You should perform read and write operations
    --     only on an @ACTIVE@ stream.
    --
    -- -   @UPDATING@ - Shards in the stream are being merged or split. Read
    --     and write operations continue to work while the stream is in the
    --     @UPDATING@ state.
    StreamDescriptionSummary -> StreamStatus
streamStatus :: StreamStatus,
    -- | The current retention period, in hours.
    StreamDescriptionSummary -> Int
retentionPeriodHours :: Prelude.Int,
    -- | The approximate time that the stream was created.
    StreamDescriptionSummary -> POSIX
streamCreationTimestamp :: Data.POSIX,
    -- | Represents the current enhanced monitoring settings of the stream.
    StreamDescriptionSummary -> [EnhancedMetrics]
enhancedMonitoring :: [EnhancedMetrics],
    -- | The number of open shards in the stream.
    StreamDescriptionSummary -> Natural
openShardCount :: Prelude.Natural
  }
  deriving (StreamDescriptionSummary -> StreamDescriptionSummary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamDescriptionSummary -> StreamDescriptionSummary -> Bool
$c/= :: StreamDescriptionSummary -> StreamDescriptionSummary -> Bool
== :: StreamDescriptionSummary -> StreamDescriptionSummary -> Bool
$c== :: StreamDescriptionSummary -> StreamDescriptionSummary -> Bool
Prelude.Eq, ReadPrec [StreamDescriptionSummary]
ReadPrec StreamDescriptionSummary
Int -> ReadS StreamDescriptionSummary
ReadS [StreamDescriptionSummary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StreamDescriptionSummary]
$creadListPrec :: ReadPrec [StreamDescriptionSummary]
readPrec :: ReadPrec StreamDescriptionSummary
$creadPrec :: ReadPrec StreamDescriptionSummary
readList :: ReadS [StreamDescriptionSummary]
$creadList :: ReadS [StreamDescriptionSummary]
readsPrec :: Int -> ReadS StreamDescriptionSummary
$creadsPrec :: Int -> ReadS StreamDescriptionSummary
Prelude.Read, Int -> StreamDescriptionSummary -> ShowS
[StreamDescriptionSummary] -> ShowS
StreamDescriptionSummary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamDescriptionSummary] -> ShowS
$cshowList :: [StreamDescriptionSummary] -> ShowS
show :: StreamDescriptionSummary -> String
$cshow :: StreamDescriptionSummary -> String
showsPrec :: Int -> StreamDescriptionSummary -> ShowS
$cshowsPrec :: Int -> StreamDescriptionSummary -> ShowS
Prelude.Show, forall x.
Rep StreamDescriptionSummary x -> StreamDescriptionSummary
forall x.
StreamDescriptionSummary -> Rep StreamDescriptionSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StreamDescriptionSummary x -> StreamDescriptionSummary
$cfrom :: forall x.
StreamDescriptionSummary -> Rep StreamDescriptionSummary x
Prelude.Generic)

-- |
-- Create a value of 'StreamDescriptionSummary' 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:
--
-- 'consumerCount', 'streamDescriptionSummary_consumerCount' - The number of enhanced fan-out consumers registered with the stream.
--
-- 'encryptionType', 'streamDescriptionSummary_encryptionType' - The encryption type used. This value is one of the following:
--
-- -   @KMS@
--
-- -   @NONE@
--
-- 'keyId', 'streamDescriptionSummary_keyId' - The GUID for the customer-managed Amazon Web Services KMS key to use for
-- encryption. This value can be a globally unique identifier, a fully
-- specified ARN to either an alias or a key, or an alias name prefixed by
-- \"alias\/\".You can also use a master key owned by Kinesis Data Streams
-- by specifying the alias @aws\/kinesis@.
--
-- -   Key ARN example:
--     @arn:aws:kms:us-east-1:123456789012:key\/12345678-1234-1234-1234-123456789012@
--
-- -   Alias ARN example:
--     @ arn:aws:kms:us-east-1:123456789012:alias\/MyAliasName@
--
-- -   Globally unique key ID example:
--     @12345678-1234-1234-1234-123456789012@
--
-- -   Alias name example: @alias\/MyAliasName@
--
-- -   Master key owned by Kinesis Data Streams: @alias\/aws\/kinesis@
--
-- 'streamModeDetails', 'streamDescriptionSummary_streamModeDetails' - Specifies the capacity mode to which you want to set your data stream.
-- Currently, in Kinesis Data Streams, you can choose between an
-- __on-demand__ ycapacity mode and a __provisioned__ capacity mode for
-- your data streams.
--
-- 'streamName', 'streamDescriptionSummary_streamName' - The name of the stream being described.
--
-- 'streamARN', 'streamDescriptionSummary_streamARN' - The Amazon Resource Name (ARN) for the stream being described.
--
-- 'streamStatus', 'streamDescriptionSummary_streamStatus' - The current status of the stream being described. The stream status is
-- one of the following states:
--
-- -   @CREATING@ - The stream is being created. Kinesis Data Streams
--     immediately returns and sets @StreamStatus@ to @CREATING@.
--
-- -   @DELETING@ - The stream is being deleted. The specified stream is in
--     the @DELETING@ state until Kinesis Data Streams completes the
--     deletion.
--
-- -   @ACTIVE@ - The stream exists and is ready for read and write
--     operations or deletion. You should perform read and write operations
--     only on an @ACTIVE@ stream.
--
-- -   @UPDATING@ - Shards in the stream are being merged or split. Read
--     and write operations continue to work while the stream is in the
--     @UPDATING@ state.
--
-- 'retentionPeriodHours', 'streamDescriptionSummary_retentionPeriodHours' - The current retention period, in hours.
--
-- 'streamCreationTimestamp', 'streamDescriptionSummary_streamCreationTimestamp' - The approximate time that the stream was created.
--
-- 'enhancedMonitoring', 'streamDescriptionSummary_enhancedMonitoring' - Represents the current enhanced monitoring settings of the stream.
--
-- 'openShardCount', 'streamDescriptionSummary_openShardCount' - The number of open shards in the stream.
newStreamDescriptionSummary ::
  -- | 'streamName'
  Prelude.Text ->
  -- | 'streamARN'
  Prelude.Text ->
  -- | 'streamStatus'
  StreamStatus ->
  -- | 'retentionPeriodHours'
  Prelude.Int ->
  -- | 'streamCreationTimestamp'
  Prelude.UTCTime ->
  -- | 'openShardCount'
  Prelude.Natural ->
  StreamDescriptionSummary
newStreamDescriptionSummary :: Text
-> Text
-> StreamStatus
-> Int
-> UTCTime
-> Natural
-> StreamDescriptionSummary
newStreamDescriptionSummary
  Text
pStreamName_
  Text
pStreamARN_
  StreamStatus
pStreamStatus_
  Int
pRetentionPeriodHours_
  UTCTime
pStreamCreationTimestamp_
  Natural
pOpenShardCount_ =
    StreamDescriptionSummary'
      { $sel:consumerCount:StreamDescriptionSummary' :: Maybe Natural
consumerCount =
          forall a. Maybe a
Prelude.Nothing,
        $sel:encryptionType:StreamDescriptionSummary' :: Maybe EncryptionType
encryptionType = forall a. Maybe a
Prelude.Nothing,
        $sel:keyId:StreamDescriptionSummary' :: Maybe Text
keyId = forall a. Maybe a
Prelude.Nothing,
        $sel:streamModeDetails:StreamDescriptionSummary' :: Maybe StreamModeDetails
streamModeDetails = forall a. Maybe a
Prelude.Nothing,
        $sel:streamName:StreamDescriptionSummary' :: Text
streamName = Text
pStreamName_,
        $sel:streamARN:StreamDescriptionSummary' :: Text
streamARN = Text
pStreamARN_,
        $sel:streamStatus:StreamDescriptionSummary' :: StreamStatus
streamStatus = StreamStatus
pStreamStatus_,
        $sel:retentionPeriodHours:StreamDescriptionSummary' :: Int
retentionPeriodHours = Int
pRetentionPeriodHours_,
        $sel:streamCreationTimestamp:StreamDescriptionSummary' :: POSIX
streamCreationTimestamp =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStreamCreationTimestamp_,
        $sel:enhancedMonitoring:StreamDescriptionSummary' :: [EnhancedMetrics]
enhancedMonitoring = forall a. Monoid a => a
Prelude.mempty,
        $sel:openShardCount:StreamDescriptionSummary' :: Natural
openShardCount = Natural
pOpenShardCount_
      }

-- | The number of enhanced fan-out consumers registered with the stream.
streamDescriptionSummary_consumerCount :: Lens.Lens' StreamDescriptionSummary (Prelude.Maybe Prelude.Natural)
streamDescriptionSummary_consumerCount :: Lens' StreamDescriptionSummary (Maybe Natural)
streamDescriptionSummary_consumerCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescriptionSummary' {Maybe Natural
consumerCount :: Maybe Natural
$sel:consumerCount:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe Natural
consumerCount} -> Maybe Natural
consumerCount) (\s :: StreamDescriptionSummary
s@StreamDescriptionSummary' {} Maybe Natural
a -> StreamDescriptionSummary
s {$sel:consumerCount:StreamDescriptionSummary' :: Maybe Natural
consumerCount = Maybe Natural
a} :: StreamDescriptionSummary)

-- | The encryption type used. This value is one of the following:
--
-- -   @KMS@
--
-- -   @NONE@
streamDescriptionSummary_encryptionType :: Lens.Lens' StreamDescriptionSummary (Prelude.Maybe EncryptionType)
streamDescriptionSummary_encryptionType :: Lens' StreamDescriptionSummary (Maybe EncryptionType)
streamDescriptionSummary_encryptionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescriptionSummary' {Maybe EncryptionType
encryptionType :: Maybe EncryptionType
$sel:encryptionType:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe EncryptionType
encryptionType} -> Maybe EncryptionType
encryptionType) (\s :: StreamDescriptionSummary
s@StreamDescriptionSummary' {} Maybe EncryptionType
a -> StreamDescriptionSummary
s {$sel:encryptionType:StreamDescriptionSummary' :: Maybe EncryptionType
encryptionType = Maybe EncryptionType
a} :: StreamDescriptionSummary)

-- | The GUID for the customer-managed Amazon Web Services KMS key to use for
-- encryption. This value can be a globally unique identifier, a fully
-- specified ARN to either an alias or a key, or an alias name prefixed by
-- \"alias\/\".You can also use a master key owned by Kinesis Data Streams
-- by specifying the alias @aws\/kinesis@.
--
-- -   Key ARN example:
--     @arn:aws:kms:us-east-1:123456789012:key\/12345678-1234-1234-1234-123456789012@
--
-- -   Alias ARN example:
--     @ arn:aws:kms:us-east-1:123456789012:alias\/MyAliasName@
--
-- -   Globally unique key ID example:
--     @12345678-1234-1234-1234-123456789012@
--
-- -   Alias name example: @alias\/MyAliasName@
--
-- -   Master key owned by Kinesis Data Streams: @alias\/aws\/kinesis@
streamDescriptionSummary_keyId :: Lens.Lens' StreamDescriptionSummary (Prelude.Maybe Prelude.Text)
streamDescriptionSummary_keyId :: Lens' StreamDescriptionSummary (Maybe Text)
streamDescriptionSummary_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescriptionSummary' {Maybe Text
keyId :: Maybe Text
$sel:keyId:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe Text
keyId} -> Maybe Text
keyId) (\s :: StreamDescriptionSummary
s@StreamDescriptionSummary' {} Maybe Text
a -> StreamDescriptionSummary
s {$sel:keyId:StreamDescriptionSummary' :: Maybe Text
keyId = Maybe Text
a} :: StreamDescriptionSummary)

-- | Specifies the capacity mode to which you want to set your data stream.
-- Currently, in Kinesis Data Streams, you can choose between an
-- __on-demand__ ycapacity mode and a __provisioned__ capacity mode for
-- your data streams.
streamDescriptionSummary_streamModeDetails :: Lens.Lens' StreamDescriptionSummary (Prelude.Maybe StreamModeDetails)
streamDescriptionSummary_streamModeDetails :: Lens' StreamDescriptionSummary (Maybe StreamModeDetails)
streamDescriptionSummary_streamModeDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescriptionSummary' {Maybe StreamModeDetails
streamModeDetails :: Maybe StreamModeDetails
$sel:streamModeDetails:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe StreamModeDetails
streamModeDetails} -> Maybe StreamModeDetails
streamModeDetails) (\s :: StreamDescriptionSummary
s@StreamDescriptionSummary' {} Maybe StreamModeDetails
a -> StreamDescriptionSummary
s {$sel:streamModeDetails:StreamDescriptionSummary' :: Maybe StreamModeDetails
streamModeDetails = Maybe StreamModeDetails
a} :: StreamDescriptionSummary)

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

-- | The Amazon Resource Name (ARN) for the stream being described.
streamDescriptionSummary_streamARN :: Lens.Lens' StreamDescriptionSummary Prelude.Text
streamDescriptionSummary_streamARN :: Lens' StreamDescriptionSummary Text
streamDescriptionSummary_streamARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescriptionSummary' {Text
streamARN :: Text
$sel:streamARN:StreamDescriptionSummary' :: StreamDescriptionSummary -> Text
streamARN} -> Text
streamARN) (\s :: StreamDescriptionSummary
s@StreamDescriptionSummary' {} Text
a -> StreamDescriptionSummary
s {$sel:streamARN:StreamDescriptionSummary' :: Text
streamARN = Text
a} :: StreamDescriptionSummary)

-- | The current status of the stream being described. The stream status is
-- one of the following states:
--
-- -   @CREATING@ - The stream is being created. Kinesis Data Streams
--     immediately returns and sets @StreamStatus@ to @CREATING@.
--
-- -   @DELETING@ - The stream is being deleted. The specified stream is in
--     the @DELETING@ state until Kinesis Data Streams completes the
--     deletion.
--
-- -   @ACTIVE@ - The stream exists and is ready for read and write
--     operations or deletion. You should perform read and write operations
--     only on an @ACTIVE@ stream.
--
-- -   @UPDATING@ - Shards in the stream are being merged or split. Read
--     and write operations continue to work while the stream is in the
--     @UPDATING@ state.
streamDescriptionSummary_streamStatus :: Lens.Lens' StreamDescriptionSummary StreamStatus
streamDescriptionSummary_streamStatus :: Lens' StreamDescriptionSummary StreamStatus
streamDescriptionSummary_streamStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescriptionSummary' {StreamStatus
streamStatus :: StreamStatus
$sel:streamStatus:StreamDescriptionSummary' :: StreamDescriptionSummary -> StreamStatus
streamStatus} -> StreamStatus
streamStatus) (\s :: StreamDescriptionSummary
s@StreamDescriptionSummary' {} StreamStatus
a -> StreamDescriptionSummary
s {$sel:streamStatus:StreamDescriptionSummary' :: StreamStatus
streamStatus = StreamStatus
a} :: StreamDescriptionSummary)

-- | The current retention period, in hours.
streamDescriptionSummary_retentionPeriodHours :: Lens.Lens' StreamDescriptionSummary Prelude.Int
streamDescriptionSummary_retentionPeriodHours :: Lens' StreamDescriptionSummary Int
streamDescriptionSummary_retentionPeriodHours = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescriptionSummary' {Int
retentionPeriodHours :: Int
$sel:retentionPeriodHours:StreamDescriptionSummary' :: StreamDescriptionSummary -> Int
retentionPeriodHours} -> Int
retentionPeriodHours) (\s :: StreamDescriptionSummary
s@StreamDescriptionSummary' {} Int
a -> StreamDescriptionSummary
s {$sel:retentionPeriodHours:StreamDescriptionSummary' :: Int
retentionPeriodHours = Int
a} :: StreamDescriptionSummary)

-- | The approximate time that the stream was created.
streamDescriptionSummary_streamCreationTimestamp :: Lens.Lens' StreamDescriptionSummary Prelude.UTCTime
streamDescriptionSummary_streamCreationTimestamp :: Lens' StreamDescriptionSummary UTCTime
streamDescriptionSummary_streamCreationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescriptionSummary' {POSIX
streamCreationTimestamp :: POSIX
$sel:streamCreationTimestamp:StreamDescriptionSummary' :: StreamDescriptionSummary -> POSIX
streamCreationTimestamp} -> POSIX
streamCreationTimestamp) (\s :: StreamDescriptionSummary
s@StreamDescriptionSummary' {} POSIX
a -> StreamDescriptionSummary
s {$sel:streamCreationTimestamp:StreamDescriptionSummary' :: POSIX
streamCreationTimestamp = POSIX
a} :: StreamDescriptionSummary) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Represents the current enhanced monitoring settings of the stream.
streamDescriptionSummary_enhancedMonitoring :: Lens.Lens' StreamDescriptionSummary [EnhancedMetrics]
streamDescriptionSummary_enhancedMonitoring :: Lens' StreamDescriptionSummary [EnhancedMetrics]
streamDescriptionSummary_enhancedMonitoring = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescriptionSummary' {[EnhancedMetrics]
enhancedMonitoring :: [EnhancedMetrics]
$sel:enhancedMonitoring:StreamDescriptionSummary' :: StreamDescriptionSummary -> [EnhancedMetrics]
enhancedMonitoring} -> [EnhancedMetrics]
enhancedMonitoring) (\s :: StreamDescriptionSummary
s@StreamDescriptionSummary' {} [EnhancedMetrics]
a -> StreamDescriptionSummary
s {$sel:enhancedMonitoring:StreamDescriptionSummary' :: [EnhancedMetrics]
enhancedMonitoring = [EnhancedMetrics]
a} :: StreamDescriptionSummary) 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

-- | The number of open shards in the stream.
streamDescriptionSummary_openShardCount :: Lens.Lens' StreamDescriptionSummary Prelude.Natural
streamDescriptionSummary_openShardCount :: Lens' StreamDescriptionSummary Natural
streamDescriptionSummary_openShardCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescriptionSummary' {Natural
openShardCount :: Natural
$sel:openShardCount:StreamDescriptionSummary' :: StreamDescriptionSummary -> Natural
openShardCount} -> Natural
openShardCount) (\s :: StreamDescriptionSummary
s@StreamDescriptionSummary' {} Natural
a -> StreamDescriptionSummary
s {$sel:openShardCount:StreamDescriptionSummary' :: Natural
openShardCount = Natural
a} :: StreamDescriptionSummary)

instance Data.FromJSON StreamDescriptionSummary where
  parseJSON :: Value -> Parser StreamDescriptionSummary
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"StreamDescriptionSummary"
      ( \Object
x ->
          Maybe Natural
-> Maybe EncryptionType
-> Maybe Text
-> Maybe StreamModeDetails
-> Text
-> Text
-> StreamStatus
-> Int
-> POSIX
-> [EnhancedMetrics]
-> Natural
-> StreamDescriptionSummary
StreamDescriptionSummary'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ConsumerCount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EncryptionType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"KeyId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"StreamModeDetails")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"StreamName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"StreamARN")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"StreamStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"RetentionPeriodHours")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"StreamCreationTimestamp")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EnhancedMonitoring"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser a
Data..: Key
"OpenShardCount")
      )

instance Prelude.Hashable StreamDescriptionSummary where
  hashWithSalt :: Int -> StreamDescriptionSummary -> Int
hashWithSalt Int
_salt StreamDescriptionSummary' {Int
Natural
[EnhancedMetrics]
Maybe Natural
Maybe Text
Maybe EncryptionType
Maybe StreamModeDetails
Text
POSIX
StreamStatus
openShardCount :: Natural
enhancedMonitoring :: [EnhancedMetrics]
streamCreationTimestamp :: POSIX
retentionPeriodHours :: Int
streamStatus :: StreamStatus
streamARN :: Text
streamName :: Text
streamModeDetails :: Maybe StreamModeDetails
keyId :: Maybe Text
encryptionType :: Maybe EncryptionType
consumerCount :: Maybe Natural
$sel:openShardCount:StreamDescriptionSummary' :: StreamDescriptionSummary -> Natural
$sel:enhancedMonitoring:StreamDescriptionSummary' :: StreamDescriptionSummary -> [EnhancedMetrics]
$sel:streamCreationTimestamp:StreamDescriptionSummary' :: StreamDescriptionSummary -> POSIX
$sel:retentionPeriodHours:StreamDescriptionSummary' :: StreamDescriptionSummary -> Int
$sel:streamStatus:StreamDescriptionSummary' :: StreamDescriptionSummary -> StreamStatus
$sel:streamARN:StreamDescriptionSummary' :: StreamDescriptionSummary -> Text
$sel:streamName:StreamDescriptionSummary' :: StreamDescriptionSummary -> Text
$sel:streamModeDetails:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe StreamModeDetails
$sel:keyId:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe Text
$sel:encryptionType:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe EncryptionType
$sel:consumerCount:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
consumerCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionType
encryptionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
keyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StreamModeDetails
streamModeDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
streamName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
streamARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StreamStatus
streamStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
retentionPeriodHours
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
streamCreationTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [EnhancedMetrics]
enhancedMonitoring
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
openShardCount

instance Prelude.NFData StreamDescriptionSummary where
  rnf :: StreamDescriptionSummary -> ()
rnf StreamDescriptionSummary' {Int
Natural
[EnhancedMetrics]
Maybe Natural
Maybe Text
Maybe EncryptionType
Maybe StreamModeDetails
Text
POSIX
StreamStatus
openShardCount :: Natural
enhancedMonitoring :: [EnhancedMetrics]
streamCreationTimestamp :: POSIX
retentionPeriodHours :: Int
streamStatus :: StreamStatus
streamARN :: Text
streamName :: Text
streamModeDetails :: Maybe StreamModeDetails
keyId :: Maybe Text
encryptionType :: Maybe EncryptionType
consumerCount :: Maybe Natural
$sel:openShardCount:StreamDescriptionSummary' :: StreamDescriptionSummary -> Natural
$sel:enhancedMonitoring:StreamDescriptionSummary' :: StreamDescriptionSummary -> [EnhancedMetrics]
$sel:streamCreationTimestamp:StreamDescriptionSummary' :: StreamDescriptionSummary -> POSIX
$sel:retentionPeriodHours:StreamDescriptionSummary' :: StreamDescriptionSummary -> Int
$sel:streamStatus:StreamDescriptionSummary' :: StreamDescriptionSummary -> StreamStatus
$sel:streamARN:StreamDescriptionSummary' :: StreamDescriptionSummary -> Text
$sel:streamName:StreamDescriptionSummary' :: StreamDescriptionSummary -> Text
$sel:streamModeDetails:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe StreamModeDetails
$sel:keyId:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe Text
$sel:encryptionType:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe EncryptionType
$sel:consumerCount:StreamDescriptionSummary' :: StreamDescriptionSummary -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
consumerCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionType
encryptionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamModeDetails
streamModeDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
streamName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
streamARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StreamStatus
streamStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
retentionPeriodHours
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
streamCreationTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [EnhancedMetrics]
enhancedMonitoring
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
openShardCount