{-# 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.KinesisVideo.CreateStream
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new Kinesis video stream.
--
-- When you create a new stream, Kinesis Video Streams assigns it a version
-- number. When you change the stream\'s metadata, Kinesis Video Streams
-- updates the version.
--
-- @CreateStream@ is an asynchronous operation.
--
-- For information about how the service works, see
-- <https://docs.aws.amazon.com/kinesisvideostreams/latest/dg/how-it-works.html How it Works>.
--
-- You must have permissions for the @KinesisVideo:CreateStream@ action.
module Amazonka.KinesisVideo.CreateStream
  ( -- * Creating a Request
    CreateStream (..),
    newCreateStream,

    -- * Request Lenses
    createStream_dataRetentionInHours,
    createStream_deviceName,
    createStream_kmsKeyId,
    createStream_mediaType,
    createStream_tags,
    createStream_streamName,

    -- * Destructuring the Response
    CreateStreamResponse (..),
    newCreateStreamResponse,

    -- * Response Lenses
    createStreamResponse_streamARN,
    createStreamResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateStream' smart constructor.
data CreateStream = CreateStream'
  { -- | The number of hours that you want to retain the data in the stream.
    -- Kinesis Video Streams retains the data in a data store that is
    -- associated with the stream.
    --
    -- The default value is 0, indicating that the stream does not persist
    -- data.
    --
    -- When the @DataRetentionInHours@ value is 0, consumers can still consume
    -- the fragments that remain in the service host buffer, which has a
    -- retention time limit of 5 minutes and a retention memory limit of 200
    -- MB. Fragments are removed from the buffer when either limit is reached.
    CreateStream -> Maybe Natural
dataRetentionInHours :: Prelude.Maybe Prelude.Natural,
    -- | The name of the device that is writing to the stream.
    --
    -- In the current implementation, Kinesis Video Streams does not use this
    -- name.
    CreateStream -> Maybe Text
deviceName :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Key Management Service (KMS) key that you want Kinesis
    -- Video Streams to use to encrypt stream data.
    --
    -- If no key ID is specified, the default, Kinesis Video-managed key
    -- (@aws\/kinesisvideo@) is used.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/kms/latest/APIReference/API_DescribeKey.html#API_DescribeKey_RequestParameters DescribeKey>.
    CreateStream -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The media type of the stream. Consumers of the stream can use this
    -- information when processing the stream. For more information about media
    -- types, see
    -- <http://www.iana.org/assignments/media-types/media-types.xhtml Media Types>.
    -- If you choose to specify the @MediaType@, see
    -- <https://tools.ietf.org/html/rfc6838#section-4.2 Naming Requirements>
    -- for guidelines.
    --
    -- Example valid values include \"video\/h264\" and
    -- \"video\/h264,audio\/aac\".
    --
    -- This parameter is optional; the default value is @null@ (or empty in
    -- JSON).
    CreateStream -> Maybe Text
mediaType :: Prelude.Maybe Prelude.Text,
    -- | A list of tags to associate with the specified stream. Each tag is a
    -- key-value pair (the value is optional).
    CreateStream -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A name for the stream that you are creating.
    --
    -- The stream name is an identifier for the stream, and must be unique for
    -- each account and region.
    CreateStream -> Text
streamName :: Prelude.Text
  }
  deriving (CreateStream -> CreateStream -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStream -> CreateStream -> Bool
$c/= :: CreateStream -> CreateStream -> Bool
== :: CreateStream -> CreateStream -> Bool
$c== :: CreateStream -> CreateStream -> Bool
Prelude.Eq, ReadPrec [CreateStream]
ReadPrec CreateStream
Int -> ReadS CreateStream
ReadS [CreateStream]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStream]
$creadListPrec :: ReadPrec [CreateStream]
readPrec :: ReadPrec CreateStream
$creadPrec :: ReadPrec CreateStream
readList :: ReadS [CreateStream]
$creadList :: ReadS [CreateStream]
readsPrec :: Int -> ReadS CreateStream
$creadsPrec :: Int -> ReadS CreateStream
Prelude.Read, Int -> CreateStream -> ShowS
[CreateStream] -> ShowS
CreateStream -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStream] -> ShowS
$cshowList :: [CreateStream] -> ShowS
show :: CreateStream -> String
$cshow :: CreateStream -> String
showsPrec :: Int -> CreateStream -> ShowS
$cshowsPrec :: Int -> CreateStream -> ShowS
Prelude.Show, forall x. Rep CreateStream x -> CreateStream
forall x. CreateStream -> Rep CreateStream x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStream x -> CreateStream
$cfrom :: forall x. CreateStream -> Rep CreateStream x
Prelude.Generic)

-- |
-- Create a value of 'CreateStream' 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:
--
-- 'dataRetentionInHours', 'createStream_dataRetentionInHours' - The number of hours that you want to retain the data in the stream.
-- Kinesis Video Streams retains the data in a data store that is
-- associated with the stream.
--
-- The default value is 0, indicating that the stream does not persist
-- data.
--
-- When the @DataRetentionInHours@ value is 0, consumers can still consume
-- the fragments that remain in the service host buffer, which has a
-- retention time limit of 5 minutes and a retention memory limit of 200
-- MB. Fragments are removed from the buffer when either limit is reached.
--
-- 'deviceName', 'createStream_deviceName' - The name of the device that is writing to the stream.
--
-- In the current implementation, Kinesis Video Streams does not use this
-- name.
--
-- 'kmsKeyId', 'createStream_kmsKeyId' - The ID of the Key Management Service (KMS) key that you want Kinesis
-- Video Streams to use to encrypt stream data.
--
-- If no key ID is specified, the default, Kinesis Video-managed key
-- (@aws\/kinesisvideo@) is used.
--
-- For more information, see
-- <https://docs.aws.amazon.com/kms/latest/APIReference/API_DescribeKey.html#API_DescribeKey_RequestParameters DescribeKey>.
--
-- 'mediaType', 'createStream_mediaType' - The media type of the stream. Consumers of the stream can use this
-- information when processing the stream. For more information about media
-- types, see
-- <http://www.iana.org/assignments/media-types/media-types.xhtml Media Types>.
-- If you choose to specify the @MediaType@, see
-- <https://tools.ietf.org/html/rfc6838#section-4.2 Naming Requirements>
-- for guidelines.
--
-- Example valid values include \"video\/h264\" and
-- \"video\/h264,audio\/aac\".
--
-- This parameter is optional; the default value is @null@ (or empty in
-- JSON).
--
-- 'tags', 'createStream_tags' - A list of tags to associate with the specified stream. Each tag is a
-- key-value pair (the value is optional).
--
-- 'streamName', 'createStream_streamName' - A name for the stream that you are creating.
--
-- The stream name is an identifier for the stream, and must be unique for
-- each account and region.
newCreateStream ::
  -- | 'streamName'
  Prelude.Text ->
  CreateStream
newCreateStream :: Text -> CreateStream
newCreateStream Text
pStreamName_ =
  CreateStream'
    { $sel:dataRetentionInHours:CreateStream' :: Maybe Natural
dataRetentionInHours =
        forall a. Maybe a
Prelude.Nothing,
      $sel:deviceName:CreateStream' :: Maybe Text
deviceName = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:CreateStream' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:mediaType:CreateStream' :: Maybe Text
mediaType = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateStream' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:streamName:CreateStream' :: Text
streamName = Text
pStreamName_
    }

-- | The number of hours that you want to retain the data in the stream.
-- Kinesis Video Streams retains the data in a data store that is
-- associated with the stream.
--
-- The default value is 0, indicating that the stream does not persist
-- data.
--
-- When the @DataRetentionInHours@ value is 0, consumers can still consume
-- the fragments that remain in the service host buffer, which has a
-- retention time limit of 5 minutes and a retention memory limit of 200
-- MB. Fragments are removed from the buffer when either limit is reached.
createStream_dataRetentionInHours :: Lens.Lens' CreateStream (Prelude.Maybe Prelude.Natural)
createStream_dataRetentionInHours :: Lens' CreateStream (Maybe Natural)
createStream_dataRetentionInHours = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStream' {Maybe Natural
dataRetentionInHours :: Maybe Natural
$sel:dataRetentionInHours:CreateStream' :: CreateStream -> Maybe Natural
dataRetentionInHours} -> Maybe Natural
dataRetentionInHours) (\s :: CreateStream
s@CreateStream' {} Maybe Natural
a -> CreateStream
s {$sel:dataRetentionInHours:CreateStream' :: Maybe Natural
dataRetentionInHours = Maybe Natural
a} :: CreateStream)

-- | The name of the device that is writing to the stream.
--
-- In the current implementation, Kinesis Video Streams does not use this
-- name.
createStream_deviceName :: Lens.Lens' CreateStream (Prelude.Maybe Prelude.Text)
createStream_deviceName :: Lens' CreateStream (Maybe Text)
createStream_deviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStream' {Maybe Text
deviceName :: Maybe Text
$sel:deviceName:CreateStream' :: CreateStream -> Maybe Text
deviceName} -> Maybe Text
deviceName) (\s :: CreateStream
s@CreateStream' {} Maybe Text
a -> CreateStream
s {$sel:deviceName:CreateStream' :: Maybe Text
deviceName = Maybe Text
a} :: CreateStream)

-- | The ID of the Key Management Service (KMS) key that you want Kinesis
-- Video Streams to use to encrypt stream data.
--
-- If no key ID is specified, the default, Kinesis Video-managed key
-- (@aws\/kinesisvideo@) is used.
--
-- For more information, see
-- <https://docs.aws.amazon.com/kms/latest/APIReference/API_DescribeKey.html#API_DescribeKey_RequestParameters DescribeKey>.
createStream_kmsKeyId :: Lens.Lens' CreateStream (Prelude.Maybe Prelude.Text)
createStream_kmsKeyId :: Lens' CreateStream (Maybe Text)
createStream_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStream' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CreateStream' :: CreateStream -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CreateStream
s@CreateStream' {} Maybe Text
a -> CreateStream
s {$sel:kmsKeyId:CreateStream' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CreateStream)

-- | The media type of the stream. Consumers of the stream can use this
-- information when processing the stream. For more information about media
-- types, see
-- <http://www.iana.org/assignments/media-types/media-types.xhtml Media Types>.
-- If you choose to specify the @MediaType@, see
-- <https://tools.ietf.org/html/rfc6838#section-4.2 Naming Requirements>
-- for guidelines.
--
-- Example valid values include \"video\/h264\" and
-- \"video\/h264,audio\/aac\".
--
-- This parameter is optional; the default value is @null@ (or empty in
-- JSON).
createStream_mediaType :: Lens.Lens' CreateStream (Prelude.Maybe Prelude.Text)
createStream_mediaType :: Lens' CreateStream (Maybe Text)
createStream_mediaType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStream' {Maybe Text
mediaType :: Maybe Text
$sel:mediaType:CreateStream' :: CreateStream -> Maybe Text
mediaType} -> Maybe Text
mediaType) (\s :: CreateStream
s@CreateStream' {} Maybe Text
a -> CreateStream
s {$sel:mediaType:CreateStream' :: Maybe Text
mediaType = Maybe Text
a} :: CreateStream)

-- | A list of tags to associate with the specified stream. Each tag is a
-- key-value pair (the value is optional).
createStream_tags :: Lens.Lens' CreateStream (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createStream_tags :: Lens' CreateStream (Maybe (HashMap Text Text))
createStream_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStream' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateStream' :: CreateStream -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateStream
s@CreateStream' {} Maybe (HashMap Text Text)
a -> CreateStream
s {$sel:tags:CreateStream' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateStream) 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

-- | A name for the stream that you are creating.
--
-- The stream name is an identifier for the stream, and must be unique for
-- each account and region.
createStream_streamName :: Lens.Lens' CreateStream Prelude.Text
createStream_streamName :: Lens' CreateStream Text
createStream_streamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStream' {Text
streamName :: Text
$sel:streamName:CreateStream' :: CreateStream -> Text
streamName} -> Text
streamName) (\s :: CreateStream
s@CreateStream' {} Text
a -> CreateStream
s {$sel:streamName:CreateStream' :: Text
streamName = Text
a} :: CreateStream)

instance Core.AWSRequest CreateStream where
  type AWSResponse CreateStream = CreateStreamResponse
  request :: (Service -> Service) -> CreateStream -> Request CreateStream
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 CreateStream
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateStream)))
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 Text -> Int -> CreateStreamResponse
CreateStreamResponse'
            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
"StreamARN")
            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 CreateStream where
  hashWithSalt :: Int -> CreateStream -> Int
hashWithSalt Int
_salt CreateStream' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Text
streamName :: Text
tags :: Maybe (HashMap Text Text)
mediaType :: Maybe Text
kmsKeyId :: Maybe Text
deviceName :: Maybe Text
dataRetentionInHours :: Maybe Natural
$sel:streamName:CreateStream' :: CreateStream -> Text
$sel:tags:CreateStream' :: CreateStream -> Maybe (HashMap Text Text)
$sel:mediaType:CreateStream' :: CreateStream -> Maybe Text
$sel:kmsKeyId:CreateStream' :: CreateStream -> Maybe Text
$sel:deviceName:CreateStream' :: CreateStream -> Maybe Text
$sel:dataRetentionInHours:CreateStream' :: CreateStream -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
dataRetentionInHours
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deviceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
mediaType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
streamName

instance Prelude.NFData CreateStream where
  rnf :: CreateStream -> ()
rnf CreateStream' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Text
streamName :: Text
tags :: Maybe (HashMap Text Text)
mediaType :: Maybe Text
kmsKeyId :: Maybe Text
deviceName :: Maybe Text
dataRetentionInHours :: Maybe Natural
$sel:streamName:CreateStream' :: CreateStream -> Text
$sel:tags:CreateStream' :: CreateStream -> Maybe (HashMap Text Text)
$sel:mediaType:CreateStream' :: CreateStream -> Maybe Text
$sel:kmsKeyId:CreateStream' :: CreateStream -> Maybe Text
$sel:deviceName:CreateStream' :: CreateStream -> Maybe Text
$sel:dataRetentionInHours:CreateStream' :: CreateStream -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
dataRetentionInHours
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deviceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
mediaType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
streamName

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

instance Data.ToJSON CreateStream where
  toJSON :: CreateStream -> Value
toJSON CreateStream' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Text
streamName :: Text
tags :: Maybe (HashMap Text Text)
mediaType :: Maybe Text
kmsKeyId :: Maybe Text
deviceName :: Maybe Text
dataRetentionInHours :: Maybe Natural
$sel:streamName:CreateStream' :: CreateStream -> Text
$sel:tags:CreateStream' :: CreateStream -> Maybe (HashMap Text Text)
$sel:mediaType:CreateStream' :: CreateStream -> Maybe Text
$sel:kmsKeyId:CreateStream' :: CreateStream -> Maybe Text
$sel:deviceName:CreateStream' :: CreateStream -> Maybe Text
$sel:dataRetentionInHours:CreateStream' :: CreateStream -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DataRetentionInHours" 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
dataRetentionInHours,
            (Key
"DeviceName" 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
deviceName,
            (Key
"KmsKeyId" 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
kmsKeyId,
            (Key
"MediaType" 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
mediaType,
            (Key
"Tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"StreamName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
streamName)
          ]
      )

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

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

-- | /See:/ 'newCreateStreamResponse' smart constructor.
data CreateStreamResponse = CreateStreamResponse'
  { -- | The Amazon Resource Name (ARN) of the stream.
    CreateStreamResponse -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateStreamResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateStreamResponse -> CreateStreamResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStreamResponse -> CreateStreamResponse -> Bool
$c/= :: CreateStreamResponse -> CreateStreamResponse -> Bool
== :: CreateStreamResponse -> CreateStreamResponse -> Bool
$c== :: CreateStreamResponse -> CreateStreamResponse -> Bool
Prelude.Eq, ReadPrec [CreateStreamResponse]
ReadPrec CreateStreamResponse
Int -> ReadS CreateStreamResponse
ReadS [CreateStreamResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStreamResponse]
$creadListPrec :: ReadPrec [CreateStreamResponse]
readPrec :: ReadPrec CreateStreamResponse
$creadPrec :: ReadPrec CreateStreamResponse
readList :: ReadS [CreateStreamResponse]
$creadList :: ReadS [CreateStreamResponse]
readsPrec :: Int -> ReadS CreateStreamResponse
$creadsPrec :: Int -> ReadS CreateStreamResponse
Prelude.Read, Int -> CreateStreamResponse -> ShowS
[CreateStreamResponse] -> ShowS
CreateStreamResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStreamResponse] -> ShowS
$cshowList :: [CreateStreamResponse] -> ShowS
show :: CreateStreamResponse -> String
$cshow :: CreateStreamResponse -> String
showsPrec :: Int -> CreateStreamResponse -> ShowS
$cshowsPrec :: Int -> CreateStreamResponse -> ShowS
Prelude.Show, forall x. Rep CreateStreamResponse x -> CreateStreamResponse
forall x. CreateStreamResponse -> Rep CreateStreamResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStreamResponse x -> CreateStreamResponse
$cfrom :: forall x. CreateStreamResponse -> Rep CreateStreamResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateStreamResponse' 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:
--
-- 'streamARN', 'createStreamResponse_streamARN' - The Amazon Resource Name (ARN) of the stream.
--
-- 'httpStatus', 'createStreamResponse_httpStatus' - The response's http status code.
newCreateStreamResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateStreamResponse
newCreateStreamResponse :: Int -> CreateStreamResponse
newCreateStreamResponse Int
pHttpStatus_ =
  CreateStreamResponse'
    { $sel:streamARN:CreateStreamResponse' :: Maybe Text
streamARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateStreamResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData CreateStreamResponse where
  rnf :: CreateStreamResponse -> ()
rnf CreateStreamResponse' {Int
Maybe Text
httpStatus :: Int
streamARN :: Maybe Text
$sel:httpStatus:CreateStreamResponse' :: CreateStreamResponse -> Int
$sel:streamARN:CreateStreamResponse' :: CreateStreamResponse -> Maybe Text
..} =
    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 Int
httpStatus