{-# 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.MediaConnect.AddFlowSources
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds Sources to flow
module Amazonka.MediaConnect.AddFlowSources
  ( -- * Creating a Request
    AddFlowSources (..),
    newAddFlowSources,

    -- * Request Lenses
    addFlowSources_flowArn,
    addFlowSources_sources,

    -- * Destructuring the Response
    AddFlowSourcesResponse (..),
    newAddFlowSourcesResponse,

    -- * Response Lenses
    addFlowSourcesResponse_flowArn,
    addFlowSourcesResponse_sources,
    addFlowSourcesResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaConnect.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | A request to add sources to the flow.
--
-- /See:/ 'newAddFlowSources' smart constructor.
data AddFlowSources = AddFlowSources'
  { -- | The flow that you want to mutate.
    AddFlowSources -> Text
flowArn :: Prelude.Text,
    -- | A list of sources that you want to add.
    AddFlowSources -> [SetSourceRequest]
sources :: [SetSourceRequest]
  }
  deriving (AddFlowSources -> AddFlowSources -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddFlowSources -> AddFlowSources -> Bool
$c/= :: AddFlowSources -> AddFlowSources -> Bool
== :: AddFlowSources -> AddFlowSources -> Bool
$c== :: AddFlowSources -> AddFlowSources -> Bool
Prelude.Eq, ReadPrec [AddFlowSources]
ReadPrec AddFlowSources
Int -> ReadS AddFlowSources
ReadS [AddFlowSources]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddFlowSources]
$creadListPrec :: ReadPrec [AddFlowSources]
readPrec :: ReadPrec AddFlowSources
$creadPrec :: ReadPrec AddFlowSources
readList :: ReadS [AddFlowSources]
$creadList :: ReadS [AddFlowSources]
readsPrec :: Int -> ReadS AddFlowSources
$creadsPrec :: Int -> ReadS AddFlowSources
Prelude.Read, Int -> AddFlowSources -> ShowS
[AddFlowSources] -> ShowS
AddFlowSources -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddFlowSources] -> ShowS
$cshowList :: [AddFlowSources] -> ShowS
show :: AddFlowSources -> String
$cshow :: AddFlowSources -> String
showsPrec :: Int -> AddFlowSources -> ShowS
$cshowsPrec :: Int -> AddFlowSources -> ShowS
Prelude.Show, forall x. Rep AddFlowSources x -> AddFlowSources
forall x. AddFlowSources -> Rep AddFlowSources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddFlowSources x -> AddFlowSources
$cfrom :: forall x. AddFlowSources -> Rep AddFlowSources x
Prelude.Generic)

-- |
-- Create a value of 'AddFlowSources' 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:
--
-- 'flowArn', 'addFlowSources_flowArn' - The flow that you want to mutate.
--
-- 'sources', 'addFlowSources_sources' - A list of sources that you want to add.
newAddFlowSources ::
  -- | 'flowArn'
  Prelude.Text ->
  AddFlowSources
newAddFlowSources :: Text -> AddFlowSources
newAddFlowSources Text
pFlowArn_ =
  AddFlowSources'
    { $sel:flowArn:AddFlowSources' :: Text
flowArn = Text
pFlowArn_,
      $sel:sources:AddFlowSources' :: [SetSourceRequest]
sources = forall a. Monoid a => a
Prelude.mempty
    }

-- | The flow that you want to mutate.
addFlowSources_flowArn :: Lens.Lens' AddFlowSources Prelude.Text
addFlowSources_flowArn :: Lens' AddFlowSources Text
addFlowSources_flowArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddFlowSources' {Text
flowArn :: Text
$sel:flowArn:AddFlowSources' :: AddFlowSources -> Text
flowArn} -> Text
flowArn) (\s :: AddFlowSources
s@AddFlowSources' {} Text
a -> AddFlowSources
s {$sel:flowArn:AddFlowSources' :: Text
flowArn = Text
a} :: AddFlowSources)

-- | A list of sources that you want to add.
addFlowSources_sources :: Lens.Lens' AddFlowSources [SetSourceRequest]
addFlowSources_sources :: Lens' AddFlowSources [SetSourceRequest]
addFlowSources_sources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddFlowSources' {[SetSourceRequest]
sources :: [SetSourceRequest]
$sel:sources:AddFlowSources' :: AddFlowSources -> [SetSourceRequest]
sources} -> [SetSourceRequest]
sources) (\s :: AddFlowSources
s@AddFlowSources' {} [SetSourceRequest]
a -> AddFlowSources
s {$sel:sources:AddFlowSources' :: [SetSourceRequest]
sources = [SetSourceRequest]
a} :: AddFlowSources) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest AddFlowSources where
  type
    AWSResponse AddFlowSources =
      AddFlowSourcesResponse
  request :: (Service -> Service) -> AddFlowSources -> Request AddFlowSources
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 AddFlowSources
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AddFlowSources)))
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 Text -> Maybe [Source] -> Int -> AddFlowSourcesResponse
AddFlowSourcesResponse'
            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
"flowArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"sources" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 AddFlowSources where
  hashWithSalt :: Int -> AddFlowSources -> Int
hashWithSalt Int
_salt AddFlowSources' {[SetSourceRequest]
Text
sources :: [SetSourceRequest]
flowArn :: Text
$sel:sources:AddFlowSources' :: AddFlowSources -> [SetSourceRequest]
$sel:flowArn:AddFlowSources' :: AddFlowSources -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
flowArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [SetSourceRequest]
sources

instance Prelude.NFData AddFlowSources where
  rnf :: AddFlowSources -> ()
rnf AddFlowSources' {[SetSourceRequest]
Text
sources :: [SetSourceRequest]
flowArn :: Text
$sel:sources:AddFlowSources' :: AddFlowSources -> [SetSourceRequest]
$sel:flowArn:AddFlowSources' :: AddFlowSources -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
flowArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [SetSourceRequest]
sources

instance Data.ToHeaders AddFlowSources where
  toHeaders :: AddFlowSources -> 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 AddFlowSources where
  toJSON :: AddFlowSources -> Value
toJSON AddFlowSources' {[SetSourceRequest]
Text
sources :: [SetSourceRequest]
flowArn :: Text
$sel:sources:AddFlowSources' :: AddFlowSources -> [SetSourceRequest]
$sel:flowArn:AddFlowSources' :: AddFlowSources -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"sources" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [SetSourceRequest]
sources)]
      )

instance Data.ToPath AddFlowSources where
  toPath :: AddFlowSources -> ByteString
toPath AddFlowSources' {[SetSourceRequest]
Text
sources :: [SetSourceRequest]
flowArn :: Text
$sel:sources:AddFlowSources' :: AddFlowSources -> [SetSourceRequest]
$sel:flowArn:AddFlowSources' :: AddFlowSources -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/v1/flows/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
flowArn, ByteString
"/source"]

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

-- | /See:/ 'newAddFlowSourcesResponse' smart constructor.
data AddFlowSourcesResponse = AddFlowSourcesResponse'
  { -- | The ARN of the flow that these sources were added to.
    AddFlowSourcesResponse -> Maybe Text
flowArn :: Prelude.Maybe Prelude.Text,
    -- | The details of the newly added sources.
    AddFlowSourcesResponse -> Maybe [Source]
sources :: Prelude.Maybe [Source],
    -- | The response's http status code.
    AddFlowSourcesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AddFlowSourcesResponse -> AddFlowSourcesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddFlowSourcesResponse -> AddFlowSourcesResponse -> Bool
$c/= :: AddFlowSourcesResponse -> AddFlowSourcesResponse -> Bool
== :: AddFlowSourcesResponse -> AddFlowSourcesResponse -> Bool
$c== :: AddFlowSourcesResponse -> AddFlowSourcesResponse -> Bool
Prelude.Eq, ReadPrec [AddFlowSourcesResponse]
ReadPrec AddFlowSourcesResponse
Int -> ReadS AddFlowSourcesResponse
ReadS [AddFlowSourcesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddFlowSourcesResponse]
$creadListPrec :: ReadPrec [AddFlowSourcesResponse]
readPrec :: ReadPrec AddFlowSourcesResponse
$creadPrec :: ReadPrec AddFlowSourcesResponse
readList :: ReadS [AddFlowSourcesResponse]
$creadList :: ReadS [AddFlowSourcesResponse]
readsPrec :: Int -> ReadS AddFlowSourcesResponse
$creadsPrec :: Int -> ReadS AddFlowSourcesResponse
Prelude.Read, Int -> AddFlowSourcesResponse -> ShowS
[AddFlowSourcesResponse] -> ShowS
AddFlowSourcesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddFlowSourcesResponse] -> ShowS
$cshowList :: [AddFlowSourcesResponse] -> ShowS
show :: AddFlowSourcesResponse -> String
$cshow :: AddFlowSourcesResponse -> String
showsPrec :: Int -> AddFlowSourcesResponse -> ShowS
$cshowsPrec :: Int -> AddFlowSourcesResponse -> ShowS
Prelude.Show, forall x. Rep AddFlowSourcesResponse x -> AddFlowSourcesResponse
forall x. AddFlowSourcesResponse -> Rep AddFlowSourcesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddFlowSourcesResponse x -> AddFlowSourcesResponse
$cfrom :: forall x. AddFlowSourcesResponse -> Rep AddFlowSourcesResponse x
Prelude.Generic)

-- |
-- Create a value of 'AddFlowSourcesResponse' 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:
--
-- 'flowArn', 'addFlowSourcesResponse_flowArn' - The ARN of the flow that these sources were added to.
--
-- 'sources', 'addFlowSourcesResponse_sources' - The details of the newly added sources.
--
-- 'httpStatus', 'addFlowSourcesResponse_httpStatus' - The response's http status code.
newAddFlowSourcesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddFlowSourcesResponse
newAddFlowSourcesResponse :: Int -> AddFlowSourcesResponse
newAddFlowSourcesResponse Int
pHttpStatus_ =
  AddFlowSourcesResponse'
    { $sel:flowArn:AddFlowSourcesResponse' :: Maybe Text
flowArn = forall a. Maybe a
Prelude.Nothing,
      $sel:sources:AddFlowSourcesResponse' :: Maybe [Source]
sources = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AddFlowSourcesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the flow that these sources were added to.
addFlowSourcesResponse_flowArn :: Lens.Lens' AddFlowSourcesResponse (Prelude.Maybe Prelude.Text)
addFlowSourcesResponse_flowArn :: Lens' AddFlowSourcesResponse (Maybe Text)
addFlowSourcesResponse_flowArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddFlowSourcesResponse' {Maybe Text
flowArn :: Maybe Text
$sel:flowArn:AddFlowSourcesResponse' :: AddFlowSourcesResponse -> Maybe Text
flowArn} -> Maybe Text
flowArn) (\s :: AddFlowSourcesResponse
s@AddFlowSourcesResponse' {} Maybe Text
a -> AddFlowSourcesResponse
s {$sel:flowArn:AddFlowSourcesResponse' :: Maybe Text
flowArn = Maybe Text
a} :: AddFlowSourcesResponse)

-- | The details of the newly added sources.
addFlowSourcesResponse_sources :: Lens.Lens' AddFlowSourcesResponse (Prelude.Maybe [Source])
addFlowSourcesResponse_sources :: Lens' AddFlowSourcesResponse (Maybe [Source])
addFlowSourcesResponse_sources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddFlowSourcesResponse' {Maybe [Source]
sources :: Maybe [Source]
$sel:sources:AddFlowSourcesResponse' :: AddFlowSourcesResponse -> Maybe [Source]
sources} -> Maybe [Source]
sources) (\s :: AddFlowSourcesResponse
s@AddFlowSourcesResponse' {} Maybe [Source]
a -> AddFlowSourcesResponse
s {$sel:sources:AddFlowSourcesResponse' :: Maybe [Source]
sources = Maybe [Source]
a} :: AddFlowSourcesResponse) 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 response's http status code.
addFlowSourcesResponse_httpStatus :: Lens.Lens' AddFlowSourcesResponse Prelude.Int
addFlowSourcesResponse_httpStatus :: Lens' AddFlowSourcesResponse Int
addFlowSourcesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddFlowSourcesResponse' {Int
httpStatus :: Int
$sel:httpStatus:AddFlowSourcesResponse' :: AddFlowSourcesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: AddFlowSourcesResponse
s@AddFlowSourcesResponse' {} Int
a -> AddFlowSourcesResponse
s {$sel:httpStatus:AddFlowSourcesResponse' :: Int
httpStatus = Int
a} :: AddFlowSourcesResponse)

instance Prelude.NFData AddFlowSourcesResponse where
  rnf :: AddFlowSourcesResponse -> ()
rnf AddFlowSourcesResponse' {Int
Maybe [Source]
Maybe Text
httpStatus :: Int
sources :: Maybe [Source]
flowArn :: Maybe Text
$sel:httpStatus:AddFlowSourcesResponse' :: AddFlowSourcesResponse -> Int
$sel:sources:AddFlowSourcesResponse' :: AddFlowSourcesResponse -> Maybe [Source]
$sel:flowArn:AddFlowSourcesResponse' :: AddFlowSourcesResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
flowArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Source]
sources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus