{-# 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.IVS.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\'s configuration. This does not affect an ongoing
-- stream of this channel. You must stop and restart the stream for the
-- changes to take effect.
module Amazonka.IVS.UpdateChannel
  ( -- * Creating a Request
    UpdateChannel (..),
    newUpdateChannel,

    -- * Request Lenses
    updateChannel_authorized,
    updateChannel_latencyMode,
    updateChannel_name,
    updateChannel_recordingConfigurationArn,
    updateChannel_type,
    updateChannel_arn,

    -- * 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.IVS.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateChannel' smart constructor.
data UpdateChannel = UpdateChannel'
  { -- | Whether the channel is private (enabled for playback authorization).
    UpdateChannel -> Maybe Bool
authorized :: Prelude.Maybe Prelude.Bool,
    -- | Channel latency mode. Use @NORMAL@ to broadcast and deliver live video
    -- up to Full HD. Use @LOW@ for near-real-time interaction with viewers.
    -- (Note: In the Amazon IVS console, @LOW@ and @NORMAL@ correspond to
    -- Ultra-low and Standard, respectively.)
    UpdateChannel -> Maybe ChannelLatencyMode
latencyMode :: Prelude.Maybe ChannelLatencyMode,
    -- | Channel name.
    UpdateChannel -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Recording-configuration ARN. If this is set to an empty string,
    -- recording is disabled. A value other than an empty string indicates that
    -- recording is enabled
    UpdateChannel -> Maybe Text
recordingConfigurationArn :: Prelude.Maybe Prelude.Text,
    -- | Channel type, which determines the allowable resolution and bitrate. /If
    -- you exceed the allowable resolution or bitrate, the stream probably will
    -- disconnect immediately/. Valid values:
    --
    -- -   @STANDARD@: Video is transcoded: multiple qualities are generated
    --     from the original input, to automatically give viewers the best
    --     experience for their devices and network conditions. Transcoding
    --     allows higher playback quality across a range of download speeds.
    --     Resolution can be up to 1080p and bitrate can be up to 8.5 Mbps.
    --     Audio is transcoded only for renditions 360p and below; above that,
    --     audio is passed through. This is the default.
    --
    -- -   @BASIC@: Video is transmuxed: Amazon IVS delivers the original input
    --     to viewers. The viewer’s video-quality choice is limited to the
    --     original input. Resolution can be up to 1080p and bitrate can be up
    --     to 1.5 Mbps for 480p and up to 3.5 Mbps for resolutions between 480p
    --     and 1080p.
    UpdateChannel -> Maybe ChannelType
type' :: Prelude.Maybe ChannelType,
    -- | ARN of the channel to be updated.
    UpdateChannel -> Text
arn :: 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:
--
-- 'authorized', 'updateChannel_authorized' - Whether the channel is private (enabled for playback authorization).
--
-- 'latencyMode', 'updateChannel_latencyMode' - Channel latency mode. Use @NORMAL@ to broadcast and deliver live video
-- up to Full HD. Use @LOW@ for near-real-time interaction with viewers.
-- (Note: In the Amazon IVS console, @LOW@ and @NORMAL@ correspond to
-- Ultra-low and Standard, respectively.)
--
-- 'name', 'updateChannel_name' - Channel name.
--
-- 'recordingConfigurationArn', 'updateChannel_recordingConfigurationArn' - Recording-configuration ARN. If this is set to an empty string,
-- recording is disabled. A value other than an empty string indicates that
-- recording is enabled
--
-- 'type'', 'updateChannel_type' - Channel type, which determines the allowable resolution and bitrate. /If
-- you exceed the allowable resolution or bitrate, the stream probably will
-- disconnect immediately/. Valid values:
--
-- -   @STANDARD@: Video is transcoded: multiple qualities are generated
--     from the original input, to automatically give viewers the best
--     experience for their devices and network conditions. Transcoding
--     allows higher playback quality across a range of download speeds.
--     Resolution can be up to 1080p and bitrate can be up to 8.5 Mbps.
--     Audio is transcoded only for renditions 360p and below; above that,
--     audio is passed through. This is the default.
--
-- -   @BASIC@: Video is transmuxed: Amazon IVS delivers the original input
--     to viewers. The viewer’s video-quality choice is limited to the
--     original input. Resolution can be up to 1080p and bitrate can be up
--     to 1.5 Mbps for 480p and up to 3.5 Mbps for resolutions between 480p
--     and 1080p.
--
-- 'arn', 'updateChannel_arn' - ARN of the channel to be updated.
newUpdateChannel ::
  -- | 'arn'
  Prelude.Text ->
  UpdateChannel
newUpdateChannel :: Text -> UpdateChannel
newUpdateChannel Text
pArn_ =
  UpdateChannel'
    { $sel:authorized:UpdateChannel' :: Maybe Bool
authorized = forall a. Maybe a
Prelude.Nothing,
      $sel:latencyMode:UpdateChannel' :: Maybe ChannelLatencyMode
latencyMode = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateChannel' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:recordingConfigurationArn:UpdateChannel' :: Maybe Text
recordingConfigurationArn = forall a. Maybe a
Prelude.Nothing,
      $sel:type':UpdateChannel' :: Maybe ChannelType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:UpdateChannel' :: Text
arn = Text
pArn_
    }

-- | Whether the channel is private (enabled for playback authorization).
updateChannel_authorized :: Lens.Lens' UpdateChannel (Prelude.Maybe Prelude.Bool)
updateChannel_authorized :: Lens' UpdateChannel (Maybe Bool)
updateChannel_authorized = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannel' {Maybe Bool
authorized :: Maybe Bool
$sel:authorized:UpdateChannel' :: UpdateChannel -> Maybe Bool
authorized} -> Maybe Bool
authorized) (\s :: UpdateChannel
s@UpdateChannel' {} Maybe Bool
a -> UpdateChannel
s {$sel:authorized:UpdateChannel' :: Maybe Bool
authorized = Maybe Bool
a} :: UpdateChannel)

-- | Channel latency mode. Use @NORMAL@ to broadcast and deliver live video
-- up to Full HD. Use @LOW@ for near-real-time interaction with viewers.
-- (Note: In the Amazon IVS console, @LOW@ and @NORMAL@ correspond to
-- Ultra-low and Standard, respectively.)
updateChannel_latencyMode :: Lens.Lens' UpdateChannel (Prelude.Maybe ChannelLatencyMode)
updateChannel_latencyMode :: Lens' UpdateChannel (Maybe ChannelLatencyMode)
updateChannel_latencyMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannel' {Maybe ChannelLatencyMode
latencyMode :: Maybe ChannelLatencyMode
$sel:latencyMode:UpdateChannel' :: UpdateChannel -> Maybe ChannelLatencyMode
latencyMode} -> Maybe ChannelLatencyMode
latencyMode) (\s :: UpdateChannel
s@UpdateChannel' {} Maybe ChannelLatencyMode
a -> UpdateChannel
s {$sel:latencyMode:UpdateChannel' :: Maybe ChannelLatencyMode
latencyMode = Maybe ChannelLatencyMode
a} :: UpdateChannel)

-- | Channel name.
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)

-- | Recording-configuration ARN. If this is set to an empty string,
-- recording is disabled. A value other than an empty string indicates that
-- recording is enabled
updateChannel_recordingConfigurationArn :: Lens.Lens' UpdateChannel (Prelude.Maybe Prelude.Text)
updateChannel_recordingConfigurationArn :: Lens' UpdateChannel (Maybe Text)
updateChannel_recordingConfigurationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannel' {Maybe Text
recordingConfigurationArn :: Maybe Text
$sel:recordingConfigurationArn:UpdateChannel' :: UpdateChannel -> Maybe Text
recordingConfigurationArn} -> Maybe Text
recordingConfigurationArn) (\s :: UpdateChannel
s@UpdateChannel' {} Maybe Text
a -> UpdateChannel
s {$sel:recordingConfigurationArn:UpdateChannel' :: Maybe Text
recordingConfigurationArn = Maybe Text
a} :: UpdateChannel)

-- | Channel type, which determines the allowable resolution and bitrate. /If
-- you exceed the allowable resolution or bitrate, the stream probably will
-- disconnect immediately/. Valid values:
--
-- -   @STANDARD@: Video is transcoded: multiple qualities are generated
--     from the original input, to automatically give viewers the best
--     experience for their devices and network conditions. Transcoding
--     allows higher playback quality across a range of download speeds.
--     Resolution can be up to 1080p and bitrate can be up to 8.5 Mbps.
--     Audio is transcoded only for renditions 360p and below; above that,
--     audio is passed through. This is the default.
--
-- -   @BASIC@: Video is transmuxed: Amazon IVS delivers the original input
--     to viewers. The viewer’s video-quality choice is limited to the
--     original input. Resolution can be up to 1080p and bitrate can be up
--     to 1.5 Mbps for 480p and up to 3.5 Mbps for resolutions between 480p
--     and 1080p.
updateChannel_type :: Lens.Lens' UpdateChannel (Prelude.Maybe ChannelType)
updateChannel_type :: Lens' UpdateChannel (Maybe ChannelType)
updateChannel_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannel' {Maybe ChannelType
type' :: Maybe ChannelType
$sel:type':UpdateChannel' :: UpdateChannel -> Maybe ChannelType
type'} -> Maybe ChannelType
type') (\s :: UpdateChannel
s@UpdateChannel' {} Maybe ChannelType
a -> UpdateChannel
s {$sel:type':UpdateChannel' :: Maybe ChannelType
type' = Maybe ChannelType
a} :: UpdateChannel)

-- | ARN of the channel to be updated.
updateChannel_arn :: Lens.Lens' UpdateChannel Prelude.Text
updateChannel_arn :: Lens' UpdateChannel Text
updateChannel_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateChannel' {Text
arn :: Text
$sel:arn:UpdateChannel' :: UpdateChannel -> Text
arn} -> Text
arn) (\s :: UpdateChannel
s@UpdateChannel' {} Text
a -> UpdateChannel
s {$sel:arn:UpdateChannel' :: Text
arn = 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.postJSON (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 Bool
Maybe Text
Maybe ChannelLatencyMode
Maybe ChannelType
Text
arn :: Text
type' :: Maybe ChannelType
recordingConfigurationArn :: Maybe Text
name :: Maybe Text
latencyMode :: Maybe ChannelLatencyMode
authorized :: Maybe Bool
$sel:arn:UpdateChannel' :: UpdateChannel -> Text
$sel:type':UpdateChannel' :: UpdateChannel -> Maybe ChannelType
$sel:recordingConfigurationArn:UpdateChannel' :: UpdateChannel -> Maybe Text
$sel:name:UpdateChannel' :: UpdateChannel -> Maybe Text
$sel:latencyMode:UpdateChannel' :: UpdateChannel -> Maybe ChannelLatencyMode
$sel:authorized:UpdateChannel' :: UpdateChannel -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
authorized
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChannelLatencyMode
latencyMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
recordingConfigurationArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChannelType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

instance Prelude.NFData UpdateChannel where
  rnf :: UpdateChannel -> ()
rnf UpdateChannel' {Maybe Bool
Maybe Text
Maybe ChannelLatencyMode
Maybe ChannelType
Text
arn :: Text
type' :: Maybe ChannelType
recordingConfigurationArn :: Maybe Text
name :: Maybe Text
latencyMode :: Maybe ChannelLatencyMode
authorized :: Maybe Bool
$sel:arn:UpdateChannel' :: UpdateChannel -> Text
$sel:type':UpdateChannel' :: UpdateChannel -> Maybe ChannelType
$sel:recordingConfigurationArn:UpdateChannel' :: UpdateChannel -> Maybe Text
$sel:name:UpdateChannel' :: UpdateChannel -> Maybe Text
$sel:latencyMode:UpdateChannel' :: UpdateChannel -> Maybe ChannelLatencyMode
$sel:authorized:UpdateChannel' :: UpdateChannel -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
authorized
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelLatencyMode
latencyMode
      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
recordingConfigurationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn

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 Bool
Maybe Text
Maybe ChannelLatencyMode
Maybe ChannelType
Text
arn :: Text
type' :: Maybe ChannelType
recordingConfigurationArn :: Maybe Text
name :: Maybe Text
latencyMode :: Maybe ChannelLatencyMode
authorized :: Maybe Bool
$sel:arn:UpdateChannel' :: UpdateChannel -> Text
$sel:type':UpdateChannel' :: UpdateChannel -> Maybe ChannelType
$sel:recordingConfigurationArn:UpdateChannel' :: UpdateChannel -> Maybe Text
$sel:name:UpdateChannel' :: UpdateChannel -> Maybe Text
$sel:latencyMode:UpdateChannel' :: UpdateChannel -> Maybe ChannelLatencyMode
$sel:authorized:UpdateChannel' :: UpdateChannel -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"authorized" 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 Bool
authorized,
            (Key
"latencyMode" 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 ChannelLatencyMode
latencyMode,
            (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
"recordingConfigurationArn" 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
recordingConfigurationArn,
            (Key
"type" 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 ChannelType
type',
            forall a. a -> Maybe a
Prelude.Just (Key
"arn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
arn)
          ]
      )

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

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

-- | /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