{-# 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.InputSettings
-- 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.InputSettings 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.AudioSelector
import Amazonka.MediaLive.Types.CaptionSelector
import Amazonka.MediaLive.Types.InputDeblockFilter
import Amazonka.MediaLive.Types.InputDenoiseFilter
import Amazonka.MediaLive.Types.InputFilter
import Amazonka.MediaLive.Types.InputSourceEndBehavior
import Amazonka.MediaLive.Types.NetworkInputSettings
import Amazonka.MediaLive.Types.Smpte2038DataPreference
import Amazonka.MediaLive.Types.VideoSelector
import qualified Amazonka.Prelude as Prelude

-- | Live Event input parameters. There can be multiple inputs in a single
-- Live Event.
--
-- /See:/ 'newInputSettings' smart constructor.
data InputSettings = InputSettings'
  { -- | Used to select the audio stream to decode for inputs that have multiple
    -- available.
    InputSettings -> Maybe [AudioSelector]
audioSelectors :: Prelude.Maybe [AudioSelector],
    -- | Used to select the caption input to use for inputs that have multiple
    -- available.
    InputSettings -> Maybe [CaptionSelector]
captionSelectors :: Prelude.Maybe [CaptionSelector],
    -- | Enable or disable the deblock filter when filtering.
    InputSettings -> Maybe InputDeblockFilter
deblockFilter :: Prelude.Maybe InputDeblockFilter,
    -- | Enable or disable the denoise filter when filtering.
    InputSettings -> Maybe InputDenoiseFilter
denoiseFilter :: Prelude.Maybe InputDenoiseFilter,
    -- | Adjusts the magnitude of filtering from 1 (minimal) to 5 (strongest).
    InputSettings -> Maybe Natural
filterStrength :: Prelude.Maybe Prelude.Natural,
    -- | Turns on the filter for this input. MPEG-2 inputs have the deblocking
    -- filter enabled by default. 1) auto - filtering will be applied depending
    -- on input type\/quality 2) disabled - no filtering will be applied to the
    -- input 3) forced - filtering will be applied regardless of input type
    InputSettings -> Maybe InputFilter
inputFilter :: Prelude.Maybe InputFilter,
    -- | Input settings.
    InputSettings -> Maybe NetworkInputSettings
networkInputSettings :: Prelude.Maybe NetworkInputSettings,
    -- | PID from which to read SCTE-35 messages. If left undefined, EML will
    -- select the first SCTE-35 PID found in the input.
    InputSettings -> Maybe Natural
scte35Pid :: Prelude.Maybe Prelude.Natural,
    -- | Specifies whether to extract applicable ancillary data from a SMPTE-2038
    -- source in this input. Applicable data types are captions, timecode, AFD,
    -- and SCTE-104 messages. - PREFER: Extract from SMPTE-2038 if present in
    -- this input, otherwise extract from another source (if any). - IGNORE:
    -- Never extract any ancillary data from SMPTE-2038.
    InputSettings -> Maybe Smpte2038DataPreference
smpte2038DataPreference :: Prelude.Maybe Smpte2038DataPreference,
    -- | Loop input if it is a file. This allows a file input to be streamed
    -- indefinitely.
    InputSettings -> Maybe InputSourceEndBehavior
sourceEndBehavior :: Prelude.Maybe InputSourceEndBehavior,
    -- | Informs which video elementary stream to decode for input types that
    -- have multiple available.
    InputSettings -> Maybe VideoSelector
videoSelector :: Prelude.Maybe VideoSelector
  }
  deriving (InputSettings -> InputSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputSettings -> InputSettings -> Bool
$c/= :: InputSettings -> InputSettings -> Bool
== :: InputSettings -> InputSettings -> Bool
$c== :: InputSettings -> InputSettings -> Bool
Prelude.Eq, ReadPrec [InputSettings]
ReadPrec InputSettings
Int -> ReadS InputSettings
ReadS [InputSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InputSettings]
$creadListPrec :: ReadPrec [InputSettings]
readPrec :: ReadPrec InputSettings
$creadPrec :: ReadPrec InputSettings
readList :: ReadS [InputSettings]
$creadList :: ReadS [InputSettings]
readsPrec :: Int -> ReadS InputSettings
$creadsPrec :: Int -> ReadS InputSettings
Prelude.Read, Int -> InputSettings -> ShowS
[InputSettings] -> ShowS
InputSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputSettings] -> ShowS
$cshowList :: [InputSettings] -> ShowS
show :: InputSettings -> String
$cshow :: InputSettings -> String
showsPrec :: Int -> InputSettings -> ShowS
$cshowsPrec :: Int -> InputSettings -> ShowS
Prelude.Show, forall x. Rep InputSettings x -> InputSettings
forall x. InputSettings -> Rep InputSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputSettings x -> InputSettings
$cfrom :: forall x. InputSettings -> Rep InputSettings x
Prelude.Generic)

-- |
-- Create a value of 'InputSettings' 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:
--
-- 'audioSelectors', 'inputSettings_audioSelectors' - Used to select the audio stream to decode for inputs that have multiple
-- available.
--
-- 'captionSelectors', 'inputSettings_captionSelectors' - Used to select the caption input to use for inputs that have multiple
-- available.
--
-- 'deblockFilter', 'inputSettings_deblockFilter' - Enable or disable the deblock filter when filtering.
--
-- 'denoiseFilter', 'inputSettings_denoiseFilter' - Enable or disable the denoise filter when filtering.
--
-- 'filterStrength', 'inputSettings_filterStrength' - Adjusts the magnitude of filtering from 1 (minimal) to 5 (strongest).
--
-- 'inputFilter', 'inputSettings_inputFilter' - Turns on the filter for this input. MPEG-2 inputs have the deblocking
-- filter enabled by default. 1) auto - filtering will be applied depending
-- on input type\/quality 2) disabled - no filtering will be applied to the
-- input 3) forced - filtering will be applied regardless of input type
--
-- 'networkInputSettings', 'inputSettings_networkInputSettings' - Input settings.
--
-- 'scte35Pid', 'inputSettings_scte35Pid' - PID from which to read SCTE-35 messages. If left undefined, EML will
-- select the first SCTE-35 PID found in the input.
--
-- 'smpte2038DataPreference', 'inputSettings_smpte2038DataPreference' - Specifies whether to extract applicable ancillary data from a SMPTE-2038
-- source in this input. Applicable data types are captions, timecode, AFD,
-- and SCTE-104 messages. - PREFER: Extract from SMPTE-2038 if present in
-- this input, otherwise extract from another source (if any). - IGNORE:
-- Never extract any ancillary data from SMPTE-2038.
--
-- 'sourceEndBehavior', 'inputSettings_sourceEndBehavior' - Loop input if it is a file. This allows a file input to be streamed
-- indefinitely.
--
-- 'videoSelector', 'inputSettings_videoSelector' - Informs which video elementary stream to decode for input types that
-- have multiple available.
newInputSettings ::
  InputSettings
newInputSettings :: InputSettings
newInputSettings =
  InputSettings'
    { $sel:audioSelectors:InputSettings' :: Maybe [AudioSelector]
audioSelectors = forall a. Maybe a
Prelude.Nothing,
      $sel:captionSelectors:InputSettings' :: Maybe [CaptionSelector]
captionSelectors = forall a. Maybe a
Prelude.Nothing,
      $sel:deblockFilter:InputSettings' :: Maybe InputDeblockFilter
deblockFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:denoiseFilter:InputSettings' :: Maybe InputDenoiseFilter
denoiseFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:filterStrength:InputSettings' :: Maybe Natural
filterStrength = forall a. Maybe a
Prelude.Nothing,
      $sel:inputFilter:InputSettings' :: Maybe InputFilter
inputFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:networkInputSettings:InputSettings' :: Maybe NetworkInputSettings
networkInputSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:scte35Pid:InputSettings' :: Maybe Natural
scte35Pid = forall a. Maybe a
Prelude.Nothing,
      $sel:smpte2038DataPreference:InputSettings' :: Maybe Smpte2038DataPreference
smpte2038DataPreference = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceEndBehavior:InputSettings' :: Maybe InputSourceEndBehavior
sourceEndBehavior = forall a. Maybe a
Prelude.Nothing,
      $sel:videoSelector:InputSettings' :: Maybe VideoSelector
videoSelector = forall a. Maybe a
Prelude.Nothing
    }

-- | Used to select the audio stream to decode for inputs that have multiple
-- available.
inputSettings_audioSelectors :: Lens.Lens' InputSettings (Prelude.Maybe [AudioSelector])
inputSettings_audioSelectors :: Lens' InputSettings (Maybe [AudioSelector])
inputSettings_audioSelectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputSettings' {Maybe [AudioSelector]
audioSelectors :: Maybe [AudioSelector]
$sel:audioSelectors:InputSettings' :: InputSettings -> Maybe [AudioSelector]
audioSelectors} -> Maybe [AudioSelector]
audioSelectors) (\s :: InputSettings
s@InputSettings' {} Maybe [AudioSelector]
a -> InputSettings
s {$sel:audioSelectors:InputSettings' :: Maybe [AudioSelector]
audioSelectors = Maybe [AudioSelector]
a} :: InputSettings) 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

-- | Used to select the caption input to use for inputs that have multiple
-- available.
inputSettings_captionSelectors :: Lens.Lens' InputSettings (Prelude.Maybe [CaptionSelector])
inputSettings_captionSelectors :: Lens' InputSettings (Maybe [CaptionSelector])
inputSettings_captionSelectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputSettings' {Maybe [CaptionSelector]
captionSelectors :: Maybe [CaptionSelector]
$sel:captionSelectors:InputSettings' :: InputSettings -> Maybe [CaptionSelector]
captionSelectors} -> Maybe [CaptionSelector]
captionSelectors) (\s :: InputSettings
s@InputSettings' {} Maybe [CaptionSelector]
a -> InputSettings
s {$sel:captionSelectors:InputSettings' :: Maybe [CaptionSelector]
captionSelectors = Maybe [CaptionSelector]
a} :: InputSettings) 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

-- | Enable or disable the deblock filter when filtering.
inputSettings_deblockFilter :: Lens.Lens' InputSettings (Prelude.Maybe InputDeblockFilter)
inputSettings_deblockFilter :: Lens' InputSettings (Maybe InputDeblockFilter)
inputSettings_deblockFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputSettings' {Maybe InputDeblockFilter
deblockFilter :: Maybe InputDeblockFilter
$sel:deblockFilter:InputSettings' :: InputSettings -> Maybe InputDeblockFilter
deblockFilter} -> Maybe InputDeblockFilter
deblockFilter) (\s :: InputSettings
s@InputSettings' {} Maybe InputDeblockFilter
a -> InputSettings
s {$sel:deblockFilter:InputSettings' :: Maybe InputDeblockFilter
deblockFilter = Maybe InputDeblockFilter
a} :: InputSettings)

-- | Enable or disable the denoise filter when filtering.
inputSettings_denoiseFilter :: Lens.Lens' InputSettings (Prelude.Maybe InputDenoiseFilter)
inputSettings_denoiseFilter :: Lens' InputSettings (Maybe InputDenoiseFilter)
inputSettings_denoiseFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputSettings' {Maybe InputDenoiseFilter
denoiseFilter :: Maybe InputDenoiseFilter
$sel:denoiseFilter:InputSettings' :: InputSettings -> Maybe InputDenoiseFilter
denoiseFilter} -> Maybe InputDenoiseFilter
denoiseFilter) (\s :: InputSettings
s@InputSettings' {} Maybe InputDenoiseFilter
a -> InputSettings
s {$sel:denoiseFilter:InputSettings' :: Maybe InputDenoiseFilter
denoiseFilter = Maybe InputDenoiseFilter
a} :: InputSettings)

-- | Adjusts the magnitude of filtering from 1 (minimal) to 5 (strongest).
inputSettings_filterStrength :: Lens.Lens' InputSettings (Prelude.Maybe Prelude.Natural)
inputSettings_filterStrength :: Lens' InputSettings (Maybe Natural)
inputSettings_filterStrength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputSettings' {Maybe Natural
filterStrength :: Maybe Natural
$sel:filterStrength:InputSettings' :: InputSettings -> Maybe Natural
filterStrength} -> Maybe Natural
filterStrength) (\s :: InputSettings
s@InputSettings' {} Maybe Natural
a -> InputSettings
s {$sel:filterStrength:InputSettings' :: Maybe Natural
filterStrength = Maybe Natural
a} :: InputSettings)

-- | Turns on the filter for this input. MPEG-2 inputs have the deblocking
-- filter enabled by default. 1) auto - filtering will be applied depending
-- on input type\/quality 2) disabled - no filtering will be applied to the
-- input 3) forced - filtering will be applied regardless of input type
inputSettings_inputFilter :: Lens.Lens' InputSettings (Prelude.Maybe InputFilter)
inputSettings_inputFilter :: Lens' InputSettings (Maybe InputFilter)
inputSettings_inputFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputSettings' {Maybe InputFilter
inputFilter :: Maybe InputFilter
$sel:inputFilter:InputSettings' :: InputSettings -> Maybe InputFilter
inputFilter} -> Maybe InputFilter
inputFilter) (\s :: InputSettings
s@InputSettings' {} Maybe InputFilter
a -> InputSettings
s {$sel:inputFilter:InputSettings' :: Maybe InputFilter
inputFilter = Maybe InputFilter
a} :: InputSettings)

-- | Input settings.
inputSettings_networkInputSettings :: Lens.Lens' InputSettings (Prelude.Maybe NetworkInputSettings)
inputSettings_networkInputSettings :: Lens' InputSettings (Maybe NetworkInputSettings)
inputSettings_networkInputSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputSettings' {Maybe NetworkInputSettings
networkInputSettings :: Maybe NetworkInputSettings
$sel:networkInputSettings:InputSettings' :: InputSettings -> Maybe NetworkInputSettings
networkInputSettings} -> Maybe NetworkInputSettings
networkInputSettings) (\s :: InputSettings
s@InputSettings' {} Maybe NetworkInputSettings
a -> InputSettings
s {$sel:networkInputSettings:InputSettings' :: Maybe NetworkInputSettings
networkInputSettings = Maybe NetworkInputSettings
a} :: InputSettings)

-- | PID from which to read SCTE-35 messages. If left undefined, EML will
-- select the first SCTE-35 PID found in the input.
inputSettings_scte35Pid :: Lens.Lens' InputSettings (Prelude.Maybe Prelude.Natural)
inputSettings_scte35Pid :: Lens' InputSettings (Maybe Natural)
inputSettings_scte35Pid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputSettings' {Maybe Natural
scte35Pid :: Maybe Natural
$sel:scte35Pid:InputSettings' :: InputSettings -> Maybe Natural
scte35Pid} -> Maybe Natural
scte35Pid) (\s :: InputSettings
s@InputSettings' {} Maybe Natural
a -> InputSettings
s {$sel:scte35Pid:InputSettings' :: Maybe Natural
scte35Pid = Maybe Natural
a} :: InputSettings)

-- | Specifies whether to extract applicable ancillary data from a SMPTE-2038
-- source in this input. Applicable data types are captions, timecode, AFD,
-- and SCTE-104 messages. - PREFER: Extract from SMPTE-2038 if present in
-- this input, otherwise extract from another source (if any). - IGNORE:
-- Never extract any ancillary data from SMPTE-2038.
inputSettings_smpte2038DataPreference :: Lens.Lens' InputSettings (Prelude.Maybe Smpte2038DataPreference)
inputSettings_smpte2038DataPreference :: Lens' InputSettings (Maybe Smpte2038DataPreference)
inputSettings_smpte2038DataPreference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputSettings' {Maybe Smpte2038DataPreference
smpte2038DataPreference :: Maybe Smpte2038DataPreference
$sel:smpte2038DataPreference:InputSettings' :: InputSettings -> Maybe Smpte2038DataPreference
smpte2038DataPreference} -> Maybe Smpte2038DataPreference
smpte2038DataPreference) (\s :: InputSettings
s@InputSettings' {} Maybe Smpte2038DataPreference
a -> InputSettings
s {$sel:smpte2038DataPreference:InputSettings' :: Maybe Smpte2038DataPreference
smpte2038DataPreference = Maybe Smpte2038DataPreference
a} :: InputSettings)

-- | Loop input if it is a file. This allows a file input to be streamed
-- indefinitely.
inputSettings_sourceEndBehavior :: Lens.Lens' InputSettings (Prelude.Maybe InputSourceEndBehavior)
inputSettings_sourceEndBehavior :: Lens' InputSettings (Maybe InputSourceEndBehavior)
inputSettings_sourceEndBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputSettings' {Maybe InputSourceEndBehavior
sourceEndBehavior :: Maybe InputSourceEndBehavior
$sel:sourceEndBehavior:InputSettings' :: InputSettings -> Maybe InputSourceEndBehavior
sourceEndBehavior} -> Maybe InputSourceEndBehavior
sourceEndBehavior) (\s :: InputSettings
s@InputSettings' {} Maybe InputSourceEndBehavior
a -> InputSettings
s {$sel:sourceEndBehavior:InputSettings' :: Maybe InputSourceEndBehavior
sourceEndBehavior = Maybe InputSourceEndBehavior
a} :: InputSettings)

-- | Informs which video elementary stream to decode for input types that
-- have multiple available.
inputSettings_videoSelector :: Lens.Lens' InputSettings (Prelude.Maybe VideoSelector)
inputSettings_videoSelector :: Lens' InputSettings (Maybe VideoSelector)
inputSettings_videoSelector = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputSettings' {Maybe VideoSelector
videoSelector :: Maybe VideoSelector
$sel:videoSelector:InputSettings' :: InputSettings -> Maybe VideoSelector
videoSelector} -> Maybe VideoSelector
videoSelector) (\s :: InputSettings
s@InputSettings' {} Maybe VideoSelector
a -> InputSettings
s {$sel:videoSelector:InputSettings' :: Maybe VideoSelector
videoSelector = Maybe VideoSelector
a} :: InputSettings)

instance Data.FromJSON InputSettings where
  parseJSON :: Value -> Parser InputSettings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"InputSettings"
      ( \Object
x ->
          Maybe [AudioSelector]
-> Maybe [CaptionSelector]
-> Maybe InputDeblockFilter
-> Maybe InputDenoiseFilter
-> Maybe Natural
-> Maybe InputFilter
-> Maybe NetworkInputSettings
-> Maybe Natural
-> Maybe Smpte2038DataPreference
-> Maybe InputSourceEndBehavior
-> Maybe VideoSelector
-> InputSettings
InputSettings'
            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
"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
"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
"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
"inputFilter")
            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
"networkInputSettings")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"scte35Pid")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"smpte2038DataPreference")
            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
"sourceEndBehavior")
            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 InputSettings where
  hashWithSalt :: Int -> InputSettings -> Int
hashWithSalt Int
_salt InputSettings' {Maybe Natural
Maybe [AudioSelector]
Maybe [CaptionSelector]
Maybe InputDeblockFilter
Maybe InputDenoiseFilter
Maybe InputFilter
Maybe InputSourceEndBehavior
Maybe NetworkInputSettings
Maybe Smpte2038DataPreference
Maybe VideoSelector
videoSelector :: Maybe VideoSelector
sourceEndBehavior :: Maybe InputSourceEndBehavior
smpte2038DataPreference :: Maybe Smpte2038DataPreference
scte35Pid :: Maybe Natural
networkInputSettings :: Maybe NetworkInputSettings
inputFilter :: Maybe InputFilter
filterStrength :: Maybe Natural
denoiseFilter :: Maybe InputDenoiseFilter
deblockFilter :: Maybe InputDeblockFilter
captionSelectors :: Maybe [CaptionSelector]
audioSelectors :: Maybe [AudioSelector]
$sel:videoSelector:InputSettings' :: InputSettings -> Maybe VideoSelector
$sel:sourceEndBehavior:InputSettings' :: InputSettings -> Maybe InputSourceEndBehavior
$sel:smpte2038DataPreference:InputSettings' :: InputSettings -> Maybe Smpte2038DataPreference
$sel:scte35Pid:InputSettings' :: InputSettings -> Maybe Natural
$sel:networkInputSettings:InputSettings' :: InputSettings -> Maybe NetworkInputSettings
$sel:inputFilter:InputSettings' :: InputSettings -> Maybe InputFilter
$sel:filterStrength:InputSettings' :: InputSettings -> Maybe Natural
$sel:denoiseFilter:InputSettings' :: InputSettings -> Maybe InputDenoiseFilter
$sel:deblockFilter:InputSettings' :: InputSettings -> Maybe InputDeblockFilter
$sel:captionSelectors:InputSettings' :: InputSettings -> Maybe [CaptionSelector]
$sel:audioSelectors:InputSettings' :: InputSettings -> Maybe [AudioSelector]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AudioSelector]
audioSelectors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CaptionSelector]
captionSelectors
      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 Natural
filterStrength
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputFilter
inputFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NetworkInputSettings
networkInputSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
scte35Pid
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Smpte2038DataPreference
smpte2038DataPreference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputSourceEndBehavior
sourceEndBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VideoSelector
videoSelector

instance Prelude.NFData InputSettings where
  rnf :: InputSettings -> ()
rnf InputSettings' {Maybe Natural
Maybe [AudioSelector]
Maybe [CaptionSelector]
Maybe InputDeblockFilter
Maybe InputDenoiseFilter
Maybe InputFilter
Maybe InputSourceEndBehavior
Maybe NetworkInputSettings
Maybe Smpte2038DataPreference
Maybe VideoSelector
videoSelector :: Maybe VideoSelector
sourceEndBehavior :: Maybe InputSourceEndBehavior
smpte2038DataPreference :: Maybe Smpte2038DataPreference
scte35Pid :: Maybe Natural
networkInputSettings :: Maybe NetworkInputSettings
inputFilter :: Maybe InputFilter
filterStrength :: Maybe Natural
denoiseFilter :: Maybe InputDenoiseFilter
deblockFilter :: Maybe InputDeblockFilter
captionSelectors :: Maybe [CaptionSelector]
audioSelectors :: Maybe [AudioSelector]
$sel:videoSelector:InputSettings' :: InputSettings -> Maybe VideoSelector
$sel:sourceEndBehavior:InputSettings' :: InputSettings -> Maybe InputSourceEndBehavior
$sel:smpte2038DataPreference:InputSettings' :: InputSettings -> Maybe Smpte2038DataPreference
$sel:scte35Pid:InputSettings' :: InputSettings -> Maybe Natural
$sel:networkInputSettings:InputSettings' :: InputSettings -> Maybe NetworkInputSettings
$sel:inputFilter:InputSettings' :: InputSettings -> Maybe InputFilter
$sel:filterStrength:InputSettings' :: InputSettings -> Maybe Natural
$sel:denoiseFilter:InputSettings' :: InputSettings -> Maybe InputDenoiseFilter
$sel:deblockFilter:InputSettings' :: InputSettings -> Maybe InputDeblockFilter
$sel:captionSelectors:InputSettings' :: InputSettings -> Maybe [CaptionSelector]
$sel:audioSelectors:InputSettings' :: InputSettings -> Maybe [AudioSelector]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AudioSelector]
audioSelectors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CaptionSelector]
captionSelectors
      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 Natural
filterStrength
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputFilter
inputFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NetworkInputSettings
networkInputSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
scte35Pid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Smpte2038DataPreference
smpte2038DataPreference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputSourceEndBehavior
sourceEndBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VideoSelector
videoSelector

instance Data.ToJSON InputSettings where
  toJSON :: InputSettings -> Value
toJSON InputSettings' {Maybe Natural
Maybe [AudioSelector]
Maybe [CaptionSelector]
Maybe InputDeblockFilter
Maybe InputDenoiseFilter
Maybe InputFilter
Maybe InputSourceEndBehavior
Maybe NetworkInputSettings
Maybe Smpte2038DataPreference
Maybe VideoSelector
videoSelector :: Maybe VideoSelector
sourceEndBehavior :: Maybe InputSourceEndBehavior
smpte2038DataPreference :: Maybe Smpte2038DataPreference
scte35Pid :: Maybe Natural
networkInputSettings :: Maybe NetworkInputSettings
inputFilter :: Maybe InputFilter
filterStrength :: Maybe Natural
denoiseFilter :: Maybe InputDenoiseFilter
deblockFilter :: Maybe InputDeblockFilter
captionSelectors :: Maybe [CaptionSelector]
audioSelectors :: Maybe [AudioSelector]
$sel:videoSelector:InputSettings' :: InputSettings -> Maybe VideoSelector
$sel:sourceEndBehavior:InputSettings' :: InputSettings -> Maybe InputSourceEndBehavior
$sel:smpte2038DataPreference:InputSettings' :: InputSettings -> Maybe Smpte2038DataPreference
$sel:scte35Pid:InputSettings' :: InputSettings -> Maybe Natural
$sel:networkInputSettings:InputSettings' :: InputSettings -> Maybe NetworkInputSettings
$sel:inputFilter:InputSettings' :: InputSettings -> Maybe InputFilter
$sel:filterStrength:InputSettings' :: InputSettings -> Maybe Natural
$sel:denoiseFilter:InputSettings' :: InputSettings -> Maybe InputDenoiseFilter
$sel:deblockFilter:InputSettings' :: InputSettings -> Maybe InputDeblockFilter
$sel:captionSelectors:InputSettings' :: InputSettings -> Maybe [CaptionSelector]
$sel:audioSelectors:InputSettings' :: InputSettings -> Maybe [AudioSelector]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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 [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 [CaptionSelector]
captionSelectors,
            (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
"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 Natural
filterStrength,
            (Key
"inputFilter" 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 InputFilter
inputFilter,
            (Key
"networkInputSettings" 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 NetworkInputSettings
networkInputSettings,
            (Key
"scte35Pid" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
scte35Pid,
            (Key
"smpte2038DataPreference" 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 Smpte2038DataPreference
smpte2038DataPreference,
            (Key
"sourceEndBehavior" 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 InputSourceEndBehavior
sourceEndBehavior,
            (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
          ]
      )