{-# 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.H265Settings
-- 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.H265Settings 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.H265AdaptiveQuantization
import Amazonka.MediaLive.Types.H265AlternativeTransferFunction
import Amazonka.MediaLive.Types.H265ColorMetadata
import Amazonka.MediaLive.Types.H265ColorSpaceSettings
import Amazonka.MediaLive.Types.H265FilterSettings
import Amazonka.MediaLive.Types.H265FlickerAq
import Amazonka.MediaLive.Types.H265GopSizeUnits
import Amazonka.MediaLive.Types.H265Level
import Amazonka.MediaLive.Types.H265LookAheadRateControl
import Amazonka.MediaLive.Types.H265Profile
import Amazonka.MediaLive.Types.H265RateControlMode
import Amazonka.MediaLive.Types.H265ScanType
import Amazonka.MediaLive.Types.H265SceneChangeDetect
import Amazonka.MediaLive.Types.H265Tier
import Amazonka.MediaLive.Types.H265TimecodeInsertionBehavior
import Amazonka.MediaLive.Types.TimecodeBurninSettings
import qualified Amazonka.Prelude as Prelude

-- | H265 Settings
--
-- /See:/ 'newH265Settings' smart constructor.
data H265Settings = H265Settings'
  { -- | Adaptive quantization. Allows intra-frame quantizers to vary to improve
    -- visual quality.
    H265Settings -> Maybe H265AdaptiveQuantization
adaptiveQuantization :: Prelude.Maybe H265AdaptiveQuantization,
    -- | 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.
    H265Settings -> Maybe AfdSignaling
afdSignaling :: Prelude.Maybe AfdSignaling,
    -- | Whether or not EML should insert an Alternative Transfer Function SEI
    -- message to support backwards compatibility with non-HDR decoders and
    -- displays.
    H265Settings -> Maybe H265AlternativeTransferFunction
alternativeTransferFunction :: Prelude.Maybe H265AlternativeTransferFunction,
    -- | 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.
    H265Settings -> Maybe Natural
bitrate :: Prelude.Maybe Prelude.Natural,
    -- | Size of buffer (HRD buffer model) in bits.
    H265Settings -> Maybe Natural
bufSize :: Prelude.Maybe Prelude.Natural,
    -- | Includes colorspace metadata in the output.
    H265Settings -> Maybe H265ColorMetadata
colorMetadata :: Prelude.Maybe H265ColorMetadata,
    -- | Color Space settings
    H265Settings -> Maybe H265ColorSpaceSettings
colorSpaceSettings :: Prelude.Maybe H265ColorSpaceSettings,
    -- | Optional filters that you can apply to an encode.
    H265Settings -> Maybe H265FilterSettings
filterSettings :: Prelude.Maybe H265FilterSettings,
    -- | Four bit AFD value to write on all frames of video in the output stream.
    -- Only valid when afdSignaling is set to \'Fixed\'.
    H265Settings -> Maybe FixedAfd
fixedAfd :: Prelude.Maybe FixedAfd,
    -- | If set to enabled, adjust quantization within each frame to reduce
    -- flicker or \'pop\' on I-frames.
    H265Settings -> Maybe H265FlickerAq
flickerAq :: Prelude.Maybe H265FlickerAq,
    -- | 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.
    H265Settings -> Maybe Natural
gopClosedCadence :: 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.
    H265Settings -> 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.
    H265Settings -> Maybe H265GopSizeUnits
gopSizeUnits :: Prelude.Maybe H265GopSizeUnits,
    -- | H.265 Level.
    H265Settings -> Maybe H265Level
level :: Prelude.Maybe H265Level,
    -- | Amount of lookahead. A value of low can decrease latency and memory
    -- usage, while high can produce better quality for certain content.
    H265Settings -> Maybe H265LookAheadRateControl
lookAheadRateControl :: Prelude.Maybe H265LookAheadRateControl,
    -- | For QVBR: See the tooltip for Quality level
    H265Settings -> 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
    H265Settings -> Maybe Natural
minIInterval :: Prelude.Maybe Prelude.Natural,
    -- | Pixel Aspect Ratio denominator.
    H265Settings -> Maybe Natural
parDenominator :: Prelude.Maybe Prelude.Natural,
    -- | Pixel Aspect Ratio numerator.
    H265Settings -> Maybe Natural
parNumerator :: Prelude.Maybe Prelude.Natural,
    -- | H.265 Profile.
    H265Settings -> Maybe H265Profile
profile :: Prelude.Maybe H265Profile,
    -- | Controls the target quality for the video encode. Applies only when the
    -- rate control mode is QVBR. Set values for the QVBR quality level field
    -- and Max bitrate field 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
    H265Settings -> 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. 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.
    H265Settings -> Maybe H265RateControlMode
rateControlMode :: Prelude.Maybe H265RateControlMode,
    -- | Sets the scan type of the output to progressive or top-field-first
    -- interlaced.
    H265Settings -> Maybe H265ScanType
scanType :: Prelude.Maybe H265ScanType,
    -- | Scene change detection.
    H265Settings -> Maybe H265SceneChangeDetect
sceneChangeDetect :: Prelude.Maybe H265SceneChangeDetect,
    -- | 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.
    H265Settings -> Maybe Natural
slices :: Prelude.Maybe Prelude.Natural,
    -- | H.265 Tier.
    H265Settings -> Maybe H265Tier
tier :: Prelude.Maybe H265Tier,
    -- | Timecode burn-in settings
    H265Settings -> 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
    H265Settings -> Maybe H265TimecodeInsertionBehavior
timecodeInsertion :: Prelude.Maybe H265TimecodeInsertionBehavior,
    -- | Framerate numerator - framerate is a fraction, e.g. 24000 \/ 1001 =
    -- 23.976 fps.
    H265Settings -> Natural
framerateNumerator :: Prelude.Natural,
    -- | Framerate denominator.
    H265Settings -> Natural
framerateDenominator :: Prelude.Natural
  }
  deriving (H265Settings -> H265Settings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: H265Settings -> H265Settings -> Bool
$c/= :: H265Settings -> H265Settings -> Bool
== :: H265Settings -> H265Settings -> Bool
$c== :: H265Settings -> H265Settings -> Bool
Prelude.Eq, ReadPrec [H265Settings]
ReadPrec H265Settings
Int -> ReadS H265Settings
ReadS [H265Settings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [H265Settings]
$creadListPrec :: ReadPrec [H265Settings]
readPrec :: ReadPrec H265Settings
$creadPrec :: ReadPrec H265Settings
readList :: ReadS [H265Settings]
$creadList :: ReadS [H265Settings]
readsPrec :: Int -> ReadS H265Settings
$creadsPrec :: Int -> ReadS H265Settings
Prelude.Read, Int -> H265Settings -> ShowS
[H265Settings] -> ShowS
H265Settings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [H265Settings] -> ShowS
$cshowList :: [H265Settings] -> ShowS
show :: H265Settings -> String
$cshow :: H265Settings -> String
showsPrec :: Int -> H265Settings -> ShowS
$cshowsPrec :: Int -> H265Settings -> ShowS
Prelude.Show, forall x. Rep H265Settings x -> H265Settings
forall x. H265Settings -> Rep H265Settings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep H265Settings x -> H265Settings
$cfrom :: forall x. H265Settings -> Rep H265Settings x
Prelude.Generic)

-- |
-- Create a value of 'H265Settings' 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', 'h265Settings_adaptiveQuantization' - Adaptive quantization. Allows intra-frame quantizers to vary to improve
-- visual quality.
--
-- 'afdSignaling', 'h265Settings_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.
--
-- 'alternativeTransferFunction', 'h265Settings_alternativeTransferFunction' - Whether or not EML should insert an Alternative Transfer Function SEI
-- message to support backwards compatibility with non-HDR decoders and
-- displays.
--
-- 'bitrate', 'h265Settings_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.
--
-- 'bufSize', 'h265Settings_bufSize' - Size of buffer (HRD buffer model) in bits.
--
-- 'colorMetadata', 'h265Settings_colorMetadata' - Includes colorspace metadata in the output.
--
-- 'colorSpaceSettings', 'h265Settings_colorSpaceSettings' - Color Space settings
--
-- 'filterSettings', 'h265Settings_filterSettings' - Optional filters that you can apply to an encode.
--
-- 'fixedAfd', 'h265Settings_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', 'h265Settings_flickerAq' - If set to enabled, adjust quantization within each frame to reduce
-- flicker or \'pop\' on I-frames.
--
-- 'gopClosedCadence', 'h265Settings_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.
--
-- 'gopSize', 'h265Settings_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', 'h265Settings_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', 'h265Settings_level' - H.265 Level.
--
-- 'lookAheadRateControl', 'h265Settings_lookAheadRateControl' - Amount of lookahead. A value of low can decrease latency and memory
-- usage, while high can produce better quality for certain content.
--
-- 'maxBitrate', 'h265Settings_maxBitrate' - For QVBR: See the tooltip for Quality level
--
-- 'minIInterval', 'h265Settings_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
--
-- 'parDenominator', 'h265Settings_parDenominator' - Pixel Aspect Ratio denominator.
--
-- 'parNumerator', 'h265Settings_parNumerator' - Pixel Aspect Ratio numerator.
--
-- 'profile', 'h265Settings_profile' - H.265 Profile.
--
-- 'qvbrQualityLevel', 'h265Settings_qvbrQualityLevel' - Controls the target quality for the video encode. Applies only when the
-- rate control mode is QVBR. Set values for the QVBR quality level field
-- and Max bitrate field 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
--
-- 'rateControlMode', 'h265Settings_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. 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', 'h265Settings_scanType' - Sets the scan type of the output to progressive or top-field-first
-- interlaced.
--
-- 'sceneChangeDetect', 'h265Settings_sceneChangeDetect' - Scene change detection.
--
-- 'slices', 'h265Settings_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.
--
-- 'tier', 'h265Settings_tier' - H.265 Tier.
--
-- 'timecodeBurninSettings', 'h265Settings_timecodeBurninSettings' - Timecode burn-in settings
--
-- 'timecodeInsertion', 'h265Settings_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
--
-- 'framerateNumerator', 'h265Settings_framerateNumerator' - Framerate numerator - framerate is a fraction, e.g. 24000 \/ 1001 =
-- 23.976 fps.
--
-- 'framerateDenominator', 'h265Settings_framerateDenominator' - Framerate denominator.
newH265Settings ::
  -- | 'framerateNumerator'
  Prelude.Natural ->
  -- | 'framerateDenominator'
  Prelude.Natural ->
  H265Settings
newH265Settings :: Natural -> Natural -> H265Settings
newH265Settings
  Natural
pFramerateNumerator_
  Natural
pFramerateDenominator_ =
    H265Settings'
      { $sel:adaptiveQuantization:H265Settings' :: Maybe H265AdaptiveQuantization
adaptiveQuantization =
          forall a. Maybe a
Prelude.Nothing,
        $sel:afdSignaling:H265Settings' :: Maybe AfdSignaling
afdSignaling = forall a. Maybe a
Prelude.Nothing,
        $sel:alternativeTransferFunction:H265Settings' :: Maybe H265AlternativeTransferFunction
alternativeTransferFunction = forall a. Maybe a
Prelude.Nothing,
        $sel:bitrate:H265Settings' :: Maybe Natural
bitrate = forall a. Maybe a
Prelude.Nothing,
        $sel:bufSize:H265Settings' :: Maybe Natural
bufSize = forall a. Maybe a
Prelude.Nothing,
        $sel:colorMetadata:H265Settings' :: Maybe H265ColorMetadata
colorMetadata = forall a. Maybe a
Prelude.Nothing,
        $sel:colorSpaceSettings:H265Settings' :: Maybe H265ColorSpaceSettings
colorSpaceSettings = forall a. Maybe a
Prelude.Nothing,
        $sel:filterSettings:H265Settings' :: Maybe H265FilterSettings
filterSettings = forall a. Maybe a
Prelude.Nothing,
        $sel:fixedAfd:H265Settings' :: Maybe FixedAfd
fixedAfd = forall a. Maybe a
Prelude.Nothing,
        $sel:flickerAq:H265Settings' :: Maybe H265FlickerAq
flickerAq = forall a. Maybe a
Prelude.Nothing,
        $sel:gopClosedCadence:H265Settings' :: Maybe Natural
gopClosedCadence = forall a. Maybe a
Prelude.Nothing,
        $sel:gopSize:H265Settings' :: Maybe Double
gopSize = forall a. Maybe a
Prelude.Nothing,
        $sel:gopSizeUnits:H265Settings' :: Maybe H265GopSizeUnits
gopSizeUnits = forall a. Maybe a
Prelude.Nothing,
        $sel:level:H265Settings' :: Maybe H265Level
level = forall a. Maybe a
Prelude.Nothing,
        $sel:lookAheadRateControl:H265Settings' :: Maybe H265LookAheadRateControl
lookAheadRateControl = forall a. Maybe a
Prelude.Nothing,
        $sel:maxBitrate:H265Settings' :: Maybe Natural
maxBitrate = forall a. Maybe a
Prelude.Nothing,
        $sel:minIInterval:H265Settings' :: Maybe Natural
minIInterval = forall a. Maybe a
Prelude.Nothing,
        $sel:parDenominator:H265Settings' :: Maybe Natural
parDenominator = forall a. Maybe a
Prelude.Nothing,
        $sel:parNumerator:H265Settings' :: Maybe Natural
parNumerator = forall a. Maybe a
Prelude.Nothing,
        $sel:profile:H265Settings' :: Maybe H265Profile
profile = forall a. Maybe a
Prelude.Nothing,
        $sel:qvbrQualityLevel:H265Settings' :: Maybe Natural
qvbrQualityLevel = forall a. Maybe a
Prelude.Nothing,
        $sel:rateControlMode:H265Settings' :: Maybe H265RateControlMode
rateControlMode = forall a. Maybe a
Prelude.Nothing,
        $sel:scanType:H265Settings' :: Maybe H265ScanType
scanType = forall a. Maybe a
Prelude.Nothing,
        $sel:sceneChangeDetect:H265Settings' :: Maybe H265SceneChangeDetect
sceneChangeDetect = forall a. Maybe a
Prelude.Nothing,
        $sel:slices:H265Settings' :: Maybe Natural
slices = forall a. Maybe a
Prelude.Nothing,
        $sel:tier:H265Settings' :: Maybe H265Tier
tier = forall a. Maybe a
Prelude.Nothing,
        $sel:timecodeBurninSettings:H265Settings' :: Maybe TimecodeBurninSettings
timecodeBurninSettings = forall a. Maybe a
Prelude.Nothing,
        $sel:timecodeInsertion:H265Settings' :: Maybe H265TimecodeInsertionBehavior
timecodeInsertion = forall a. Maybe a
Prelude.Nothing,
        $sel:framerateNumerator:H265Settings' :: Natural
framerateNumerator = Natural
pFramerateNumerator_,
        $sel:framerateDenominator:H265Settings' :: Natural
framerateDenominator = Natural
pFramerateDenominator_
      }

-- | Adaptive quantization. Allows intra-frame quantizers to vary to improve
-- visual quality.
h265Settings_adaptiveQuantization :: Lens.Lens' H265Settings (Prelude.Maybe H265AdaptiveQuantization)
h265Settings_adaptiveQuantization :: Lens' H265Settings (Maybe H265AdaptiveQuantization)
h265Settings_adaptiveQuantization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe H265AdaptiveQuantization
adaptiveQuantization :: Maybe H265AdaptiveQuantization
$sel:adaptiveQuantization:H265Settings' :: H265Settings -> Maybe H265AdaptiveQuantization
adaptiveQuantization} -> Maybe H265AdaptiveQuantization
adaptiveQuantization) (\s :: H265Settings
s@H265Settings' {} Maybe H265AdaptiveQuantization
a -> H265Settings
s {$sel:adaptiveQuantization:H265Settings' :: Maybe H265AdaptiveQuantization
adaptiveQuantization = Maybe H265AdaptiveQuantization
a} :: H265Settings)

-- | 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.
h265Settings_afdSignaling :: Lens.Lens' H265Settings (Prelude.Maybe AfdSignaling)
h265Settings_afdSignaling :: Lens' H265Settings (Maybe AfdSignaling)
h265Settings_afdSignaling = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe AfdSignaling
afdSignaling :: Maybe AfdSignaling
$sel:afdSignaling:H265Settings' :: H265Settings -> Maybe AfdSignaling
afdSignaling} -> Maybe AfdSignaling
afdSignaling) (\s :: H265Settings
s@H265Settings' {} Maybe AfdSignaling
a -> H265Settings
s {$sel:afdSignaling:H265Settings' :: Maybe AfdSignaling
afdSignaling = Maybe AfdSignaling
a} :: H265Settings)

-- | Whether or not EML should insert an Alternative Transfer Function SEI
-- message to support backwards compatibility with non-HDR decoders and
-- displays.
h265Settings_alternativeTransferFunction :: Lens.Lens' H265Settings (Prelude.Maybe H265AlternativeTransferFunction)
h265Settings_alternativeTransferFunction :: Lens' H265Settings (Maybe H265AlternativeTransferFunction)
h265Settings_alternativeTransferFunction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe H265AlternativeTransferFunction
alternativeTransferFunction :: Maybe H265AlternativeTransferFunction
$sel:alternativeTransferFunction:H265Settings' :: H265Settings -> Maybe H265AlternativeTransferFunction
alternativeTransferFunction} -> Maybe H265AlternativeTransferFunction
alternativeTransferFunction) (\s :: H265Settings
s@H265Settings' {} Maybe H265AlternativeTransferFunction
a -> H265Settings
s {$sel:alternativeTransferFunction:H265Settings' :: Maybe H265AlternativeTransferFunction
alternativeTransferFunction = Maybe H265AlternativeTransferFunction
a} :: H265Settings)

-- | 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.
h265Settings_bitrate :: Lens.Lens' H265Settings (Prelude.Maybe Prelude.Natural)
h265Settings_bitrate :: Lens' H265Settings (Maybe Natural)
h265Settings_bitrate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe Natural
bitrate :: Maybe Natural
$sel:bitrate:H265Settings' :: H265Settings -> Maybe Natural
bitrate} -> Maybe Natural
bitrate) (\s :: H265Settings
s@H265Settings' {} Maybe Natural
a -> H265Settings
s {$sel:bitrate:H265Settings' :: Maybe Natural
bitrate = Maybe Natural
a} :: H265Settings)

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

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

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

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

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

-- | If set to enabled, adjust quantization within each frame to reduce
-- flicker or \'pop\' on I-frames.
h265Settings_flickerAq :: Lens.Lens' H265Settings (Prelude.Maybe H265FlickerAq)
h265Settings_flickerAq :: Lens' H265Settings (Maybe H265FlickerAq)
h265Settings_flickerAq = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe H265FlickerAq
flickerAq :: Maybe H265FlickerAq
$sel:flickerAq:H265Settings' :: H265Settings -> Maybe H265FlickerAq
flickerAq} -> Maybe H265FlickerAq
flickerAq) (\s :: H265Settings
s@H265Settings' {} Maybe H265FlickerAq
a -> H265Settings
s {$sel:flickerAq:H265Settings' :: Maybe H265FlickerAq
flickerAq = Maybe H265FlickerAq
a} :: H265Settings)

-- | 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.
h265Settings_gopClosedCadence :: Lens.Lens' H265Settings (Prelude.Maybe Prelude.Natural)
h265Settings_gopClosedCadence :: Lens' H265Settings (Maybe Natural)
h265Settings_gopClosedCadence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe Natural
gopClosedCadence :: Maybe Natural
$sel:gopClosedCadence:H265Settings' :: H265Settings -> Maybe Natural
gopClosedCadence} -> Maybe Natural
gopClosedCadence) (\s :: H265Settings
s@H265Settings' {} Maybe Natural
a -> H265Settings
s {$sel:gopClosedCadence:H265Settings' :: Maybe Natural
gopClosedCadence = Maybe Natural
a} :: H265Settings)

-- | 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.
h265Settings_gopSize :: Lens.Lens' H265Settings (Prelude.Maybe Prelude.Double)
h265Settings_gopSize :: Lens' H265Settings (Maybe Double)
h265Settings_gopSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe Double
gopSize :: Maybe Double
$sel:gopSize:H265Settings' :: H265Settings -> Maybe Double
gopSize} -> Maybe Double
gopSize) (\s :: H265Settings
s@H265Settings' {} Maybe Double
a -> H265Settings
s {$sel:gopSize:H265Settings' :: Maybe Double
gopSize = Maybe Double
a} :: H265Settings)

-- | 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.
h265Settings_gopSizeUnits :: Lens.Lens' H265Settings (Prelude.Maybe H265GopSizeUnits)
h265Settings_gopSizeUnits :: Lens' H265Settings (Maybe H265GopSizeUnits)
h265Settings_gopSizeUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe H265GopSizeUnits
gopSizeUnits :: Maybe H265GopSizeUnits
$sel:gopSizeUnits:H265Settings' :: H265Settings -> Maybe H265GopSizeUnits
gopSizeUnits} -> Maybe H265GopSizeUnits
gopSizeUnits) (\s :: H265Settings
s@H265Settings' {} Maybe H265GopSizeUnits
a -> H265Settings
s {$sel:gopSizeUnits:H265Settings' :: Maybe H265GopSizeUnits
gopSizeUnits = Maybe H265GopSizeUnits
a} :: H265Settings)

-- | H.265 Level.
h265Settings_level :: Lens.Lens' H265Settings (Prelude.Maybe H265Level)
h265Settings_level :: Lens' H265Settings (Maybe H265Level)
h265Settings_level = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe H265Level
level :: Maybe H265Level
$sel:level:H265Settings' :: H265Settings -> Maybe H265Level
level} -> Maybe H265Level
level) (\s :: H265Settings
s@H265Settings' {} Maybe H265Level
a -> H265Settings
s {$sel:level:H265Settings' :: Maybe H265Level
level = Maybe H265Level
a} :: H265Settings)

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

-- | For QVBR: See the tooltip for Quality level
h265Settings_maxBitrate :: Lens.Lens' H265Settings (Prelude.Maybe Prelude.Natural)
h265Settings_maxBitrate :: Lens' H265Settings (Maybe Natural)
h265Settings_maxBitrate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe Natural
maxBitrate :: Maybe Natural
$sel:maxBitrate:H265Settings' :: H265Settings -> Maybe Natural
maxBitrate} -> Maybe Natural
maxBitrate) (\s :: H265Settings
s@H265Settings' {} Maybe Natural
a -> H265Settings
s {$sel:maxBitrate:H265Settings' :: Maybe Natural
maxBitrate = Maybe Natural
a} :: H265Settings)

-- | 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
h265Settings_minIInterval :: Lens.Lens' H265Settings (Prelude.Maybe Prelude.Natural)
h265Settings_minIInterval :: Lens' H265Settings (Maybe Natural)
h265Settings_minIInterval = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe Natural
minIInterval :: Maybe Natural
$sel:minIInterval:H265Settings' :: H265Settings -> Maybe Natural
minIInterval} -> Maybe Natural
minIInterval) (\s :: H265Settings
s@H265Settings' {} Maybe Natural
a -> H265Settings
s {$sel:minIInterval:H265Settings' :: Maybe Natural
minIInterval = Maybe Natural
a} :: H265Settings)

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

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

-- | H.265 Profile.
h265Settings_profile :: Lens.Lens' H265Settings (Prelude.Maybe H265Profile)
h265Settings_profile :: Lens' H265Settings (Maybe H265Profile)
h265Settings_profile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe H265Profile
profile :: Maybe H265Profile
$sel:profile:H265Settings' :: H265Settings -> Maybe H265Profile
profile} -> Maybe H265Profile
profile) (\s :: H265Settings
s@H265Settings' {} Maybe H265Profile
a -> H265Settings
s {$sel:profile:H265Settings' :: Maybe H265Profile
profile = Maybe H265Profile
a} :: H265Settings)

-- | Controls the target quality for the video encode. Applies only when the
-- rate control mode is QVBR. Set values for the QVBR quality level field
-- and Max bitrate field 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
h265Settings_qvbrQualityLevel :: Lens.Lens' H265Settings (Prelude.Maybe Prelude.Natural)
h265Settings_qvbrQualityLevel :: Lens' H265Settings (Maybe Natural)
h265Settings_qvbrQualityLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe Natural
qvbrQualityLevel :: Maybe Natural
$sel:qvbrQualityLevel:H265Settings' :: H265Settings -> Maybe Natural
qvbrQualityLevel} -> Maybe Natural
qvbrQualityLevel) (\s :: H265Settings
s@H265Settings' {} Maybe Natural
a -> H265Settings
s {$sel:qvbrQualityLevel:H265Settings' :: Maybe Natural
qvbrQualityLevel = Maybe Natural
a} :: H265Settings)

-- | 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. 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.
h265Settings_rateControlMode :: Lens.Lens' H265Settings (Prelude.Maybe H265RateControlMode)
h265Settings_rateControlMode :: Lens' H265Settings (Maybe H265RateControlMode)
h265Settings_rateControlMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe H265RateControlMode
rateControlMode :: Maybe H265RateControlMode
$sel:rateControlMode:H265Settings' :: H265Settings -> Maybe H265RateControlMode
rateControlMode} -> Maybe H265RateControlMode
rateControlMode) (\s :: H265Settings
s@H265Settings' {} Maybe H265RateControlMode
a -> H265Settings
s {$sel:rateControlMode:H265Settings' :: Maybe H265RateControlMode
rateControlMode = Maybe H265RateControlMode
a} :: H265Settings)

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

-- | Scene change detection.
h265Settings_sceneChangeDetect :: Lens.Lens' H265Settings (Prelude.Maybe H265SceneChangeDetect)
h265Settings_sceneChangeDetect :: Lens' H265Settings (Maybe H265SceneChangeDetect)
h265Settings_sceneChangeDetect = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe H265SceneChangeDetect
sceneChangeDetect :: Maybe H265SceneChangeDetect
$sel:sceneChangeDetect:H265Settings' :: H265Settings -> Maybe H265SceneChangeDetect
sceneChangeDetect} -> Maybe H265SceneChangeDetect
sceneChangeDetect) (\s :: H265Settings
s@H265Settings' {} Maybe H265SceneChangeDetect
a -> H265Settings
s {$sel:sceneChangeDetect:H265Settings' :: Maybe H265SceneChangeDetect
sceneChangeDetect = Maybe H265SceneChangeDetect
a} :: H265Settings)

-- | 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.
h265Settings_slices :: Lens.Lens' H265Settings (Prelude.Maybe Prelude.Natural)
h265Settings_slices :: Lens' H265Settings (Maybe Natural)
h265Settings_slices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe Natural
slices :: Maybe Natural
$sel:slices:H265Settings' :: H265Settings -> Maybe Natural
slices} -> Maybe Natural
slices) (\s :: H265Settings
s@H265Settings' {} Maybe Natural
a -> H265Settings
s {$sel:slices:H265Settings' :: Maybe Natural
slices = Maybe Natural
a} :: H265Settings)

-- | H.265 Tier.
h265Settings_tier :: Lens.Lens' H265Settings (Prelude.Maybe H265Tier)
h265Settings_tier :: Lens' H265Settings (Maybe H265Tier)
h265Settings_tier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe H265Tier
tier :: Maybe H265Tier
$sel:tier:H265Settings' :: H265Settings -> Maybe H265Tier
tier} -> Maybe H265Tier
tier) (\s :: H265Settings
s@H265Settings' {} Maybe H265Tier
a -> H265Settings
s {$sel:tier:H265Settings' :: Maybe H265Tier
tier = Maybe H265Tier
a} :: H265Settings)

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

-- | 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
h265Settings_timecodeInsertion :: Lens.Lens' H265Settings (Prelude.Maybe H265TimecodeInsertionBehavior)
h265Settings_timecodeInsertion :: Lens' H265Settings (Maybe H265TimecodeInsertionBehavior)
h265Settings_timecodeInsertion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\H265Settings' {Maybe H265TimecodeInsertionBehavior
timecodeInsertion :: Maybe H265TimecodeInsertionBehavior
$sel:timecodeInsertion:H265Settings' :: H265Settings -> Maybe H265TimecodeInsertionBehavior
timecodeInsertion} -> Maybe H265TimecodeInsertionBehavior
timecodeInsertion) (\s :: H265Settings
s@H265Settings' {} Maybe H265TimecodeInsertionBehavior
a -> H265Settings
s {$sel:timecodeInsertion:H265Settings' :: Maybe H265TimecodeInsertionBehavior
timecodeInsertion = Maybe H265TimecodeInsertionBehavior
a} :: H265Settings)

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

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

instance Data.FromJSON H265Settings where
  parseJSON :: Value -> Parser H265Settings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"H265Settings"
      ( \Object
x ->
          Maybe H265AdaptiveQuantization
-> Maybe AfdSignaling
-> Maybe H265AlternativeTransferFunction
-> Maybe Natural
-> Maybe Natural
-> Maybe H265ColorMetadata
-> Maybe H265ColorSpaceSettings
-> Maybe H265FilterSettings
-> Maybe FixedAfd
-> Maybe H265FlickerAq
-> Maybe Natural
-> Maybe Double
-> Maybe H265GopSizeUnits
-> Maybe H265Level
-> Maybe H265LookAheadRateControl
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe H265Profile
-> Maybe Natural
-> Maybe H265RateControlMode
-> Maybe H265ScanType
-> Maybe H265SceneChangeDetect
-> Maybe Natural
-> Maybe H265Tier
-> Maybe TimecodeBurninSettings
-> Maybe H265TimecodeInsertionBehavior
-> Natural
-> Natural
-> H265Settings
H265Settings'
            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
"alternativeTransferFunction")
            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
"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
"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
"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
"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
"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
"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
"tier")
            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")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"framerateNumerator")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"framerateDenominator")
      )

instance Prelude.Hashable H265Settings where
  hashWithSalt :: Int -> H265Settings -> Int
hashWithSalt Int
_salt H265Settings' {Natural
Maybe Double
Maybe Natural
Maybe AfdSignaling
Maybe FixedAfd
Maybe H265AdaptiveQuantization
Maybe H265AlternativeTransferFunction
Maybe H265ColorMetadata
Maybe H265FlickerAq
Maybe H265GopSizeUnits
Maybe H265Level
Maybe H265LookAheadRateControl
Maybe H265Profile
Maybe H265RateControlMode
Maybe H265ScanType
Maybe H265SceneChangeDetect
Maybe H265Tier
Maybe H265TimecodeInsertionBehavior
Maybe H265ColorSpaceSettings
Maybe H265FilterSettings
Maybe TimecodeBurninSettings
framerateDenominator :: Natural
framerateNumerator :: Natural
timecodeInsertion :: Maybe H265TimecodeInsertionBehavior
timecodeBurninSettings :: Maybe TimecodeBurninSettings
tier :: Maybe H265Tier
slices :: Maybe Natural
sceneChangeDetect :: Maybe H265SceneChangeDetect
scanType :: Maybe H265ScanType
rateControlMode :: Maybe H265RateControlMode
qvbrQualityLevel :: Maybe Natural
profile :: Maybe H265Profile
parNumerator :: Maybe Natural
parDenominator :: Maybe Natural
minIInterval :: Maybe Natural
maxBitrate :: Maybe Natural
lookAheadRateControl :: Maybe H265LookAheadRateControl
level :: Maybe H265Level
gopSizeUnits :: Maybe H265GopSizeUnits
gopSize :: Maybe Double
gopClosedCadence :: Maybe Natural
flickerAq :: Maybe H265FlickerAq
fixedAfd :: Maybe FixedAfd
filterSettings :: Maybe H265FilterSettings
colorSpaceSettings :: Maybe H265ColorSpaceSettings
colorMetadata :: Maybe H265ColorMetadata
bufSize :: Maybe Natural
bitrate :: Maybe Natural
alternativeTransferFunction :: Maybe H265AlternativeTransferFunction
afdSignaling :: Maybe AfdSignaling
adaptiveQuantization :: Maybe H265AdaptiveQuantization
$sel:framerateDenominator:H265Settings' :: H265Settings -> Natural
$sel:framerateNumerator:H265Settings' :: H265Settings -> Natural
$sel:timecodeInsertion:H265Settings' :: H265Settings -> Maybe H265TimecodeInsertionBehavior
$sel:timecodeBurninSettings:H265Settings' :: H265Settings -> Maybe TimecodeBurninSettings
$sel:tier:H265Settings' :: H265Settings -> Maybe H265Tier
$sel:slices:H265Settings' :: H265Settings -> Maybe Natural
$sel:sceneChangeDetect:H265Settings' :: H265Settings -> Maybe H265SceneChangeDetect
$sel:scanType:H265Settings' :: H265Settings -> Maybe H265ScanType
$sel:rateControlMode:H265Settings' :: H265Settings -> Maybe H265RateControlMode
$sel:qvbrQualityLevel:H265Settings' :: H265Settings -> Maybe Natural
$sel:profile:H265Settings' :: H265Settings -> Maybe H265Profile
$sel:parNumerator:H265Settings' :: H265Settings -> Maybe Natural
$sel:parDenominator:H265Settings' :: H265Settings -> Maybe Natural
$sel:minIInterval:H265Settings' :: H265Settings -> Maybe Natural
$sel:maxBitrate:H265Settings' :: H265Settings -> Maybe Natural
$sel:lookAheadRateControl:H265Settings' :: H265Settings -> Maybe H265LookAheadRateControl
$sel:level:H265Settings' :: H265Settings -> Maybe H265Level
$sel:gopSizeUnits:H265Settings' :: H265Settings -> Maybe H265GopSizeUnits
$sel:gopSize:H265Settings' :: H265Settings -> Maybe Double
$sel:gopClosedCadence:H265Settings' :: H265Settings -> Maybe Natural
$sel:flickerAq:H265Settings' :: H265Settings -> Maybe H265FlickerAq
$sel:fixedAfd:H265Settings' :: H265Settings -> Maybe FixedAfd
$sel:filterSettings:H265Settings' :: H265Settings -> Maybe H265FilterSettings
$sel:colorSpaceSettings:H265Settings' :: H265Settings -> Maybe H265ColorSpaceSettings
$sel:colorMetadata:H265Settings' :: H265Settings -> Maybe H265ColorMetadata
$sel:bufSize:H265Settings' :: H265Settings -> Maybe Natural
$sel:bitrate:H265Settings' :: H265Settings -> Maybe Natural
$sel:alternativeTransferFunction:H265Settings' :: H265Settings -> Maybe H265AlternativeTransferFunction
$sel:afdSignaling:H265Settings' :: H265Settings -> Maybe AfdSignaling
$sel:adaptiveQuantization:H265Settings' :: H265Settings -> Maybe H265AdaptiveQuantization
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265AdaptiveQuantization
adaptiveQuantization
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AfdSignaling
afdSignaling
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265AlternativeTransferFunction
alternativeTransferFunction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
bitrate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
bufSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265ColorMetadata
colorMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265ColorSpaceSettings
colorSpaceSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265FilterSettings
filterSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FixedAfd
fixedAfd
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265FlickerAq
flickerAq
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
gopClosedCadence
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
gopSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265GopSizeUnits
gopSizeUnits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265Level
level
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265LookAheadRateControl
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
parDenominator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
parNumerator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265Profile
profile
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
qvbrQualityLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265RateControlMode
rateControlMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265ScanType
scanType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265SceneChangeDetect
sceneChangeDetect
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
slices
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265Tier
tier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimecodeBurninSettings
timecodeBurninSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe H265TimecodeInsertionBehavior
timecodeInsertion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
framerateNumerator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
framerateDenominator

instance Prelude.NFData H265Settings where
  rnf :: H265Settings -> ()
rnf H265Settings' {Natural
Maybe Double
Maybe Natural
Maybe AfdSignaling
Maybe FixedAfd
Maybe H265AdaptiveQuantization
Maybe H265AlternativeTransferFunction
Maybe H265ColorMetadata
Maybe H265FlickerAq
Maybe H265GopSizeUnits
Maybe H265Level
Maybe H265LookAheadRateControl
Maybe H265Profile
Maybe H265RateControlMode
Maybe H265ScanType
Maybe H265SceneChangeDetect
Maybe H265Tier
Maybe H265TimecodeInsertionBehavior
Maybe H265ColorSpaceSettings
Maybe H265FilterSettings
Maybe TimecodeBurninSettings
framerateDenominator :: Natural
framerateNumerator :: Natural
timecodeInsertion :: Maybe H265TimecodeInsertionBehavior
timecodeBurninSettings :: Maybe TimecodeBurninSettings
tier :: Maybe H265Tier
slices :: Maybe Natural
sceneChangeDetect :: Maybe H265SceneChangeDetect
scanType :: Maybe H265ScanType
rateControlMode :: Maybe H265RateControlMode
qvbrQualityLevel :: Maybe Natural
profile :: Maybe H265Profile
parNumerator :: Maybe Natural
parDenominator :: Maybe Natural
minIInterval :: Maybe Natural
maxBitrate :: Maybe Natural
lookAheadRateControl :: Maybe H265LookAheadRateControl
level :: Maybe H265Level
gopSizeUnits :: Maybe H265GopSizeUnits
gopSize :: Maybe Double
gopClosedCadence :: Maybe Natural
flickerAq :: Maybe H265FlickerAq
fixedAfd :: Maybe FixedAfd
filterSettings :: Maybe H265FilterSettings
colorSpaceSettings :: Maybe H265ColorSpaceSettings
colorMetadata :: Maybe H265ColorMetadata
bufSize :: Maybe Natural
bitrate :: Maybe Natural
alternativeTransferFunction :: Maybe H265AlternativeTransferFunction
afdSignaling :: Maybe AfdSignaling
adaptiveQuantization :: Maybe H265AdaptiveQuantization
$sel:framerateDenominator:H265Settings' :: H265Settings -> Natural
$sel:framerateNumerator:H265Settings' :: H265Settings -> Natural
$sel:timecodeInsertion:H265Settings' :: H265Settings -> Maybe H265TimecodeInsertionBehavior
$sel:timecodeBurninSettings:H265Settings' :: H265Settings -> Maybe TimecodeBurninSettings
$sel:tier:H265Settings' :: H265Settings -> Maybe H265Tier
$sel:slices:H265Settings' :: H265Settings -> Maybe Natural
$sel:sceneChangeDetect:H265Settings' :: H265Settings -> Maybe H265SceneChangeDetect
$sel:scanType:H265Settings' :: H265Settings -> Maybe H265ScanType
$sel:rateControlMode:H265Settings' :: H265Settings -> Maybe H265RateControlMode
$sel:qvbrQualityLevel:H265Settings' :: H265Settings -> Maybe Natural
$sel:profile:H265Settings' :: H265Settings -> Maybe H265Profile
$sel:parNumerator:H265Settings' :: H265Settings -> Maybe Natural
$sel:parDenominator:H265Settings' :: H265Settings -> Maybe Natural
$sel:minIInterval:H265Settings' :: H265Settings -> Maybe Natural
$sel:maxBitrate:H265Settings' :: H265Settings -> Maybe Natural
$sel:lookAheadRateControl:H265Settings' :: H265Settings -> Maybe H265LookAheadRateControl
$sel:level:H265Settings' :: H265Settings -> Maybe H265Level
$sel:gopSizeUnits:H265Settings' :: H265Settings -> Maybe H265GopSizeUnits
$sel:gopSize:H265Settings' :: H265Settings -> Maybe Double
$sel:gopClosedCadence:H265Settings' :: H265Settings -> Maybe Natural
$sel:flickerAq:H265Settings' :: H265Settings -> Maybe H265FlickerAq
$sel:fixedAfd:H265Settings' :: H265Settings -> Maybe FixedAfd
$sel:filterSettings:H265Settings' :: H265Settings -> Maybe H265FilterSettings
$sel:colorSpaceSettings:H265Settings' :: H265Settings -> Maybe H265ColorSpaceSettings
$sel:colorMetadata:H265Settings' :: H265Settings -> Maybe H265ColorMetadata
$sel:bufSize:H265Settings' :: H265Settings -> Maybe Natural
$sel:bitrate:H265Settings' :: H265Settings -> Maybe Natural
$sel:alternativeTransferFunction:H265Settings' :: H265Settings -> Maybe H265AlternativeTransferFunction
$sel:afdSignaling:H265Settings' :: H265Settings -> Maybe AfdSignaling
$sel:adaptiveQuantization:H265Settings' :: H265Settings -> Maybe H265AdaptiveQuantization
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe H265AdaptiveQuantization
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 H265AlternativeTransferFunction
alternativeTransferFunction
      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
bufSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H265ColorMetadata
colorMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H265ColorSpaceSettings
colorSpaceSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H265FilterSettings
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 H265FlickerAq
flickerAq
      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 Double
gopSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H265GopSizeUnits
gopSizeUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H265Level
level
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H265LookAheadRateControl
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
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 H265Profile
profile
      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 H265RateControlMode
rateControlMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe H265ScanType
scanType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe H265SceneChangeDetect
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 H265Tier
tier
      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 H265TimecodeInsertionBehavior
timecodeInsertion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Natural
framerateNumerator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Natural
framerateDenominator

instance Data.ToJSON H265Settings where
  toJSON :: H265Settings -> Value
toJSON H265Settings' {Natural
Maybe Double
Maybe Natural
Maybe AfdSignaling
Maybe FixedAfd
Maybe H265AdaptiveQuantization
Maybe H265AlternativeTransferFunction
Maybe H265ColorMetadata
Maybe H265FlickerAq
Maybe H265GopSizeUnits
Maybe H265Level
Maybe H265LookAheadRateControl
Maybe H265Profile
Maybe H265RateControlMode
Maybe H265ScanType
Maybe H265SceneChangeDetect
Maybe H265Tier
Maybe H265TimecodeInsertionBehavior
Maybe H265ColorSpaceSettings
Maybe H265FilterSettings
Maybe TimecodeBurninSettings
framerateDenominator :: Natural
framerateNumerator :: Natural
timecodeInsertion :: Maybe H265TimecodeInsertionBehavior
timecodeBurninSettings :: Maybe TimecodeBurninSettings
tier :: Maybe H265Tier
slices :: Maybe Natural
sceneChangeDetect :: Maybe H265SceneChangeDetect
scanType :: Maybe H265ScanType
rateControlMode :: Maybe H265RateControlMode
qvbrQualityLevel :: Maybe Natural
profile :: Maybe H265Profile
parNumerator :: Maybe Natural
parDenominator :: Maybe Natural
minIInterval :: Maybe Natural
maxBitrate :: Maybe Natural
lookAheadRateControl :: Maybe H265LookAheadRateControl
level :: Maybe H265Level
gopSizeUnits :: Maybe H265GopSizeUnits
gopSize :: Maybe Double
gopClosedCadence :: Maybe Natural
flickerAq :: Maybe H265FlickerAq
fixedAfd :: Maybe FixedAfd
filterSettings :: Maybe H265FilterSettings
colorSpaceSettings :: Maybe H265ColorSpaceSettings
colorMetadata :: Maybe H265ColorMetadata
bufSize :: Maybe Natural
bitrate :: Maybe Natural
alternativeTransferFunction :: Maybe H265AlternativeTransferFunction
afdSignaling :: Maybe AfdSignaling
adaptiveQuantization :: Maybe H265AdaptiveQuantization
$sel:framerateDenominator:H265Settings' :: H265Settings -> Natural
$sel:framerateNumerator:H265Settings' :: H265Settings -> Natural
$sel:timecodeInsertion:H265Settings' :: H265Settings -> Maybe H265TimecodeInsertionBehavior
$sel:timecodeBurninSettings:H265Settings' :: H265Settings -> Maybe TimecodeBurninSettings
$sel:tier:H265Settings' :: H265Settings -> Maybe H265Tier
$sel:slices:H265Settings' :: H265Settings -> Maybe Natural
$sel:sceneChangeDetect:H265Settings' :: H265Settings -> Maybe H265SceneChangeDetect
$sel:scanType:H265Settings' :: H265Settings -> Maybe H265ScanType
$sel:rateControlMode:H265Settings' :: H265Settings -> Maybe H265RateControlMode
$sel:qvbrQualityLevel:H265Settings' :: H265Settings -> Maybe Natural
$sel:profile:H265Settings' :: H265Settings -> Maybe H265Profile
$sel:parNumerator:H265Settings' :: H265Settings -> Maybe Natural
$sel:parDenominator:H265Settings' :: H265Settings -> Maybe Natural
$sel:minIInterval:H265Settings' :: H265Settings -> Maybe Natural
$sel:maxBitrate:H265Settings' :: H265Settings -> Maybe Natural
$sel:lookAheadRateControl:H265Settings' :: H265Settings -> Maybe H265LookAheadRateControl
$sel:level:H265Settings' :: H265Settings -> Maybe H265Level
$sel:gopSizeUnits:H265Settings' :: H265Settings -> Maybe H265GopSizeUnits
$sel:gopSize:H265Settings' :: H265Settings -> Maybe Double
$sel:gopClosedCadence:H265Settings' :: H265Settings -> Maybe Natural
$sel:flickerAq:H265Settings' :: H265Settings -> Maybe H265FlickerAq
$sel:fixedAfd:H265Settings' :: H265Settings -> Maybe FixedAfd
$sel:filterSettings:H265Settings' :: H265Settings -> Maybe H265FilterSettings
$sel:colorSpaceSettings:H265Settings' :: H265Settings -> Maybe H265ColorSpaceSettings
$sel:colorMetadata:H265Settings' :: H265Settings -> Maybe H265ColorMetadata
$sel:bufSize:H265Settings' :: H265Settings -> Maybe Natural
$sel:bitrate:H265Settings' :: H265Settings -> Maybe Natural
$sel:alternativeTransferFunction:H265Settings' :: H265Settings -> Maybe H265AlternativeTransferFunction
$sel:afdSignaling:H265Settings' :: H265Settings -> Maybe AfdSignaling
$sel:adaptiveQuantization:H265Settings' :: H265Settings -> Maybe H265AdaptiveQuantization
..} =
    [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 H265AdaptiveQuantization
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
"alternativeTransferFunction" 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 H265AlternativeTransferFunction
alternativeTransferFunction,
            (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
"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 H265ColorMetadata
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 H265ColorSpaceSettings
colorSpaceSettings,
            (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 H265FilterSettings
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 H265FlickerAq
flickerAq,
            (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
"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 H265GopSizeUnits
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 H265Level
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 H265LookAheadRateControl
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
"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 H265Profile
profile,
            (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 H265RateControlMode
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 H265ScanType
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 H265SceneChangeDetect
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
"tier" 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 H265Tier
tier,
            (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 H265TimecodeInsertionBehavior
timecodeInsertion,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"framerateNumerator" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
framerateNumerator),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"framerateDenominator"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
framerateDenominator
              )
          ]
      )