{-# 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.Omics.CreateWorkflow
-- 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 workflow.
module Amazonka.Omics.CreateWorkflow
  ( -- * Creating a Request
    CreateWorkflow (..),
    newCreateWorkflow,

    -- * Request Lenses
    createWorkflow_definitionUri,
    createWorkflow_definitionZip,
    createWorkflow_description,
    createWorkflow_engine,
    createWorkflow_main,
    createWorkflow_name,
    createWorkflow_parameterTemplate,
    createWorkflow_storageCapacity,
    createWorkflow_tags,
    createWorkflow_requestId,

    -- * Destructuring the Response
    CreateWorkflowResponse (..),
    newCreateWorkflowResponse,

    -- * Response Lenses
    createWorkflowResponse_arn,
    createWorkflowResponse_id,
    createWorkflowResponse_status,
    createWorkflowResponse_tags,
    createWorkflowResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateWorkflow' smart constructor.
data CreateWorkflow = CreateWorkflow'
  { -- | The URI of a definition for the workflow.
    CreateWorkflow -> Maybe Text
definitionUri :: Prelude.Maybe Prelude.Text,
    -- | A ZIP archive for the workflow.
    CreateWorkflow -> Maybe Base64
definitionZip :: Prelude.Maybe Data.Base64,
    -- | A description for the workflow.
    CreateWorkflow -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | An engine for the workflow.
    CreateWorkflow -> Maybe WorkflowEngine
engine :: Prelude.Maybe WorkflowEngine,
    -- | The path of the main definition file for the workflow.
    CreateWorkflow -> Maybe Text
main :: Prelude.Maybe Prelude.Text,
    -- | A name for the workflow.
    CreateWorkflow -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | A parameter template for the workflow.
    CreateWorkflow -> Maybe (HashMap Text WorkflowParameter)
parameterTemplate :: Prelude.Maybe (Prelude.HashMap Prelude.Text WorkflowParameter),
    -- | A storage capacity for the workflow.
    CreateWorkflow -> Maybe Natural
storageCapacity :: Prelude.Maybe Prelude.Natural,
    -- | Tags for the workflow.
    CreateWorkflow -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A request ID for the workflow.
    CreateWorkflow -> Text
requestId :: Prelude.Text
  }
  deriving (CreateWorkflow -> CreateWorkflow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkflow -> CreateWorkflow -> Bool
$c/= :: CreateWorkflow -> CreateWorkflow -> Bool
== :: CreateWorkflow -> CreateWorkflow -> Bool
$c== :: CreateWorkflow -> CreateWorkflow -> Bool
Prelude.Eq, ReadPrec [CreateWorkflow]
ReadPrec CreateWorkflow
Int -> ReadS CreateWorkflow
ReadS [CreateWorkflow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWorkflow]
$creadListPrec :: ReadPrec [CreateWorkflow]
readPrec :: ReadPrec CreateWorkflow
$creadPrec :: ReadPrec CreateWorkflow
readList :: ReadS [CreateWorkflow]
$creadList :: ReadS [CreateWorkflow]
readsPrec :: Int -> ReadS CreateWorkflow
$creadsPrec :: Int -> ReadS CreateWorkflow
Prelude.Read, Int -> CreateWorkflow -> ShowS
[CreateWorkflow] -> ShowS
CreateWorkflow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkflow] -> ShowS
$cshowList :: [CreateWorkflow] -> ShowS
show :: CreateWorkflow -> String
$cshow :: CreateWorkflow -> String
showsPrec :: Int -> CreateWorkflow -> ShowS
$cshowsPrec :: Int -> CreateWorkflow -> ShowS
Prelude.Show, forall x. Rep CreateWorkflow x -> CreateWorkflow
forall x. CreateWorkflow -> Rep CreateWorkflow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWorkflow x -> CreateWorkflow
$cfrom :: forall x. CreateWorkflow -> Rep CreateWorkflow x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkflow' 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:
--
-- 'definitionUri', 'createWorkflow_definitionUri' - The URI of a definition for the workflow.
--
-- 'definitionZip', 'createWorkflow_definitionZip' - A ZIP archive for the workflow.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'description', 'createWorkflow_description' - A description for the workflow.
--
-- 'engine', 'createWorkflow_engine' - An engine for the workflow.
--
-- 'main', 'createWorkflow_main' - The path of the main definition file for the workflow.
--
-- 'name', 'createWorkflow_name' - A name for the workflow.
--
-- 'parameterTemplate', 'createWorkflow_parameterTemplate' - A parameter template for the workflow.
--
-- 'storageCapacity', 'createWorkflow_storageCapacity' - A storage capacity for the workflow.
--
-- 'tags', 'createWorkflow_tags' - Tags for the workflow.
--
-- 'requestId', 'createWorkflow_requestId' - A request ID for the workflow.
newCreateWorkflow ::
  -- | 'requestId'
  Prelude.Text ->
  CreateWorkflow
newCreateWorkflow :: Text -> CreateWorkflow
newCreateWorkflow Text
pRequestId_ =
  CreateWorkflow'
    { $sel:definitionUri:CreateWorkflow' :: Maybe Text
definitionUri = forall a. Maybe a
Prelude.Nothing,
      $sel:definitionZip:CreateWorkflow' :: Maybe Base64
definitionZip = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateWorkflow' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:engine:CreateWorkflow' :: Maybe WorkflowEngine
engine = forall a. Maybe a
Prelude.Nothing,
      $sel:main:CreateWorkflow' :: Maybe Text
main = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateWorkflow' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:parameterTemplate:CreateWorkflow' :: Maybe (HashMap Text WorkflowParameter)
parameterTemplate = forall a. Maybe a
Prelude.Nothing,
      $sel:storageCapacity:CreateWorkflow' :: Maybe Natural
storageCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateWorkflow' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:CreateWorkflow' :: Text
requestId = Text
pRequestId_
    }

-- | The URI of a definition for the workflow.
createWorkflow_definitionUri :: Lens.Lens' CreateWorkflow (Prelude.Maybe Prelude.Text)
createWorkflow_definitionUri :: Lens' CreateWorkflow (Maybe Text)
createWorkflow_definitionUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflow' {Maybe Text
definitionUri :: Maybe Text
$sel:definitionUri:CreateWorkflow' :: CreateWorkflow -> Maybe Text
definitionUri} -> Maybe Text
definitionUri) (\s :: CreateWorkflow
s@CreateWorkflow' {} Maybe Text
a -> CreateWorkflow
s {$sel:definitionUri:CreateWorkflow' :: Maybe Text
definitionUri = Maybe Text
a} :: CreateWorkflow)

-- | A ZIP archive for the workflow.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
createWorkflow_definitionZip :: Lens.Lens' CreateWorkflow (Prelude.Maybe Prelude.ByteString)
createWorkflow_definitionZip :: Lens' CreateWorkflow (Maybe ByteString)
createWorkflow_definitionZip = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflow' {Maybe Base64
definitionZip :: Maybe Base64
$sel:definitionZip:CreateWorkflow' :: CreateWorkflow -> Maybe Base64
definitionZip} -> Maybe Base64
definitionZip) (\s :: CreateWorkflow
s@CreateWorkflow' {} Maybe Base64
a -> CreateWorkflow
s {$sel:definitionZip:CreateWorkflow' :: Maybe Base64
definitionZip = Maybe Base64
a} :: CreateWorkflow) 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 Iso' Base64 ByteString
Data._Base64

-- | A description for the workflow.
createWorkflow_description :: Lens.Lens' CreateWorkflow (Prelude.Maybe Prelude.Text)
createWorkflow_description :: Lens' CreateWorkflow (Maybe Text)
createWorkflow_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflow' {Maybe Text
description :: Maybe Text
$sel:description:CreateWorkflow' :: CreateWorkflow -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateWorkflow
s@CreateWorkflow' {} Maybe Text
a -> CreateWorkflow
s {$sel:description:CreateWorkflow' :: Maybe Text
description = Maybe Text
a} :: CreateWorkflow)

-- | An engine for the workflow.
createWorkflow_engine :: Lens.Lens' CreateWorkflow (Prelude.Maybe WorkflowEngine)
createWorkflow_engine :: Lens' CreateWorkflow (Maybe WorkflowEngine)
createWorkflow_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflow' {Maybe WorkflowEngine
engine :: Maybe WorkflowEngine
$sel:engine:CreateWorkflow' :: CreateWorkflow -> Maybe WorkflowEngine
engine} -> Maybe WorkflowEngine
engine) (\s :: CreateWorkflow
s@CreateWorkflow' {} Maybe WorkflowEngine
a -> CreateWorkflow
s {$sel:engine:CreateWorkflow' :: Maybe WorkflowEngine
engine = Maybe WorkflowEngine
a} :: CreateWorkflow)

-- | The path of the main definition file for the workflow.
createWorkflow_main :: Lens.Lens' CreateWorkflow (Prelude.Maybe Prelude.Text)
createWorkflow_main :: Lens' CreateWorkflow (Maybe Text)
createWorkflow_main = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflow' {Maybe Text
main :: Maybe Text
$sel:main:CreateWorkflow' :: CreateWorkflow -> Maybe Text
main} -> Maybe Text
main) (\s :: CreateWorkflow
s@CreateWorkflow' {} Maybe Text
a -> CreateWorkflow
s {$sel:main:CreateWorkflow' :: Maybe Text
main = Maybe Text
a} :: CreateWorkflow)

-- | A name for the workflow.
createWorkflow_name :: Lens.Lens' CreateWorkflow (Prelude.Maybe Prelude.Text)
createWorkflow_name :: Lens' CreateWorkflow (Maybe Text)
createWorkflow_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflow' {Maybe Text
name :: Maybe Text
$sel:name:CreateWorkflow' :: CreateWorkflow -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateWorkflow
s@CreateWorkflow' {} Maybe Text
a -> CreateWorkflow
s {$sel:name:CreateWorkflow' :: Maybe Text
name = Maybe Text
a} :: CreateWorkflow)

-- | A parameter template for the workflow.
createWorkflow_parameterTemplate :: Lens.Lens' CreateWorkflow (Prelude.Maybe (Prelude.HashMap Prelude.Text WorkflowParameter))
createWorkflow_parameterTemplate :: Lens' CreateWorkflow (Maybe (HashMap Text WorkflowParameter))
createWorkflow_parameterTemplate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflow' {Maybe (HashMap Text WorkflowParameter)
parameterTemplate :: Maybe (HashMap Text WorkflowParameter)
$sel:parameterTemplate:CreateWorkflow' :: CreateWorkflow -> Maybe (HashMap Text WorkflowParameter)
parameterTemplate} -> Maybe (HashMap Text WorkflowParameter)
parameterTemplate) (\s :: CreateWorkflow
s@CreateWorkflow' {} Maybe (HashMap Text WorkflowParameter)
a -> CreateWorkflow
s {$sel:parameterTemplate:CreateWorkflow' :: Maybe (HashMap Text WorkflowParameter)
parameterTemplate = Maybe (HashMap Text WorkflowParameter)
a} :: CreateWorkflow) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A storage capacity for the workflow.
createWorkflow_storageCapacity :: Lens.Lens' CreateWorkflow (Prelude.Maybe Prelude.Natural)
createWorkflow_storageCapacity :: Lens' CreateWorkflow (Maybe Natural)
createWorkflow_storageCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflow' {Maybe Natural
storageCapacity :: Maybe Natural
$sel:storageCapacity:CreateWorkflow' :: CreateWorkflow -> Maybe Natural
storageCapacity} -> Maybe Natural
storageCapacity) (\s :: CreateWorkflow
s@CreateWorkflow' {} Maybe Natural
a -> CreateWorkflow
s {$sel:storageCapacity:CreateWorkflow' :: Maybe Natural
storageCapacity = Maybe Natural
a} :: CreateWorkflow)

-- | Tags for the workflow.
createWorkflow_tags :: Lens.Lens' CreateWorkflow (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createWorkflow_tags :: Lens' CreateWorkflow (Maybe (HashMap Text Text))
createWorkflow_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflow' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateWorkflow' :: CreateWorkflow -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateWorkflow
s@CreateWorkflow' {} Maybe (HashMap Text Text)
a -> CreateWorkflow
s {$sel:tags:CreateWorkflow' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateWorkflow) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A request ID for the workflow.
createWorkflow_requestId :: Lens.Lens' CreateWorkflow Prelude.Text
createWorkflow_requestId :: Lens' CreateWorkflow Text
createWorkflow_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflow' {Text
requestId :: Text
$sel:requestId:CreateWorkflow' :: CreateWorkflow -> Text
requestId} -> Text
requestId) (\s :: CreateWorkflow
s@CreateWorkflow' {} Text
a -> CreateWorkflow
s {$sel:requestId:CreateWorkflow' :: Text
requestId = Text
a} :: CreateWorkflow)

instance Core.AWSRequest CreateWorkflow where
  type
    AWSResponse CreateWorkflow =
      CreateWorkflowResponse
  request :: (Service -> Service) -> CreateWorkflow -> Request CreateWorkflow
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 CreateWorkflow
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateWorkflow)))
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 Text
-> Maybe WorkflowStatus
-> Maybe (HashMap Text Text)
-> Int
-> CreateWorkflowResponse
CreateWorkflowResponse'
            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
"arn")
            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
"id")
            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
"status")
            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
"tags" 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 CreateWorkflow where
  hashWithSalt :: Int -> CreateWorkflow -> Int
hashWithSalt Int
_salt CreateWorkflow' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text WorkflowParameter)
Maybe Base64
Maybe WorkflowEngine
Text
requestId :: Text
tags :: Maybe (HashMap Text Text)
storageCapacity :: Maybe Natural
parameterTemplate :: Maybe (HashMap Text WorkflowParameter)
name :: Maybe Text
main :: Maybe Text
engine :: Maybe WorkflowEngine
description :: Maybe Text
definitionZip :: Maybe Base64
definitionUri :: Maybe Text
$sel:requestId:CreateWorkflow' :: CreateWorkflow -> Text
$sel:tags:CreateWorkflow' :: CreateWorkflow -> Maybe (HashMap Text Text)
$sel:storageCapacity:CreateWorkflow' :: CreateWorkflow -> Maybe Natural
$sel:parameterTemplate:CreateWorkflow' :: CreateWorkflow -> Maybe (HashMap Text WorkflowParameter)
$sel:name:CreateWorkflow' :: CreateWorkflow -> Maybe Text
$sel:main:CreateWorkflow' :: CreateWorkflow -> Maybe Text
$sel:engine:CreateWorkflow' :: CreateWorkflow -> Maybe WorkflowEngine
$sel:description:CreateWorkflow' :: CreateWorkflow -> Maybe Text
$sel:definitionZip:CreateWorkflow' :: CreateWorkflow -> Maybe Base64
$sel:definitionUri:CreateWorkflow' :: CreateWorkflow -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
definitionUri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Base64
definitionZip
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkflowEngine
engine
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
main
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text WorkflowParameter)
parameterTemplate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
storageCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
requestId

instance Prelude.NFData CreateWorkflow where
  rnf :: CreateWorkflow -> ()
rnf CreateWorkflow' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text WorkflowParameter)
Maybe Base64
Maybe WorkflowEngine
Text
requestId :: Text
tags :: Maybe (HashMap Text Text)
storageCapacity :: Maybe Natural
parameterTemplate :: Maybe (HashMap Text WorkflowParameter)
name :: Maybe Text
main :: Maybe Text
engine :: Maybe WorkflowEngine
description :: Maybe Text
definitionZip :: Maybe Base64
definitionUri :: Maybe Text
$sel:requestId:CreateWorkflow' :: CreateWorkflow -> Text
$sel:tags:CreateWorkflow' :: CreateWorkflow -> Maybe (HashMap Text Text)
$sel:storageCapacity:CreateWorkflow' :: CreateWorkflow -> Maybe Natural
$sel:parameterTemplate:CreateWorkflow' :: CreateWorkflow -> Maybe (HashMap Text WorkflowParameter)
$sel:name:CreateWorkflow' :: CreateWorkflow -> Maybe Text
$sel:main:CreateWorkflow' :: CreateWorkflow -> Maybe Text
$sel:engine:CreateWorkflow' :: CreateWorkflow -> Maybe WorkflowEngine
$sel:description:CreateWorkflow' :: CreateWorkflow -> Maybe Text
$sel:definitionZip:CreateWorkflow' :: CreateWorkflow -> Maybe Base64
$sel:definitionUri:CreateWorkflow' :: CreateWorkflow -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
definitionUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Base64
definitionZip
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 WorkflowEngine
engine
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
main
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text WorkflowParameter)
parameterTemplate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
storageCapacity
      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
requestId

instance Data.ToHeaders CreateWorkflow where
  toHeaders :: CreateWorkflow -> 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 CreateWorkflow where
  toJSON :: CreateWorkflow -> Value
toJSON CreateWorkflow' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text WorkflowParameter)
Maybe Base64
Maybe WorkflowEngine
Text
requestId :: Text
tags :: Maybe (HashMap Text Text)
storageCapacity :: Maybe Natural
parameterTemplate :: Maybe (HashMap Text WorkflowParameter)
name :: Maybe Text
main :: Maybe Text
engine :: Maybe WorkflowEngine
description :: Maybe Text
definitionZip :: Maybe Base64
definitionUri :: Maybe Text
$sel:requestId:CreateWorkflow' :: CreateWorkflow -> Text
$sel:tags:CreateWorkflow' :: CreateWorkflow -> Maybe (HashMap Text Text)
$sel:storageCapacity:CreateWorkflow' :: CreateWorkflow -> Maybe Natural
$sel:parameterTemplate:CreateWorkflow' :: CreateWorkflow -> Maybe (HashMap Text WorkflowParameter)
$sel:name:CreateWorkflow' :: CreateWorkflow -> Maybe Text
$sel:main:CreateWorkflow' :: CreateWorkflow -> Maybe Text
$sel:engine:CreateWorkflow' :: CreateWorkflow -> Maybe WorkflowEngine
$sel:description:CreateWorkflow' :: CreateWorkflow -> Maybe Text
$sel:definitionZip:CreateWorkflow' :: CreateWorkflow -> Maybe Base64
$sel:definitionUri:CreateWorkflow' :: CreateWorkflow -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"definitionUri" 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
definitionUri,
            (Key
"definitionZip" 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 Base64
definitionZip,
            (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
"engine" 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 WorkflowEngine
engine,
            (Key
"main" 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
main,
            (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
name,
            (Key
"parameterTemplate" 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 WorkflowParameter)
parameterTemplate,
            (Key
"storageCapacity" 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 Natural
storageCapacity,
            (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
"requestId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
requestId)
          ]
      )

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

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

-- | /See:/ 'newCreateWorkflowResponse' smart constructor.
data CreateWorkflowResponse = CreateWorkflowResponse'
  { -- | The workflow\'s ARN.
    CreateWorkflowResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The workflow\'s ID.
    CreateWorkflowResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The workflow\'s status.
    CreateWorkflowResponse -> Maybe WorkflowStatus
status :: Prelude.Maybe WorkflowStatus,
    -- | The workflow\'s tags.
    CreateWorkflowResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    CreateWorkflowResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateWorkflowResponse -> CreateWorkflowResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkflowResponse -> CreateWorkflowResponse -> Bool
$c/= :: CreateWorkflowResponse -> CreateWorkflowResponse -> Bool
== :: CreateWorkflowResponse -> CreateWorkflowResponse -> Bool
$c== :: CreateWorkflowResponse -> CreateWorkflowResponse -> Bool
Prelude.Eq, ReadPrec [CreateWorkflowResponse]
ReadPrec CreateWorkflowResponse
Int -> ReadS CreateWorkflowResponse
ReadS [CreateWorkflowResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWorkflowResponse]
$creadListPrec :: ReadPrec [CreateWorkflowResponse]
readPrec :: ReadPrec CreateWorkflowResponse
$creadPrec :: ReadPrec CreateWorkflowResponse
readList :: ReadS [CreateWorkflowResponse]
$creadList :: ReadS [CreateWorkflowResponse]
readsPrec :: Int -> ReadS CreateWorkflowResponse
$creadsPrec :: Int -> ReadS CreateWorkflowResponse
Prelude.Read, Int -> CreateWorkflowResponse -> ShowS
[CreateWorkflowResponse] -> ShowS
CreateWorkflowResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkflowResponse] -> ShowS
$cshowList :: [CreateWorkflowResponse] -> ShowS
show :: CreateWorkflowResponse -> String
$cshow :: CreateWorkflowResponse -> String
showsPrec :: Int -> CreateWorkflowResponse -> ShowS
$cshowsPrec :: Int -> CreateWorkflowResponse -> ShowS
Prelude.Show, forall x. Rep CreateWorkflowResponse x -> CreateWorkflowResponse
forall x. CreateWorkflowResponse -> Rep CreateWorkflowResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWorkflowResponse x -> CreateWorkflowResponse
$cfrom :: forall x. CreateWorkflowResponse -> Rep CreateWorkflowResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkflowResponse' 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:
--
-- 'arn', 'createWorkflowResponse_arn' - The workflow\'s ARN.
--
-- 'id', 'createWorkflowResponse_id' - The workflow\'s ID.
--
-- 'status', 'createWorkflowResponse_status' - The workflow\'s status.
--
-- 'tags', 'createWorkflowResponse_tags' - The workflow\'s tags.
--
-- 'httpStatus', 'createWorkflowResponse_httpStatus' - The response's http status code.
newCreateWorkflowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateWorkflowResponse
newCreateWorkflowResponse :: Int -> CreateWorkflowResponse
newCreateWorkflowResponse Int
pHttpStatus_ =
  CreateWorkflowResponse'
    { $sel:arn:CreateWorkflowResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:id:CreateWorkflowResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:status:CreateWorkflowResponse' :: Maybe WorkflowStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateWorkflowResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateWorkflowResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The workflow\'s ARN.
createWorkflowResponse_arn :: Lens.Lens' CreateWorkflowResponse (Prelude.Maybe Prelude.Text)
createWorkflowResponse_arn :: Lens' CreateWorkflowResponse (Maybe Text)
createWorkflowResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflowResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateWorkflowResponse' :: CreateWorkflowResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateWorkflowResponse
s@CreateWorkflowResponse' {} Maybe Text
a -> CreateWorkflowResponse
s {$sel:arn:CreateWorkflowResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateWorkflowResponse)

-- | The workflow\'s ID.
createWorkflowResponse_id :: Lens.Lens' CreateWorkflowResponse (Prelude.Maybe Prelude.Text)
createWorkflowResponse_id :: Lens' CreateWorkflowResponse (Maybe Text)
createWorkflowResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflowResponse' {Maybe Text
id :: Maybe Text
$sel:id:CreateWorkflowResponse' :: CreateWorkflowResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateWorkflowResponse
s@CreateWorkflowResponse' {} Maybe Text
a -> CreateWorkflowResponse
s {$sel:id:CreateWorkflowResponse' :: Maybe Text
id = Maybe Text
a} :: CreateWorkflowResponse)

-- | The workflow\'s status.
createWorkflowResponse_status :: Lens.Lens' CreateWorkflowResponse (Prelude.Maybe WorkflowStatus)
createWorkflowResponse_status :: Lens' CreateWorkflowResponse (Maybe WorkflowStatus)
createWorkflowResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflowResponse' {Maybe WorkflowStatus
status :: Maybe WorkflowStatus
$sel:status:CreateWorkflowResponse' :: CreateWorkflowResponse -> Maybe WorkflowStatus
status} -> Maybe WorkflowStatus
status) (\s :: CreateWorkflowResponse
s@CreateWorkflowResponse' {} Maybe WorkflowStatus
a -> CreateWorkflowResponse
s {$sel:status:CreateWorkflowResponse' :: Maybe WorkflowStatus
status = Maybe WorkflowStatus
a} :: CreateWorkflowResponse)

-- | The workflow\'s tags.
createWorkflowResponse_tags :: Lens.Lens' CreateWorkflowResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createWorkflowResponse_tags :: Lens' CreateWorkflowResponse (Maybe (HashMap Text Text))
createWorkflowResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflowResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateWorkflowResponse' :: CreateWorkflowResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateWorkflowResponse
s@CreateWorkflowResponse' {} Maybe (HashMap Text Text)
a -> CreateWorkflowResponse
s {$sel:tags:CreateWorkflowResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateWorkflowResponse) 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.
createWorkflowResponse_httpStatus :: Lens.Lens' CreateWorkflowResponse Prelude.Int
createWorkflowResponse_httpStatus :: Lens' CreateWorkflowResponse Int
createWorkflowResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkflowResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateWorkflowResponse' :: CreateWorkflowResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateWorkflowResponse
s@CreateWorkflowResponse' {} Int
a -> CreateWorkflowResponse
s {$sel:httpStatus:CreateWorkflowResponse' :: Int
httpStatus = Int
a} :: CreateWorkflowResponse)

instance Prelude.NFData CreateWorkflowResponse where
  rnf :: CreateWorkflowResponse -> ()
rnf CreateWorkflowResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe WorkflowStatus
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
status :: Maybe WorkflowStatus
id :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:CreateWorkflowResponse' :: CreateWorkflowResponse -> Int
$sel:tags:CreateWorkflowResponse' :: CreateWorkflowResponse -> Maybe (HashMap Text Text)
$sel:status:CreateWorkflowResponse' :: CreateWorkflowResponse -> Maybe WorkflowStatus
$sel:id:CreateWorkflowResponse' :: CreateWorkflowResponse -> Maybe Text
$sel:arn:CreateWorkflowResponse' :: CreateWorkflowResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowStatus
status
      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 Int
httpStatus