{-# 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.SageMaker.CreateFlowDefinition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a flow definition.
module Amazonka.SageMaker.CreateFlowDefinition
  ( -- * Creating a Request
    CreateFlowDefinition (..),
    newCreateFlowDefinition,

    -- * Request Lenses
    createFlowDefinition_humanLoopActivationConfig,
    createFlowDefinition_humanLoopRequestSource,
    createFlowDefinition_tags,
    createFlowDefinition_flowDefinitionName,
    createFlowDefinition_humanLoopConfig,
    createFlowDefinition_outputConfig,
    createFlowDefinition_roleArn,

    -- * Destructuring the Response
    CreateFlowDefinitionResponse (..),
    newCreateFlowDefinitionResponse,

    -- * Response Lenses
    createFlowDefinitionResponse_httpStatus,
    createFlowDefinitionResponse_flowDefinitionArn,
  )
where

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
import Amazonka.SageMaker.Types

-- | /See:/ 'newCreateFlowDefinition' smart constructor.
data CreateFlowDefinition = CreateFlowDefinition'
  { -- | An object containing information about the events that trigger a human
    -- workflow.
    CreateFlowDefinition -> Maybe HumanLoopActivationConfig
humanLoopActivationConfig :: Prelude.Maybe HumanLoopActivationConfig,
    -- | Container for configuring the source of human task requests. Use to
    -- specify if Amazon Rekognition or Amazon Textract is used as an
    -- integration source.
    CreateFlowDefinition -> Maybe HumanLoopRequestSource
humanLoopRequestSource :: Prelude.Maybe HumanLoopRequestSource,
    -- | An array of key-value pairs that contain metadata to help you categorize
    -- and organize a flow definition. Each tag consists of a key and a value,
    -- both of which you define.
    CreateFlowDefinition -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of your flow definition.
    CreateFlowDefinition -> Text
flowDefinitionName :: Prelude.Text,
    -- | An object containing information about the tasks the human reviewers
    -- will perform.
    CreateFlowDefinition -> HumanLoopConfig
humanLoopConfig :: HumanLoopConfig,
    -- | An object containing information about where the human review results
    -- will be uploaded.
    CreateFlowDefinition -> FlowDefinitionOutputConfig
outputConfig :: FlowDefinitionOutputConfig,
    -- | The Amazon Resource Name (ARN) of the role needed to call other services
    -- on your behalf. For example,
    -- @arn:aws:iam::1234567890:role\/service-role\/AmazonSageMaker-ExecutionRole-20180111T151298@.
    CreateFlowDefinition -> Text
roleArn :: Prelude.Text
  }
  deriving (CreateFlowDefinition -> CreateFlowDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFlowDefinition -> CreateFlowDefinition -> Bool
$c/= :: CreateFlowDefinition -> CreateFlowDefinition -> Bool
== :: CreateFlowDefinition -> CreateFlowDefinition -> Bool
$c== :: CreateFlowDefinition -> CreateFlowDefinition -> Bool
Prelude.Eq, ReadPrec [CreateFlowDefinition]
ReadPrec CreateFlowDefinition
Int -> ReadS CreateFlowDefinition
ReadS [CreateFlowDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFlowDefinition]
$creadListPrec :: ReadPrec [CreateFlowDefinition]
readPrec :: ReadPrec CreateFlowDefinition
$creadPrec :: ReadPrec CreateFlowDefinition
readList :: ReadS [CreateFlowDefinition]
$creadList :: ReadS [CreateFlowDefinition]
readsPrec :: Int -> ReadS CreateFlowDefinition
$creadsPrec :: Int -> ReadS CreateFlowDefinition
Prelude.Read, Int -> CreateFlowDefinition -> ShowS
[CreateFlowDefinition] -> ShowS
CreateFlowDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFlowDefinition] -> ShowS
$cshowList :: [CreateFlowDefinition] -> ShowS
show :: CreateFlowDefinition -> String
$cshow :: CreateFlowDefinition -> String
showsPrec :: Int -> CreateFlowDefinition -> ShowS
$cshowsPrec :: Int -> CreateFlowDefinition -> ShowS
Prelude.Show, forall x. Rep CreateFlowDefinition x -> CreateFlowDefinition
forall x. CreateFlowDefinition -> Rep CreateFlowDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFlowDefinition x -> CreateFlowDefinition
$cfrom :: forall x. CreateFlowDefinition -> Rep CreateFlowDefinition x
Prelude.Generic)

-- |
-- Create a value of 'CreateFlowDefinition' 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:
--
-- 'humanLoopActivationConfig', 'createFlowDefinition_humanLoopActivationConfig' - An object containing information about the events that trigger a human
-- workflow.
--
-- 'humanLoopRequestSource', 'createFlowDefinition_humanLoopRequestSource' - Container for configuring the source of human task requests. Use to
-- specify if Amazon Rekognition or Amazon Textract is used as an
-- integration source.
--
-- 'tags', 'createFlowDefinition_tags' - An array of key-value pairs that contain metadata to help you categorize
-- and organize a flow definition. Each tag consists of a key and a value,
-- both of which you define.
--
-- 'flowDefinitionName', 'createFlowDefinition_flowDefinitionName' - The name of your flow definition.
--
-- 'humanLoopConfig', 'createFlowDefinition_humanLoopConfig' - An object containing information about the tasks the human reviewers
-- will perform.
--
-- 'outputConfig', 'createFlowDefinition_outputConfig' - An object containing information about where the human review results
-- will be uploaded.
--
-- 'roleArn', 'createFlowDefinition_roleArn' - The Amazon Resource Name (ARN) of the role needed to call other services
-- on your behalf. For example,
-- @arn:aws:iam::1234567890:role\/service-role\/AmazonSageMaker-ExecutionRole-20180111T151298@.
newCreateFlowDefinition ::
  -- | 'flowDefinitionName'
  Prelude.Text ->
  -- | 'humanLoopConfig'
  HumanLoopConfig ->
  -- | 'outputConfig'
  FlowDefinitionOutputConfig ->
  -- | 'roleArn'
  Prelude.Text ->
  CreateFlowDefinition
newCreateFlowDefinition :: Text
-> HumanLoopConfig
-> FlowDefinitionOutputConfig
-> Text
-> CreateFlowDefinition
newCreateFlowDefinition
  Text
pFlowDefinitionName_
  HumanLoopConfig
pHumanLoopConfig_
  FlowDefinitionOutputConfig
pOutputConfig_
  Text
pRoleArn_ =
    CreateFlowDefinition'
      { $sel:humanLoopActivationConfig:CreateFlowDefinition' :: Maybe HumanLoopActivationConfig
humanLoopActivationConfig =
          forall a. Maybe a
Prelude.Nothing,
        $sel:humanLoopRequestSource:CreateFlowDefinition' :: Maybe HumanLoopRequestSource
humanLoopRequestSource = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateFlowDefinition' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:flowDefinitionName:CreateFlowDefinition' :: Text
flowDefinitionName = Text
pFlowDefinitionName_,
        $sel:humanLoopConfig:CreateFlowDefinition' :: HumanLoopConfig
humanLoopConfig = HumanLoopConfig
pHumanLoopConfig_,
        $sel:outputConfig:CreateFlowDefinition' :: FlowDefinitionOutputConfig
outputConfig = FlowDefinitionOutputConfig
pOutputConfig_,
        $sel:roleArn:CreateFlowDefinition' :: Text
roleArn = Text
pRoleArn_
      }

-- | An object containing information about the events that trigger a human
-- workflow.
createFlowDefinition_humanLoopActivationConfig :: Lens.Lens' CreateFlowDefinition (Prelude.Maybe HumanLoopActivationConfig)
createFlowDefinition_humanLoopActivationConfig :: Lens' CreateFlowDefinition (Maybe HumanLoopActivationConfig)
createFlowDefinition_humanLoopActivationConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowDefinition' {Maybe HumanLoopActivationConfig
humanLoopActivationConfig :: Maybe HumanLoopActivationConfig
$sel:humanLoopActivationConfig:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe HumanLoopActivationConfig
humanLoopActivationConfig} -> Maybe HumanLoopActivationConfig
humanLoopActivationConfig) (\s :: CreateFlowDefinition
s@CreateFlowDefinition' {} Maybe HumanLoopActivationConfig
a -> CreateFlowDefinition
s {$sel:humanLoopActivationConfig:CreateFlowDefinition' :: Maybe HumanLoopActivationConfig
humanLoopActivationConfig = Maybe HumanLoopActivationConfig
a} :: CreateFlowDefinition)

-- | Container for configuring the source of human task requests. Use to
-- specify if Amazon Rekognition or Amazon Textract is used as an
-- integration source.
createFlowDefinition_humanLoopRequestSource :: Lens.Lens' CreateFlowDefinition (Prelude.Maybe HumanLoopRequestSource)
createFlowDefinition_humanLoopRequestSource :: Lens' CreateFlowDefinition (Maybe HumanLoopRequestSource)
createFlowDefinition_humanLoopRequestSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowDefinition' {Maybe HumanLoopRequestSource
humanLoopRequestSource :: Maybe HumanLoopRequestSource
$sel:humanLoopRequestSource:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe HumanLoopRequestSource
humanLoopRequestSource} -> Maybe HumanLoopRequestSource
humanLoopRequestSource) (\s :: CreateFlowDefinition
s@CreateFlowDefinition' {} Maybe HumanLoopRequestSource
a -> CreateFlowDefinition
s {$sel:humanLoopRequestSource:CreateFlowDefinition' :: Maybe HumanLoopRequestSource
humanLoopRequestSource = Maybe HumanLoopRequestSource
a} :: CreateFlowDefinition)

-- | An array of key-value pairs that contain metadata to help you categorize
-- and organize a flow definition. Each tag consists of a key and a value,
-- both of which you define.
createFlowDefinition_tags :: Lens.Lens' CreateFlowDefinition (Prelude.Maybe [Tag])
createFlowDefinition_tags :: Lens' CreateFlowDefinition (Maybe [Tag])
createFlowDefinition_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowDefinition' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateFlowDefinition
s@CreateFlowDefinition' {} Maybe [Tag]
a -> CreateFlowDefinition
s {$sel:tags:CreateFlowDefinition' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateFlowDefinition) 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 name of your flow definition.
createFlowDefinition_flowDefinitionName :: Lens.Lens' CreateFlowDefinition Prelude.Text
createFlowDefinition_flowDefinitionName :: Lens' CreateFlowDefinition Text
createFlowDefinition_flowDefinitionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowDefinition' {Text
flowDefinitionName :: Text
$sel:flowDefinitionName:CreateFlowDefinition' :: CreateFlowDefinition -> Text
flowDefinitionName} -> Text
flowDefinitionName) (\s :: CreateFlowDefinition
s@CreateFlowDefinition' {} Text
a -> CreateFlowDefinition
s {$sel:flowDefinitionName:CreateFlowDefinition' :: Text
flowDefinitionName = Text
a} :: CreateFlowDefinition)

-- | An object containing information about the tasks the human reviewers
-- will perform.
createFlowDefinition_humanLoopConfig :: Lens.Lens' CreateFlowDefinition HumanLoopConfig
createFlowDefinition_humanLoopConfig :: Lens' CreateFlowDefinition HumanLoopConfig
createFlowDefinition_humanLoopConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowDefinition' {HumanLoopConfig
humanLoopConfig :: HumanLoopConfig
$sel:humanLoopConfig:CreateFlowDefinition' :: CreateFlowDefinition -> HumanLoopConfig
humanLoopConfig} -> HumanLoopConfig
humanLoopConfig) (\s :: CreateFlowDefinition
s@CreateFlowDefinition' {} HumanLoopConfig
a -> CreateFlowDefinition
s {$sel:humanLoopConfig:CreateFlowDefinition' :: HumanLoopConfig
humanLoopConfig = HumanLoopConfig
a} :: CreateFlowDefinition)

-- | An object containing information about where the human review results
-- will be uploaded.
createFlowDefinition_outputConfig :: Lens.Lens' CreateFlowDefinition FlowDefinitionOutputConfig
createFlowDefinition_outputConfig :: Lens' CreateFlowDefinition FlowDefinitionOutputConfig
createFlowDefinition_outputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowDefinition' {FlowDefinitionOutputConfig
outputConfig :: FlowDefinitionOutputConfig
$sel:outputConfig:CreateFlowDefinition' :: CreateFlowDefinition -> FlowDefinitionOutputConfig
outputConfig} -> FlowDefinitionOutputConfig
outputConfig) (\s :: CreateFlowDefinition
s@CreateFlowDefinition' {} FlowDefinitionOutputConfig
a -> CreateFlowDefinition
s {$sel:outputConfig:CreateFlowDefinition' :: FlowDefinitionOutputConfig
outputConfig = FlowDefinitionOutputConfig
a} :: CreateFlowDefinition)

-- | The Amazon Resource Name (ARN) of the role needed to call other services
-- on your behalf. For example,
-- @arn:aws:iam::1234567890:role\/service-role\/AmazonSageMaker-ExecutionRole-20180111T151298@.
createFlowDefinition_roleArn :: Lens.Lens' CreateFlowDefinition Prelude.Text
createFlowDefinition_roleArn :: Lens' CreateFlowDefinition Text
createFlowDefinition_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowDefinition' {Text
roleArn :: Text
$sel:roleArn:CreateFlowDefinition' :: CreateFlowDefinition -> Text
roleArn} -> Text
roleArn) (\s :: CreateFlowDefinition
s@CreateFlowDefinition' {} Text
a -> CreateFlowDefinition
s {$sel:roleArn:CreateFlowDefinition' :: Text
roleArn = Text
a} :: CreateFlowDefinition)

instance Core.AWSRequest CreateFlowDefinition where
  type
    AWSResponse CreateFlowDefinition =
      CreateFlowDefinitionResponse
  request :: (Service -> Service)
-> CreateFlowDefinition -> Request CreateFlowDefinition
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 CreateFlowDefinition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateFlowDefinition)))
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 ->
          Int -> Text -> CreateFlowDefinitionResponse
CreateFlowDefinitionResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"FlowDefinitionArn")
      )

instance Prelude.Hashable CreateFlowDefinition where
  hashWithSalt :: Int -> CreateFlowDefinition -> Int
hashWithSalt Int
_salt CreateFlowDefinition' {Maybe [Tag]
Maybe HumanLoopActivationConfig
Maybe HumanLoopRequestSource
Text
FlowDefinitionOutputConfig
HumanLoopConfig
roleArn :: Text
outputConfig :: FlowDefinitionOutputConfig
humanLoopConfig :: HumanLoopConfig
flowDefinitionName :: Text
tags :: Maybe [Tag]
humanLoopRequestSource :: Maybe HumanLoopRequestSource
humanLoopActivationConfig :: Maybe HumanLoopActivationConfig
$sel:roleArn:CreateFlowDefinition' :: CreateFlowDefinition -> Text
$sel:outputConfig:CreateFlowDefinition' :: CreateFlowDefinition -> FlowDefinitionOutputConfig
$sel:humanLoopConfig:CreateFlowDefinition' :: CreateFlowDefinition -> HumanLoopConfig
$sel:flowDefinitionName:CreateFlowDefinition' :: CreateFlowDefinition -> Text
$sel:tags:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe [Tag]
$sel:humanLoopRequestSource:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe HumanLoopRequestSource
$sel:humanLoopActivationConfig:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe HumanLoopActivationConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HumanLoopActivationConfig
humanLoopActivationConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HumanLoopRequestSource
humanLoopRequestSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
flowDefinitionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HumanLoopConfig
humanLoopConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FlowDefinitionOutputConfig
outputConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData CreateFlowDefinition where
  rnf :: CreateFlowDefinition -> ()
rnf CreateFlowDefinition' {Maybe [Tag]
Maybe HumanLoopActivationConfig
Maybe HumanLoopRequestSource
Text
FlowDefinitionOutputConfig
HumanLoopConfig
roleArn :: Text
outputConfig :: FlowDefinitionOutputConfig
humanLoopConfig :: HumanLoopConfig
flowDefinitionName :: Text
tags :: Maybe [Tag]
humanLoopRequestSource :: Maybe HumanLoopRequestSource
humanLoopActivationConfig :: Maybe HumanLoopActivationConfig
$sel:roleArn:CreateFlowDefinition' :: CreateFlowDefinition -> Text
$sel:outputConfig:CreateFlowDefinition' :: CreateFlowDefinition -> FlowDefinitionOutputConfig
$sel:humanLoopConfig:CreateFlowDefinition' :: CreateFlowDefinition -> HumanLoopConfig
$sel:flowDefinitionName:CreateFlowDefinition' :: CreateFlowDefinition -> Text
$sel:tags:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe [Tag]
$sel:humanLoopRequestSource:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe HumanLoopRequestSource
$sel:humanLoopActivationConfig:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe HumanLoopActivationConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe HumanLoopActivationConfig
humanLoopActivationConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HumanLoopRequestSource
humanLoopRequestSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
flowDefinitionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HumanLoopConfig
humanLoopConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FlowDefinitionOutputConfig
outputConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

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

instance Data.ToJSON CreateFlowDefinition where
  toJSON :: CreateFlowDefinition -> Value
toJSON CreateFlowDefinition' {Maybe [Tag]
Maybe HumanLoopActivationConfig
Maybe HumanLoopRequestSource
Text
FlowDefinitionOutputConfig
HumanLoopConfig
roleArn :: Text
outputConfig :: FlowDefinitionOutputConfig
humanLoopConfig :: HumanLoopConfig
flowDefinitionName :: Text
tags :: Maybe [Tag]
humanLoopRequestSource :: Maybe HumanLoopRequestSource
humanLoopActivationConfig :: Maybe HumanLoopActivationConfig
$sel:roleArn:CreateFlowDefinition' :: CreateFlowDefinition -> Text
$sel:outputConfig:CreateFlowDefinition' :: CreateFlowDefinition -> FlowDefinitionOutputConfig
$sel:humanLoopConfig:CreateFlowDefinition' :: CreateFlowDefinition -> HumanLoopConfig
$sel:flowDefinitionName:CreateFlowDefinition' :: CreateFlowDefinition -> Text
$sel:tags:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe [Tag]
$sel:humanLoopRequestSource:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe HumanLoopRequestSource
$sel:humanLoopActivationConfig:CreateFlowDefinition' :: CreateFlowDefinition -> Maybe HumanLoopActivationConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"HumanLoopActivationConfig" 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 HumanLoopActivationConfig
humanLoopActivationConfig,
            (Key
"HumanLoopRequestSource" 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 HumanLoopRequestSource
humanLoopRequestSource,
            (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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"FlowDefinitionName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
flowDefinitionName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"HumanLoopConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HumanLoopConfig
humanLoopConfig),
            forall a. a -> Maybe a
Prelude.Just (Key
"OutputConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FlowDefinitionOutputConfig
outputConfig),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateFlowDefinitionResponse' 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:
--
-- 'httpStatus', 'createFlowDefinitionResponse_httpStatus' - The response's http status code.
--
-- 'flowDefinitionArn', 'createFlowDefinitionResponse_flowDefinitionArn' - The Amazon Resource Name (ARN) of the flow definition you create.
newCreateFlowDefinitionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'flowDefinitionArn'
  Prelude.Text ->
  CreateFlowDefinitionResponse
newCreateFlowDefinitionResponse :: Int -> Text -> CreateFlowDefinitionResponse
newCreateFlowDefinitionResponse
  Int
pHttpStatus_
  Text
pFlowDefinitionArn_ =
    CreateFlowDefinitionResponse'
      { $sel:httpStatus:CreateFlowDefinitionResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:flowDefinitionArn:CreateFlowDefinitionResponse' :: Text
flowDefinitionArn = Text
pFlowDefinitionArn_
      }

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

-- | The Amazon Resource Name (ARN) of the flow definition you create.
createFlowDefinitionResponse_flowDefinitionArn :: Lens.Lens' CreateFlowDefinitionResponse Prelude.Text
createFlowDefinitionResponse_flowDefinitionArn :: Lens' CreateFlowDefinitionResponse Text
createFlowDefinitionResponse_flowDefinitionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowDefinitionResponse' {Text
flowDefinitionArn :: Text
$sel:flowDefinitionArn:CreateFlowDefinitionResponse' :: CreateFlowDefinitionResponse -> Text
flowDefinitionArn} -> Text
flowDefinitionArn) (\s :: CreateFlowDefinitionResponse
s@CreateFlowDefinitionResponse' {} Text
a -> CreateFlowDefinitionResponse
s {$sel:flowDefinitionArn:CreateFlowDefinitionResponse' :: Text
flowDefinitionArn = Text
a} :: CreateFlowDefinitionResponse)

instance Prelude.NFData CreateFlowDefinitionResponse where
  rnf :: CreateFlowDefinitionResponse -> ()
rnf CreateFlowDefinitionResponse' {Int
Text
flowDefinitionArn :: Text
httpStatus :: Int
$sel:flowDefinitionArn:CreateFlowDefinitionResponse' :: CreateFlowDefinitionResponse -> Text
$sel:httpStatus:CreateFlowDefinitionResponse' :: CreateFlowDefinitionResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
flowDefinitionArn