{-# 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.InputDeviceUhdSettings
-- 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.InputDeviceUhdSettings 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.InputDeviceActiveInput
import Amazonka.MediaLive.Types.InputDeviceConfiguredInput
import Amazonka.MediaLive.Types.InputDeviceScanType
import Amazonka.MediaLive.Types.InputDeviceState
import qualified Amazonka.Prelude as Prelude

-- | Settings that describe the active source from the input device, and the
-- video characteristics of that source.
--
-- /See:/ 'newInputDeviceUhdSettings' smart constructor.
data InputDeviceUhdSettings = InputDeviceUhdSettings'
  { -- | If you specified Auto as the configured input, specifies which of the
    -- sources is currently active (SDI or HDMI).
    InputDeviceUhdSettings -> Maybe InputDeviceActiveInput
activeInput :: Prelude.Maybe InputDeviceActiveInput,
    -- | The source at the input device that is currently active. You can specify
    -- this source.
    InputDeviceUhdSettings -> Maybe InputDeviceConfiguredInput
configuredInput :: Prelude.Maybe InputDeviceConfiguredInput,
    -- | The state of the input device.
    InputDeviceUhdSettings -> Maybe InputDeviceState
deviceState :: Prelude.Maybe InputDeviceState,
    -- | The frame rate of the video source.
    InputDeviceUhdSettings -> Maybe Double
framerate :: Prelude.Maybe Prelude.Double,
    -- | The height of the video source, in pixels.
    InputDeviceUhdSettings -> Maybe Int
height :: Prelude.Maybe Prelude.Int,
    -- | The Link device\'s buffer size (latency) in milliseconds (ms). You can
    -- specify this value.
    InputDeviceUhdSettings -> Maybe Int
latencyMs :: Prelude.Maybe Prelude.Int,
    -- | The current maximum bitrate for ingesting this source, in bits per
    -- second. You can specify this maximum.
    InputDeviceUhdSettings -> Maybe Int
maxBitrate :: Prelude.Maybe Prelude.Int,
    -- | The scan type of the video source.
    InputDeviceUhdSettings -> Maybe InputDeviceScanType
scanType :: Prelude.Maybe InputDeviceScanType,
    -- | The width of the video source, in pixels.
    InputDeviceUhdSettings -> Maybe Int
width :: Prelude.Maybe Prelude.Int
  }
  deriving (InputDeviceUhdSettings -> InputDeviceUhdSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputDeviceUhdSettings -> InputDeviceUhdSettings -> Bool
$c/= :: InputDeviceUhdSettings -> InputDeviceUhdSettings -> Bool
== :: InputDeviceUhdSettings -> InputDeviceUhdSettings -> Bool
$c== :: InputDeviceUhdSettings -> InputDeviceUhdSettings -> Bool
Prelude.Eq, ReadPrec [InputDeviceUhdSettings]
ReadPrec InputDeviceUhdSettings
Int -> ReadS InputDeviceUhdSettings
ReadS [InputDeviceUhdSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InputDeviceUhdSettings]
$creadListPrec :: ReadPrec [InputDeviceUhdSettings]
readPrec :: ReadPrec InputDeviceUhdSettings
$creadPrec :: ReadPrec InputDeviceUhdSettings
readList :: ReadS [InputDeviceUhdSettings]
$creadList :: ReadS [InputDeviceUhdSettings]
readsPrec :: Int -> ReadS InputDeviceUhdSettings
$creadsPrec :: Int -> ReadS InputDeviceUhdSettings
Prelude.Read, Int -> InputDeviceUhdSettings -> ShowS
[InputDeviceUhdSettings] -> ShowS
InputDeviceUhdSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputDeviceUhdSettings] -> ShowS
$cshowList :: [InputDeviceUhdSettings] -> ShowS
show :: InputDeviceUhdSettings -> String
$cshow :: InputDeviceUhdSettings -> String
showsPrec :: Int -> InputDeviceUhdSettings -> ShowS
$cshowsPrec :: Int -> InputDeviceUhdSettings -> ShowS
Prelude.Show, forall x. Rep InputDeviceUhdSettings x -> InputDeviceUhdSettings
forall x. InputDeviceUhdSettings -> Rep InputDeviceUhdSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputDeviceUhdSettings x -> InputDeviceUhdSettings
$cfrom :: forall x. InputDeviceUhdSettings -> Rep InputDeviceUhdSettings x
Prelude.Generic)

-- |
-- Create a value of 'InputDeviceUhdSettings' 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:
--
-- 'activeInput', 'inputDeviceUhdSettings_activeInput' - If you specified Auto as the configured input, specifies which of the
-- sources is currently active (SDI or HDMI).
--
-- 'configuredInput', 'inputDeviceUhdSettings_configuredInput' - The source at the input device that is currently active. You can specify
-- this source.
--
-- 'deviceState', 'inputDeviceUhdSettings_deviceState' - The state of the input device.
--
-- 'framerate', 'inputDeviceUhdSettings_framerate' - The frame rate of the video source.
--
-- 'height', 'inputDeviceUhdSettings_height' - The height of the video source, in pixels.
--
-- 'latencyMs', 'inputDeviceUhdSettings_latencyMs' - The Link device\'s buffer size (latency) in milliseconds (ms). You can
-- specify this value.
--
-- 'maxBitrate', 'inputDeviceUhdSettings_maxBitrate' - The current maximum bitrate for ingesting this source, in bits per
-- second. You can specify this maximum.
--
-- 'scanType', 'inputDeviceUhdSettings_scanType' - The scan type of the video source.
--
-- 'width', 'inputDeviceUhdSettings_width' - The width of the video source, in pixels.
newInputDeviceUhdSettings ::
  InputDeviceUhdSettings
newInputDeviceUhdSettings :: InputDeviceUhdSettings
newInputDeviceUhdSettings =
  InputDeviceUhdSettings'
    { $sel:activeInput:InputDeviceUhdSettings' :: Maybe InputDeviceActiveInput
activeInput =
        forall a. Maybe a
Prelude.Nothing,
      $sel:configuredInput:InputDeviceUhdSettings' :: Maybe InputDeviceConfiguredInput
configuredInput = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceState:InputDeviceUhdSettings' :: Maybe InputDeviceState
deviceState = forall a. Maybe a
Prelude.Nothing,
      $sel:framerate:InputDeviceUhdSettings' :: Maybe Double
framerate = forall a. Maybe a
Prelude.Nothing,
      $sel:height:InputDeviceUhdSettings' :: Maybe Int
height = forall a. Maybe a
Prelude.Nothing,
      $sel:latencyMs:InputDeviceUhdSettings' :: Maybe Int
latencyMs = forall a. Maybe a
Prelude.Nothing,
      $sel:maxBitrate:InputDeviceUhdSettings' :: Maybe Int
maxBitrate = forall a. Maybe a
Prelude.Nothing,
      $sel:scanType:InputDeviceUhdSettings' :: Maybe InputDeviceScanType
scanType = forall a. Maybe a
Prelude.Nothing,
      $sel:width:InputDeviceUhdSettings' :: Maybe Int
width = forall a. Maybe a
Prelude.Nothing
    }

-- | If you specified Auto as the configured input, specifies which of the
-- sources is currently active (SDI or HDMI).
inputDeviceUhdSettings_activeInput :: Lens.Lens' InputDeviceUhdSettings (Prelude.Maybe InputDeviceActiveInput)
inputDeviceUhdSettings_activeInput :: Lens' InputDeviceUhdSettings (Maybe InputDeviceActiveInput)
inputDeviceUhdSettings_activeInput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputDeviceUhdSettings' {Maybe InputDeviceActiveInput
activeInput :: Maybe InputDeviceActiveInput
$sel:activeInput:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceActiveInput
activeInput} -> Maybe InputDeviceActiveInput
activeInput) (\s :: InputDeviceUhdSettings
s@InputDeviceUhdSettings' {} Maybe InputDeviceActiveInput
a -> InputDeviceUhdSettings
s {$sel:activeInput:InputDeviceUhdSettings' :: Maybe InputDeviceActiveInput
activeInput = Maybe InputDeviceActiveInput
a} :: InputDeviceUhdSettings)

-- | The source at the input device that is currently active. You can specify
-- this source.
inputDeviceUhdSettings_configuredInput :: Lens.Lens' InputDeviceUhdSettings (Prelude.Maybe InputDeviceConfiguredInput)
inputDeviceUhdSettings_configuredInput :: Lens' InputDeviceUhdSettings (Maybe InputDeviceConfiguredInput)
inputDeviceUhdSettings_configuredInput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputDeviceUhdSettings' {Maybe InputDeviceConfiguredInput
configuredInput :: Maybe InputDeviceConfiguredInput
$sel:configuredInput:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceConfiguredInput
configuredInput} -> Maybe InputDeviceConfiguredInput
configuredInput) (\s :: InputDeviceUhdSettings
s@InputDeviceUhdSettings' {} Maybe InputDeviceConfiguredInput
a -> InputDeviceUhdSettings
s {$sel:configuredInput:InputDeviceUhdSettings' :: Maybe InputDeviceConfiguredInput
configuredInput = Maybe InputDeviceConfiguredInput
a} :: InputDeviceUhdSettings)

-- | The state of the input device.
inputDeviceUhdSettings_deviceState :: Lens.Lens' InputDeviceUhdSettings (Prelude.Maybe InputDeviceState)
inputDeviceUhdSettings_deviceState :: Lens' InputDeviceUhdSettings (Maybe InputDeviceState)
inputDeviceUhdSettings_deviceState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputDeviceUhdSettings' {Maybe InputDeviceState
deviceState :: Maybe InputDeviceState
$sel:deviceState:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceState
deviceState} -> Maybe InputDeviceState
deviceState) (\s :: InputDeviceUhdSettings
s@InputDeviceUhdSettings' {} Maybe InputDeviceState
a -> InputDeviceUhdSettings
s {$sel:deviceState:InputDeviceUhdSettings' :: Maybe InputDeviceState
deviceState = Maybe InputDeviceState
a} :: InputDeviceUhdSettings)

-- | The frame rate of the video source.
inputDeviceUhdSettings_framerate :: Lens.Lens' InputDeviceUhdSettings (Prelude.Maybe Prelude.Double)
inputDeviceUhdSettings_framerate :: Lens' InputDeviceUhdSettings (Maybe Double)
inputDeviceUhdSettings_framerate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputDeviceUhdSettings' {Maybe Double
framerate :: Maybe Double
$sel:framerate:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Double
framerate} -> Maybe Double
framerate) (\s :: InputDeviceUhdSettings
s@InputDeviceUhdSettings' {} Maybe Double
a -> InputDeviceUhdSettings
s {$sel:framerate:InputDeviceUhdSettings' :: Maybe Double
framerate = Maybe Double
a} :: InputDeviceUhdSettings)

-- | The height of the video source, in pixels.
inputDeviceUhdSettings_height :: Lens.Lens' InputDeviceUhdSettings (Prelude.Maybe Prelude.Int)
inputDeviceUhdSettings_height :: Lens' InputDeviceUhdSettings (Maybe Int)
inputDeviceUhdSettings_height = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputDeviceUhdSettings' {Maybe Int
height :: Maybe Int
$sel:height:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
height} -> Maybe Int
height) (\s :: InputDeviceUhdSettings
s@InputDeviceUhdSettings' {} Maybe Int
a -> InputDeviceUhdSettings
s {$sel:height:InputDeviceUhdSettings' :: Maybe Int
height = Maybe Int
a} :: InputDeviceUhdSettings)

-- | The Link device\'s buffer size (latency) in milliseconds (ms). You can
-- specify this value.
inputDeviceUhdSettings_latencyMs :: Lens.Lens' InputDeviceUhdSettings (Prelude.Maybe Prelude.Int)
inputDeviceUhdSettings_latencyMs :: Lens' InputDeviceUhdSettings (Maybe Int)
inputDeviceUhdSettings_latencyMs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputDeviceUhdSettings' {Maybe Int
latencyMs :: Maybe Int
$sel:latencyMs:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
latencyMs} -> Maybe Int
latencyMs) (\s :: InputDeviceUhdSettings
s@InputDeviceUhdSettings' {} Maybe Int
a -> InputDeviceUhdSettings
s {$sel:latencyMs:InputDeviceUhdSettings' :: Maybe Int
latencyMs = Maybe Int
a} :: InputDeviceUhdSettings)

-- | The current maximum bitrate for ingesting this source, in bits per
-- second. You can specify this maximum.
inputDeviceUhdSettings_maxBitrate :: Lens.Lens' InputDeviceUhdSettings (Prelude.Maybe Prelude.Int)
inputDeviceUhdSettings_maxBitrate :: Lens' InputDeviceUhdSettings (Maybe Int)
inputDeviceUhdSettings_maxBitrate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputDeviceUhdSettings' {Maybe Int
maxBitrate :: Maybe Int
$sel:maxBitrate:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
maxBitrate} -> Maybe Int
maxBitrate) (\s :: InputDeviceUhdSettings
s@InputDeviceUhdSettings' {} Maybe Int
a -> InputDeviceUhdSettings
s {$sel:maxBitrate:InputDeviceUhdSettings' :: Maybe Int
maxBitrate = Maybe Int
a} :: InputDeviceUhdSettings)

-- | The scan type of the video source.
inputDeviceUhdSettings_scanType :: Lens.Lens' InputDeviceUhdSettings (Prelude.Maybe InputDeviceScanType)
inputDeviceUhdSettings_scanType :: Lens' InputDeviceUhdSettings (Maybe InputDeviceScanType)
inputDeviceUhdSettings_scanType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputDeviceUhdSettings' {Maybe InputDeviceScanType
scanType :: Maybe InputDeviceScanType
$sel:scanType:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceScanType
scanType} -> Maybe InputDeviceScanType
scanType) (\s :: InputDeviceUhdSettings
s@InputDeviceUhdSettings' {} Maybe InputDeviceScanType
a -> InputDeviceUhdSettings
s {$sel:scanType:InputDeviceUhdSettings' :: Maybe InputDeviceScanType
scanType = Maybe InputDeviceScanType
a} :: InputDeviceUhdSettings)

-- | The width of the video source, in pixels.
inputDeviceUhdSettings_width :: Lens.Lens' InputDeviceUhdSettings (Prelude.Maybe Prelude.Int)
inputDeviceUhdSettings_width :: Lens' InputDeviceUhdSettings (Maybe Int)
inputDeviceUhdSettings_width = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InputDeviceUhdSettings' {Maybe Int
width :: Maybe Int
$sel:width:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
width} -> Maybe Int
width) (\s :: InputDeviceUhdSettings
s@InputDeviceUhdSettings' {} Maybe Int
a -> InputDeviceUhdSettings
s {$sel:width:InputDeviceUhdSettings' :: Maybe Int
width = Maybe Int
a} :: InputDeviceUhdSettings)

instance Data.FromJSON InputDeviceUhdSettings where
  parseJSON :: Value -> Parser InputDeviceUhdSettings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"InputDeviceUhdSettings"
      ( \Object
x ->
          Maybe InputDeviceActiveInput
-> Maybe InputDeviceConfiguredInput
-> Maybe InputDeviceState
-> Maybe Double
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe InputDeviceScanType
-> Maybe Int
-> InputDeviceUhdSettings
InputDeviceUhdSettings'
            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
"activeInput")
            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
"configuredInput")
            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
"deviceState")
            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
"framerate")
            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
"height")
            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
"latencyMs")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"maxBitrate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"scanType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"width")
      )

instance Prelude.Hashable InputDeviceUhdSettings where
  hashWithSalt :: Int -> InputDeviceUhdSettings -> Int
hashWithSalt Int
_salt InputDeviceUhdSettings' {Maybe Double
Maybe Int
Maybe InputDeviceActiveInput
Maybe InputDeviceConfiguredInput
Maybe InputDeviceScanType
Maybe InputDeviceState
width :: Maybe Int
scanType :: Maybe InputDeviceScanType
maxBitrate :: Maybe Int
latencyMs :: Maybe Int
height :: Maybe Int
framerate :: Maybe Double
deviceState :: Maybe InputDeviceState
configuredInput :: Maybe InputDeviceConfiguredInput
activeInput :: Maybe InputDeviceActiveInput
$sel:width:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
$sel:scanType:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceScanType
$sel:maxBitrate:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
$sel:latencyMs:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
$sel:height:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
$sel:framerate:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Double
$sel:deviceState:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceState
$sel:configuredInput:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceConfiguredInput
$sel:activeInput:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceActiveInput
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputDeviceActiveInput
activeInput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputDeviceConfiguredInput
configuredInput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputDeviceState
deviceState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
framerate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
height
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
latencyMs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxBitrate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputDeviceScanType
scanType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
width

instance Prelude.NFData InputDeviceUhdSettings where
  rnf :: InputDeviceUhdSettings -> ()
rnf InputDeviceUhdSettings' {Maybe Double
Maybe Int
Maybe InputDeviceActiveInput
Maybe InputDeviceConfiguredInput
Maybe InputDeviceScanType
Maybe InputDeviceState
width :: Maybe Int
scanType :: Maybe InputDeviceScanType
maxBitrate :: Maybe Int
latencyMs :: Maybe Int
height :: Maybe Int
framerate :: Maybe Double
deviceState :: Maybe InputDeviceState
configuredInput :: Maybe InputDeviceConfiguredInput
activeInput :: Maybe InputDeviceActiveInput
$sel:width:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
$sel:scanType:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceScanType
$sel:maxBitrate:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
$sel:latencyMs:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
$sel:height:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Int
$sel:framerate:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe Double
$sel:deviceState:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceState
$sel:configuredInput:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceConfiguredInput
$sel:activeInput:InputDeviceUhdSettings' :: InputDeviceUhdSettings -> Maybe InputDeviceActiveInput
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe InputDeviceActiveInput
activeInput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputDeviceConfiguredInput
configuredInput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputDeviceState
deviceState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
framerate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
height
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
latencyMs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxBitrate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputDeviceScanType
scanType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
width