{-# 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.MediaLive.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)
--
-- Creates a new channel
module Amazonka.MediaLive.CreateChannel
  ( -- * Creating a Request
    CreateChannel' (..),
    newCreateChannel',

    -- * Request Lenses
    createChannel'_cdiInputSpecification,
    createChannel'_channelClass,
    createChannel'_destinations,
    createChannel'_encoderSettings,
    createChannel'_inputAttachments,
    createChannel'_inputSpecification,
    createChannel'_logLevel,
    createChannel'_maintenance,
    createChannel'_name,
    createChannel'_requestId,
    createChannel'_reserved,
    createChannel'_roleArn,
    createChannel'_tags,
    createChannel'_vpc,

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

    -- * Response Lenses
    createChannelResponse_channel,
    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.MediaLive.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | A request to create a channel
--
-- /See:/ 'newCreateChannel'' smart constructor.
data CreateChannel' = CreateChannel''
  { -- | Specification of CDI inputs for this channel
    CreateChannel' -> Maybe CdiInputSpecification
cdiInputSpecification :: Prelude.Maybe CdiInputSpecification,
    -- | The class for this channel. STANDARD for a channel with two pipelines or
    -- SINGLE_PIPELINE for a channel with one pipeline.
    CreateChannel' -> Maybe ChannelClass
channelClass :: Prelude.Maybe ChannelClass,
    CreateChannel' -> Maybe [OutputDestination]
destinations :: Prelude.Maybe [OutputDestination],
    CreateChannel' -> Maybe EncoderSettings
encoderSettings :: Prelude.Maybe EncoderSettings,
    -- | List of input attachments for channel.
    CreateChannel' -> Maybe [InputAttachment]
inputAttachments :: Prelude.Maybe [InputAttachment],
    -- | Specification of network and file inputs for this channel
    CreateChannel' -> Maybe InputSpecification
inputSpecification :: Prelude.Maybe InputSpecification,
    -- | The log level to write to CloudWatch Logs.
    CreateChannel' -> Maybe LogLevel
logLevel :: Prelude.Maybe LogLevel,
    -- | Maintenance settings for this channel.
    CreateChannel' -> Maybe MaintenanceCreateSettings
maintenance :: Prelude.Maybe MaintenanceCreateSettings,
    -- | Name of channel.
    CreateChannel' -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Unique request ID to be specified. This is needed to prevent retries
    -- from creating multiple resources.
    CreateChannel' -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | Deprecated field that\'s only usable by whitelisted customers.
    CreateChannel' -> Maybe Text
reserved :: Prelude.Maybe Prelude.Text,
    -- | An optional Amazon Resource Name (ARN) of the role to assume when
    -- running the Channel.
    CreateChannel' -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | A collection of key-value pairs.
    CreateChannel' -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Settings for the VPC outputs
    CreateChannel' -> Maybe VpcOutputSettings
vpc :: Prelude.Maybe VpcOutputSettings
  }
  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:
--
-- 'cdiInputSpecification', 'createChannel'_cdiInputSpecification' - Specification of CDI inputs for this channel
--
-- 'channelClass', 'createChannel'_channelClass' - The class for this channel. STANDARD for a channel with two pipelines or
-- SINGLE_PIPELINE for a channel with one pipeline.
--
-- 'destinations', 'createChannel'_destinations' - Undocumented member.
--
-- 'encoderSettings', 'createChannel'_encoderSettings' - Undocumented member.
--
-- 'inputAttachments', 'createChannel'_inputAttachments' - List of input attachments for channel.
--
-- 'inputSpecification', 'createChannel'_inputSpecification' - Specification of network and file inputs for this channel
--
-- 'logLevel', 'createChannel'_logLevel' - The log level to write to CloudWatch Logs.
--
-- 'maintenance', 'createChannel'_maintenance' - Maintenance settings for this channel.
--
-- 'name', 'createChannel'_name' - Name of channel.
--
-- 'requestId', 'createChannel'_requestId' - Unique request ID to be specified. This is needed to prevent retries
-- from creating multiple resources.
--
-- 'reserved', 'createChannel'_reserved' - Deprecated field that\'s only usable by whitelisted customers.
--
-- 'roleArn', 'createChannel'_roleArn' - An optional Amazon Resource Name (ARN) of the role to assume when
-- running the Channel.
--
-- 'tags', 'createChannel'_tags' - A collection of key-value pairs.
--
-- 'vpc', 'createChannel'_vpc' - Settings for the VPC outputs
newCreateChannel' ::
  CreateChannel'
newCreateChannel' :: CreateChannel'
newCreateChannel' =
  CreateChannel''
    { $sel:cdiInputSpecification:CreateChannel'' :: Maybe CdiInputSpecification
cdiInputSpecification =
        forall a. Maybe a
Prelude.Nothing,
      $sel:channelClass:CreateChannel'' :: Maybe ChannelClass
channelClass = forall a. Maybe a
Prelude.Nothing,
      $sel:destinations:CreateChannel'' :: Maybe [OutputDestination]
destinations = forall a. Maybe a
Prelude.Nothing,
      $sel:encoderSettings:CreateChannel'' :: Maybe EncoderSettings
encoderSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:inputAttachments:CreateChannel'' :: Maybe [InputAttachment]
inputAttachments = forall a. Maybe a
Prelude.Nothing,
      $sel:inputSpecification:CreateChannel'' :: Maybe InputSpecification
inputSpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:logLevel:CreateChannel'' :: Maybe LogLevel
logLevel = forall a. Maybe a
Prelude.Nothing,
      $sel:maintenance:CreateChannel'' :: Maybe MaintenanceCreateSettings
maintenance = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateChannel'' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:CreateChannel'' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:reserved:CreateChannel'' :: Maybe Text
reserved = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:CreateChannel'' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateChannel'' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:vpc:CreateChannel'' :: Maybe VpcOutputSettings
vpc = forall a. Maybe a
Prelude.Nothing
    }

-- | Specification of CDI inputs for this channel
createChannel'_cdiInputSpecification :: Lens.Lens' CreateChannel' (Prelude.Maybe CdiInputSpecification)
createChannel'_cdiInputSpecification :: Lens' CreateChannel' (Maybe CdiInputSpecification)
createChannel'_cdiInputSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe CdiInputSpecification
cdiInputSpecification :: Maybe CdiInputSpecification
$sel:cdiInputSpecification:CreateChannel'' :: CreateChannel' -> Maybe CdiInputSpecification
cdiInputSpecification} -> Maybe CdiInputSpecification
cdiInputSpecification) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe CdiInputSpecification
a -> CreateChannel'
s {$sel:cdiInputSpecification:CreateChannel'' :: Maybe CdiInputSpecification
cdiInputSpecification = Maybe CdiInputSpecification
a} :: CreateChannel')

-- | The class for this channel. STANDARD for a channel with two pipelines or
-- SINGLE_PIPELINE for a channel with one pipeline.
createChannel'_channelClass :: Lens.Lens' CreateChannel' (Prelude.Maybe ChannelClass)
createChannel'_channelClass :: Lens' CreateChannel' (Maybe ChannelClass)
createChannel'_channelClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe ChannelClass
channelClass :: Maybe ChannelClass
$sel:channelClass:CreateChannel'' :: CreateChannel' -> Maybe ChannelClass
channelClass} -> Maybe ChannelClass
channelClass) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe ChannelClass
a -> CreateChannel'
s {$sel:channelClass:CreateChannel'' :: Maybe ChannelClass
channelClass = Maybe ChannelClass
a} :: CreateChannel')

-- | Undocumented member.
createChannel'_destinations :: Lens.Lens' CreateChannel' (Prelude.Maybe [OutputDestination])
createChannel'_destinations :: Lens' CreateChannel' (Maybe [OutputDestination])
createChannel'_destinations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe [OutputDestination]
destinations :: Maybe [OutputDestination]
$sel:destinations:CreateChannel'' :: CreateChannel' -> Maybe [OutputDestination]
destinations} -> Maybe [OutputDestination]
destinations) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe [OutputDestination]
a -> CreateChannel'
s {$sel:destinations:CreateChannel'' :: Maybe [OutputDestination]
destinations = Maybe [OutputDestination]
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

-- | Undocumented member.
createChannel'_encoderSettings :: Lens.Lens' CreateChannel' (Prelude.Maybe EncoderSettings)
createChannel'_encoderSettings :: Lens' CreateChannel' (Maybe EncoderSettings)
createChannel'_encoderSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe EncoderSettings
encoderSettings :: Maybe EncoderSettings
$sel:encoderSettings:CreateChannel'' :: CreateChannel' -> Maybe EncoderSettings
encoderSettings} -> Maybe EncoderSettings
encoderSettings) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe EncoderSettings
a -> CreateChannel'
s {$sel:encoderSettings:CreateChannel'' :: Maybe EncoderSettings
encoderSettings = Maybe EncoderSettings
a} :: CreateChannel')

-- | List of input attachments for channel.
createChannel'_inputAttachments :: Lens.Lens' CreateChannel' (Prelude.Maybe [InputAttachment])
createChannel'_inputAttachments :: Lens' CreateChannel' (Maybe [InputAttachment])
createChannel'_inputAttachments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe [InputAttachment]
inputAttachments :: Maybe [InputAttachment]
$sel:inputAttachments:CreateChannel'' :: CreateChannel' -> Maybe [InputAttachment]
inputAttachments} -> Maybe [InputAttachment]
inputAttachments) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe [InputAttachment]
a -> CreateChannel'
s {$sel:inputAttachments:CreateChannel'' :: Maybe [InputAttachment]
inputAttachments = Maybe [InputAttachment]
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

-- | Specification of network and file inputs for this channel
createChannel'_inputSpecification :: Lens.Lens' CreateChannel' (Prelude.Maybe InputSpecification)
createChannel'_inputSpecification :: Lens' CreateChannel' (Maybe InputSpecification)
createChannel'_inputSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe InputSpecification
inputSpecification :: Maybe InputSpecification
$sel:inputSpecification:CreateChannel'' :: CreateChannel' -> Maybe InputSpecification
inputSpecification} -> Maybe InputSpecification
inputSpecification) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe InputSpecification
a -> CreateChannel'
s {$sel:inputSpecification:CreateChannel'' :: Maybe InputSpecification
inputSpecification = Maybe InputSpecification
a} :: CreateChannel')

-- | The log level to write to CloudWatch Logs.
createChannel'_logLevel :: Lens.Lens' CreateChannel' (Prelude.Maybe LogLevel)
createChannel'_logLevel :: Lens' CreateChannel' (Maybe LogLevel)
createChannel'_logLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe LogLevel
logLevel :: Maybe LogLevel
$sel:logLevel:CreateChannel'' :: CreateChannel' -> Maybe LogLevel
logLevel} -> Maybe LogLevel
logLevel) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe LogLevel
a -> CreateChannel'
s {$sel:logLevel:CreateChannel'' :: Maybe LogLevel
logLevel = Maybe LogLevel
a} :: CreateChannel')

-- | Maintenance settings for this channel.
createChannel'_maintenance :: Lens.Lens' CreateChannel' (Prelude.Maybe MaintenanceCreateSettings)
createChannel'_maintenance :: Lens' CreateChannel' (Maybe MaintenanceCreateSettings)
createChannel'_maintenance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe MaintenanceCreateSettings
maintenance :: Maybe MaintenanceCreateSettings
$sel:maintenance:CreateChannel'' :: CreateChannel' -> Maybe MaintenanceCreateSettings
maintenance} -> Maybe MaintenanceCreateSettings
maintenance) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe MaintenanceCreateSettings
a -> CreateChannel'
s {$sel:maintenance:CreateChannel'' :: Maybe MaintenanceCreateSettings
maintenance = Maybe MaintenanceCreateSettings
a} :: CreateChannel')

-- | Name of channel.
createChannel'_name :: Lens.Lens' CreateChannel' (Prelude.Maybe Prelude.Text)
createChannel'_name :: Lens' CreateChannel' (Maybe Text)
createChannel'_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe Text
name :: Maybe Text
$sel:name:CreateChannel'' :: CreateChannel' -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe Text
a -> CreateChannel'
s {$sel:name:CreateChannel'' :: Maybe Text
name = Maybe Text
a} :: CreateChannel')

-- | Unique request ID to be specified. This is needed to prevent retries
-- from creating multiple resources.
createChannel'_requestId :: Lens.Lens' CreateChannel' (Prelude.Maybe Prelude.Text)
createChannel'_requestId :: Lens' CreateChannel' (Maybe Text)
createChannel'_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe Text
requestId :: Maybe Text
$sel:requestId:CreateChannel'' :: CreateChannel' -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe Text
a -> CreateChannel'
s {$sel:requestId:CreateChannel'' :: Maybe Text
requestId = Maybe Text
a} :: CreateChannel')

-- | Deprecated field that\'s only usable by whitelisted customers.
createChannel'_reserved :: Lens.Lens' CreateChannel' (Prelude.Maybe Prelude.Text)
createChannel'_reserved :: Lens' CreateChannel' (Maybe Text)
createChannel'_reserved = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe Text
reserved :: Maybe Text
$sel:reserved:CreateChannel'' :: CreateChannel' -> Maybe Text
reserved} -> Maybe Text
reserved) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe Text
a -> CreateChannel'
s {$sel:reserved:CreateChannel'' :: Maybe Text
reserved = Maybe Text
a} :: CreateChannel')

-- | An optional Amazon Resource Name (ARN) of the role to assume when
-- running the Channel.
createChannel'_roleArn :: Lens.Lens' CreateChannel' (Prelude.Maybe Prelude.Text)
createChannel'_roleArn :: Lens' CreateChannel' (Maybe Text)
createChannel'_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:CreateChannel'' :: CreateChannel' -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe Text
a -> CreateChannel'
s {$sel:roleArn:CreateChannel'' :: Maybe Text
roleArn = Maybe Text
a} :: CreateChannel')

-- | A collection of key-value pairs.
createChannel'_tags :: Lens.Lens' CreateChannel' (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createChannel'_tags :: Lens' CreateChannel' (Maybe (HashMap Text Text))
createChannel'_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateChannel'' :: CreateChannel' -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe (HashMap Text Text)
a -> CreateChannel'
s {$sel:tags:CreateChannel'' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
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

-- | Settings for the VPC outputs
createChannel'_vpc :: Lens.Lens' CreateChannel' (Prelude.Maybe VpcOutputSettings)
createChannel'_vpc :: Lens' CreateChannel' (Maybe VpcOutputSettings)
createChannel'_vpc = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannel'' {Maybe VpcOutputSettings
vpc :: Maybe VpcOutputSettings
$sel:vpc:CreateChannel'' :: CreateChannel' -> Maybe VpcOutputSettings
vpc} -> Maybe VpcOutputSettings
vpc) (\s :: CreateChannel'
s@CreateChannel'' {} Maybe VpcOutputSettings
a -> CreateChannel'
s {$sel:vpc:CreateChannel'' :: Maybe VpcOutputSettings
vpc = Maybe VpcOutputSettings
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 Channel -> 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
"channel")
            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 [OutputDestination]
Maybe [InputAttachment]
Maybe Text
Maybe (HashMap Text Text)
Maybe CdiInputSpecification
Maybe ChannelClass
Maybe InputSpecification
Maybe LogLevel
Maybe MaintenanceCreateSettings
Maybe VpcOutputSettings
Maybe EncoderSettings
vpc :: Maybe VpcOutputSettings
tags :: Maybe (HashMap Text Text)
roleArn :: Maybe Text
reserved :: Maybe Text
requestId :: Maybe Text
name :: Maybe Text
maintenance :: Maybe MaintenanceCreateSettings
logLevel :: Maybe LogLevel
inputSpecification :: Maybe InputSpecification
inputAttachments :: Maybe [InputAttachment]
encoderSettings :: Maybe EncoderSettings
destinations :: Maybe [OutputDestination]
channelClass :: Maybe ChannelClass
cdiInputSpecification :: Maybe CdiInputSpecification
$sel:vpc:CreateChannel'' :: CreateChannel' -> Maybe VpcOutputSettings
$sel:tags:CreateChannel'' :: CreateChannel' -> Maybe (HashMap Text Text)
$sel:roleArn:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:reserved:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:requestId:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:name:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:maintenance:CreateChannel'' :: CreateChannel' -> Maybe MaintenanceCreateSettings
$sel:logLevel:CreateChannel'' :: CreateChannel' -> Maybe LogLevel
$sel:inputSpecification:CreateChannel'' :: CreateChannel' -> Maybe InputSpecification
$sel:inputAttachments:CreateChannel'' :: CreateChannel' -> Maybe [InputAttachment]
$sel:encoderSettings:CreateChannel'' :: CreateChannel' -> Maybe EncoderSettings
$sel:destinations:CreateChannel'' :: CreateChannel' -> Maybe [OutputDestination]
$sel:channelClass:CreateChannel'' :: CreateChannel' -> Maybe ChannelClass
$sel:cdiInputSpecification:CreateChannel'' :: CreateChannel' -> Maybe CdiInputSpecification
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CdiInputSpecification
cdiInputSpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChannelClass
channelClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [OutputDestination]
destinations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncoderSettings
encoderSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InputAttachment]
inputAttachments
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputSpecification
inputSpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LogLevel
logLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MaintenanceCreateSettings
maintenance
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
requestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reserved
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcOutputSettings
vpc

instance Prelude.NFData CreateChannel' where
  rnf :: CreateChannel' -> ()
rnf CreateChannel'' {Maybe [OutputDestination]
Maybe [InputAttachment]
Maybe Text
Maybe (HashMap Text Text)
Maybe CdiInputSpecification
Maybe ChannelClass
Maybe InputSpecification
Maybe LogLevel
Maybe MaintenanceCreateSettings
Maybe VpcOutputSettings
Maybe EncoderSettings
vpc :: Maybe VpcOutputSettings
tags :: Maybe (HashMap Text Text)
roleArn :: Maybe Text
reserved :: Maybe Text
requestId :: Maybe Text
name :: Maybe Text
maintenance :: Maybe MaintenanceCreateSettings
logLevel :: Maybe LogLevel
inputSpecification :: Maybe InputSpecification
inputAttachments :: Maybe [InputAttachment]
encoderSettings :: Maybe EncoderSettings
destinations :: Maybe [OutputDestination]
channelClass :: Maybe ChannelClass
cdiInputSpecification :: Maybe CdiInputSpecification
$sel:vpc:CreateChannel'' :: CreateChannel' -> Maybe VpcOutputSettings
$sel:tags:CreateChannel'' :: CreateChannel' -> Maybe (HashMap Text Text)
$sel:roleArn:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:reserved:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:requestId:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:name:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:maintenance:CreateChannel'' :: CreateChannel' -> Maybe MaintenanceCreateSettings
$sel:logLevel:CreateChannel'' :: CreateChannel' -> Maybe LogLevel
$sel:inputSpecification:CreateChannel'' :: CreateChannel' -> Maybe InputSpecification
$sel:inputAttachments:CreateChannel'' :: CreateChannel' -> Maybe [InputAttachment]
$sel:encoderSettings:CreateChannel'' :: CreateChannel' -> Maybe EncoderSettings
$sel:destinations:CreateChannel'' :: CreateChannel' -> Maybe [OutputDestination]
$sel:channelClass:CreateChannel'' :: CreateChannel' -> Maybe ChannelClass
$sel:cdiInputSpecification:CreateChannel'' :: CreateChannel' -> Maybe CdiInputSpecification
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CdiInputSpecification
cdiInputSpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelClass
channelClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [OutputDestination]
destinations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncoderSettings
encoderSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InputAttachment]
inputAttachments
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputSpecification
inputSpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LogLevel
logLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MaintenanceCreateSettings
maintenance
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reserved
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      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 Maybe VpcOutputSettings
vpc

instance Data.ToHeaders CreateChannel' where
  toHeaders :: CreateChannel' -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateChannel' where
  toJSON :: CreateChannel' -> Value
toJSON CreateChannel'' {Maybe [OutputDestination]
Maybe [InputAttachment]
Maybe Text
Maybe (HashMap Text Text)
Maybe CdiInputSpecification
Maybe ChannelClass
Maybe InputSpecification
Maybe LogLevel
Maybe MaintenanceCreateSettings
Maybe VpcOutputSettings
Maybe EncoderSettings
vpc :: Maybe VpcOutputSettings
tags :: Maybe (HashMap Text Text)
roleArn :: Maybe Text
reserved :: Maybe Text
requestId :: Maybe Text
name :: Maybe Text
maintenance :: Maybe MaintenanceCreateSettings
logLevel :: Maybe LogLevel
inputSpecification :: Maybe InputSpecification
inputAttachments :: Maybe [InputAttachment]
encoderSettings :: Maybe EncoderSettings
destinations :: Maybe [OutputDestination]
channelClass :: Maybe ChannelClass
cdiInputSpecification :: Maybe CdiInputSpecification
$sel:vpc:CreateChannel'' :: CreateChannel' -> Maybe VpcOutputSettings
$sel:tags:CreateChannel'' :: CreateChannel' -> Maybe (HashMap Text Text)
$sel:roleArn:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:reserved:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:requestId:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:name:CreateChannel'' :: CreateChannel' -> Maybe Text
$sel:maintenance:CreateChannel'' :: CreateChannel' -> Maybe MaintenanceCreateSettings
$sel:logLevel:CreateChannel'' :: CreateChannel' -> Maybe LogLevel
$sel:inputSpecification:CreateChannel'' :: CreateChannel' -> Maybe InputSpecification
$sel:inputAttachments:CreateChannel'' :: CreateChannel' -> Maybe [InputAttachment]
$sel:encoderSettings:CreateChannel'' :: CreateChannel' -> Maybe EncoderSettings
$sel:destinations:CreateChannel'' :: CreateChannel' -> Maybe [OutputDestination]
$sel:channelClass:CreateChannel'' :: CreateChannel' -> Maybe ChannelClass
$sel:cdiInputSpecification:CreateChannel'' :: CreateChannel' -> Maybe CdiInputSpecification
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cdiInputSpecification" 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 CdiInputSpecification
cdiInputSpecification,
            (Key
"channelClass" 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 ChannelClass
channelClass,
            (Key
"destinations" 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 [OutputDestination]
destinations,
            (Key
"encoderSettings" 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 EncoderSettings
encoderSettings,
            (Key
"inputAttachments" 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 [InputAttachment]
inputAttachments,
            (Key
"inputSpecification" 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 InputSpecification
inputSpecification,
            (Key
"logLevel" 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 LogLevel
logLevel,
            (Key
"maintenance" 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 MaintenanceCreateSettings
maintenance,
            (Key
"name" 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
name,
            (Key
"requestId" 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
requestId,
            (Key
"reserved" 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
reserved,
            (Key
"roleArn" 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
roleArn,
            (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,
            (Key
"vpc" 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 VpcOutputSettings
vpc
          ]
      )

instance Data.ToPath CreateChannel' where
  toPath :: CreateChannel' -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/prod/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

-- | Placeholder documentation for CreateChannelResponse
--
-- /See:/ 'newCreateChannelResponse' smart constructor.
data CreateChannelResponse = CreateChannelResponse'
  { CreateChannelResponse -> Maybe Channel
channel :: Prelude.Maybe Channel,
    -- | 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:
--
-- 'channel', 'createChannelResponse_channel' - Undocumented member.
--
-- 'httpStatus', 'createChannelResponse_httpStatus' - The response's http status code.
newCreateChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateChannelResponse
newCreateChannelResponse :: Int -> CreateChannelResponse
newCreateChannelResponse Int
pHttpStatus_ =
  CreateChannelResponse'
    { $sel:channel:CreateChannelResponse' :: Maybe Channel
channel = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateChannelResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createChannelResponse_channel :: Lens.Lens' CreateChannelResponse (Prelude.Maybe Channel)
createChannelResponse_channel :: Lens' CreateChannelResponse (Maybe Channel)
createChannelResponse_channel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannelResponse' {Maybe Channel
channel :: Maybe Channel
$sel:channel:CreateChannelResponse' :: CreateChannelResponse -> Maybe Channel
channel} -> Maybe Channel
channel) (\s :: CreateChannelResponse
s@CreateChannelResponse' {} Maybe Channel
a -> CreateChannelResponse
s {$sel:channel:CreateChannelResponse' :: Maybe Channel
channel = Maybe Channel
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 Channel
httpStatus :: Int
channel :: Maybe Channel
$sel:httpStatus:CreateChannelResponse' :: CreateChannelResponse -> Int
$sel:channel:CreateChannelResponse' :: CreateChannelResponse -> Maybe Channel
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Channel
channel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus