{-# 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.H264Settings
-- 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.H264Settings 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.AfdSignaling
import Amazonka.MediaLive.Types.FixedAfd
import Amazonka.MediaLive.Types.H264AdaptiveQuantization
import Amazonka.MediaLive.Types.H264ColorMetadata
import Amazonka.MediaLive.Types.H264ColorSpaceSettings
import Amazonka.MediaLive.Types.H264EntropyEncoding
import Amazonka.MediaLive.Types.H264FilterSettings
import Amazonka.MediaLive.Types.H264FlickerAq
import Amazonka.MediaLive.Types.H264ForceFieldPictures
import Amazonka.MediaLive.Types.H264FramerateControl
import Amazonka.MediaLive.Types.H264GopBReference
import Amazonka.MediaLive.Types.H264GopSizeUnits
import Amazonka.MediaLive.Types.H264Level
import Amazonka.MediaLive.Types.H264LookAheadRateControl
import Amazonka.MediaLive.Types.H264ParControl
import Amazonka.MediaLive.Types.H264Profile
import Amazonka.MediaLive.Types.H264QualityLevel
import Amazonka.MediaLive.Types.H264RateControlMode
import Amazonka.MediaLive.Types.H264ScanType
import Amazonka.MediaLive.Types.H264SceneChangeDetect
import Amazonka.MediaLive.Types.H264SpatialAq
import Amazonka.MediaLive.Types.H264SubGopLength
import Amazonka.MediaLive.Types.H264Syntax
import Amazonka.MediaLive.Types.H264TemporalAq
import Amazonka.MediaLive.Types.H264TimecodeInsertionBehavior
import Amazonka.MediaLive.Types.TimecodeBurninSettings
import qualified Amazonka.Prelude as Prelude

-- | H264 Settings
--
-- /See:/ 'newH264Settings' smart constructor.
data H264Settings = H264Settings'
  { -- | Enables or disables adaptive quantization, which is a technique
    -- MediaLive can apply to video on a frame-by-frame basis to produce more
    -- compression without losing quality. There are three types of adaptive
    -- quantization: flicker, spatial, and temporal. Set the field in one of
    -- these ways: Set to Auto. Recommended. For each type of AQ, MediaLive
    -- will determine if AQ is needed, and if so, the appropriate strength. Set
    -- a strength (a value other than Auto or Disable). This strength will
    -- apply to any of the AQ fields that you choose to enable. Set to Disabled
    -- to disable all types of adaptive quantization.
    H264Settings -> Maybe H264AdaptiveQuantization
adaptiveQuantization :: Prelude.Maybe H264AdaptiveQuantization,
    -- | Indicates that AFD values will be written into the output stream. If
    -- afdSignaling is \"auto\", the system will try to preserve the input AFD
    -- value (in cases where multiple AFD values are valid). If set to
    -- \"fixed\", the AFD value will be the value configured in the fixedAfd
    -- parameter.
    H264Settings -> Maybe AfdSignaling
afdSignaling :: Prelude.Maybe AfdSignaling,
    -- | Average bitrate in bits\/second. Required when the rate control mode is
    -- VBR or CBR. Not used for QVBR. In an MS Smooth output group, each output
    -- must have a unique value when its bitrate is rounded down to the nearest
    -- multiple of 1000.
    H264Settings -> Maybe Natural
bitrate :: Prelude.Maybe Prelude.Natural,
    -- | Percentage of the buffer that should initially be filled (HRD buffer
    -- model).
    H264Settings -> Maybe Natural
bufFillPct :: Prelude.Maybe Prelude.Natural,
    -- | Size of buffer (HRD buffer model) in bits.
    H264Settings -> Maybe Natural
bufSize :: Prelude.Maybe Prelude.Natural,
    -- | Includes colorspace metadata in the output.
    H264Settings -> Maybe H264ColorMetadata
colorMetadata :: Prelude.Maybe H264ColorMetadata,
    -- | Color Space settings
    H264Settings -> Maybe H264ColorSpaceSettings
colorSpaceSettings :: Prelude.Maybe H264ColorSpaceSettings,
    -- | Entropy encoding mode. Use cabac (must be in Main or High profile) or
    -- cavlc.
    H264Settings -> Maybe H264EntropyEncoding
entropyEncoding :: Prelude.Maybe H264EntropyEncoding,
    -- | Optional filters that you can apply to an encode.
    H264Settings -> Maybe H264FilterSettings
filterSettings :: Prelude.Maybe H264FilterSettings,
    -- | Four bit AFD value to write on all frames of video in the output stream.
    -- Only valid when afdSignaling is set to \'Fixed\'.
    H264Settings -> Maybe FixedAfd
fixedAfd :: Prelude.Maybe FixedAfd,
    -- | Flicker AQ makes adjustments within each frame to reduce flicker or
    -- \'pop\' on I-frames. The value to enter in this field depends on the
    -- value in the Adaptive quantization field: If you have set the Adaptive
    -- quantization field to Auto, MediaLive ignores any value in this field.
    -- MediaLive will determine if flicker AQ is appropriate and will apply the
    -- appropriate strength. If you have set the Adaptive quantization field to
    -- a strength, you can set this field to Enabled or Disabled. Enabled:
    -- MediaLive will apply flicker AQ using the specified strength. Disabled:
    -- MediaLive won\'t apply flicker AQ. If you have set the Adaptive
    -- quantization to Disabled, MediaLive ignores any value in this field and
    -- doesn\'t apply flicker AQ.
    H264Settings -> Maybe H264FlickerAq
flickerAq :: Prelude.Maybe H264FlickerAq,
    -- | This setting applies only when scan type is \"interlaced.\" It controls
    -- whether coding is performed on a field basis or on a frame basis. (When
    -- the video is progressive, the coding is always performed on a frame
    -- basis.) enabled: Force MediaLive to code on a field basis, so that odd
    -- and even sets of fields are coded separately. disabled: Code the two
    -- sets of fields separately (on a field basis) or together (on a frame
    -- basis using PAFF), depending on what is most appropriate for the
    -- content.
    H264Settings -> Maybe H264ForceFieldPictures
forceFieldPictures :: Prelude.Maybe H264ForceFieldPictures,
    -- | This field indicates how the output video frame rate is specified. If
    -- \"specified\" is selected then the output video frame rate is determined
    -- by framerateNumerator and framerateDenominator, else if
    -- \"initializeFromSource\" is selected then the output video frame rate
    -- will be set equal to the input video frame rate of the first input.
    H264Settings -> Maybe H264FramerateControl
framerateControl :: Prelude.Maybe H264FramerateControl,
    -- | Framerate denominator.
    H264Settings -> Maybe Natural
framerateDenominator :: Prelude.Maybe Prelude.Natural,
    -- | Framerate numerator - framerate is a fraction, e.g. 24000 \/ 1001 =
    -- 23.976 fps.
    H264Settings -> Maybe Natural
framerateNumerator :: Prelude.Maybe Prelude.Natural,
    -- | Documentation update needed
    H264Settings -> Maybe H264GopBReference
gopBReference :: Prelude.Maybe H264GopBReference,
    -- | Frequency of closed GOPs. In streaming applications, it is recommended
    -- that this be set to 1 so a decoder joining mid-stream will receive an
    -- IDR frame as quickly as possible. Setting this value to 0 will break
    -- output segmenting.
    H264Settings -> Maybe Natural
gopClosedCadence :: Prelude.Maybe Prelude.Natural,
    -- | Number of B-frames between reference frames.
    H264Settings -> Maybe Natural
gopNumBFrames :: Prelude.Maybe Prelude.Natural,
    -- | GOP size (keyframe interval) in units of either frames or seconds per
    -- gopSizeUnits. If gopSizeUnits is frames, gopSize must be an integer and
    -- must be greater than or equal to 1. If gopSizeUnits is seconds, gopSize
    -- must be greater than 0, but need not be an integer.
    H264Settings -> Maybe Double
gopSize :: Prelude.Maybe Prelude.Double,
    -- | Indicates if the gopSize is specified in frames or seconds. If seconds
    -- the system will convert the gopSize into a frame count at run time.
    H264Settings -> Maybe H264GopSizeUnits
gopSizeUnits :: Prelude.Maybe H264GopSizeUnits,
    -- | H.264 Level.
    H264Settings -> Maybe H264Level
level :: Prelude.Maybe H264Level,
    -- | Amount of lookahead. A value of low can decrease latency and memory
    -- usage, while high can produce better quality for certain content.
    H264Settings -> Maybe H264LookAheadRateControl
lookAheadRateControl :: Prelude.Maybe H264LookAheadRateControl,
    -- | For QVBR: See the tooltip for Quality level For VBR: Set the maximum
    -- bitrate in order to accommodate expected spikes in the complexity of the
    -- video.
    H264Settings -> Maybe Natural
maxBitrate :: Prelude.Maybe Prelude.Natural,
    -- | Only meaningful if sceneChangeDetect is set to enabled. Defaults to 5 if
    -- multiplex rate control is used. Enforces separation between repeated
    -- (cadence) I-frames and I-frames inserted by Scene Change Detection. If a
    -- scene change I-frame is within I-interval frames of a cadence I-frame,
    -- the GOP is shrunk and\/or stretched to the scene change I-frame. GOP
    -- stretch requires enabling lookahead as well as setting I-interval. The
    -- normal cadence resumes for the next GOP. Note: Maximum GOP stretch = GOP
    -- size + Min-I-interval - 1
    H264Settings -> Maybe Natural
minIInterval :: Prelude.Maybe Prelude.Natural,
    -- | Number of reference frames to use. The encoder may use more than
    -- requested if using B-frames and\/or interlaced encoding.
    H264Settings -> Maybe Natural
numRefFrames :: Prelude.Maybe Prelude.Natural,
    -- | This field indicates how the output pixel aspect ratio is specified. If
    -- \"specified\" is selected then the output video pixel aspect ratio is
    -- determined by parNumerator and parDenominator, else if
    -- \"initializeFromSource\" is selected then the output pixsel aspect ratio
    -- will be set equal to the input video pixel aspect ratio of the first
    -- input.
    H264Settings -> Maybe H264ParControl
parControl :: Prelude.Maybe H264ParControl,
    -- | Pixel Aspect Ratio denominator.
    H264Settings -> Maybe Natural
parDenominator :: Prelude.Maybe Prelude.Natural,
    -- | Pixel Aspect Ratio numerator.
    H264Settings -> Maybe Natural
parNumerator :: Prelude.Maybe Prelude.Natural,
    -- | H.264 Profile.
    H264Settings -> Maybe H264Profile
profile :: Prelude.Maybe H264Profile,
    -- | Leave as STANDARD_QUALITY or choose a different value (which might
    -- result in additional costs to run the channel). - ENHANCED_QUALITY:
    -- Produces a slightly better video quality without an increase in the
    -- bitrate. Has an effect only when the Rate control mode is QVBR or CBR.
    -- If this channel is in a MediaLive multiplex, the value must be
    -- ENHANCED_QUALITY. - STANDARD_QUALITY: Valid for any Rate control mode.
    H264Settings -> Maybe H264QualityLevel
qualityLevel :: Prelude.Maybe H264QualityLevel,
    -- | Controls the target quality for the video encode. Applies only when the
    -- rate control mode is QVBR. You can set a target quality or you can let
    -- MediaLive determine the best quality. To set a target quality, enter
    -- values in the QVBR quality level field and the Max bitrate field. Enter
    -- values that suit your most important viewing devices. Recommended values
    -- are: - Primary screen: Quality level: 8 to 10. Max bitrate: 4M - PC or
    -- tablet: Quality level: 7. Max bitrate: 1.5M to 3M - Smartphone: Quality
    -- level: 6. Max bitrate: 1M to 1.5M To let MediaLive decide, leave the
    -- QVBR quality level field empty, and in Max bitrate enter the maximum
    -- rate you want in the video. For more information, see the section called
    -- \"Video - rate control mode\" in the MediaLive user guide
    H264Settings -> Maybe Natural
qvbrQualityLevel :: Prelude.Maybe Prelude.Natural,
    -- | Rate control mode. QVBR: Quality will match the specified quality level
    -- except when it is constrained by the maximum bitrate. Recommended if you
    -- or your viewers pay for bandwidth. VBR: Quality and bitrate vary,
    -- depending on the video complexity. Recommended instead of QVBR if you
    -- want to maintain a specific average bitrate over the duration of the
    -- channel. CBR: Quality varies, depending on the video complexity.
    -- Recommended only if you distribute your assets to devices that cannot
    -- handle variable bitrates. Multiplex: This rate control mode is only
    -- supported (and is required) when the video is being delivered to a
    -- MediaLive Multiplex in which case the rate control configuration is
    -- controlled by the properties within the Multiplex Program.
    H264Settings -> Maybe H264RateControlMode
rateControlMode :: Prelude.Maybe H264RateControlMode,
    -- | Sets the scan type of the output to progressive or top-field-first
    -- interlaced.
    H264Settings -> Maybe H264ScanType
scanType :: Prelude.Maybe H264ScanType,
    -- | Scene change detection. - On: inserts I-frames when scene change is
    -- detected. - Off: does not force an I-frame when scene change is
    -- detected.
    H264Settings -> Maybe H264SceneChangeDetect
sceneChangeDetect :: Prelude.Maybe H264SceneChangeDetect,
    -- | Number of slices per picture. Must be less than or equal to the number
    -- of macroblock rows for progressive pictures, and less than or equal to
    -- half the number of macroblock rows for interlaced pictures. This field
    -- is optional; when no value is specified the encoder will choose the
    -- number of slices based on encode resolution.
    H264Settings -> Maybe Natural
slices :: Prelude.Maybe Prelude.Natural,
    -- | Softness. Selects quantizer matrix, larger values reduce high-frequency
    -- content in the encoded image. If not set to zero, must be greater than
    -- 15.
    H264Settings -> Maybe Natural
softness :: Prelude.Maybe Prelude.Natural,
    -- | Spatial AQ makes adjustments within each frame based on spatial
    -- variation of content complexity. The value to enter in this field
    -- depends on the value in the Adaptive quantization field: If you have set
    -- the Adaptive quantization field to Auto, MediaLive ignores any value in
    -- this field. MediaLive will determine if spatial AQ is appropriate and
    -- will apply the appropriate strength. If you have set the Adaptive
    -- quantization field to a strength, you can set this field to Enabled or
    -- Disabled. Enabled: MediaLive will apply spatial AQ using the specified
    -- strength. Disabled: MediaLive won\'t apply spatial AQ. If you have set
    -- the Adaptive quantization to Disabled, MediaLive ignores any value in
    -- this field and doesn\'t apply spatial AQ.
    H264Settings -> Maybe H264SpatialAq
spatialAq :: Prelude.Maybe H264SpatialAq,
    -- | If set to fixed, use gopNumBFrames B-frames per sub-GOP. If set to
    -- dynamic, optimize the number of B-frames used for each sub-GOP to
    -- improve visual quality.
    H264Settings -> Maybe H264SubGopLength
subgopLength :: Prelude.Maybe H264SubGopLength,
    -- | Produces a bitstream compliant with SMPTE RP-2027.
    H264Settings -> Maybe H264Syntax
syntax :: Prelude.Maybe H264Syntax,
    -- | Temporal makes adjustments within each frame based on temporal variation
    -- of content complexity. The value to enter in this field depends on the
    -- value in the Adaptive quantization field: If you have set the Adaptive
    -- quantization field to Auto, MediaLive ignores any value in this field.
    -- MediaLive will determine if temporal AQ is appropriate and will apply
    -- the appropriate strength. If you have set the Adaptive quantization
    -- field to a strength, you can set this field to Enabled or Disabled.
    -- Enabled: MediaLive will apply temporal AQ using the specified strength.
    -- Disabled: MediaLive won\'t apply temporal AQ. If you have set the
    -- Adaptive quantization to Disabled, MediaLive ignores any value in this
    -- field and doesn\'t apply temporal AQ.
    H264Settings -> Maybe H264TemporalAq
temporalAq :: Prelude.Maybe H264TemporalAq,
    -- | Timecode burn-in settings
    H264Settings -> Maybe TimecodeBurninSettings
timecodeBurninSettings :: Prelude.Maybe TimecodeBurninSettings,
    -- | Determines how timecodes should be inserted into the video elementary
    -- stream. - \'disabled\': Do not include timecodes - \'picTimingSei\':
    -- Pass through picture timing SEI messages from the source specified in
    -- Timecode Config
    H264Settings -> Maybe H264TimecodeInsertionBehavior
timecodeInsertion :: Prelude.Maybe H264TimecodeInsertionBehavior
  }
  deriving (H264Settings -> H264Settings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: H264Settings -> H264Settings -> Bool
$c/= :: H264Settings -> H264Settings -> Bool
== :: H264Settings -> H264Settings -> Bool
$c== :: H264Settings -> H264Settings -> Bool
Prelude.Eq, ReadPrec [H264Settings]
ReadPrec H264Settings
Int -> ReadS H264Settings
ReadS [H264Settings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [H264Settings]
$creadListPrec :: ReadPrec [H264Settings]
readPrec :: ReadPrec H264Settings
$creadPrec :: ReadPrec H264Settings
readList :: ReadS [H264Settings]
$creadList :: ReadS [H264Settings]
readsPrec :: Int -> ReadS H264Settings
$creadsPrec :: Int -> ReadS H264Settings
Prelude.Read, Int -> H264Settings -> ShowS
[H264Settings] -> ShowS
H264Settings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [H264Settings] -> ShowS
$cshowList :: [H264Settings] -> ShowS
show :: H264Settings -> String
$cshow :: H264Settings -> String
showsPrec :: Int -> H264Settings -> ShowS
$cshowsPrec :: Int -> H264Settings -> ShowS
Prelude.Show, forall x. Rep H264Settings x -> H264Settings
forall x. H264Settings -> Rep H264Settings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep H264Settings x -> H264Settings
$cfrom :: forall x. H264Settings -> Rep H264Settings x
Prelude.Generic)

-- |
-- Create a value of 'H264Settings' 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:
--
-- 'adaptiveQuantization', 'h264Settings_adaptiveQuantization' - Enables or disables adaptive quantization, which is a technique
-- MediaLive can apply to video on a frame-by-frame basis to produce more
-- compression without losing quality. There are three types of adaptive
-- quantization: flicker, spatial, and temporal. Set the field in one of
-- these ways: Set to Auto. Recommended. For each type of AQ, MediaLive
-- will determine if AQ is needed, and if so, the appropriate strength. Set
-- a strength (a value other than Auto or Disable). This strength will
-- apply to any of the AQ fields that you choose to enable. Set to Disabled
-- to disable all types of adaptive quantization.
--
-- 'afdSignaling', 'h264Settings_afdSignaling' - Indicates that AFD values will be written into the output stream. If
-- afdSignaling is \"auto\", the system will try to preserve the input AFD
-- value (in cases where multiple AFD values are valid). If set to
-- \"fixed\", the AFD value will be the value configured in the fixedAfd
-- parameter.
--
-- 'bitrate', 'h264Settings_bitrate' - Average bitrate in bits\/second. Required when the rate control mode is
-- VBR or CBR. Not used for QVBR. In an MS Smooth output group, each output
-- must have a unique value when its bitrate is rounded down to the nearest
-- multiple of 1000.
--
-- 'bufFillPct', 'h264Settings_bufFillPct' - Percentage of the buffer that should initially be filled (HRD buffer
-- model).
--
-- 'bufSize', 'h264Settings_bufSize' - Size of buffer (HRD buffer model) in bits.
--
-- 'colorMetadata', 'h264Settings_colorMetadata' - Includes colorspace metadata in the output.
--
-- 'colorSpaceSettings', 'h264Settings_colorSpaceSettings' - Color Space settings
--
-- 'entropyEncoding', 'h264Settings_entropyEncoding' - Entropy encoding mode. Use cabac (must be in Main or High profile) or
-- cavlc.
--
-- 'filterSettings', 'h264Settings_filterSettings' - Optional filters that you can apply to an encode.
--
-- 'fixedAfd', 'h264Settings_fixedAfd' - Four bit AFD value to write on all frames of video in the output stream.
-- Only valid when afdSignaling is set to \'Fixed\'.
--
-- 'flickerAq', 'h264Settings_flickerAq' - Flicker AQ makes adjustments within each frame to reduce flicker or
-- \'pop\' on I-frames. The value to enter in this field depends on the
-- value in the Adaptive quantization field: If you have set the Adaptive
-- quantization field to Auto, MediaLive ignores any value in this field.
-- MediaLive will determine if flicker AQ is appropriate and will apply the
-- appropriate strength. If you have set the Adaptive quantization field to
-- a strength, you can set this field to Enabled or Disabled. Enabled:
-- MediaLive will apply flicker AQ using the specified strength. Disabled:
-- MediaLive won\'t apply flicker AQ. If you have set the Adaptive
-- quantization to Disabled, MediaLive ignores any value in this field and
-- doesn\'t apply flicker AQ.
--
-- 'forceFieldPictures', 'h264Settings_forceFieldPictures' - This setting applies only when scan type is \"interlaced.\" It controls
-- whether coding is performed on a field basis or on a frame basis. (When
-- the video is progressive, the coding is always performed on a frame
-- basis.) enabled: Force MediaLive to code on a field basis, so that odd
-- and even sets of fields are coded separately. disabled: Code the two
-- sets of fields separately (on a field basis) or together (on a frame
-- basis using PAFF), depending on what is most appropriate for the
-- content.
--
-- 'framerateControl', 'h264Settings_framerateControl' - This field indicates how the output video frame rate is specified. If
-- \"specified\" is selected then the output video frame rate is determined
-- by framerateNumerator and framerateDenominator, else if
-- \"initializeFromSource\" is selected then the output video frame rate
-- will be set equal to the input video frame rate of the first input.
--
-- 'framerateDenominator', 'h264Settings_framerateDenominator' - Framerate denominator.
--
-- 'framerateNumerator', 'h264Settings_framerateNumerator' - Framerate numerator - framerate is a fraction, e.g. 24000 \/ 1001 =
-- 23.976 fps.
--
-- 'gopBReference', 'h264Settings_gopBReference' - Documentation update needed
--
-- 'gopClosedCadence', 'h264Settings_gopClosedCadence' - Frequency of closed GOPs. In streaming applications, it is recommended
-- that this be set to 1 so a decoder joining mid-stream will receive an
-- IDR frame as quickly as possible. Setting this value to 0 will break
-- output segmenting.
--
-- 'gopNumBFrames', 'h264Settings_gopNumBFrames' - Number of B-frames between reference frames.
--
-- 'gopSize', 'h264Settings_gopSize' - GOP size (keyframe interval) in units of either frames or seconds per
-- gopSizeUnits. If gopSizeUnits is frames, gopSize must be an integer and
-- must be greater than or equal to 1. If gopSizeUnits is seconds, gopSize
-- must be greater than 0, but need not be an integer.
--
-- 'gopSizeUnits', 'h264Settings_gopSizeUnits' - Indicates if the gopSize is specified in frames or seconds. If seconds
-- the system will convert the gopSize into a frame count at run time.
--
-- 'level', 'h264Settings_level' - H.264 Level.
--
-- 'lookAheadRateControl', 'h264Settings_lookAheadRateControl' - Amount of lookahead. A value of low can decrease latency and memory
-- usage, while high can produce better quality for certain content.
--
-- 'maxBitrate', 'h264Settings_maxBitrate' - For QVBR: See the tooltip for Quality level For VBR: Set the maximum
-- bitrate in order to accommodate expected spikes in the complexity of the
-- video.
--
-- 'minIInterval', 'h264Settings_minIInterval' - Only meaningful if sceneChangeDetect is set to enabled. Defaults to 5 if
-- multiplex rate control is used. Enforces separation between repeated
-- (cadence) I-frames and I-frames inserted by Scene Change Detection. If a
-- scene change I-frame is within I-interval frames of a cadence I-frame,
-- the GOP is shrunk and\/or stretched to the scene change I-frame. GOP
-- stretch requires enabling lookahead as well as setting I-interval. The
-- normal cadence resumes for the next GOP. Note: Maximum GOP stretch = GOP
-- size + Min-I-interval - 1
--
-- 'numRefFrames', 'h264Settings_numRefFrames' - Number of reference frames to use. The encoder may use more than
-- requested if using B-frames and\/or interlaced encoding.
--
-- 'parControl', 'h264Settings_parControl' - This field indicates how the output pixel aspect ratio is specified. If
-- \"specified\" is selected then the output video pixel aspect ratio is
-- determined by parNumerator and parDenominator, else if
-- \"initializeFromSource\" is selected then the output pixsel aspect ratio
-- will be set equal to the input video pixel aspect ratio of the first
-- input.
--
-- 'parDenominator', 'h264Settings_parDenominator' - Pixel Aspect Ratio denominator.
--
-- 'parNumerator', 'h264Settings_parNumerator' - Pixel Aspect Ratio numerator.
--
-- 'profile', 'h264Settings_profile' - H.264 Profile.
--
-- 'qualityLevel', 'h264Settings_qualityLevel' - Leave as STANDARD_QUALITY or choose a different value (which might
-- result in additional costs to run the channel). - ENHANCED_QUALITY:
-- Produces a slightly better video quality without an increase in the
-- bitrate. Has an effect only when the Rate control mode is QVBR or CBR.
-- If this channel is in a MediaLive multiplex, the value must be
-- ENHANCED_QUALITY. - STANDARD_QUALITY: Valid for any Rate control mode.
--
-- 'qvbrQualityLevel', 'h264Settings_qvbrQualityLevel' - Controls the target quality for the video encode. Applies only when the
-- rate control mode is QVBR. You can set a target quality or you can let
-- MediaLive determine the best quality. To set a target quality, enter
-- values in the QVBR quality level field and the Max bitrate field. Enter
-- values that suit your most important viewing devices. Recommended values
-- are: - Primary screen: Quality level: 8 to 10. Max bitrate: 4M - PC or
-- tablet: Quality level: 7. Max bitrate: 1.5M to 3M - Smartphone: Quality
-- level: 6. Max bitrate: 1M to 1.5M To let MediaLive decide, leave the
-- QVBR quality level field empty, and in Max bitrate enter the maximum
-- rate you want in the video. For more information, see the section called
-- \"Video - rate control mode\" in the MediaLive user guide
--
-- 'rateControlMode', 'h264Settings_rateControlMode' - Rate control mode. QVBR: Quality will match the specified quality level
-- except when it is constrained by the maximum bitrate. Recommended if you
-- or your viewers pay for bandwidth. VBR: Quality and bitrate vary,
-- depending on the video complexity. Recommended instead of QVBR if you
-- want to maintain a specific average bitrate over the duration of the
-- channel. CBR: Quality varies, depending on the video complexity.
-- Recommended only if you distribute your assets to devices that cannot
-- handle variable bitrates. Multiplex: This rate control mode is only
-- supported (and is required) when the video is being delivered to a
-- MediaLive Multiplex in which case the rate control configuration is
-- controlled by the properties within the Multiplex Program.
--
-- 'scanType', 'h264Settings_scanType' - Sets the scan type of the output to progressive or top-field-first
-- interlaced.
--
-- 'sceneChangeDetect', 'h264Settings_sceneChangeDetect' - Scene change detection. - On: inserts I-frames when scene change is
-- detected. - Off: does not force an I-frame when scene change is
-- detected.
--
-- 'slices', 'h264Settings_slices' - Number of slices per picture. Must be less than or equal to the number
-- of macroblock rows for progressive pictures, and less than or equal to
-- half the number of macroblock rows for interlaced pictures. This field
-- is optional; when no value is specified the encoder will choose the
-- number of slices based on encode resolution.
--
-- 'softness', 'h264Settings_softness' - Softness. Selects quantizer matrix, larger values reduce high-frequency
-- content in the encoded image. If not set to zero, must be greater than
-- 15.
--
-- 'spatialAq', 'h264Settings_spatialAq' - Spatial AQ makes adjustments within each frame based on spatial
-- variation of content complexity. The value to enter in this field
-- depends on the value in the Adaptive quantization field: If you have set
-- the Adaptive quantization field to Auto, MediaLive ignores any value in
-- this field. MediaLive will determine if spatial AQ is appropriate and
-- will apply the appropriate strength. If you have set the Adaptive
-- quantization field to a strength, you can set this field to Enabled or
-- Disabled. Enabled: MediaLive will apply spatial AQ using the specified
-- strength. Disabled: MediaLive won\'t apply spatial AQ. If you have set
-- the Adaptive quantization to Disabled, MediaLive ignores any value in
-- this field and doesn\'t apply spatial AQ.
--
-- 'subgopLength', 'h264Settings_subgopLength' - If set to fixed, use gopNumBFrames B-frames per sub-GOP. If set to
-- dynamic, optimize the number of B-frames used for each sub-GOP to
-- improve visual quality.
--
-- 'syntax', 'h264Settings_syntax' - Produces a bitstream compliant with SMPTE RP-2027.
--
-- 'temporalAq', 'h264Settings_temporalAq' - Temporal makes adjustments within each frame based on temporal variation
-- of content complexity. The value to enter in this field depends on the
-- value in the Adaptive quantization field: If you have set the Adaptive
-- quantization field to Auto, MediaLive ignores any value in this field.
-- MediaLive will determine if temporal AQ is appropriate and will apply
-- the appropriate strength. If you have set the Adaptive quantization
-- field to a strength, you can set this field to Enabled or Disabled.
-- Enabled: MediaLive will apply temporal AQ using the specified strength.
-- Disabled: MediaLive won\'t apply temporal AQ. If you have set the
-- Adaptive quantization to Disabled, MediaLive ignores any value in this
-- field and doesn\'t apply temporal AQ.
--
-- 'timecodeBurninSettings', 'h264Settings_timecodeBurninSettings' - Timecode burn-in settings
--
-- 'timecodeInsertion', 'h264Settings_timecodeInsertion' - Determines how timecodes should be inserted into the video elementary
-- stream. - \'disabled\': Do not include timecodes - \'picTimingSei\':
-- Pass through picture timing SEI messages from the source specified in
-- Timecode Config
newH264Settings ::
  H264Settings
newH264Settings :: H264Settings
newH264Settings =
  H264Settings'
    { $sel:adaptiveQuantization:H264Settings' :: Maybe H264AdaptiveQuantization
adaptiveQuantization =
        forall a. Maybe a
Prelude.Nothing,
      $sel:afdSignaling:H264Settings' :: Maybe AfdSignaling
afdSignaling = forall a. Maybe a
Prelude.Nothing,
      $sel:bitrate:H264Settings' :: Maybe Natural
bitrate = forall a. Maybe a
Prelude.Nothing,
      $sel:bufFillPct:H264Settings' :: Maybe Natural
bufFillPct = forall a. Maybe a
Prelude.Nothing,
      $sel:bufSize:H264Settings' :: Maybe Natural
bufSize = forall a. Maybe a
Prelude.Nothing,
      $sel:colorMetadata:H264Settings' :: Maybe H264ColorMetadata
colorMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:colorSpaceSettings:H264Settings' :: Maybe H264ColorSpaceSettings
colorSpaceSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:entropyEncoding:H264Settings' :: Maybe H264EntropyEncoding
entropyEncoding = forall a. Maybe a
Prelude.Nothing,
      $sel:filterSettings:H264Settings' :: Maybe H264FilterSettings
filterSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:fixedAfd:H264Settings' :: Maybe FixedAfd
fixedAfd = forall a. Maybe a
Prelude.Nothing,
      $sel:flickerAq:H264Settings' :: Maybe H264FlickerAq
flickerAq = forall a. Maybe a
Prelude.Nothing,
      $sel:forceFieldPictures:H264Settings' :: Maybe H264ForceFieldPictures
forceFieldPictures = forall a. Maybe a
Prelude.Nothing,
      $sel:framerateControl:H264Settings' :: Maybe H264FramerateControl
framerateControl = forall a. Maybe a
Prelude.Nothing,
      $sel:framerateDenominator:H264Settings' :: Maybe Natural
framerateDenominator = forall a. Maybe a
Prelude.Nothing,
      $sel:framerateNumerator:H264Settings' :: Maybe Natural
framerateNumerator = forall a. Maybe a
Prelude.Nothing,
      $sel:gopBReference:H264Settings' :: Maybe H264GopBReference
gopBReference = forall a. Maybe a
Prelude.Nothing,
      $sel:gopClosedCadence:H264Settings' :: Maybe Natural
gopClosedCadence = forall a. Maybe a
Prelude.Nothing,
      $sel:gopNumBFrames:H264Settings' :: Maybe Natural
gopNumBFrames = forall a. Maybe a
Prelude.Nothing,
      $sel:gopSize:H264Settings' :: Maybe Double
gopSize = forall a. Maybe a
Prelude.Nothing,
      $sel:gopSizeUnits:H264Settings' :: Maybe H264GopSizeUnits
gopSizeUnits = forall a. Maybe a
Prelude.Nothing,
      $sel:level:H264Settings' :: Maybe H264Level
level = forall a. Maybe a
Prelude.Nothing,
      $sel:lookAheadRateControl:H264Settings' :: Maybe H264LookAheadRateControl
lookAheadRateControl = forall a. Maybe a
Prelude.Nothing,
      $sel:maxBitrate:H264Settings' :: Maybe Natural
maxBitrate = forall a. Maybe a
Prelude.Nothing,
      $sel:minIInterval:H264Settings' :: Maybe Natural
minIInterval = forall a. Maybe a
Prelude.Nothing,
      $sel:numRefFrames:H264Settings' :: Maybe Natural
numRefFrames = forall a. Maybe a
Prelude.Nothing,
      $sel:parControl:H264Settings' :: Maybe H264ParControl
parControl = forall a. Maybe a
Prelude.Nothing,
      $sel:parDenominator:H264Settings' :: Maybe Natural
parDenominator = forall a. Maybe a
Prelude.Nothing,
      $sel:parNumerator:H264Settings' :: Maybe Natural
parNumerator = forall a. Maybe a
Prelude.Nothing,
      $sel:profile:H264Settings' :: Maybe H264Profile
profile = forall a. Maybe a
Prelude.Nothing,
      $sel:qualityLevel:H264Settings' :: Maybe H264QualityLevel
qualityLevel = forall a. Maybe a
Prelude.Nothing,
      $sel:qvbrQualityLevel:H264Settings' :: Maybe Natural
qvbrQualityLevel = forall a. Maybe a
Prelude.Nothing,
      $sel:rateControlMode:H264Settings' :: Maybe H264RateControlMode
rateControlMode = forall a. Maybe a
Prelude.Nothing,
      $sel:scanType:H264Settings' :: Maybe H264ScanType
scanType = forall a. Maybe a
Prelude.Nothing,
      $sel:sceneChangeDetect:H264Settings' :: Maybe H264SceneChangeDetect
sceneChangeDetect = forall a. Maybe a
Prelude.Nothing,
      $sel:slices:H264Settings' :: Maybe Natural
slices = forall a. Maybe a
Prelude.Nothing,
      $sel:softness:H264Settings' :: Maybe Natural
softness = forall a. Maybe a
Prelude.Nothing,
      $sel:spatialAq:H264Settings' :: Maybe H264SpatialAq
spatialAq = forall a. Maybe a
Prelude.Nothing,
      $sel:subgopLength:H264Settings' :: Maybe H264SubGopLength
subgopLength = forall a. Maybe a
Prelude.Nothing,
      $sel:syntax:H264Settings' :: Maybe H264Syntax
syntax = forall a. Maybe a
Prelude.Nothing,
      $sel:temporalAq:H264Settings' :: Maybe H264TemporalAq
temporalAq = forall a. Maybe a
Prelude.Nothing,
      $sel:timecodeBurninSettings:H264Settings' :: Maybe TimecodeBurninSettings
timecodeBurninSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:timecodeInsertion:H264Settings' :: Maybe H264TimecodeInsertionBehavior
timecodeInsertion = forall a. Maybe a
Prelude.Nothing
    }

-- | Enables or disables adaptive quantization, which is a technique
-- MediaLive can apply to video on a frame-by-frame basis to produce more
-- compression without losing quality. There are three types of adaptive
-- quantization: flicker, spatial, and temporal. Set the field in one of
-- these ways: Set to Auto. Recommended. For each type of AQ, MediaLive
-- will determine if AQ is needed, and if so, the appropriate strength. Set
-- a strength (a value other than Auto or Disable). This strength will
-- apply to any of the AQ fields that you choose to enable. Set to Disabled
-- to disable all types of adaptive quantization.
h264Settings_adaptiveQuantization :: Lens.Lens' H264Settings (Prelude.Maybe H264AdaptiveQuantization)
h264Settings_adaptiveQuantization :: Lens' H264Settings (Maybe H264AdaptiveQuantization)
h264Settings_adaptiveQuantization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264AdaptiveQuantization
adaptiveQuantization :: Maybe H264AdaptiveQuantization
$sel:adaptiveQuantization:H264Settings' :: H264Settings -> Maybe H264AdaptiveQuantization
adaptiveQuantization} -> Maybe H264AdaptiveQuantization
adaptiveQuantization) (\s :: H264Settings
s@H264Settings' {} Maybe H264AdaptiveQuantization
a -> H264Settings
s {$sel:adaptiveQuantization:H264Settings' :: Maybe H264AdaptiveQuantization
adaptiveQuantization = Maybe H264AdaptiveQuantization
a} :: H264Settings)

-- | Indicates that AFD values will be written into the output stream. If
-- afdSignaling is \"auto\", the system will try to preserve the input AFD
-- value (in cases where multiple AFD values are valid). If set to
-- \"fixed\", the AFD value will be the value configured in the fixedAfd
-- parameter.
h264Settings_afdSignaling :: Lens.Lens' H264Settings (Prelude.Maybe AfdSignaling)
h264Settings_afdSignaling :: Lens' H264Settings (Maybe AfdSignaling)
h264Settings_afdSignaling = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe AfdSignaling
afdSignaling :: Maybe AfdSignaling
$sel:afdSignaling:H264Settings' :: H264Settings -> Maybe AfdSignaling
afdSignaling} -> Maybe AfdSignaling
afdSignaling) (\s :: H264Settings
s@H264Settings' {} Maybe AfdSignaling
a -> H264Settings
s {$sel:afdSignaling:H264Settings' :: Maybe AfdSignaling
afdSignaling = Maybe AfdSignaling
a} :: H264Settings)

-- | Average bitrate in bits\/second. Required when the rate control mode is
-- VBR or CBR. Not used for QVBR. In an MS Smooth output group, each output
-- must have a unique value when its bitrate is rounded down to the nearest
-- multiple of 1000.
h264Settings_bitrate :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_bitrate :: Lens' H264Settings (Maybe Natural)
h264Settings_bitrate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
bitrate :: Maybe Natural
$sel:bitrate:H264Settings' :: H264Settings -> Maybe Natural
bitrate} -> Maybe Natural
bitrate) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:bitrate:H264Settings' :: Maybe Natural
bitrate = Maybe Natural
a} :: H264Settings)

-- | Percentage of the buffer that should initially be filled (HRD buffer
-- model).
h264Settings_bufFillPct :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_bufFillPct :: Lens' H264Settings (Maybe Natural)
h264Settings_bufFillPct = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
bufFillPct :: Maybe Natural
$sel:bufFillPct:H264Settings' :: H264Settings -> Maybe Natural
bufFillPct} -> Maybe Natural
bufFillPct) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:bufFillPct:H264Settings' :: Maybe Natural
bufFillPct = Maybe Natural
a} :: H264Settings)

-- | Size of buffer (HRD buffer model) in bits.
h264Settings_bufSize :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_bufSize :: Lens' H264Settings (Maybe Natural)
h264Settings_bufSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
bufSize :: Maybe Natural
$sel:bufSize:H264Settings' :: H264Settings -> Maybe Natural
bufSize} -> Maybe Natural
bufSize) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:bufSize:H264Settings' :: Maybe Natural
bufSize = Maybe Natural
a} :: H264Settings)

-- | Includes colorspace metadata in the output.
h264Settings_colorMetadata :: Lens.Lens' H264Settings (Prelude.Maybe H264ColorMetadata)
h264Settings_colorMetadata :: Lens' H264Settings (Maybe H264ColorMetadata)
h264Settings_colorMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264ColorMetadata
colorMetadata :: Maybe H264ColorMetadata
$sel:colorMetadata:H264Settings' :: H264Settings -> Maybe H264ColorMetadata
colorMetadata} -> Maybe H264ColorMetadata
colorMetadata) (\s :: H264Settings
s@H264Settings' {} Maybe H264ColorMetadata
a -> H264Settings
s {$sel:colorMetadata:H264Settings' :: Maybe H264ColorMetadata
colorMetadata = Maybe H264ColorMetadata
a} :: H264Settings)

-- | Color Space settings
h264Settings_colorSpaceSettings :: Lens.Lens' H264Settings (Prelude.Maybe H264ColorSpaceSettings)
h264Settings_colorSpaceSettings :: Lens' H264Settings (Maybe H264ColorSpaceSettings)
h264Settings_colorSpaceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264ColorSpaceSettings
colorSpaceSettings :: Maybe H264ColorSpaceSettings
$sel:colorSpaceSettings:H264Settings' :: H264Settings -> Maybe H264ColorSpaceSettings
colorSpaceSettings} -> Maybe H264ColorSpaceSettings
colorSpaceSettings) (\s :: H264Settings
s@H264Settings' {} Maybe H264ColorSpaceSettings
a -> H264Settings
s {$sel:colorSpaceSettings:H264Settings' :: Maybe H264ColorSpaceSettings
colorSpaceSettings = Maybe H264ColorSpaceSettings
a} :: H264Settings)

-- | Entropy encoding mode. Use cabac (must be in Main or High profile) or
-- cavlc.
h264Settings_entropyEncoding :: Lens.Lens' H264Settings (Prelude.Maybe H264EntropyEncoding)
h264Settings_entropyEncoding :: Lens' H264Settings (Maybe H264EntropyEncoding)
h264Settings_entropyEncoding = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264EntropyEncoding
entropyEncoding :: Maybe H264EntropyEncoding
$sel:entropyEncoding:H264Settings' :: H264Settings -> Maybe H264EntropyEncoding
entropyEncoding} -> Maybe H264EntropyEncoding
entropyEncoding) (\s :: H264Settings
s@H264Settings' {} Maybe H264EntropyEncoding
a -> H264Settings
s {$sel:entropyEncoding:H264Settings' :: Maybe H264EntropyEncoding
entropyEncoding = Maybe H264EntropyEncoding
a} :: H264Settings)

-- | Optional filters that you can apply to an encode.
h264Settings_filterSettings :: Lens.Lens' H264Settings (Prelude.Maybe H264FilterSettings)
h264Settings_filterSettings :: Lens' H264Settings (Maybe H264FilterSettings)
h264Settings_filterSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264FilterSettings
filterSettings :: Maybe H264FilterSettings
$sel:filterSettings:H264Settings' :: H264Settings -> Maybe H264FilterSettings
filterSettings} -> Maybe H264FilterSettings
filterSettings) (\s :: H264Settings
s@H264Settings' {} Maybe H264FilterSettings
a -> H264Settings
s {$sel:filterSettings:H264Settings' :: Maybe H264FilterSettings
filterSettings = Maybe H264FilterSettings
a} :: H264Settings)

-- | Four bit AFD value to write on all frames of video in the output stream.
-- Only valid when afdSignaling is set to \'Fixed\'.
h264Settings_fixedAfd :: Lens.Lens' H264Settings (Prelude.Maybe FixedAfd)
h264Settings_fixedAfd :: Lens' H264Settings (Maybe FixedAfd)
h264Settings_fixedAfd = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe FixedAfd
fixedAfd :: Maybe FixedAfd
$sel:fixedAfd:H264Settings' :: H264Settings -> Maybe FixedAfd
fixedAfd} -> Maybe FixedAfd
fixedAfd) (\s :: H264Settings
s@H264Settings' {} Maybe FixedAfd
a -> H264Settings
s {$sel:fixedAfd:H264Settings' :: Maybe FixedAfd
fixedAfd = Maybe FixedAfd
a} :: H264Settings)

-- | Flicker AQ makes adjustments within each frame to reduce flicker or
-- \'pop\' on I-frames. The value to enter in this field depends on the
-- value in the Adaptive quantization field: If you have set the Adaptive
-- quantization field to Auto, MediaLive ignores any value in this field.
-- MediaLive will determine if flicker AQ is appropriate and will apply the
-- appropriate strength. If you have set the Adaptive quantization field to
-- a strength, you can set this field to Enabled or Disabled. Enabled:
-- MediaLive will apply flicker AQ using the specified strength. Disabled:
-- MediaLive won\'t apply flicker AQ. If you have set the Adaptive
-- quantization to Disabled, MediaLive ignores any value in this field and
-- doesn\'t apply flicker AQ.
h264Settings_flickerAq :: Lens.Lens' H264Settings (Prelude.Maybe H264FlickerAq)
h264Settings_flickerAq :: Lens' H264Settings (Maybe H264FlickerAq)
h264Settings_flickerAq = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264FlickerAq
flickerAq :: Maybe H264FlickerAq
$sel:flickerAq:H264Settings' :: H264Settings -> Maybe H264FlickerAq
flickerAq} -> Maybe H264FlickerAq
flickerAq) (\s :: H264Settings
s@H264Settings' {} Maybe H264FlickerAq
a -> H264Settings
s {$sel:flickerAq:H264Settings' :: Maybe H264FlickerAq
flickerAq = Maybe H264FlickerAq
a} :: H264Settings)

-- | This setting applies only when scan type is \"interlaced.\" It controls
-- whether coding is performed on a field basis or on a frame basis. (When
-- the video is progressive, the coding is always performed on a frame
-- basis.) enabled: Force MediaLive to code on a field basis, so that odd
-- and even sets of fields are coded separately. disabled: Code the two
-- sets of fields separately (on a field basis) or together (on a frame
-- basis using PAFF), depending on what is most appropriate for the
-- content.
h264Settings_forceFieldPictures :: Lens.Lens' H264Settings (Prelude.Maybe H264ForceFieldPictures)
h264Settings_forceFieldPictures :: Lens' H264Settings (Maybe H264ForceFieldPictures)
h264Settings_forceFieldPictures = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264ForceFieldPictures
forceFieldPictures :: Maybe H264ForceFieldPictures
$sel:forceFieldPictures:H264Settings' :: H264Settings -> Maybe H264ForceFieldPictures
forceFieldPictures} -> Maybe H264ForceFieldPictures
forceFieldPictures) (\s :: H264Settings
s@H264Settings' {} Maybe H264ForceFieldPictures
a -> H264Settings
s {$sel:forceFieldPictures:H264Settings' :: Maybe H264ForceFieldPictures
forceFieldPictures = Maybe H264ForceFieldPictures
a} :: H264Settings)

-- | This field indicates how the output video frame rate is specified. If
-- \"specified\" is selected then the output video frame rate is determined
-- by framerateNumerator and framerateDenominator, else if
-- \"initializeFromSource\" is selected then the output video frame rate
-- will be set equal to the input video frame rate of the first input.
h264Settings_framerateControl :: Lens.Lens' H264Settings (Prelude.Maybe H264FramerateControl)
h264Settings_framerateControl :: Lens' H264Settings (Maybe H264FramerateControl)
h264Settings_framerateControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264FramerateControl
framerateControl :: Maybe H264FramerateControl
$sel:framerateControl:H264Settings' :: H264Settings -> Maybe H264FramerateControl
framerateControl} -> Maybe H264FramerateControl
framerateControl) (\s :: H264Settings
s@H264Settings' {} Maybe H264FramerateControl
a -> H264Settings
s {$sel:framerateControl:H264Settings' :: Maybe H264FramerateControl
framerateControl = Maybe H264FramerateControl
a} :: H264Settings)

-- | Framerate denominator.
h264Settings_framerateDenominator :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_framerateDenominator :: Lens' H264Settings (Maybe Natural)
h264Settings_framerateDenominator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
framerateDenominator :: Maybe Natural
$sel:framerateDenominator:H264Settings' :: H264Settings -> Maybe Natural
framerateDenominator} -> Maybe Natural
framerateDenominator) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:framerateDenominator:H264Settings' :: Maybe Natural
framerateDenominator = Maybe Natural
a} :: H264Settings)

-- | Framerate numerator - framerate is a fraction, e.g. 24000 \/ 1001 =
-- 23.976 fps.
h264Settings_framerateNumerator :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_framerateNumerator :: Lens' H264Settings (Maybe Natural)
h264Settings_framerateNumerator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
framerateNumerator :: Maybe Natural
$sel:framerateNumerator:H264Settings' :: H264Settings -> Maybe Natural
framerateNumerator} -> Maybe Natural
framerateNumerator) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:framerateNumerator:H264Settings' :: Maybe Natural
framerateNumerator = Maybe Natural
a} :: H264Settings)

-- | Documentation update needed
h264Settings_gopBReference :: Lens.Lens' H264Settings (Prelude.Maybe H264GopBReference)
h264Settings_gopBReference :: Lens' H264Settings (Maybe H264GopBReference)
h264Settings_gopBReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264GopBReference
gopBReference :: Maybe H264GopBReference
$sel:gopBReference:H264Settings' :: H264Settings -> Maybe H264GopBReference
gopBReference} -> Maybe H264GopBReference
gopBReference) (\s :: H264Settings
s@H264Settings' {} Maybe H264GopBReference
a -> H264Settings
s {$sel:gopBReference:H264Settings' :: Maybe H264GopBReference
gopBReference = Maybe H264GopBReference
a} :: H264Settings)

-- | Frequency of closed GOPs. In streaming applications, it is recommended
-- that this be set to 1 so a decoder joining mid-stream will receive an
-- IDR frame as quickly as possible. Setting this value to 0 will break
-- output segmenting.
h264Settings_gopClosedCadence :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_gopClosedCadence :: Lens' H264Settings (Maybe Natural)
h264Settings_gopClosedCadence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
gopClosedCadence :: Maybe Natural
$sel:gopClosedCadence:H264Settings' :: H264Settings -> Maybe Natural
gopClosedCadence} -> Maybe Natural
gopClosedCadence) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:gopClosedCadence:H264Settings' :: Maybe Natural
gopClosedCadence = Maybe Natural
a} :: H264Settings)

-- | Number of B-frames between reference frames.
h264Settings_gopNumBFrames :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_gopNumBFrames :: Lens' H264Settings (Maybe Natural)
h264Settings_gopNumBFrames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
gopNumBFrames :: Maybe Natural
$sel:gopNumBFrames:H264Settings' :: H264Settings -> Maybe Natural
gopNumBFrames} -> Maybe Natural
gopNumBFrames) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:gopNumBFrames:H264Settings' :: Maybe Natural
gopNumBFrames = Maybe Natural
a} :: H264Settings)

-- | GOP size (keyframe interval) in units of either frames or seconds per
-- gopSizeUnits. If gopSizeUnits is frames, gopSize must be an integer and
-- must be greater than or equal to 1. If gopSizeUnits is seconds, gopSize
-- must be greater than 0, but need not be an integer.
h264Settings_gopSize :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Double)
h264Settings_gopSize :: Lens' H264Settings (Maybe Double)
h264Settings_gopSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Double
gopSize :: Maybe Double
$sel:gopSize:H264Settings' :: H264Settings -> Maybe Double
gopSize} -> Maybe Double
gopSize) (\s :: H264Settings
s@H264Settings' {} Maybe Double
a -> H264Settings
s {$sel:gopSize:H264Settings' :: Maybe Double
gopSize = Maybe Double
a} :: H264Settings)

-- | Indicates if the gopSize is specified in frames or seconds. If seconds
-- the system will convert the gopSize into a frame count at run time.
h264Settings_gopSizeUnits :: Lens.Lens' H264Settings (Prelude.Maybe H264GopSizeUnits)
h264Settings_gopSizeUnits :: Lens' H264Settings (Maybe H264GopSizeUnits)
h264Settings_gopSizeUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264GopSizeUnits
gopSizeUnits :: Maybe H264GopSizeUnits
$sel:gopSizeUnits:H264Settings' :: H264Settings -> Maybe H264GopSizeUnits
gopSizeUnits} -> Maybe H264GopSizeUnits
gopSizeUnits) (\s :: H264Settings
s@H264Settings' {} Maybe H264GopSizeUnits
a -> H264Settings
s {$sel:gopSizeUnits:H264Settings' :: Maybe H264GopSizeUnits
gopSizeUnits = Maybe H264GopSizeUnits
a} :: H264Settings)

-- | H.264 Level.
h264Settings_level :: Lens.Lens' H264Settings (Prelude.Maybe H264Level)
h264Settings_level :: Lens' H264Settings (Maybe H264Level)
h264Settings_level = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264Level
level :: Maybe H264Level
$sel:level:H264Settings' :: H264Settings -> Maybe H264Level
level} -> Maybe H264Level
level) (\s :: H264Settings
s@H264Settings' {} Maybe H264Level
a -> H264Settings
s {$sel:level:H264Settings' :: Maybe H264Level
level = Maybe H264Level
a} :: H264Settings)

-- | Amount of lookahead. A value of low can decrease latency and memory
-- usage, while high can produce better quality for certain content.
h264Settings_lookAheadRateControl :: Lens.Lens' H264Settings (Prelude.Maybe H264LookAheadRateControl)
h264Settings_lookAheadRateControl :: Lens' H264Settings (Maybe H264LookAheadRateControl)
h264Settings_lookAheadRateControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264LookAheadRateControl
lookAheadRateControl :: Maybe H264LookAheadRateControl
$sel:lookAheadRateControl:H264Settings' :: H264Settings -> Maybe H264LookAheadRateControl
lookAheadRateControl} -> Maybe H264LookAheadRateControl
lookAheadRateControl) (\s :: H264Settings
s@H264Settings' {} Maybe H264LookAheadRateControl
a -> H264Settings
s {$sel:lookAheadRateControl:H264Settings' :: Maybe H264LookAheadRateControl
lookAheadRateControl = Maybe H264LookAheadRateControl
a} :: H264Settings)

-- | For QVBR: See the tooltip for Quality level For VBR: Set the maximum
-- bitrate in order to accommodate expected spikes in the complexity of the
-- video.
h264Settings_maxBitrate :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_maxBitrate :: Lens' H264Settings (Maybe Natural)
h264Settings_maxBitrate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
maxBitrate :: Maybe Natural
$sel:maxBitrate:H264Settings' :: H264Settings -> Maybe Natural
maxBitrate} -> Maybe Natural
maxBitrate) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:maxBitrate:H264Settings' :: Maybe Natural
maxBitrate = Maybe Natural
a} :: H264Settings)

-- | Only meaningful if sceneChangeDetect is set to enabled. Defaults to 5 if
-- multiplex rate control is used. Enforces separation between repeated
-- (cadence) I-frames and I-frames inserted by Scene Change Detection. If a
-- scene change I-frame is within I-interval frames of a cadence I-frame,
-- the GOP is shrunk and\/or stretched to the scene change I-frame. GOP
-- stretch requires enabling lookahead as well as setting I-interval. The
-- normal cadence resumes for the next GOP. Note: Maximum GOP stretch = GOP
-- size + Min-I-interval - 1
h264Settings_minIInterval :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_minIInterval :: Lens' H264Settings (Maybe Natural)
h264Settings_minIInterval = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
minIInterval :: Maybe Natural
$sel:minIInterval:H264Settings' :: H264Settings -> Maybe Natural
minIInterval} -> Maybe Natural
minIInterval) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:minIInterval:H264Settings' :: Maybe Natural
minIInterval = Maybe Natural
a} :: H264Settings)

-- | Number of reference frames to use. The encoder may use more than
-- requested if using B-frames and\/or interlaced encoding.
h264Settings_numRefFrames :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_numRefFrames :: Lens' H264Settings (Maybe Natural)
h264Settings_numRefFrames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
numRefFrames :: Maybe Natural
$sel:numRefFrames:H264Settings' :: H264Settings -> Maybe Natural
numRefFrames} -> Maybe Natural
numRefFrames) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:numRefFrames:H264Settings' :: Maybe Natural
numRefFrames = Maybe Natural
a} :: H264Settings)

-- | This field indicates how the output pixel aspect ratio is specified. If
-- \"specified\" is selected then the output video pixel aspect ratio is
-- determined by parNumerator and parDenominator, else if
-- \"initializeFromSource\" is selected then the output pixsel aspect ratio
-- will be set equal to the input video pixel aspect ratio of the first
-- input.
h264Settings_parControl :: Lens.Lens' H264Settings (Prelude.Maybe H264ParControl)
h264Settings_parControl :: Lens' H264Settings (Maybe H264ParControl)
h264Settings_parControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264ParControl
parControl :: Maybe H264ParControl
$sel:parControl:H264Settings' :: H264Settings -> Maybe H264ParControl
parControl} -> Maybe H264ParControl
parControl) (\s :: H264Settings
s@H264Settings' {} Maybe H264ParControl
a -> H264Settings
s {$sel:parControl:H264Settings' :: Maybe H264ParControl
parControl = Maybe H264ParControl
a} :: H264Settings)

-- | Pixel Aspect Ratio denominator.
h264Settings_parDenominator :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_parDenominator :: Lens' H264Settings (Maybe Natural)
h264Settings_parDenominator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
parDenominator :: Maybe Natural
$sel:parDenominator:H264Settings' :: H264Settings -> Maybe Natural
parDenominator} -> Maybe Natural
parDenominator) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:parDenominator:H264Settings' :: Maybe Natural
parDenominator = Maybe Natural
a} :: H264Settings)

-- | Pixel Aspect Ratio numerator.
h264Settings_parNumerator :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_parNumerator :: Lens' H264Settings (Maybe Natural)
h264Settings_parNumerator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
parNumerator :: Maybe Natural
$sel:parNumerator:H264Settings' :: H264Settings -> Maybe Natural
parNumerator} -> Maybe Natural
parNumerator) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:parNumerator:H264Settings' :: Maybe Natural
parNumerator = Maybe Natural
a} :: H264Settings)

-- | H.264 Profile.
h264Settings_profile :: Lens.Lens' H264Settings (Prelude.Maybe H264Profile)
h264Settings_profile :: Lens' H264Settings (Maybe H264Profile)
h264Settings_profile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264Profile
profile :: Maybe H264Profile
$sel:profile:H264Settings' :: H264Settings -> Maybe H264Profile
profile} -> Maybe H264Profile
profile) (\s :: H264Settings
s@H264Settings' {} Maybe H264Profile
a -> H264Settings
s {$sel:profile:H264Settings' :: Maybe H264Profile
profile = Maybe H264Profile
a} :: H264Settings)

-- | Leave as STANDARD_QUALITY or choose a different value (which might
-- result in additional costs to run the channel). - ENHANCED_QUALITY:
-- Produces a slightly better video quality without an increase in the
-- bitrate. Has an effect only when the Rate control mode is QVBR or CBR.
-- If this channel is in a MediaLive multiplex, the value must be
-- ENHANCED_QUALITY. - STANDARD_QUALITY: Valid for any Rate control mode.
h264Settings_qualityLevel :: Lens.Lens' H264Settings (Prelude.Maybe H264QualityLevel)
h264Settings_qualityLevel :: Lens' H264Settings (Maybe H264QualityLevel)
h264Settings_qualityLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264QualityLevel
qualityLevel :: Maybe H264QualityLevel
$sel:qualityLevel:H264Settings' :: H264Settings -> Maybe H264QualityLevel
qualityLevel} -> Maybe H264QualityLevel
qualityLevel) (\s :: H264Settings
s@H264Settings' {} Maybe H264QualityLevel
a -> H264Settings
s {$sel:qualityLevel:H264Settings' :: Maybe H264QualityLevel
qualityLevel = Maybe H264QualityLevel
a} :: H264Settings)

-- | Controls the target quality for the video encode. Applies only when the
-- rate control mode is QVBR. You can set a target quality or you can let
-- MediaLive determine the best quality. To set a target quality, enter
-- values in the QVBR quality level field and the Max bitrate field. Enter
-- values that suit your most important viewing devices. Recommended values
-- are: - Primary screen: Quality level: 8 to 10. Max bitrate: 4M - PC or
-- tablet: Quality level: 7. Max bitrate: 1.5M to 3M - Smartphone: Quality
-- level: 6. Max bitrate: 1M to 1.5M To let MediaLive decide, leave the
-- QVBR quality level field empty, and in Max bitrate enter the maximum
-- rate you want in the video. For more information, see the section called
-- \"Video - rate control mode\" in the MediaLive user guide
h264Settings_qvbrQualityLevel :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_qvbrQualityLevel :: Lens' H264Settings (Maybe Natural)
h264Settings_qvbrQualityLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
qvbrQualityLevel :: Maybe Natural
$sel:qvbrQualityLevel:H264Settings' :: H264Settings -> Maybe Natural
qvbrQualityLevel} -> Maybe Natural
qvbrQualityLevel) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:qvbrQualityLevel:H264Settings' :: Maybe Natural
qvbrQualityLevel = Maybe Natural
a} :: H264Settings)

-- | Rate control mode. QVBR: Quality will match the specified quality level
-- except when it is constrained by the maximum bitrate. Recommended if you
-- or your viewers pay for bandwidth. VBR: Quality and bitrate vary,
-- depending on the video complexity. Recommended instead of QVBR if you
-- want to maintain a specific average bitrate over the duration of the
-- channel. CBR: Quality varies, depending on the video complexity.
-- Recommended only if you distribute your assets to devices that cannot
-- handle variable bitrates. Multiplex: This rate control mode is only
-- supported (and is required) when the video is being delivered to a
-- MediaLive Multiplex in which case the rate control configuration is
-- controlled by the properties within the Multiplex Program.
h264Settings_rateControlMode :: Lens.Lens' H264Settings (Prelude.Maybe H264RateControlMode)
h264Settings_rateControlMode :: Lens' H264Settings (Maybe H264RateControlMode)
h264Settings_rateControlMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264RateControlMode
rateControlMode :: Maybe H264RateControlMode
$sel:rateControlMode:H264Settings' :: H264Settings -> Maybe H264RateControlMode
rateControlMode} -> Maybe H264RateControlMode
rateControlMode) (\s :: H264Settings
s@H264Settings' {} Maybe H264RateControlMode
a -> H264Settings
s {$sel:rateControlMode:H264Settings' :: Maybe H264RateControlMode
rateControlMode = Maybe H264RateControlMode
a} :: H264Settings)

-- | Sets the scan type of the output to progressive or top-field-first
-- interlaced.
h264Settings_scanType :: Lens.Lens' H264Settings (Prelude.Maybe H264ScanType)
h264Settings_scanType :: Lens' H264Settings (Maybe H264ScanType)
h264Settings_scanType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264ScanType
scanType :: Maybe H264ScanType
$sel:scanType:H264Settings' :: H264Settings -> Maybe H264ScanType
scanType} -> Maybe H264ScanType
scanType) (\s :: H264Settings
s@H264Settings' {} Maybe H264ScanType
a -> H264Settings
s {$sel:scanType:H264Settings' :: Maybe H264ScanType
scanType = Maybe H264ScanType
a} :: H264Settings)

-- | Scene change detection. - On: inserts I-frames when scene change is
-- detected. - Off: does not force an I-frame when scene change is
-- detected.
h264Settings_sceneChangeDetect :: Lens.Lens' H264Settings (Prelude.Maybe H264SceneChangeDetect)
h264Settings_sceneChangeDetect :: Lens' H264Settings (Maybe H264SceneChangeDetect)
h264Settings_sceneChangeDetect = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264SceneChangeDetect
sceneChangeDetect :: Maybe H264SceneChangeDetect
$sel:sceneChangeDetect:H264Settings' :: H264Settings -> Maybe H264SceneChangeDetect
sceneChangeDetect} -> Maybe H264SceneChangeDetect
sceneChangeDetect) (\s :: H264Settings
s@H264Settings' {} Maybe H264SceneChangeDetect
a -> H264Settings
s {$sel:sceneChangeDetect:H264Settings' :: Maybe H264SceneChangeDetect
sceneChangeDetect = Maybe H264SceneChangeDetect
a} :: H264Settings)

-- | Number of slices per picture. Must be less than or equal to the number
-- of macroblock rows for progressive pictures, and less than or equal to
-- half the number of macroblock rows for interlaced pictures. This field
-- is optional; when no value is specified the encoder will choose the
-- number of slices based on encode resolution.
h264Settings_slices :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_slices :: Lens' H264Settings (Maybe Natural)
h264Settings_slices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
slices :: Maybe Natural
$sel:slices:H264Settings' :: H264Settings -> Maybe Natural
slices} -> Maybe Natural
slices) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:slices:H264Settings' :: Maybe Natural
slices = Maybe Natural
a} :: H264Settings)

-- | Softness. Selects quantizer matrix, larger values reduce high-frequency
-- content in the encoded image. If not set to zero, must be greater than
-- 15.
h264Settings_softness :: Lens.Lens' H264Settings (Prelude.Maybe Prelude.Natural)
h264Settings_softness :: Lens' H264Settings (Maybe Natural)
h264Settings_softness = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe Natural
softness :: Maybe Natural
$sel:softness:H264Settings' :: H264Settings -> Maybe Natural
softness} -> Maybe Natural
softness) (\s :: H264Settings
s@H264Settings' {} Maybe Natural
a -> H264Settings
s {$sel:softness:H264Settings' :: Maybe Natural
softness = Maybe Natural
a} :: H264Settings)

-- | Spatial AQ makes adjustments within each frame based on spatial
-- variation of content complexity. The value to enter in this field
-- depends on the value in the Adaptive quantization field: If you have set
-- the Adaptive quantization field to Auto, MediaLive ignores any value in
-- this field. MediaLive will determine if spatial AQ is appropriate and
-- will apply the appropriate strength. If you have set the Adaptive
-- quantization field to a strength, you can set this field to Enabled or
-- Disabled. Enabled: MediaLive will apply spatial AQ using the specified
-- strength. Disabled: MediaLive won\'t apply spatial AQ. If you have set
-- the Adaptive quantization to Disabled, MediaLive ignores any value in
-- this field and doesn\'t apply spatial AQ.
h264Settings_spatialAq :: Lens.Lens' H264Settings (Prelude.Maybe H264SpatialAq)
h264Settings_spatialAq :: Lens' H264Settings (Maybe H264SpatialAq)
h264Settings_spatialAq = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264SpatialAq
spatialAq :: Maybe H264SpatialAq
$sel:spatialAq:H264Settings' :: H264Settings -> Maybe H264SpatialAq
spatialAq} -> Maybe H264SpatialAq
spatialAq) (\s :: H264Settings
s@H264Settings' {} Maybe H264SpatialAq
a -> H264Settings
s {$sel:spatialAq:H264Settings' :: Maybe H264SpatialAq
spatialAq = Maybe H264SpatialAq
a} :: H264Settings)

-- | If set to fixed, use gopNumBFrames B-frames per sub-GOP. If set to
-- dynamic, optimize the number of B-frames used for each sub-GOP to
-- improve visual quality.
h264Settings_subgopLength :: Lens.Lens' H264Settings (Prelude.Maybe H264SubGopLength)
h264Settings_subgopLength :: Lens' H264Settings (Maybe H264SubGopLength)
h264Settings_subgopLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264SubGopLength
subgopLength :: Maybe H264SubGopLength
$sel:subgopLength:H264Settings' :: H264Settings -> Maybe H264SubGopLength
subgopLength} -> Maybe H264SubGopLength
subgopLength) (\s :: H264Settings
s@H264Settings' {} Maybe H264SubGopLength
a -> H264Settings
s {$sel:subgopLength:H264Settings' :: Maybe H264SubGopLength
subgopLength = Maybe H264SubGopLength
a} :: H264Settings)

-- | Produces a bitstream compliant with SMPTE RP-2027.
h264Settings_syntax :: Lens.Lens' H264Settings (Prelude.Maybe H264Syntax)
h264Settings_syntax :: Lens' H264Settings (Maybe H264Syntax)
h264Settings_syntax = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264Syntax
syntax :: Maybe H264Syntax
$sel:syntax:H264Settings' :: H264Settings -> Maybe H264Syntax
syntax} -> Maybe H264Syntax
syntax) (\s :: H264Settings
s@H264Settings' {} Maybe H264Syntax
a -> H264Settings
s {$sel:syntax:H264Settings' :: Maybe H264Syntax
syntax = Maybe H264Syntax
a} :: H264Settings)

-- | Temporal makes adjustments within each frame based on temporal variation
-- of content complexity. The value to enter in this field depends on the
-- value in the Adaptive quantization field: If you have set the Adaptive
-- quantization field to Auto, MediaLive ignores any value in this field.
-- MediaLive will determine if temporal AQ is appropriate and will apply
-- the appropriate strength. If you have set the Adaptive quantization
-- field to a strength, you can set this field to Enabled or Disabled.
-- Enabled: MediaLive will apply temporal AQ using the specified strength.
-- Disabled: MediaLive won\'t apply temporal AQ. If you have set the
-- Adaptive quantization to Disabled, MediaLive ignores any value in this
-- field and doesn\'t apply temporal AQ.
h264Settings_temporalAq :: Lens.Lens' H264Settings (Prelude.Maybe H264TemporalAq)
h264Settings_temporalAq :: Lens' H264Settings (Maybe H264TemporalAq)
h264Settings_temporalAq = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264TemporalAq
temporalAq :: Maybe H264TemporalAq
$sel:temporalAq:H264Settings' :: H264Settings -> Maybe H264TemporalAq
temporalAq} -> Maybe H264TemporalAq
temporalAq) (\s :: H264Settings
s@H264Settings' {} Maybe H264TemporalAq
a -> H264Settings
s {$sel:temporalAq:H264Settings' :: Maybe H264TemporalAq
temporalAq = Maybe H264TemporalAq
a} :: H264Settings)

-- | Timecode burn-in settings
h264Settings_timecodeBurninSettings :: Lens.Lens' H264Settings (Prelude.Maybe TimecodeBurninSettings)
h264Settings_timecodeBurninSettings :: Lens' H264Settings (Maybe TimecodeBurninSettings)
h264Settings_timecodeBurninSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe TimecodeBurninSettings
timecodeBurninSettings :: Maybe TimecodeBurninSettings
$sel:timecodeBurninSettings:H264Settings' :: H264Settings -> Maybe TimecodeBurninSettings
timecodeBurninSettings} -> Maybe TimecodeBurninSettings
timecodeBurninSettings) (\s :: H264Settings
s@H264Settings' {} Maybe TimecodeBurninSettings
a -> H264Settings
s {$sel:timecodeBurninSettings:H264Settings' :: Maybe TimecodeBurninSettings
timecodeBurninSettings = Maybe TimecodeBurninSettings
a} :: H264Settings)

-- | Determines how timecodes should be inserted into the video elementary
-- stream. - \'disabled\': Do not include timecodes - \'picTimingSei\':
-- Pass through picture timing SEI messages from the source specified in
-- Timecode Config
h264Settings_timecodeInsertion :: Lens.Lens' H264Settings (Prelude.Maybe H264TimecodeInsertionBehavior)
h264Settings_timecodeInsertion :: Lens' H264Settings (Maybe H264TimecodeInsertionBehavior)
h264Settings_timecodeInsertion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H264Settings' {Maybe H264TimecodeInsertionBehavior
timecodeInsertion :: Maybe H264TimecodeInsertionBehavior
$sel:timecodeInsertion:H264Settings' :: H264Settings -> Maybe H264TimecodeInsertionBehavior
timecodeInsertion} -> Maybe H264TimecodeInsertionBehavior
timecodeInsertion) (\s :: H264Settings
s@H264Settings' {} Maybe H264TimecodeInsertionBehavior
a -> H264Settings
s {$sel:timecodeInsertion:H264Settings' :: Maybe H264TimecodeInsertionBehavior
timecodeInsertion = Maybe H264TimecodeInsertionBehavior
a} :: H264Settings)

instance Data.FromJSON H264Settings where
  parseJSON :: Value -> Parser H264Settings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"H264Settings"
      ( \Object
x ->
          Maybe H264AdaptiveQuantization
-> Maybe AfdSignaling
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe H264ColorMetadata
-> Maybe H264ColorSpaceSettings
-> Maybe H264EntropyEncoding
-> Maybe H264FilterSettings
-> Maybe FixedAfd
-> Maybe H264FlickerAq
-> Maybe H264ForceFieldPictures
-> Maybe H264FramerateControl
-> Maybe Natural
-> Maybe Natural
-> Maybe H264GopBReference
-> Maybe Natural
-> Maybe Natural
-> Maybe Double
-> Maybe H264GopSizeUnits
-> Maybe H264Level
-> Maybe H264LookAheadRateControl
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe H264ParControl
-> Maybe Natural
-> Maybe Natural
-> Maybe H264Profile
-> Maybe H264QualityLevel
-> Maybe Natural
-> Maybe H264RateControlMode
-> Maybe H264ScanType
-> Maybe H264SceneChangeDetect
-> Maybe Natural
-> Maybe Natural
-> Maybe H264SpatialAq
-> Maybe H264SubGopLength
-> Maybe H264Syntax
-> Maybe H264TemporalAq
-> Maybe TimecodeBurninSettings
-> Maybe H264TimecodeInsertionBehavior
-> H264Settings
H264Settings'
            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
"adaptiveQuantization")
            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
"afdSignaling")
            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
"bitrate")
            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
"bufFillPct")
            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
"bufSize")
            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
"colorMetadata")
            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
"colorSpaceSettings")
            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
"entropyEncoding")
            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
"filterSettings")
            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
"fixedAfd")
            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
"flickerAq")
            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
"forceFieldPictures")
            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
"framerateControl")
            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
"framerateDenominator")
            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
"framerateNumerator")
            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
"gopBReference")
            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
"gopClosedCadence")
            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
"gopNumBFrames")
            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
"gopSize")
            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
"gopSizeUnits")
            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
"level")
            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
"lookAheadRateControl")
            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
"maxBitrate")
            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
"minIInterval")
            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
"numRefFrames")
            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
"parControl")
            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
"parDenominator")
            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
"parNumerator")
            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
"profile")
            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
"qualityLevel")
            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
"qvbrQualityLevel")
            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
"rateControlMode")
            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
"scanType")
            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
"sceneChangeDetect")
            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
"slices")
            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
"softness")
            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
"spatialAq")
            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
"subgopLength")
            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
"syntax")
            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
"temporalAq")
            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
"timecodeBurninSettings")
            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
"timecodeInsertion")
      )

instance Prelude.Hashable H264Settings where
  hashWithSalt :: Int -> H264Settings -> Int
hashWithSalt Int
_salt H264Settings' {Maybe Double
Maybe Natural
Maybe AfdSignaling
Maybe FixedAfd
Maybe H264AdaptiveQuantization
Maybe H264ColorMetadata
Maybe H264EntropyEncoding
Maybe H264FlickerAq
Maybe H264ForceFieldPictures
Maybe H264FramerateControl
Maybe H264GopBReference
Maybe H264GopSizeUnits
Maybe H264Level
Maybe H264LookAheadRateControl
Maybe H264ParControl
Maybe H264Profile
Maybe H264QualityLevel
Maybe H264RateControlMode
Maybe H264ScanType
Maybe H264SceneChangeDetect
Maybe H264SpatialAq
Maybe H264SubGopLength
Maybe H264Syntax
Maybe H264TemporalAq
Maybe H264TimecodeInsertionBehavior
Maybe H264ColorSpaceSettings
Maybe H264FilterSettings
Maybe TimecodeBurninSettings
timecodeInsertion :: Maybe H264TimecodeInsertionBehavior
timecodeBurninSettings :: Maybe TimecodeBurninSettings
temporalAq :: Maybe H264TemporalAq
syntax :: Maybe H264Syntax
subgopLength :: Maybe H264SubGopLength
spatialAq :: Maybe H264SpatialAq
softness :: Maybe Natural
slices :: Maybe Natural
sceneChangeDetect :: Maybe H264SceneChangeDetect
scanType :: Maybe H264ScanType
rateControlMode :: Maybe H264RateControlMode
qvbrQualityLevel :: Maybe Natural
qualityLevel :: Maybe H264QualityLevel
profile :: Maybe H264Profile
parNumerator :: Maybe Natural
parDenominator :: Maybe Natural
parControl :: Maybe H264ParControl
numRefFrames :: Maybe Natural
minIInterval :: Maybe Natural
maxBitrate :: Maybe Natural
lookAheadRateControl :: Maybe H264LookAheadRateControl
level :: Maybe H264Level
gopSizeUnits :: Maybe H264GopSizeUnits
gopSize :: Maybe Double
gopNumBFrames :: Maybe Natural
gopClosedCadence :: Maybe Natural
gopBReference :: Maybe H264GopBReference
framerateNumerator :: Maybe Natural
framerateDenominator :: Maybe Natural
framerateControl :: Maybe H264FramerateControl
forceFieldPictures :: Maybe H264ForceFieldPictures
flickerAq :: Maybe H264FlickerAq
fixedAfd :: Maybe FixedAfd
filterSettings :: Maybe H264FilterSettings
entropyEncoding :: Maybe H264EntropyEncoding
colorSpaceSettings :: Maybe H264ColorSpaceSettings
colorMetadata :: Maybe H264ColorMetadata
bufSize :: Maybe Natural
bufFillPct :: Maybe Natural
bitrate :: Maybe Natural
afdSignaling :: Maybe AfdSignaling
adaptiveQuantization :: Maybe H264AdaptiveQuantization
$sel:timecodeInsertion:H264Settings' :: H264Settings -> Maybe H264TimecodeInsertionBehavior
$sel:timecodeBurninSettings:H264Settings' :: H264Settings -> Maybe TimecodeBurninSettings
$sel:temporalAq:H264Settings' :: H264Settings -> Maybe H264TemporalAq
$sel:syntax:H264Settings' :: H264Settings -> Maybe H264Syntax
$sel:subgopLength:H264Settings' :: H264Settings -> Maybe H264SubGopLength
$sel:spatialAq:H264Settings' :: H264Settings -> Maybe H264SpatialAq
$sel:softness:H264Settings' :: H264Settings -> Maybe Natural
$sel:slices:H264Settings' :: H264Settings -> Maybe Natural
$sel:sceneChangeDetect:H264Settings' :: H264Settings -> Maybe H264SceneChangeDetect
$sel:scanType:H264Settings' :: H264Settings -> Maybe H264ScanType
$sel:rateControlMode:H264Settings' :: H264Settings -> Maybe H264RateControlMode
$sel:qvbrQualityLevel:H264Settings' :: H264Settings -> Maybe Natural
$sel:qualityLevel:H264Settings' :: H264Settings -> Maybe H264QualityLevel
$sel:profile:H264Settings' :: H264Settings -> Maybe H264Profile
$sel:parNumerator:H264Settings' :: H264Settings -> Maybe Natural
$sel:parDenominator:H264Settings' :: H264Settings -> Maybe Natural
$sel:parControl:H264Settings' :: H264Settings -> Maybe H264ParControl
$sel:numRefFrames:H264Settings' :: H264Settings -> Maybe Natural
$sel:minIInterval:H264Settings' :: H264Settings -> Maybe Natural
$sel:maxBitrate:H264Settings' :: H264Settings -> Maybe Natural
$sel:lookAheadRateControl:H264Settings' :: H264Settings -> Maybe H264LookAheadRateControl
$sel:level:H264Settings' :: H264Settings -> Maybe H264Level
$sel:gopSizeUnits:H264Settings' :: H264Settings -> Maybe H264GopSizeUnits
$sel:gopSize:H264Settings' :: H264Settings -> Maybe Double
$sel:gopNumBFrames:H264Settings' :: H264Settings -> Maybe Natural
$sel:gopClosedCadence:H264Settings' :: H264Settings -> Maybe Natural
$sel:gopBReference:H264Settings' :: H264Settings -> Maybe H264GopBReference
$sel:framerateNumerator:H264Settings' :: H264Settings -> Maybe Natural
$sel:framerateDenominator:H264Settings' :: H264Settings -> Maybe Natural
$sel:framerateControl:H264Settings' :: H264Settings -> Maybe H264FramerateControl
$sel:forceFieldPictures:H264Settings' :: H264Settings -> Maybe H264ForceFieldPictures
$sel:flickerAq:H264Settings' :: H264Settings -> Maybe H264FlickerAq
$sel:fixedAfd:H264Settings' :: H264Settings -> Maybe FixedAfd
$sel:filterSettings:H264Settings' :: H264Settings -> Maybe H264FilterSettings
$sel:entropyEncoding:H264Settings' :: H264Settings -> Maybe H264EntropyEncoding
$sel:colorSpaceSettings:H264Settings' :: H264Settings -> Maybe H264ColorSpaceSettings
$sel:colorMetadata:H264Settings' :: H264Settings -> Maybe H264ColorMetadata
$sel:bufSize:H264Settings' :: H264Settings -> Maybe Natural
$sel:bufFillPct:H264Settings' :: H264Settings -> Maybe Natural
$sel:bitrate:H264Settings' :: H264Settings -> Maybe Natural
$sel:afdSignaling:H264Settings' :: H264Settings -> Maybe AfdSignaling
$sel:adaptiveQuantization:H264Settings' :: H264Settings -> Maybe H264AdaptiveQuantization
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264AdaptiveQuantization
adaptiveQuantization
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AfdSignaling
afdSignaling
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
bitrate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
bufFillPct
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
bufSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264ColorMetadata
colorMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264ColorSpaceSettings
colorSpaceSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264EntropyEncoding
entropyEncoding
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264FilterSettings
filterSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FixedAfd
fixedAfd
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264FlickerAq
flickerAq
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264ForceFieldPictures
forceFieldPictures
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264FramerateControl
framerateControl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
framerateDenominator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
framerateNumerator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264GopBReference
gopBReference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
gopClosedCadence
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
gopNumBFrames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
gopSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264GopSizeUnits
gopSizeUnits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264Level
level
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264LookAheadRateControl
lookAheadRateControl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxBitrate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
minIInterval
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
numRefFrames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264ParControl
parControl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
parDenominator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
parNumerator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264Profile
profile
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264QualityLevel
qualityLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
qvbrQualityLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264RateControlMode
rateControlMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264ScanType
scanType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264SceneChangeDetect
sceneChangeDetect
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
slices
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
softness
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264SpatialAq
spatialAq
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264SubGopLength
subgopLength
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264Syntax
syntax
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264TemporalAq
temporalAq
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimecodeBurninSettings
timecodeBurninSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H264TimecodeInsertionBehavior
timecodeInsertion

instance Prelude.NFData H264Settings where
  rnf :: H264Settings -> ()
rnf H264Settings' {Maybe Double
Maybe Natural
Maybe AfdSignaling
Maybe FixedAfd
Maybe H264AdaptiveQuantization
Maybe H264ColorMetadata
Maybe H264EntropyEncoding
Maybe H264FlickerAq
Maybe H264ForceFieldPictures
Maybe H264FramerateControl
Maybe H264GopBReference
Maybe H264GopSizeUnits
Maybe H264Level
Maybe H264LookAheadRateControl
Maybe H264ParControl
Maybe H264Profile
Maybe H264QualityLevel
Maybe H264RateControlMode
Maybe H264ScanType
Maybe H264SceneChangeDetect
Maybe H264SpatialAq
Maybe H264SubGopLength
Maybe H264Syntax
Maybe H264TemporalAq
Maybe H264TimecodeInsertionBehavior
Maybe H264ColorSpaceSettings
Maybe H264FilterSettings
Maybe TimecodeBurninSettings
timecodeInsertion :: Maybe H264TimecodeInsertionBehavior
timecodeBurninSettings :: Maybe TimecodeBurninSettings
temporalAq :: Maybe H264TemporalAq
syntax :: Maybe H264Syntax
subgopLength :: Maybe H264SubGopLength
spatialAq :: Maybe H264SpatialAq
softness :: Maybe Natural
slices :: Maybe Natural
sceneChangeDetect :: Maybe H264SceneChangeDetect
scanType :: Maybe H264ScanType
rateControlMode :: Maybe H264RateControlMode
qvbrQualityLevel :: Maybe Natural
qualityLevel :: Maybe H264QualityLevel
profile :: Maybe H264Profile
parNumerator :: Maybe Natural
parDenominator :: Maybe Natural
parControl :: Maybe H264ParControl
numRefFrames :: Maybe Natural
minIInterval :: Maybe Natural
maxBitrate :: Maybe Natural
lookAheadRateControl :: Maybe H264LookAheadRateControl
level :: Maybe H264Level
gopSizeUnits :: Maybe H264GopSizeUnits
gopSize :: Maybe Double
gopNumBFrames :: Maybe Natural
gopClosedCadence :: Maybe Natural
gopBReference :: Maybe H264GopBReference
framerateNumerator :: Maybe Natural
framerateDenominator :: Maybe Natural
framerateControl :: Maybe H264FramerateControl
forceFieldPictures :: Maybe H264ForceFieldPictures
flickerAq :: Maybe H264FlickerAq
fixedAfd :: Maybe FixedAfd
filterSettings :: Maybe H264FilterSettings
entropyEncoding :: Maybe H264EntropyEncoding
colorSpaceSettings :: Maybe H264ColorSpaceSettings
colorMetadata :: Maybe H264ColorMetadata
bufSize :: Maybe Natural
bufFillPct :: Maybe Natural
bitrate :: Maybe Natural
afdSignaling :: Maybe AfdSignaling
adaptiveQuantization :: Maybe H264AdaptiveQuantization
$sel:timecodeInsertion:H264Settings' :: H264Settings -> Maybe H264TimecodeInsertionBehavior
$sel:timecodeBurninSettings:H264Settings' :: H264Settings -> Maybe TimecodeBurninSettings
$sel:temporalAq:H264Settings' :: H264Settings -> Maybe H264TemporalAq
$sel:syntax:H264Settings' :: H264Settings -> Maybe H264Syntax
$sel:subgopLength:H264Settings' :: H264Settings -> Maybe H264SubGopLength
$sel:spatialAq:H264Settings' :: H264Settings -> Maybe H264SpatialAq
$sel:softness:H264Settings' :: H264Settings -> Maybe Natural
$sel:slices:H264Settings' :: H264Settings -> Maybe Natural
$sel:sceneChangeDetect:H264Settings' :: H264Settings -> Maybe H264SceneChangeDetect
$sel:scanType:H264Settings' :: H264Settings -> Maybe H264ScanType
$sel:rateControlMode:H264Settings' :: H264Settings -> Maybe H264RateControlMode
$sel:qvbrQualityLevel:H264Settings' :: H264Settings -> Maybe Natural
$sel:qualityLevel:H264Settings' :: H264Settings -> Maybe H264QualityLevel
$sel:profile:H264Settings' :: H264Settings -> Maybe H264Profile
$sel:parNumerator:H264Settings' :: H264Settings -> Maybe Natural
$sel:parDenominator:H264Settings' :: H264Settings -> Maybe Natural
$sel:parControl:H264Settings' :: H264Settings -> Maybe H264ParControl
$sel:numRefFrames:H264Settings' :: H264Settings -> Maybe Natural
$sel:minIInterval:H264Settings' :: H264Settings -> Maybe Natural
$sel:maxBitrate:H264Settings' :: H264Settings -> Maybe Natural
$sel:lookAheadRateControl:H264Settings' :: H264Settings -> Maybe H264LookAheadRateControl
$sel:level:H264Settings' :: H264Settings -> Maybe H264Level
$sel:gopSizeUnits:H264Settings' :: H264Settings -> Maybe H264GopSizeUnits
$sel:gopSize:H264Settings' :: H264Settings -> Maybe Double
$sel:gopNumBFrames:H264Settings' :: H264Settings -> Maybe Natural
$sel:gopClosedCadence:H264Settings' :: H264Settings -> Maybe Natural
$sel:gopBReference:H264Settings' :: H264Settings -> Maybe H264GopBReference
$sel:framerateNumerator:H264Settings' :: H264Settings -> Maybe Natural
$sel:framerateDenominator:H264Settings' :: H264Settings -> Maybe Natural
$sel:framerateControl:H264Settings' :: H264Settings -> Maybe H264FramerateControl
$sel:forceFieldPictures:H264Settings' :: H264Settings -> Maybe H264ForceFieldPictures
$sel:flickerAq:H264Settings' :: H264Settings -> Maybe H264FlickerAq
$sel:fixedAfd:H264Settings' :: H264Settings -> Maybe FixedAfd
$sel:filterSettings:H264Settings' :: H264Settings -> Maybe H264FilterSettings
$sel:entropyEncoding:H264Settings' :: H264Settings -> Maybe H264EntropyEncoding
$sel:colorSpaceSettings:H264Settings' :: H264Settings -> Maybe H264ColorSpaceSettings
$sel:colorMetadata:H264Settings' :: H264Settings -> Maybe H264ColorMetadata
$sel:bufSize:H264Settings' :: H264Settings -> Maybe Natural
$sel:bufFillPct:H264Settings' :: H264Settings -> Maybe Natural
$sel:bitrate:H264Settings' :: H264Settings -> Maybe Natural
$sel:afdSignaling:H264Settings' :: H264Settings -> Maybe AfdSignaling
$sel:adaptiveQuantization:H264Settings' :: H264Settings -> Maybe H264AdaptiveQuantization
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe H264AdaptiveQuantization
adaptiveQuantization
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AfdSignaling
afdSignaling
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
bitrate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
bufFillPct
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
bufSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H264ColorMetadata
colorMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H264ColorSpaceSettings
colorSpaceSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H264EntropyEncoding
entropyEncoding
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H264FilterSettings
filterSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FixedAfd
fixedAfd
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H264FlickerAq
flickerAq
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H264ForceFieldPictures
forceFieldPictures
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H264FramerateControl
framerateControl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
framerateDenominator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
framerateNumerator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H264GopBReference
gopBReference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
gopClosedCadence
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
gopNumBFrames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
gopSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H264GopSizeUnits
gopSizeUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H264Level
level
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264LookAheadRateControl
lookAheadRateControl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxBitrate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
minIInterval
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
numRefFrames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264ParControl
parControl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
parDenominator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
parNumerator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264Profile
profile
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264QualityLevel
qualityLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
qvbrQualityLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264RateControlMode
rateControlMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264ScanType
scanType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264SceneChangeDetect
sceneChangeDetect
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
slices
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
softness
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264SpatialAq
spatialAq
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264SubGopLength
subgopLength
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264Syntax
syntax
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264TemporalAq
temporalAq
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe TimecodeBurninSettings
timecodeBurninSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H264TimecodeInsertionBehavior
timecodeInsertion

instance Data.ToJSON H264Settings where
  toJSON :: H264Settings -> Value
toJSON H264Settings' {Maybe Double
Maybe Natural
Maybe AfdSignaling
Maybe FixedAfd
Maybe H264AdaptiveQuantization
Maybe H264ColorMetadata
Maybe H264EntropyEncoding
Maybe H264FlickerAq
Maybe H264ForceFieldPictures
Maybe H264FramerateControl
Maybe H264GopBReference
Maybe H264GopSizeUnits
Maybe H264Level
Maybe H264LookAheadRateControl
Maybe H264ParControl
Maybe H264Profile
Maybe H264QualityLevel
Maybe H264RateControlMode
Maybe H264ScanType
Maybe H264SceneChangeDetect
Maybe H264SpatialAq
Maybe H264SubGopLength
Maybe H264Syntax
Maybe H264TemporalAq
Maybe H264TimecodeInsertionBehavior
Maybe H264ColorSpaceSettings
Maybe H264FilterSettings
Maybe TimecodeBurninSettings
timecodeInsertion :: Maybe H264TimecodeInsertionBehavior
timecodeBurninSettings :: Maybe TimecodeBurninSettings
temporalAq :: Maybe H264TemporalAq
syntax :: Maybe H264Syntax
subgopLength :: Maybe H264SubGopLength
spatialAq :: Maybe H264SpatialAq
softness :: Maybe Natural
slices :: Maybe Natural
sceneChangeDetect :: Maybe H264SceneChangeDetect
scanType :: Maybe H264ScanType
rateControlMode :: Maybe H264RateControlMode
qvbrQualityLevel :: Maybe Natural
qualityLevel :: Maybe H264QualityLevel
profile :: Maybe H264Profile
parNumerator :: Maybe Natural
parDenominator :: Maybe Natural
parControl :: Maybe H264ParControl
numRefFrames :: Maybe Natural
minIInterval :: Maybe Natural
maxBitrate :: Maybe Natural
lookAheadRateControl :: Maybe H264LookAheadRateControl
level :: Maybe H264Level
gopSizeUnits :: Maybe H264GopSizeUnits
gopSize :: Maybe Double
gopNumBFrames :: Maybe Natural
gopClosedCadence :: Maybe Natural
gopBReference :: Maybe H264GopBReference
framerateNumerator :: Maybe Natural
framerateDenominator :: Maybe Natural
framerateControl :: Maybe H264FramerateControl
forceFieldPictures :: Maybe H264ForceFieldPictures
flickerAq :: Maybe H264FlickerAq
fixedAfd :: Maybe FixedAfd
filterSettings :: Maybe H264FilterSettings
entropyEncoding :: Maybe H264EntropyEncoding
colorSpaceSettings :: Maybe H264ColorSpaceSettings
colorMetadata :: Maybe H264ColorMetadata
bufSize :: Maybe Natural
bufFillPct :: Maybe Natural
bitrate :: Maybe Natural
afdSignaling :: Maybe AfdSignaling
adaptiveQuantization :: Maybe H264AdaptiveQuantization
$sel:timecodeInsertion:H264Settings' :: H264Settings -> Maybe H264TimecodeInsertionBehavior
$sel:timecodeBurninSettings:H264Settings' :: H264Settings -> Maybe TimecodeBurninSettings
$sel:temporalAq:H264Settings' :: H264Settings -> Maybe H264TemporalAq
$sel:syntax:H264Settings' :: H264Settings -> Maybe H264Syntax
$sel:subgopLength:H264Settings' :: H264Settings -> Maybe H264SubGopLength
$sel:spatialAq:H264Settings' :: H264Settings -> Maybe H264SpatialAq
$sel:softness:H264Settings' :: H264Settings -> Maybe Natural
$sel:slices:H264Settings' :: H264Settings -> Maybe Natural
$sel:sceneChangeDetect:H264Settings' :: H264Settings -> Maybe H264SceneChangeDetect
$sel:scanType:H264Settings' :: H264Settings -> Maybe H264ScanType
$sel:rateControlMode:H264Settings' :: H264Settings -> Maybe H264RateControlMode
$sel:qvbrQualityLevel:H264Settings' :: H264Settings -> Maybe Natural
$sel:qualityLevel:H264Settings' :: H264Settings -> Maybe H264QualityLevel
$sel:profile:H264Settings' :: H264Settings -> Maybe H264Profile
$sel:parNumerator:H264Settings' :: H264Settings -> Maybe Natural
$sel:parDenominator:H264Settings' :: H264Settings -> Maybe Natural
$sel:parControl:H264Settings' :: H264Settings -> Maybe H264ParControl
$sel:numRefFrames:H264Settings' :: H264Settings -> Maybe Natural
$sel:minIInterval:H264Settings' :: H264Settings -> Maybe Natural
$sel:maxBitrate:H264Settings' :: H264Settings -> Maybe Natural
$sel:lookAheadRateControl:H264Settings' :: H264Settings -> Maybe H264LookAheadRateControl
$sel:level:H264Settings' :: H264Settings -> Maybe H264Level
$sel:gopSizeUnits:H264Settings' :: H264Settings -> Maybe H264GopSizeUnits
$sel:gopSize:H264Settings' :: H264Settings -> Maybe Double
$sel:gopNumBFrames:H264Settings' :: H264Settings -> Maybe Natural
$sel:gopClosedCadence:H264Settings' :: H264Settings -> Maybe Natural
$sel:gopBReference:H264Settings' :: H264Settings -> Maybe H264GopBReference
$sel:framerateNumerator:H264Settings' :: H264Settings -> Maybe Natural
$sel:framerateDenominator:H264Settings' :: H264Settings -> Maybe Natural
$sel:framerateControl:H264Settings' :: H264Settings -> Maybe H264FramerateControl
$sel:forceFieldPictures:H264Settings' :: H264Settings -> Maybe H264ForceFieldPictures
$sel:flickerAq:H264Settings' :: H264Settings -> Maybe H264FlickerAq
$sel:fixedAfd:H264Settings' :: H264Settings -> Maybe FixedAfd
$sel:filterSettings:H264Settings' :: H264Settings -> Maybe H264FilterSettings
$sel:entropyEncoding:H264Settings' :: H264Settings -> Maybe H264EntropyEncoding
$sel:colorSpaceSettings:H264Settings' :: H264Settings -> Maybe H264ColorSpaceSettings
$sel:colorMetadata:H264Settings' :: H264Settings -> Maybe H264ColorMetadata
$sel:bufSize:H264Settings' :: H264Settings -> Maybe Natural
$sel:bufFillPct:H264Settings' :: H264Settings -> Maybe Natural
$sel:bitrate:H264Settings' :: H264Settings -> Maybe Natural
$sel:afdSignaling:H264Settings' :: H264Settings -> Maybe AfdSignaling
$sel:adaptiveQuantization:H264Settings' :: H264Settings -> Maybe H264AdaptiveQuantization
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"adaptiveQuantization" 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 H264AdaptiveQuantization
adaptiveQuantization,
            (Key
"afdSignaling" 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 AfdSignaling
afdSignaling,
            (Key
"bitrate" 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
bitrate,
            (Key
"bufFillPct" 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
bufFillPct,
            (Key
"bufSize" 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
bufSize,
            (Key
"colorMetadata" 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 H264ColorMetadata
colorMetadata,
            (Key
"colorSpaceSettings" 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 H264ColorSpaceSettings
colorSpaceSettings,
            (Key
"entropyEncoding" 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 H264EntropyEncoding
entropyEncoding,
            (Key
"filterSettings" 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 H264FilterSettings
filterSettings,
            (Key
"fixedAfd" 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 FixedAfd
fixedAfd,
            (Key
"flickerAq" 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 H264FlickerAq
flickerAq,
            (Key
"forceFieldPictures" 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 H264ForceFieldPictures
forceFieldPictures,
            (Key
"framerateControl" 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 H264FramerateControl
framerateControl,
            (Key
"framerateDenominator" 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
framerateDenominator,
            (Key
"framerateNumerator" 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
framerateNumerator,
            (Key
"gopBReference" 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 H264GopBReference
gopBReference,
            (Key
"gopClosedCadence" 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
gopClosedCadence,
            (Key
"gopNumBFrames" 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
gopNumBFrames,
            (Key
"gopSize" 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 Double
gopSize,
            (Key
"gopSizeUnits" 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 H264GopSizeUnits
gopSizeUnits,
            (Key
"level" 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 H264Level
level,
            (Key
"lookAheadRateControl" 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 H264LookAheadRateControl
lookAheadRateControl,
            (Key
"maxBitrate" 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
maxBitrate,
            (Key
"minIInterval" 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
minIInterval,
            (Key
"numRefFrames" 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
numRefFrames,
            (Key
"parControl" 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 H264ParControl
parControl,
            (Key
"parDenominator" 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
parDenominator,
            (Key
"parNumerator" 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
parNumerator,
            (Key
"profile" 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 H264Profile
profile,
            (Key
"qualityLevel" 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 H264QualityLevel
qualityLevel,
            (Key
"qvbrQualityLevel" 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
qvbrQualityLevel,
            (Key
"rateControlMode" 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 H264RateControlMode
rateControlMode,
            (Key
"scanType" 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 H264ScanType
scanType,
            (Key
"sceneChangeDetect" 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 H264SceneChangeDetect
sceneChangeDetect,
            (Key
"slices" 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
slices,
            (Key
"softness" 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
softness,
            (Key
"spatialAq" 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 H264SpatialAq
spatialAq,
            (Key
"subgopLength" 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 H264SubGopLength
subgopLength,
            (Key
"syntax" 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 H264Syntax
syntax,
            (Key
"temporalAq" 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 H264TemporalAq
temporalAq,
            (Key
"timecodeBurninSettings" 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 TimecodeBurninSettings
timecodeBurninSettings,
            (Key
"timecodeInsertion" 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 H264TimecodeInsertionBehavior
timecodeInsertion
          ]
      )