{-# 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.GetWorkflow
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about a workflow.
module Amazonka.Omics.GetWorkflow
  ( -- * Creating a Request
    GetWorkflow (..),
    newGetWorkflow,

    -- * Request Lenses
    getWorkflow_export,
    getWorkflow_type,
    getWorkflow_id,

    -- * Destructuring the Response
    GetWorkflowResponse (..),
    newGetWorkflowResponse,

    -- * Response Lenses
    getWorkflowResponse_arn,
    getWorkflowResponse_creationTime,
    getWorkflowResponse_definition,
    getWorkflowResponse_description,
    getWorkflowResponse_digest,
    getWorkflowResponse_engine,
    getWorkflowResponse_id,
    getWorkflowResponse_main,
    getWorkflowResponse_name,
    getWorkflowResponse_parameterTemplate,
    getWorkflowResponse_status,
    getWorkflowResponse_statusMessage,
    getWorkflowResponse_storageCapacity,
    getWorkflowResponse_tags,
    getWorkflowResponse_type,
    getWorkflowResponse_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:/ 'newGetWorkflow' smart constructor.
data GetWorkflow = GetWorkflow'
  { -- | The export format for the workflow.
    GetWorkflow -> Maybe [WorkflowExport]
export' :: Prelude.Maybe [WorkflowExport],
    -- | The workflow\'s type.
    GetWorkflow -> Maybe WorkflowType
type' :: Prelude.Maybe WorkflowType,
    -- | The workflow\'s ID.
    GetWorkflow -> Text
id :: Prelude.Text
  }
  deriving (GetWorkflow -> GetWorkflow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorkflow -> GetWorkflow -> Bool
$c/= :: GetWorkflow -> GetWorkflow -> Bool
== :: GetWorkflow -> GetWorkflow -> Bool
$c== :: GetWorkflow -> GetWorkflow -> Bool
Prelude.Eq, ReadPrec [GetWorkflow]
ReadPrec GetWorkflow
Int -> ReadS GetWorkflow
ReadS [GetWorkflow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorkflow]
$creadListPrec :: ReadPrec [GetWorkflow]
readPrec :: ReadPrec GetWorkflow
$creadPrec :: ReadPrec GetWorkflow
readList :: ReadS [GetWorkflow]
$creadList :: ReadS [GetWorkflow]
readsPrec :: Int -> ReadS GetWorkflow
$creadsPrec :: Int -> ReadS GetWorkflow
Prelude.Read, Int -> GetWorkflow -> ShowS
[GetWorkflow] -> ShowS
GetWorkflow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorkflow] -> ShowS
$cshowList :: [GetWorkflow] -> ShowS
show :: GetWorkflow -> String
$cshow :: GetWorkflow -> String
showsPrec :: Int -> GetWorkflow -> ShowS
$cshowsPrec :: Int -> GetWorkflow -> ShowS
Prelude.Show, forall x. Rep GetWorkflow x -> GetWorkflow
forall x. GetWorkflow -> Rep GetWorkflow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetWorkflow x -> GetWorkflow
$cfrom :: forall x. GetWorkflow -> Rep GetWorkflow x
Prelude.Generic)

-- |
-- Create a value of 'GetWorkflow' 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:
--
-- 'export'', 'getWorkflow_export' - The export format for the workflow.
--
-- 'type'', 'getWorkflow_type' - The workflow\'s type.
--
-- 'id', 'getWorkflow_id' - The workflow\'s ID.
newGetWorkflow ::
  -- | 'id'
  Prelude.Text ->
  GetWorkflow
newGetWorkflow :: Text -> GetWorkflow
newGetWorkflow Text
pId_ =
  GetWorkflow'
    { $sel:export':GetWorkflow' :: Maybe [WorkflowExport]
export' = forall a. Maybe a
Prelude.Nothing,
      $sel:type':GetWorkflow' :: Maybe WorkflowType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:id:GetWorkflow' :: Text
id = Text
pId_
    }

-- | The export format for the workflow.
getWorkflow_export :: Lens.Lens' GetWorkflow (Prelude.Maybe [WorkflowExport])
getWorkflow_export :: Lens' GetWorkflow (Maybe [WorkflowExport])
getWorkflow_export = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflow' {Maybe [WorkflowExport]
export' :: Maybe [WorkflowExport]
$sel:export':GetWorkflow' :: GetWorkflow -> Maybe [WorkflowExport]
export'} -> Maybe [WorkflowExport]
export') (\s :: GetWorkflow
s@GetWorkflow' {} Maybe [WorkflowExport]
a -> GetWorkflow
s {$sel:export':GetWorkflow' :: Maybe [WorkflowExport]
export' = Maybe [WorkflowExport]
a} :: GetWorkflow) 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 workflow\'s type.
getWorkflow_type :: Lens.Lens' GetWorkflow (Prelude.Maybe WorkflowType)
getWorkflow_type :: Lens' GetWorkflow (Maybe WorkflowType)
getWorkflow_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflow' {Maybe WorkflowType
type' :: Maybe WorkflowType
$sel:type':GetWorkflow' :: GetWorkflow -> Maybe WorkflowType
type'} -> Maybe WorkflowType
type') (\s :: GetWorkflow
s@GetWorkflow' {} Maybe WorkflowType
a -> GetWorkflow
s {$sel:type':GetWorkflow' :: Maybe WorkflowType
type' = Maybe WorkflowType
a} :: GetWorkflow)

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

instance Core.AWSRequest GetWorkflow where
  type AWSResponse GetWorkflow = GetWorkflowResponse
  request :: (Service -> Service) -> GetWorkflow -> Request GetWorkflow
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetWorkflow
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetWorkflow)))
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 ISO8601
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe WorkflowEngine
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe (HashMap Text WorkflowParameter)
-> Maybe WorkflowStatus
-> Maybe Text
-> Maybe Natural
-> Maybe (HashMap Text Text)
-> Maybe WorkflowType
-> Int
-> GetWorkflowResponse
GetWorkflowResponse'
            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
"creationTime")
            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
"definition")
            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
"description")
            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
"digest")
            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
"engine")
            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
"main")
            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
"name")
            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
"parameterTemplate"
                            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.<*> (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
"statusMessage")
            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
"storageCapacity")
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"type")
            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 GetWorkflow where
  hashWithSalt :: Int -> GetWorkflow -> Int
hashWithSalt Int
_salt GetWorkflow' {Maybe [WorkflowExport]
Maybe WorkflowType
Text
id :: Text
type' :: Maybe WorkflowType
export' :: Maybe [WorkflowExport]
$sel:id:GetWorkflow' :: GetWorkflow -> Text
$sel:type':GetWorkflow' :: GetWorkflow -> Maybe WorkflowType
$sel:export':GetWorkflow' :: GetWorkflow -> Maybe [WorkflowExport]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [WorkflowExport]
export'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkflowType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData GetWorkflow where
  rnf :: GetWorkflow -> ()
rnf GetWorkflow' {Maybe [WorkflowExport]
Maybe WorkflowType
Text
id :: Text
type' :: Maybe WorkflowType
export' :: Maybe [WorkflowExport]
$sel:id:GetWorkflow' :: GetWorkflow -> Text
$sel:type':GetWorkflow' :: GetWorkflow -> Maybe WorkflowType
$sel:export':GetWorkflow' :: GetWorkflow -> Maybe [WorkflowExport]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [WorkflowExport]
export'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders GetWorkflow where
  toHeaders :: GetWorkflow -> 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.ToPath GetWorkflow where
  toPath :: GetWorkflow -> ByteString
toPath GetWorkflow' {Maybe [WorkflowExport]
Maybe WorkflowType
Text
id :: Text
type' :: Maybe WorkflowType
export' :: Maybe [WorkflowExport]
$sel:id:GetWorkflow' :: GetWorkflow -> Text
$sel:type':GetWorkflow' :: GetWorkflow -> Maybe WorkflowType
$sel:export':GetWorkflow' :: GetWorkflow -> Maybe [WorkflowExport]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/workflow/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

instance Data.ToQuery GetWorkflow where
  toQuery :: GetWorkflow -> QueryString
toQuery GetWorkflow' {Maybe [WorkflowExport]
Maybe WorkflowType
Text
id :: Text
type' :: Maybe WorkflowType
export' :: Maybe [WorkflowExport]
$sel:id:GetWorkflow' :: GetWorkflow -> Text
$sel:type':GetWorkflow' :: GetWorkflow -> Maybe WorkflowType
$sel:export':GetWorkflow' :: GetWorkflow -> Maybe [WorkflowExport]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"export"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [WorkflowExport]
export'),
        ByteString
"type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe WorkflowType
type'
      ]

-- | /See:/ 'newGetWorkflowResponse' smart constructor.
data GetWorkflowResponse = GetWorkflowResponse'
  { -- | The workflow\'s ARN.
    GetWorkflowResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | When the workflow was created.
    GetWorkflowResponse -> Maybe ISO8601
creationTime :: Prelude.Maybe Data.ISO8601,
    -- | The workflow\'s definition.
    GetWorkflowResponse -> Maybe Text
definition :: Prelude.Maybe Prelude.Text,
    -- | The workflow\'s description.
    GetWorkflowResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The workflow\'s digest.
    GetWorkflowResponse -> Maybe Text
digest :: Prelude.Maybe Prelude.Text,
    -- | The workflow\'s engine.
    GetWorkflowResponse -> Maybe WorkflowEngine
engine :: Prelude.Maybe WorkflowEngine,
    -- | The workflow\'s ID.
    GetWorkflowResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The path of the main definition file for the workflow.
    GetWorkflowResponse -> Maybe Text
main :: Prelude.Maybe Prelude.Text,
    -- | The workflow\'s name.
    GetWorkflowResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The workflow\'s parameter template.
    GetWorkflowResponse -> Maybe (HashMap Text WorkflowParameter)
parameterTemplate :: Prelude.Maybe (Prelude.HashMap Prelude.Text WorkflowParameter),
    -- | The workflow\'s status.
    GetWorkflowResponse -> Maybe WorkflowStatus
status :: Prelude.Maybe WorkflowStatus,
    -- | The workflow\'s status message.
    GetWorkflowResponse -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | The workflow\'s storage capacity.
    GetWorkflowResponse -> Maybe Natural
storageCapacity :: Prelude.Maybe Prelude.Natural,
    -- | The workflow\'s tags.
    GetWorkflowResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The workflow\'s type.
    GetWorkflowResponse -> Maybe WorkflowType
type' :: Prelude.Maybe WorkflowType,
    -- | The response's http status code.
    GetWorkflowResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetWorkflowResponse -> GetWorkflowResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorkflowResponse -> GetWorkflowResponse -> Bool
$c/= :: GetWorkflowResponse -> GetWorkflowResponse -> Bool
== :: GetWorkflowResponse -> GetWorkflowResponse -> Bool
$c== :: GetWorkflowResponse -> GetWorkflowResponse -> Bool
Prelude.Eq, ReadPrec [GetWorkflowResponse]
ReadPrec GetWorkflowResponse
Int -> ReadS GetWorkflowResponse
ReadS [GetWorkflowResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorkflowResponse]
$creadListPrec :: ReadPrec [GetWorkflowResponse]
readPrec :: ReadPrec GetWorkflowResponse
$creadPrec :: ReadPrec GetWorkflowResponse
readList :: ReadS [GetWorkflowResponse]
$creadList :: ReadS [GetWorkflowResponse]
readsPrec :: Int -> ReadS GetWorkflowResponse
$creadsPrec :: Int -> ReadS GetWorkflowResponse
Prelude.Read, Int -> GetWorkflowResponse -> ShowS
[GetWorkflowResponse] -> ShowS
GetWorkflowResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorkflowResponse] -> ShowS
$cshowList :: [GetWorkflowResponse] -> ShowS
show :: GetWorkflowResponse -> String
$cshow :: GetWorkflowResponse -> String
showsPrec :: Int -> GetWorkflowResponse -> ShowS
$cshowsPrec :: Int -> GetWorkflowResponse -> ShowS
Prelude.Show, forall x. Rep GetWorkflowResponse x -> GetWorkflowResponse
forall x. GetWorkflowResponse -> Rep GetWorkflowResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetWorkflowResponse x -> GetWorkflowResponse
$cfrom :: forall x. GetWorkflowResponse -> Rep GetWorkflowResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetWorkflowResponse' 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', 'getWorkflowResponse_arn' - The workflow\'s ARN.
--
-- 'creationTime', 'getWorkflowResponse_creationTime' - When the workflow was created.
--
-- 'definition', 'getWorkflowResponse_definition' - The workflow\'s definition.
--
-- 'description', 'getWorkflowResponse_description' - The workflow\'s description.
--
-- 'digest', 'getWorkflowResponse_digest' - The workflow\'s digest.
--
-- 'engine', 'getWorkflowResponse_engine' - The workflow\'s engine.
--
-- 'id', 'getWorkflowResponse_id' - The workflow\'s ID.
--
-- 'main', 'getWorkflowResponse_main' - The path of the main definition file for the workflow.
--
-- 'name', 'getWorkflowResponse_name' - The workflow\'s name.
--
-- 'parameterTemplate', 'getWorkflowResponse_parameterTemplate' - The workflow\'s parameter template.
--
-- 'status', 'getWorkflowResponse_status' - The workflow\'s status.
--
-- 'statusMessage', 'getWorkflowResponse_statusMessage' - The workflow\'s status message.
--
-- 'storageCapacity', 'getWorkflowResponse_storageCapacity' - The workflow\'s storage capacity.
--
-- 'tags', 'getWorkflowResponse_tags' - The workflow\'s tags.
--
-- 'type'', 'getWorkflowResponse_type' - The workflow\'s type.
--
-- 'httpStatus', 'getWorkflowResponse_httpStatus' - The response's http status code.
newGetWorkflowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetWorkflowResponse
newGetWorkflowResponse :: Int -> GetWorkflowResponse
newGetWorkflowResponse Int
pHttpStatus_ =
  GetWorkflowResponse'
    { $sel:arn:GetWorkflowResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:GetWorkflowResponse' :: Maybe ISO8601
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:definition:GetWorkflowResponse' :: Maybe Text
definition = forall a. Maybe a
Prelude.Nothing,
      $sel:description:GetWorkflowResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:digest:GetWorkflowResponse' :: Maybe Text
digest = forall a. Maybe a
Prelude.Nothing,
      $sel:engine:GetWorkflowResponse' :: Maybe WorkflowEngine
engine = forall a. Maybe a
Prelude.Nothing,
      $sel:id:GetWorkflowResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:main:GetWorkflowResponse' :: Maybe Text
main = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetWorkflowResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:parameterTemplate:GetWorkflowResponse' :: Maybe (HashMap Text WorkflowParameter)
parameterTemplate = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetWorkflowResponse' :: Maybe WorkflowStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:GetWorkflowResponse' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:storageCapacity:GetWorkflowResponse' :: Maybe Natural
storageCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:GetWorkflowResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:type':GetWorkflowResponse' :: Maybe WorkflowType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetWorkflowResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | When the workflow was created.
getWorkflowResponse_creationTime :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Prelude.UTCTime)
getWorkflowResponse_creationTime :: Lens' GetWorkflowResponse (Maybe UTCTime)
getWorkflowResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe ISO8601
creationTime :: Maybe ISO8601
$sel:creationTime:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe ISO8601
creationTime} -> Maybe ISO8601
creationTime) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe ISO8601
a -> GetWorkflowResponse
s {$sel:creationTime:GetWorkflowResponse' :: Maybe ISO8601
creationTime = Maybe ISO8601
a} :: GetWorkflowResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The workflow\'s definition.
getWorkflowResponse_definition :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Prelude.Text)
getWorkflowResponse_definition :: Lens' GetWorkflowResponse (Maybe Text)
getWorkflowResponse_definition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe Text
definition :: Maybe Text
$sel:definition:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
definition} -> Maybe Text
definition) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe Text
a -> GetWorkflowResponse
s {$sel:definition:GetWorkflowResponse' :: Maybe Text
definition = Maybe Text
a} :: GetWorkflowResponse)

-- | The workflow\'s description.
getWorkflowResponse_description :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Prelude.Text)
getWorkflowResponse_description :: Lens' GetWorkflowResponse (Maybe Text)
getWorkflowResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe Text
description :: Maybe Text
$sel:description:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe Text
a -> GetWorkflowResponse
s {$sel:description:GetWorkflowResponse' :: Maybe Text
description = Maybe Text
a} :: GetWorkflowResponse)

-- | The workflow\'s digest.
getWorkflowResponse_digest :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Prelude.Text)
getWorkflowResponse_digest :: Lens' GetWorkflowResponse (Maybe Text)
getWorkflowResponse_digest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe Text
digest :: Maybe Text
$sel:digest:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
digest} -> Maybe Text
digest) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe Text
a -> GetWorkflowResponse
s {$sel:digest:GetWorkflowResponse' :: Maybe Text
digest = Maybe Text
a} :: GetWorkflowResponse)

-- | The workflow\'s engine.
getWorkflowResponse_engine :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe WorkflowEngine)
getWorkflowResponse_engine :: Lens' GetWorkflowResponse (Maybe WorkflowEngine)
getWorkflowResponse_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe WorkflowEngine
engine :: Maybe WorkflowEngine
$sel:engine:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowEngine
engine} -> Maybe WorkflowEngine
engine) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe WorkflowEngine
a -> GetWorkflowResponse
s {$sel:engine:GetWorkflowResponse' :: Maybe WorkflowEngine
engine = Maybe WorkflowEngine
a} :: GetWorkflowResponse)

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

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

-- | The workflow\'s name.
getWorkflowResponse_name :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Prelude.Text)
getWorkflowResponse_name :: Lens' GetWorkflowResponse (Maybe Text)
getWorkflowResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe Text
a -> GetWorkflowResponse
s {$sel:name:GetWorkflowResponse' :: Maybe Text
name = Maybe Text
a} :: GetWorkflowResponse)

-- | The workflow\'s parameter template.
getWorkflowResponse_parameterTemplate :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text WorkflowParameter))
getWorkflowResponse_parameterTemplate :: Lens' GetWorkflowResponse (Maybe (HashMap Text WorkflowParameter))
getWorkflowResponse_parameterTemplate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe (HashMap Text WorkflowParameter)
parameterTemplate :: Maybe (HashMap Text WorkflowParameter)
$sel:parameterTemplate:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe (HashMap Text WorkflowParameter)
parameterTemplate} -> Maybe (HashMap Text WorkflowParameter)
parameterTemplate) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe (HashMap Text WorkflowParameter)
a -> GetWorkflowResponse
s {$sel:parameterTemplate:GetWorkflowResponse' :: Maybe (HashMap Text WorkflowParameter)
parameterTemplate = Maybe (HashMap Text WorkflowParameter)
a} :: GetWorkflowResponse) 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 workflow\'s status.
getWorkflowResponse_status :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe WorkflowStatus)
getWorkflowResponse_status :: Lens' GetWorkflowResponse (Maybe WorkflowStatus)
getWorkflowResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe WorkflowStatus
status :: Maybe WorkflowStatus
$sel:status:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowStatus
status} -> Maybe WorkflowStatus
status) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe WorkflowStatus
a -> GetWorkflowResponse
s {$sel:status:GetWorkflowResponse' :: Maybe WorkflowStatus
status = Maybe WorkflowStatus
a} :: GetWorkflowResponse)

-- | The workflow\'s status message.
getWorkflowResponse_statusMessage :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Prelude.Text)
getWorkflowResponse_statusMessage :: Lens' GetWorkflowResponse (Maybe Text)
getWorkflowResponse_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe Text
a -> GetWorkflowResponse
s {$sel:statusMessage:GetWorkflowResponse' :: Maybe Text
statusMessage = Maybe Text
a} :: GetWorkflowResponse)

-- | The workflow\'s storage capacity.
getWorkflowResponse_storageCapacity :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Prelude.Natural)
getWorkflowResponse_storageCapacity :: Lens' GetWorkflowResponse (Maybe Natural)
getWorkflowResponse_storageCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe Natural
storageCapacity :: Maybe Natural
$sel:storageCapacity:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Natural
storageCapacity} -> Maybe Natural
storageCapacity) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe Natural
a -> GetWorkflowResponse
s {$sel:storageCapacity:GetWorkflowResponse' :: Maybe Natural
storageCapacity = Maybe Natural
a} :: GetWorkflowResponse)

-- | The workflow\'s tags.
getWorkflowResponse_tags :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getWorkflowResponse_tags :: Lens' GetWorkflowResponse (Maybe (HashMap Text Text))
getWorkflowResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe (HashMap Text Text)
a -> GetWorkflowResponse
s {$sel:tags:GetWorkflowResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetWorkflowResponse) 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 workflow\'s type.
getWorkflowResponse_type :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe WorkflowType)
getWorkflowResponse_type :: Lens' GetWorkflowResponse (Maybe WorkflowType)
getWorkflowResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe WorkflowType
type' :: Maybe WorkflowType
$sel:type':GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowType
type'} -> Maybe WorkflowType
type') (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe WorkflowType
a -> GetWorkflowResponse
s {$sel:type':GetWorkflowResponse' :: Maybe WorkflowType
type' = Maybe WorkflowType
a} :: GetWorkflowResponse)

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

instance Prelude.NFData GetWorkflowResponse where
  rnf :: GetWorkflowResponse -> ()
rnf GetWorkflowResponse' {Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text WorkflowParameter)
Maybe ISO8601
Maybe WorkflowEngine
Maybe WorkflowStatus
Maybe WorkflowType
httpStatus :: Int
type' :: Maybe WorkflowType
tags :: Maybe (HashMap Text Text)
storageCapacity :: Maybe Natural
statusMessage :: Maybe Text
status :: Maybe WorkflowStatus
parameterTemplate :: Maybe (HashMap Text WorkflowParameter)
name :: Maybe Text
main :: Maybe Text
id :: Maybe Text
engine :: Maybe WorkflowEngine
digest :: Maybe Text
description :: Maybe Text
definition :: Maybe Text
creationTime :: Maybe ISO8601
arn :: Maybe Text
$sel:httpStatus:GetWorkflowResponse' :: GetWorkflowResponse -> Int
$sel:type':GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowType
$sel:tags:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe (HashMap Text Text)
$sel:storageCapacity:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Natural
$sel:statusMessage:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
$sel:status:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowStatus
$sel:parameterTemplate:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe (HashMap Text WorkflowParameter)
$sel:name:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
$sel:main:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
$sel:id:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
$sel:engine:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowEngine
$sel:digest:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
$sel:description:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
$sel:definition:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
$sel:creationTime:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe ISO8601
$sel:arn:GetWorkflowResponse' :: GetWorkflowResponse -> 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 ISO8601
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
definition
      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 Text
digest
      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
id
      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 WorkflowStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusMessage
      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 Maybe WorkflowType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus