{-# 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.IoTAnalytics.CreateChannel
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Used to create a channel. A channel collects data from an MQTT topic and
-- archives the raw, unprocessed messages before publishing the data to a
-- pipeline.
module Amazonka.IoTAnalytics.CreateChannel
  ( -- * Creating a Request
    CreateChannel (..),
    newCreateChannel,

    -- * Request Lenses
    createChannel_channelStorage,
    createChannel_retentionPeriod,
    createChannel_tags,
    createChannel_channelName,

    -- * Destructuring the Response
    CreateChannelResponse (..),
    newCreateChannelResponse,

    -- * Response Lenses
    createChannelResponse_channelArn,
    createChannelResponse_channelName,
    createChannelResponse_retentionPeriod,
    createChannelResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateChannel' smart constructor.
data CreateChannel = CreateChannel'
  { -- | Where channel data is stored. You can choose one of @serviceManagedS3@
    -- or @customerManagedS3@ storage. If not specified, the default is
    -- @serviceManagedS3@. You can\'t change this storage option after the
    -- channel is created.
    CreateChannel -> Maybe ChannelStorage
channelStorage :: Prelude.Maybe ChannelStorage,
    -- | How long, in days, message data is kept for the channel. When
    -- @customerManagedS3@ storage is selected, this parameter is ignored.
    CreateChannel -> Maybe RetentionPeriod
retentionPeriod :: Prelude.Maybe RetentionPeriod,
    -- | Metadata which can be used to manage the channel.
    CreateChannel -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The name of the channel.
    CreateChannel -> Text
channelName :: Prelude.Text
  }
  deriving (CreateChannel -> CreateChannel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateChannel -> CreateChannel -> Bool
$c/= :: CreateChannel -> CreateChannel -> Bool
== :: CreateChannel -> CreateChannel -> Bool
$c== :: CreateChannel -> CreateChannel -> Bool
Prelude.Eq, ReadPrec [CreateChannel]
ReadPrec CreateChannel
Int -> ReadS CreateChannel
ReadS [CreateChannel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateChannel]
$creadListPrec :: ReadPrec [CreateChannel]
readPrec :: ReadPrec CreateChannel
$creadPrec :: ReadPrec CreateChannel
readList :: ReadS [CreateChannel]
$creadList :: ReadS [CreateChannel]
readsPrec :: Int -> ReadS CreateChannel
$creadsPrec :: Int -> ReadS CreateChannel
Prelude.Read, Int -> CreateChannel -> ShowS
[CreateChannel] -> ShowS
CreateChannel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateChannel] -> ShowS
$cshowList :: [CreateChannel] -> ShowS
show :: CreateChannel -> String
$cshow :: CreateChannel -> String
showsPrec :: Int -> CreateChannel -> ShowS
$cshowsPrec :: Int -> CreateChannel -> ShowS
Prelude.Show, forall x. Rep CreateChannel x -> CreateChannel
forall x. CreateChannel -> Rep CreateChannel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateChannel x -> CreateChannel
$cfrom :: forall x. CreateChannel -> Rep CreateChannel x
Prelude.Generic)

-- |
-- Create a value of 'CreateChannel' 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:
--
-- 'channelStorage', 'createChannel_channelStorage' - Where channel data is stored. You can choose one of @serviceManagedS3@
-- or @customerManagedS3@ storage. If not specified, the default is
-- @serviceManagedS3@. You can\'t change this storage option after the
-- channel is created.
--
-- 'retentionPeriod', 'createChannel_retentionPeriod' - How long, in days, message data is kept for the channel. When
-- @customerManagedS3@ storage is selected, this parameter is ignored.
--
-- 'tags', 'createChannel_tags' - Metadata which can be used to manage the channel.
--
-- 'channelName', 'createChannel_channelName' - The name of the channel.
newCreateChannel ::
  -- | 'channelName'
  Prelude.Text ->
  CreateChannel
newCreateChannel :: Text -> CreateChannel
newCreateChannel Text
pChannelName_ =
  CreateChannel'
    { $sel:channelStorage:CreateChannel' :: Maybe ChannelStorage
channelStorage = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionPeriod:CreateChannel' :: Maybe RetentionPeriod
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateChannel' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:channelName:CreateChannel' :: Text
channelName = Text
pChannelName_
    }

-- | Where channel data is stored. You can choose one of @serviceManagedS3@
-- or @customerManagedS3@ storage. If not specified, the default is
-- @serviceManagedS3@. You can\'t change this storage option after the
-- channel is created.
createChannel_channelStorage :: Lens.Lens' CreateChannel (Prelude.Maybe ChannelStorage)
createChannel_channelStorage :: Lens' CreateChannel (Maybe ChannelStorage)
createChannel_channelStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel' {Maybe ChannelStorage
channelStorage :: Maybe ChannelStorage
$sel:channelStorage:CreateChannel' :: CreateChannel -> Maybe ChannelStorage
channelStorage} -> Maybe ChannelStorage
channelStorage) (\s :: CreateChannel
s@CreateChannel' {} Maybe ChannelStorage
a -> CreateChannel
s {$sel:channelStorage:CreateChannel' :: Maybe ChannelStorage
channelStorage = Maybe ChannelStorage
a} :: CreateChannel)

-- | How long, in days, message data is kept for the channel. When
-- @customerManagedS3@ storage is selected, this parameter is ignored.
createChannel_retentionPeriod :: Lens.Lens' CreateChannel (Prelude.Maybe RetentionPeriod)
createChannel_retentionPeriod :: Lens' CreateChannel (Maybe RetentionPeriod)
createChannel_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel' {Maybe RetentionPeriod
retentionPeriod :: Maybe RetentionPeriod
$sel:retentionPeriod:CreateChannel' :: CreateChannel -> Maybe RetentionPeriod
retentionPeriod} -> Maybe RetentionPeriod
retentionPeriod) (\s :: CreateChannel
s@CreateChannel' {} Maybe RetentionPeriod
a -> CreateChannel
s {$sel:retentionPeriod:CreateChannel' :: Maybe RetentionPeriod
retentionPeriod = Maybe RetentionPeriod
a} :: CreateChannel)

-- | Metadata which can be used to manage the channel.
createChannel_tags :: Lens.Lens' CreateChannel (Prelude.Maybe (Prelude.NonEmpty Tag))
createChannel_tags :: Lens' CreateChannel (Maybe (NonEmpty Tag))
createChannel_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateChannel' :: CreateChannel -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateChannel
s@CreateChannel' {} Maybe (NonEmpty Tag)
a -> CreateChannel
s {$sel:tags:CreateChannel' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateChannel) 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

-- | The name of the channel.
createChannel_channelName :: Lens.Lens' CreateChannel Prelude.Text
createChannel_channelName :: Lens' CreateChannel Text
createChannel_channelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel' {Text
channelName :: Text
$sel:channelName:CreateChannel' :: CreateChannel -> Text
channelName} -> Text
channelName) (\s :: CreateChannel
s@CreateChannel' {} Text
a -> CreateChannel
s {$sel:channelName:CreateChannel' :: Text
channelName = Text
a} :: CreateChannel)

instance Core.AWSRequest CreateChannel where
  type
    AWSResponse CreateChannel =
      CreateChannelResponse
  request :: (Service -> Service) -> CreateChannel -> Request CreateChannel
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 CreateChannel
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateChannel)))
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
-> Maybe Text
-> Maybe RetentionPeriod
-> Int
-> CreateChannelResponse
CreateChannelResponse'
            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
"channelArn")
            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
"channelName")
            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
"retentionPeriod")
            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 CreateChannel where
  hashWithSalt :: Int -> CreateChannel -> Int
hashWithSalt Int
_salt CreateChannel' {Maybe (NonEmpty Tag)
Maybe RetentionPeriod
Maybe ChannelStorage
Text
channelName :: Text
tags :: Maybe (NonEmpty Tag)
retentionPeriod :: Maybe RetentionPeriod
channelStorage :: Maybe ChannelStorage
$sel:channelName:CreateChannel' :: CreateChannel -> Text
$sel:tags:CreateChannel' :: CreateChannel -> Maybe (NonEmpty Tag)
$sel:retentionPeriod:CreateChannel' :: CreateChannel -> Maybe RetentionPeriod
$sel:channelStorage:CreateChannel' :: CreateChannel -> Maybe ChannelStorage
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChannelStorage
channelStorage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RetentionPeriod
retentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelName

instance Prelude.NFData CreateChannel where
  rnf :: CreateChannel -> ()
rnf CreateChannel' {Maybe (NonEmpty Tag)
Maybe RetentionPeriod
Maybe ChannelStorage
Text
channelName :: Text
tags :: Maybe (NonEmpty Tag)
retentionPeriod :: Maybe RetentionPeriod
channelStorage :: Maybe ChannelStorage
$sel:channelName:CreateChannel' :: CreateChannel -> Text
$sel:tags:CreateChannel' :: CreateChannel -> Maybe (NonEmpty Tag)
$sel:retentionPeriod:CreateChannel' :: CreateChannel -> Maybe RetentionPeriod
$sel:channelStorage:CreateChannel' :: CreateChannel -> Maybe ChannelStorage
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelStorage
channelStorage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RetentionPeriod
retentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
channelName

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

instance Data.ToJSON CreateChannel where
  toJSON :: CreateChannel -> Value
toJSON CreateChannel' {Maybe (NonEmpty Tag)
Maybe RetentionPeriod
Maybe ChannelStorage
Text
channelName :: Text
tags :: Maybe (NonEmpty Tag)
retentionPeriod :: Maybe RetentionPeriod
channelStorage :: Maybe ChannelStorage
$sel:channelName:CreateChannel' :: CreateChannel -> Text
$sel:tags:CreateChannel' :: CreateChannel -> Maybe (NonEmpty Tag)
$sel:retentionPeriod:CreateChannel' :: CreateChannel -> Maybe RetentionPeriod
$sel:channelStorage:CreateChannel' :: CreateChannel -> Maybe ChannelStorage
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"channelStorage" 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 ChannelStorage
channelStorage,
            (Key
"retentionPeriod" 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 RetentionPeriod
retentionPeriod,
            (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 (NonEmpty Tag)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"channelName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
channelName)
          ]
      )

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

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

-- | /See:/ 'newCreateChannelResponse' smart constructor.
data CreateChannelResponse = CreateChannelResponse'
  { -- | The ARN of the channel.
    CreateChannelResponse -> Maybe Text
channelArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the channel.
    CreateChannelResponse -> Maybe Text
channelName :: Prelude.Maybe Prelude.Text,
    -- | How long, in days, message data is kept for the channel.
    CreateChannelResponse -> Maybe RetentionPeriod
retentionPeriod :: Prelude.Maybe RetentionPeriod,
    -- | The response's http status code.
    CreateChannelResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateChannelResponse -> CreateChannelResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateChannelResponse -> CreateChannelResponse -> Bool
$c/= :: CreateChannelResponse -> CreateChannelResponse -> Bool
== :: CreateChannelResponse -> CreateChannelResponse -> Bool
$c== :: CreateChannelResponse -> CreateChannelResponse -> Bool
Prelude.Eq, ReadPrec [CreateChannelResponse]
ReadPrec CreateChannelResponse
Int -> ReadS CreateChannelResponse
ReadS [CreateChannelResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateChannelResponse]
$creadListPrec :: ReadPrec [CreateChannelResponse]
readPrec :: ReadPrec CreateChannelResponse
$creadPrec :: ReadPrec CreateChannelResponse
readList :: ReadS [CreateChannelResponse]
$creadList :: ReadS [CreateChannelResponse]
readsPrec :: Int -> ReadS CreateChannelResponse
$creadsPrec :: Int -> ReadS CreateChannelResponse
Prelude.Read, Int -> CreateChannelResponse -> ShowS
[CreateChannelResponse] -> ShowS
CreateChannelResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateChannelResponse] -> ShowS
$cshowList :: [CreateChannelResponse] -> ShowS
show :: CreateChannelResponse -> String
$cshow :: CreateChannelResponse -> String
showsPrec :: Int -> CreateChannelResponse -> ShowS
$cshowsPrec :: Int -> CreateChannelResponse -> ShowS
Prelude.Show, forall x. Rep CreateChannelResponse x -> CreateChannelResponse
forall x. CreateChannelResponse -> Rep CreateChannelResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateChannelResponse x -> CreateChannelResponse
$cfrom :: forall x. CreateChannelResponse -> Rep CreateChannelResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateChannelResponse' 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:
--
-- 'channelArn', 'createChannelResponse_channelArn' - The ARN of the channel.
--
-- 'channelName', 'createChannelResponse_channelName' - The name of the channel.
--
-- 'retentionPeriod', 'createChannelResponse_retentionPeriod' - How long, in days, message data is kept for the channel.
--
-- 'httpStatus', 'createChannelResponse_httpStatus' - The response's http status code.
newCreateChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateChannelResponse
newCreateChannelResponse :: Int -> CreateChannelResponse
newCreateChannelResponse Int
pHttpStatus_ =
  CreateChannelResponse'
    { $sel:channelArn:CreateChannelResponse' :: Maybe Text
channelArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:channelName:CreateChannelResponse' :: Maybe Text
channelName = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionPeriod:CreateChannelResponse' :: Maybe RetentionPeriod
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateChannelResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the channel.
createChannelResponse_channelArn :: Lens.Lens' CreateChannelResponse (Prelude.Maybe Prelude.Text)
createChannelResponse_channelArn :: Lens' CreateChannelResponse (Maybe Text)
createChannelResponse_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannelResponse' {Maybe Text
channelArn :: Maybe Text
$sel:channelArn:CreateChannelResponse' :: CreateChannelResponse -> Maybe Text
channelArn} -> Maybe Text
channelArn) (\s :: CreateChannelResponse
s@CreateChannelResponse' {} Maybe Text
a -> CreateChannelResponse
s {$sel:channelArn:CreateChannelResponse' :: Maybe Text
channelArn = Maybe Text
a} :: CreateChannelResponse)

-- | The name of the channel.
createChannelResponse_channelName :: Lens.Lens' CreateChannelResponse (Prelude.Maybe Prelude.Text)
createChannelResponse_channelName :: Lens' CreateChannelResponse (Maybe Text)
createChannelResponse_channelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannelResponse' {Maybe Text
channelName :: Maybe Text
$sel:channelName:CreateChannelResponse' :: CreateChannelResponse -> Maybe Text
channelName} -> Maybe Text
channelName) (\s :: CreateChannelResponse
s@CreateChannelResponse' {} Maybe Text
a -> CreateChannelResponse
s {$sel:channelName:CreateChannelResponse' :: Maybe Text
channelName = Maybe Text
a} :: CreateChannelResponse)

-- | How long, in days, message data is kept for the channel.
createChannelResponse_retentionPeriod :: Lens.Lens' CreateChannelResponse (Prelude.Maybe RetentionPeriod)
createChannelResponse_retentionPeriod :: Lens' CreateChannelResponse (Maybe RetentionPeriod)
createChannelResponse_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannelResponse' {Maybe RetentionPeriod
retentionPeriod :: Maybe RetentionPeriod
$sel:retentionPeriod:CreateChannelResponse' :: CreateChannelResponse -> Maybe RetentionPeriod
retentionPeriod} -> Maybe RetentionPeriod
retentionPeriod) (\s :: CreateChannelResponse
s@CreateChannelResponse' {} Maybe RetentionPeriod
a -> CreateChannelResponse
s {$sel:retentionPeriod:CreateChannelResponse' :: Maybe RetentionPeriod
retentionPeriod = Maybe RetentionPeriod
a} :: CreateChannelResponse)

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

instance Prelude.NFData CreateChannelResponse where
  rnf :: CreateChannelResponse -> ()
rnf CreateChannelResponse' {Int
Maybe Text
Maybe RetentionPeriod
httpStatus :: Int
retentionPeriod :: Maybe RetentionPeriod
channelName :: Maybe Text
channelArn :: Maybe Text
$sel:httpStatus:CreateChannelResponse' :: CreateChannelResponse -> Int
$sel:retentionPeriod:CreateChannelResponse' :: CreateChannelResponse -> Maybe RetentionPeriod
$sel:channelName:CreateChannelResponse' :: CreateChannelResponse -> Maybe Text
$sel:channelArn:CreateChannelResponse' :: CreateChannelResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
channelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
channelName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RetentionPeriod
retentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus