{-# 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.AppFlow.CreateFlow
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables your application to create a new flow using Amazon AppFlow. You
-- must create a connector profile before calling this API. Please note
-- that the Request Syntax below shows syntax for multiple destinations,
-- however, you can only transfer data to one item in this list at a time.
-- Amazon AppFlow does not currently support flows to multiple destinations
-- at once.
module Amazonka.AppFlow.CreateFlow
  ( -- * Creating a Request
    CreateFlow (..),
    newCreateFlow,

    -- * Request Lenses
    createFlow_description,
    createFlow_kmsArn,
    createFlow_metadataCatalogConfig,
    createFlow_tags,
    createFlow_flowName,
    createFlow_triggerConfig,
    createFlow_sourceFlowConfig,
    createFlow_destinationFlowConfigList,
    createFlow_tasks,

    -- * Destructuring the Response
    CreateFlowResponse (..),
    newCreateFlowResponse,

    -- * Response Lenses
    createFlowResponse_flowArn,
    createFlowResponse_flowStatus,
    createFlowResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateFlow' smart constructor.
data CreateFlow = CreateFlow'
  { -- | A description of the flow you want to create.
    CreateFlow -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The ARN (Amazon Resource Name) of the Key Management Service (KMS) key
    -- you provide for encryption. This is required if you do not want to use
    -- the Amazon AppFlow-managed KMS key. If you don\'t provide anything here,
    -- Amazon AppFlow uses the Amazon AppFlow-managed KMS key.
    CreateFlow -> Maybe Text
kmsArn :: Prelude.Maybe Prelude.Text,
    -- | Specifies the configuration that Amazon AppFlow uses when it catalogs
    -- the data that\'s transferred by the associated flow. When Amazon AppFlow
    -- catalogs the data from a flow, it stores metadata in a data catalog.
    CreateFlow -> Maybe MetadataCatalogConfig
metadataCatalogConfig :: Prelude.Maybe MetadataCatalogConfig,
    -- | The tags used to organize, track, or control access for your flow.
    CreateFlow -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The specified name of the flow. Spaces are not allowed. Use underscores
    -- (_) or hyphens (-) only.
    CreateFlow -> Text
flowName :: Prelude.Text,
    -- | The trigger settings that determine how and when the flow runs.
    CreateFlow -> TriggerConfig
triggerConfig :: TriggerConfig,
    -- | The configuration that controls how Amazon AppFlow retrieves data from
    -- the source connector.
    CreateFlow -> SourceFlowConfig
sourceFlowConfig :: SourceFlowConfig,
    -- | The configuration that controls how Amazon AppFlow places data in the
    -- destination connector.
    CreateFlow -> [DestinationFlowConfig]
destinationFlowConfigList :: [DestinationFlowConfig],
    -- | A list of tasks that Amazon AppFlow performs while transferring the data
    -- in the flow run.
    CreateFlow -> [Task]
tasks :: [Task]
  }
  deriving (CreateFlow -> CreateFlow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFlow -> CreateFlow -> Bool
$c/= :: CreateFlow -> CreateFlow -> Bool
== :: CreateFlow -> CreateFlow -> Bool
$c== :: CreateFlow -> CreateFlow -> Bool
Prelude.Eq, ReadPrec [CreateFlow]
ReadPrec CreateFlow
Int -> ReadS CreateFlow
ReadS [CreateFlow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFlow]
$creadListPrec :: ReadPrec [CreateFlow]
readPrec :: ReadPrec CreateFlow
$creadPrec :: ReadPrec CreateFlow
readList :: ReadS [CreateFlow]
$creadList :: ReadS [CreateFlow]
readsPrec :: Int -> ReadS CreateFlow
$creadsPrec :: Int -> ReadS CreateFlow
Prelude.Read, Int -> CreateFlow -> ShowS
[CreateFlow] -> ShowS
CreateFlow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFlow] -> ShowS
$cshowList :: [CreateFlow] -> ShowS
show :: CreateFlow -> String
$cshow :: CreateFlow -> String
showsPrec :: Int -> CreateFlow -> ShowS
$cshowsPrec :: Int -> CreateFlow -> ShowS
Prelude.Show, forall x. Rep CreateFlow x -> CreateFlow
forall x. CreateFlow -> Rep CreateFlow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFlow x -> CreateFlow
$cfrom :: forall x. CreateFlow -> Rep CreateFlow x
Prelude.Generic)

-- |
-- Create a value of 'CreateFlow' 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:
--
-- 'description', 'createFlow_description' - A description of the flow you want to create.
--
-- 'kmsArn', 'createFlow_kmsArn' - The ARN (Amazon Resource Name) of the Key Management Service (KMS) key
-- you provide for encryption. This is required if you do not want to use
-- the Amazon AppFlow-managed KMS key. If you don\'t provide anything here,
-- Amazon AppFlow uses the Amazon AppFlow-managed KMS key.
--
-- 'metadataCatalogConfig', 'createFlow_metadataCatalogConfig' - Specifies the configuration that Amazon AppFlow uses when it catalogs
-- the data that\'s transferred by the associated flow. When Amazon AppFlow
-- catalogs the data from a flow, it stores metadata in a data catalog.
--
-- 'tags', 'createFlow_tags' - The tags used to organize, track, or control access for your flow.
--
-- 'flowName', 'createFlow_flowName' - The specified name of the flow. Spaces are not allowed. Use underscores
-- (_) or hyphens (-) only.
--
-- 'triggerConfig', 'createFlow_triggerConfig' - The trigger settings that determine how and when the flow runs.
--
-- 'sourceFlowConfig', 'createFlow_sourceFlowConfig' - The configuration that controls how Amazon AppFlow retrieves data from
-- the source connector.
--
-- 'destinationFlowConfigList', 'createFlow_destinationFlowConfigList' - The configuration that controls how Amazon AppFlow places data in the
-- destination connector.
--
-- 'tasks', 'createFlow_tasks' - A list of tasks that Amazon AppFlow performs while transferring the data
-- in the flow run.
newCreateFlow ::
  -- | 'flowName'
  Prelude.Text ->
  -- | 'triggerConfig'
  TriggerConfig ->
  -- | 'sourceFlowConfig'
  SourceFlowConfig ->
  CreateFlow
newCreateFlow :: Text -> TriggerConfig -> SourceFlowConfig -> CreateFlow
newCreateFlow
  Text
pFlowName_
  TriggerConfig
pTriggerConfig_
  SourceFlowConfig
pSourceFlowConfig_ =
    CreateFlow'
      { $sel:description:CreateFlow' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsArn:CreateFlow' :: Maybe Text
kmsArn = forall a. Maybe a
Prelude.Nothing,
        $sel:metadataCatalogConfig:CreateFlow' :: Maybe MetadataCatalogConfig
metadataCatalogConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateFlow' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:flowName:CreateFlow' :: Text
flowName = Text
pFlowName_,
        $sel:triggerConfig:CreateFlow' :: TriggerConfig
triggerConfig = TriggerConfig
pTriggerConfig_,
        $sel:sourceFlowConfig:CreateFlow' :: SourceFlowConfig
sourceFlowConfig = SourceFlowConfig
pSourceFlowConfig_,
        $sel:destinationFlowConfigList:CreateFlow' :: [DestinationFlowConfig]
destinationFlowConfigList = forall a. Monoid a => a
Prelude.mempty,
        $sel:tasks:CreateFlow' :: [Task]
tasks = forall a. Monoid a => a
Prelude.mempty
      }

-- | A description of the flow you want to create.
createFlow_description :: Lens.Lens' CreateFlow (Prelude.Maybe Prelude.Text)
createFlow_description :: Lens' CreateFlow (Maybe Text)
createFlow_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlow' {Maybe Text
description :: Maybe Text
$sel:description:CreateFlow' :: CreateFlow -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateFlow
s@CreateFlow' {} Maybe Text
a -> CreateFlow
s {$sel:description:CreateFlow' :: Maybe Text
description = Maybe Text
a} :: CreateFlow)

-- | The ARN (Amazon Resource Name) of the Key Management Service (KMS) key
-- you provide for encryption. This is required if you do not want to use
-- the Amazon AppFlow-managed KMS key. If you don\'t provide anything here,
-- Amazon AppFlow uses the Amazon AppFlow-managed KMS key.
createFlow_kmsArn :: Lens.Lens' CreateFlow (Prelude.Maybe Prelude.Text)
createFlow_kmsArn :: Lens' CreateFlow (Maybe Text)
createFlow_kmsArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlow' {Maybe Text
kmsArn :: Maybe Text
$sel:kmsArn:CreateFlow' :: CreateFlow -> Maybe Text
kmsArn} -> Maybe Text
kmsArn) (\s :: CreateFlow
s@CreateFlow' {} Maybe Text
a -> CreateFlow
s {$sel:kmsArn:CreateFlow' :: Maybe Text
kmsArn = Maybe Text
a} :: CreateFlow)

-- | Specifies the configuration that Amazon AppFlow uses when it catalogs
-- the data that\'s transferred by the associated flow. When Amazon AppFlow
-- catalogs the data from a flow, it stores metadata in a data catalog.
createFlow_metadataCatalogConfig :: Lens.Lens' CreateFlow (Prelude.Maybe MetadataCatalogConfig)
createFlow_metadataCatalogConfig :: Lens' CreateFlow (Maybe MetadataCatalogConfig)
createFlow_metadataCatalogConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlow' {Maybe MetadataCatalogConfig
metadataCatalogConfig :: Maybe MetadataCatalogConfig
$sel:metadataCatalogConfig:CreateFlow' :: CreateFlow -> Maybe MetadataCatalogConfig
metadataCatalogConfig} -> Maybe MetadataCatalogConfig
metadataCatalogConfig) (\s :: CreateFlow
s@CreateFlow' {} Maybe MetadataCatalogConfig
a -> CreateFlow
s {$sel:metadataCatalogConfig:CreateFlow' :: Maybe MetadataCatalogConfig
metadataCatalogConfig = Maybe MetadataCatalogConfig
a} :: CreateFlow)

-- | The tags used to organize, track, or control access for your flow.
createFlow_tags :: Lens.Lens' CreateFlow (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createFlow_tags :: Lens' CreateFlow (Maybe (HashMap Text Text))
createFlow_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlow' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateFlow' :: CreateFlow -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateFlow
s@CreateFlow' {} Maybe (HashMap Text Text)
a -> CreateFlow
s {$sel:tags:CreateFlow' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateFlow) 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 specified name of the flow. Spaces are not allowed. Use underscores
-- (_) or hyphens (-) only.
createFlow_flowName :: Lens.Lens' CreateFlow Prelude.Text
createFlow_flowName :: Lens' CreateFlow Text
createFlow_flowName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlow' {Text
flowName :: Text
$sel:flowName:CreateFlow' :: CreateFlow -> Text
flowName} -> Text
flowName) (\s :: CreateFlow
s@CreateFlow' {} Text
a -> CreateFlow
s {$sel:flowName:CreateFlow' :: Text
flowName = Text
a} :: CreateFlow)

-- | The trigger settings that determine how and when the flow runs.
createFlow_triggerConfig :: Lens.Lens' CreateFlow TriggerConfig
createFlow_triggerConfig :: Lens' CreateFlow TriggerConfig
createFlow_triggerConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlow' {TriggerConfig
triggerConfig :: TriggerConfig
$sel:triggerConfig:CreateFlow' :: CreateFlow -> TriggerConfig
triggerConfig} -> TriggerConfig
triggerConfig) (\s :: CreateFlow
s@CreateFlow' {} TriggerConfig
a -> CreateFlow
s {$sel:triggerConfig:CreateFlow' :: TriggerConfig
triggerConfig = TriggerConfig
a} :: CreateFlow)

-- | The configuration that controls how Amazon AppFlow retrieves data from
-- the source connector.
createFlow_sourceFlowConfig :: Lens.Lens' CreateFlow SourceFlowConfig
createFlow_sourceFlowConfig :: Lens' CreateFlow SourceFlowConfig
createFlow_sourceFlowConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlow' {SourceFlowConfig
sourceFlowConfig :: SourceFlowConfig
$sel:sourceFlowConfig:CreateFlow' :: CreateFlow -> SourceFlowConfig
sourceFlowConfig} -> SourceFlowConfig
sourceFlowConfig) (\s :: CreateFlow
s@CreateFlow' {} SourceFlowConfig
a -> CreateFlow
s {$sel:sourceFlowConfig:CreateFlow' :: SourceFlowConfig
sourceFlowConfig = SourceFlowConfig
a} :: CreateFlow)

-- | The configuration that controls how Amazon AppFlow places data in the
-- destination connector.
createFlow_destinationFlowConfigList :: Lens.Lens' CreateFlow [DestinationFlowConfig]
createFlow_destinationFlowConfigList :: Lens' CreateFlow [DestinationFlowConfig]
createFlow_destinationFlowConfigList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlow' {[DestinationFlowConfig]
destinationFlowConfigList :: [DestinationFlowConfig]
$sel:destinationFlowConfigList:CreateFlow' :: CreateFlow -> [DestinationFlowConfig]
destinationFlowConfigList} -> [DestinationFlowConfig]
destinationFlowConfigList) (\s :: CreateFlow
s@CreateFlow' {} [DestinationFlowConfig]
a -> CreateFlow
s {$sel:destinationFlowConfigList:CreateFlow' :: [DestinationFlowConfig]
destinationFlowConfigList = [DestinationFlowConfig]
a} :: CreateFlow) 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

-- | A list of tasks that Amazon AppFlow performs while transferring the data
-- in the flow run.
createFlow_tasks :: Lens.Lens' CreateFlow [Task]
createFlow_tasks :: Lens' CreateFlow [Task]
createFlow_tasks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlow' {[Task]
tasks :: [Task]
$sel:tasks:CreateFlow' :: CreateFlow -> [Task]
tasks} -> [Task]
tasks) (\s :: CreateFlow
s@CreateFlow' {} [Task]
a -> CreateFlow
s {$sel:tasks:CreateFlow' :: [Task]
tasks = [Task]
a} :: CreateFlow) 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 CreateFlow where
  type AWSResponse CreateFlow = CreateFlowResponse
  request :: (Service -> Service) -> CreateFlow -> Request CreateFlow
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 CreateFlow
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateFlow)))
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 FlowStatus -> Int -> CreateFlowResponse
CreateFlowResponse'
            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
"flowStatus")
            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 CreateFlow where
  hashWithSalt :: Int -> CreateFlow -> Int
hashWithSalt Int
_salt CreateFlow' {[Task]
[DestinationFlowConfig]
Maybe Text
Maybe (HashMap Text Text)
Maybe MetadataCatalogConfig
Text
TriggerConfig
SourceFlowConfig
tasks :: [Task]
destinationFlowConfigList :: [DestinationFlowConfig]
sourceFlowConfig :: SourceFlowConfig
triggerConfig :: TriggerConfig
flowName :: Text
tags :: Maybe (HashMap Text Text)
metadataCatalogConfig :: Maybe MetadataCatalogConfig
kmsArn :: Maybe Text
description :: Maybe Text
$sel:tasks:CreateFlow' :: CreateFlow -> [Task]
$sel:destinationFlowConfigList:CreateFlow' :: CreateFlow -> [DestinationFlowConfig]
$sel:sourceFlowConfig:CreateFlow' :: CreateFlow -> SourceFlowConfig
$sel:triggerConfig:CreateFlow' :: CreateFlow -> TriggerConfig
$sel:flowName:CreateFlow' :: CreateFlow -> Text
$sel:tags:CreateFlow' :: CreateFlow -> Maybe (HashMap Text Text)
$sel:metadataCatalogConfig:CreateFlow' :: CreateFlow -> Maybe MetadataCatalogConfig
$sel:kmsArn:CreateFlow' :: CreateFlow -> Maybe Text
$sel:description:CreateFlow' :: CreateFlow -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MetadataCatalogConfig
metadataCatalogConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
flowName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TriggerConfig
triggerConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SourceFlowConfig
sourceFlowConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [DestinationFlowConfig]
destinationFlowConfigList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Task]
tasks

instance Prelude.NFData CreateFlow where
  rnf :: CreateFlow -> ()
rnf CreateFlow' {[Task]
[DestinationFlowConfig]
Maybe Text
Maybe (HashMap Text Text)
Maybe MetadataCatalogConfig
Text
TriggerConfig
SourceFlowConfig
tasks :: [Task]
destinationFlowConfigList :: [DestinationFlowConfig]
sourceFlowConfig :: SourceFlowConfig
triggerConfig :: TriggerConfig
flowName :: Text
tags :: Maybe (HashMap Text Text)
metadataCatalogConfig :: Maybe MetadataCatalogConfig
kmsArn :: Maybe Text
description :: Maybe Text
$sel:tasks:CreateFlow' :: CreateFlow -> [Task]
$sel:destinationFlowConfigList:CreateFlow' :: CreateFlow -> [DestinationFlowConfig]
$sel:sourceFlowConfig:CreateFlow' :: CreateFlow -> SourceFlowConfig
$sel:triggerConfig:CreateFlow' :: CreateFlow -> TriggerConfig
$sel:flowName:CreateFlow' :: CreateFlow -> Text
$sel:tags:CreateFlow' :: CreateFlow -> Maybe (HashMap Text Text)
$sel:metadataCatalogConfig:CreateFlow' :: CreateFlow -> Maybe MetadataCatalogConfig
$sel:kmsArn:CreateFlow' :: CreateFlow -> Maybe Text
$sel:description:CreateFlow' :: CreateFlow -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MetadataCatalogConfig
metadataCatalogConfig
      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
flowName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TriggerConfig
triggerConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SourceFlowConfig
sourceFlowConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [DestinationFlowConfig]
destinationFlowConfigList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Task]
tasks

instance Data.ToHeaders CreateFlow where
  toHeaders :: CreateFlow -> 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 CreateFlow where
  toJSON :: CreateFlow -> Value
toJSON CreateFlow' {[Task]
[DestinationFlowConfig]
Maybe Text
Maybe (HashMap Text Text)
Maybe MetadataCatalogConfig
Text
TriggerConfig
SourceFlowConfig
tasks :: [Task]
destinationFlowConfigList :: [DestinationFlowConfig]
sourceFlowConfig :: SourceFlowConfig
triggerConfig :: TriggerConfig
flowName :: Text
tags :: Maybe (HashMap Text Text)
metadataCatalogConfig :: Maybe MetadataCatalogConfig
kmsArn :: Maybe Text
description :: Maybe Text
$sel:tasks:CreateFlow' :: CreateFlow -> [Task]
$sel:destinationFlowConfigList:CreateFlow' :: CreateFlow -> [DestinationFlowConfig]
$sel:sourceFlowConfig:CreateFlow' :: CreateFlow -> SourceFlowConfig
$sel:triggerConfig:CreateFlow' :: CreateFlow -> TriggerConfig
$sel:flowName:CreateFlow' :: CreateFlow -> Text
$sel:tags:CreateFlow' :: CreateFlow -> Maybe (HashMap Text Text)
$sel:metadataCatalogConfig:CreateFlow' :: CreateFlow -> Maybe MetadataCatalogConfig
$sel:kmsArn:CreateFlow' :: CreateFlow -> Maybe Text
$sel:description:CreateFlow' :: CreateFlow -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" 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
description,
            (Key
"kmsArn" 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
kmsArn,
            (Key
"metadataCatalogConfig" 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 MetadataCatalogConfig
metadataCatalogConfig,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"flowName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
flowName),
            forall a. a -> Maybe a
Prelude.Just (Key
"triggerConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TriggerConfig
triggerConfig),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"sourceFlowConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SourceFlowConfig
sourceFlowConfig),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"destinationFlowConfigList"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [DestinationFlowConfig]
destinationFlowConfigList
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"tasks" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Task]
tasks)
          ]
      )

instance Data.ToPath CreateFlow where
  toPath :: CreateFlow -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/create-flow"

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

-- | /See:/ 'newCreateFlowResponse' smart constructor.
data CreateFlowResponse = CreateFlowResponse'
  { -- | The flow\'s Amazon Resource Name (ARN).
    CreateFlowResponse -> Maybe Text
flowArn :: Prelude.Maybe Prelude.Text,
    -- | Indicates the current status of the flow.
    CreateFlowResponse -> Maybe FlowStatus
flowStatus :: Prelude.Maybe FlowStatus,
    -- | The response's http status code.
    CreateFlowResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateFlowResponse -> CreateFlowResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFlowResponse -> CreateFlowResponse -> Bool
$c/= :: CreateFlowResponse -> CreateFlowResponse -> Bool
== :: CreateFlowResponse -> CreateFlowResponse -> Bool
$c== :: CreateFlowResponse -> CreateFlowResponse -> Bool
Prelude.Eq, ReadPrec [CreateFlowResponse]
ReadPrec CreateFlowResponse
Int -> ReadS CreateFlowResponse
ReadS [CreateFlowResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFlowResponse]
$creadListPrec :: ReadPrec [CreateFlowResponse]
readPrec :: ReadPrec CreateFlowResponse
$creadPrec :: ReadPrec CreateFlowResponse
readList :: ReadS [CreateFlowResponse]
$creadList :: ReadS [CreateFlowResponse]
readsPrec :: Int -> ReadS CreateFlowResponse
$creadsPrec :: Int -> ReadS CreateFlowResponse
Prelude.Read, Int -> CreateFlowResponse -> ShowS
[CreateFlowResponse] -> ShowS
CreateFlowResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFlowResponse] -> ShowS
$cshowList :: [CreateFlowResponse] -> ShowS
show :: CreateFlowResponse -> String
$cshow :: CreateFlowResponse -> String
showsPrec :: Int -> CreateFlowResponse -> ShowS
$cshowsPrec :: Int -> CreateFlowResponse -> ShowS
Prelude.Show, forall x. Rep CreateFlowResponse x -> CreateFlowResponse
forall x. CreateFlowResponse -> Rep CreateFlowResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFlowResponse x -> CreateFlowResponse
$cfrom :: forall x. CreateFlowResponse -> Rep CreateFlowResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateFlowResponse' 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', 'createFlowResponse_flowArn' - The flow\'s Amazon Resource Name (ARN).
--
-- 'flowStatus', 'createFlowResponse_flowStatus' - Indicates the current status of the flow.
--
-- 'httpStatus', 'createFlowResponse_httpStatus' - The response's http status code.
newCreateFlowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateFlowResponse
newCreateFlowResponse :: Int -> CreateFlowResponse
newCreateFlowResponse Int
pHttpStatus_ =
  CreateFlowResponse'
    { $sel:flowArn:CreateFlowResponse' :: Maybe Text
flowArn = forall a. Maybe a
Prelude.Nothing,
      $sel:flowStatus:CreateFlowResponse' :: Maybe FlowStatus
flowStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateFlowResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The flow\'s Amazon Resource Name (ARN).
createFlowResponse_flowArn :: Lens.Lens' CreateFlowResponse (Prelude.Maybe Prelude.Text)
createFlowResponse_flowArn :: Lens' CreateFlowResponse (Maybe Text)
createFlowResponse_flowArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowResponse' {Maybe Text
flowArn :: Maybe Text
$sel:flowArn:CreateFlowResponse' :: CreateFlowResponse -> Maybe Text
flowArn} -> Maybe Text
flowArn) (\s :: CreateFlowResponse
s@CreateFlowResponse' {} Maybe Text
a -> CreateFlowResponse
s {$sel:flowArn:CreateFlowResponse' :: Maybe Text
flowArn = Maybe Text
a} :: CreateFlowResponse)

-- | Indicates the current status of the flow.
createFlowResponse_flowStatus :: Lens.Lens' CreateFlowResponse (Prelude.Maybe FlowStatus)
createFlowResponse_flowStatus :: Lens' CreateFlowResponse (Maybe FlowStatus)
createFlowResponse_flowStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowResponse' {Maybe FlowStatus
flowStatus :: Maybe FlowStatus
$sel:flowStatus:CreateFlowResponse' :: CreateFlowResponse -> Maybe FlowStatus
flowStatus} -> Maybe FlowStatus
flowStatus) (\s :: CreateFlowResponse
s@CreateFlowResponse' {} Maybe FlowStatus
a -> CreateFlowResponse
s {$sel:flowStatus:CreateFlowResponse' :: Maybe FlowStatus
flowStatus = Maybe FlowStatus
a} :: CreateFlowResponse)

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

instance Prelude.NFData CreateFlowResponse where
  rnf :: CreateFlowResponse -> ()
rnf CreateFlowResponse' {Int
Maybe Text
Maybe FlowStatus
httpStatus :: Int
flowStatus :: Maybe FlowStatus
flowArn :: Maybe Text
$sel:httpStatus:CreateFlowResponse' :: CreateFlowResponse -> Int
$sel:flowStatus:CreateFlowResponse' :: CreateFlowResponse -> Maybe FlowStatus
$sel:flowArn:CreateFlowResponse' :: CreateFlowResponse -> 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 FlowStatus
flowStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus