{-# 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.HlsGroupSettings
-- 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.HlsGroupSettings 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.CaptionLanguageMapping
import Amazonka.MediaLive.Types.HlsAdMarkers
import Amazonka.MediaLive.Types.HlsCaptionLanguageSetting
import Amazonka.MediaLive.Types.HlsCdnSettings
import Amazonka.MediaLive.Types.HlsClientCache
import Amazonka.MediaLive.Types.HlsCodecSpecification
import Amazonka.MediaLive.Types.HlsDirectoryStructure
import Amazonka.MediaLive.Types.HlsDiscontinuityTags
import Amazonka.MediaLive.Types.HlsEncryptionType
import Amazonka.MediaLive.Types.HlsId3SegmentTaggingState
import Amazonka.MediaLive.Types.HlsIncompleteSegmentBehavior
import Amazonka.MediaLive.Types.HlsIvInManifest
import Amazonka.MediaLive.Types.HlsIvSource
import Amazonka.MediaLive.Types.HlsManifestCompression
import Amazonka.MediaLive.Types.HlsManifestDurationFormat
import Amazonka.MediaLive.Types.HlsMode
import Amazonka.MediaLive.Types.HlsOutputSelection
import Amazonka.MediaLive.Types.HlsProgramDateTime
import Amazonka.MediaLive.Types.HlsProgramDateTimeClock
import Amazonka.MediaLive.Types.HlsRedundantManifest
import Amazonka.MediaLive.Types.HlsSegmentationMode
import Amazonka.MediaLive.Types.HlsStreamInfResolution
import Amazonka.MediaLive.Types.HlsTimedMetadataId3Frame
import Amazonka.MediaLive.Types.HlsTsFileMode
import Amazonka.MediaLive.Types.IFrameOnlyPlaylistType
import Amazonka.MediaLive.Types.InputLossActionForHlsOut
import Amazonka.MediaLive.Types.KeyProviderSettings
import Amazonka.MediaLive.Types.OutputLocationRef
import qualified Amazonka.Prelude as Prelude

-- | Hls Group Settings
--
-- /See:/ 'newHlsGroupSettings' smart constructor.
data HlsGroupSettings = HlsGroupSettings'
  { -- | Choose one or more ad marker types to pass SCTE35 signals through to
    -- this group of Apple HLS outputs.
    HlsGroupSettings -> Maybe [HlsAdMarkers]
adMarkers :: Prelude.Maybe [HlsAdMarkers],
    -- | A partial URI prefix that will be prepended to each output in the media
    -- .m3u8 file. Can be used if base manifest is delivered from a different
    -- URL than the main .m3u8 file.
    HlsGroupSettings -> Maybe Text
baseUrlContent :: Prelude.Maybe Prelude.Text,
    -- | Optional. One value per output group. This field is required only if you
    -- are completing Base URL content A, and the downstream system has
    -- notified you that the media files for pipeline 1 of all outputs are in a
    -- location different from the media files for pipeline 0.
    HlsGroupSettings -> Maybe Text
baseUrlContent1 :: Prelude.Maybe Prelude.Text,
    -- | A partial URI prefix that will be prepended to each output in the media
    -- .m3u8 file. Can be used if base manifest is delivered from a different
    -- URL than the main .m3u8 file.
    HlsGroupSettings -> Maybe Text
baseUrlManifest :: Prelude.Maybe Prelude.Text,
    -- | Optional. One value per output group. Complete this field only if you
    -- are completing Base URL manifest A, and the downstream system has
    -- notified you that the child manifest files for pipeline 1 of all outputs
    -- are in a location different from the child manifest files for pipeline
    -- 0.
    HlsGroupSettings -> Maybe Text
baseUrlManifest1 :: Prelude.Maybe Prelude.Text,
    -- | Mapping of up to 4 caption channels to caption languages. Is only
    -- meaningful if captionLanguageSetting is set to \"insert\".
    HlsGroupSettings -> Maybe [CaptionLanguageMapping]
captionLanguageMappings :: Prelude.Maybe [CaptionLanguageMapping],
    -- | Applies only to 608 Embedded output captions. insert: Include
    -- CLOSED-CAPTIONS lines in the manifest. Specify at least one language in
    -- the CC1 Language Code field. One CLOSED-CAPTION line is added for each
    -- Language Code you specify. Make sure to specify the languages in the
    -- order in which they appear in the original source (if the source is
    -- embedded format) or the order of the caption selectors (if the source is
    -- other than embedded). Otherwise, languages in the manifest will not
    -- match up properly with the output captions. none: Include
    -- CLOSED-CAPTIONS=NONE line in the manifest. omit: Omit any
    -- CLOSED-CAPTIONS line from the manifest.
    HlsGroupSettings -> Maybe HlsCaptionLanguageSetting
captionLanguageSetting :: Prelude.Maybe HlsCaptionLanguageSetting,
    -- | When set to \"disabled\", sets the #EXT-X-ALLOW-CACHE:no tag in the
    -- manifest, which prevents clients from saving media segments for later
    -- replay.
    HlsGroupSettings -> Maybe HlsClientCache
clientCache :: Prelude.Maybe HlsClientCache,
    -- | Specification to use (RFC-6381 or the default RFC-4281) during m3u8
    -- playlist generation.
    HlsGroupSettings -> Maybe HlsCodecSpecification
codecSpecification :: Prelude.Maybe HlsCodecSpecification,
    -- | For use with encryptionType. This is a 128-bit, 16-byte hex value
    -- represented by a 32-character text string. If ivSource is set to
    -- \"explicit\" then this parameter is required and is used as the IV for
    -- encryption.
    HlsGroupSettings -> Maybe Text
constantIv :: Prelude.Maybe Prelude.Text,
    -- | Place segments in subdirectories.
    HlsGroupSettings -> Maybe HlsDirectoryStructure
directoryStructure :: Prelude.Maybe HlsDirectoryStructure,
    -- | Specifies whether to insert EXT-X-DISCONTINUITY tags in the HLS child
    -- manifests for this output group. Typically, choose Insert because these
    -- tags are required in the manifest (according to the HLS specification)
    -- and serve an important purpose. Choose Never Insert only if the
    -- downstream system is doing real-time failover (without using the
    -- MediaLive automatic failover feature) and only if that downstream system
    -- has advised you to exclude the tags.
    HlsGroupSettings -> Maybe HlsDiscontinuityTags
discontinuityTags :: Prelude.Maybe HlsDiscontinuityTags,
    -- | Encrypts the segments with the given encryption scheme. Exclude this
    -- parameter if no encryption is desired.
    HlsGroupSettings -> Maybe HlsEncryptionType
encryptionType :: Prelude.Maybe HlsEncryptionType,
    -- | Parameters that control interactions with the CDN.
    HlsGroupSettings -> Maybe HlsCdnSettings
hlsCdnSettings :: Prelude.Maybe HlsCdnSettings,
    -- | State of HLS ID3 Segment Tagging
    HlsGroupSettings -> Maybe HlsId3SegmentTaggingState
hlsId3SegmentTagging :: Prelude.Maybe HlsId3SegmentTaggingState,
    -- | DISABLED: Do not create an I-frame-only manifest, but do create the
    -- master and media manifests (according to the Output Selection field).
    -- STANDARD: Create an I-frame-only manifest for each output that contains
    -- video, as well as the other manifests (according to the Output Selection
    -- field). The I-frame manifest contains a #EXT-X-I-FRAMES-ONLY tag to
    -- indicate it is I-frame only, and one or more #EXT-X-BYTERANGE entries
    -- identifying the I-frame position. For example,
    -- #EXT-X-BYTERANGE:160364\@1461888\"
    HlsGroupSettings -> Maybe IFrameOnlyPlaylistType
iFrameOnlyPlaylists :: Prelude.Maybe IFrameOnlyPlaylistType,
    -- | Specifies whether to include the final (incomplete) segment in the media
    -- output when the pipeline stops producing output because of a channel
    -- stop, a channel pause or a loss of input to the pipeline. Auto means
    -- that MediaLive decides whether to include the final segment, depending
    -- on the channel class and the types of output groups. Suppress means to
    -- never include the incomplete segment. We recommend you choose Auto and
    -- let MediaLive control the behavior.
    HlsGroupSettings -> Maybe HlsIncompleteSegmentBehavior
incompleteSegmentBehavior :: Prelude.Maybe HlsIncompleteSegmentBehavior,
    -- | Applies only if Mode field is LIVE. Specifies the maximum number of
    -- segments in the media manifest file. After this maximum, older segments
    -- are removed from the media manifest. This number must be smaller than
    -- the number in the Keep Segments field.
    HlsGroupSettings -> Maybe Natural
indexNSegments :: Prelude.Maybe Prelude.Natural,
    -- | Parameter that control output group behavior on input loss.
    HlsGroupSettings -> Maybe InputLossActionForHlsOut
inputLossAction :: Prelude.Maybe InputLossActionForHlsOut,
    -- | For use with encryptionType. The IV (Initialization Vector) is a 128-bit
    -- number used in conjunction with the key for encrypting blocks. If set to
    -- \"include\", IV is listed in the manifest, otherwise the IV is not in
    -- the manifest.
    HlsGroupSettings -> Maybe HlsIvInManifest
ivInManifest :: Prelude.Maybe HlsIvInManifest,
    -- | For use with encryptionType. The IV (Initialization Vector) is a 128-bit
    -- number used in conjunction with the key for encrypting blocks. If this
    -- setting is \"followsSegmentNumber\", it will cause the IV to change
    -- every segment (to match the segment number). If this is set to
    -- \"explicit\", you must enter a constantIv value.
    HlsGroupSettings -> Maybe HlsIvSource
ivSource :: Prelude.Maybe HlsIvSource,
    -- | Applies only if Mode field is LIVE. Specifies the number of media
    -- segments to retain in the destination directory. This number should be
    -- bigger than indexNSegments (Num segments). We recommend (value = (2 x
    -- indexNsegments) + 1). If this \"keep segments\" number is too low, the
    -- following might happen: the player is still reading a media manifest
    -- file that lists this segment, but that segment has been removed from the
    -- destination directory (as directed by indexNSegments). This situation
    -- would result in a 404 HTTP error on the player.
    HlsGroupSettings -> Maybe Natural
keepSegments :: Prelude.Maybe Prelude.Natural,
    -- | The value specifies how the key is represented in the resource
    -- identified by the URI. If parameter is absent, an implicit value of
    -- \"identity\" is used. A reverse DNS string can also be given.
    HlsGroupSettings -> Maybe Text
keyFormat :: Prelude.Maybe Prelude.Text,
    -- | Either a single positive integer version value or a slash delimited list
    -- of version values (1\/2\/3).
    HlsGroupSettings -> Maybe Text
keyFormatVersions :: Prelude.Maybe Prelude.Text,
    -- | The key provider settings.
    HlsGroupSettings -> Maybe KeyProviderSettings
keyProviderSettings :: Prelude.Maybe KeyProviderSettings,
    -- | When set to gzip, compresses HLS playlist.
    HlsGroupSettings -> Maybe HlsManifestCompression
manifestCompression :: Prelude.Maybe HlsManifestCompression,
    -- | Indicates whether the output manifest should use floating point or
    -- integer values for segment duration.
    HlsGroupSettings -> Maybe HlsManifestDurationFormat
manifestDurationFormat :: Prelude.Maybe HlsManifestDurationFormat,
    -- | Minimum length of MPEG-2 Transport Stream segments in seconds. When set,
    -- minimum segment length is enforced by looking ahead and back within the
    -- specified range for a nearby avail and extending the segment size if
    -- needed.
    HlsGroupSettings -> Maybe Natural
minSegmentLength :: Prelude.Maybe Prelude.Natural,
    -- | If \"vod\", all segments are indexed and kept permanently in the
    -- destination and manifest. If \"live\", only the number segments
    -- specified in keepSegments and indexNSegments are kept; newer segments
    -- replace older segments, which may prevent players from rewinding all the
    -- way to the beginning of the event. VOD mode uses HLS EXT-X-PLAYLIST-TYPE
    -- of EVENT while the channel is running, converting it to a \"VOD\" type
    -- manifest on completion of the stream.
    HlsGroupSettings -> Maybe HlsMode
mode :: Prelude.Maybe HlsMode,
    -- | MANIFESTS_AND_SEGMENTS: Generates manifests (master manifest, if
    -- applicable, and media manifests) for this output group.
    -- VARIANT_MANIFESTS_AND_SEGMENTS: Generates media manifests for this
    -- output group, but not a master manifest. SEGMENTS_ONLY: Does not
    -- generate any manifests for this output group.
    HlsGroupSettings -> Maybe HlsOutputSelection
outputSelection :: Prelude.Maybe HlsOutputSelection,
    -- | Includes or excludes EXT-X-PROGRAM-DATE-TIME tag in .m3u8 manifest
    -- files. The value is calculated using the program date time clock.
    HlsGroupSettings -> Maybe HlsProgramDateTime
programDateTime :: Prelude.Maybe HlsProgramDateTime,
    -- | Specifies the algorithm used to drive the HLS EXT-X-PROGRAM-DATE-TIME
    -- clock. Options include: INITIALIZE_FROM_OUTPUT_TIMECODE: The PDT clock
    -- is initialized as a function of the first output timecode, then
    -- incremented by the EXTINF duration of each encoded segment.
    -- SYSTEM_CLOCK: The PDT clock is initialized as a function of the UTC wall
    -- clock, then incremented by the EXTINF duration of each encoded segment.
    -- If the PDT clock diverges from the wall clock by more than 500ms, it is
    -- resynchronized to the wall clock.
    HlsGroupSettings -> Maybe HlsProgramDateTimeClock
programDateTimeClock :: Prelude.Maybe HlsProgramDateTimeClock,
    -- | Period of insertion of EXT-X-PROGRAM-DATE-TIME entry, in seconds.
    HlsGroupSettings -> Maybe Natural
programDateTimePeriod :: Prelude.Maybe Prelude.Natural,
    -- | ENABLED: The master manifest (.m3u8 file) for each pipeline includes
    -- information about both pipelines: first its own media files, then the
    -- media files of the other pipeline. This feature allows playout device
    -- that support stale manifest detection to switch from one manifest to the
    -- other, when the current manifest seems to be stale. There are still two
    -- destinations and two master manifests, but both master manifests
    -- reference the media files from both pipelines. DISABLED: The master
    -- manifest (.m3u8 file) for each pipeline includes information about its
    -- own pipeline only. For an HLS output group with MediaPackage as the
    -- destination, the DISABLED behavior is always followed. MediaPackage
    -- regenerates the manifests it serves to players so a redundant manifest
    -- from MediaLive is irrelevant.
    HlsGroupSettings -> Maybe HlsRedundantManifest
redundantManifest :: Prelude.Maybe HlsRedundantManifest,
    -- | Length of MPEG-2 Transport Stream segments to create in seconds. Note
    -- that segments will end on the next keyframe after this duration, so
    -- actual segment length may be longer.
    HlsGroupSettings -> Maybe Natural
segmentLength :: Prelude.Maybe Prelude.Natural,
    -- | useInputSegmentation has been deprecated. The configured segment size is
    -- always used.
    HlsGroupSettings -> Maybe HlsSegmentationMode
segmentationMode :: Prelude.Maybe HlsSegmentationMode,
    -- | Number of segments to write to a subdirectory before starting a new one.
    -- directoryStructure must be subdirectoryPerStream for this setting to
    -- have an effect.
    HlsGroupSettings -> Maybe Natural
segmentsPerSubdirectory :: Prelude.Maybe Prelude.Natural,
    -- | Include or exclude RESOLUTION attribute for video in EXT-X-STREAM-INF
    -- tag of variant manifest.
    HlsGroupSettings -> Maybe HlsStreamInfResolution
streamInfResolution :: Prelude.Maybe HlsStreamInfResolution,
    -- | Indicates ID3 frame that has the timecode.
    HlsGroupSettings -> Maybe HlsTimedMetadataId3Frame
timedMetadataId3Frame :: Prelude.Maybe HlsTimedMetadataId3Frame,
    -- | Timed Metadata interval in seconds.
    HlsGroupSettings -> Maybe Natural
timedMetadataId3Period :: Prelude.Maybe Prelude.Natural,
    -- | Provides an extra millisecond delta offset to fine tune the timestamps.
    HlsGroupSettings -> Maybe Natural
timestampDeltaMilliseconds :: Prelude.Maybe Prelude.Natural,
    -- | SEGMENTED_FILES: Emit the program as segments - multiple .ts media
    -- files. SINGLE_FILE: Applies only if Mode field is VOD. Emit the program
    -- as a single .ts media file. The media manifest includes #EXT-X-BYTERANGE
    -- tags to index segments for playback. A typical use for this value is
    -- when sending the output to AWS Elemental MediaConvert, which can accept
    -- only a single media file. Playback while the channel is running is not
    -- guaranteed due to HTTP server caching.
    HlsGroupSettings -> Maybe HlsTsFileMode
tsFileMode :: Prelude.Maybe HlsTsFileMode,
    -- | A directory or HTTP destination for the HLS segments, manifest files,
    -- and encryption keys (if enabled).
    HlsGroupSettings -> OutputLocationRef
destination :: OutputLocationRef
  }
  deriving (HlsGroupSettings -> HlsGroupSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HlsGroupSettings -> HlsGroupSettings -> Bool
$c/= :: HlsGroupSettings -> HlsGroupSettings -> Bool
== :: HlsGroupSettings -> HlsGroupSettings -> Bool
$c== :: HlsGroupSettings -> HlsGroupSettings -> Bool
Prelude.Eq, ReadPrec [HlsGroupSettings]
ReadPrec HlsGroupSettings
Int -> ReadS HlsGroupSettings
ReadS [HlsGroupSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HlsGroupSettings]
$creadListPrec :: ReadPrec [HlsGroupSettings]
readPrec :: ReadPrec HlsGroupSettings
$creadPrec :: ReadPrec HlsGroupSettings
readList :: ReadS [HlsGroupSettings]
$creadList :: ReadS [HlsGroupSettings]
readsPrec :: Int -> ReadS HlsGroupSettings
$creadsPrec :: Int -> ReadS HlsGroupSettings
Prelude.Read, Int -> HlsGroupSettings -> ShowS
[HlsGroupSettings] -> ShowS
HlsGroupSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HlsGroupSettings] -> ShowS
$cshowList :: [HlsGroupSettings] -> ShowS
show :: HlsGroupSettings -> String
$cshow :: HlsGroupSettings -> String
showsPrec :: Int -> HlsGroupSettings -> ShowS
$cshowsPrec :: Int -> HlsGroupSettings -> ShowS
Prelude.Show, forall x. Rep HlsGroupSettings x -> HlsGroupSettings
forall x. HlsGroupSettings -> Rep HlsGroupSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HlsGroupSettings x -> HlsGroupSettings
$cfrom :: forall x. HlsGroupSettings -> Rep HlsGroupSettings x
Prelude.Generic)

-- |
-- Create a value of 'HlsGroupSettings' 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:
--
-- 'adMarkers', 'hlsGroupSettings_adMarkers' - Choose one or more ad marker types to pass SCTE35 signals through to
-- this group of Apple HLS outputs.
--
-- 'baseUrlContent', 'hlsGroupSettings_baseUrlContent' - A partial URI prefix that will be prepended to each output in the media
-- .m3u8 file. Can be used if base manifest is delivered from a different
-- URL than the main .m3u8 file.
--
-- 'baseUrlContent1', 'hlsGroupSettings_baseUrlContent1' - Optional. One value per output group. This field is required only if you
-- are completing Base URL content A, and the downstream system has
-- notified you that the media files for pipeline 1 of all outputs are in a
-- location different from the media files for pipeline 0.
--
-- 'baseUrlManifest', 'hlsGroupSettings_baseUrlManifest' - A partial URI prefix that will be prepended to each output in the media
-- .m3u8 file. Can be used if base manifest is delivered from a different
-- URL than the main .m3u8 file.
--
-- 'baseUrlManifest1', 'hlsGroupSettings_baseUrlManifest1' - Optional. One value per output group. Complete this field only if you
-- are completing Base URL manifest A, and the downstream system has
-- notified you that the child manifest files for pipeline 1 of all outputs
-- are in a location different from the child manifest files for pipeline
-- 0.
--
-- 'captionLanguageMappings', 'hlsGroupSettings_captionLanguageMappings' - Mapping of up to 4 caption channels to caption languages. Is only
-- meaningful if captionLanguageSetting is set to \"insert\".
--
-- 'captionLanguageSetting', 'hlsGroupSettings_captionLanguageSetting' - Applies only to 608 Embedded output captions. insert: Include
-- CLOSED-CAPTIONS lines in the manifest. Specify at least one language in
-- the CC1 Language Code field. One CLOSED-CAPTION line is added for each
-- Language Code you specify. Make sure to specify the languages in the
-- order in which they appear in the original source (if the source is
-- embedded format) or the order of the caption selectors (if the source is
-- other than embedded). Otherwise, languages in the manifest will not
-- match up properly with the output captions. none: Include
-- CLOSED-CAPTIONS=NONE line in the manifest. omit: Omit any
-- CLOSED-CAPTIONS line from the manifest.
--
-- 'clientCache', 'hlsGroupSettings_clientCache' - When set to \"disabled\", sets the #EXT-X-ALLOW-CACHE:no tag in the
-- manifest, which prevents clients from saving media segments for later
-- replay.
--
-- 'codecSpecification', 'hlsGroupSettings_codecSpecification' - Specification to use (RFC-6381 or the default RFC-4281) during m3u8
-- playlist generation.
--
-- 'constantIv', 'hlsGroupSettings_constantIv' - For use with encryptionType. This is a 128-bit, 16-byte hex value
-- represented by a 32-character text string. If ivSource is set to
-- \"explicit\" then this parameter is required and is used as the IV for
-- encryption.
--
-- 'directoryStructure', 'hlsGroupSettings_directoryStructure' - Place segments in subdirectories.
--
-- 'discontinuityTags', 'hlsGroupSettings_discontinuityTags' - Specifies whether to insert EXT-X-DISCONTINUITY tags in the HLS child
-- manifests for this output group. Typically, choose Insert because these
-- tags are required in the manifest (according to the HLS specification)
-- and serve an important purpose. Choose Never Insert only if the
-- downstream system is doing real-time failover (without using the
-- MediaLive automatic failover feature) and only if that downstream system
-- has advised you to exclude the tags.
--
-- 'encryptionType', 'hlsGroupSettings_encryptionType' - Encrypts the segments with the given encryption scheme. Exclude this
-- parameter if no encryption is desired.
--
-- 'hlsCdnSettings', 'hlsGroupSettings_hlsCdnSettings' - Parameters that control interactions with the CDN.
--
-- 'hlsId3SegmentTagging', 'hlsGroupSettings_hlsId3SegmentTagging' - State of HLS ID3 Segment Tagging
--
-- 'iFrameOnlyPlaylists', 'hlsGroupSettings_iFrameOnlyPlaylists' - DISABLED: Do not create an I-frame-only manifest, but do create the
-- master and media manifests (according to the Output Selection field).
-- STANDARD: Create an I-frame-only manifest for each output that contains
-- video, as well as the other manifests (according to the Output Selection
-- field). The I-frame manifest contains a #EXT-X-I-FRAMES-ONLY tag to
-- indicate it is I-frame only, and one or more #EXT-X-BYTERANGE entries
-- identifying the I-frame position. For example,
-- #EXT-X-BYTERANGE:160364\@1461888\"
--
-- 'incompleteSegmentBehavior', 'hlsGroupSettings_incompleteSegmentBehavior' - Specifies whether to include the final (incomplete) segment in the media
-- output when the pipeline stops producing output because of a channel
-- stop, a channel pause or a loss of input to the pipeline. Auto means
-- that MediaLive decides whether to include the final segment, depending
-- on the channel class and the types of output groups. Suppress means to
-- never include the incomplete segment. We recommend you choose Auto and
-- let MediaLive control the behavior.
--
-- 'indexNSegments', 'hlsGroupSettings_indexNSegments' - Applies only if Mode field is LIVE. Specifies the maximum number of
-- segments in the media manifest file. After this maximum, older segments
-- are removed from the media manifest. This number must be smaller than
-- the number in the Keep Segments field.
--
-- 'inputLossAction', 'hlsGroupSettings_inputLossAction' - Parameter that control output group behavior on input loss.
--
-- 'ivInManifest', 'hlsGroupSettings_ivInManifest' - For use with encryptionType. The IV (Initialization Vector) is a 128-bit
-- number used in conjunction with the key for encrypting blocks. If set to
-- \"include\", IV is listed in the manifest, otherwise the IV is not in
-- the manifest.
--
-- 'ivSource', 'hlsGroupSettings_ivSource' - For use with encryptionType. The IV (Initialization Vector) is a 128-bit
-- number used in conjunction with the key for encrypting blocks. If this
-- setting is \"followsSegmentNumber\", it will cause the IV to change
-- every segment (to match the segment number). If this is set to
-- \"explicit\", you must enter a constantIv value.
--
-- 'keepSegments', 'hlsGroupSettings_keepSegments' - Applies only if Mode field is LIVE. Specifies the number of media
-- segments to retain in the destination directory. This number should be
-- bigger than indexNSegments (Num segments). We recommend (value = (2 x
-- indexNsegments) + 1). If this \"keep segments\" number is too low, the
-- following might happen: the player is still reading a media manifest
-- file that lists this segment, but that segment has been removed from the
-- destination directory (as directed by indexNSegments). This situation
-- would result in a 404 HTTP error on the player.
--
-- 'keyFormat', 'hlsGroupSettings_keyFormat' - The value specifies how the key is represented in the resource
-- identified by the URI. If parameter is absent, an implicit value of
-- \"identity\" is used. A reverse DNS string can also be given.
--
-- 'keyFormatVersions', 'hlsGroupSettings_keyFormatVersions' - Either a single positive integer version value or a slash delimited list
-- of version values (1\/2\/3).
--
-- 'keyProviderSettings', 'hlsGroupSettings_keyProviderSettings' - The key provider settings.
--
-- 'manifestCompression', 'hlsGroupSettings_manifestCompression' - When set to gzip, compresses HLS playlist.
--
-- 'manifestDurationFormat', 'hlsGroupSettings_manifestDurationFormat' - Indicates whether the output manifest should use floating point or
-- integer values for segment duration.
--
-- 'minSegmentLength', 'hlsGroupSettings_minSegmentLength' - Minimum length of MPEG-2 Transport Stream segments in seconds. When set,
-- minimum segment length is enforced by looking ahead and back within the
-- specified range for a nearby avail and extending the segment size if
-- needed.
--
-- 'mode', 'hlsGroupSettings_mode' - If \"vod\", all segments are indexed and kept permanently in the
-- destination and manifest. If \"live\", only the number segments
-- specified in keepSegments and indexNSegments are kept; newer segments
-- replace older segments, which may prevent players from rewinding all the
-- way to the beginning of the event. VOD mode uses HLS EXT-X-PLAYLIST-TYPE
-- of EVENT while the channel is running, converting it to a \"VOD\" type
-- manifest on completion of the stream.
--
-- 'outputSelection', 'hlsGroupSettings_outputSelection' - MANIFESTS_AND_SEGMENTS: Generates manifests (master manifest, if
-- applicable, and media manifests) for this output group.
-- VARIANT_MANIFESTS_AND_SEGMENTS: Generates media manifests for this
-- output group, but not a master manifest. SEGMENTS_ONLY: Does not
-- generate any manifests for this output group.
--
-- 'programDateTime', 'hlsGroupSettings_programDateTime' - Includes or excludes EXT-X-PROGRAM-DATE-TIME tag in .m3u8 manifest
-- files. The value is calculated using the program date time clock.
--
-- 'programDateTimeClock', 'hlsGroupSettings_programDateTimeClock' - Specifies the algorithm used to drive the HLS EXT-X-PROGRAM-DATE-TIME
-- clock. Options include: INITIALIZE_FROM_OUTPUT_TIMECODE: The PDT clock
-- is initialized as a function of the first output timecode, then
-- incremented by the EXTINF duration of each encoded segment.
-- SYSTEM_CLOCK: The PDT clock is initialized as a function of the UTC wall
-- clock, then incremented by the EXTINF duration of each encoded segment.
-- If the PDT clock diverges from the wall clock by more than 500ms, it is
-- resynchronized to the wall clock.
--
-- 'programDateTimePeriod', 'hlsGroupSettings_programDateTimePeriod' - Period of insertion of EXT-X-PROGRAM-DATE-TIME entry, in seconds.
--
-- 'redundantManifest', 'hlsGroupSettings_redundantManifest' - ENABLED: The master manifest (.m3u8 file) for each pipeline includes
-- information about both pipelines: first its own media files, then the
-- media files of the other pipeline. This feature allows playout device
-- that support stale manifest detection to switch from one manifest to the
-- other, when the current manifest seems to be stale. There are still two
-- destinations and two master manifests, but both master manifests
-- reference the media files from both pipelines. DISABLED: The master
-- manifest (.m3u8 file) for each pipeline includes information about its
-- own pipeline only. For an HLS output group with MediaPackage as the
-- destination, the DISABLED behavior is always followed. MediaPackage
-- regenerates the manifests it serves to players so a redundant manifest
-- from MediaLive is irrelevant.
--
-- 'segmentLength', 'hlsGroupSettings_segmentLength' - Length of MPEG-2 Transport Stream segments to create in seconds. Note
-- that segments will end on the next keyframe after this duration, so
-- actual segment length may be longer.
--
-- 'segmentationMode', 'hlsGroupSettings_segmentationMode' - useInputSegmentation has been deprecated. The configured segment size is
-- always used.
--
-- 'segmentsPerSubdirectory', 'hlsGroupSettings_segmentsPerSubdirectory' - Number of segments to write to a subdirectory before starting a new one.
-- directoryStructure must be subdirectoryPerStream for this setting to
-- have an effect.
--
-- 'streamInfResolution', 'hlsGroupSettings_streamInfResolution' - Include or exclude RESOLUTION attribute for video in EXT-X-STREAM-INF
-- tag of variant manifest.
--
-- 'timedMetadataId3Frame', 'hlsGroupSettings_timedMetadataId3Frame' - Indicates ID3 frame that has the timecode.
--
-- 'timedMetadataId3Period', 'hlsGroupSettings_timedMetadataId3Period' - Timed Metadata interval in seconds.
--
-- 'timestampDeltaMilliseconds', 'hlsGroupSettings_timestampDeltaMilliseconds' - Provides an extra millisecond delta offset to fine tune the timestamps.
--
-- 'tsFileMode', 'hlsGroupSettings_tsFileMode' - SEGMENTED_FILES: Emit the program as segments - multiple .ts media
-- files. SINGLE_FILE: Applies only if Mode field is VOD. Emit the program
-- as a single .ts media file. The media manifest includes #EXT-X-BYTERANGE
-- tags to index segments for playback. A typical use for this value is
-- when sending the output to AWS Elemental MediaConvert, which can accept
-- only a single media file. Playback while the channel is running is not
-- guaranteed due to HTTP server caching.
--
-- 'destination', 'hlsGroupSettings_destination' - A directory or HTTP destination for the HLS segments, manifest files,
-- and encryption keys (if enabled).
newHlsGroupSettings ::
  -- | 'destination'
  OutputLocationRef ->
  HlsGroupSettings
newHlsGroupSettings :: OutputLocationRef -> HlsGroupSettings
newHlsGroupSettings OutputLocationRef
pDestination_ =
  HlsGroupSettings'
    { $sel:adMarkers:HlsGroupSettings' :: Maybe [HlsAdMarkers]
adMarkers = forall a. Maybe a
Prelude.Nothing,
      $sel:baseUrlContent:HlsGroupSettings' :: Maybe Text
baseUrlContent = forall a. Maybe a
Prelude.Nothing,
      $sel:baseUrlContent1:HlsGroupSettings' :: Maybe Text
baseUrlContent1 = forall a. Maybe a
Prelude.Nothing,
      $sel:baseUrlManifest:HlsGroupSettings' :: Maybe Text
baseUrlManifest = forall a. Maybe a
Prelude.Nothing,
      $sel:baseUrlManifest1:HlsGroupSettings' :: Maybe Text
baseUrlManifest1 = forall a. Maybe a
Prelude.Nothing,
      $sel:captionLanguageMappings:HlsGroupSettings' :: Maybe [CaptionLanguageMapping]
captionLanguageMappings = forall a. Maybe a
Prelude.Nothing,
      $sel:captionLanguageSetting:HlsGroupSettings' :: Maybe HlsCaptionLanguageSetting
captionLanguageSetting = forall a. Maybe a
Prelude.Nothing,
      $sel:clientCache:HlsGroupSettings' :: Maybe HlsClientCache
clientCache = forall a. Maybe a
Prelude.Nothing,
      $sel:codecSpecification:HlsGroupSettings' :: Maybe HlsCodecSpecification
codecSpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:constantIv:HlsGroupSettings' :: Maybe Text
constantIv = forall a. Maybe a
Prelude.Nothing,
      $sel:directoryStructure:HlsGroupSettings' :: Maybe HlsDirectoryStructure
directoryStructure = forall a. Maybe a
Prelude.Nothing,
      $sel:discontinuityTags:HlsGroupSettings' :: Maybe HlsDiscontinuityTags
discontinuityTags = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionType:HlsGroupSettings' :: Maybe HlsEncryptionType
encryptionType = forall a. Maybe a
Prelude.Nothing,
      $sel:hlsCdnSettings:HlsGroupSettings' :: Maybe HlsCdnSettings
hlsCdnSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:hlsId3SegmentTagging:HlsGroupSettings' :: Maybe HlsId3SegmentTaggingState
hlsId3SegmentTagging = forall a. Maybe a
Prelude.Nothing,
      $sel:iFrameOnlyPlaylists:HlsGroupSettings' :: Maybe IFrameOnlyPlaylistType
iFrameOnlyPlaylists = forall a. Maybe a
Prelude.Nothing,
      $sel:incompleteSegmentBehavior:HlsGroupSettings' :: Maybe HlsIncompleteSegmentBehavior
incompleteSegmentBehavior = forall a. Maybe a
Prelude.Nothing,
      $sel:indexNSegments:HlsGroupSettings' :: Maybe Natural
indexNSegments = forall a. Maybe a
Prelude.Nothing,
      $sel:inputLossAction:HlsGroupSettings' :: Maybe InputLossActionForHlsOut
inputLossAction = forall a. Maybe a
Prelude.Nothing,
      $sel:ivInManifest:HlsGroupSettings' :: Maybe HlsIvInManifest
ivInManifest = forall a. Maybe a
Prelude.Nothing,
      $sel:ivSource:HlsGroupSettings' :: Maybe HlsIvSource
ivSource = forall a. Maybe a
Prelude.Nothing,
      $sel:keepSegments:HlsGroupSettings' :: Maybe Natural
keepSegments = forall a. Maybe a
Prelude.Nothing,
      $sel:keyFormat:HlsGroupSettings' :: Maybe Text
keyFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:keyFormatVersions:HlsGroupSettings' :: Maybe Text
keyFormatVersions = forall a. Maybe a
Prelude.Nothing,
      $sel:keyProviderSettings:HlsGroupSettings' :: Maybe KeyProviderSettings
keyProviderSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:manifestCompression:HlsGroupSettings' :: Maybe HlsManifestCompression
manifestCompression = forall a. Maybe a
Prelude.Nothing,
      $sel:manifestDurationFormat:HlsGroupSettings' :: Maybe HlsManifestDurationFormat
manifestDurationFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:minSegmentLength:HlsGroupSettings' :: Maybe Natural
minSegmentLength = forall a. Maybe a
Prelude.Nothing,
      $sel:mode:HlsGroupSettings' :: Maybe HlsMode
mode = forall a. Maybe a
Prelude.Nothing,
      $sel:outputSelection:HlsGroupSettings' :: Maybe HlsOutputSelection
outputSelection = forall a. Maybe a
Prelude.Nothing,
      $sel:programDateTime:HlsGroupSettings' :: Maybe HlsProgramDateTime
programDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:programDateTimeClock:HlsGroupSettings' :: Maybe HlsProgramDateTimeClock
programDateTimeClock = forall a. Maybe a
Prelude.Nothing,
      $sel:programDateTimePeriod:HlsGroupSettings' :: Maybe Natural
programDateTimePeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:redundantManifest:HlsGroupSettings' :: Maybe HlsRedundantManifest
redundantManifest = forall a. Maybe a
Prelude.Nothing,
      $sel:segmentLength:HlsGroupSettings' :: Maybe Natural
segmentLength = forall a. Maybe a
Prelude.Nothing,
      $sel:segmentationMode:HlsGroupSettings' :: Maybe HlsSegmentationMode
segmentationMode = forall a. Maybe a
Prelude.Nothing,
      $sel:segmentsPerSubdirectory:HlsGroupSettings' :: Maybe Natural
segmentsPerSubdirectory = forall a. Maybe a
Prelude.Nothing,
      $sel:streamInfResolution:HlsGroupSettings' :: Maybe HlsStreamInfResolution
streamInfResolution = forall a. Maybe a
Prelude.Nothing,
      $sel:timedMetadataId3Frame:HlsGroupSettings' :: Maybe HlsTimedMetadataId3Frame
timedMetadataId3Frame = forall a. Maybe a
Prelude.Nothing,
      $sel:timedMetadataId3Period:HlsGroupSettings' :: Maybe Natural
timedMetadataId3Period = forall a. Maybe a
Prelude.Nothing,
      $sel:timestampDeltaMilliseconds:HlsGroupSettings' :: Maybe Natural
timestampDeltaMilliseconds = forall a. Maybe a
Prelude.Nothing,
      $sel:tsFileMode:HlsGroupSettings' :: Maybe HlsTsFileMode
tsFileMode = forall a. Maybe a
Prelude.Nothing,
      $sel:destination:HlsGroupSettings' :: OutputLocationRef
destination = OutputLocationRef
pDestination_
    }

-- | Choose one or more ad marker types to pass SCTE35 signals through to
-- this group of Apple HLS outputs.
hlsGroupSettings_adMarkers :: Lens.Lens' HlsGroupSettings (Prelude.Maybe [HlsAdMarkers])
hlsGroupSettings_adMarkers :: Lens' HlsGroupSettings (Maybe [HlsAdMarkers])
hlsGroupSettings_adMarkers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe [HlsAdMarkers]
adMarkers :: Maybe [HlsAdMarkers]
$sel:adMarkers:HlsGroupSettings' :: HlsGroupSettings -> Maybe [HlsAdMarkers]
adMarkers} -> Maybe [HlsAdMarkers]
adMarkers) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe [HlsAdMarkers]
a -> HlsGroupSettings
s {$sel:adMarkers:HlsGroupSettings' :: Maybe [HlsAdMarkers]
adMarkers = Maybe [HlsAdMarkers]
a} :: HlsGroupSettings) 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

-- | A partial URI prefix that will be prepended to each output in the media
-- .m3u8 file. Can be used if base manifest is delivered from a different
-- URL than the main .m3u8 file.
hlsGroupSettings_baseUrlContent :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Text)
hlsGroupSettings_baseUrlContent :: Lens' HlsGroupSettings (Maybe Text)
hlsGroupSettings_baseUrlContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Text
baseUrlContent :: Maybe Text
$sel:baseUrlContent:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
baseUrlContent} -> Maybe Text
baseUrlContent) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Text
a -> HlsGroupSettings
s {$sel:baseUrlContent:HlsGroupSettings' :: Maybe Text
baseUrlContent = Maybe Text
a} :: HlsGroupSettings)

-- | Optional. One value per output group. This field is required only if you
-- are completing Base URL content A, and the downstream system has
-- notified you that the media files for pipeline 1 of all outputs are in a
-- location different from the media files for pipeline 0.
hlsGroupSettings_baseUrlContent1 :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Text)
hlsGroupSettings_baseUrlContent1 :: Lens' HlsGroupSettings (Maybe Text)
hlsGroupSettings_baseUrlContent1 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Text
baseUrlContent1 :: Maybe Text
$sel:baseUrlContent1:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
baseUrlContent1} -> Maybe Text
baseUrlContent1) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Text
a -> HlsGroupSettings
s {$sel:baseUrlContent1:HlsGroupSettings' :: Maybe Text
baseUrlContent1 = Maybe Text
a} :: HlsGroupSettings)

-- | A partial URI prefix that will be prepended to each output in the media
-- .m3u8 file. Can be used if base manifest is delivered from a different
-- URL than the main .m3u8 file.
hlsGroupSettings_baseUrlManifest :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Text)
hlsGroupSettings_baseUrlManifest :: Lens' HlsGroupSettings (Maybe Text)
hlsGroupSettings_baseUrlManifest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Text
baseUrlManifest :: Maybe Text
$sel:baseUrlManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
baseUrlManifest} -> Maybe Text
baseUrlManifest) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Text
a -> HlsGroupSettings
s {$sel:baseUrlManifest:HlsGroupSettings' :: Maybe Text
baseUrlManifest = Maybe Text
a} :: HlsGroupSettings)

-- | Optional. One value per output group. Complete this field only if you
-- are completing Base URL manifest A, and the downstream system has
-- notified you that the child manifest files for pipeline 1 of all outputs
-- are in a location different from the child manifest files for pipeline
-- 0.
hlsGroupSettings_baseUrlManifest1 :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Text)
hlsGroupSettings_baseUrlManifest1 :: Lens' HlsGroupSettings (Maybe Text)
hlsGroupSettings_baseUrlManifest1 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Text
baseUrlManifest1 :: Maybe Text
$sel:baseUrlManifest1:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
baseUrlManifest1} -> Maybe Text
baseUrlManifest1) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Text
a -> HlsGroupSettings
s {$sel:baseUrlManifest1:HlsGroupSettings' :: Maybe Text
baseUrlManifest1 = Maybe Text
a} :: HlsGroupSettings)

-- | Mapping of up to 4 caption channels to caption languages. Is only
-- meaningful if captionLanguageSetting is set to \"insert\".
hlsGroupSettings_captionLanguageMappings :: Lens.Lens' HlsGroupSettings (Prelude.Maybe [CaptionLanguageMapping])
hlsGroupSettings_captionLanguageMappings :: Lens' HlsGroupSettings (Maybe [CaptionLanguageMapping])
hlsGroupSettings_captionLanguageMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe [CaptionLanguageMapping]
captionLanguageMappings :: Maybe [CaptionLanguageMapping]
$sel:captionLanguageMappings:HlsGroupSettings' :: HlsGroupSettings -> Maybe [CaptionLanguageMapping]
captionLanguageMappings} -> Maybe [CaptionLanguageMapping]
captionLanguageMappings) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe [CaptionLanguageMapping]
a -> HlsGroupSettings
s {$sel:captionLanguageMappings:HlsGroupSettings' :: Maybe [CaptionLanguageMapping]
captionLanguageMappings = Maybe [CaptionLanguageMapping]
a} :: HlsGroupSettings) 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

-- | Applies only to 608 Embedded output captions. insert: Include
-- CLOSED-CAPTIONS lines in the manifest. Specify at least one language in
-- the CC1 Language Code field. One CLOSED-CAPTION line is added for each
-- Language Code you specify. Make sure to specify the languages in the
-- order in which they appear in the original source (if the source is
-- embedded format) or the order of the caption selectors (if the source is
-- other than embedded). Otherwise, languages in the manifest will not
-- match up properly with the output captions. none: Include
-- CLOSED-CAPTIONS=NONE line in the manifest. omit: Omit any
-- CLOSED-CAPTIONS line from the manifest.
hlsGroupSettings_captionLanguageSetting :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsCaptionLanguageSetting)
hlsGroupSettings_captionLanguageSetting :: Lens' HlsGroupSettings (Maybe HlsCaptionLanguageSetting)
hlsGroupSettings_captionLanguageSetting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsCaptionLanguageSetting
captionLanguageSetting :: Maybe HlsCaptionLanguageSetting
$sel:captionLanguageSetting:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCaptionLanguageSetting
captionLanguageSetting} -> Maybe HlsCaptionLanguageSetting
captionLanguageSetting) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsCaptionLanguageSetting
a -> HlsGroupSettings
s {$sel:captionLanguageSetting:HlsGroupSettings' :: Maybe HlsCaptionLanguageSetting
captionLanguageSetting = Maybe HlsCaptionLanguageSetting
a} :: HlsGroupSettings)

-- | When set to \"disabled\", sets the #EXT-X-ALLOW-CACHE:no tag in the
-- manifest, which prevents clients from saving media segments for later
-- replay.
hlsGroupSettings_clientCache :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsClientCache)
hlsGroupSettings_clientCache :: Lens' HlsGroupSettings (Maybe HlsClientCache)
hlsGroupSettings_clientCache = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsClientCache
clientCache :: Maybe HlsClientCache
$sel:clientCache:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsClientCache
clientCache} -> Maybe HlsClientCache
clientCache) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsClientCache
a -> HlsGroupSettings
s {$sel:clientCache:HlsGroupSettings' :: Maybe HlsClientCache
clientCache = Maybe HlsClientCache
a} :: HlsGroupSettings)

-- | Specification to use (RFC-6381 or the default RFC-4281) during m3u8
-- playlist generation.
hlsGroupSettings_codecSpecification :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsCodecSpecification)
hlsGroupSettings_codecSpecification :: Lens' HlsGroupSettings (Maybe HlsCodecSpecification)
hlsGroupSettings_codecSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsCodecSpecification
codecSpecification :: Maybe HlsCodecSpecification
$sel:codecSpecification:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCodecSpecification
codecSpecification} -> Maybe HlsCodecSpecification
codecSpecification) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsCodecSpecification
a -> HlsGroupSettings
s {$sel:codecSpecification:HlsGroupSettings' :: Maybe HlsCodecSpecification
codecSpecification = Maybe HlsCodecSpecification
a} :: HlsGroupSettings)

-- | For use with encryptionType. This is a 128-bit, 16-byte hex value
-- represented by a 32-character text string. If ivSource is set to
-- \"explicit\" then this parameter is required and is used as the IV for
-- encryption.
hlsGroupSettings_constantIv :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Text)
hlsGroupSettings_constantIv :: Lens' HlsGroupSettings (Maybe Text)
hlsGroupSettings_constantIv = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Text
constantIv :: Maybe Text
$sel:constantIv:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
constantIv} -> Maybe Text
constantIv) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Text
a -> HlsGroupSettings
s {$sel:constantIv:HlsGroupSettings' :: Maybe Text
constantIv = Maybe Text
a} :: HlsGroupSettings)

-- | Place segments in subdirectories.
hlsGroupSettings_directoryStructure :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsDirectoryStructure)
hlsGroupSettings_directoryStructure :: Lens' HlsGroupSettings (Maybe HlsDirectoryStructure)
hlsGroupSettings_directoryStructure = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsDirectoryStructure
directoryStructure :: Maybe HlsDirectoryStructure
$sel:directoryStructure:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsDirectoryStructure
directoryStructure} -> Maybe HlsDirectoryStructure
directoryStructure) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsDirectoryStructure
a -> HlsGroupSettings
s {$sel:directoryStructure:HlsGroupSettings' :: Maybe HlsDirectoryStructure
directoryStructure = Maybe HlsDirectoryStructure
a} :: HlsGroupSettings)

-- | Specifies whether to insert EXT-X-DISCONTINUITY tags in the HLS child
-- manifests for this output group. Typically, choose Insert because these
-- tags are required in the manifest (according to the HLS specification)
-- and serve an important purpose. Choose Never Insert only if the
-- downstream system is doing real-time failover (without using the
-- MediaLive automatic failover feature) and only if that downstream system
-- has advised you to exclude the tags.
hlsGroupSettings_discontinuityTags :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsDiscontinuityTags)
hlsGroupSettings_discontinuityTags :: Lens' HlsGroupSettings (Maybe HlsDiscontinuityTags)
hlsGroupSettings_discontinuityTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsDiscontinuityTags
discontinuityTags :: Maybe HlsDiscontinuityTags
$sel:discontinuityTags:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsDiscontinuityTags
discontinuityTags} -> Maybe HlsDiscontinuityTags
discontinuityTags) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsDiscontinuityTags
a -> HlsGroupSettings
s {$sel:discontinuityTags:HlsGroupSettings' :: Maybe HlsDiscontinuityTags
discontinuityTags = Maybe HlsDiscontinuityTags
a} :: HlsGroupSettings)

-- | Encrypts the segments with the given encryption scheme. Exclude this
-- parameter if no encryption is desired.
hlsGroupSettings_encryptionType :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsEncryptionType)
hlsGroupSettings_encryptionType :: Lens' HlsGroupSettings (Maybe HlsEncryptionType)
hlsGroupSettings_encryptionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsEncryptionType
encryptionType :: Maybe HlsEncryptionType
$sel:encryptionType:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsEncryptionType
encryptionType} -> Maybe HlsEncryptionType
encryptionType) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsEncryptionType
a -> HlsGroupSettings
s {$sel:encryptionType:HlsGroupSettings' :: Maybe HlsEncryptionType
encryptionType = Maybe HlsEncryptionType
a} :: HlsGroupSettings)

-- | Parameters that control interactions with the CDN.
hlsGroupSettings_hlsCdnSettings :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsCdnSettings)
hlsGroupSettings_hlsCdnSettings :: Lens' HlsGroupSettings (Maybe HlsCdnSettings)
hlsGroupSettings_hlsCdnSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsCdnSettings
hlsCdnSettings :: Maybe HlsCdnSettings
$sel:hlsCdnSettings:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCdnSettings
hlsCdnSettings} -> Maybe HlsCdnSettings
hlsCdnSettings) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsCdnSettings
a -> HlsGroupSettings
s {$sel:hlsCdnSettings:HlsGroupSettings' :: Maybe HlsCdnSettings
hlsCdnSettings = Maybe HlsCdnSettings
a} :: HlsGroupSettings)

-- | State of HLS ID3 Segment Tagging
hlsGroupSettings_hlsId3SegmentTagging :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsId3SegmentTaggingState)
hlsGroupSettings_hlsId3SegmentTagging :: Lens' HlsGroupSettings (Maybe HlsId3SegmentTaggingState)
hlsGroupSettings_hlsId3SegmentTagging = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsId3SegmentTaggingState
hlsId3SegmentTagging :: Maybe HlsId3SegmentTaggingState
$sel:hlsId3SegmentTagging:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsId3SegmentTaggingState
hlsId3SegmentTagging} -> Maybe HlsId3SegmentTaggingState
hlsId3SegmentTagging) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsId3SegmentTaggingState
a -> HlsGroupSettings
s {$sel:hlsId3SegmentTagging:HlsGroupSettings' :: Maybe HlsId3SegmentTaggingState
hlsId3SegmentTagging = Maybe HlsId3SegmentTaggingState
a} :: HlsGroupSettings)

-- | DISABLED: Do not create an I-frame-only manifest, but do create the
-- master and media manifests (according to the Output Selection field).
-- STANDARD: Create an I-frame-only manifest for each output that contains
-- video, as well as the other manifests (according to the Output Selection
-- field). The I-frame manifest contains a #EXT-X-I-FRAMES-ONLY tag to
-- indicate it is I-frame only, and one or more #EXT-X-BYTERANGE entries
-- identifying the I-frame position. For example,
-- #EXT-X-BYTERANGE:160364\@1461888\"
hlsGroupSettings_iFrameOnlyPlaylists :: Lens.Lens' HlsGroupSettings (Prelude.Maybe IFrameOnlyPlaylistType)
hlsGroupSettings_iFrameOnlyPlaylists :: Lens' HlsGroupSettings (Maybe IFrameOnlyPlaylistType)
hlsGroupSettings_iFrameOnlyPlaylists = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe IFrameOnlyPlaylistType
iFrameOnlyPlaylists :: Maybe IFrameOnlyPlaylistType
$sel:iFrameOnlyPlaylists:HlsGroupSettings' :: HlsGroupSettings -> Maybe IFrameOnlyPlaylistType
iFrameOnlyPlaylists} -> Maybe IFrameOnlyPlaylistType
iFrameOnlyPlaylists) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe IFrameOnlyPlaylistType
a -> HlsGroupSettings
s {$sel:iFrameOnlyPlaylists:HlsGroupSettings' :: Maybe IFrameOnlyPlaylistType
iFrameOnlyPlaylists = Maybe IFrameOnlyPlaylistType
a} :: HlsGroupSettings)

-- | Specifies whether to include the final (incomplete) segment in the media
-- output when the pipeline stops producing output because of a channel
-- stop, a channel pause or a loss of input to the pipeline. Auto means
-- that MediaLive decides whether to include the final segment, depending
-- on the channel class and the types of output groups. Suppress means to
-- never include the incomplete segment. We recommend you choose Auto and
-- let MediaLive control the behavior.
hlsGroupSettings_incompleteSegmentBehavior :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsIncompleteSegmentBehavior)
hlsGroupSettings_incompleteSegmentBehavior :: Lens' HlsGroupSettings (Maybe HlsIncompleteSegmentBehavior)
hlsGroupSettings_incompleteSegmentBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsIncompleteSegmentBehavior
incompleteSegmentBehavior :: Maybe HlsIncompleteSegmentBehavior
$sel:incompleteSegmentBehavior:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIncompleteSegmentBehavior
incompleteSegmentBehavior} -> Maybe HlsIncompleteSegmentBehavior
incompleteSegmentBehavior) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsIncompleteSegmentBehavior
a -> HlsGroupSettings
s {$sel:incompleteSegmentBehavior:HlsGroupSettings' :: Maybe HlsIncompleteSegmentBehavior
incompleteSegmentBehavior = Maybe HlsIncompleteSegmentBehavior
a} :: HlsGroupSettings)

-- | Applies only if Mode field is LIVE. Specifies the maximum number of
-- segments in the media manifest file. After this maximum, older segments
-- are removed from the media manifest. This number must be smaller than
-- the number in the Keep Segments field.
hlsGroupSettings_indexNSegments :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Natural)
hlsGroupSettings_indexNSegments :: Lens' HlsGroupSettings (Maybe Natural)
hlsGroupSettings_indexNSegments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Natural
indexNSegments :: Maybe Natural
$sel:indexNSegments:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
indexNSegments} -> Maybe Natural
indexNSegments) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Natural
a -> HlsGroupSettings
s {$sel:indexNSegments:HlsGroupSettings' :: Maybe Natural
indexNSegments = Maybe Natural
a} :: HlsGroupSettings)

-- | Parameter that control output group behavior on input loss.
hlsGroupSettings_inputLossAction :: Lens.Lens' HlsGroupSettings (Prelude.Maybe InputLossActionForHlsOut)
hlsGroupSettings_inputLossAction :: Lens' HlsGroupSettings (Maybe InputLossActionForHlsOut)
hlsGroupSettings_inputLossAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe InputLossActionForHlsOut
inputLossAction :: Maybe InputLossActionForHlsOut
$sel:inputLossAction:HlsGroupSettings' :: HlsGroupSettings -> Maybe InputLossActionForHlsOut
inputLossAction} -> Maybe InputLossActionForHlsOut
inputLossAction) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe InputLossActionForHlsOut
a -> HlsGroupSettings
s {$sel:inputLossAction:HlsGroupSettings' :: Maybe InputLossActionForHlsOut
inputLossAction = Maybe InputLossActionForHlsOut
a} :: HlsGroupSettings)

-- | For use with encryptionType. The IV (Initialization Vector) is a 128-bit
-- number used in conjunction with the key for encrypting blocks. If set to
-- \"include\", IV is listed in the manifest, otherwise the IV is not in
-- the manifest.
hlsGroupSettings_ivInManifest :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsIvInManifest)
hlsGroupSettings_ivInManifest :: Lens' HlsGroupSettings (Maybe HlsIvInManifest)
hlsGroupSettings_ivInManifest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsIvInManifest
ivInManifest :: Maybe HlsIvInManifest
$sel:ivInManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIvInManifest
ivInManifest} -> Maybe HlsIvInManifest
ivInManifest) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsIvInManifest
a -> HlsGroupSettings
s {$sel:ivInManifest:HlsGroupSettings' :: Maybe HlsIvInManifest
ivInManifest = Maybe HlsIvInManifest
a} :: HlsGroupSettings)

-- | For use with encryptionType. The IV (Initialization Vector) is a 128-bit
-- number used in conjunction with the key for encrypting blocks. If this
-- setting is \"followsSegmentNumber\", it will cause the IV to change
-- every segment (to match the segment number). If this is set to
-- \"explicit\", you must enter a constantIv value.
hlsGroupSettings_ivSource :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsIvSource)
hlsGroupSettings_ivSource :: Lens' HlsGroupSettings (Maybe HlsIvSource)
hlsGroupSettings_ivSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsIvSource
ivSource :: Maybe HlsIvSource
$sel:ivSource:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIvSource
ivSource} -> Maybe HlsIvSource
ivSource) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsIvSource
a -> HlsGroupSettings
s {$sel:ivSource:HlsGroupSettings' :: Maybe HlsIvSource
ivSource = Maybe HlsIvSource
a} :: HlsGroupSettings)

-- | Applies only if Mode field is LIVE. Specifies the number of media
-- segments to retain in the destination directory. This number should be
-- bigger than indexNSegments (Num segments). We recommend (value = (2 x
-- indexNsegments) + 1). If this \"keep segments\" number is too low, the
-- following might happen: the player is still reading a media manifest
-- file that lists this segment, but that segment has been removed from the
-- destination directory (as directed by indexNSegments). This situation
-- would result in a 404 HTTP error on the player.
hlsGroupSettings_keepSegments :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Natural)
hlsGroupSettings_keepSegments :: Lens' HlsGroupSettings (Maybe Natural)
hlsGroupSettings_keepSegments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Natural
keepSegments :: Maybe Natural
$sel:keepSegments:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
keepSegments} -> Maybe Natural
keepSegments) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Natural
a -> HlsGroupSettings
s {$sel:keepSegments:HlsGroupSettings' :: Maybe Natural
keepSegments = Maybe Natural
a} :: HlsGroupSettings)

-- | The value specifies how the key is represented in the resource
-- identified by the URI. If parameter is absent, an implicit value of
-- \"identity\" is used. A reverse DNS string can also be given.
hlsGroupSettings_keyFormat :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Text)
hlsGroupSettings_keyFormat :: Lens' HlsGroupSettings (Maybe Text)
hlsGroupSettings_keyFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Text
keyFormat :: Maybe Text
$sel:keyFormat:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
keyFormat} -> Maybe Text
keyFormat) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Text
a -> HlsGroupSettings
s {$sel:keyFormat:HlsGroupSettings' :: Maybe Text
keyFormat = Maybe Text
a} :: HlsGroupSettings)

-- | Either a single positive integer version value or a slash delimited list
-- of version values (1\/2\/3).
hlsGroupSettings_keyFormatVersions :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Text)
hlsGroupSettings_keyFormatVersions :: Lens' HlsGroupSettings (Maybe Text)
hlsGroupSettings_keyFormatVersions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Text
keyFormatVersions :: Maybe Text
$sel:keyFormatVersions:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
keyFormatVersions} -> Maybe Text
keyFormatVersions) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Text
a -> HlsGroupSettings
s {$sel:keyFormatVersions:HlsGroupSettings' :: Maybe Text
keyFormatVersions = Maybe Text
a} :: HlsGroupSettings)

-- | The key provider settings.
hlsGroupSettings_keyProviderSettings :: Lens.Lens' HlsGroupSettings (Prelude.Maybe KeyProviderSettings)
hlsGroupSettings_keyProviderSettings :: Lens' HlsGroupSettings (Maybe KeyProviderSettings)
hlsGroupSettings_keyProviderSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe KeyProviderSettings
keyProviderSettings :: Maybe KeyProviderSettings
$sel:keyProviderSettings:HlsGroupSettings' :: HlsGroupSettings -> Maybe KeyProviderSettings
keyProviderSettings} -> Maybe KeyProviderSettings
keyProviderSettings) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe KeyProviderSettings
a -> HlsGroupSettings
s {$sel:keyProviderSettings:HlsGroupSettings' :: Maybe KeyProviderSettings
keyProviderSettings = Maybe KeyProviderSettings
a} :: HlsGroupSettings)

-- | When set to gzip, compresses HLS playlist.
hlsGroupSettings_manifestCompression :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsManifestCompression)
hlsGroupSettings_manifestCompression :: Lens' HlsGroupSettings (Maybe HlsManifestCompression)
hlsGroupSettings_manifestCompression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsManifestCompression
manifestCompression :: Maybe HlsManifestCompression
$sel:manifestCompression:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsManifestCompression
manifestCompression} -> Maybe HlsManifestCompression
manifestCompression) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsManifestCompression
a -> HlsGroupSettings
s {$sel:manifestCompression:HlsGroupSettings' :: Maybe HlsManifestCompression
manifestCompression = Maybe HlsManifestCompression
a} :: HlsGroupSettings)

-- | Indicates whether the output manifest should use floating point or
-- integer values for segment duration.
hlsGroupSettings_manifestDurationFormat :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsManifestDurationFormat)
hlsGroupSettings_manifestDurationFormat :: Lens' HlsGroupSettings (Maybe HlsManifestDurationFormat)
hlsGroupSettings_manifestDurationFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsManifestDurationFormat
manifestDurationFormat :: Maybe HlsManifestDurationFormat
$sel:manifestDurationFormat:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsManifestDurationFormat
manifestDurationFormat} -> Maybe HlsManifestDurationFormat
manifestDurationFormat) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsManifestDurationFormat
a -> HlsGroupSettings
s {$sel:manifestDurationFormat:HlsGroupSettings' :: Maybe HlsManifestDurationFormat
manifestDurationFormat = Maybe HlsManifestDurationFormat
a} :: HlsGroupSettings)

-- | Minimum length of MPEG-2 Transport Stream segments in seconds. When set,
-- minimum segment length is enforced by looking ahead and back within the
-- specified range for a nearby avail and extending the segment size if
-- needed.
hlsGroupSettings_minSegmentLength :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Natural)
hlsGroupSettings_minSegmentLength :: Lens' HlsGroupSettings (Maybe Natural)
hlsGroupSettings_minSegmentLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Natural
minSegmentLength :: Maybe Natural
$sel:minSegmentLength:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
minSegmentLength} -> Maybe Natural
minSegmentLength) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Natural
a -> HlsGroupSettings
s {$sel:minSegmentLength:HlsGroupSettings' :: Maybe Natural
minSegmentLength = Maybe Natural
a} :: HlsGroupSettings)

-- | If \"vod\", all segments are indexed and kept permanently in the
-- destination and manifest. If \"live\", only the number segments
-- specified in keepSegments and indexNSegments are kept; newer segments
-- replace older segments, which may prevent players from rewinding all the
-- way to the beginning of the event. VOD mode uses HLS EXT-X-PLAYLIST-TYPE
-- of EVENT while the channel is running, converting it to a \"VOD\" type
-- manifest on completion of the stream.
hlsGroupSettings_mode :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsMode)
hlsGroupSettings_mode :: Lens' HlsGroupSettings (Maybe HlsMode)
hlsGroupSettings_mode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsMode
mode :: Maybe HlsMode
$sel:mode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsMode
mode} -> Maybe HlsMode
mode) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsMode
a -> HlsGroupSettings
s {$sel:mode:HlsGroupSettings' :: Maybe HlsMode
mode = Maybe HlsMode
a} :: HlsGroupSettings)

-- | MANIFESTS_AND_SEGMENTS: Generates manifests (master manifest, if
-- applicable, and media manifests) for this output group.
-- VARIANT_MANIFESTS_AND_SEGMENTS: Generates media manifests for this
-- output group, but not a master manifest. SEGMENTS_ONLY: Does not
-- generate any manifests for this output group.
hlsGroupSettings_outputSelection :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsOutputSelection)
hlsGroupSettings_outputSelection :: Lens' HlsGroupSettings (Maybe HlsOutputSelection)
hlsGroupSettings_outputSelection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsOutputSelection
outputSelection :: Maybe HlsOutputSelection
$sel:outputSelection:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsOutputSelection
outputSelection} -> Maybe HlsOutputSelection
outputSelection) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsOutputSelection
a -> HlsGroupSettings
s {$sel:outputSelection:HlsGroupSettings' :: Maybe HlsOutputSelection
outputSelection = Maybe HlsOutputSelection
a} :: HlsGroupSettings)

-- | Includes or excludes EXT-X-PROGRAM-DATE-TIME tag in .m3u8 manifest
-- files. The value is calculated using the program date time clock.
hlsGroupSettings_programDateTime :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsProgramDateTime)
hlsGroupSettings_programDateTime :: Lens' HlsGroupSettings (Maybe HlsProgramDateTime)
hlsGroupSettings_programDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsProgramDateTime
programDateTime :: Maybe HlsProgramDateTime
$sel:programDateTime:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsProgramDateTime
programDateTime} -> Maybe HlsProgramDateTime
programDateTime) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsProgramDateTime
a -> HlsGroupSettings
s {$sel:programDateTime:HlsGroupSettings' :: Maybe HlsProgramDateTime
programDateTime = Maybe HlsProgramDateTime
a} :: HlsGroupSettings)

-- | Specifies the algorithm used to drive the HLS EXT-X-PROGRAM-DATE-TIME
-- clock. Options include: INITIALIZE_FROM_OUTPUT_TIMECODE: The PDT clock
-- is initialized as a function of the first output timecode, then
-- incremented by the EXTINF duration of each encoded segment.
-- SYSTEM_CLOCK: The PDT clock is initialized as a function of the UTC wall
-- clock, then incremented by the EXTINF duration of each encoded segment.
-- If the PDT clock diverges from the wall clock by more than 500ms, it is
-- resynchronized to the wall clock.
hlsGroupSettings_programDateTimeClock :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsProgramDateTimeClock)
hlsGroupSettings_programDateTimeClock :: Lens' HlsGroupSettings (Maybe HlsProgramDateTimeClock)
hlsGroupSettings_programDateTimeClock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsProgramDateTimeClock
programDateTimeClock :: Maybe HlsProgramDateTimeClock
$sel:programDateTimeClock:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsProgramDateTimeClock
programDateTimeClock} -> Maybe HlsProgramDateTimeClock
programDateTimeClock) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsProgramDateTimeClock
a -> HlsGroupSettings
s {$sel:programDateTimeClock:HlsGroupSettings' :: Maybe HlsProgramDateTimeClock
programDateTimeClock = Maybe HlsProgramDateTimeClock
a} :: HlsGroupSettings)

-- | Period of insertion of EXT-X-PROGRAM-DATE-TIME entry, in seconds.
hlsGroupSettings_programDateTimePeriod :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Natural)
hlsGroupSettings_programDateTimePeriod :: Lens' HlsGroupSettings (Maybe Natural)
hlsGroupSettings_programDateTimePeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Natural
programDateTimePeriod :: Maybe Natural
$sel:programDateTimePeriod:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
programDateTimePeriod} -> Maybe Natural
programDateTimePeriod) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Natural
a -> HlsGroupSettings
s {$sel:programDateTimePeriod:HlsGroupSettings' :: Maybe Natural
programDateTimePeriod = Maybe Natural
a} :: HlsGroupSettings)

-- | ENABLED: The master manifest (.m3u8 file) for each pipeline includes
-- information about both pipelines: first its own media files, then the
-- media files of the other pipeline. This feature allows playout device
-- that support stale manifest detection to switch from one manifest to the
-- other, when the current manifest seems to be stale. There are still two
-- destinations and two master manifests, but both master manifests
-- reference the media files from both pipelines. DISABLED: The master
-- manifest (.m3u8 file) for each pipeline includes information about its
-- own pipeline only. For an HLS output group with MediaPackage as the
-- destination, the DISABLED behavior is always followed. MediaPackage
-- regenerates the manifests it serves to players so a redundant manifest
-- from MediaLive is irrelevant.
hlsGroupSettings_redundantManifest :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsRedundantManifest)
hlsGroupSettings_redundantManifest :: Lens' HlsGroupSettings (Maybe HlsRedundantManifest)
hlsGroupSettings_redundantManifest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsRedundantManifest
redundantManifest :: Maybe HlsRedundantManifest
$sel:redundantManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsRedundantManifest
redundantManifest} -> Maybe HlsRedundantManifest
redundantManifest) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsRedundantManifest
a -> HlsGroupSettings
s {$sel:redundantManifest:HlsGroupSettings' :: Maybe HlsRedundantManifest
redundantManifest = Maybe HlsRedundantManifest
a} :: HlsGroupSettings)

-- | Length of MPEG-2 Transport Stream segments to create in seconds. Note
-- that segments will end on the next keyframe after this duration, so
-- actual segment length may be longer.
hlsGroupSettings_segmentLength :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Natural)
hlsGroupSettings_segmentLength :: Lens' HlsGroupSettings (Maybe Natural)
hlsGroupSettings_segmentLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Natural
segmentLength :: Maybe Natural
$sel:segmentLength:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
segmentLength} -> Maybe Natural
segmentLength) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Natural
a -> HlsGroupSettings
s {$sel:segmentLength:HlsGroupSettings' :: Maybe Natural
segmentLength = Maybe Natural
a} :: HlsGroupSettings)

-- | useInputSegmentation has been deprecated. The configured segment size is
-- always used.
hlsGroupSettings_segmentationMode :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsSegmentationMode)
hlsGroupSettings_segmentationMode :: Lens' HlsGroupSettings (Maybe HlsSegmentationMode)
hlsGroupSettings_segmentationMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsSegmentationMode
segmentationMode :: Maybe HlsSegmentationMode
$sel:segmentationMode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsSegmentationMode
segmentationMode} -> Maybe HlsSegmentationMode
segmentationMode) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsSegmentationMode
a -> HlsGroupSettings
s {$sel:segmentationMode:HlsGroupSettings' :: Maybe HlsSegmentationMode
segmentationMode = Maybe HlsSegmentationMode
a} :: HlsGroupSettings)

-- | Number of segments to write to a subdirectory before starting a new one.
-- directoryStructure must be subdirectoryPerStream for this setting to
-- have an effect.
hlsGroupSettings_segmentsPerSubdirectory :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Natural)
hlsGroupSettings_segmentsPerSubdirectory :: Lens' HlsGroupSettings (Maybe Natural)
hlsGroupSettings_segmentsPerSubdirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Natural
segmentsPerSubdirectory :: Maybe Natural
$sel:segmentsPerSubdirectory:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
segmentsPerSubdirectory} -> Maybe Natural
segmentsPerSubdirectory) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Natural
a -> HlsGroupSettings
s {$sel:segmentsPerSubdirectory:HlsGroupSettings' :: Maybe Natural
segmentsPerSubdirectory = Maybe Natural
a} :: HlsGroupSettings)

-- | Include or exclude RESOLUTION attribute for video in EXT-X-STREAM-INF
-- tag of variant manifest.
hlsGroupSettings_streamInfResolution :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsStreamInfResolution)
hlsGroupSettings_streamInfResolution :: Lens' HlsGroupSettings (Maybe HlsStreamInfResolution)
hlsGroupSettings_streamInfResolution = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsStreamInfResolution
streamInfResolution :: Maybe HlsStreamInfResolution
$sel:streamInfResolution:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsStreamInfResolution
streamInfResolution} -> Maybe HlsStreamInfResolution
streamInfResolution) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsStreamInfResolution
a -> HlsGroupSettings
s {$sel:streamInfResolution:HlsGroupSettings' :: Maybe HlsStreamInfResolution
streamInfResolution = Maybe HlsStreamInfResolution
a} :: HlsGroupSettings)

-- | Indicates ID3 frame that has the timecode.
hlsGroupSettings_timedMetadataId3Frame :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsTimedMetadataId3Frame)
hlsGroupSettings_timedMetadataId3Frame :: Lens' HlsGroupSettings (Maybe HlsTimedMetadataId3Frame)
hlsGroupSettings_timedMetadataId3Frame = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsTimedMetadataId3Frame
timedMetadataId3Frame :: Maybe HlsTimedMetadataId3Frame
$sel:timedMetadataId3Frame:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsTimedMetadataId3Frame
timedMetadataId3Frame} -> Maybe HlsTimedMetadataId3Frame
timedMetadataId3Frame) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsTimedMetadataId3Frame
a -> HlsGroupSettings
s {$sel:timedMetadataId3Frame:HlsGroupSettings' :: Maybe HlsTimedMetadataId3Frame
timedMetadataId3Frame = Maybe HlsTimedMetadataId3Frame
a} :: HlsGroupSettings)

-- | Timed Metadata interval in seconds.
hlsGroupSettings_timedMetadataId3Period :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Natural)
hlsGroupSettings_timedMetadataId3Period :: Lens' HlsGroupSettings (Maybe Natural)
hlsGroupSettings_timedMetadataId3Period = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Natural
timedMetadataId3Period :: Maybe Natural
$sel:timedMetadataId3Period:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
timedMetadataId3Period} -> Maybe Natural
timedMetadataId3Period) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Natural
a -> HlsGroupSettings
s {$sel:timedMetadataId3Period:HlsGroupSettings' :: Maybe Natural
timedMetadataId3Period = Maybe Natural
a} :: HlsGroupSettings)

-- | Provides an extra millisecond delta offset to fine tune the timestamps.
hlsGroupSettings_timestampDeltaMilliseconds :: Lens.Lens' HlsGroupSettings (Prelude.Maybe Prelude.Natural)
hlsGroupSettings_timestampDeltaMilliseconds :: Lens' HlsGroupSettings (Maybe Natural)
hlsGroupSettings_timestampDeltaMilliseconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe Natural
timestampDeltaMilliseconds :: Maybe Natural
$sel:timestampDeltaMilliseconds:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
timestampDeltaMilliseconds} -> Maybe Natural
timestampDeltaMilliseconds) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe Natural
a -> HlsGroupSettings
s {$sel:timestampDeltaMilliseconds:HlsGroupSettings' :: Maybe Natural
timestampDeltaMilliseconds = Maybe Natural
a} :: HlsGroupSettings)

-- | SEGMENTED_FILES: Emit the program as segments - multiple .ts media
-- files. SINGLE_FILE: Applies only if Mode field is VOD. Emit the program
-- as a single .ts media file. The media manifest includes #EXT-X-BYTERANGE
-- tags to index segments for playback. A typical use for this value is
-- when sending the output to AWS Elemental MediaConvert, which can accept
-- only a single media file. Playback while the channel is running is not
-- guaranteed due to HTTP server caching.
hlsGroupSettings_tsFileMode :: Lens.Lens' HlsGroupSettings (Prelude.Maybe HlsTsFileMode)
hlsGroupSettings_tsFileMode :: Lens' HlsGroupSettings (Maybe HlsTsFileMode)
hlsGroupSettings_tsFileMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {Maybe HlsTsFileMode
tsFileMode :: Maybe HlsTsFileMode
$sel:tsFileMode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsTsFileMode
tsFileMode} -> Maybe HlsTsFileMode
tsFileMode) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} Maybe HlsTsFileMode
a -> HlsGroupSettings
s {$sel:tsFileMode:HlsGroupSettings' :: Maybe HlsTsFileMode
tsFileMode = Maybe HlsTsFileMode
a} :: HlsGroupSettings)

-- | A directory or HTTP destination for the HLS segments, manifest files,
-- and encryption keys (if enabled).
hlsGroupSettings_destination :: Lens.Lens' HlsGroupSettings OutputLocationRef
hlsGroupSettings_destination :: Lens' HlsGroupSettings OutputLocationRef
hlsGroupSettings_destination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HlsGroupSettings' {OutputLocationRef
destination :: OutputLocationRef
$sel:destination:HlsGroupSettings' :: HlsGroupSettings -> OutputLocationRef
destination} -> OutputLocationRef
destination) (\s :: HlsGroupSettings
s@HlsGroupSettings' {} OutputLocationRef
a -> HlsGroupSettings
s {$sel:destination:HlsGroupSettings' :: OutputLocationRef
destination = OutputLocationRef
a} :: HlsGroupSettings)

instance Data.FromJSON HlsGroupSettings where
  parseJSON :: Value -> Parser HlsGroupSettings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"HlsGroupSettings"
      ( \Object
x ->
          Maybe [HlsAdMarkers]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [CaptionLanguageMapping]
-> Maybe HlsCaptionLanguageSetting
-> Maybe HlsClientCache
-> Maybe HlsCodecSpecification
-> Maybe Text
-> Maybe HlsDirectoryStructure
-> Maybe HlsDiscontinuityTags
-> Maybe HlsEncryptionType
-> Maybe HlsCdnSettings
-> Maybe HlsId3SegmentTaggingState
-> Maybe IFrameOnlyPlaylistType
-> Maybe HlsIncompleteSegmentBehavior
-> Maybe Natural
-> Maybe InputLossActionForHlsOut
-> Maybe HlsIvInManifest
-> Maybe HlsIvSource
-> Maybe Natural
-> Maybe Text
-> Maybe Text
-> Maybe KeyProviderSettings
-> Maybe HlsManifestCompression
-> Maybe HlsManifestDurationFormat
-> Maybe Natural
-> Maybe HlsMode
-> Maybe HlsOutputSelection
-> Maybe HlsProgramDateTime
-> Maybe HlsProgramDateTimeClock
-> Maybe Natural
-> Maybe HlsRedundantManifest
-> Maybe Natural
-> Maybe HlsSegmentationMode
-> Maybe Natural
-> Maybe HlsStreamInfResolution
-> Maybe HlsTimedMetadataId3Frame
-> Maybe Natural
-> Maybe Natural
-> Maybe HlsTsFileMode
-> OutputLocationRef
-> HlsGroupSettings
HlsGroupSettings'
            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
"adMarkers" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"baseUrlContent")
            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
"baseUrlContent1")
            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
"baseUrlManifest")
            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
"baseUrlManifest1")
            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
"captionLanguageMappings"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"captionLanguageSetting")
            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
"clientCache")
            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
"codecSpecification")
            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
"constantIv")
            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
"directoryStructure")
            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
"discontinuityTags")
            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
"encryptionType")
            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
"hlsCdnSettings")
            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
"hlsId3SegmentTagging")
            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
"iFrameOnlyPlaylists")
            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
"incompleteSegmentBehavior")
            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
"indexNSegments")
            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
"inputLossAction")
            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
"ivInManifest")
            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
"ivSource")
            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
"keepSegments")
            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
"keyFormat")
            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
"keyFormatVersions")
            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
"keyProviderSettings")
            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
"manifestCompression")
            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
"manifestDurationFormat")
            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
"minSegmentLength")
            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
"mode")
            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
"outputSelection")
            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
"programDateTime")
            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
"programDateTimeClock")
            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
"programDateTimePeriod")
            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
"redundantManifest")
            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
"segmentLength")
            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
"segmentationMode")
            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
"segmentsPerSubdirectory")
            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
"streamInfResolution")
            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
"timedMetadataId3Frame")
            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
"timedMetadataId3Period")
            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
"timestampDeltaMilliseconds")
            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
"tsFileMode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"destination")
      )

instance Prelude.Hashable HlsGroupSettings where
  hashWithSalt :: Int -> HlsGroupSettings -> Int
hashWithSalt Int
_salt HlsGroupSettings' {Maybe Natural
Maybe [CaptionLanguageMapping]
Maybe [HlsAdMarkers]
Maybe Text
Maybe HlsCaptionLanguageSetting
Maybe HlsClientCache
Maybe HlsCodecSpecification
Maybe HlsDirectoryStructure
Maybe HlsDiscontinuityTags
Maybe HlsEncryptionType
Maybe HlsId3SegmentTaggingState
Maybe HlsIncompleteSegmentBehavior
Maybe HlsIvInManifest
Maybe HlsIvSource
Maybe HlsManifestCompression
Maybe HlsManifestDurationFormat
Maybe HlsMode
Maybe HlsOutputSelection
Maybe HlsProgramDateTime
Maybe HlsProgramDateTimeClock
Maybe HlsRedundantManifest
Maybe HlsSegmentationMode
Maybe HlsStreamInfResolution
Maybe HlsTimedMetadataId3Frame
Maybe HlsTsFileMode
Maybe IFrameOnlyPlaylistType
Maybe InputLossActionForHlsOut
Maybe HlsCdnSettings
Maybe KeyProviderSettings
OutputLocationRef
destination :: OutputLocationRef
tsFileMode :: Maybe HlsTsFileMode
timestampDeltaMilliseconds :: Maybe Natural
timedMetadataId3Period :: Maybe Natural
timedMetadataId3Frame :: Maybe HlsTimedMetadataId3Frame
streamInfResolution :: Maybe HlsStreamInfResolution
segmentsPerSubdirectory :: Maybe Natural
segmentationMode :: Maybe HlsSegmentationMode
segmentLength :: Maybe Natural
redundantManifest :: Maybe HlsRedundantManifest
programDateTimePeriod :: Maybe Natural
programDateTimeClock :: Maybe HlsProgramDateTimeClock
programDateTime :: Maybe HlsProgramDateTime
outputSelection :: Maybe HlsOutputSelection
mode :: Maybe HlsMode
minSegmentLength :: Maybe Natural
manifestDurationFormat :: Maybe HlsManifestDurationFormat
manifestCompression :: Maybe HlsManifestCompression
keyProviderSettings :: Maybe KeyProviderSettings
keyFormatVersions :: Maybe Text
keyFormat :: Maybe Text
keepSegments :: Maybe Natural
ivSource :: Maybe HlsIvSource
ivInManifest :: Maybe HlsIvInManifest
inputLossAction :: Maybe InputLossActionForHlsOut
indexNSegments :: Maybe Natural
incompleteSegmentBehavior :: Maybe HlsIncompleteSegmentBehavior
iFrameOnlyPlaylists :: Maybe IFrameOnlyPlaylistType
hlsId3SegmentTagging :: Maybe HlsId3SegmentTaggingState
hlsCdnSettings :: Maybe HlsCdnSettings
encryptionType :: Maybe HlsEncryptionType
discontinuityTags :: Maybe HlsDiscontinuityTags
directoryStructure :: Maybe HlsDirectoryStructure
constantIv :: Maybe Text
codecSpecification :: Maybe HlsCodecSpecification
clientCache :: Maybe HlsClientCache
captionLanguageSetting :: Maybe HlsCaptionLanguageSetting
captionLanguageMappings :: Maybe [CaptionLanguageMapping]
baseUrlManifest1 :: Maybe Text
baseUrlManifest :: Maybe Text
baseUrlContent1 :: Maybe Text
baseUrlContent :: Maybe Text
adMarkers :: Maybe [HlsAdMarkers]
$sel:destination:HlsGroupSettings' :: HlsGroupSettings -> OutputLocationRef
$sel:tsFileMode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsTsFileMode
$sel:timestampDeltaMilliseconds:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:timedMetadataId3Period:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:timedMetadataId3Frame:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsTimedMetadataId3Frame
$sel:streamInfResolution:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsStreamInfResolution
$sel:segmentsPerSubdirectory:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:segmentationMode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsSegmentationMode
$sel:segmentLength:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:redundantManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsRedundantManifest
$sel:programDateTimePeriod:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:programDateTimeClock:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsProgramDateTimeClock
$sel:programDateTime:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsProgramDateTime
$sel:outputSelection:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsOutputSelection
$sel:mode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsMode
$sel:minSegmentLength:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:manifestDurationFormat:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsManifestDurationFormat
$sel:manifestCompression:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsManifestCompression
$sel:keyProviderSettings:HlsGroupSettings' :: HlsGroupSettings -> Maybe KeyProviderSettings
$sel:keyFormatVersions:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:keyFormat:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:keepSegments:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:ivSource:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIvSource
$sel:ivInManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIvInManifest
$sel:inputLossAction:HlsGroupSettings' :: HlsGroupSettings -> Maybe InputLossActionForHlsOut
$sel:indexNSegments:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:incompleteSegmentBehavior:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIncompleteSegmentBehavior
$sel:iFrameOnlyPlaylists:HlsGroupSettings' :: HlsGroupSettings -> Maybe IFrameOnlyPlaylistType
$sel:hlsId3SegmentTagging:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsId3SegmentTaggingState
$sel:hlsCdnSettings:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCdnSettings
$sel:encryptionType:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsEncryptionType
$sel:discontinuityTags:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsDiscontinuityTags
$sel:directoryStructure:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsDirectoryStructure
$sel:constantIv:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:codecSpecification:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCodecSpecification
$sel:clientCache:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsClientCache
$sel:captionLanguageSetting:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCaptionLanguageSetting
$sel:captionLanguageMappings:HlsGroupSettings' :: HlsGroupSettings -> Maybe [CaptionLanguageMapping]
$sel:baseUrlManifest1:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:baseUrlManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:baseUrlContent1:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:baseUrlContent:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:adMarkers:HlsGroupSettings' :: HlsGroupSettings -> Maybe [HlsAdMarkers]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [HlsAdMarkers]
adMarkers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
baseUrlContent
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
baseUrlContent1
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
baseUrlManifest
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
baseUrlManifest1
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CaptionLanguageMapping]
captionLanguageMappings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsCaptionLanguageSetting
captionLanguageSetting
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsClientCache
clientCache
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsCodecSpecification
codecSpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
constantIv
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsDirectoryStructure
directoryStructure
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsDiscontinuityTags
discontinuityTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsEncryptionType
encryptionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsCdnSettings
hlsCdnSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsId3SegmentTaggingState
hlsId3SegmentTagging
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IFrameOnlyPlaylistType
iFrameOnlyPlaylists
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsIncompleteSegmentBehavior
incompleteSegmentBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
indexNSegments
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputLossActionForHlsOut
inputLossAction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsIvInManifest
ivInManifest
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsIvSource
ivSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
keepSegments
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
keyFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
keyFormatVersions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KeyProviderSettings
keyProviderSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsManifestCompression
manifestCompression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsManifestDurationFormat
manifestDurationFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
minSegmentLength
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsMode
mode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsOutputSelection
outputSelection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsProgramDateTime
programDateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsProgramDateTimeClock
programDateTimeClock
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
programDateTimePeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsRedundantManifest
redundantManifest
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
segmentLength
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsSegmentationMode
segmentationMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
segmentsPerSubdirectory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsStreamInfResolution
streamInfResolution
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsTimedMetadataId3Frame
timedMetadataId3Frame
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timedMetadataId3Period
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timestampDeltaMilliseconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HlsTsFileMode
tsFileMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` OutputLocationRef
destination

instance Prelude.NFData HlsGroupSettings where
  rnf :: HlsGroupSettings -> ()
rnf HlsGroupSettings' {Maybe Natural
Maybe [CaptionLanguageMapping]
Maybe [HlsAdMarkers]
Maybe Text
Maybe HlsCaptionLanguageSetting
Maybe HlsClientCache
Maybe HlsCodecSpecification
Maybe HlsDirectoryStructure
Maybe HlsDiscontinuityTags
Maybe HlsEncryptionType
Maybe HlsId3SegmentTaggingState
Maybe HlsIncompleteSegmentBehavior
Maybe HlsIvInManifest
Maybe HlsIvSource
Maybe HlsManifestCompression
Maybe HlsManifestDurationFormat
Maybe HlsMode
Maybe HlsOutputSelection
Maybe HlsProgramDateTime
Maybe HlsProgramDateTimeClock
Maybe HlsRedundantManifest
Maybe HlsSegmentationMode
Maybe HlsStreamInfResolution
Maybe HlsTimedMetadataId3Frame
Maybe HlsTsFileMode
Maybe IFrameOnlyPlaylistType
Maybe InputLossActionForHlsOut
Maybe HlsCdnSettings
Maybe KeyProviderSettings
OutputLocationRef
destination :: OutputLocationRef
tsFileMode :: Maybe HlsTsFileMode
timestampDeltaMilliseconds :: Maybe Natural
timedMetadataId3Period :: Maybe Natural
timedMetadataId3Frame :: Maybe HlsTimedMetadataId3Frame
streamInfResolution :: Maybe HlsStreamInfResolution
segmentsPerSubdirectory :: Maybe Natural
segmentationMode :: Maybe HlsSegmentationMode
segmentLength :: Maybe Natural
redundantManifest :: Maybe HlsRedundantManifest
programDateTimePeriod :: Maybe Natural
programDateTimeClock :: Maybe HlsProgramDateTimeClock
programDateTime :: Maybe HlsProgramDateTime
outputSelection :: Maybe HlsOutputSelection
mode :: Maybe HlsMode
minSegmentLength :: Maybe Natural
manifestDurationFormat :: Maybe HlsManifestDurationFormat
manifestCompression :: Maybe HlsManifestCompression
keyProviderSettings :: Maybe KeyProviderSettings
keyFormatVersions :: Maybe Text
keyFormat :: Maybe Text
keepSegments :: Maybe Natural
ivSource :: Maybe HlsIvSource
ivInManifest :: Maybe HlsIvInManifest
inputLossAction :: Maybe InputLossActionForHlsOut
indexNSegments :: Maybe Natural
incompleteSegmentBehavior :: Maybe HlsIncompleteSegmentBehavior
iFrameOnlyPlaylists :: Maybe IFrameOnlyPlaylistType
hlsId3SegmentTagging :: Maybe HlsId3SegmentTaggingState
hlsCdnSettings :: Maybe HlsCdnSettings
encryptionType :: Maybe HlsEncryptionType
discontinuityTags :: Maybe HlsDiscontinuityTags
directoryStructure :: Maybe HlsDirectoryStructure
constantIv :: Maybe Text
codecSpecification :: Maybe HlsCodecSpecification
clientCache :: Maybe HlsClientCache
captionLanguageSetting :: Maybe HlsCaptionLanguageSetting
captionLanguageMappings :: Maybe [CaptionLanguageMapping]
baseUrlManifest1 :: Maybe Text
baseUrlManifest :: Maybe Text
baseUrlContent1 :: Maybe Text
baseUrlContent :: Maybe Text
adMarkers :: Maybe [HlsAdMarkers]
$sel:destination:HlsGroupSettings' :: HlsGroupSettings -> OutputLocationRef
$sel:tsFileMode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsTsFileMode
$sel:timestampDeltaMilliseconds:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:timedMetadataId3Period:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:timedMetadataId3Frame:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsTimedMetadataId3Frame
$sel:streamInfResolution:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsStreamInfResolution
$sel:segmentsPerSubdirectory:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:segmentationMode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsSegmentationMode
$sel:segmentLength:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:redundantManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsRedundantManifest
$sel:programDateTimePeriod:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:programDateTimeClock:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsProgramDateTimeClock
$sel:programDateTime:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsProgramDateTime
$sel:outputSelection:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsOutputSelection
$sel:mode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsMode
$sel:minSegmentLength:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:manifestDurationFormat:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsManifestDurationFormat
$sel:manifestCompression:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsManifestCompression
$sel:keyProviderSettings:HlsGroupSettings' :: HlsGroupSettings -> Maybe KeyProviderSettings
$sel:keyFormatVersions:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:keyFormat:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:keepSegments:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:ivSource:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIvSource
$sel:ivInManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIvInManifest
$sel:inputLossAction:HlsGroupSettings' :: HlsGroupSettings -> Maybe InputLossActionForHlsOut
$sel:indexNSegments:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:incompleteSegmentBehavior:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIncompleteSegmentBehavior
$sel:iFrameOnlyPlaylists:HlsGroupSettings' :: HlsGroupSettings -> Maybe IFrameOnlyPlaylistType
$sel:hlsId3SegmentTagging:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsId3SegmentTaggingState
$sel:hlsCdnSettings:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCdnSettings
$sel:encryptionType:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsEncryptionType
$sel:discontinuityTags:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsDiscontinuityTags
$sel:directoryStructure:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsDirectoryStructure
$sel:constantIv:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:codecSpecification:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCodecSpecification
$sel:clientCache:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsClientCache
$sel:captionLanguageSetting:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCaptionLanguageSetting
$sel:captionLanguageMappings:HlsGroupSettings' :: HlsGroupSettings -> Maybe [CaptionLanguageMapping]
$sel:baseUrlManifest1:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:baseUrlManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:baseUrlContent1:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:baseUrlContent:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:adMarkers:HlsGroupSettings' :: HlsGroupSettings -> Maybe [HlsAdMarkers]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [HlsAdMarkers]
adMarkers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
baseUrlContent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
baseUrlContent1
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
baseUrlManifest
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
baseUrlManifest1
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CaptionLanguageMapping]
captionLanguageMappings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HlsCaptionLanguageSetting
captionLanguageSetting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HlsClientCache
clientCache
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HlsCodecSpecification
codecSpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
constantIv
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HlsDirectoryStructure
directoryStructure
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HlsDiscontinuityTags
discontinuityTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HlsEncryptionType
encryptionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HlsCdnSettings
hlsCdnSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HlsId3SegmentTaggingState
hlsId3SegmentTagging
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IFrameOnlyPlaylistType
iFrameOnlyPlaylists
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsIncompleteSegmentBehavior
incompleteSegmentBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
indexNSegments
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputLossActionForHlsOut
inputLossAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HlsIvInManifest
ivInManifest
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HlsIvSource
ivSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
keepSegments
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
keyFormatVersions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe KeyProviderSettings
keyProviderSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsManifestCompression
manifestCompression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsManifestDurationFormat
manifestDurationFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
minSegmentLength
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsMode
mode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsOutputSelection
outputSelection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsProgramDateTime
programDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsProgramDateTimeClock
programDateTimeClock
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
programDateTimePeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsRedundantManifest
redundantManifest
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
segmentLength
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsSegmentationMode
segmentationMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
segmentsPerSubdirectory
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsStreamInfResolution
streamInfResolution
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsTimedMetadataId3Frame
timedMetadataId3Frame
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
timedMetadataId3Period
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
timestampDeltaMilliseconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe HlsTsFileMode
tsFileMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        OutputLocationRef
destination

instance Data.ToJSON HlsGroupSettings where
  toJSON :: HlsGroupSettings -> Value
toJSON HlsGroupSettings' {Maybe Natural
Maybe [CaptionLanguageMapping]
Maybe [HlsAdMarkers]
Maybe Text
Maybe HlsCaptionLanguageSetting
Maybe HlsClientCache
Maybe HlsCodecSpecification
Maybe HlsDirectoryStructure
Maybe HlsDiscontinuityTags
Maybe HlsEncryptionType
Maybe HlsId3SegmentTaggingState
Maybe HlsIncompleteSegmentBehavior
Maybe HlsIvInManifest
Maybe HlsIvSource
Maybe HlsManifestCompression
Maybe HlsManifestDurationFormat
Maybe HlsMode
Maybe HlsOutputSelection
Maybe HlsProgramDateTime
Maybe HlsProgramDateTimeClock
Maybe HlsRedundantManifest
Maybe HlsSegmentationMode
Maybe HlsStreamInfResolution
Maybe HlsTimedMetadataId3Frame
Maybe HlsTsFileMode
Maybe IFrameOnlyPlaylistType
Maybe InputLossActionForHlsOut
Maybe HlsCdnSettings
Maybe KeyProviderSettings
OutputLocationRef
destination :: OutputLocationRef
tsFileMode :: Maybe HlsTsFileMode
timestampDeltaMilliseconds :: Maybe Natural
timedMetadataId3Period :: Maybe Natural
timedMetadataId3Frame :: Maybe HlsTimedMetadataId3Frame
streamInfResolution :: Maybe HlsStreamInfResolution
segmentsPerSubdirectory :: Maybe Natural
segmentationMode :: Maybe HlsSegmentationMode
segmentLength :: Maybe Natural
redundantManifest :: Maybe HlsRedundantManifest
programDateTimePeriod :: Maybe Natural
programDateTimeClock :: Maybe HlsProgramDateTimeClock
programDateTime :: Maybe HlsProgramDateTime
outputSelection :: Maybe HlsOutputSelection
mode :: Maybe HlsMode
minSegmentLength :: Maybe Natural
manifestDurationFormat :: Maybe HlsManifestDurationFormat
manifestCompression :: Maybe HlsManifestCompression
keyProviderSettings :: Maybe KeyProviderSettings
keyFormatVersions :: Maybe Text
keyFormat :: Maybe Text
keepSegments :: Maybe Natural
ivSource :: Maybe HlsIvSource
ivInManifest :: Maybe HlsIvInManifest
inputLossAction :: Maybe InputLossActionForHlsOut
indexNSegments :: Maybe Natural
incompleteSegmentBehavior :: Maybe HlsIncompleteSegmentBehavior
iFrameOnlyPlaylists :: Maybe IFrameOnlyPlaylistType
hlsId3SegmentTagging :: Maybe HlsId3SegmentTaggingState
hlsCdnSettings :: Maybe HlsCdnSettings
encryptionType :: Maybe HlsEncryptionType
discontinuityTags :: Maybe HlsDiscontinuityTags
directoryStructure :: Maybe HlsDirectoryStructure
constantIv :: Maybe Text
codecSpecification :: Maybe HlsCodecSpecification
clientCache :: Maybe HlsClientCache
captionLanguageSetting :: Maybe HlsCaptionLanguageSetting
captionLanguageMappings :: Maybe [CaptionLanguageMapping]
baseUrlManifest1 :: Maybe Text
baseUrlManifest :: Maybe Text
baseUrlContent1 :: Maybe Text
baseUrlContent :: Maybe Text
adMarkers :: Maybe [HlsAdMarkers]
$sel:destination:HlsGroupSettings' :: HlsGroupSettings -> OutputLocationRef
$sel:tsFileMode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsTsFileMode
$sel:timestampDeltaMilliseconds:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:timedMetadataId3Period:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:timedMetadataId3Frame:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsTimedMetadataId3Frame
$sel:streamInfResolution:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsStreamInfResolution
$sel:segmentsPerSubdirectory:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:segmentationMode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsSegmentationMode
$sel:segmentLength:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:redundantManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsRedundantManifest
$sel:programDateTimePeriod:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:programDateTimeClock:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsProgramDateTimeClock
$sel:programDateTime:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsProgramDateTime
$sel:outputSelection:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsOutputSelection
$sel:mode:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsMode
$sel:minSegmentLength:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:manifestDurationFormat:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsManifestDurationFormat
$sel:manifestCompression:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsManifestCompression
$sel:keyProviderSettings:HlsGroupSettings' :: HlsGroupSettings -> Maybe KeyProviderSettings
$sel:keyFormatVersions:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:keyFormat:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:keepSegments:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:ivSource:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIvSource
$sel:ivInManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIvInManifest
$sel:inputLossAction:HlsGroupSettings' :: HlsGroupSettings -> Maybe InputLossActionForHlsOut
$sel:indexNSegments:HlsGroupSettings' :: HlsGroupSettings -> Maybe Natural
$sel:incompleteSegmentBehavior:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsIncompleteSegmentBehavior
$sel:iFrameOnlyPlaylists:HlsGroupSettings' :: HlsGroupSettings -> Maybe IFrameOnlyPlaylistType
$sel:hlsId3SegmentTagging:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsId3SegmentTaggingState
$sel:hlsCdnSettings:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCdnSettings
$sel:encryptionType:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsEncryptionType
$sel:discontinuityTags:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsDiscontinuityTags
$sel:directoryStructure:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsDirectoryStructure
$sel:constantIv:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:codecSpecification:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCodecSpecification
$sel:clientCache:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsClientCache
$sel:captionLanguageSetting:HlsGroupSettings' :: HlsGroupSettings -> Maybe HlsCaptionLanguageSetting
$sel:captionLanguageMappings:HlsGroupSettings' :: HlsGroupSettings -> Maybe [CaptionLanguageMapping]
$sel:baseUrlManifest1:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:baseUrlManifest:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:baseUrlContent1:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:baseUrlContent:HlsGroupSettings' :: HlsGroupSettings -> Maybe Text
$sel:adMarkers:HlsGroupSettings' :: HlsGroupSettings -> Maybe [HlsAdMarkers]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"adMarkers" 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 [HlsAdMarkers]
adMarkers,
            (Key
"baseUrlContent" 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
baseUrlContent,
            (Key
"baseUrlContent1" 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
baseUrlContent1,
            (Key
"baseUrlManifest" 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
baseUrlManifest,
            (Key
"baseUrlManifest1" 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
baseUrlManifest1,
            (Key
"captionLanguageMappings" 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 [CaptionLanguageMapping]
captionLanguageMappings,
            (Key
"captionLanguageSetting" 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 HlsCaptionLanguageSetting
captionLanguageSetting,
            (Key
"clientCache" 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 HlsClientCache
clientCache,
            (Key
"codecSpecification" 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 HlsCodecSpecification
codecSpecification,
            (Key
"constantIv" 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
constantIv,
            (Key
"directoryStructure" 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 HlsDirectoryStructure
directoryStructure,
            (Key
"discontinuityTags" 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 HlsDiscontinuityTags
discontinuityTags,
            (Key
"encryptionType" 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 HlsEncryptionType
encryptionType,
            (Key
"hlsCdnSettings" 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 HlsCdnSettings
hlsCdnSettings,
            (Key
"hlsId3SegmentTagging" 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 HlsId3SegmentTaggingState
hlsId3SegmentTagging,
            (Key
"iFrameOnlyPlaylists" 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 IFrameOnlyPlaylistType
iFrameOnlyPlaylists,
            (Key
"incompleteSegmentBehavior" 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 HlsIncompleteSegmentBehavior
incompleteSegmentBehavior,
            (Key
"indexNSegments" 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
indexNSegments,
            (Key
"inputLossAction" 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 InputLossActionForHlsOut
inputLossAction,
            (Key
"ivInManifest" 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 HlsIvInManifest
ivInManifest,
            (Key
"ivSource" 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 HlsIvSource
ivSource,
            (Key
"keepSegments" 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
keepSegments,
            (Key
"keyFormat" 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
keyFormat,
            (Key
"keyFormatVersions" 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
keyFormatVersions,
            (Key
"keyProviderSettings" 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 KeyProviderSettings
keyProviderSettings,
            (Key
"manifestCompression" 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 HlsManifestCompression
manifestCompression,
            (Key
"manifestDurationFormat" 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 HlsManifestDurationFormat
manifestDurationFormat,
            (Key
"minSegmentLength" 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
minSegmentLength,
            (Key
"mode" 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 HlsMode
mode,
            (Key
"outputSelection" 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 HlsOutputSelection
outputSelection,
            (Key
"programDateTime" 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 HlsProgramDateTime
programDateTime,
            (Key
"programDateTimeClock" 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 HlsProgramDateTimeClock
programDateTimeClock,
            (Key
"programDateTimePeriod" 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
programDateTimePeriod,
            (Key
"redundantManifest" 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 HlsRedundantManifest
redundantManifest,
            (Key
"segmentLength" 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
segmentLength,
            (Key
"segmentationMode" 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 HlsSegmentationMode
segmentationMode,
            (Key
"segmentsPerSubdirectory" 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
segmentsPerSubdirectory,
            (Key
"streamInfResolution" 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 HlsStreamInfResolution
streamInfResolution,
            (Key
"timedMetadataId3Frame" 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 HlsTimedMetadataId3Frame
timedMetadataId3Frame,
            (Key
"timedMetadataId3Period" 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
timedMetadataId3Period,
            (Key
"timestampDeltaMilliseconds" 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
timestampDeltaMilliseconds,
            (Key
"tsFileMode" 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 HlsTsFileMode
tsFileMode,
            forall a. a -> Maybe a
Prelude.Just (Key
"destination" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= OutputLocationRef
destination)
          ]
      )