{-# 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.Input
-- 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.Input 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.InputClass
import Amazonka.MediaLive.Types.InputDestination
import Amazonka.MediaLive.Types.InputDeviceSettings
import Amazonka.MediaLive.Types.InputSource
import Amazonka.MediaLive.Types.InputSourceType
import Amazonka.MediaLive.Types.InputState
import Amazonka.MediaLive.Types.InputType
import Amazonka.MediaLive.Types.MediaConnectFlow
import qualified Amazonka.Prelude as Prelude

-- | Placeholder documentation for Input
--
-- /See:/ 'newInput' smart constructor.
data Input = Input'
  { -- | The Unique ARN of the input (generated, immutable).
    Input -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | A list of channel IDs that that input is attached to (currently an input
    -- can only be attached to one channel).
    Input -> Maybe [Text]
attachedChannels :: Prelude.Maybe [Prelude.Text],
    -- | A list of the destinations of the input (PUSH-type).
    Input -> Maybe [InputDestination]
destinations :: Prelude.Maybe [InputDestination],
    -- | The generated ID of the input (unique for user account, immutable).
    Input -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | STANDARD - MediaLive expects two sources to be connected to this input.
    -- If the channel is also STANDARD, both sources will be ingested. If the
    -- channel is SINGLE_PIPELINE, only the first source will be ingested; the
    -- second source will always be ignored, even if the first source fails.
    -- SINGLE_PIPELINE - You can connect only one source to this input. If the
    -- ChannelClass is also SINGLE_PIPELINE, this value is valid. If the
    -- ChannelClass is STANDARD, this value is not valid because the channel
    -- requires two sources in the input.
    Input -> Maybe InputClass
inputClass :: Prelude.Maybe InputClass,
    -- | Settings for the input devices.
    Input -> Maybe [InputDeviceSettings]
inputDevices :: Prelude.Maybe [InputDeviceSettings],
    -- | A list of IDs for all Inputs which are partners of this one.
    Input -> Maybe [Text]
inputPartnerIds :: Prelude.Maybe [Prelude.Text],
    -- | Certain pull input sources can be dynamic, meaning that they can have
    -- their URL\'s dynamically changes during input switch actions. Presently,
    -- this functionality only works with MP4_FILE and TS_FILE inputs.
    Input -> Maybe InputSourceType
inputSourceType :: Prelude.Maybe InputSourceType,
    -- | A list of MediaConnect Flows for this input.
    Input -> Maybe [MediaConnectFlow]
mediaConnectFlows :: Prelude.Maybe [MediaConnectFlow],
    -- | The user-assigned name (This is a mutable value).
    Input -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the role this input assumes during and
    -- after creation.
    Input -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | A list of IDs for all the Input Security Groups attached to the input.
    Input -> Maybe [Text]
securityGroups :: Prelude.Maybe [Prelude.Text],
    -- | A list of the sources of the input (PULL-type).
    Input -> Maybe [InputSource]
sources :: Prelude.Maybe [InputSource],
    Input -> Maybe InputState
state :: Prelude.Maybe InputState,
    -- | A collection of key-value pairs.
    Input -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    Input -> Maybe InputType
type' :: Prelude.Maybe InputType
  }
  deriving (Input -> Input -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Input -> Input -> Bool
$c/= :: Input -> Input -> Bool
== :: Input -> Input -> Bool
$c== :: Input -> Input -> Bool
Prelude.Eq, ReadPrec [Input]
ReadPrec Input
Int -> ReadS Input
ReadS [Input]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Input]
$creadListPrec :: ReadPrec [Input]
readPrec :: ReadPrec Input
$creadPrec :: ReadPrec Input
readList :: ReadS [Input]
$creadList :: ReadS [Input]
readsPrec :: Int -> ReadS Input
$creadsPrec :: Int -> ReadS Input
Prelude.Read, Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Input] -> ShowS
$cshowList :: [Input] -> ShowS
show :: Input -> String
$cshow :: Input -> String
showsPrec :: Int -> Input -> ShowS
$cshowsPrec :: Int -> Input -> ShowS
Prelude.Show, forall x. Rep Input x -> Input
forall x. Input -> Rep Input x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Input x -> Input
$cfrom :: forall x. Input -> Rep Input x
Prelude.Generic)

-- |
-- Create a value of 'Input' 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:
--
-- 'arn', 'input_arn' - The Unique ARN of the input (generated, immutable).
--
-- 'attachedChannels', 'input_attachedChannels' - A list of channel IDs that that input is attached to (currently an input
-- can only be attached to one channel).
--
-- 'destinations', 'input_destinations' - A list of the destinations of the input (PUSH-type).
--
-- 'id', 'input_id' - The generated ID of the input (unique for user account, immutable).
--
-- 'inputClass', 'input_inputClass' - STANDARD - MediaLive expects two sources to be connected to this input.
-- If the channel is also STANDARD, both sources will be ingested. If the
-- channel is SINGLE_PIPELINE, only the first source will be ingested; the
-- second source will always be ignored, even if the first source fails.
-- SINGLE_PIPELINE - You can connect only one source to this input. If the
-- ChannelClass is also SINGLE_PIPELINE, this value is valid. If the
-- ChannelClass is STANDARD, this value is not valid because the channel
-- requires two sources in the input.
--
-- 'inputDevices', 'input_inputDevices' - Settings for the input devices.
--
-- 'inputPartnerIds', 'input_inputPartnerIds' - A list of IDs for all Inputs which are partners of this one.
--
-- 'inputSourceType', 'input_inputSourceType' - Certain pull input sources can be dynamic, meaning that they can have
-- their URL\'s dynamically changes during input switch actions. Presently,
-- this functionality only works with MP4_FILE and TS_FILE inputs.
--
-- 'mediaConnectFlows', 'input_mediaConnectFlows' - A list of MediaConnect Flows for this input.
--
-- 'name', 'input_name' - The user-assigned name (This is a mutable value).
--
-- 'roleArn', 'input_roleArn' - The Amazon Resource Name (ARN) of the role this input assumes during and
-- after creation.
--
-- 'securityGroups', 'input_securityGroups' - A list of IDs for all the Input Security Groups attached to the input.
--
-- 'sources', 'input_sources' - A list of the sources of the input (PULL-type).
--
-- 'state', 'input_state' - Undocumented member.
--
-- 'tags', 'input_tags' - A collection of key-value pairs.
--
-- 'type'', 'input_type' - Undocumented member.
newInput ::
  Input
newInput :: Input
newInput =
  Input'
    { $sel:arn:Input' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:attachedChannels:Input' :: Maybe [Text]
attachedChannels = forall a. Maybe a
Prelude.Nothing,
      $sel:destinations:Input' :: Maybe [InputDestination]
destinations = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Input' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:inputClass:Input' :: Maybe InputClass
inputClass = forall a. Maybe a
Prelude.Nothing,
      $sel:inputDevices:Input' :: Maybe [InputDeviceSettings]
inputDevices = forall a. Maybe a
Prelude.Nothing,
      $sel:inputPartnerIds:Input' :: Maybe [Text]
inputPartnerIds = forall a. Maybe a
Prelude.Nothing,
      $sel:inputSourceType:Input' :: Maybe InputSourceType
inputSourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:mediaConnectFlows:Input' :: Maybe [MediaConnectFlow]
mediaConnectFlows = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Input' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:Input' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroups:Input' :: Maybe [Text]
securityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:sources:Input' :: Maybe [InputSource]
sources = forall a. Maybe a
Prelude.Nothing,
      $sel:state:Input' :: Maybe InputState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:Input' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Input' :: Maybe InputType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | The Unique ARN of the input (generated, immutable).
input_arn :: Lens.Lens' Input (Prelude.Maybe Prelude.Text)
input_arn :: Lens' Input (Maybe Text)
input_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe Text
arn :: Maybe Text
$sel:arn:Input' :: Input -> Maybe Text
arn} -> Maybe Text
arn) (\s :: Input
s@Input' {} Maybe Text
a -> Input
s {$sel:arn:Input' :: Maybe Text
arn = Maybe Text
a} :: Input)

-- | A list of channel IDs that that input is attached to (currently an input
-- can only be attached to one channel).
input_attachedChannels :: Lens.Lens' Input (Prelude.Maybe [Prelude.Text])
input_attachedChannels :: Lens' Input (Maybe [Text])
input_attachedChannels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe [Text]
attachedChannels :: Maybe [Text]
$sel:attachedChannels:Input' :: Input -> Maybe [Text]
attachedChannels} -> Maybe [Text]
attachedChannels) (\s :: Input
s@Input' {} Maybe [Text]
a -> Input
s {$sel:attachedChannels:Input' :: Maybe [Text]
attachedChannels = Maybe [Text]
a} :: Input) 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

-- | A list of the destinations of the input (PUSH-type).
input_destinations :: Lens.Lens' Input (Prelude.Maybe [InputDestination])
input_destinations :: Lens' Input (Maybe [InputDestination])
input_destinations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe [InputDestination]
destinations :: Maybe [InputDestination]
$sel:destinations:Input' :: Input -> Maybe [InputDestination]
destinations} -> Maybe [InputDestination]
destinations) (\s :: Input
s@Input' {} Maybe [InputDestination]
a -> Input
s {$sel:destinations:Input' :: Maybe [InputDestination]
destinations = Maybe [InputDestination]
a} :: Input) 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

-- | The generated ID of the input (unique for user account, immutable).
input_id :: Lens.Lens' Input (Prelude.Maybe Prelude.Text)
input_id :: Lens' Input (Maybe Text)
input_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe Text
id :: Maybe Text
$sel:id:Input' :: Input -> Maybe Text
id} -> Maybe Text
id) (\s :: Input
s@Input' {} Maybe Text
a -> Input
s {$sel:id:Input' :: Maybe Text
id = Maybe Text
a} :: Input)

-- | STANDARD - MediaLive expects two sources to be connected to this input.
-- If the channel is also STANDARD, both sources will be ingested. If the
-- channel is SINGLE_PIPELINE, only the first source will be ingested; the
-- second source will always be ignored, even if the first source fails.
-- SINGLE_PIPELINE - You can connect only one source to this input. If the
-- ChannelClass is also SINGLE_PIPELINE, this value is valid. If the
-- ChannelClass is STANDARD, this value is not valid because the channel
-- requires two sources in the input.
input_inputClass :: Lens.Lens' Input (Prelude.Maybe InputClass)
input_inputClass :: Lens' Input (Maybe InputClass)
input_inputClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe InputClass
inputClass :: Maybe InputClass
$sel:inputClass:Input' :: Input -> Maybe InputClass
inputClass} -> Maybe InputClass
inputClass) (\s :: Input
s@Input' {} Maybe InputClass
a -> Input
s {$sel:inputClass:Input' :: Maybe InputClass
inputClass = Maybe InputClass
a} :: Input)

-- | Settings for the input devices.
input_inputDevices :: Lens.Lens' Input (Prelude.Maybe [InputDeviceSettings])
input_inputDevices :: Lens' Input (Maybe [InputDeviceSettings])
input_inputDevices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe [InputDeviceSettings]
inputDevices :: Maybe [InputDeviceSettings]
$sel:inputDevices:Input' :: Input -> Maybe [InputDeviceSettings]
inputDevices} -> Maybe [InputDeviceSettings]
inputDevices) (\s :: Input
s@Input' {} Maybe [InputDeviceSettings]
a -> Input
s {$sel:inputDevices:Input' :: Maybe [InputDeviceSettings]
inputDevices = Maybe [InputDeviceSettings]
a} :: Input) 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

-- | A list of IDs for all Inputs which are partners of this one.
input_inputPartnerIds :: Lens.Lens' Input (Prelude.Maybe [Prelude.Text])
input_inputPartnerIds :: Lens' Input (Maybe [Text])
input_inputPartnerIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe [Text]
inputPartnerIds :: Maybe [Text]
$sel:inputPartnerIds:Input' :: Input -> Maybe [Text]
inputPartnerIds} -> Maybe [Text]
inputPartnerIds) (\s :: Input
s@Input' {} Maybe [Text]
a -> Input
s {$sel:inputPartnerIds:Input' :: Maybe [Text]
inputPartnerIds = Maybe [Text]
a} :: Input) 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

-- | Certain pull input sources can be dynamic, meaning that they can have
-- their URL\'s dynamically changes during input switch actions. Presently,
-- this functionality only works with MP4_FILE and TS_FILE inputs.
input_inputSourceType :: Lens.Lens' Input (Prelude.Maybe InputSourceType)
input_inputSourceType :: Lens' Input (Maybe InputSourceType)
input_inputSourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe InputSourceType
inputSourceType :: Maybe InputSourceType
$sel:inputSourceType:Input' :: Input -> Maybe InputSourceType
inputSourceType} -> Maybe InputSourceType
inputSourceType) (\s :: Input
s@Input' {} Maybe InputSourceType
a -> Input
s {$sel:inputSourceType:Input' :: Maybe InputSourceType
inputSourceType = Maybe InputSourceType
a} :: Input)

-- | A list of MediaConnect Flows for this input.
input_mediaConnectFlows :: Lens.Lens' Input (Prelude.Maybe [MediaConnectFlow])
input_mediaConnectFlows :: Lens' Input (Maybe [MediaConnectFlow])
input_mediaConnectFlows = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe [MediaConnectFlow]
mediaConnectFlows :: Maybe [MediaConnectFlow]
$sel:mediaConnectFlows:Input' :: Input -> Maybe [MediaConnectFlow]
mediaConnectFlows} -> Maybe [MediaConnectFlow]
mediaConnectFlows) (\s :: Input
s@Input' {} Maybe [MediaConnectFlow]
a -> Input
s {$sel:mediaConnectFlows:Input' :: Maybe [MediaConnectFlow]
mediaConnectFlows = Maybe [MediaConnectFlow]
a} :: Input) 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

-- | The user-assigned name (This is a mutable value).
input_name :: Lens.Lens' Input (Prelude.Maybe Prelude.Text)
input_name :: Lens' Input (Maybe Text)
input_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe Text
name :: Maybe Text
$sel:name:Input' :: Input -> Maybe Text
name} -> Maybe Text
name) (\s :: Input
s@Input' {} Maybe Text
a -> Input
s {$sel:name:Input' :: Maybe Text
name = Maybe Text
a} :: Input)

-- | The Amazon Resource Name (ARN) of the role this input assumes during and
-- after creation.
input_roleArn :: Lens.Lens' Input (Prelude.Maybe Prelude.Text)
input_roleArn :: Lens' Input (Maybe Text)
input_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:Input' :: Input -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: Input
s@Input' {} Maybe Text
a -> Input
s {$sel:roleArn:Input' :: Maybe Text
roleArn = Maybe Text
a} :: Input)

-- | A list of IDs for all the Input Security Groups attached to the input.
input_securityGroups :: Lens.Lens' Input (Prelude.Maybe [Prelude.Text])
input_securityGroups :: Lens' Input (Maybe [Text])
input_securityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe [Text]
securityGroups :: Maybe [Text]
$sel:securityGroups:Input' :: Input -> Maybe [Text]
securityGroups} -> Maybe [Text]
securityGroups) (\s :: Input
s@Input' {} Maybe [Text]
a -> Input
s {$sel:securityGroups:Input' :: Maybe [Text]
securityGroups = Maybe [Text]
a} :: Input) 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

-- | A list of the sources of the input (PULL-type).
input_sources :: Lens.Lens' Input (Prelude.Maybe [InputSource])
input_sources :: Lens' Input (Maybe [InputSource])
input_sources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe [InputSource]
sources :: Maybe [InputSource]
$sel:sources:Input' :: Input -> Maybe [InputSource]
sources} -> Maybe [InputSource]
sources) (\s :: Input
s@Input' {} Maybe [InputSource]
a -> Input
s {$sel:sources:Input' :: Maybe [InputSource]
sources = Maybe [InputSource]
a} :: Input) 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

-- | Undocumented member.
input_state :: Lens.Lens' Input (Prelude.Maybe InputState)
input_state :: Lens' Input (Maybe InputState)
input_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe InputState
state :: Maybe InputState
$sel:state:Input' :: Input -> Maybe InputState
state} -> Maybe InputState
state) (\s :: Input
s@Input' {} Maybe InputState
a -> Input
s {$sel:state:Input' :: Maybe InputState
state = Maybe InputState
a} :: Input)

-- | A collection of key-value pairs.
input_tags :: Lens.Lens' Input (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
input_tags :: Lens' Input (Maybe (HashMap Text Text))
input_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:Input' :: Input -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: Input
s@Input' {} Maybe (HashMap Text Text)
a -> Input
s {$sel:tags:Input' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: Input) 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

-- | Undocumented member.
input_type :: Lens.Lens' Input (Prelude.Maybe InputType)
input_type :: Lens' Input (Maybe InputType)
input_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Input' {Maybe InputType
type' :: Maybe InputType
$sel:type':Input' :: Input -> Maybe InputType
type'} -> Maybe InputType
type') (\s :: Input
s@Input' {} Maybe InputType
a -> Input
s {$sel:type':Input' :: Maybe InputType
type' = Maybe InputType
a} :: Input)

instance Data.FromJSON Input where
  parseJSON :: Value -> Parser Input
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Input"
      ( \Object
x ->
          Maybe Text
-> Maybe [Text]
-> Maybe [InputDestination]
-> Maybe Text
-> Maybe InputClass
-> Maybe [InputDeviceSettings]
-> Maybe [Text]
-> Maybe InputSourceType
-> Maybe [MediaConnectFlow]
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe [InputSource]
-> Maybe InputState
-> Maybe (HashMap Text Text)
-> Maybe InputType
-> Input
Input'
            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
"arn")
            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
"attachedChannels"
                            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
"destinations" 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
"id")
            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
"inputClass")
            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
"inputDevices" 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
"inputPartnerIds"
                            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
"inputSourceType")
            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
"mediaConnectFlows"
                            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
"name")
            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
"roleArn")
            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
"securityGroups" 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
"sources" 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
"state")
            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
"tags" 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
"type")
      )

instance Prelude.Hashable Input where
  hashWithSalt :: Int -> Input -> Int
hashWithSalt Int
_salt Input' {Maybe [Text]
Maybe [InputDestination]
Maybe [InputDeviceSettings]
Maybe [InputSource]
Maybe [MediaConnectFlow]
Maybe Text
Maybe (HashMap Text Text)
Maybe InputClass
Maybe InputSourceType
Maybe InputState
Maybe InputType
type' :: Maybe InputType
tags :: Maybe (HashMap Text Text)
state :: Maybe InputState
sources :: Maybe [InputSource]
securityGroups :: Maybe [Text]
roleArn :: Maybe Text
name :: Maybe Text
mediaConnectFlows :: Maybe [MediaConnectFlow]
inputSourceType :: Maybe InputSourceType
inputPartnerIds :: Maybe [Text]
inputDevices :: Maybe [InputDeviceSettings]
inputClass :: Maybe InputClass
id :: Maybe Text
destinations :: Maybe [InputDestination]
attachedChannels :: Maybe [Text]
arn :: Maybe Text
$sel:type':Input' :: Input -> Maybe InputType
$sel:tags:Input' :: Input -> Maybe (HashMap Text Text)
$sel:state:Input' :: Input -> Maybe InputState
$sel:sources:Input' :: Input -> Maybe [InputSource]
$sel:securityGroups:Input' :: Input -> Maybe [Text]
$sel:roleArn:Input' :: Input -> Maybe Text
$sel:name:Input' :: Input -> Maybe Text
$sel:mediaConnectFlows:Input' :: Input -> Maybe [MediaConnectFlow]
$sel:inputSourceType:Input' :: Input -> Maybe InputSourceType
$sel:inputPartnerIds:Input' :: Input -> Maybe [Text]
$sel:inputDevices:Input' :: Input -> Maybe [InputDeviceSettings]
$sel:inputClass:Input' :: Input -> Maybe InputClass
$sel:id:Input' :: Input -> Maybe Text
$sel:destinations:Input' :: Input -> Maybe [InputDestination]
$sel:attachedChannels:Input' :: Input -> Maybe [Text]
$sel:arn:Input' :: Input -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
attachedChannels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InputDestination]
destinations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputClass
inputClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InputDeviceSettings]
inputDevices
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
inputPartnerIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputSourceType
inputSourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [MediaConnectFlow]
mediaConnectFlows
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InputSource]
sources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputType
type'

instance Prelude.NFData Input where
  rnf :: Input -> ()
rnf Input' {Maybe [Text]
Maybe [InputDestination]
Maybe [InputDeviceSettings]
Maybe [InputSource]
Maybe [MediaConnectFlow]
Maybe Text
Maybe (HashMap Text Text)
Maybe InputClass
Maybe InputSourceType
Maybe InputState
Maybe InputType
type' :: Maybe InputType
tags :: Maybe (HashMap Text Text)
state :: Maybe InputState
sources :: Maybe [InputSource]
securityGroups :: Maybe [Text]
roleArn :: Maybe Text
name :: Maybe Text
mediaConnectFlows :: Maybe [MediaConnectFlow]
inputSourceType :: Maybe InputSourceType
inputPartnerIds :: Maybe [Text]
inputDevices :: Maybe [InputDeviceSettings]
inputClass :: Maybe InputClass
id :: Maybe Text
destinations :: Maybe [InputDestination]
attachedChannels :: Maybe [Text]
arn :: Maybe Text
$sel:type':Input' :: Input -> Maybe InputType
$sel:tags:Input' :: Input -> Maybe (HashMap Text Text)
$sel:state:Input' :: Input -> Maybe InputState
$sel:sources:Input' :: Input -> Maybe [InputSource]
$sel:securityGroups:Input' :: Input -> Maybe [Text]
$sel:roleArn:Input' :: Input -> Maybe Text
$sel:name:Input' :: Input -> Maybe Text
$sel:mediaConnectFlows:Input' :: Input -> Maybe [MediaConnectFlow]
$sel:inputSourceType:Input' :: Input -> Maybe InputSourceType
$sel:inputPartnerIds:Input' :: Input -> Maybe [Text]
$sel:inputDevices:Input' :: Input -> Maybe [InputDeviceSettings]
$sel:inputClass:Input' :: Input -> Maybe InputClass
$sel:id:Input' :: Input -> Maybe Text
$sel:destinations:Input' :: Input -> Maybe [InputDestination]
$sel:attachedChannels:Input' :: Input -> Maybe [Text]
$sel:arn:Input' :: Input -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
attachedChannels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InputDestination]
destinations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputClass
inputClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InputDeviceSettings]
inputDevices
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
inputPartnerIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputSourceType
inputSourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [MediaConnectFlow]
mediaConnectFlows
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InputSource]
sources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputType
type'