{-# 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.UpdateChannel
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a channel.
module Amazonka.MediaLive.UpdateChannel
  ( -- * Creating a Request
    UpdateChannel' (..),
    newUpdateChannel',

    -- * Request Lenses
    updateChannel'_cdiInputSpecification,
    updateChannel'_destinations,
    updateChannel'_encoderSettings,
    updateChannel'_inputAttachments,
    updateChannel'_inputSpecification,
    updateChannel'_logLevel,
    updateChannel'_maintenance,
    updateChannel'_name,
    updateChannel'_roleArn,
    updateChannel'_channelId,

    -- * Destructuring the Response
    UpdateChannelResponse (..),
    newUpdateChannelResponse,

    -- * Response Lenses
    updateChannelResponse_channel,
    updateChannelResponse_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 update a channel.
--
-- /See:/ 'newUpdateChannel'' smart constructor.
data UpdateChannel' = UpdateChannel''
  { -- | Specification of CDI inputs for this channel
    UpdateChannel' -> Maybe CdiInputSpecification
cdiInputSpecification :: Prelude.Maybe CdiInputSpecification,
    -- | A list of output destinations for this channel.
    UpdateChannel' -> Maybe [OutputDestination]
destinations :: Prelude.Maybe [OutputDestination],
    -- | The encoder settings for this channel.
    UpdateChannel' -> Maybe EncoderSettings
encoderSettings :: Prelude.Maybe EncoderSettings,
    UpdateChannel' -> Maybe [InputAttachment]
inputAttachments :: Prelude.Maybe [InputAttachment],
    -- | Specification of network and file inputs for this channel
    UpdateChannel' -> Maybe InputSpecification
inputSpecification :: Prelude.Maybe InputSpecification,
    -- | The log level to write to CloudWatch Logs.
    UpdateChannel' -> Maybe LogLevel
logLevel :: Prelude.Maybe LogLevel,
    -- | Maintenance settings for this channel.
    UpdateChannel' -> Maybe MaintenanceUpdateSettings
maintenance :: Prelude.Maybe MaintenanceUpdateSettings,
    -- | The name of the channel.
    UpdateChannel' -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | An optional Amazon Resource Name (ARN) of the role to assume when
    -- running the Channel. If you do not specify this on an update call but
    -- the role was previously set that role will be removed.
    UpdateChannel' -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | channel ID
    UpdateChannel' -> Text
channelId :: Prelude.Text
  }
  deriving (UpdateChannel' -> UpdateChannel' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateChannel' -> UpdateChannel' -> Bool
$c/= :: UpdateChannel' -> UpdateChannel' -> Bool
== :: UpdateChannel' -> UpdateChannel' -> Bool
$c== :: UpdateChannel' -> UpdateChannel' -> Bool
Prelude.Eq, ReadPrec [UpdateChannel']
ReadPrec UpdateChannel'
Int -> ReadS UpdateChannel'
ReadS [UpdateChannel']
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateChannel']
$creadListPrec :: ReadPrec [UpdateChannel']
readPrec :: ReadPrec UpdateChannel'
$creadPrec :: ReadPrec UpdateChannel'
readList :: ReadS [UpdateChannel']
$creadList :: ReadS [UpdateChannel']
readsPrec :: Int -> ReadS UpdateChannel'
$creadsPrec :: Int -> ReadS UpdateChannel'
Prelude.Read, Int -> UpdateChannel' -> ShowS
[UpdateChannel'] -> ShowS
UpdateChannel' -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateChannel'] -> ShowS
$cshowList :: [UpdateChannel'] -> ShowS
show :: UpdateChannel' -> String
$cshow :: UpdateChannel' -> String
showsPrec :: Int -> UpdateChannel' -> ShowS
$cshowsPrec :: Int -> UpdateChannel' -> ShowS
Prelude.Show, forall x. Rep UpdateChannel' x -> UpdateChannel'
forall x. UpdateChannel' -> Rep UpdateChannel' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateChannel' x -> UpdateChannel'
$cfrom :: forall x. UpdateChannel' -> Rep UpdateChannel' x
Prelude.Generic)

-- |
-- Create a value of 'UpdateChannel'' 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', 'updateChannel'_cdiInputSpecification' - Specification of CDI inputs for this channel
--
-- 'destinations', 'updateChannel'_destinations' - A list of output destinations for this channel.
--
-- 'encoderSettings', 'updateChannel'_encoderSettings' - The encoder settings for this channel.
--
-- 'inputAttachments', 'updateChannel'_inputAttachments' - Undocumented member.
--
-- 'inputSpecification', 'updateChannel'_inputSpecification' - Specification of network and file inputs for this channel
--
-- 'logLevel', 'updateChannel'_logLevel' - The log level to write to CloudWatch Logs.
--
-- 'maintenance', 'updateChannel'_maintenance' - Maintenance settings for this channel.
--
-- 'name', 'updateChannel'_name' - The name of the channel.
--
-- 'roleArn', 'updateChannel'_roleArn' - An optional Amazon Resource Name (ARN) of the role to assume when
-- running the Channel. If you do not specify this on an update call but
-- the role was previously set that role will be removed.
--
-- 'channelId', 'updateChannel'_channelId' - channel ID
newUpdateChannel' ::
  -- | 'channelId'
  Prelude.Text ->
  UpdateChannel'
newUpdateChannel' :: Text -> UpdateChannel'
newUpdateChannel' Text
pChannelId_ =
  UpdateChannel''
    { $sel:cdiInputSpecification:UpdateChannel'' :: Maybe CdiInputSpecification
cdiInputSpecification =
        forall a. Maybe a
Prelude.Nothing,
      $sel:destinations:UpdateChannel'' :: Maybe [OutputDestination]
destinations = forall a. Maybe a
Prelude.Nothing,
      $sel:encoderSettings:UpdateChannel'' :: Maybe EncoderSettings
encoderSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:inputAttachments:UpdateChannel'' :: Maybe [InputAttachment]
inputAttachments = forall a. Maybe a
Prelude.Nothing,
      $sel:inputSpecification:UpdateChannel'' :: Maybe InputSpecification
inputSpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:logLevel:UpdateChannel'' :: Maybe LogLevel
logLevel = forall a. Maybe a
Prelude.Nothing,
      $sel:maintenance:UpdateChannel'' :: Maybe MaintenanceUpdateSettings
maintenance = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateChannel'' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:UpdateChannel'' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:channelId:UpdateChannel'' :: Text
channelId = Text
pChannelId_
    }

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

-- | A list of output destinations for this channel.
updateChannel'_destinations :: Lens.Lens' UpdateChannel' (Prelude.Maybe [OutputDestination])
updateChannel'_destinations :: Lens' UpdateChannel' (Maybe [OutputDestination])
updateChannel'_destinations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannel'' {Maybe [OutputDestination]
destinations :: Maybe [OutputDestination]
$sel:destinations:UpdateChannel'' :: UpdateChannel' -> Maybe [OutputDestination]
destinations} -> Maybe [OutputDestination]
destinations) (\s :: UpdateChannel'
s@UpdateChannel'' {} Maybe [OutputDestination]
a -> UpdateChannel'
s {$sel:destinations:UpdateChannel'' :: Maybe [OutputDestination]
destinations = Maybe [OutputDestination]
a} :: UpdateChannel') 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 encoder settings for this channel.
updateChannel'_encoderSettings :: Lens.Lens' UpdateChannel' (Prelude.Maybe EncoderSettings)
updateChannel'_encoderSettings :: Lens' UpdateChannel' (Maybe EncoderSettings)
updateChannel'_encoderSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannel'' {Maybe EncoderSettings
encoderSettings :: Maybe EncoderSettings
$sel:encoderSettings:UpdateChannel'' :: UpdateChannel' -> Maybe EncoderSettings
encoderSettings} -> Maybe EncoderSettings
encoderSettings) (\s :: UpdateChannel'
s@UpdateChannel'' {} Maybe EncoderSettings
a -> UpdateChannel'
s {$sel:encoderSettings:UpdateChannel'' :: Maybe EncoderSettings
encoderSettings = Maybe EncoderSettings
a} :: UpdateChannel')

-- | Undocumented member.
updateChannel'_inputAttachments :: Lens.Lens' UpdateChannel' (Prelude.Maybe [InputAttachment])
updateChannel'_inputAttachments :: Lens' UpdateChannel' (Maybe [InputAttachment])
updateChannel'_inputAttachments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannel'' {Maybe [InputAttachment]
inputAttachments :: Maybe [InputAttachment]
$sel:inputAttachments:UpdateChannel'' :: UpdateChannel' -> Maybe [InputAttachment]
inputAttachments} -> Maybe [InputAttachment]
inputAttachments) (\s :: UpdateChannel'
s@UpdateChannel'' {} Maybe [InputAttachment]
a -> UpdateChannel'
s {$sel:inputAttachments:UpdateChannel'' :: Maybe [InputAttachment]
inputAttachments = Maybe [InputAttachment]
a} :: UpdateChannel') 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
updateChannel'_inputSpecification :: Lens.Lens' UpdateChannel' (Prelude.Maybe InputSpecification)
updateChannel'_inputSpecification :: Lens' UpdateChannel' (Maybe InputSpecification)
updateChannel'_inputSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannel'' {Maybe InputSpecification
inputSpecification :: Maybe InputSpecification
$sel:inputSpecification:UpdateChannel'' :: UpdateChannel' -> Maybe InputSpecification
inputSpecification} -> Maybe InputSpecification
inputSpecification) (\s :: UpdateChannel'
s@UpdateChannel'' {} Maybe InputSpecification
a -> UpdateChannel'
s {$sel:inputSpecification:UpdateChannel'' :: Maybe InputSpecification
inputSpecification = Maybe InputSpecification
a} :: UpdateChannel')

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

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

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

-- | An optional Amazon Resource Name (ARN) of the role to assume when
-- running the Channel. If you do not specify this on an update call but
-- the role was previously set that role will be removed.
updateChannel'_roleArn :: Lens.Lens' UpdateChannel' (Prelude.Maybe Prelude.Text)
updateChannel'_roleArn :: Lens' UpdateChannel' (Maybe Text)
updateChannel'_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannel'' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:UpdateChannel'' :: UpdateChannel' -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: UpdateChannel'
s@UpdateChannel'' {} Maybe Text
a -> UpdateChannel'
s {$sel:roleArn:UpdateChannel'' :: Maybe Text
roleArn = Maybe Text
a} :: UpdateChannel')

-- | channel ID
updateChannel'_channelId :: Lens.Lens' UpdateChannel' Prelude.Text
updateChannel'_channelId :: Lens' UpdateChannel' Text
updateChannel'_channelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannel'' {Text
channelId :: Text
$sel:channelId:UpdateChannel'' :: UpdateChannel' -> Text
channelId} -> Text
channelId) (\s :: UpdateChannel'
s@UpdateChannel'' {} Text
a -> UpdateChannel'
s {$sel:channelId:UpdateChannel'' :: Text
channelId = Text
a} :: UpdateChannel')

instance Core.AWSRequest UpdateChannel' where
  type
    AWSResponse UpdateChannel' =
      UpdateChannelResponse
  request :: (Service -> Service) -> UpdateChannel' -> Request UpdateChannel'
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateChannel'
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateChannel')))
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 -> UpdateChannelResponse
UpdateChannelResponse'
            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 UpdateChannel' where
  hashWithSalt :: Int -> UpdateChannel' -> Int
hashWithSalt Int
_salt UpdateChannel'' {Maybe [OutputDestination]
Maybe [InputAttachment]
Maybe Text
Maybe CdiInputSpecification
Maybe InputSpecification
Maybe LogLevel
Maybe MaintenanceUpdateSettings
Maybe EncoderSettings
Text
channelId :: Text
roleArn :: Maybe Text
name :: Maybe Text
maintenance :: Maybe MaintenanceUpdateSettings
logLevel :: Maybe LogLevel
inputSpecification :: Maybe InputSpecification
inputAttachments :: Maybe [InputAttachment]
encoderSettings :: Maybe EncoderSettings
destinations :: Maybe [OutputDestination]
cdiInputSpecification :: Maybe CdiInputSpecification
$sel:channelId:UpdateChannel'' :: UpdateChannel' -> Text
$sel:roleArn:UpdateChannel'' :: UpdateChannel' -> Maybe Text
$sel:name:UpdateChannel'' :: UpdateChannel' -> Maybe Text
$sel:maintenance:UpdateChannel'' :: UpdateChannel' -> Maybe MaintenanceUpdateSettings
$sel:logLevel:UpdateChannel'' :: UpdateChannel' -> Maybe LogLevel
$sel:inputSpecification:UpdateChannel'' :: UpdateChannel' -> Maybe InputSpecification
$sel:inputAttachments:UpdateChannel'' :: UpdateChannel' -> Maybe [InputAttachment]
$sel:encoderSettings:UpdateChannel'' :: UpdateChannel' -> Maybe EncoderSettings
$sel:destinations:UpdateChannel'' :: UpdateChannel' -> Maybe [OutputDestination]
$sel:cdiInputSpecification:UpdateChannel'' :: UpdateChannel' -> 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 [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 MaintenanceUpdateSettings
maintenance
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelId

instance Prelude.NFData UpdateChannel' where
  rnf :: UpdateChannel' -> ()
rnf UpdateChannel'' {Maybe [OutputDestination]
Maybe [InputAttachment]
Maybe Text
Maybe CdiInputSpecification
Maybe InputSpecification
Maybe LogLevel
Maybe MaintenanceUpdateSettings
Maybe EncoderSettings
Text
channelId :: Text
roleArn :: Maybe Text
name :: Maybe Text
maintenance :: Maybe MaintenanceUpdateSettings
logLevel :: Maybe LogLevel
inputSpecification :: Maybe InputSpecification
inputAttachments :: Maybe [InputAttachment]
encoderSettings :: Maybe EncoderSettings
destinations :: Maybe [OutputDestination]
cdiInputSpecification :: Maybe CdiInputSpecification
$sel:channelId:UpdateChannel'' :: UpdateChannel' -> Text
$sel:roleArn:UpdateChannel'' :: UpdateChannel' -> Maybe Text
$sel:name:UpdateChannel'' :: UpdateChannel' -> Maybe Text
$sel:maintenance:UpdateChannel'' :: UpdateChannel' -> Maybe MaintenanceUpdateSettings
$sel:logLevel:UpdateChannel'' :: UpdateChannel' -> Maybe LogLevel
$sel:inputSpecification:UpdateChannel'' :: UpdateChannel' -> Maybe InputSpecification
$sel:inputAttachments:UpdateChannel'' :: UpdateChannel' -> Maybe [InputAttachment]
$sel:encoderSettings:UpdateChannel'' :: UpdateChannel' -> Maybe EncoderSettings
$sel:destinations:UpdateChannel'' :: UpdateChannel' -> Maybe [OutputDestination]
$sel:cdiInputSpecification:UpdateChannel'' :: UpdateChannel' -> 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 [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 MaintenanceUpdateSettings
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
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
channelId

instance Data.ToHeaders UpdateChannel' where
  toHeaders :: UpdateChannel' -> 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 UpdateChannel' where
  toJSON :: UpdateChannel' -> Value
toJSON UpdateChannel'' {Maybe [OutputDestination]
Maybe [InputAttachment]
Maybe Text
Maybe CdiInputSpecification
Maybe InputSpecification
Maybe LogLevel
Maybe MaintenanceUpdateSettings
Maybe EncoderSettings
Text
channelId :: Text
roleArn :: Maybe Text
name :: Maybe Text
maintenance :: Maybe MaintenanceUpdateSettings
logLevel :: Maybe LogLevel
inputSpecification :: Maybe InputSpecification
inputAttachments :: Maybe [InputAttachment]
encoderSettings :: Maybe EncoderSettings
destinations :: Maybe [OutputDestination]
cdiInputSpecification :: Maybe CdiInputSpecification
$sel:channelId:UpdateChannel'' :: UpdateChannel' -> Text
$sel:roleArn:UpdateChannel'' :: UpdateChannel' -> Maybe Text
$sel:name:UpdateChannel'' :: UpdateChannel' -> Maybe Text
$sel:maintenance:UpdateChannel'' :: UpdateChannel' -> Maybe MaintenanceUpdateSettings
$sel:logLevel:UpdateChannel'' :: UpdateChannel' -> Maybe LogLevel
$sel:inputSpecification:UpdateChannel'' :: UpdateChannel' -> Maybe InputSpecification
$sel:inputAttachments:UpdateChannel'' :: UpdateChannel' -> Maybe [InputAttachment]
$sel:encoderSettings:UpdateChannel'' :: UpdateChannel' -> Maybe EncoderSettings
$sel:destinations:UpdateChannel'' :: UpdateChannel' -> Maybe [OutputDestination]
$sel:cdiInputSpecification:UpdateChannel'' :: UpdateChannel' -> 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
"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 MaintenanceUpdateSettings
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
"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
          ]
      )

instance Data.ToPath UpdateChannel' where
  toPath :: UpdateChannel' -> ByteString
toPath UpdateChannel'' {Maybe [OutputDestination]
Maybe [InputAttachment]
Maybe Text
Maybe CdiInputSpecification
Maybe InputSpecification
Maybe LogLevel
Maybe MaintenanceUpdateSettings
Maybe EncoderSettings
Text
channelId :: Text
roleArn :: Maybe Text
name :: Maybe Text
maintenance :: Maybe MaintenanceUpdateSettings
logLevel :: Maybe LogLevel
inputSpecification :: Maybe InputSpecification
inputAttachments :: Maybe [InputAttachment]
encoderSettings :: Maybe EncoderSettings
destinations :: Maybe [OutputDestination]
cdiInputSpecification :: Maybe CdiInputSpecification
$sel:channelId:UpdateChannel'' :: UpdateChannel' -> Text
$sel:roleArn:UpdateChannel'' :: UpdateChannel' -> Maybe Text
$sel:name:UpdateChannel'' :: UpdateChannel' -> Maybe Text
$sel:maintenance:UpdateChannel'' :: UpdateChannel' -> Maybe MaintenanceUpdateSettings
$sel:logLevel:UpdateChannel'' :: UpdateChannel' -> Maybe LogLevel
$sel:inputSpecification:UpdateChannel'' :: UpdateChannel' -> Maybe InputSpecification
$sel:inputAttachments:UpdateChannel'' :: UpdateChannel' -> Maybe [InputAttachment]
$sel:encoderSettings:UpdateChannel'' :: UpdateChannel' -> Maybe EncoderSettings
$sel:destinations:UpdateChannel'' :: UpdateChannel' -> Maybe [OutputDestination]
$sel:cdiInputSpecification:UpdateChannel'' :: UpdateChannel' -> Maybe CdiInputSpecification
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/prod/channels/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
channelId]

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

-- | Placeholder documentation for UpdateChannelResponse
--
-- /See:/ 'newUpdateChannelResponse' smart constructor.
data UpdateChannelResponse = UpdateChannelResponse'
  { UpdateChannelResponse -> Maybe Channel
channel :: Prelude.Maybe Channel,
    -- | The response's http status code.
    UpdateChannelResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateChannelResponse -> UpdateChannelResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateChannelResponse -> UpdateChannelResponse -> Bool
$c/= :: UpdateChannelResponse -> UpdateChannelResponse -> Bool
== :: UpdateChannelResponse -> UpdateChannelResponse -> Bool
$c== :: UpdateChannelResponse -> UpdateChannelResponse -> Bool
Prelude.Eq, ReadPrec [UpdateChannelResponse]
ReadPrec UpdateChannelResponse
Int -> ReadS UpdateChannelResponse
ReadS [UpdateChannelResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateChannelResponse]
$creadListPrec :: ReadPrec [UpdateChannelResponse]
readPrec :: ReadPrec UpdateChannelResponse
$creadPrec :: ReadPrec UpdateChannelResponse
readList :: ReadS [UpdateChannelResponse]
$creadList :: ReadS [UpdateChannelResponse]
readsPrec :: Int -> ReadS UpdateChannelResponse
$creadsPrec :: Int -> ReadS UpdateChannelResponse
Prelude.Read, Int -> UpdateChannelResponse -> ShowS
[UpdateChannelResponse] -> ShowS
UpdateChannelResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateChannelResponse] -> ShowS
$cshowList :: [UpdateChannelResponse] -> ShowS
show :: UpdateChannelResponse -> String
$cshow :: UpdateChannelResponse -> String
showsPrec :: Int -> UpdateChannelResponse -> ShowS
$cshowsPrec :: Int -> UpdateChannelResponse -> ShowS
Prelude.Show, forall x. Rep UpdateChannelResponse x -> UpdateChannelResponse
forall x. UpdateChannelResponse -> Rep UpdateChannelResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateChannelResponse x -> UpdateChannelResponse
$cfrom :: forall x. UpdateChannelResponse -> Rep UpdateChannelResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateChannelResponse' 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', 'updateChannelResponse_channel' - Undocumented member.
--
-- 'httpStatus', 'updateChannelResponse_httpStatus' - The response's http status code.
newUpdateChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateChannelResponse
newUpdateChannelResponse :: Int -> UpdateChannelResponse
newUpdateChannelResponse Int
pHttpStatus_ =
  UpdateChannelResponse'
    { $sel:channel:UpdateChannelResponse' :: Maybe Channel
channel = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateChannelResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
updateChannelResponse_channel :: Lens.Lens' UpdateChannelResponse (Prelude.Maybe Channel)
updateChannelResponse_channel :: Lens' UpdateChannelResponse (Maybe Channel)
updateChannelResponse_channel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannelResponse' {Maybe Channel
channel :: Maybe Channel
$sel:channel:UpdateChannelResponse' :: UpdateChannelResponse -> Maybe Channel
channel} -> Maybe Channel
channel) (\s :: UpdateChannelResponse
s@UpdateChannelResponse' {} Maybe Channel
a -> UpdateChannelResponse
s {$sel:channel:UpdateChannelResponse' :: Maybe Channel
channel = Maybe Channel
a} :: UpdateChannelResponse)

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

instance Prelude.NFData UpdateChannelResponse where
  rnf :: UpdateChannelResponse -> ()
rnf UpdateChannelResponse' {Int
Maybe Channel
httpStatus :: Int
channel :: Maybe Channel
$sel:httpStatus:UpdateChannelResponse' :: UpdateChannelResponse -> Int
$sel:channel:UpdateChannelResponse' :: UpdateChannelResponse -> 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