{-# 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.StreamDescription
-- 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.StreamDescription 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.Shard
import Amazonka.Kinesis.Types.StreamModeDetails
import Amazonka.Kinesis.Types.StreamStatus
import qualified Amazonka.Prelude as Prelude

-- | Represents the output for DescribeStream.
--
-- /See:/ 'newStreamDescription' smart constructor.
data StreamDescription = StreamDescription'
  { -- | The server-side encryption type used on the stream. This parameter can
    -- be one of the following values:
    --
    -- -   @NONE@: Do not encrypt the records in the stream.
    --
    -- -   @KMS@: Use server-side encryption on the records in the stream using
    --     a customer-managed Amazon Web Services KMS key.
    StreamDescription -> 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@
    StreamDescription -> 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__ capacity mode and a __provisioned__ capacity mode for your
    -- data streams.
    StreamDescription -> Maybe StreamModeDetails
streamModeDetails :: Prelude.Maybe StreamModeDetails,
    -- | The name of the stream being described.
    StreamDescription -> Text
streamName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) for the stream being described.
    StreamDescription -> 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.
    StreamDescription -> StreamStatus
streamStatus :: StreamStatus,
    -- | The shards that comprise the stream.
    StreamDescription -> [Shard]
shards :: [Shard],
    -- | If set to @true@, more shards in the stream are available to describe.
    StreamDescription -> Bool
hasMoreShards :: Prelude.Bool,
    -- | The current retention period, in hours. Minimum value of 24. Maximum
    -- value of 168.
    StreamDescription -> Int
retentionPeriodHours :: Prelude.Int,
    -- | The approximate time that the stream was created.
    StreamDescription -> POSIX
streamCreationTimestamp :: Data.POSIX,
    -- | Represents the current enhanced monitoring settings of the stream.
    StreamDescription -> [EnhancedMetrics]
enhancedMonitoring :: [EnhancedMetrics]
  }
  deriving (StreamDescription -> StreamDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamDescription -> StreamDescription -> Bool
$c/= :: StreamDescription -> StreamDescription -> Bool
== :: StreamDescription -> StreamDescription -> Bool
$c== :: StreamDescription -> StreamDescription -> Bool
Prelude.Eq, ReadPrec [StreamDescription]
ReadPrec StreamDescription
Int -> ReadS StreamDescription
ReadS [StreamDescription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StreamDescription]
$creadListPrec :: ReadPrec [StreamDescription]
readPrec :: ReadPrec StreamDescription
$creadPrec :: ReadPrec StreamDescription
readList :: ReadS [StreamDescription]
$creadList :: ReadS [StreamDescription]
readsPrec :: Int -> ReadS StreamDescription
$creadsPrec :: Int -> ReadS StreamDescription
Prelude.Read, Int -> StreamDescription -> ShowS
[StreamDescription] -> ShowS
StreamDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamDescription] -> ShowS
$cshowList :: [StreamDescription] -> ShowS
show :: StreamDescription -> String
$cshow :: StreamDescription -> String
showsPrec :: Int -> StreamDescription -> ShowS
$cshowsPrec :: Int -> StreamDescription -> ShowS
Prelude.Show, forall x. Rep StreamDescription x -> StreamDescription
forall x. StreamDescription -> Rep StreamDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StreamDescription x -> StreamDescription
$cfrom :: forall x. StreamDescription -> Rep StreamDescription x
Prelude.Generic)

-- |
-- Create a value of 'StreamDescription' 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:
--
-- 'encryptionType', 'streamDescription_encryptionType' - The server-side encryption type used on the stream. This parameter can
-- be one of the following values:
--
-- -   @NONE@: Do not encrypt the records in the stream.
--
-- -   @KMS@: Use server-side encryption on the records in the stream using
--     a customer-managed Amazon Web Services KMS key.
--
-- 'keyId', 'streamDescription_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', 'streamDescription_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__ capacity mode and a __provisioned__ capacity mode for your
-- data streams.
--
-- 'streamName', 'streamDescription_streamName' - The name of the stream being described.
--
-- 'streamARN', 'streamDescription_streamARN' - The Amazon Resource Name (ARN) for the stream being described.
--
-- 'streamStatus', 'streamDescription_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.
--
-- 'shards', 'streamDescription_shards' - The shards that comprise the stream.
--
-- 'hasMoreShards', 'streamDescription_hasMoreShards' - If set to @true@, more shards in the stream are available to describe.
--
-- 'retentionPeriodHours', 'streamDescription_retentionPeriodHours' - The current retention period, in hours. Minimum value of 24. Maximum
-- value of 168.
--
-- 'streamCreationTimestamp', 'streamDescription_streamCreationTimestamp' - The approximate time that the stream was created.
--
-- 'enhancedMonitoring', 'streamDescription_enhancedMonitoring' - Represents the current enhanced monitoring settings of the stream.
newStreamDescription ::
  -- | 'streamName'
  Prelude.Text ->
  -- | 'streamARN'
  Prelude.Text ->
  -- | 'streamStatus'
  StreamStatus ->
  -- | 'hasMoreShards'
  Prelude.Bool ->
  -- | 'retentionPeriodHours'
  Prelude.Int ->
  -- | 'streamCreationTimestamp'
  Prelude.UTCTime ->
  StreamDescription
newStreamDescription :: Text
-> Text
-> StreamStatus
-> Bool
-> Int
-> UTCTime
-> StreamDescription
newStreamDescription
  Text
pStreamName_
  Text
pStreamARN_
  StreamStatus
pStreamStatus_
  Bool
pHasMoreShards_
  Int
pRetentionPeriodHours_
  UTCTime
pStreamCreationTimestamp_ =
    StreamDescription'
      { $sel:encryptionType:StreamDescription' :: Maybe EncryptionType
encryptionType =
          forall a. Maybe a
Prelude.Nothing,
        $sel:keyId:StreamDescription' :: Maybe Text
keyId = forall a. Maybe a
Prelude.Nothing,
        $sel:streamModeDetails:StreamDescription' :: Maybe StreamModeDetails
streamModeDetails = forall a. Maybe a
Prelude.Nothing,
        $sel:streamName:StreamDescription' :: Text
streamName = Text
pStreamName_,
        $sel:streamARN:StreamDescription' :: Text
streamARN = Text
pStreamARN_,
        $sel:streamStatus:StreamDescription' :: StreamStatus
streamStatus = StreamStatus
pStreamStatus_,
        $sel:shards:StreamDescription' :: [Shard]
shards = forall a. Monoid a => a
Prelude.mempty,
        $sel:hasMoreShards:StreamDescription' :: Bool
hasMoreShards = Bool
pHasMoreShards_,
        $sel:retentionPeriodHours:StreamDescription' :: Int
retentionPeriodHours = Int
pRetentionPeriodHours_,
        $sel:streamCreationTimestamp:StreamDescription' :: POSIX
streamCreationTimestamp =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStreamCreationTimestamp_,
        $sel:enhancedMonitoring:StreamDescription' :: [EnhancedMetrics]
enhancedMonitoring = forall a. Monoid a => a
Prelude.mempty
      }

-- | The server-side encryption type used on the stream. This parameter can
-- be one of the following values:
--
-- -   @NONE@: Do not encrypt the records in the stream.
--
-- -   @KMS@: Use server-side encryption on the records in the stream using
--     a customer-managed Amazon Web Services KMS key.
streamDescription_encryptionType :: Lens.Lens' StreamDescription (Prelude.Maybe EncryptionType)
streamDescription_encryptionType :: Lens' StreamDescription (Maybe EncryptionType)
streamDescription_encryptionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescription' {Maybe EncryptionType
encryptionType :: Maybe EncryptionType
$sel:encryptionType:StreamDescription' :: StreamDescription -> Maybe EncryptionType
encryptionType} -> Maybe EncryptionType
encryptionType) (\s :: StreamDescription
s@StreamDescription' {} Maybe EncryptionType
a -> StreamDescription
s {$sel:encryptionType:StreamDescription' :: Maybe EncryptionType
encryptionType = Maybe EncryptionType
a} :: StreamDescription)

-- | 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@
streamDescription_keyId :: Lens.Lens' StreamDescription (Prelude.Maybe Prelude.Text)
streamDescription_keyId :: Lens' StreamDescription (Maybe Text)
streamDescription_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescription' {Maybe Text
keyId :: Maybe Text
$sel:keyId:StreamDescription' :: StreamDescription -> Maybe Text
keyId} -> Maybe Text
keyId) (\s :: StreamDescription
s@StreamDescription' {} Maybe Text
a -> StreamDescription
s {$sel:keyId:StreamDescription' :: Maybe Text
keyId = Maybe Text
a} :: StreamDescription)

-- | 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__ capacity mode and a __provisioned__ capacity mode for your
-- data streams.
streamDescription_streamModeDetails :: Lens.Lens' StreamDescription (Prelude.Maybe StreamModeDetails)
streamDescription_streamModeDetails :: Lens' StreamDescription (Maybe StreamModeDetails)
streamDescription_streamModeDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescription' {Maybe StreamModeDetails
streamModeDetails :: Maybe StreamModeDetails
$sel:streamModeDetails:StreamDescription' :: StreamDescription -> Maybe StreamModeDetails
streamModeDetails} -> Maybe StreamModeDetails
streamModeDetails) (\s :: StreamDescription
s@StreamDescription' {} Maybe StreamModeDetails
a -> StreamDescription
s {$sel:streamModeDetails:StreamDescription' :: Maybe StreamModeDetails
streamModeDetails = Maybe StreamModeDetails
a} :: StreamDescription)

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

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

-- | 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.
streamDescription_streamStatus :: Lens.Lens' StreamDescription StreamStatus
streamDescription_streamStatus :: Lens' StreamDescription StreamStatus
streamDescription_streamStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescription' {StreamStatus
streamStatus :: StreamStatus
$sel:streamStatus:StreamDescription' :: StreamDescription -> StreamStatus
streamStatus} -> StreamStatus
streamStatus) (\s :: StreamDescription
s@StreamDescription' {} StreamStatus
a -> StreamDescription
s {$sel:streamStatus:StreamDescription' :: StreamStatus
streamStatus = StreamStatus
a} :: StreamDescription)

-- | The shards that comprise the stream.
streamDescription_shards :: Lens.Lens' StreamDescription [Shard]
streamDescription_shards :: Lens' StreamDescription [Shard]
streamDescription_shards = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescription' {[Shard]
shards :: [Shard]
$sel:shards:StreamDescription' :: StreamDescription -> [Shard]
shards} -> [Shard]
shards) (\s :: StreamDescription
s@StreamDescription' {} [Shard]
a -> StreamDescription
s {$sel:shards:StreamDescription' :: [Shard]
shards = [Shard]
a} :: StreamDescription) 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 shards in the stream are available to describe.
streamDescription_hasMoreShards :: Lens.Lens' StreamDescription Prelude.Bool
streamDescription_hasMoreShards :: Lens' StreamDescription Bool
streamDescription_hasMoreShards = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescription' {Bool
hasMoreShards :: Bool
$sel:hasMoreShards:StreamDescription' :: StreamDescription -> Bool
hasMoreShards} -> Bool
hasMoreShards) (\s :: StreamDescription
s@StreamDescription' {} Bool
a -> StreamDescription
s {$sel:hasMoreShards:StreamDescription' :: Bool
hasMoreShards = Bool
a} :: StreamDescription)

-- | The current retention period, in hours. Minimum value of 24. Maximum
-- value of 168.
streamDescription_retentionPeriodHours :: Lens.Lens' StreamDescription Prelude.Int
streamDescription_retentionPeriodHours :: Lens' StreamDescription Int
streamDescription_retentionPeriodHours = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescription' {Int
retentionPeriodHours :: Int
$sel:retentionPeriodHours:StreamDescription' :: StreamDescription -> Int
retentionPeriodHours} -> Int
retentionPeriodHours) (\s :: StreamDescription
s@StreamDescription' {} Int
a -> StreamDescription
s {$sel:retentionPeriodHours:StreamDescription' :: Int
retentionPeriodHours = Int
a} :: StreamDescription)

-- | The approximate time that the stream was created.
streamDescription_streamCreationTimestamp :: Lens.Lens' StreamDescription Prelude.UTCTime
streamDescription_streamCreationTimestamp :: Lens' StreamDescription UTCTime
streamDescription_streamCreationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescription' {POSIX
streamCreationTimestamp :: POSIX
$sel:streamCreationTimestamp:StreamDescription' :: StreamDescription -> POSIX
streamCreationTimestamp} -> POSIX
streamCreationTimestamp) (\s :: StreamDescription
s@StreamDescription' {} POSIX
a -> StreamDescription
s {$sel:streamCreationTimestamp:StreamDescription' :: POSIX
streamCreationTimestamp = POSIX
a} :: StreamDescription) 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.
streamDescription_enhancedMonitoring :: Lens.Lens' StreamDescription [EnhancedMetrics]
streamDescription_enhancedMonitoring :: Lens' StreamDescription [EnhancedMetrics]
streamDescription_enhancedMonitoring = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StreamDescription' {[EnhancedMetrics]
enhancedMonitoring :: [EnhancedMetrics]
$sel:enhancedMonitoring:StreamDescription' :: StreamDescription -> [EnhancedMetrics]
enhancedMonitoring} -> [EnhancedMetrics]
enhancedMonitoring) (\s :: StreamDescription
s@StreamDescription' {} [EnhancedMetrics]
a -> StreamDescription
s {$sel:enhancedMonitoring:StreamDescription' :: [EnhancedMetrics]
enhancedMonitoring = [EnhancedMetrics]
a} :: StreamDescription) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Data.FromJSON StreamDescription where
  parseJSON :: Value -> Parser StreamDescription
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"StreamDescription"
      ( \Object
x ->
          Maybe EncryptionType
-> Maybe Text
-> Maybe StreamModeDetails
-> Text
-> Text
-> StreamStatus
-> [Shard]
-> Bool
-> Int
-> POSIX
-> [EnhancedMetrics]
-> StreamDescription
StreamDescription'
            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
"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 (Maybe a)
Data..:? Key
"Shards" 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
"HasMoreShards")
            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
                        )
      )

instance Prelude.Hashable StreamDescription where
  hashWithSalt :: Int -> StreamDescription -> Int
hashWithSalt Int
_salt StreamDescription' {Bool
Int
[EnhancedMetrics]
[Shard]
Maybe Text
Maybe EncryptionType
Maybe StreamModeDetails
Text
POSIX
StreamStatus
enhancedMonitoring :: [EnhancedMetrics]
streamCreationTimestamp :: POSIX
retentionPeriodHours :: Int
hasMoreShards :: Bool
shards :: [Shard]
streamStatus :: StreamStatus
streamARN :: Text
streamName :: Text
streamModeDetails :: Maybe StreamModeDetails
keyId :: Maybe Text
encryptionType :: Maybe EncryptionType
$sel:enhancedMonitoring:StreamDescription' :: StreamDescription -> [EnhancedMetrics]
$sel:streamCreationTimestamp:StreamDescription' :: StreamDescription -> POSIX
$sel:retentionPeriodHours:StreamDescription' :: StreamDescription -> Int
$sel:hasMoreShards:StreamDescription' :: StreamDescription -> Bool
$sel:shards:StreamDescription' :: StreamDescription -> [Shard]
$sel:streamStatus:StreamDescription' :: StreamDescription -> StreamStatus
$sel:streamARN:StreamDescription' :: StreamDescription -> Text
$sel:streamName:StreamDescription' :: StreamDescription -> Text
$sel:streamModeDetails:StreamDescription' :: StreamDescription -> Maybe StreamModeDetails
$sel:keyId:StreamDescription' :: StreamDescription -> Maybe Text
$sel:encryptionType:StreamDescription' :: StreamDescription -> Maybe EncryptionType
..} =
    Int
_salt
      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` [Shard]
shards
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
hasMoreShards
      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

instance Prelude.NFData StreamDescription where
  rnf :: StreamDescription -> ()
rnf StreamDescription' {Bool
Int
[EnhancedMetrics]
[Shard]
Maybe Text
Maybe EncryptionType
Maybe StreamModeDetails
Text
POSIX
StreamStatus
enhancedMonitoring :: [EnhancedMetrics]
streamCreationTimestamp :: POSIX
retentionPeriodHours :: Int
hasMoreShards :: Bool
shards :: [Shard]
streamStatus :: StreamStatus
streamARN :: Text
streamName :: Text
streamModeDetails :: Maybe StreamModeDetails
keyId :: Maybe Text
encryptionType :: Maybe EncryptionType
$sel:enhancedMonitoring:StreamDescription' :: StreamDescription -> [EnhancedMetrics]
$sel:streamCreationTimestamp:StreamDescription' :: StreamDescription -> POSIX
$sel:retentionPeriodHours:StreamDescription' :: StreamDescription -> Int
$sel:hasMoreShards:StreamDescription' :: StreamDescription -> Bool
$sel:shards:StreamDescription' :: StreamDescription -> [Shard]
$sel:streamStatus:StreamDescription' :: StreamDescription -> StreamStatus
$sel:streamARN:StreamDescription' :: StreamDescription -> Text
$sel:streamName:StreamDescription' :: StreamDescription -> Text
$sel:streamModeDetails:StreamDescription' :: StreamDescription -> Maybe StreamModeDetails
$sel:keyId:StreamDescription' :: StreamDescription -> Maybe Text
$sel:encryptionType:StreamDescription' :: StreamDescription -> Maybe EncryptionType
..} =
    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 [Shard]
shards
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
hasMoreShards
      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