{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.CreateInput
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create an input
module Amazonka.MediaLive.CreateInput
  ( -- * Creating a Request
    CreateInput' (..),
    newCreateInput',

    -- * Request Lenses
    createInput'_destinations,
    createInput'_inputDevices,
    createInput'_inputSecurityGroups,
    createInput'_mediaConnectFlows,
    createInput'_name,
    createInput'_requestId,
    createInput'_roleArn,
    createInput'_sources,
    createInput'_tags,
    createInput'_type,
    createInput'_vpc,

    -- * Destructuring the Response
    CreateInputResponse (..),
    newCreateInputResponse,

    -- * Response Lenses
    createInputResponse_input,
    createInputResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | The name of the input
--
-- /See:/ 'newCreateInput'' smart constructor.
data CreateInput' = CreateInput''
  { -- | Destination settings for PUSH type inputs.
    CreateInput' -> Maybe [InputDestinationRequest]
destinations :: Prelude.Maybe [InputDestinationRequest],
    -- | Settings for the devices.
    CreateInput' -> Maybe [InputDeviceSettings]
inputDevices :: Prelude.Maybe [InputDeviceSettings],
    -- | A list of security groups referenced by IDs to attach to the input.
    CreateInput' -> Maybe [Text]
inputSecurityGroups :: Prelude.Maybe [Prelude.Text],
    -- | A list of the MediaConnect Flows that you want to use in this input. You
    -- can specify as few as one Flow and presently, as many as two. The only
    -- requirement is when you have more than one is that each Flow is in a
    -- separate Availability Zone as this ensures your EML input is redundant
    -- to AZ issues.
    CreateInput' -> Maybe [MediaConnectFlowRequest]
mediaConnectFlows :: Prelude.Maybe [MediaConnectFlowRequest],
    -- | Name of the input.
    CreateInput' -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Unique identifier of the request to ensure the request is handled
    -- exactly once in case of retries.
    CreateInput' -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the role this input assumes during and
    -- after creation.
    CreateInput' -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The source URLs for a PULL-type input. Every PULL type input needs
    -- exactly two source URLs for redundancy. Only specify sources for PULL
    -- type Inputs. Leave Destinations empty.
    CreateInput' -> Maybe [InputSourceRequest]
sources :: Prelude.Maybe [InputSourceRequest],
    -- | A collection of key-value pairs.
    CreateInput' -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    CreateInput' -> Maybe InputType
type' :: Prelude.Maybe InputType,
    CreateInput' -> Maybe InputVpcRequest
vpc :: Prelude.Maybe InputVpcRequest
  }
  deriving (CreateInput' -> CreateInput' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateInput' -> CreateInput' -> Bool
$c/= :: CreateInput' -> CreateInput' -> Bool
== :: CreateInput' -> CreateInput' -> Bool
$c== :: CreateInput' -> CreateInput' -> Bool
Prelude.Eq, ReadPrec [CreateInput']
ReadPrec CreateInput'
Int -> ReadS CreateInput'
ReadS [CreateInput']
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateInput']
$creadListPrec :: ReadPrec [CreateInput']
readPrec :: ReadPrec CreateInput'
$creadPrec :: ReadPrec CreateInput'
readList :: ReadS [CreateInput']
$creadList :: ReadS [CreateInput']
readsPrec :: Int -> ReadS CreateInput'
$creadsPrec :: Int -> ReadS CreateInput'
Prelude.Read, Int -> CreateInput' -> ShowS
[CreateInput'] -> ShowS
CreateInput' -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateInput'] -> ShowS
$cshowList :: [CreateInput'] -> ShowS
show :: CreateInput' -> String
$cshow :: CreateInput' -> String
showsPrec :: Int -> CreateInput' -> ShowS
$cshowsPrec :: Int -> CreateInput' -> ShowS
Prelude.Show, forall x. Rep CreateInput' x -> CreateInput'
forall x. CreateInput' -> Rep CreateInput' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateInput' x -> CreateInput'
$cfrom :: forall x. CreateInput' -> Rep CreateInput' x
Prelude.Generic)

-- |
-- Create a value of 'CreateInput'' 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:
--
-- 'destinations', 'createInput'_destinations' - Destination settings for PUSH type inputs.
--
-- 'inputDevices', 'createInput'_inputDevices' - Settings for the devices.
--
-- 'inputSecurityGroups', 'createInput'_inputSecurityGroups' - A list of security groups referenced by IDs to attach to the input.
--
-- 'mediaConnectFlows', 'createInput'_mediaConnectFlows' - A list of the MediaConnect Flows that you want to use in this input. You
-- can specify as few as one Flow and presently, as many as two. The only
-- requirement is when you have more than one is that each Flow is in a
-- separate Availability Zone as this ensures your EML input is redundant
-- to AZ issues.
--
-- 'name', 'createInput'_name' - Name of the input.
--
-- 'requestId', 'createInput'_requestId' - Unique identifier of the request to ensure the request is handled
-- exactly once in case of retries.
--
-- 'roleArn', 'createInput'_roleArn' - The Amazon Resource Name (ARN) of the role this input assumes during and
-- after creation.
--
-- 'sources', 'createInput'_sources' - The source URLs for a PULL-type input. Every PULL type input needs
-- exactly two source URLs for redundancy. Only specify sources for PULL
-- type Inputs. Leave Destinations empty.
--
-- 'tags', 'createInput'_tags' - A collection of key-value pairs.
--
-- 'type'', 'createInput'_type' - Undocumented member.
--
-- 'vpc', 'createInput'_vpc' - Undocumented member.
newCreateInput' ::
  CreateInput'
newCreateInput' :: CreateInput'
newCreateInput' =
  CreateInput''
    { $sel:destinations:CreateInput'' :: Maybe [InputDestinationRequest]
destinations = forall a. Maybe a
Prelude.Nothing,
      $sel:inputDevices:CreateInput'' :: Maybe [InputDeviceSettings]
inputDevices = forall a. Maybe a
Prelude.Nothing,
      $sel:inputSecurityGroups:CreateInput'' :: Maybe [Text]
inputSecurityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:mediaConnectFlows:CreateInput'' :: Maybe [MediaConnectFlowRequest]
mediaConnectFlows = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateInput'' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:CreateInput'' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:CreateInput'' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:sources:CreateInput'' :: Maybe [InputSourceRequest]
sources = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateInput'' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:type':CreateInput'' :: Maybe InputType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:vpc:CreateInput'' :: Maybe InputVpcRequest
vpc = forall a. Maybe a
Prelude.Nothing
    }

-- | Destination settings for PUSH type inputs.
createInput'_destinations :: Lens.Lens' CreateInput' (Prelude.Maybe [InputDestinationRequest])
createInput'_destinations :: Lens' CreateInput' (Maybe [InputDestinationRequest])
createInput'_destinations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput'' {Maybe [InputDestinationRequest]
destinations :: Maybe [InputDestinationRequest]
$sel:destinations:CreateInput'' :: CreateInput' -> Maybe [InputDestinationRequest]
destinations} -> Maybe [InputDestinationRequest]
destinations) (\s :: CreateInput'
s@CreateInput'' {} Maybe [InputDestinationRequest]
a -> CreateInput'
s {$sel:destinations:CreateInput'' :: Maybe [InputDestinationRequest]
destinations = Maybe [InputDestinationRequest]
a} :: CreateInput') 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

-- | Settings for the devices.
createInput'_inputDevices :: Lens.Lens' CreateInput' (Prelude.Maybe [InputDeviceSettings])
createInput'_inputDevices :: Lens' CreateInput' (Maybe [InputDeviceSettings])
createInput'_inputDevices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput'' {Maybe [InputDeviceSettings]
inputDevices :: Maybe [InputDeviceSettings]
$sel:inputDevices:CreateInput'' :: CreateInput' -> Maybe [InputDeviceSettings]
inputDevices} -> Maybe [InputDeviceSettings]
inputDevices) (\s :: CreateInput'
s@CreateInput'' {} Maybe [InputDeviceSettings]
a -> CreateInput'
s {$sel:inputDevices:CreateInput'' :: Maybe [InputDeviceSettings]
inputDevices = Maybe [InputDeviceSettings]
a} :: CreateInput') 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 security groups referenced by IDs to attach to the input.
createInput'_inputSecurityGroups :: Lens.Lens' CreateInput' (Prelude.Maybe [Prelude.Text])
createInput'_inputSecurityGroups :: Lens' CreateInput' (Maybe [Text])
createInput'_inputSecurityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput'' {Maybe [Text]
inputSecurityGroups :: Maybe [Text]
$sel:inputSecurityGroups:CreateInput'' :: CreateInput' -> Maybe [Text]
inputSecurityGroups} -> Maybe [Text]
inputSecurityGroups) (\s :: CreateInput'
s@CreateInput'' {} Maybe [Text]
a -> CreateInput'
s {$sel:inputSecurityGroups:CreateInput'' :: Maybe [Text]
inputSecurityGroups = Maybe [Text]
a} :: CreateInput') 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 MediaConnect Flows that you want to use in this input. You
-- can specify as few as one Flow and presently, as many as two. The only
-- requirement is when you have more than one is that each Flow is in a
-- separate Availability Zone as this ensures your EML input is redundant
-- to AZ issues.
createInput'_mediaConnectFlows :: Lens.Lens' CreateInput' (Prelude.Maybe [MediaConnectFlowRequest])
createInput'_mediaConnectFlows :: Lens' CreateInput' (Maybe [MediaConnectFlowRequest])
createInput'_mediaConnectFlows = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput'' {Maybe [MediaConnectFlowRequest]
mediaConnectFlows :: Maybe [MediaConnectFlowRequest]
$sel:mediaConnectFlows:CreateInput'' :: CreateInput' -> Maybe [MediaConnectFlowRequest]
mediaConnectFlows} -> Maybe [MediaConnectFlowRequest]
mediaConnectFlows) (\s :: CreateInput'
s@CreateInput'' {} Maybe [MediaConnectFlowRequest]
a -> CreateInput'
s {$sel:mediaConnectFlows:CreateInput'' :: Maybe [MediaConnectFlowRequest]
mediaConnectFlows = Maybe [MediaConnectFlowRequest]
a} :: CreateInput') 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

-- | Name of the input.
createInput'_name :: Lens.Lens' CreateInput' (Prelude.Maybe Prelude.Text)
createInput'_name :: Lens' CreateInput' (Maybe Text)
createInput'_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput'' {Maybe Text
name :: Maybe Text
$sel:name:CreateInput'' :: CreateInput' -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateInput'
s@CreateInput'' {} Maybe Text
a -> CreateInput'
s {$sel:name:CreateInput'' :: Maybe Text
name = Maybe Text
a} :: CreateInput')

-- | Unique identifier of the request to ensure the request is handled
-- exactly once in case of retries.
createInput'_requestId :: Lens.Lens' CreateInput' (Prelude.Maybe Prelude.Text)
createInput'_requestId :: Lens' CreateInput' (Maybe Text)
createInput'_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput'' {Maybe Text
requestId :: Maybe Text
$sel:requestId:CreateInput'' :: CreateInput' -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: CreateInput'
s@CreateInput'' {} Maybe Text
a -> CreateInput'
s {$sel:requestId:CreateInput'' :: Maybe Text
requestId = Maybe Text
a} :: CreateInput')

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

-- | The source URLs for a PULL-type input. Every PULL type input needs
-- exactly two source URLs for redundancy. Only specify sources for PULL
-- type Inputs. Leave Destinations empty.
createInput'_sources :: Lens.Lens' CreateInput' (Prelude.Maybe [InputSourceRequest])
createInput'_sources :: Lens' CreateInput' (Maybe [InputSourceRequest])
createInput'_sources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput'' {Maybe [InputSourceRequest]
sources :: Maybe [InputSourceRequest]
$sel:sources:CreateInput'' :: CreateInput' -> Maybe [InputSourceRequest]
sources} -> Maybe [InputSourceRequest]
sources) (\s :: CreateInput'
s@CreateInput'' {} Maybe [InputSourceRequest]
a -> CreateInput'
s {$sel:sources:CreateInput'' :: Maybe [InputSourceRequest]
sources = Maybe [InputSourceRequest]
a} :: CreateInput') 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 collection of key-value pairs.
createInput'_tags :: Lens.Lens' CreateInput' (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createInput'_tags :: Lens' CreateInput' (Maybe (HashMap Text Text))
createInput'_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput'' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateInput'' :: CreateInput' -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateInput'
s@CreateInput'' {} Maybe (HashMap Text Text)
a -> CreateInput'
s {$sel:tags:CreateInput'' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateInput') 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.
createInput'_type :: Lens.Lens' CreateInput' (Prelude.Maybe InputType)
createInput'_type :: Lens' CreateInput' (Maybe InputType)
createInput'_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput'' {Maybe InputType
type' :: Maybe InputType
$sel:type':CreateInput'' :: CreateInput' -> Maybe InputType
type'} -> Maybe InputType
type') (\s :: CreateInput'
s@CreateInput'' {} Maybe InputType
a -> CreateInput'
s {$sel:type':CreateInput'' :: Maybe InputType
type' = Maybe InputType
a} :: CreateInput')

-- | Undocumented member.
createInput'_vpc :: Lens.Lens' CreateInput' (Prelude.Maybe InputVpcRequest)
createInput'_vpc :: Lens' CreateInput' (Maybe InputVpcRequest)
createInput'_vpc = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInput'' {Maybe InputVpcRequest
vpc :: Maybe InputVpcRequest
$sel:vpc:CreateInput'' :: CreateInput' -> Maybe InputVpcRequest
vpc} -> Maybe InputVpcRequest
vpc) (\s :: CreateInput'
s@CreateInput'' {} Maybe InputVpcRequest
a -> CreateInput'
s {$sel:vpc:CreateInput'' :: Maybe InputVpcRequest
vpc = Maybe InputVpcRequest
a} :: CreateInput')

instance Core.AWSRequest CreateInput' where
  type AWSResponse CreateInput' = CreateInputResponse
  request :: (Service -> Service) -> CreateInput' -> Request CreateInput'
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateInput'
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateInput')))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Input -> Int -> CreateInputResponse
CreateInputResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"input")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateInput' where
  hashWithSalt :: Int -> CreateInput' -> Int
hashWithSalt Int
_salt CreateInput'' {Maybe [Text]
Maybe [InputDestinationRequest]
Maybe [InputDeviceSettings]
Maybe [InputSourceRequest]
Maybe [MediaConnectFlowRequest]
Maybe Text
Maybe (HashMap Text Text)
Maybe InputType
Maybe InputVpcRequest
vpc :: Maybe InputVpcRequest
type' :: Maybe InputType
tags :: Maybe (HashMap Text Text)
sources :: Maybe [InputSourceRequest]
roleArn :: Maybe Text
requestId :: Maybe Text
name :: Maybe Text
mediaConnectFlows :: Maybe [MediaConnectFlowRequest]
inputSecurityGroups :: Maybe [Text]
inputDevices :: Maybe [InputDeviceSettings]
destinations :: Maybe [InputDestinationRequest]
$sel:vpc:CreateInput'' :: CreateInput' -> Maybe InputVpcRequest
$sel:type':CreateInput'' :: CreateInput' -> Maybe InputType
$sel:tags:CreateInput'' :: CreateInput' -> Maybe (HashMap Text Text)
$sel:sources:CreateInput'' :: CreateInput' -> Maybe [InputSourceRequest]
$sel:roleArn:CreateInput'' :: CreateInput' -> Maybe Text
$sel:requestId:CreateInput'' :: CreateInput' -> Maybe Text
$sel:name:CreateInput'' :: CreateInput' -> Maybe Text
$sel:mediaConnectFlows:CreateInput'' :: CreateInput' -> Maybe [MediaConnectFlowRequest]
$sel:inputSecurityGroups:CreateInput'' :: CreateInput' -> Maybe [Text]
$sel:inputDevices:CreateInput'' :: CreateInput' -> Maybe [InputDeviceSettings]
$sel:destinations:CreateInput'' :: CreateInput' -> Maybe [InputDestinationRequest]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InputDestinationRequest]
destinations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InputDeviceSettings]
inputDevices
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
inputSecurityGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [MediaConnectFlowRequest]
mediaConnectFlows
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
requestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InputSourceRequest]
sources
      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'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputVpcRequest
vpc

instance Prelude.NFData CreateInput' where
  rnf :: CreateInput' -> ()
rnf CreateInput'' {Maybe [Text]
Maybe [InputDestinationRequest]
Maybe [InputDeviceSettings]
Maybe [InputSourceRequest]
Maybe [MediaConnectFlowRequest]
Maybe Text
Maybe (HashMap Text Text)
Maybe InputType
Maybe InputVpcRequest
vpc :: Maybe InputVpcRequest
type' :: Maybe InputType
tags :: Maybe (HashMap Text Text)
sources :: Maybe [InputSourceRequest]
roleArn :: Maybe Text
requestId :: Maybe Text
name :: Maybe Text
mediaConnectFlows :: Maybe [MediaConnectFlowRequest]
inputSecurityGroups :: Maybe [Text]
inputDevices :: Maybe [InputDeviceSettings]
destinations :: Maybe [InputDestinationRequest]
$sel:vpc:CreateInput'' :: CreateInput' -> Maybe InputVpcRequest
$sel:type':CreateInput'' :: CreateInput' -> Maybe InputType
$sel:tags:CreateInput'' :: CreateInput' -> Maybe (HashMap Text Text)
$sel:sources:CreateInput'' :: CreateInput' -> Maybe [InputSourceRequest]
$sel:roleArn:CreateInput'' :: CreateInput' -> Maybe Text
$sel:requestId:CreateInput'' :: CreateInput' -> Maybe Text
$sel:name:CreateInput'' :: CreateInput' -> Maybe Text
$sel:mediaConnectFlows:CreateInput'' :: CreateInput' -> Maybe [MediaConnectFlowRequest]
$sel:inputSecurityGroups:CreateInput'' :: CreateInput' -> Maybe [Text]
$sel:inputDevices:CreateInput'' :: CreateInput' -> Maybe [InputDeviceSettings]
$sel:destinations:CreateInput'' :: CreateInput' -> Maybe [InputDestinationRequest]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [InputDestinationRequest]
destinations
      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]
inputSecurityGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [MediaConnectFlowRequest]
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
requestId
      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 [InputSourceRequest]
sources
      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'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputVpcRequest
vpc

instance Data.ToHeaders CreateInput' where
  toHeaders :: CreateInput' -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateInput' where
  toJSON :: CreateInput' -> Value
toJSON CreateInput'' {Maybe [Text]
Maybe [InputDestinationRequest]
Maybe [InputDeviceSettings]
Maybe [InputSourceRequest]
Maybe [MediaConnectFlowRequest]
Maybe Text
Maybe (HashMap Text Text)
Maybe InputType
Maybe InputVpcRequest
vpc :: Maybe InputVpcRequest
type' :: Maybe InputType
tags :: Maybe (HashMap Text Text)
sources :: Maybe [InputSourceRequest]
roleArn :: Maybe Text
requestId :: Maybe Text
name :: Maybe Text
mediaConnectFlows :: Maybe [MediaConnectFlowRequest]
inputSecurityGroups :: Maybe [Text]
inputDevices :: Maybe [InputDeviceSettings]
destinations :: Maybe [InputDestinationRequest]
$sel:vpc:CreateInput'' :: CreateInput' -> Maybe InputVpcRequest
$sel:type':CreateInput'' :: CreateInput' -> Maybe InputType
$sel:tags:CreateInput'' :: CreateInput' -> Maybe (HashMap Text Text)
$sel:sources:CreateInput'' :: CreateInput' -> Maybe [InputSourceRequest]
$sel:roleArn:CreateInput'' :: CreateInput' -> Maybe Text
$sel:requestId:CreateInput'' :: CreateInput' -> Maybe Text
$sel:name:CreateInput'' :: CreateInput' -> Maybe Text
$sel:mediaConnectFlows:CreateInput'' :: CreateInput' -> Maybe [MediaConnectFlowRequest]
$sel:inputSecurityGroups:CreateInput'' :: CreateInput' -> Maybe [Text]
$sel:inputDevices:CreateInput'' :: CreateInput' -> Maybe [InputDeviceSettings]
$sel:destinations:CreateInput'' :: CreateInput' -> Maybe [InputDestinationRequest]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"destinations" 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 [InputDestinationRequest]
destinations,
            (Key
"inputDevices" 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 [InputDeviceSettings]
inputDevices,
            (Key
"inputSecurityGroups" 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]
inputSecurityGroups,
            (Key
"mediaConnectFlows" 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 [MediaConnectFlowRequest]
mediaConnectFlows,
            (Key
"name" 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
name,
            (Key
"requestId" 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
requestId,
            (Key
"roleArn" 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
roleArn,
            (Key
"sources" 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 [InputSourceRequest]
sources,
            (Key
"tags" 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 Text)
tags,
            (Key
"type" 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 InputType
type',
            (Key
"vpc" 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 InputVpcRequest
vpc
          ]
      )

instance Data.ToPath CreateInput' where
  toPath :: CreateInput' -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/prod/inputs"

instance Data.ToQuery CreateInput' where
  toQuery :: CreateInput' -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | Placeholder documentation for CreateInputResponse
--
-- /See:/ 'newCreateInputResponse' smart constructor.
data CreateInputResponse = CreateInputResponse'
  { CreateInputResponse -> Maybe Input
input :: Prelude.Maybe Input,
    -- | The response's http status code.
    CreateInputResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateInputResponse -> CreateInputResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateInputResponse -> CreateInputResponse -> Bool
$c/= :: CreateInputResponse -> CreateInputResponse -> Bool
== :: CreateInputResponse -> CreateInputResponse -> Bool
$c== :: CreateInputResponse -> CreateInputResponse -> Bool
Prelude.Eq, ReadPrec [CreateInputResponse]
ReadPrec CreateInputResponse
Int -> ReadS CreateInputResponse
ReadS [CreateInputResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateInputResponse]
$creadListPrec :: ReadPrec [CreateInputResponse]
readPrec :: ReadPrec CreateInputResponse
$creadPrec :: ReadPrec CreateInputResponse
readList :: ReadS [CreateInputResponse]
$creadList :: ReadS [CreateInputResponse]
readsPrec :: Int -> ReadS CreateInputResponse
$creadsPrec :: Int -> ReadS CreateInputResponse
Prelude.Read, Int -> CreateInputResponse -> ShowS
[CreateInputResponse] -> ShowS
CreateInputResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateInputResponse] -> ShowS
$cshowList :: [CreateInputResponse] -> ShowS
show :: CreateInputResponse -> String
$cshow :: CreateInputResponse -> String
showsPrec :: Int -> CreateInputResponse -> ShowS
$cshowsPrec :: Int -> CreateInputResponse -> ShowS
Prelude.Show, forall x. Rep CreateInputResponse x -> CreateInputResponse
forall x. CreateInputResponse -> Rep CreateInputResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateInputResponse x -> CreateInputResponse
$cfrom :: forall x. CreateInputResponse -> Rep CreateInputResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateInputResponse' 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:
--
-- 'input', 'createInputResponse_input' - Undocumented member.
--
-- 'httpStatus', 'createInputResponse_httpStatus' - The response's http status code.
newCreateInputResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateInputResponse
newCreateInputResponse :: Int -> CreateInputResponse
newCreateInputResponse Int
pHttpStatus_ =
  CreateInputResponse'
    { $sel:input:CreateInputResponse' :: Maybe Input
input = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateInputResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The response's http status code.
createInputResponse_httpStatus :: Lens.Lens' CreateInputResponse Prelude.Int
createInputResponse_httpStatus :: Lens' CreateInputResponse Int
createInputResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInputResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateInputResponse' :: CreateInputResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateInputResponse
s@CreateInputResponse' {} Int
a -> CreateInputResponse
s {$sel:httpStatus:CreateInputResponse' :: Int
httpStatus = Int
a} :: CreateInputResponse)

instance Prelude.NFData CreateInputResponse where
  rnf :: CreateInputResponse -> ()
rnf CreateInputResponse' {Int
Maybe Input
httpStatus :: Int
input :: Maybe Input
$sel:httpStatus:CreateInputResponse' :: CreateInputResponse -> Int
$sel:input:CreateInputResponse' :: CreateInputResponse -> Maybe Input
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Input
input
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus