{-# 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.CreatePartnerInput
-- 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 a partner input
module Amazonka.MediaLive.CreatePartnerInput
  ( -- * Creating a Request
    CreatePartnerInput' (..),
    newCreatePartnerInput',

    -- * Request Lenses
    createPartnerInput'_requestId,
    createPartnerInput'_tags,
    createPartnerInput'_inputId,

    -- * Destructuring the Response
    CreatePartnerInputResponse (..),
    newCreatePartnerInputResponse,

    -- * Response Lenses
    createPartnerInputResponse_input,
    createPartnerInputResponse_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

-- | A request to create a partner input
--
-- /See:/ 'newCreatePartnerInput'' smart constructor.
data CreatePartnerInput' = CreatePartnerInput''
  { -- | Unique identifier of the request to ensure the request is handled
    -- exactly once in case of retries.
    CreatePartnerInput' -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | A collection of key-value pairs.
    CreatePartnerInput' -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Unique ID of the input.
    CreatePartnerInput' -> Text
inputId :: Prelude.Text
  }
  deriving (CreatePartnerInput' -> CreatePartnerInput' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePartnerInput' -> CreatePartnerInput' -> Bool
$c/= :: CreatePartnerInput' -> CreatePartnerInput' -> Bool
== :: CreatePartnerInput' -> CreatePartnerInput' -> Bool
$c== :: CreatePartnerInput' -> CreatePartnerInput' -> Bool
Prelude.Eq, ReadPrec [CreatePartnerInput']
ReadPrec CreatePartnerInput'
Int -> ReadS CreatePartnerInput'
ReadS [CreatePartnerInput']
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePartnerInput']
$creadListPrec :: ReadPrec [CreatePartnerInput']
readPrec :: ReadPrec CreatePartnerInput'
$creadPrec :: ReadPrec CreatePartnerInput'
readList :: ReadS [CreatePartnerInput']
$creadList :: ReadS [CreatePartnerInput']
readsPrec :: Int -> ReadS CreatePartnerInput'
$creadsPrec :: Int -> ReadS CreatePartnerInput'
Prelude.Read, Int -> CreatePartnerInput' -> ShowS
[CreatePartnerInput'] -> ShowS
CreatePartnerInput' -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePartnerInput'] -> ShowS
$cshowList :: [CreatePartnerInput'] -> ShowS
show :: CreatePartnerInput' -> String
$cshow :: CreatePartnerInput' -> String
showsPrec :: Int -> CreatePartnerInput' -> ShowS
$cshowsPrec :: Int -> CreatePartnerInput' -> ShowS
Prelude.Show, forall x. Rep CreatePartnerInput' x -> CreatePartnerInput'
forall x. CreatePartnerInput' -> Rep CreatePartnerInput' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePartnerInput' x -> CreatePartnerInput'
$cfrom :: forall x. CreatePartnerInput' -> Rep CreatePartnerInput' x
Prelude.Generic)

-- |
-- Create a value of 'CreatePartnerInput'' 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:
--
-- 'requestId', 'createPartnerInput'_requestId' - Unique identifier of the request to ensure the request is handled
-- exactly once in case of retries.
--
-- 'tags', 'createPartnerInput'_tags' - A collection of key-value pairs.
--
-- 'inputId', 'createPartnerInput'_inputId' - Unique ID of the input.
newCreatePartnerInput' ::
  -- | 'inputId'
  Prelude.Text ->
  CreatePartnerInput'
newCreatePartnerInput' :: Text -> CreatePartnerInput'
newCreatePartnerInput' Text
pInputId_ =
  CreatePartnerInput''
    { $sel:requestId:CreatePartnerInput'' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreatePartnerInput'' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:inputId:CreatePartnerInput'' :: Text
inputId = Text
pInputId_
    }

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

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

-- | Unique ID of the input.
createPartnerInput'_inputId :: Lens.Lens' CreatePartnerInput' Prelude.Text
createPartnerInput'_inputId :: Lens' CreatePartnerInput' Text
createPartnerInput'_inputId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePartnerInput'' {Text
inputId :: Text
$sel:inputId:CreatePartnerInput'' :: CreatePartnerInput' -> Text
inputId} -> Text
inputId) (\s :: CreatePartnerInput'
s@CreatePartnerInput'' {} Text
a -> CreatePartnerInput'
s {$sel:inputId:CreatePartnerInput'' :: Text
inputId = Text
a} :: CreatePartnerInput')

instance Core.AWSRequest CreatePartnerInput' where
  type
    AWSResponse CreatePartnerInput' =
      CreatePartnerInputResponse
  request :: (Service -> Service)
-> CreatePartnerInput' -> Request CreatePartnerInput'
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 CreatePartnerInput'
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreatePartnerInput')))
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 -> CreatePartnerInputResponse
CreatePartnerInputResponse'
            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 CreatePartnerInput' where
  hashWithSalt :: Int -> CreatePartnerInput' -> Int
hashWithSalt Int
_salt CreatePartnerInput'' {Maybe Text
Maybe (HashMap Text Text)
Text
inputId :: Text
tags :: Maybe (HashMap Text Text)
requestId :: Maybe Text
$sel:inputId:CreatePartnerInput'' :: CreatePartnerInput' -> Text
$sel:tags:CreatePartnerInput'' :: CreatePartnerInput' -> Maybe (HashMap Text Text)
$sel:requestId:CreatePartnerInput'' :: CreatePartnerInput' -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
requestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
inputId

instance Prelude.NFData CreatePartnerInput' where
  rnf :: CreatePartnerInput' -> ()
rnf CreatePartnerInput'' {Maybe Text
Maybe (HashMap Text Text)
Text
inputId :: Text
tags :: Maybe (HashMap Text Text)
requestId :: Maybe Text
$sel:inputId:CreatePartnerInput'' :: CreatePartnerInput' -> Text
$sel:tags:CreatePartnerInput'' :: CreatePartnerInput' -> Maybe (HashMap Text Text)
$sel:requestId:CreatePartnerInput'' :: CreatePartnerInput' -> Maybe Text
..} =
    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 (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
inputId

instance Data.ToHeaders CreatePartnerInput' where
  toHeaders :: CreatePartnerInput' -> 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 CreatePartnerInput' where
  toJSON :: CreatePartnerInput' -> Value
toJSON CreatePartnerInput'' {Maybe Text
Maybe (HashMap Text Text)
Text
inputId :: Text
tags :: Maybe (HashMap Text Text)
requestId :: Maybe Text
$sel:inputId:CreatePartnerInput'' :: CreatePartnerInput' -> Text
$sel:tags:CreatePartnerInput'' :: CreatePartnerInput' -> Maybe (HashMap Text Text)
$sel:requestId:CreatePartnerInput'' :: CreatePartnerInput' -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"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
          ]
      )

instance Data.ToPath CreatePartnerInput' where
  toPath :: CreatePartnerInput' -> ByteString
toPath CreatePartnerInput'' {Maybe Text
Maybe (HashMap Text Text)
Text
inputId :: Text
tags :: Maybe (HashMap Text Text)
requestId :: Maybe Text
$sel:inputId:CreatePartnerInput'' :: CreatePartnerInput' -> Text
$sel:tags:CreatePartnerInput'' :: CreatePartnerInput' -> Maybe (HashMap Text Text)
$sel:requestId:CreatePartnerInput'' :: CreatePartnerInput' -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/prod/inputs/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
inputId, ByteString
"/partners"]

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

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

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

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

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

instance Prelude.NFData CreatePartnerInputResponse where
  rnf :: CreatePartnerInputResponse -> ()
rnf CreatePartnerInputResponse' {Int
Maybe Input
httpStatus :: Int
input :: Maybe Input
$sel:httpStatus:CreatePartnerInputResponse' :: CreatePartnerInputResponse -> Int
$sel:input:CreatePartnerInputResponse' :: CreatePartnerInputResponse -> 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