{-# 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.MediaConvert.Types.InputTemplate
-- 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.MediaConvert.Types.InputTemplate where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaConvert.Types.AudioSelector
import Amazonka.MediaConvert.Types.AudioSelectorGroup
import Amazonka.MediaConvert.Types.CaptionSelector
import Amazonka.MediaConvert.Types.ImageInserter
import Amazonka.MediaConvert.Types.InputClipping
import Amazonka.MediaConvert.Types.InputDeblockFilter
import Amazonka.MediaConvert.Types.InputDenoiseFilter
import Amazonka.MediaConvert.Types.InputFilterEnable
import Amazonka.MediaConvert.Types.InputPsiControl
import Amazonka.MediaConvert.Types.InputScanType
import Amazonka.MediaConvert.Types.InputTimecodeSource
import Amazonka.MediaConvert.Types.Rectangle
import Amazonka.MediaConvert.Types.VideoSelector
import qualified Amazonka.Prelude as Prelude

-- | Specified video input in a template.
--
-- /See:/ 'newInputTemplate' smart constructor.
data InputTemplate = InputTemplate'
  { -- | Use audio selector groups to combine multiple sidecar audio inputs so
    -- that you can assign them to a single output audio tab
    -- (AudioDescription). Note that, if you\'re working with embedded audio,
    -- it\'s simpler to assign multiple input tracks into a single audio
    -- selector rather than use an audio selector group.
    InputTemplate -> Maybe (HashMap Text AudioSelectorGroup)
audioSelectorGroups :: Prelude.Maybe (Prelude.HashMap Prelude.Text AudioSelectorGroup),
    -- | Use Audio selectors (AudioSelectors) to specify a track or set of tracks
    -- from the input that you will use in your outputs. You can use multiple
    -- Audio selectors per input.
    InputTemplate -> Maybe (HashMap Text AudioSelector)
audioSelectors :: Prelude.Maybe (Prelude.HashMap Prelude.Text AudioSelector),
    -- | Use captions selectors to specify the captions data from your input that
    -- you use in your outputs. You can use up to 20 captions selectors per
    -- input.
    InputTemplate -> Maybe (HashMap Text CaptionSelector)
captionSelectors :: Prelude.Maybe (Prelude.HashMap Prelude.Text CaptionSelector),
    -- | Use Cropping selection (crop) to specify the video area that the service
    -- will include in the output video frame. If you specify a value here, it
    -- will override any value that you specify in the output setting Cropping
    -- selection (crop).
    InputTemplate -> Maybe Rectangle
crop :: Prelude.Maybe Rectangle,
    -- | Enable Deblock (InputDeblockFilter) to produce smoother motion in the
    -- output. Default is disabled. Only manually controllable for MPEG2 and
    -- uncompressed video inputs.
    InputTemplate -> Maybe InputDeblockFilter
deblockFilter :: Prelude.Maybe InputDeblockFilter,
    -- | Enable Denoise (InputDenoiseFilter) to filter noise from the input.
    -- Default is disabled. Only applicable to MPEG2, H.264, H.265, and
    -- uncompressed video inputs.
    InputTemplate -> Maybe InputDenoiseFilter
denoiseFilter :: Prelude.Maybe InputDenoiseFilter,
    -- | Use this setting only when your video source has Dolby Vision studio
    -- mastering metadata that is carried in a separate XML file. Specify the
    -- Amazon S3 location for the metadata XML file. MediaConvert uses this
    -- file to provide global and frame-level metadata for Dolby Vision
    -- preprocessing. When you specify a file here and your input also has
    -- interleaved global and frame level metadata, MediaConvert ignores the
    -- interleaved metadata and uses only the the metadata from this external
    -- XML file. Note that your IAM service role must grant MediaConvert read
    -- permissions to this file. For more information, see
    -- https:\/\/docs.aws.amazon.com\/mediaconvert\/latest\/ug\/iam-role.html.
    InputTemplate -> Maybe Text
dolbyVisionMetadataXml :: Prelude.Maybe Prelude.Text,
    -- | Specify how the transcoding service applies the denoise and deblock
    -- filters. You must also enable the filters separately, with Denoise
    -- (InputDenoiseFilter) and Deblock (InputDeblockFilter). * Auto - The
    -- transcoding service determines whether to apply filtering, depending on
    -- input type and quality. * Disable - The input is not filtered. This is
    -- true even if you use the API to enable them in (InputDeblockFilter) and
    -- (InputDeblockFilter). * Force - The input is filtered regardless of
    -- input type.
    InputTemplate -> Maybe InputFilterEnable
filterEnable :: Prelude.Maybe InputFilterEnable,
    -- | Use Filter strength (FilterStrength) to adjust the magnitude the input
    -- filter settings (Deblock and Denoise). The range is -5 to 5. Default is
    -- 0.
    InputTemplate -> Maybe Int
filterStrength :: Prelude.Maybe Prelude.Int,
    -- | Enable the image inserter feature to include a graphic overlay on your
    -- video. Enable or disable this feature for each input individually. This
    -- setting is disabled by default.
    InputTemplate -> Maybe ImageInserter
imageInserter :: Prelude.Maybe ImageInserter,
    -- | (InputClippings) contains sets of start and end times that together
    -- specify a portion of the input to be used in the outputs. If you provide
    -- only a start time, the clip will be the entire input from that point to
    -- the end. If you provide only an end time, it will be the entire input up
    -- to that point. When you specify more than one input clip, the
    -- transcoding service creates the job outputs by stringing the clips
    -- together in the order you specify them.
    InputTemplate -> Maybe [InputClipping]
inputClippings :: Prelude.Maybe [InputClipping],
    -- | When you have a progressive segmented frame (PsF) input, use this
    -- setting to flag the input as PsF. MediaConvert doesn\'t automatically
    -- detect PsF. Therefore, flagging your input as PsF results in better
    -- preservation of video quality when you do deinterlacing and frame rate
    -- conversion. If you don\'t specify, the default value is Auto (AUTO).
    -- Auto is the correct setting for all inputs that are not PsF. Don\'t set
    -- this value to PsF when your input is interlaced. Doing so creates
    -- horizontal interlacing artifacts.
    InputTemplate -> Maybe InputScanType
inputScanType :: Prelude.Maybe InputScanType,
    -- | Use Selection placement (position) to define the video area in your
    -- output frame. The area outside of the rectangle that you specify here is
    -- black. If you specify a value here, it will override any value that you
    -- specify in the output setting Selection placement (position). If you
    -- specify a value here, this will override any AFD values in your input,
    -- even if you set Respond to AFD (RespondToAfd) to Respond (RESPOND). If
    -- you specify a value here, this will ignore anything that you specify for
    -- the setting Scaling Behavior (scalingBehavior).
    InputTemplate -> Maybe Rectangle
position :: Prelude.Maybe Rectangle,
    -- | Use Program (programNumber) to select a specific program from within a
    -- multi-program transport stream. Note that Quad 4K is not currently
    -- supported. Default is the first program within the transport stream. If
    -- the program you specify doesn\'t exist, the transcoding service will use
    -- this default.
    InputTemplate -> Maybe Natural
programNumber :: Prelude.Maybe Prelude.Natural,
    -- | Set PSI control (InputPsiControl) for transport stream inputs to specify
    -- which data the demux process to scans. * Ignore PSI - Scan all PIDs for
    -- audio and video. * Use PSI - Scan only PSI data.
    InputTemplate -> Maybe InputPsiControl
psiControl :: Prelude.Maybe InputPsiControl,
    -- | Use this Timecode source setting, located under the input settings
    -- (InputTimecodeSource), to specify how the service counts input video
    -- frames. This input frame count affects only the behavior of features
    -- that apply to a single input at a time, such as input clipping and
    -- synchronizing some captions formats. Choose Embedded (EMBEDDED) to use
    -- the timecodes in your input video. Choose Start at zero (ZEROBASED) to
    -- start the first frame at zero. Choose Specified start (SPECIFIEDSTART)
    -- to start the first frame at the timecode that you specify in the setting
    -- Start timecode (timecodeStart). If you don\'t specify a value for
    -- Timecode source, the service will use Embedded by default. For more
    -- information about timecodes, see
    -- https:\/\/docs.aws.amazon.com\/console\/mediaconvert\/timecode.
    InputTemplate -> Maybe InputTimecodeSource
timecodeSource :: Prelude.Maybe InputTimecodeSource,
    -- | Specify the timecode that you want the service to use for this input\'s
    -- initial frame. To use this setting, you must set the Timecode source
    -- setting, located under the input settings (InputTimecodeSource), to
    -- Specified start (SPECIFIEDSTART). For more information about timecodes,
    -- see https:\/\/docs.aws.amazon.com\/console\/mediaconvert\/timecode.
    InputTemplate -> Maybe Text
timecodeStart :: Prelude.Maybe Prelude.Text,
    -- | Input video selectors contain the video settings for the input. Each of
    -- your inputs can have up to one video selector.
    InputTemplate -> Maybe VideoSelector
videoSelector :: Prelude.Maybe VideoSelector
  }
  deriving (InputTemplate -> InputTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputTemplate -> InputTemplate -> Bool
$c/= :: InputTemplate -> InputTemplate -> Bool
== :: InputTemplate -> InputTemplate -> Bool
$c== :: InputTemplate -> InputTemplate -> Bool
Prelude.Eq, ReadPrec [InputTemplate]
ReadPrec InputTemplate
Int -> ReadS InputTemplate
ReadS [InputTemplate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InputTemplate]
$creadListPrec :: ReadPrec [InputTemplate]
readPrec :: ReadPrec InputTemplate
$creadPrec :: ReadPrec InputTemplate
readList :: ReadS [InputTemplate]
$creadList :: ReadS [InputTemplate]
readsPrec :: Int -> ReadS InputTemplate
$creadsPrec :: Int -> ReadS InputTemplate
Prelude.Read, Int -> InputTemplate -> ShowS
[InputTemplate] -> ShowS
InputTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputTemplate] -> ShowS
$cshowList :: [InputTemplate] -> ShowS
show :: InputTemplate -> String
$cshow :: InputTemplate -> String
showsPrec :: Int -> InputTemplate -> ShowS
$cshowsPrec :: Int -> InputTemplate -> ShowS
Prelude.Show, forall x. Rep InputTemplate x -> InputTemplate
forall x. InputTemplate -> Rep InputTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputTemplate x -> InputTemplate
$cfrom :: forall x. InputTemplate -> Rep InputTemplate x
Prelude.Generic)

-- |
-- Create a value of 'InputTemplate' 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:
--
-- 'audioSelectorGroups', 'inputTemplate_audioSelectorGroups' - Use audio selector groups to combine multiple sidecar audio inputs so
-- that you can assign them to a single output audio tab
-- (AudioDescription). Note that, if you\'re working with embedded audio,
-- it\'s simpler to assign multiple input tracks into a single audio
-- selector rather than use an audio selector group.
--
-- 'audioSelectors', 'inputTemplate_audioSelectors' - Use Audio selectors (AudioSelectors) to specify a track or set of tracks
-- from the input that you will use in your outputs. You can use multiple
-- Audio selectors per input.
--
-- 'captionSelectors', 'inputTemplate_captionSelectors' - Use captions selectors to specify the captions data from your input that
-- you use in your outputs. You can use up to 20 captions selectors per
-- input.
--
-- 'crop', 'inputTemplate_crop' - Use Cropping selection (crop) to specify the video area that the service
-- will include in the output video frame. If you specify a value here, it
-- will override any value that you specify in the output setting Cropping
-- selection (crop).
--
-- 'deblockFilter', 'inputTemplate_deblockFilter' - Enable Deblock (InputDeblockFilter) to produce smoother motion in the
-- output. Default is disabled. Only manually controllable for MPEG2 and
-- uncompressed video inputs.
--
-- 'denoiseFilter', 'inputTemplate_denoiseFilter' - Enable Denoise (InputDenoiseFilter) to filter noise from the input.
-- Default is disabled. Only applicable to MPEG2, H.264, H.265, and
-- uncompressed video inputs.
--
-- 'dolbyVisionMetadataXml', 'inputTemplate_dolbyVisionMetadataXml' - Use this setting only when your video source has Dolby Vision studio
-- mastering metadata that is carried in a separate XML file. Specify the
-- Amazon S3 location for the metadata XML file. MediaConvert uses this
-- file to provide global and frame-level metadata for Dolby Vision
-- preprocessing. When you specify a file here and your input also has
-- interleaved global and frame level metadata, MediaConvert ignores the
-- interleaved metadata and uses only the the metadata from this external
-- XML file. Note that your IAM service role must grant MediaConvert read
-- permissions to this file. For more information, see
-- https:\/\/docs.aws.amazon.com\/mediaconvert\/latest\/ug\/iam-role.html.
--
-- 'filterEnable', 'inputTemplate_filterEnable' - Specify how the transcoding service applies the denoise and deblock
-- filters. You must also enable the filters separately, with Denoise
-- (InputDenoiseFilter) and Deblock (InputDeblockFilter). * Auto - The
-- transcoding service determines whether to apply filtering, depending on
-- input type and quality. * Disable - The input is not filtered. This is
-- true even if you use the API to enable them in (InputDeblockFilter) and
-- (InputDeblockFilter). * Force - The input is filtered regardless of
-- input type.
--
-- 'filterStrength', 'inputTemplate_filterStrength' - Use Filter strength (FilterStrength) to adjust the magnitude the input
-- filter settings (Deblock and Denoise). The range is -5 to 5. Default is
-- 0.
--
-- 'imageInserter', 'inputTemplate_imageInserter' - Enable the image inserter feature to include a graphic overlay on your
-- video. Enable or disable this feature for each input individually. This
-- setting is disabled by default.
--
-- 'inputClippings', 'inputTemplate_inputClippings' - (InputClippings) contains sets of start and end times that together
-- specify a portion of the input to be used in the outputs. If you provide
-- only a start time, the clip will be the entire input from that point to
-- the end. If you provide only an end time, it will be the entire input up
-- to that point. When you specify more than one input clip, the
-- transcoding service creates the job outputs by stringing the clips
-- together in the order you specify them.
--
-- 'inputScanType', 'inputTemplate_inputScanType' - When you have a progressive segmented frame (PsF) input, use this
-- setting to flag the input as PsF. MediaConvert doesn\'t automatically
-- detect PsF. Therefore, flagging your input as PsF results in better
-- preservation of video quality when you do deinterlacing and frame rate
-- conversion. If you don\'t specify, the default value is Auto (AUTO).
-- Auto is the correct setting for all inputs that are not PsF. Don\'t set
-- this value to PsF when your input is interlaced. Doing so creates
-- horizontal interlacing artifacts.
--
-- 'position', 'inputTemplate_position' - Use Selection placement (position) to define the video area in your
-- output frame. The area outside of the rectangle that you specify here is
-- black. If you specify a value here, it will override any value that you
-- specify in the output setting Selection placement (position). If you
-- specify a value here, this will override any AFD values in your input,
-- even if you set Respond to AFD (RespondToAfd) to Respond (RESPOND). If
-- you specify a value here, this will ignore anything that you specify for
-- the setting Scaling Behavior (scalingBehavior).
--
-- 'programNumber', 'inputTemplate_programNumber' - Use Program (programNumber) to select a specific program from within a
-- multi-program transport stream. Note that Quad 4K is not currently
-- supported. Default is the first program within the transport stream. If
-- the program you specify doesn\'t exist, the transcoding service will use
-- this default.
--
-- 'psiControl', 'inputTemplate_psiControl' - Set PSI control (InputPsiControl) for transport stream inputs to specify
-- which data the demux process to scans. * Ignore PSI - Scan all PIDs for
-- audio and video. * Use PSI - Scan only PSI data.
--
-- 'timecodeSource', 'inputTemplate_timecodeSource' - Use this Timecode source setting, located under the input settings
-- (InputTimecodeSource), to specify how the service counts input video
-- frames. This input frame count affects only the behavior of features
-- that apply to a single input at a time, such as input clipping and
-- synchronizing some captions formats. Choose Embedded (EMBEDDED) to use
-- the timecodes in your input video. Choose Start at zero (ZEROBASED) to
-- start the first frame at zero. Choose Specified start (SPECIFIEDSTART)
-- to start the first frame at the timecode that you specify in the setting
-- Start timecode (timecodeStart). If you don\'t specify a value for
-- Timecode source, the service will use Embedded by default. For more
-- information about timecodes, see
-- https:\/\/docs.aws.amazon.com\/console\/mediaconvert\/timecode.
--
-- 'timecodeStart', 'inputTemplate_timecodeStart' - Specify the timecode that you want the service to use for this input\'s
-- initial frame. To use this setting, you must set the Timecode source
-- setting, located under the input settings (InputTimecodeSource), to
-- Specified start (SPECIFIEDSTART). For more information about timecodes,
-- see https:\/\/docs.aws.amazon.com\/console\/mediaconvert\/timecode.
--
-- 'videoSelector', 'inputTemplate_videoSelector' - Input video selectors contain the video settings for the input. Each of
-- your inputs can have up to one video selector.
newInputTemplate ::
  InputTemplate
newInputTemplate :: InputTemplate
newInputTemplate =
  InputTemplate'
    { $sel:audioSelectorGroups:InputTemplate' :: Maybe (HashMap Text AudioSelectorGroup)
audioSelectorGroups =
        forall a. Maybe a
Prelude.Nothing,
      $sel:audioSelectors:InputTemplate' :: Maybe (HashMap Text AudioSelector)
audioSelectors = forall a. Maybe a
Prelude.Nothing,
      $sel:captionSelectors:InputTemplate' :: Maybe (HashMap Text CaptionSelector)
captionSelectors = forall a. Maybe a
Prelude.Nothing,
      $sel:crop:InputTemplate' :: Maybe Rectangle
crop = forall a. Maybe a
Prelude.Nothing,
      $sel:deblockFilter:InputTemplate' :: Maybe InputDeblockFilter
deblockFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:denoiseFilter:InputTemplate' :: Maybe InputDenoiseFilter
denoiseFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:dolbyVisionMetadataXml:InputTemplate' :: Maybe Text
dolbyVisionMetadataXml = forall a. Maybe a
Prelude.Nothing,
      $sel:filterEnable:InputTemplate' :: Maybe InputFilterEnable
filterEnable = forall a. Maybe a
Prelude.Nothing,
      $sel:filterStrength:InputTemplate' :: Maybe Int
filterStrength = forall a. Maybe a
Prelude.Nothing,
      $sel:imageInserter:InputTemplate' :: Maybe ImageInserter
imageInserter = forall a. Maybe a
Prelude.Nothing,
      $sel:inputClippings:InputTemplate' :: Maybe [InputClipping]
inputClippings = forall a. Maybe a
Prelude.Nothing,
      $sel:inputScanType:InputTemplate' :: Maybe InputScanType
inputScanType = forall a. Maybe a
Prelude.Nothing,
      $sel:position:InputTemplate' :: Maybe Rectangle
position = forall a. Maybe a
Prelude.Nothing,
      $sel:programNumber:InputTemplate' :: Maybe Natural
programNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:psiControl:InputTemplate' :: Maybe InputPsiControl
psiControl = forall a. Maybe a
Prelude.Nothing,
      $sel:timecodeSource:InputTemplate' :: Maybe InputTimecodeSource
timecodeSource = forall a. Maybe a
Prelude.Nothing,
      $sel:timecodeStart:InputTemplate' :: Maybe Text
timecodeStart = forall a. Maybe a
Prelude.Nothing,
      $sel:videoSelector:InputTemplate' :: Maybe VideoSelector
videoSelector = forall a. Maybe a
Prelude.Nothing
    }

-- | Use audio selector groups to combine multiple sidecar audio inputs so
-- that you can assign them to a single output audio tab
-- (AudioDescription). Note that, if you\'re working with embedded audio,
-- it\'s simpler to assign multiple input tracks into a single audio
-- selector rather than use an audio selector group.
inputTemplate_audioSelectorGroups :: Lens.Lens' InputTemplate (Prelude.Maybe (Prelude.HashMap Prelude.Text AudioSelectorGroup))
inputTemplate_audioSelectorGroups :: Lens' InputTemplate (Maybe (HashMap Text AudioSelectorGroup))
inputTemplate_audioSelectorGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe (HashMap Text AudioSelectorGroup)
audioSelectorGroups :: Maybe (HashMap Text AudioSelectorGroup)
$sel:audioSelectorGroups:InputTemplate' :: InputTemplate -> Maybe (HashMap Text AudioSelectorGroup)
audioSelectorGroups} -> Maybe (HashMap Text AudioSelectorGroup)
audioSelectorGroups) (\s :: InputTemplate
s@InputTemplate' {} Maybe (HashMap Text AudioSelectorGroup)
a -> InputTemplate
s {$sel:audioSelectorGroups:InputTemplate' :: Maybe (HashMap Text AudioSelectorGroup)
audioSelectorGroups = Maybe (HashMap Text AudioSelectorGroup)
a} :: InputTemplate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Use Audio selectors (AudioSelectors) to specify a track or set of tracks
-- from the input that you will use in your outputs. You can use multiple
-- Audio selectors per input.
inputTemplate_audioSelectors :: Lens.Lens' InputTemplate (Prelude.Maybe (Prelude.HashMap Prelude.Text AudioSelector))
inputTemplate_audioSelectors :: Lens' InputTemplate (Maybe (HashMap Text AudioSelector))
inputTemplate_audioSelectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe (HashMap Text AudioSelector)
audioSelectors :: Maybe (HashMap Text AudioSelector)
$sel:audioSelectors:InputTemplate' :: InputTemplate -> Maybe (HashMap Text AudioSelector)
audioSelectors} -> Maybe (HashMap Text AudioSelector)
audioSelectors) (\s :: InputTemplate
s@InputTemplate' {} Maybe (HashMap Text AudioSelector)
a -> InputTemplate
s {$sel:audioSelectors:InputTemplate' :: Maybe (HashMap Text AudioSelector)
audioSelectors = Maybe (HashMap Text AudioSelector)
a} :: InputTemplate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Use captions selectors to specify the captions data from your input that
-- you use in your outputs. You can use up to 20 captions selectors per
-- input.
inputTemplate_captionSelectors :: Lens.Lens' InputTemplate (Prelude.Maybe (Prelude.HashMap Prelude.Text CaptionSelector))
inputTemplate_captionSelectors :: Lens' InputTemplate (Maybe (HashMap Text CaptionSelector))
inputTemplate_captionSelectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe (HashMap Text CaptionSelector)
captionSelectors :: Maybe (HashMap Text CaptionSelector)
$sel:captionSelectors:InputTemplate' :: InputTemplate -> Maybe (HashMap Text CaptionSelector)
captionSelectors} -> Maybe (HashMap Text CaptionSelector)
captionSelectors) (\s :: InputTemplate
s@InputTemplate' {} Maybe (HashMap Text CaptionSelector)
a -> InputTemplate
s {$sel:captionSelectors:InputTemplate' :: Maybe (HashMap Text CaptionSelector)
captionSelectors = Maybe (HashMap Text CaptionSelector)
a} :: InputTemplate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Use Cropping selection (crop) to specify the video area that the service
-- will include in the output video frame. If you specify a value here, it
-- will override any value that you specify in the output setting Cropping
-- selection (crop).
inputTemplate_crop :: Lens.Lens' InputTemplate (Prelude.Maybe Rectangle)
inputTemplate_crop :: Lens' InputTemplate (Maybe Rectangle)
inputTemplate_crop = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe Rectangle
crop :: Maybe Rectangle
$sel:crop:InputTemplate' :: InputTemplate -> Maybe Rectangle
crop} -> Maybe Rectangle
crop) (\s :: InputTemplate
s@InputTemplate' {} Maybe Rectangle
a -> InputTemplate
s {$sel:crop:InputTemplate' :: Maybe Rectangle
crop = Maybe Rectangle
a} :: InputTemplate)

-- | Enable Deblock (InputDeblockFilter) to produce smoother motion in the
-- output. Default is disabled. Only manually controllable for MPEG2 and
-- uncompressed video inputs.
inputTemplate_deblockFilter :: Lens.Lens' InputTemplate (Prelude.Maybe InputDeblockFilter)
inputTemplate_deblockFilter :: Lens' InputTemplate (Maybe InputDeblockFilter)
inputTemplate_deblockFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe InputDeblockFilter
deblockFilter :: Maybe InputDeblockFilter
$sel:deblockFilter:InputTemplate' :: InputTemplate -> Maybe InputDeblockFilter
deblockFilter} -> Maybe InputDeblockFilter
deblockFilter) (\s :: InputTemplate
s@InputTemplate' {} Maybe InputDeblockFilter
a -> InputTemplate
s {$sel:deblockFilter:InputTemplate' :: Maybe InputDeblockFilter
deblockFilter = Maybe InputDeblockFilter
a} :: InputTemplate)

-- | Enable Denoise (InputDenoiseFilter) to filter noise from the input.
-- Default is disabled. Only applicable to MPEG2, H.264, H.265, and
-- uncompressed video inputs.
inputTemplate_denoiseFilter :: Lens.Lens' InputTemplate (Prelude.Maybe InputDenoiseFilter)
inputTemplate_denoiseFilter :: Lens' InputTemplate (Maybe InputDenoiseFilter)
inputTemplate_denoiseFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe InputDenoiseFilter
denoiseFilter :: Maybe InputDenoiseFilter
$sel:denoiseFilter:InputTemplate' :: InputTemplate -> Maybe InputDenoiseFilter
denoiseFilter} -> Maybe InputDenoiseFilter
denoiseFilter) (\s :: InputTemplate
s@InputTemplate' {} Maybe InputDenoiseFilter
a -> InputTemplate
s {$sel:denoiseFilter:InputTemplate' :: Maybe InputDenoiseFilter
denoiseFilter = Maybe InputDenoiseFilter
a} :: InputTemplate)

-- | Use this setting only when your video source has Dolby Vision studio
-- mastering metadata that is carried in a separate XML file. Specify the
-- Amazon S3 location for the metadata XML file. MediaConvert uses this
-- file to provide global and frame-level metadata for Dolby Vision
-- preprocessing. When you specify a file here and your input also has
-- interleaved global and frame level metadata, MediaConvert ignores the
-- interleaved metadata and uses only the the metadata from this external
-- XML file. Note that your IAM service role must grant MediaConvert read
-- permissions to this file. For more information, see
-- https:\/\/docs.aws.amazon.com\/mediaconvert\/latest\/ug\/iam-role.html.
inputTemplate_dolbyVisionMetadataXml :: Lens.Lens' InputTemplate (Prelude.Maybe Prelude.Text)
inputTemplate_dolbyVisionMetadataXml :: Lens' InputTemplate (Maybe Text)
inputTemplate_dolbyVisionMetadataXml = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe Text
dolbyVisionMetadataXml :: Maybe Text
$sel:dolbyVisionMetadataXml:InputTemplate' :: InputTemplate -> Maybe Text
dolbyVisionMetadataXml} -> Maybe Text
dolbyVisionMetadataXml) (\s :: InputTemplate
s@InputTemplate' {} Maybe Text
a -> InputTemplate
s {$sel:dolbyVisionMetadataXml:InputTemplate' :: Maybe Text
dolbyVisionMetadataXml = Maybe Text
a} :: InputTemplate)

-- | Specify how the transcoding service applies the denoise and deblock
-- filters. You must also enable the filters separately, with Denoise
-- (InputDenoiseFilter) and Deblock (InputDeblockFilter). * Auto - The
-- transcoding service determines whether to apply filtering, depending on
-- input type and quality. * Disable - The input is not filtered. This is
-- true even if you use the API to enable them in (InputDeblockFilter) and
-- (InputDeblockFilter). * Force - The input is filtered regardless of
-- input type.
inputTemplate_filterEnable :: Lens.Lens' InputTemplate (Prelude.Maybe InputFilterEnable)
inputTemplate_filterEnable :: Lens' InputTemplate (Maybe InputFilterEnable)
inputTemplate_filterEnable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe InputFilterEnable
filterEnable :: Maybe InputFilterEnable
$sel:filterEnable:InputTemplate' :: InputTemplate -> Maybe InputFilterEnable
filterEnable} -> Maybe InputFilterEnable
filterEnable) (\s :: InputTemplate
s@InputTemplate' {} Maybe InputFilterEnable
a -> InputTemplate
s {$sel:filterEnable:InputTemplate' :: Maybe InputFilterEnable
filterEnable = Maybe InputFilterEnable
a} :: InputTemplate)

-- | Use Filter strength (FilterStrength) to adjust the magnitude the input
-- filter settings (Deblock and Denoise). The range is -5 to 5. Default is
-- 0.
inputTemplate_filterStrength :: Lens.Lens' InputTemplate (Prelude.Maybe Prelude.Int)
inputTemplate_filterStrength :: Lens' InputTemplate (Maybe Int)
inputTemplate_filterStrength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe Int
filterStrength :: Maybe Int
$sel:filterStrength:InputTemplate' :: InputTemplate -> Maybe Int
filterStrength} -> Maybe Int
filterStrength) (\s :: InputTemplate
s@InputTemplate' {} Maybe Int
a -> InputTemplate
s {$sel:filterStrength:InputTemplate' :: Maybe Int
filterStrength = Maybe Int
a} :: InputTemplate)

-- | Enable the image inserter feature to include a graphic overlay on your
-- video. Enable or disable this feature for each input individually. This
-- setting is disabled by default.
inputTemplate_imageInserter :: Lens.Lens' InputTemplate (Prelude.Maybe ImageInserter)
inputTemplate_imageInserter :: Lens' InputTemplate (Maybe ImageInserter)
inputTemplate_imageInserter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe ImageInserter
imageInserter :: Maybe ImageInserter
$sel:imageInserter:InputTemplate' :: InputTemplate -> Maybe ImageInserter
imageInserter} -> Maybe ImageInserter
imageInserter) (\s :: InputTemplate
s@InputTemplate' {} Maybe ImageInserter
a -> InputTemplate
s {$sel:imageInserter:InputTemplate' :: Maybe ImageInserter
imageInserter = Maybe ImageInserter
a} :: InputTemplate)

-- | (InputClippings) contains sets of start and end times that together
-- specify a portion of the input to be used in the outputs. If you provide
-- only a start time, the clip will be the entire input from that point to
-- the end. If you provide only an end time, it will be the entire input up
-- to that point. When you specify more than one input clip, the
-- transcoding service creates the job outputs by stringing the clips
-- together in the order you specify them.
inputTemplate_inputClippings :: Lens.Lens' InputTemplate (Prelude.Maybe [InputClipping])
inputTemplate_inputClippings :: Lens' InputTemplate (Maybe [InputClipping])
inputTemplate_inputClippings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe [InputClipping]
inputClippings :: Maybe [InputClipping]
$sel:inputClippings:InputTemplate' :: InputTemplate -> Maybe [InputClipping]
inputClippings} -> Maybe [InputClipping]
inputClippings) (\s :: InputTemplate
s@InputTemplate' {} Maybe [InputClipping]
a -> InputTemplate
s {$sel:inputClippings:InputTemplate' :: Maybe [InputClipping]
inputClippings = Maybe [InputClipping]
a} :: InputTemplate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | When you have a progressive segmented frame (PsF) input, use this
-- setting to flag the input as PsF. MediaConvert doesn\'t automatically
-- detect PsF. Therefore, flagging your input as PsF results in better
-- preservation of video quality when you do deinterlacing and frame rate
-- conversion. If you don\'t specify, the default value is Auto (AUTO).
-- Auto is the correct setting for all inputs that are not PsF. Don\'t set
-- this value to PsF when your input is interlaced. Doing so creates
-- horizontal interlacing artifacts.
inputTemplate_inputScanType :: Lens.Lens' InputTemplate (Prelude.Maybe InputScanType)
inputTemplate_inputScanType :: Lens' InputTemplate (Maybe InputScanType)
inputTemplate_inputScanType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe InputScanType
inputScanType :: Maybe InputScanType
$sel:inputScanType:InputTemplate' :: InputTemplate -> Maybe InputScanType
inputScanType} -> Maybe InputScanType
inputScanType) (\s :: InputTemplate
s@InputTemplate' {} Maybe InputScanType
a -> InputTemplate
s {$sel:inputScanType:InputTemplate' :: Maybe InputScanType
inputScanType = Maybe InputScanType
a} :: InputTemplate)

-- | Use Selection placement (position) to define the video area in your
-- output frame. The area outside of the rectangle that you specify here is
-- black. If you specify a value here, it will override any value that you
-- specify in the output setting Selection placement (position). If you
-- specify a value here, this will override any AFD values in your input,
-- even if you set Respond to AFD (RespondToAfd) to Respond (RESPOND). If
-- you specify a value here, this will ignore anything that you specify for
-- the setting Scaling Behavior (scalingBehavior).
inputTemplate_position :: Lens.Lens' InputTemplate (Prelude.Maybe Rectangle)
inputTemplate_position :: Lens' InputTemplate (Maybe Rectangle)
inputTemplate_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe Rectangle
position :: Maybe Rectangle
$sel:position:InputTemplate' :: InputTemplate -> Maybe Rectangle
position} -> Maybe Rectangle
position) (\s :: InputTemplate
s@InputTemplate' {} Maybe Rectangle
a -> InputTemplate
s {$sel:position:InputTemplate' :: Maybe Rectangle
position = Maybe Rectangle
a} :: InputTemplate)

-- | Use Program (programNumber) to select a specific program from within a
-- multi-program transport stream. Note that Quad 4K is not currently
-- supported. Default is the first program within the transport stream. If
-- the program you specify doesn\'t exist, the transcoding service will use
-- this default.
inputTemplate_programNumber :: Lens.Lens' InputTemplate (Prelude.Maybe Prelude.Natural)
inputTemplate_programNumber :: Lens' InputTemplate (Maybe Natural)
inputTemplate_programNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe Natural
programNumber :: Maybe Natural
$sel:programNumber:InputTemplate' :: InputTemplate -> Maybe Natural
programNumber} -> Maybe Natural
programNumber) (\s :: InputTemplate
s@InputTemplate' {} Maybe Natural
a -> InputTemplate
s {$sel:programNumber:InputTemplate' :: Maybe Natural
programNumber = Maybe Natural
a} :: InputTemplate)

-- | Set PSI control (InputPsiControl) for transport stream inputs to specify
-- which data the demux process to scans. * Ignore PSI - Scan all PIDs for
-- audio and video. * Use PSI - Scan only PSI data.
inputTemplate_psiControl :: Lens.Lens' InputTemplate (Prelude.Maybe InputPsiControl)
inputTemplate_psiControl :: Lens' InputTemplate (Maybe InputPsiControl)
inputTemplate_psiControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe InputPsiControl
psiControl :: Maybe InputPsiControl
$sel:psiControl:InputTemplate' :: InputTemplate -> Maybe InputPsiControl
psiControl} -> Maybe InputPsiControl
psiControl) (\s :: InputTemplate
s@InputTemplate' {} Maybe InputPsiControl
a -> InputTemplate
s {$sel:psiControl:InputTemplate' :: Maybe InputPsiControl
psiControl = Maybe InputPsiControl
a} :: InputTemplate)

-- | Use this Timecode source setting, located under the input settings
-- (InputTimecodeSource), to specify how the service counts input video
-- frames. This input frame count affects only the behavior of features
-- that apply to a single input at a time, such as input clipping and
-- synchronizing some captions formats. Choose Embedded (EMBEDDED) to use
-- the timecodes in your input video. Choose Start at zero (ZEROBASED) to
-- start the first frame at zero. Choose Specified start (SPECIFIEDSTART)
-- to start the first frame at the timecode that you specify in the setting
-- Start timecode (timecodeStart). If you don\'t specify a value for
-- Timecode source, the service will use Embedded by default. For more
-- information about timecodes, see
-- https:\/\/docs.aws.amazon.com\/console\/mediaconvert\/timecode.
inputTemplate_timecodeSource :: Lens.Lens' InputTemplate (Prelude.Maybe InputTimecodeSource)
inputTemplate_timecodeSource :: Lens' InputTemplate (Maybe InputTimecodeSource)
inputTemplate_timecodeSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe InputTimecodeSource
timecodeSource :: Maybe InputTimecodeSource
$sel:timecodeSource:InputTemplate' :: InputTemplate -> Maybe InputTimecodeSource
timecodeSource} -> Maybe InputTimecodeSource
timecodeSource) (\s :: InputTemplate
s@InputTemplate' {} Maybe InputTimecodeSource
a -> InputTemplate
s {$sel:timecodeSource:InputTemplate' :: Maybe InputTimecodeSource
timecodeSource = Maybe InputTimecodeSource
a} :: InputTemplate)

-- | Specify the timecode that you want the service to use for this input\'s
-- initial frame. To use this setting, you must set the Timecode source
-- setting, located under the input settings (InputTimecodeSource), to
-- Specified start (SPECIFIEDSTART). For more information about timecodes,
-- see https:\/\/docs.aws.amazon.com\/console\/mediaconvert\/timecode.
inputTemplate_timecodeStart :: Lens.Lens' InputTemplate (Prelude.Maybe Prelude.Text)
inputTemplate_timecodeStart :: Lens' InputTemplate (Maybe Text)
inputTemplate_timecodeStart = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe Text
timecodeStart :: Maybe Text
$sel:timecodeStart:InputTemplate' :: InputTemplate -> Maybe Text
timecodeStart} -> Maybe Text
timecodeStart) (\s :: InputTemplate
s@InputTemplate' {} Maybe Text
a -> InputTemplate
s {$sel:timecodeStart:InputTemplate' :: Maybe Text
timecodeStart = Maybe Text
a} :: InputTemplate)

-- | Input video selectors contain the video settings for the input. Each of
-- your inputs can have up to one video selector.
inputTemplate_videoSelector :: Lens.Lens' InputTemplate (Prelude.Maybe VideoSelector)
inputTemplate_videoSelector :: Lens' InputTemplate (Maybe VideoSelector)
inputTemplate_videoSelector = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputTemplate' {Maybe VideoSelector
videoSelector :: Maybe VideoSelector
$sel:videoSelector:InputTemplate' :: InputTemplate -> Maybe VideoSelector
videoSelector} -> Maybe VideoSelector
videoSelector) (\s :: InputTemplate
s@InputTemplate' {} Maybe VideoSelector
a -> InputTemplate
s {$sel:videoSelector:InputTemplate' :: Maybe VideoSelector
videoSelector = Maybe VideoSelector
a} :: InputTemplate)

instance Data.FromJSON InputTemplate where
  parseJSON :: Value -> Parser InputTemplate
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"InputTemplate"
      ( \Object
x ->
          Maybe (HashMap Text AudioSelectorGroup)
-> Maybe (HashMap Text AudioSelector)
-> Maybe (HashMap Text CaptionSelector)
-> Maybe Rectangle
-> Maybe InputDeblockFilter
-> Maybe InputDenoiseFilter
-> Maybe Text
-> Maybe InputFilterEnable
-> Maybe Int
-> Maybe ImageInserter
-> Maybe [InputClipping]
-> Maybe InputScanType
-> Maybe Rectangle
-> Maybe Natural
-> Maybe InputPsiControl
-> Maybe InputTimecodeSource
-> Maybe Text
-> Maybe VideoSelector
-> InputTemplate
InputTemplate'
            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
"audioSelectorGroups"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"audioSelectors" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"captionSelectors"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"crop")
            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
"deblockFilter")
            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
"denoiseFilter")
            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
"dolbyVisionMetadataXml")
            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
"filterEnable")
            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
"filterStrength")
            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
"imageInserter")
            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
"inputClippings" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"inputScanType")
            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
"position")
            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
"programNumber")
            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
"psiControl")
            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
"timecodeSource")
            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
"timecodeStart")
            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
"videoSelector")
      )

instance Prelude.Hashable InputTemplate where
  hashWithSalt :: Int -> InputTemplate -> Int
hashWithSalt Int
_salt InputTemplate' {Maybe Int
Maybe Natural
Maybe [InputClipping]
Maybe Text
Maybe (HashMap Text AudioSelectorGroup)
Maybe (HashMap Text AudioSelector)
Maybe (HashMap Text CaptionSelector)
Maybe InputDeblockFilter
Maybe InputDenoiseFilter
Maybe InputFilterEnable
Maybe InputPsiControl
Maybe InputScanType
Maybe InputTimecodeSource
Maybe ImageInserter
Maybe Rectangle
Maybe VideoSelector
videoSelector :: Maybe VideoSelector
timecodeStart :: Maybe Text
timecodeSource :: Maybe InputTimecodeSource
psiControl :: Maybe InputPsiControl
programNumber :: Maybe Natural
position :: Maybe Rectangle
inputScanType :: Maybe InputScanType
inputClippings :: Maybe [InputClipping]
imageInserter :: Maybe ImageInserter
filterStrength :: Maybe Int
filterEnable :: Maybe InputFilterEnable
dolbyVisionMetadataXml :: Maybe Text
denoiseFilter :: Maybe InputDenoiseFilter
deblockFilter :: Maybe InputDeblockFilter
crop :: Maybe Rectangle
captionSelectors :: Maybe (HashMap Text CaptionSelector)
audioSelectors :: Maybe (HashMap Text AudioSelector)
audioSelectorGroups :: Maybe (HashMap Text AudioSelectorGroup)
$sel:videoSelector:InputTemplate' :: InputTemplate -> Maybe VideoSelector
$sel:timecodeStart:InputTemplate' :: InputTemplate -> Maybe Text
$sel:timecodeSource:InputTemplate' :: InputTemplate -> Maybe InputTimecodeSource
$sel:psiControl:InputTemplate' :: InputTemplate -> Maybe InputPsiControl
$sel:programNumber:InputTemplate' :: InputTemplate -> Maybe Natural
$sel:position:InputTemplate' :: InputTemplate -> Maybe Rectangle
$sel:inputScanType:InputTemplate' :: InputTemplate -> Maybe InputScanType
$sel:inputClippings:InputTemplate' :: InputTemplate -> Maybe [InputClipping]
$sel:imageInserter:InputTemplate' :: InputTemplate -> Maybe ImageInserter
$sel:filterStrength:InputTemplate' :: InputTemplate -> Maybe Int
$sel:filterEnable:InputTemplate' :: InputTemplate -> Maybe InputFilterEnable
$sel:dolbyVisionMetadataXml:InputTemplate' :: InputTemplate -> Maybe Text
$sel:denoiseFilter:InputTemplate' :: InputTemplate -> Maybe InputDenoiseFilter
$sel:deblockFilter:InputTemplate' :: InputTemplate -> Maybe InputDeblockFilter
$sel:crop:InputTemplate' :: InputTemplate -> Maybe Rectangle
$sel:captionSelectors:InputTemplate' :: InputTemplate -> Maybe (HashMap Text CaptionSelector)
$sel:audioSelectors:InputTemplate' :: InputTemplate -> Maybe (HashMap Text AudioSelector)
$sel:audioSelectorGroups:InputTemplate' :: InputTemplate -> Maybe (HashMap Text AudioSelectorGroup)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text AudioSelectorGroup)
audioSelectorGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text AudioSelector)
audioSelectors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text CaptionSelector)
captionSelectors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Rectangle
crop
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputDeblockFilter
deblockFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputDenoiseFilter
denoiseFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dolbyVisionMetadataXml
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputFilterEnable
filterEnable
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
filterStrength
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ImageInserter
imageInserter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InputClipping]
inputClippings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputScanType
inputScanType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Rectangle
position
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
programNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputPsiControl
psiControl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputTimecodeSource
timecodeSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
timecodeStart
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VideoSelector
videoSelector

instance Prelude.NFData InputTemplate where
  rnf :: InputTemplate -> ()
rnf InputTemplate' {Maybe Int
Maybe Natural
Maybe [InputClipping]
Maybe Text
Maybe (HashMap Text AudioSelectorGroup)
Maybe (HashMap Text AudioSelector)
Maybe (HashMap Text CaptionSelector)
Maybe InputDeblockFilter
Maybe InputDenoiseFilter
Maybe InputFilterEnable
Maybe InputPsiControl
Maybe InputScanType
Maybe InputTimecodeSource
Maybe ImageInserter
Maybe Rectangle
Maybe VideoSelector
videoSelector :: Maybe VideoSelector
timecodeStart :: Maybe Text
timecodeSource :: Maybe InputTimecodeSource
psiControl :: Maybe InputPsiControl
programNumber :: Maybe Natural
position :: Maybe Rectangle
inputScanType :: Maybe InputScanType
inputClippings :: Maybe [InputClipping]
imageInserter :: Maybe ImageInserter
filterStrength :: Maybe Int
filterEnable :: Maybe InputFilterEnable
dolbyVisionMetadataXml :: Maybe Text
denoiseFilter :: Maybe InputDenoiseFilter
deblockFilter :: Maybe InputDeblockFilter
crop :: Maybe Rectangle
captionSelectors :: Maybe (HashMap Text CaptionSelector)
audioSelectors :: Maybe (HashMap Text AudioSelector)
audioSelectorGroups :: Maybe (HashMap Text AudioSelectorGroup)
$sel:videoSelector:InputTemplate' :: InputTemplate -> Maybe VideoSelector
$sel:timecodeStart:InputTemplate' :: InputTemplate -> Maybe Text
$sel:timecodeSource:InputTemplate' :: InputTemplate -> Maybe InputTimecodeSource
$sel:psiControl:InputTemplate' :: InputTemplate -> Maybe InputPsiControl
$sel:programNumber:InputTemplate' :: InputTemplate -> Maybe Natural
$sel:position:InputTemplate' :: InputTemplate -> Maybe Rectangle
$sel:inputScanType:InputTemplate' :: InputTemplate -> Maybe InputScanType
$sel:inputClippings:InputTemplate' :: InputTemplate -> Maybe [InputClipping]
$sel:imageInserter:InputTemplate' :: InputTemplate -> Maybe ImageInserter
$sel:filterStrength:InputTemplate' :: InputTemplate -> Maybe Int
$sel:filterEnable:InputTemplate' :: InputTemplate -> Maybe InputFilterEnable
$sel:dolbyVisionMetadataXml:InputTemplate' :: InputTemplate -> Maybe Text
$sel:denoiseFilter:InputTemplate' :: InputTemplate -> Maybe InputDenoiseFilter
$sel:deblockFilter:InputTemplate' :: InputTemplate -> Maybe InputDeblockFilter
$sel:crop:InputTemplate' :: InputTemplate -> Maybe Rectangle
$sel:captionSelectors:InputTemplate' :: InputTemplate -> Maybe (HashMap Text CaptionSelector)
$sel:audioSelectors:InputTemplate' :: InputTemplate -> Maybe (HashMap Text AudioSelector)
$sel:audioSelectorGroups:InputTemplate' :: InputTemplate -> Maybe (HashMap Text AudioSelectorGroup)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text AudioSelectorGroup)
audioSelectorGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text AudioSelector)
audioSelectors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text CaptionSelector)
captionSelectors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Rectangle
crop
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputDeblockFilter
deblockFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputDenoiseFilter
denoiseFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dolbyVisionMetadataXml
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputFilterEnable
filterEnable
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
filterStrength
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImageInserter
imageInserter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InputClipping]
inputClippings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputScanType
inputScanType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Rectangle
position
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
programNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputPsiControl
psiControl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputTimecodeSource
timecodeSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timecodeStart
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VideoSelector
videoSelector

instance Data.ToJSON InputTemplate where
  toJSON :: InputTemplate -> Value
toJSON InputTemplate' {Maybe Int
Maybe Natural
Maybe [InputClipping]
Maybe Text
Maybe (HashMap Text AudioSelectorGroup)
Maybe (HashMap Text AudioSelector)
Maybe (HashMap Text CaptionSelector)
Maybe InputDeblockFilter
Maybe InputDenoiseFilter
Maybe InputFilterEnable
Maybe InputPsiControl
Maybe InputScanType
Maybe InputTimecodeSource
Maybe ImageInserter
Maybe Rectangle
Maybe VideoSelector
videoSelector :: Maybe VideoSelector
timecodeStart :: Maybe Text
timecodeSource :: Maybe InputTimecodeSource
psiControl :: Maybe InputPsiControl
programNumber :: Maybe Natural
position :: Maybe Rectangle
inputScanType :: Maybe InputScanType
inputClippings :: Maybe [InputClipping]
imageInserter :: Maybe ImageInserter
filterStrength :: Maybe Int
filterEnable :: Maybe InputFilterEnable
dolbyVisionMetadataXml :: Maybe Text
denoiseFilter :: Maybe InputDenoiseFilter
deblockFilter :: Maybe InputDeblockFilter
crop :: Maybe Rectangle
captionSelectors :: Maybe (HashMap Text CaptionSelector)
audioSelectors :: Maybe (HashMap Text AudioSelector)
audioSelectorGroups :: Maybe (HashMap Text AudioSelectorGroup)
$sel:videoSelector:InputTemplate' :: InputTemplate -> Maybe VideoSelector
$sel:timecodeStart:InputTemplate' :: InputTemplate -> Maybe Text
$sel:timecodeSource:InputTemplate' :: InputTemplate -> Maybe InputTimecodeSource
$sel:psiControl:InputTemplate' :: InputTemplate -> Maybe InputPsiControl
$sel:programNumber:InputTemplate' :: InputTemplate -> Maybe Natural
$sel:position:InputTemplate' :: InputTemplate -> Maybe Rectangle
$sel:inputScanType:InputTemplate' :: InputTemplate -> Maybe InputScanType
$sel:inputClippings:InputTemplate' :: InputTemplate -> Maybe [InputClipping]
$sel:imageInserter:InputTemplate' :: InputTemplate -> Maybe ImageInserter
$sel:filterStrength:InputTemplate' :: InputTemplate -> Maybe Int
$sel:filterEnable:InputTemplate' :: InputTemplate -> Maybe InputFilterEnable
$sel:dolbyVisionMetadataXml:InputTemplate' :: InputTemplate -> Maybe Text
$sel:denoiseFilter:InputTemplate' :: InputTemplate -> Maybe InputDenoiseFilter
$sel:deblockFilter:InputTemplate' :: InputTemplate -> Maybe InputDeblockFilter
$sel:crop:InputTemplate' :: InputTemplate -> Maybe Rectangle
$sel:captionSelectors:InputTemplate' :: InputTemplate -> Maybe (HashMap Text CaptionSelector)
$sel:audioSelectors:InputTemplate' :: InputTemplate -> Maybe (HashMap Text AudioSelector)
$sel:audioSelectorGroups:InputTemplate' :: InputTemplate -> Maybe (HashMap Text AudioSelectorGroup)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"audioSelectorGroups" 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 (HashMap Text AudioSelectorGroup)
audioSelectorGroups,
            (Key
"audioSelectors" 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 (HashMap Text AudioSelector)
audioSelectors,
            (Key
"captionSelectors" 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 (HashMap Text CaptionSelector)
captionSelectors,
            (Key
"crop" 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 Rectangle
crop,
            (Key
"deblockFilter" 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 InputDeblockFilter
deblockFilter,
            (Key
"denoiseFilter" 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 InputDenoiseFilter
denoiseFilter,
            (Key
"dolbyVisionMetadataXml" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
dolbyVisionMetadataXml,
            (Key
"filterEnable" 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 InputFilterEnable
filterEnable,
            (Key
"filterStrength" 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 Int
filterStrength,
            (Key
"imageInserter" 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 ImageInserter
imageInserter,
            (Key
"inputClippings" 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 [InputClipping]
inputClippings,
            (Key
"inputScanType" 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 InputScanType
inputScanType,
            (Key
"position" 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 Rectangle
position,
            (Key
"programNumber" 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
programNumber,
            (Key
"psiControl" 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 InputPsiControl
psiControl,
            (Key
"timecodeSource" 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 InputTimecodeSource
timecodeSource,
            (Key
"timecodeStart" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
timecodeStart,
            (Key
"videoSelector" 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 VideoSelector
videoSelector
          ]
      )