{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.M3u8Settings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.MediaLive.Types.M3u8Settings 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.M3u8NielsenId3Behavior
import Amazonka.MediaLive.Types.M3u8PcrControl
import Amazonka.MediaLive.Types.M3u8Scte35Behavior
import Amazonka.MediaLive.Types.M3u8TimedMetadataBehavior
import qualified Amazonka.Prelude as Prelude

-- | Settings information for the .m3u8 container
--
-- /See:/ 'newM3u8Settings' smart constructor.
data M3u8Settings = M3u8Settings'
  { -- | The number of audio frames to insert for each PES packet.
    M3u8Settings -> Maybe Natural
audioFramesPerPes :: Prelude.Maybe Prelude.Natural,
    -- | Packet Identifier (PID) of the elementary audio stream(s) in the
    -- transport stream. Multiple values are accepted, and can be entered in
    -- ranges and\/or by comma separation. Can be entered as decimal or
    -- hexadecimal values.
    M3u8Settings -> Maybe Text
audioPids :: Prelude.Maybe Prelude.Text,
    -- | This parameter is unused and deprecated.
    M3u8Settings -> Maybe Text
ecmPid :: Prelude.Maybe Prelude.Text,
    -- | If set to passthrough, Nielsen inaudible tones for media tracking will
    -- be detected in the input audio and an equivalent ID3 tag will be
    -- inserted in the output.
    M3u8Settings -> Maybe M3u8NielsenId3Behavior
nielsenId3Behavior :: Prelude.Maybe M3u8NielsenId3Behavior,
    -- | The number of milliseconds between instances of this table in the output
    -- transport stream. A value of \\\"0\\\" writes out the PMT once per
    -- segment file.
    M3u8Settings -> Maybe Natural
patInterval :: Prelude.Maybe Prelude.Natural,
    -- | When set to pcrEveryPesPacket, a Program Clock Reference value is
    -- inserted for every Packetized Elementary Stream (PES) header. This
    -- parameter is effective only when the PCR PID is the same as the video or
    -- audio elementary stream.
    M3u8Settings -> Maybe M3u8PcrControl
pcrControl :: Prelude.Maybe M3u8PcrControl,
    -- | Maximum time in milliseconds between Program Clock References (PCRs)
    -- inserted into the transport stream.
    M3u8Settings -> Maybe Natural
pcrPeriod :: Prelude.Maybe Prelude.Natural,
    -- | Packet Identifier (PID) of the Program Clock Reference (PCR) in the
    -- transport stream. When no value is given, the encoder will assign the
    -- same value as the Video PID. Can be entered as a decimal or hexadecimal
    -- value.
    M3u8Settings -> Maybe Text
pcrPid :: Prelude.Maybe Prelude.Text,
    -- | The number of milliseconds between instances of this table in the output
    -- transport stream. A value of \\\"0\\\" writes out the PMT once per
    -- segment file.
    M3u8Settings -> Maybe Natural
pmtInterval :: Prelude.Maybe Prelude.Natural,
    -- | Packet Identifier (PID) for the Program Map Table (PMT) in the transport
    -- stream. Can be entered as a decimal or hexadecimal value.
    M3u8Settings -> Maybe Text
pmtPid :: Prelude.Maybe Prelude.Text,
    -- | The value of the program number field in the Program Map Table.
    M3u8Settings -> Maybe Natural
programNum :: Prelude.Maybe Prelude.Natural,
    -- | If set to passthrough, passes any SCTE-35 signals from the input source
    -- to this output.
    M3u8Settings -> Maybe M3u8Scte35Behavior
scte35Behavior :: Prelude.Maybe M3u8Scte35Behavior,
    -- | Packet Identifier (PID) of the SCTE-35 stream in the transport stream.
    -- Can be entered as a decimal or hexadecimal value.
    M3u8Settings -> Maybe Text
scte35Pid :: Prelude.Maybe Prelude.Text,
    -- | When set to passthrough, timed metadata is passed through from input to
    -- output.
    M3u8Settings -> Maybe M3u8TimedMetadataBehavior
timedMetadataBehavior :: Prelude.Maybe M3u8TimedMetadataBehavior,
    -- | Packet Identifier (PID) of the timed metadata stream in the transport
    -- stream. Can be entered as a decimal or hexadecimal value. Valid values
    -- are 32 (or 0x20)..8182 (or 0x1ff6).
    M3u8Settings -> Maybe Text
timedMetadataPid :: Prelude.Maybe Prelude.Text,
    -- | The value of the transport stream ID field in the Program Map Table.
    M3u8Settings -> Maybe Natural
transportStreamId :: Prelude.Maybe Prelude.Natural,
    -- | Packet Identifier (PID) of the elementary video stream in the transport
    -- stream. Can be entered as a decimal or hexadecimal value.
    M3u8Settings -> Maybe Text
videoPid :: Prelude.Maybe Prelude.Text
  }
  deriving (M3u8Settings -> M3u8Settings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: M3u8Settings -> M3u8Settings -> Bool
$c/= :: M3u8Settings -> M3u8Settings -> Bool
== :: M3u8Settings -> M3u8Settings -> Bool
$c== :: M3u8Settings -> M3u8Settings -> Bool
Prelude.Eq, ReadPrec [M3u8Settings]
ReadPrec M3u8Settings
Int -> ReadS M3u8Settings
ReadS [M3u8Settings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [M3u8Settings]
$creadListPrec :: ReadPrec [M3u8Settings]
readPrec :: ReadPrec M3u8Settings
$creadPrec :: ReadPrec M3u8Settings
readList :: ReadS [M3u8Settings]
$creadList :: ReadS [M3u8Settings]
readsPrec :: Int -> ReadS M3u8Settings
$creadsPrec :: Int -> ReadS M3u8Settings
Prelude.Read, Int -> M3u8Settings -> ShowS
[M3u8Settings] -> ShowS
M3u8Settings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [M3u8Settings] -> ShowS
$cshowList :: [M3u8Settings] -> ShowS
show :: M3u8Settings -> String
$cshow :: M3u8Settings -> String
showsPrec :: Int -> M3u8Settings -> ShowS
$cshowsPrec :: Int -> M3u8Settings -> ShowS
Prelude.Show, forall x. Rep M3u8Settings x -> M3u8Settings
forall x. M3u8Settings -> Rep M3u8Settings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep M3u8Settings x -> M3u8Settings
$cfrom :: forall x. M3u8Settings -> Rep M3u8Settings x
Prelude.Generic)

-- |
-- Create a value of 'M3u8Settings' 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:
--
-- 'audioFramesPerPes', 'm3u8Settings_audioFramesPerPes' - The number of audio frames to insert for each PES packet.
--
-- 'audioPids', 'm3u8Settings_audioPids' - Packet Identifier (PID) of the elementary audio stream(s) in the
-- transport stream. Multiple values are accepted, and can be entered in
-- ranges and\/or by comma separation. Can be entered as decimal or
-- hexadecimal values.
--
-- 'ecmPid', 'm3u8Settings_ecmPid' - This parameter is unused and deprecated.
--
-- 'nielsenId3Behavior', 'm3u8Settings_nielsenId3Behavior' - If set to passthrough, Nielsen inaudible tones for media tracking will
-- be detected in the input audio and an equivalent ID3 tag will be
-- inserted in the output.
--
-- 'patInterval', 'm3u8Settings_patInterval' - The number of milliseconds between instances of this table in the output
-- transport stream. A value of \\\"0\\\" writes out the PMT once per
-- segment file.
--
-- 'pcrControl', 'm3u8Settings_pcrControl' - When set to pcrEveryPesPacket, a Program Clock Reference value is
-- inserted for every Packetized Elementary Stream (PES) header. This
-- parameter is effective only when the PCR PID is the same as the video or
-- audio elementary stream.
--
-- 'pcrPeriod', 'm3u8Settings_pcrPeriod' - Maximum time in milliseconds between Program Clock References (PCRs)
-- inserted into the transport stream.
--
-- 'pcrPid', 'm3u8Settings_pcrPid' - Packet Identifier (PID) of the Program Clock Reference (PCR) in the
-- transport stream. When no value is given, the encoder will assign the
-- same value as the Video PID. Can be entered as a decimal or hexadecimal
-- value.
--
-- 'pmtInterval', 'm3u8Settings_pmtInterval' - The number of milliseconds between instances of this table in the output
-- transport stream. A value of \\\"0\\\" writes out the PMT once per
-- segment file.
--
-- 'pmtPid', 'm3u8Settings_pmtPid' - Packet Identifier (PID) for the Program Map Table (PMT) in the transport
-- stream. Can be entered as a decimal or hexadecimal value.
--
-- 'programNum', 'm3u8Settings_programNum' - The value of the program number field in the Program Map Table.
--
-- 'scte35Behavior', 'm3u8Settings_scte35Behavior' - If set to passthrough, passes any SCTE-35 signals from the input source
-- to this output.
--
-- 'scte35Pid', 'm3u8Settings_scte35Pid' - Packet Identifier (PID) of the SCTE-35 stream in the transport stream.
-- Can be entered as a decimal or hexadecimal value.
--
-- 'timedMetadataBehavior', 'm3u8Settings_timedMetadataBehavior' - When set to passthrough, timed metadata is passed through from input to
-- output.
--
-- 'timedMetadataPid', 'm3u8Settings_timedMetadataPid' - Packet Identifier (PID) of the timed metadata stream in the transport
-- stream. Can be entered as a decimal or hexadecimal value. Valid values
-- are 32 (or 0x20)..8182 (or 0x1ff6).
--
-- 'transportStreamId', 'm3u8Settings_transportStreamId' - The value of the transport stream ID field in the Program Map Table.
--
-- 'videoPid', 'm3u8Settings_videoPid' - Packet Identifier (PID) of the elementary video stream in the transport
-- stream. Can be entered as a decimal or hexadecimal value.
newM3u8Settings ::
  M3u8Settings
newM3u8Settings :: M3u8Settings
newM3u8Settings =
  M3u8Settings'
    { $sel:audioFramesPerPes:M3u8Settings' :: Maybe Natural
audioFramesPerPes = forall a. Maybe a
Prelude.Nothing,
      $sel:audioPids:M3u8Settings' :: Maybe Text
audioPids = forall a. Maybe a
Prelude.Nothing,
      $sel:ecmPid:M3u8Settings' :: Maybe Text
ecmPid = forall a. Maybe a
Prelude.Nothing,
      $sel:nielsenId3Behavior:M3u8Settings' :: Maybe M3u8NielsenId3Behavior
nielsenId3Behavior = forall a. Maybe a
Prelude.Nothing,
      $sel:patInterval:M3u8Settings' :: Maybe Natural
patInterval = forall a. Maybe a
Prelude.Nothing,
      $sel:pcrControl:M3u8Settings' :: Maybe M3u8PcrControl
pcrControl = forall a. Maybe a
Prelude.Nothing,
      $sel:pcrPeriod:M3u8Settings' :: Maybe Natural
pcrPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:pcrPid:M3u8Settings' :: Maybe Text
pcrPid = forall a. Maybe a
Prelude.Nothing,
      $sel:pmtInterval:M3u8Settings' :: Maybe Natural
pmtInterval = forall a. Maybe a
Prelude.Nothing,
      $sel:pmtPid:M3u8Settings' :: Maybe Text
pmtPid = forall a. Maybe a
Prelude.Nothing,
      $sel:programNum:M3u8Settings' :: Maybe Natural
programNum = forall a. Maybe a
Prelude.Nothing,
      $sel:scte35Behavior:M3u8Settings' :: Maybe M3u8Scte35Behavior
scte35Behavior = forall a. Maybe a
Prelude.Nothing,
      $sel:scte35Pid:M3u8Settings' :: Maybe Text
scte35Pid = forall a. Maybe a
Prelude.Nothing,
      $sel:timedMetadataBehavior:M3u8Settings' :: Maybe M3u8TimedMetadataBehavior
timedMetadataBehavior = forall a. Maybe a
Prelude.Nothing,
      $sel:timedMetadataPid:M3u8Settings' :: Maybe Text
timedMetadataPid = forall a. Maybe a
Prelude.Nothing,
      $sel:transportStreamId:M3u8Settings' :: Maybe Natural
transportStreamId = forall a. Maybe a
Prelude.Nothing,
      $sel:videoPid:M3u8Settings' :: Maybe Text
videoPid = forall a. Maybe a
Prelude.Nothing
    }

-- | The number of audio frames to insert for each PES packet.
m3u8Settings_audioFramesPerPes :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Natural)
m3u8Settings_audioFramesPerPes :: Lens' M3u8Settings (Maybe Natural)
m3u8Settings_audioFramesPerPes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Natural
audioFramesPerPes :: Maybe Natural
$sel:audioFramesPerPes:M3u8Settings' :: M3u8Settings -> Maybe Natural
audioFramesPerPes} -> Maybe Natural
audioFramesPerPes) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Natural
a -> M3u8Settings
s {$sel:audioFramesPerPes:M3u8Settings' :: Maybe Natural
audioFramesPerPes = Maybe Natural
a} :: M3u8Settings)

-- | Packet Identifier (PID) of the elementary audio stream(s) in the
-- transport stream. Multiple values are accepted, and can be entered in
-- ranges and\/or by comma separation. Can be entered as decimal or
-- hexadecimal values.
m3u8Settings_audioPids :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Text)
m3u8Settings_audioPids :: Lens' M3u8Settings (Maybe Text)
m3u8Settings_audioPids = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Text
audioPids :: Maybe Text
$sel:audioPids:M3u8Settings' :: M3u8Settings -> Maybe Text
audioPids} -> Maybe Text
audioPids) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Text
a -> M3u8Settings
s {$sel:audioPids:M3u8Settings' :: Maybe Text
audioPids = Maybe Text
a} :: M3u8Settings)

-- | This parameter is unused and deprecated.
m3u8Settings_ecmPid :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Text)
m3u8Settings_ecmPid :: Lens' M3u8Settings (Maybe Text)
m3u8Settings_ecmPid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Text
ecmPid :: Maybe Text
$sel:ecmPid:M3u8Settings' :: M3u8Settings -> Maybe Text
ecmPid} -> Maybe Text
ecmPid) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Text
a -> M3u8Settings
s {$sel:ecmPid:M3u8Settings' :: Maybe Text
ecmPid = Maybe Text
a} :: M3u8Settings)

-- | If set to passthrough, Nielsen inaudible tones for media tracking will
-- be detected in the input audio and an equivalent ID3 tag will be
-- inserted in the output.
m3u8Settings_nielsenId3Behavior :: Lens.Lens' M3u8Settings (Prelude.Maybe M3u8NielsenId3Behavior)
m3u8Settings_nielsenId3Behavior :: Lens' M3u8Settings (Maybe M3u8NielsenId3Behavior)
m3u8Settings_nielsenId3Behavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe M3u8NielsenId3Behavior
nielsenId3Behavior :: Maybe M3u8NielsenId3Behavior
$sel:nielsenId3Behavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8NielsenId3Behavior
nielsenId3Behavior} -> Maybe M3u8NielsenId3Behavior
nielsenId3Behavior) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe M3u8NielsenId3Behavior
a -> M3u8Settings
s {$sel:nielsenId3Behavior:M3u8Settings' :: Maybe M3u8NielsenId3Behavior
nielsenId3Behavior = Maybe M3u8NielsenId3Behavior
a} :: M3u8Settings)

-- | The number of milliseconds between instances of this table in the output
-- transport stream. A value of \\\"0\\\" writes out the PMT once per
-- segment file.
m3u8Settings_patInterval :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Natural)
m3u8Settings_patInterval :: Lens' M3u8Settings (Maybe Natural)
m3u8Settings_patInterval = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Natural
patInterval :: Maybe Natural
$sel:patInterval:M3u8Settings' :: M3u8Settings -> Maybe Natural
patInterval} -> Maybe Natural
patInterval) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Natural
a -> M3u8Settings
s {$sel:patInterval:M3u8Settings' :: Maybe Natural
patInterval = Maybe Natural
a} :: M3u8Settings)

-- | When set to pcrEveryPesPacket, a Program Clock Reference value is
-- inserted for every Packetized Elementary Stream (PES) header. This
-- parameter is effective only when the PCR PID is the same as the video or
-- audio elementary stream.
m3u8Settings_pcrControl :: Lens.Lens' M3u8Settings (Prelude.Maybe M3u8PcrControl)
m3u8Settings_pcrControl :: Lens' M3u8Settings (Maybe M3u8PcrControl)
m3u8Settings_pcrControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe M3u8PcrControl
pcrControl :: Maybe M3u8PcrControl
$sel:pcrControl:M3u8Settings' :: M3u8Settings -> Maybe M3u8PcrControl
pcrControl} -> Maybe M3u8PcrControl
pcrControl) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe M3u8PcrControl
a -> M3u8Settings
s {$sel:pcrControl:M3u8Settings' :: Maybe M3u8PcrControl
pcrControl = Maybe M3u8PcrControl
a} :: M3u8Settings)

-- | Maximum time in milliseconds between Program Clock References (PCRs)
-- inserted into the transport stream.
m3u8Settings_pcrPeriod :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Natural)
m3u8Settings_pcrPeriod :: Lens' M3u8Settings (Maybe Natural)
m3u8Settings_pcrPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Natural
pcrPeriod :: Maybe Natural
$sel:pcrPeriod:M3u8Settings' :: M3u8Settings -> Maybe Natural
pcrPeriod} -> Maybe Natural
pcrPeriod) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Natural
a -> M3u8Settings
s {$sel:pcrPeriod:M3u8Settings' :: Maybe Natural
pcrPeriod = Maybe Natural
a} :: M3u8Settings)

-- | Packet Identifier (PID) of the Program Clock Reference (PCR) in the
-- transport stream. When no value is given, the encoder will assign the
-- same value as the Video PID. Can be entered as a decimal or hexadecimal
-- value.
m3u8Settings_pcrPid :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Text)
m3u8Settings_pcrPid :: Lens' M3u8Settings (Maybe Text)
m3u8Settings_pcrPid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Text
pcrPid :: Maybe Text
$sel:pcrPid:M3u8Settings' :: M3u8Settings -> Maybe Text
pcrPid} -> Maybe Text
pcrPid) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Text
a -> M3u8Settings
s {$sel:pcrPid:M3u8Settings' :: Maybe Text
pcrPid = Maybe Text
a} :: M3u8Settings)

-- | The number of milliseconds between instances of this table in the output
-- transport stream. A value of \\\"0\\\" writes out the PMT once per
-- segment file.
m3u8Settings_pmtInterval :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Natural)
m3u8Settings_pmtInterval :: Lens' M3u8Settings (Maybe Natural)
m3u8Settings_pmtInterval = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Natural
pmtInterval :: Maybe Natural
$sel:pmtInterval:M3u8Settings' :: M3u8Settings -> Maybe Natural
pmtInterval} -> Maybe Natural
pmtInterval) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Natural
a -> M3u8Settings
s {$sel:pmtInterval:M3u8Settings' :: Maybe Natural
pmtInterval = Maybe Natural
a} :: M3u8Settings)

-- | Packet Identifier (PID) for the Program Map Table (PMT) in the transport
-- stream. Can be entered as a decimal or hexadecimal value.
m3u8Settings_pmtPid :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Text)
m3u8Settings_pmtPid :: Lens' M3u8Settings (Maybe Text)
m3u8Settings_pmtPid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Text
pmtPid :: Maybe Text
$sel:pmtPid:M3u8Settings' :: M3u8Settings -> Maybe Text
pmtPid} -> Maybe Text
pmtPid) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Text
a -> M3u8Settings
s {$sel:pmtPid:M3u8Settings' :: Maybe Text
pmtPid = Maybe Text
a} :: M3u8Settings)

-- | The value of the program number field in the Program Map Table.
m3u8Settings_programNum :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Natural)
m3u8Settings_programNum :: Lens' M3u8Settings (Maybe Natural)
m3u8Settings_programNum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Natural
programNum :: Maybe Natural
$sel:programNum:M3u8Settings' :: M3u8Settings -> Maybe Natural
programNum} -> Maybe Natural
programNum) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Natural
a -> M3u8Settings
s {$sel:programNum:M3u8Settings' :: Maybe Natural
programNum = Maybe Natural
a} :: M3u8Settings)

-- | If set to passthrough, passes any SCTE-35 signals from the input source
-- to this output.
m3u8Settings_scte35Behavior :: Lens.Lens' M3u8Settings (Prelude.Maybe M3u8Scte35Behavior)
m3u8Settings_scte35Behavior :: Lens' M3u8Settings (Maybe M3u8Scte35Behavior)
m3u8Settings_scte35Behavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe M3u8Scte35Behavior
scte35Behavior :: Maybe M3u8Scte35Behavior
$sel:scte35Behavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8Scte35Behavior
scte35Behavior} -> Maybe M3u8Scte35Behavior
scte35Behavior) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe M3u8Scte35Behavior
a -> M3u8Settings
s {$sel:scte35Behavior:M3u8Settings' :: Maybe M3u8Scte35Behavior
scte35Behavior = Maybe M3u8Scte35Behavior
a} :: M3u8Settings)

-- | Packet Identifier (PID) of the SCTE-35 stream in the transport stream.
-- Can be entered as a decimal or hexadecimal value.
m3u8Settings_scte35Pid :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Text)
m3u8Settings_scte35Pid :: Lens' M3u8Settings (Maybe Text)
m3u8Settings_scte35Pid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Text
scte35Pid :: Maybe Text
$sel:scte35Pid:M3u8Settings' :: M3u8Settings -> Maybe Text
scte35Pid} -> Maybe Text
scte35Pid) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Text
a -> M3u8Settings
s {$sel:scte35Pid:M3u8Settings' :: Maybe Text
scte35Pid = Maybe Text
a} :: M3u8Settings)

-- | When set to passthrough, timed metadata is passed through from input to
-- output.
m3u8Settings_timedMetadataBehavior :: Lens.Lens' M3u8Settings (Prelude.Maybe M3u8TimedMetadataBehavior)
m3u8Settings_timedMetadataBehavior :: Lens' M3u8Settings (Maybe M3u8TimedMetadataBehavior)
m3u8Settings_timedMetadataBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe M3u8TimedMetadataBehavior
timedMetadataBehavior :: Maybe M3u8TimedMetadataBehavior
$sel:timedMetadataBehavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8TimedMetadataBehavior
timedMetadataBehavior} -> Maybe M3u8TimedMetadataBehavior
timedMetadataBehavior) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe M3u8TimedMetadataBehavior
a -> M3u8Settings
s {$sel:timedMetadataBehavior:M3u8Settings' :: Maybe M3u8TimedMetadataBehavior
timedMetadataBehavior = Maybe M3u8TimedMetadataBehavior
a} :: M3u8Settings)

-- | Packet Identifier (PID) of the timed metadata stream in the transport
-- stream. Can be entered as a decimal or hexadecimal value. Valid values
-- are 32 (or 0x20)..8182 (or 0x1ff6).
m3u8Settings_timedMetadataPid :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Text)
m3u8Settings_timedMetadataPid :: Lens' M3u8Settings (Maybe Text)
m3u8Settings_timedMetadataPid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Text
timedMetadataPid :: Maybe Text
$sel:timedMetadataPid:M3u8Settings' :: M3u8Settings -> Maybe Text
timedMetadataPid} -> Maybe Text
timedMetadataPid) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Text
a -> M3u8Settings
s {$sel:timedMetadataPid:M3u8Settings' :: Maybe Text
timedMetadataPid = Maybe Text
a} :: M3u8Settings)

-- | The value of the transport stream ID field in the Program Map Table.
m3u8Settings_transportStreamId :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Natural)
m3u8Settings_transportStreamId :: Lens' M3u8Settings (Maybe Natural)
m3u8Settings_transportStreamId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Natural
transportStreamId :: Maybe Natural
$sel:transportStreamId:M3u8Settings' :: M3u8Settings -> Maybe Natural
transportStreamId} -> Maybe Natural
transportStreamId) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Natural
a -> M3u8Settings
s {$sel:transportStreamId:M3u8Settings' :: Maybe Natural
transportStreamId = Maybe Natural
a} :: M3u8Settings)

-- | Packet Identifier (PID) of the elementary video stream in the transport
-- stream. Can be entered as a decimal or hexadecimal value.
m3u8Settings_videoPid :: Lens.Lens' M3u8Settings (Prelude.Maybe Prelude.Text)
m3u8Settings_videoPid :: Lens' M3u8Settings (Maybe Text)
m3u8Settings_videoPid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\M3u8Settings' {Maybe Text
videoPid :: Maybe Text
$sel:videoPid:M3u8Settings' :: M3u8Settings -> Maybe Text
videoPid} -> Maybe Text
videoPid) (\s :: M3u8Settings
s@M3u8Settings' {} Maybe Text
a -> M3u8Settings
s {$sel:videoPid:M3u8Settings' :: Maybe Text
videoPid = Maybe Text
a} :: M3u8Settings)

instance Data.FromJSON M3u8Settings where
  parseJSON :: Value -> Parser M3u8Settings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"M3u8Settings"
      ( \Object
x ->
          Maybe Natural
-> Maybe Text
-> Maybe Text
-> Maybe M3u8NielsenId3Behavior
-> Maybe Natural
-> Maybe M3u8PcrControl
-> Maybe Natural
-> Maybe Text
-> Maybe Natural
-> Maybe Text
-> Maybe Natural
-> Maybe M3u8Scte35Behavior
-> Maybe Text
-> Maybe M3u8TimedMetadataBehavior
-> Maybe Text
-> Maybe Natural
-> Maybe Text
-> M3u8Settings
M3u8Settings'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"audioFramesPerPes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"audioPids")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ecmPid")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"nielsenId3Behavior")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"patInterval")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"pcrControl")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"pcrPeriod")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"pcrPid")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"pmtInterval")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"pmtPid")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"programNum")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"scte35Behavior")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"scte35Pid")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"timedMetadataBehavior")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"timedMetadataPid")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"transportStreamId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"videoPid")
      )

instance Prelude.Hashable M3u8Settings where
  hashWithSalt :: Int -> M3u8Settings -> Int
hashWithSalt Int
_salt M3u8Settings' {Maybe Natural
Maybe Text
Maybe M3u8NielsenId3Behavior
Maybe M3u8PcrControl
Maybe M3u8Scte35Behavior
Maybe M3u8TimedMetadataBehavior
videoPid :: Maybe Text
transportStreamId :: Maybe Natural
timedMetadataPid :: Maybe Text
timedMetadataBehavior :: Maybe M3u8TimedMetadataBehavior
scte35Pid :: Maybe Text
scte35Behavior :: Maybe M3u8Scte35Behavior
programNum :: Maybe Natural
pmtPid :: Maybe Text
pmtInterval :: Maybe Natural
pcrPid :: Maybe Text
pcrPeriod :: Maybe Natural
pcrControl :: Maybe M3u8PcrControl
patInterval :: Maybe Natural
nielsenId3Behavior :: Maybe M3u8NielsenId3Behavior
ecmPid :: Maybe Text
audioPids :: Maybe Text
audioFramesPerPes :: Maybe Natural
$sel:videoPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:transportStreamId:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:timedMetadataPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:timedMetadataBehavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8TimedMetadataBehavior
$sel:scte35Pid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:scte35Behavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8Scte35Behavior
$sel:programNum:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:pmtPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:pmtInterval:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:pcrPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:pcrPeriod:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:pcrControl:M3u8Settings' :: M3u8Settings -> Maybe M3u8PcrControl
$sel:patInterval:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:nielsenId3Behavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8NielsenId3Behavior
$sel:ecmPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:audioPids:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:audioFramesPerPes:M3u8Settings' :: M3u8Settings -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
audioFramesPerPes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
audioPids
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ecmPid
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe M3u8NielsenId3Behavior
nielsenId3Behavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
patInterval
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe M3u8PcrControl
pcrControl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
pcrPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pcrPid
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
pmtInterval
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pmtPid
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
programNum
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe M3u8Scte35Behavior
scte35Behavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
scte35Pid
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe M3u8TimedMetadataBehavior
timedMetadataBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
timedMetadataPid
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
transportStreamId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
videoPid

instance Prelude.NFData M3u8Settings where
  rnf :: M3u8Settings -> ()
rnf M3u8Settings' {Maybe Natural
Maybe Text
Maybe M3u8NielsenId3Behavior
Maybe M3u8PcrControl
Maybe M3u8Scte35Behavior
Maybe M3u8TimedMetadataBehavior
videoPid :: Maybe Text
transportStreamId :: Maybe Natural
timedMetadataPid :: Maybe Text
timedMetadataBehavior :: Maybe M3u8TimedMetadataBehavior
scte35Pid :: Maybe Text
scte35Behavior :: Maybe M3u8Scte35Behavior
programNum :: Maybe Natural
pmtPid :: Maybe Text
pmtInterval :: Maybe Natural
pcrPid :: Maybe Text
pcrPeriod :: Maybe Natural
pcrControl :: Maybe M3u8PcrControl
patInterval :: Maybe Natural
nielsenId3Behavior :: Maybe M3u8NielsenId3Behavior
ecmPid :: Maybe Text
audioPids :: Maybe Text
audioFramesPerPes :: Maybe Natural
$sel:videoPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:transportStreamId:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:timedMetadataPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:timedMetadataBehavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8TimedMetadataBehavior
$sel:scte35Pid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:scte35Behavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8Scte35Behavior
$sel:programNum:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:pmtPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:pmtInterval:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:pcrPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:pcrPeriod:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:pcrControl:M3u8Settings' :: M3u8Settings -> Maybe M3u8PcrControl
$sel:patInterval:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:nielsenId3Behavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8NielsenId3Behavior
$sel:ecmPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:audioPids:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:audioFramesPerPes:M3u8Settings' :: M3u8Settings -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
audioFramesPerPes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
audioPids
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ecmPid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe M3u8NielsenId3Behavior
nielsenId3Behavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
patInterval
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe M3u8PcrControl
pcrControl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
pcrPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pcrPid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
pmtInterval
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pmtPid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
programNum
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe M3u8Scte35Behavior
scte35Behavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
scte35Pid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe M3u8TimedMetadataBehavior
timedMetadataBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timedMetadataPid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
transportStreamId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
videoPid

instance Data.ToJSON M3u8Settings where
  toJSON :: M3u8Settings -> Value
toJSON M3u8Settings' {Maybe Natural
Maybe Text
Maybe M3u8NielsenId3Behavior
Maybe M3u8PcrControl
Maybe M3u8Scte35Behavior
Maybe M3u8TimedMetadataBehavior
videoPid :: Maybe Text
transportStreamId :: Maybe Natural
timedMetadataPid :: Maybe Text
timedMetadataBehavior :: Maybe M3u8TimedMetadataBehavior
scte35Pid :: Maybe Text
scte35Behavior :: Maybe M3u8Scte35Behavior
programNum :: Maybe Natural
pmtPid :: Maybe Text
pmtInterval :: Maybe Natural
pcrPid :: Maybe Text
pcrPeriod :: Maybe Natural
pcrControl :: Maybe M3u8PcrControl
patInterval :: Maybe Natural
nielsenId3Behavior :: Maybe M3u8NielsenId3Behavior
ecmPid :: Maybe Text
audioPids :: Maybe Text
audioFramesPerPes :: Maybe Natural
$sel:videoPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:transportStreamId:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:timedMetadataPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:timedMetadataBehavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8TimedMetadataBehavior
$sel:scte35Pid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:scte35Behavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8Scte35Behavior
$sel:programNum:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:pmtPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:pmtInterval:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:pcrPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:pcrPeriod:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:pcrControl:M3u8Settings' :: M3u8Settings -> Maybe M3u8PcrControl
$sel:patInterval:M3u8Settings' :: M3u8Settings -> Maybe Natural
$sel:nielsenId3Behavior:M3u8Settings' :: M3u8Settings -> Maybe M3u8NielsenId3Behavior
$sel:ecmPid:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:audioPids:M3u8Settings' :: M3u8Settings -> Maybe Text
$sel:audioFramesPerPes:M3u8Settings' :: M3u8Settings -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"audioFramesPerPes" 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 Natural
audioFramesPerPes,
            (Key
"audioPids" 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
audioPids,
            (Key
"ecmPid" 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
ecmPid,
            (Key
"nielsenId3Behavior" 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 M3u8NielsenId3Behavior
nielsenId3Behavior,
            (Key
"patInterval" 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 Natural
patInterval,
            (Key
"pcrControl" 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 M3u8PcrControl
pcrControl,
            (Key
"pcrPeriod" 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 Natural
pcrPeriod,
            (Key
"pcrPid" 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
pcrPid,
            (Key
"pmtInterval" 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 Natural
pmtInterval,
            (Key
"pmtPid" 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
pmtPid,
            (Key
"programNum" 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 Natural
programNum,
            (Key
"scte35Behavior" 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 M3u8Scte35Behavior
scte35Behavior,
            (Key
"scte35Pid" 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
scte35Pid,
            (Key
"timedMetadataBehavior" 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 M3u8TimedMetadataBehavior
timedMetadataBehavior,
            (Key
"timedMetadataPid" 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
timedMetadataPid,
            (Key
"transportStreamId" 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 Natural
transportStreamId,
            (Key
"videoPid" 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
videoPid
          ]
      )