{-# 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.DeleteMultiplexProgram
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Delete a program from a multiplex.
module Amazonka.MediaLive.DeleteMultiplexProgram
  ( -- * Creating a Request
    DeleteMultiplexProgram (..),
    newDeleteMultiplexProgram,

    -- * Request Lenses
    deleteMultiplexProgram_multiplexId,
    deleteMultiplexProgram_programName,

    -- * Destructuring the Response
    DeleteMultiplexProgramResponse (..),
    newDeleteMultiplexProgramResponse,

    -- * Response Lenses
    deleteMultiplexProgramResponse_channelId,
    deleteMultiplexProgramResponse_multiplexProgramSettings,
    deleteMultiplexProgramResponse_packetIdentifiersMap,
    deleteMultiplexProgramResponse_pipelineDetails,
    deleteMultiplexProgramResponse_programName,
    deleteMultiplexProgramResponse_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

-- | Placeholder documentation for DeleteMultiplexProgramRequest
--
-- /See:/ 'newDeleteMultiplexProgram' smart constructor.
data DeleteMultiplexProgram = DeleteMultiplexProgram'
  { -- | The ID of the multiplex that the program belongs to.
    DeleteMultiplexProgram -> Text
multiplexId :: Prelude.Text,
    -- | The multiplex program name.
    DeleteMultiplexProgram -> Text
programName :: Prelude.Text
  }
  deriving (DeleteMultiplexProgram -> DeleteMultiplexProgram -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteMultiplexProgram -> DeleteMultiplexProgram -> Bool
$c/= :: DeleteMultiplexProgram -> DeleteMultiplexProgram -> Bool
== :: DeleteMultiplexProgram -> DeleteMultiplexProgram -> Bool
$c== :: DeleteMultiplexProgram -> DeleteMultiplexProgram -> Bool
Prelude.Eq, ReadPrec [DeleteMultiplexProgram]
ReadPrec DeleteMultiplexProgram
Int -> ReadS DeleteMultiplexProgram
ReadS [DeleteMultiplexProgram]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteMultiplexProgram]
$creadListPrec :: ReadPrec [DeleteMultiplexProgram]
readPrec :: ReadPrec DeleteMultiplexProgram
$creadPrec :: ReadPrec DeleteMultiplexProgram
readList :: ReadS [DeleteMultiplexProgram]
$creadList :: ReadS [DeleteMultiplexProgram]
readsPrec :: Int -> ReadS DeleteMultiplexProgram
$creadsPrec :: Int -> ReadS DeleteMultiplexProgram
Prelude.Read, Int -> DeleteMultiplexProgram -> ShowS
[DeleteMultiplexProgram] -> ShowS
DeleteMultiplexProgram -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteMultiplexProgram] -> ShowS
$cshowList :: [DeleteMultiplexProgram] -> ShowS
show :: DeleteMultiplexProgram -> String
$cshow :: DeleteMultiplexProgram -> String
showsPrec :: Int -> DeleteMultiplexProgram -> ShowS
$cshowsPrec :: Int -> DeleteMultiplexProgram -> ShowS
Prelude.Show, forall x. Rep DeleteMultiplexProgram x -> DeleteMultiplexProgram
forall x. DeleteMultiplexProgram -> Rep DeleteMultiplexProgram x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteMultiplexProgram x -> DeleteMultiplexProgram
$cfrom :: forall x. DeleteMultiplexProgram -> Rep DeleteMultiplexProgram x
Prelude.Generic)

-- |
-- Create a value of 'DeleteMultiplexProgram' 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:
--
-- 'multiplexId', 'deleteMultiplexProgram_multiplexId' - The ID of the multiplex that the program belongs to.
--
-- 'programName', 'deleteMultiplexProgram_programName' - The multiplex program name.
newDeleteMultiplexProgram ::
  -- | 'multiplexId'
  Prelude.Text ->
  -- | 'programName'
  Prelude.Text ->
  DeleteMultiplexProgram
newDeleteMultiplexProgram :: Text -> Text -> DeleteMultiplexProgram
newDeleteMultiplexProgram Text
pMultiplexId_ Text
pProgramName_ =
  DeleteMultiplexProgram'
    { $sel:multiplexId:DeleteMultiplexProgram' :: Text
multiplexId =
        Text
pMultiplexId_,
      $sel:programName:DeleteMultiplexProgram' :: Text
programName = Text
pProgramName_
    }

-- | The ID of the multiplex that the program belongs to.
deleteMultiplexProgram_multiplexId :: Lens.Lens' DeleteMultiplexProgram Prelude.Text
deleteMultiplexProgram_multiplexId :: Lens' DeleteMultiplexProgram Text
deleteMultiplexProgram_multiplexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteMultiplexProgram' {Text
multiplexId :: Text
$sel:multiplexId:DeleteMultiplexProgram' :: DeleteMultiplexProgram -> Text
multiplexId} -> Text
multiplexId) (\s :: DeleteMultiplexProgram
s@DeleteMultiplexProgram' {} Text
a -> DeleteMultiplexProgram
s {$sel:multiplexId:DeleteMultiplexProgram' :: Text
multiplexId = Text
a} :: DeleteMultiplexProgram)

-- | The multiplex program name.
deleteMultiplexProgram_programName :: Lens.Lens' DeleteMultiplexProgram Prelude.Text
deleteMultiplexProgram_programName :: Lens' DeleteMultiplexProgram Text
deleteMultiplexProgram_programName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteMultiplexProgram' {Text
programName :: Text
$sel:programName:DeleteMultiplexProgram' :: DeleteMultiplexProgram -> Text
programName} -> Text
programName) (\s :: DeleteMultiplexProgram
s@DeleteMultiplexProgram' {} Text
a -> DeleteMultiplexProgram
s {$sel:programName:DeleteMultiplexProgram' :: Text
programName = Text
a} :: DeleteMultiplexProgram)

instance Core.AWSRequest DeleteMultiplexProgram where
  type
    AWSResponse DeleteMultiplexProgram =
      DeleteMultiplexProgramResponse
  request :: (Service -> Service)
-> DeleteMultiplexProgram -> Request DeleteMultiplexProgram
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteMultiplexProgram
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteMultiplexProgram)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe MultiplexProgramSettings
-> Maybe MultiplexProgramPacketIdentifiersMap
-> Maybe [MultiplexProgramPipelineDetail]
-> Maybe Text
-> Int
-> DeleteMultiplexProgramResponse
DeleteMultiplexProgramResponse'
            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
"channelId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"multiplexProgramSettings")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"packetIdentifiersMap")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"pipelineDetails"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"programName")
            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 DeleteMultiplexProgram where
  hashWithSalt :: Int -> DeleteMultiplexProgram -> Int
hashWithSalt Int
_salt DeleteMultiplexProgram' {Text
programName :: Text
multiplexId :: Text
$sel:programName:DeleteMultiplexProgram' :: DeleteMultiplexProgram -> Text
$sel:multiplexId:DeleteMultiplexProgram' :: DeleteMultiplexProgram -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
multiplexId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
programName

instance Prelude.NFData DeleteMultiplexProgram where
  rnf :: DeleteMultiplexProgram -> ()
rnf DeleteMultiplexProgram' {Text
programName :: Text
multiplexId :: Text
$sel:programName:DeleteMultiplexProgram' :: DeleteMultiplexProgram -> Text
$sel:multiplexId:DeleteMultiplexProgram' :: DeleteMultiplexProgram -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
multiplexId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
programName

instance Data.ToHeaders DeleteMultiplexProgram where
  toHeaders :: DeleteMultiplexProgram -> 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.ToPath DeleteMultiplexProgram where
  toPath :: DeleteMultiplexProgram -> ByteString
toPath DeleteMultiplexProgram' {Text
programName :: Text
multiplexId :: Text
$sel:programName:DeleteMultiplexProgram' :: DeleteMultiplexProgram -> Text
$sel:multiplexId:DeleteMultiplexProgram' :: DeleteMultiplexProgram -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/prod/multiplexes/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
multiplexId,
        ByteString
"/programs/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
programName
      ]

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

-- | Placeholder documentation for DeleteMultiplexProgramResponse
--
-- /See:/ 'newDeleteMultiplexProgramResponse' smart constructor.
data DeleteMultiplexProgramResponse = DeleteMultiplexProgramResponse'
  { -- | The MediaLive channel associated with the program.
    DeleteMultiplexProgramResponse -> Maybe Text
channelId :: Prelude.Maybe Prelude.Text,
    -- | The settings for this multiplex program.
    DeleteMultiplexProgramResponse -> Maybe MultiplexProgramSettings
multiplexProgramSettings :: Prelude.Maybe MultiplexProgramSettings,
    -- | The packet identifier map for this multiplex program.
    DeleteMultiplexProgramResponse
-> Maybe MultiplexProgramPacketIdentifiersMap
packetIdentifiersMap :: Prelude.Maybe MultiplexProgramPacketIdentifiersMap,
    -- | Contains information about the current sources for the specified program
    -- in the specified multiplex. Keep in mind that each multiplex pipeline
    -- connects to both pipelines in a given source channel (the channel
    -- identified by the program). But only one of those channel pipelines is
    -- ever active at one time.
    DeleteMultiplexProgramResponse
-> Maybe [MultiplexProgramPipelineDetail]
pipelineDetails :: Prelude.Maybe [MultiplexProgramPipelineDetail],
    -- | The name of the multiplex program.
    DeleteMultiplexProgramResponse -> Maybe Text
programName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DeleteMultiplexProgramResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteMultiplexProgramResponse
-> DeleteMultiplexProgramResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteMultiplexProgramResponse
-> DeleteMultiplexProgramResponse -> Bool
$c/= :: DeleteMultiplexProgramResponse
-> DeleteMultiplexProgramResponse -> Bool
== :: DeleteMultiplexProgramResponse
-> DeleteMultiplexProgramResponse -> Bool
$c== :: DeleteMultiplexProgramResponse
-> DeleteMultiplexProgramResponse -> Bool
Prelude.Eq, ReadPrec [DeleteMultiplexProgramResponse]
ReadPrec DeleteMultiplexProgramResponse
Int -> ReadS DeleteMultiplexProgramResponse
ReadS [DeleteMultiplexProgramResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteMultiplexProgramResponse]
$creadListPrec :: ReadPrec [DeleteMultiplexProgramResponse]
readPrec :: ReadPrec DeleteMultiplexProgramResponse
$creadPrec :: ReadPrec DeleteMultiplexProgramResponse
readList :: ReadS [DeleteMultiplexProgramResponse]
$creadList :: ReadS [DeleteMultiplexProgramResponse]
readsPrec :: Int -> ReadS DeleteMultiplexProgramResponse
$creadsPrec :: Int -> ReadS DeleteMultiplexProgramResponse
Prelude.Read, Int -> DeleteMultiplexProgramResponse -> ShowS
[DeleteMultiplexProgramResponse] -> ShowS
DeleteMultiplexProgramResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteMultiplexProgramResponse] -> ShowS
$cshowList :: [DeleteMultiplexProgramResponse] -> ShowS
show :: DeleteMultiplexProgramResponse -> String
$cshow :: DeleteMultiplexProgramResponse -> String
showsPrec :: Int -> DeleteMultiplexProgramResponse -> ShowS
$cshowsPrec :: Int -> DeleteMultiplexProgramResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteMultiplexProgramResponse x
-> DeleteMultiplexProgramResponse
forall x.
DeleteMultiplexProgramResponse
-> Rep DeleteMultiplexProgramResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteMultiplexProgramResponse x
-> DeleteMultiplexProgramResponse
$cfrom :: forall x.
DeleteMultiplexProgramResponse
-> Rep DeleteMultiplexProgramResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteMultiplexProgramResponse' 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:
--
-- 'channelId', 'deleteMultiplexProgramResponse_channelId' - The MediaLive channel associated with the program.
--
-- 'multiplexProgramSettings', 'deleteMultiplexProgramResponse_multiplexProgramSettings' - The settings for this multiplex program.
--
-- 'packetIdentifiersMap', 'deleteMultiplexProgramResponse_packetIdentifiersMap' - The packet identifier map for this multiplex program.
--
-- 'pipelineDetails', 'deleteMultiplexProgramResponse_pipelineDetails' - Contains information about the current sources for the specified program
-- in the specified multiplex. Keep in mind that each multiplex pipeline
-- connects to both pipelines in a given source channel (the channel
-- identified by the program). But only one of those channel pipelines is
-- ever active at one time.
--
-- 'programName', 'deleteMultiplexProgramResponse_programName' - The name of the multiplex program.
--
-- 'httpStatus', 'deleteMultiplexProgramResponse_httpStatus' - The response's http status code.
newDeleteMultiplexProgramResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteMultiplexProgramResponse
newDeleteMultiplexProgramResponse :: Int -> DeleteMultiplexProgramResponse
newDeleteMultiplexProgramResponse Int
pHttpStatus_ =
  DeleteMultiplexProgramResponse'
    { $sel:channelId:DeleteMultiplexProgramResponse' :: Maybe Text
channelId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:multiplexProgramSettings:DeleteMultiplexProgramResponse' :: Maybe MultiplexProgramSettings
multiplexProgramSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:packetIdentifiersMap:DeleteMultiplexProgramResponse' :: Maybe MultiplexProgramPacketIdentifiersMap
packetIdentifiersMap = forall a. Maybe a
Prelude.Nothing,
      $sel:pipelineDetails:DeleteMultiplexProgramResponse' :: Maybe [MultiplexProgramPipelineDetail]
pipelineDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:programName:DeleteMultiplexProgramResponse' :: Maybe Text
programName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteMultiplexProgramResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The MediaLive channel associated with the program.
deleteMultiplexProgramResponse_channelId :: Lens.Lens' DeleteMultiplexProgramResponse (Prelude.Maybe Prelude.Text)
deleteMultiplexProgramResponse_channelId :: Lens' DeleteMultiplexProgramResponse (Maybe Text)
deleteMultiplexProgramResponse_channelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteMultiplexProgramResponse' {Maybe Text
channelId :: Maybe Text
$sel:channelId:DeleteMultiplexProgramResponse' :: DeleteMultiplexProgramResponse -> Maybe Text
channelId} -> Maybe Text
channelId) (\s :: DeleteMultiplexProgramResponse
s@DeleteMultiplexProgramResponse' {} Maybe Text
a -> DeleteMultiplexProgramResponse
s {$sel:channelId:DeleteMultiplexProgramResponse' :: Maybe Text
channelId = Maybe Text
a} :: DeleteMultiplexProgramResponse)

-- | The settings for this multiplex program.
deleteMultiplexProgramResponse_multiplexProgramSettings :: Lens.Lens' DeleteMultiplexProgramResponse (Prelude.Maybe MultiplexProgramSettings)
deleteMultiplexProgramResponse_multiplexProgramSettings :: Lens'
  DeleteMultiplexProgramResponse (Maybe MultiplexProgramSettings)
deleteMultiplexProgramResponse_multiplexProgramSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteMultiplexProgramResponse' {Maybe MultiplexProgramSettings
multiplexProgramSettings :: Maybe MultiplexProgramSettings
$sel:multiplexProgramSettings:DeleteMultiplexProgramResponse' :: DeleteMultiplexProgramResponse -> Maybe MultiplexProgramSettings
multiplexProgramSettings} -> Maybe MultiplexProgramSettings
multiplexProgramSettings) (\s :: DeleteMultiplexProgramResponse
s@DeleteMultiplexProgramResponse' {} Maybe MultiplexProgramSettings
a -> DeleteMultiplexProgramResponse
s {$sel:multiplexProgramSettings:DeleteMultiplexProgramResponse' :: Maybe MultiplexProgramSettings
multiplexProgramSettings = Maybe MultiplexProgramSettings
a} :: DeleteMultiplexProgramResponse)

-- | The packet identifier map for this multiplex program.
deleteMultiplexProgramResponse_packetIdentifiersMap :: Lens.Lens' DeleteMultiplexProgramResponse (Prelude.Maybe MultiplexProgramPacketIdentifiersMap)
deleteMultiplexProgramResponse_packetIdentifiersMap :: Lens'
  DeleteMultiplexProgramResponse
  (Maybe MultiplexProgramPacketIdentifiersMap)
deleteMultiplexProgramResponse_packetIdentifiersMap = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteMultiplexProgramResponse' {Maybe MultiplexProgramPacketIdentifiersMap
packetIdentifiersMap :: Maybe MultiplexProgramPacketIdentifiersMap
$sel:packetIdentifiersMap:DeleteMultiplexProgramResponse' :: DeleteMultiplexProgramResponse
-> Maybe MultiplexProgramPacketIdentifiersMap
packetIdentifiersMap} -> Maybe MultiplexProgramPacketIdentifiersMap
packetIdentifiersMap) (\s :: DeleteMultiplexProgramResponse
s@DeleteMultiplexProgramResponse' {} Maybe MultiplexProgramPacketIdentifiersMap
a -> DeleteMultiplexProgramResponse
s {$sel:packetIdentifiersMap:DeleteMultiplexProgramResponse' :: Maybe MultiplexProgramPacketIdentifiersMap
packetIdentifiersMap = Maybe MultiplexProgramPacketIdentifiersMap
a} :: DeleteMultiplexProgramResponse)

-- | Contains information about the current sources for the specified program
-- in the specified multiplex. Keep in mind that each multiplex pipeline
-- connects to both pipelines in a given source channel (the channel
-- identified by the program). But only one of those channel pipelines is
-- ever active at one time.
deleteMultiplexProgramResponse_pipelineDetails :: Lens.Lens' DeleteMultiplexProgramResponse (Prelude.Maybe [MultiplexProgramPipelineDetail])
deleteMultiplexProgramResponse_pipelineDetails :: Lens'
  DeleteMultiplexProgramResponse
  (Maybe [MultiplexProgramPipelineDetail])
deleteMultiplexProgramResponse_pipelineDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteMultiplexProgramResponse' {Maybe [MultiplexProgramPipelineDetail]
pipelineDetails :: Maybe [MultiplexProgramPipelineDetail]
$sel:pipelineDetails:DeleteMultiplexProgramResponse' :: DeleteMultiplexProgramResponse
-> Maybe [MultiplexProgramPipelineDetail]
pipelineDetails} -> Maybe [MultiplexProgramPipelineDetail]
pipelineDetails) (\s :: DeleteMultiplexProgramResponse
s@DeleteMultiplexProgramResponse' {} Maybe [MultiplexProgramPipelineDetail]
a -> DeleteMultiplexProgramResponse
s {$sel:pipelineDetails:DeleteMultiplexProgramResponse' :: Maybe [MultiplexProgramPipelineDetail]
pipelineDetails = Maybe [MultiplexProgramPipelineDetail]
a} :: DeleteMultiplexProgramResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of the multiplex program.
deleteMultiplexProgramResponse_programName :: Lens.Lens' DeleteMultiplexProgramResponse (Prelude.Maybe Prelude.Text)
deleteMultiplexProgramResponse_programName :: Lens' DeleteMultiplexProgramResponse (Maybe Text)
deleteMultiplexProgramResponse_programName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteMultiplexProgramResponse' {Maybe Text
programName :: Maybe Text
$sel:programName:DeleteMultiplexProgramResponse' :: DeleteMultiplexProgramResponse -> Maybe Text
programName} -> Maybe Text
programName) (\s :: DeleteMultiplexProgramResponse
s@DeleteMultiplexProgramResponse' {} Maybe Text
a -> DeleteMultiplexProgramResponse
s {$sel:programName:DeleteMultiplexProgramResponse' :: Maybe Text
programName = Maybe Text
a} :: DeleteMultiplexProgramResponse)

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

instance
  Prelude.NFData
    DeleteMultiplexProgramResponse
  where
  rnf :: DeleteMultiplexProgramResponse -> ()
rnf DeleteMultiplexProgramResponse' {Int
Maybe [MultiplexProgramPipelineDetail]
Maybe Text
Maybe MultiplexProgramPacketIdentifiersMap
Maybe MultiplexProgramSettings
httpStatus :: Int
programName :: Maybe Text
pipelineDetails :: Maybe [MultiplexProgramPipelineDetail]
packetIdentifiersMap :: Maybe MultiplexProgramPacketIdentifiersMap
multiplexProgramSettings :: Maybe MultiplexProgramSettings
channelId :: Maybe Text
$sel:httpStatus:DeleteMultiplexProgramResponse' :: DeleteMultiplexProgramResponse -> Int
$sel:programName:DeleteMultiplexProgramResponse' :: DeleteMultiplexProgramResponse -> Maybe Text
$sel:pipelineDetails:DeleteMultiplexProgramResponse' :: DeleteMultiplexProgramResponse
-> Maybe [MultiplexProgramPipelineDetail]
$sel:packetIdentifiersMap:DeleteMultiplexProgramResponse' :: DeleteMultiplexProgramResponse
-> Maybe MultiplexProgramPacketIdentifiersMap
$sel:multiplexProgramSettings:DeleteMultiplexProgramResponse' :: DeleteMultiplexProgramResponse -> Maybe MultiplexProgramSettings
$sel:channelId:DeleteMultiplexProgramResponse' :: DeleteMultiplexProgramResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
channelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MultiplexProgramSettings
multiplexProgramSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MultiplexProgramPacketIdentifiersMap
packetIdentifiersMap
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [MultiplexProgramPipelineDetail]
pipelineDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
programName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus