{-# 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.GetRun
-- 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 run.
module Amazonka.Omics.GetRun
  ( -- * Creating a Request
    GetRun (..),
    newGetRun,

    -- * Request Lenses
    getRun_export,
    getRun_id,

    -- * Destructuring the Response
    GetRunResponse (..),
    newGetRunResponse,

    -- * Response Lenses
    getRunResponse_arn,
    getRunResponse_creationTime,
    getRunResponse_definition,
    getRunResponse_digest,
    getRunResponse_id,
    getRunResponse_logLevel,
    getRunResponse_name,
    getRunResponse_outputUri,
    getRunResponse_parameters,
    getRunResponse_priority,
    getRunResponse_resourceDigests,
    getRunResponse_roleArn,
    getRunResponse_runGroupId,
    getRunResponse_runId,
    getRunResponse_startTime,
    getRunResponse_startedBy,
    getRunResponse_status,
    getRunResponse_statusMessage,
    getRunResponse_stopTime,
    getRunResponse_storageCapacity,
    getRunResponse_tags,
    getRunResponse_workflowId,
    getRunResponse_workflowType,
    getRunResponse_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:/ 'newGetRun' smart constructor.
data GetRun = GetRun'
  { -- | The run\'s export format.
    GetRun -> Maybe [RunExport]
export' :: Prelude.Maybe [RunExport],
    -- | The run\'s ID.
    GetRun -> Text
id :: Prelude.Text
  }
  deriving (GetRun -> GetRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRun -> GetRun -> Bool
$c/= :: GetRun -> GetRun -> Bool
== :: GetRun -> GetRun -> Bool
$c== :: GetRun -> GetRun -> Bool
Prelude.Eq, ReadPrec [GetRun]
ReadPrec GetRun
Int -> ReadS GetRun
ReadS [GetRun]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRun]
$creadListPrec :: ReadPrec [GetRun]
readPrec :: ReadPrec GetRun
$creadPrec :: ReadPrec GetRun
readList :: ReadS [GetRun]
$creadList :: ReadS [GetRun]
readsPrec :: Int -> ReadS GetRun
$creadsPrec :: Int -> ReadS GetRun
Prelude.Read, Int -> GetRun -> ShowS
[GetRun] -> ShowS
GetRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRun] -> ShowS
$cshowList :: [GetRun] -> ShowS
show :: GetRun -> String
$cshow :: GetRun -> String
showsPrec :: Int -> GetRun -> ShowS
$cshowsPrec :: Int -> GetRun -> ShowS
Prelude.Show, forall x. Rep GetRun x -> GetRun
forall x. GetRun -> Rep GetRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetRun x -> GetRun
$cfrom :: forall x. GetRun -> Rep GetRun x
Prelude.Generic)

-- |
-- Create a value of 'GetRun' 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'', 'getRun_export' - The run\'s export format.
--
-- 'id', 'getRun_id' - The run\'s ID.
newGetRun ::
  -- | 'id'
  Prelude.Text ->
  GetRun
newGetRun :: Text -> GetRun
newGetRun Text
pId_ =
  GetRun' {$sel:export':GetRun' :: Maybe [RunExport]
export' = forall a. Maybe a
Prelude.Nothing, $sel:id:GetRun' :: Text
id = Text
pId_}

-- | The run\'s export format.
getRun_export :: Lens.Lens' GetRun (Prelude.Maybe [RunExport])
getRun_export :: Lens' GetRun (Maybe [RunExport])
getRun_export = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRun' {Maybe [RunExport]
export' :: Maybe [RunExport]
$sel:export':GetRun' :: GetRun -> Maybe [RunExport]
export'} -> Maybe [RunExport]
export') (\s :: GetRun
s@GetRun' {} Maybe [RunExport]
a -> GetRun
s {$sel:export':GetRun' :: Maybe [RunExport]
export' = Maybe [RunExport]
a} :: GetRun) 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 run\'s ID.
getRun_id :: Lens.Lens' GetRun Prelude.Text
getRun_id :: Lens' GetRun Text
getRun_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRun' {Text
id :: Text
$sel:id:GetRun' :: GetRun -> Text
id} -> Text
id) (\s :: GetRun
s@GetRun' {} Text
a -> GetRun
s {$sel:id:GetRun' :: Text
id = Text
a} :: GetRun)

instance Core.AWSRequest GetRun where
  type AWSResponse GetRun = GetRunResponse
  request :: (Service -> Service) -> GetRun -> Request GetRun
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 GetRun
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetRun)))
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 RunLogLevel
-> Maybe Text
-> Maybe Text
-> Maybe RunParameters
-> Maybe Natural
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ISO8601
-> Maybe Text
-> Maybe RunStatus
-> Maybe Text
-> Maybe ISO8601
-> Maybe Natural
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Maybe WorkflowType
-> Int
-> GetRunResponse
GetRunResponse'
            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
"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
"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
"logLevel")
            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
"outputUri")
            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
"parameters")
            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
"priority")
            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
"resourceDigests"
                            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
"roleArn")
            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
"runGroupId")
            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
"runId")
            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
"startTime")
            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
"startedBy")
            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
"stopTime")
            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
"workflowId")
            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
"workflowType")
            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 GetRun where
  hashWithSalt :: Int -> GetRun -> Int
hashWithSalt Int
_salt GetRun' {Maybe [RunExport]
Text
id :: Text
export' :: Maybe [RunExport]
$sel:id:GetRun' :: GetRun -> Text
$sel:export':GetRun' :: GetRun -> Maybe [RunExport]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [RunExport]
export'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

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

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

instance Data.ToQuery GetRun where
  toQuery :: GetRun -> QueryString
toQuery GetRun' {Maybe [RunExport]
Text
id :: Text
export' :: Maybe [RunExport]
$sel:id:GetRun' :: GetRun -> Text
$sel:export':GetRun' :: GetRun -> Maybe [RunExport]
..} =
    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 [RunExport]
export')
      ]

-- | /See:/ 'newGetRunResponse' smart constructor.
data GetRunResponse = GetRunResponse'
  { -- | The run\'s ARN.
    GetRunResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | When the run was created.
    GetRunResponse -> Maybe ISO8601
creationTime :: Prelude.Maybe Data.ISO8601,
    -- | The run\'s definition.
    GetRunResponse -> Maybe Text
definition :: Prelude.Maybe Prelude.Text,
    -- | The run\'s digest.
    GetRunResponse -> Maybe Text
digest :: Prelude.Maybe Prelude.Text,
    -- | The run\'s ID.
    GetRunResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The run\'s log level.
    GetRunResponse -> Maybe RunLogLevel
logLevel :: Prelude.Maybe RunLogLevel,
    -- | The run\'s name.
    GetRunResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The run\'s output URI.
    GetRunResponse -> Maybe Text
outputUri :: Prelude.Maybe Prelude.Text,
    -- | The run\'s parameters.
    GetRunResponse -> Maybe RunParameters
parameters :: Prelude.Maybe RunParameters,
    -- | The run\'s priority.
    GetRunResponse -> Maybe Natural
priority :: Prelude.Maybe Prelude.Natural,
    -- | The run\'s resource digests.
    GetRunResponse -> Maybe (HashMap Text Text)
resourceDigests :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The run\'s service role ARN.
    GetRunResponse -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The run\'s group ID.
    GetRunResponse -> Maybe Text
runGroupId :: Prelude.Maybe Prelude.Text,
    -- | The run\'s ID.
    GetRunResponse -> Maybe Text
runId :: Prelude.Maybe Prelude.Text,
    -- | When the run started.
    GetRunResponse -> Maybe ISO8601
startTime :: Prelude.Maybe Data.ISO8601,
    -- | Who started the run.
    GetRunResponse -> Maybe Text
startedBy :: Prelude.Maybe Prelude.Text,
    -- | The run\'s status.
    GetRunResponse -> Maybe RunStatus
status :: Prelude.Maybe RunStatus,
    -- | The run\'s status message.
    GetRunResponse -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | The run\'s stop time.
    GetRunResponse -> Maybe ISO8601
stopTime :: Prelude.Maybe Data.ISO8601,
    -- | The run\'s storage capacity.
    GetRunResponse -> Maybe Natural
storageCapacity :: Prelude.Maybe Prelude.Natural,
    -- | The run\'s tags.
    GetRunResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The run\'s workflow ID.
    GetRunResponse -> Maybe Text
workflowId :: Prelude.Maybe Prelude.Text,
    -- | The run\'s workflow type.
    GetRunResponse -> Maybe WorkflowType
workflowType :: Prelude.Maybe WorkflowType,
    -- | The response's http status code.
    GetRunResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetRunResponse -> GetRunResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRunResponse -> GetRunResponse -> Bool
$c/= :: GetRunResponse -> GetRunResponse -> Bool
== :: GetRunResponse -> GetRunResponse -> Bool
$c== :: GetRunResponse -> GetRunResponse -> Bool
Prelude.Eq, ReadPrec [GetRunResponse]
ReadPrec GetRunResponse
Int -> ReadS GetRunResponse
ReadS [GetRunResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRunResponse]
$creadListPrec :: ReadPrec [GetRunResponse]
readPrec :: ReadPrec GetRunResponse
$creadPrec :: ReadPrec GetRunResponse
readList :: ReadS [GetRunResponse]
$creadList :: ReadS [GetRunResponse]
readsPrec :: Int -> ReadS GetRunResponse
$creadsPrec :: Int -> ReadS GetRunResponse
Prelude.Read, Int -> GetRunResponse -> ShowS
[GetRunResponse] -> ShowS
GetRunResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRunResponse] -> ShowS
$cshowList :: [GetRunResponse] -> ShowS
show :: GetRunResponse -> String
$cshow :: GetRunResponse -> String
showsPrec :: Int -> GetRunResponse -> ShowS
$cshowsPrec :: Int -> GetRunResponse -> ShowS
Prelude.Show, forall x. Rep GetRunResponse x -> GetRunResponse
forall x. GetRunResponse -> Rep GetRunResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetRunResponse x -> GetRunResponse
$cfrom :: forall x. GetRunResponse -> Rep GetRunResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetRunResponse' 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', 'getRunResponse_arn' - The run\'s ARN.
--
-- 'creationTime', 'getRunResponse_creationTime' - When the run was created.
--
-- 'definition', 'getRunResponse_definition' - The run\'s definition.
--
-- 'digest', 'getRunResponse_digest' - The run\'s digest.
--
-- 'id', 'getRunResponse_id' - The run\'s ID.
--
-- 'logLevel', 'getRunResponse_logLevel' - The run\'s log level.
--
-- 'name', 'getRunResponse_name' - The run\'s name.
--
-- 'outputUri', 'getRunResponse_outputUri' - The run\'s output URI.
--
-- 'parameters', 'getRunResponse_parameters' - The run\'s parameters.
--
-- 'priority', 'getRunResponse_priority' - The run\'s priority.
--
-- 'resourceDigests', 'getRunResponse_resourceDigests' - The run\'s resource digests.
--
-- 'roleArn', 'getRunResponse_roleArn' - The run\'s service role ARN.
--
-- 'runGroupId', 'getRunResponse_runGroupId' - The run\'s group ID.
--
-- 'runId', 'getRunResponse_runId' - The run\'s ID.
--
-- 'startTime', 'getRunResponse_startTime' - When the run started.
--
-- 'startedBy', 'getRunResponse_startedBy' - Who started the run.
--
-- 'status', 'getRunResponse_status' - The run\'s status.
--
-- 'statusMessage', 'getRunResponse_statusMessage' - The run\'s status message.
--
-- 'stopTime', 'getRunResponse_stopTime' - The run\'s stop time.
--
-- 'storageCapacity', 'getRunResponse_storageCapacity' - The run\'s storage capacity.
--
-- 'tags', 'getRunResponse_tags' - The run\'s tags.
--
-- 'workflowId', 'getRunResponse_workflowId' - The run\'s workflow ID.
--
-- 'workflowType', 'getRunResponse_workflowType' - The run\'s workflow type.
--
-- 'httpStatus', 'getRunResponse_httpStatus' - The response's http status code.
newGetRunResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetRunResponse
newGetRunResponse :: Int -> GetRunResponse
newGetRunResponse Int
pHttpStatus_ =
  GetRunResponse'
    { $sel:arn:GetRunResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:GetRunResponse' :: Maybe ISO8601
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:definition:GetRunResponse' :: Maybe Text
definition = forall a. Maybe a
Prelude.Nothing,
      $sel:digest:GetRunResponse' :: Maybe Text
digest = forall a. Maybe a
Prelude.Nothing,
      $sel:id:GetRunResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:logLevel:GetRunResponse' :: Maybe RunLogLevel
logLevel = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetRunResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:outputUri:GetRunResponse' :: Maybe Text
outputUri = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:GetRunResponse' :: Maybe RunParameters
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:priority:GetRunResponse' :: Maybe Natural
priority = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceDigests:GetRunResponse' :: Maybe (HashMap Text Text)
resourceDigests = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:GetRunResponse' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:runGroupId:GetRunResponse' :: Maybe Text
runGroupId = forall a. Maybe a
Prelude.Nothing,
      $sel:runId:GetRunResponse' :: Maybe Text
runId = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:GetRunResponse' :: Maybe ISO8601
startTime = forall a. Maybe a
Prelude.Nothing,
      $sel:startedBy:GetRunResponse' :: Maybe Text
startedBy = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetRunResponse' :: Maybe RunStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:GetRunResponse' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:stopTime:GetRunResponse' :: Maybe ISO8601
stopTime = forall a. Maybe a
Prelude.Nothing,
      $sel:storageCapacity:GetRunResponse' :: Maybe Natural
storageCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:GetRunResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:workflowId:GetRunResponse' :: Maybe Text
workflowId = forall a. Maybe a
Prelude.Nothing,
      $sel:workflowType:GetRunResponse' :: Maybe WorkflowType
workflowType = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetRunResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | When the run was created.
getRunResponse_creationTime :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.UTCTime)
getRunResponse_creationTime :: Lens' GetRunResponse (Maybe UTCTime)
getRunResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe ISO8601
creationTime :: Maybe ISO8601
$sel:creationTime:GetRunResponse' :: GetRunResponse -> Maybe ISO8601
creationTime} -> Maybe ISO8601
creationTime) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe ISO8601
a -> GetRunResponse
s {$sel:creationTime:GetRunResponse' :: Maybe ISO8601
creationTime = Maybe ISO8601
a} :: GetRunResponse) 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 run\'s definition.
getRunResponse_definition :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.Text)
getRunResponse_definition :: Lens' GetRunResponse (Maybe Text)
getRunResponse_definition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe Text
definition :: Maybe Text
$sel:definition:GetRunResponse' :: GetRunResponse -> Maybe Text
definition} -> Maybe Text
definition) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe Text
a -> GetRunResponse
s {$sel:definition:GetRunResponse' :: Maybe Text
definition = Maybe Text
a} :: GetRunResponse)

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

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

-- | The run\'s log level.
getRunResponse_logLevel :: Lens.Lens' GetRunResponse (Prelude.Maybe RunLogLevel)
getRunResponse_logLevel :: Lens' GetRunResponse (Maybe RunLogLevel)
getRunResponse_logLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe RunLogLevel
logLevel :: Maybe RunLogLevel
$sel:logLevel:GetRunResponse' :: GetRunResponse -> Maybe RunLogLevel
logLevel} -> Maybe RunLogLevel
logLevel) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe RunLogLevel
a -> GetRunResponse
s {$sel:logLevel:GetRunResponse' :: Maybe RunLogLevel
logLevel = Maybe RunLogLevel
a} :: GetRunResponse)

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

-- | The run\'s output URI.
getRunResponse_outputUri :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.Text)
getRunResponse_outputUri :: Lens' GetRunResponse (Maybe Text)
getRunResponse_outputUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe Text
outputUri :: Maybe Text
$sel:outputUri:GetRunResponse' :: GetRunResponse -> Maybe Text
outputUri} -> Maybe Text
outputUri) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe Text
a -> GetRunResponse
s {$sel:outputUri:GetRunResponse' :: Maybe Text
outputUri = Maybe Text
a} :: GetRunResponse)

-- | The run\'s parameters.
getRunResponse_parameters :: Lens.Lens' GetRunResponse (Prelude.Maybe RunParameters)
getRunResponse_parameters :: Lens' GetRunResponse (Maybe RunParameters)
getRunResponse_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe RunParameters
parameters :: Maybe RunParameters
$sel:parameters:GetRunResponse' :: GetRunResponse -> Maybe RunParameters
parameters} -> Maybe RunParameters
parameters) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe RunParameters
a -> GetRunResponse
s {$sel:parameters:GetRunResponse' :: Maybe RunParameters
parameters = Maybe RunParameters
a} :: GetRunResponse)

-- | The run\'s priority.
getRunResponse_priority :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.Natural)
getRunResponse_priority :: Lens' GetRunResponse (Maybe Natural)
getRunResponse_priority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe Natural
priority :: Maybe Natural
$sel:priority:GetRunResponse' :: GetRunResponse -> Maybe Natural
priority} -> Maybe Natural
priority) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe Natural
a -> GetRunResponse
s {$sel:priority:GetRunResponse' :: Maybe Natural
priority = Maybe Natural
a} :: GetRunResponse)

-- | The run\'s resource digests.
getRunResponse_resourceDigests :: Lens.Lens' GetRunResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getRunResponse_resourceDigests :: Lens' GetRunResponse (Maybe (HashMap Text Text))
getRunResponse_resourceDigests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe (HashMap Text Text)
resourceDigests :: Maybe (HashMap Text Text)
$sel:resourceDigests:GetRunResponse' :: GetRunResponse -> Maybe (HashMap Text Text)
resourceDigests} -> Maybe (HashMap Text Text)
resourceDigests) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe (HashMap Text Text)
a -> GetRunResponse
s {$sel:resourceDigests:GetRunResponse' :: Maybe (HashMap Text Text)
resourceDigests = Maybe (HashMap Text Text)
a} :: GetRunResponse) 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 run\'s service role ARN.
getRunResponse_roleArn :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.Text)
getRunResponse_roleArn :: Lens' GetRunResponse (Maybe Text)
getRunResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:GetRunResponse' :: GetRunResponse -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe Text
a -> GetRunResponse
s {$sel:roleArn:GetRunResponse' :: Maybe Text
roleArn = Maybe Text
a} :: GetRunResponse)

-- | The run\'s group ID.
getRunResponse_runGroupId :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.Text)
getRunResponse_runGroupId :: Lens' GetRunResponse (Maybe Text)
getRunResponse_runGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe Text
runGroupId :: Maybe Text
$sel:runGroupId:GetRunResponse' :: GetRunResponse -> Maybe Text
runGroupId} -> Maybe Text
runGroupId) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe Text
a -> GetRunResponse
s {$sel:runGroupId:GetRunResponse' :: Maybe Text
runGroupId = Maybe Text
a} :: GetRunResponse)

-- | The run\'s ID.
getRunResponse_runId :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.Text)
getRunResponse_runId :: Lens' GetRunResponse (Maybe Text)
getRunResponse_runId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe Text
runId :: Maybe Text
$sel:runId:GetRunResponse' :: GetRunResponse -> Maybe Text
runId} -> Maybe Text
runId) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe Text
a -> GetRunResponse
s {$sel:runId:GetRunResponse' :: Maybe Text
runId = Maybe Text
a} :: GetRunResponse)

-- | When the run started.
getRunResponse_startTime :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.UTCTime)
getRunResponse_startTime :: Lens' GetRunResponse (Maybe UTCTime)
getRunResponse_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe ISO8601
startTime :: Maybe ISO8601
$sel:startTime:GetRunResponse' :: GetRunResponse -> Maybe ISO8601
startTime} -> Maybe ISO8601
startTime) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe ISO8601
a -> GetRunResponse
s {$sel:startTime:GetRunResponse' :: Maybe ISO8601
startTime = Maybe ISO8601
a} :: GetRunResponse) 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

-- | Who started the run.
getRunResponse_startedBy :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.Text)
getRunResponse_startedBy :: Lens' GetRunResponse (Maybe Text)
getRunResponse_startedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe Text
startedBy :: Maybe Text
$sel:startedBy:GetRunResponse' :: GetRunResponse -> Maybe Text
startedBy} -> Maybe Text
startedBy) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe Text
a -> GetRunResponse
s {$sel:startedBy:GetRunResponse' :: Maybe Text
startedBy = Maybe Text
a} :: GetRunResponse)

-- | The run\'s status.
getRunResponse_status :: Lens.Lens' GetRunResponse (Prelude.Maybe RunStatus)
getRunResponse_status :: Lens' GetRunResponse (Maybe RunStatus)
getRunResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe RunStatus
status :: Maybe RunStatus
$sel:status:GetRunResponse' :: GetRunResponse -> Maybe RunStatus
status} -> Maybe RunStatus
status) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe RunStatus
a -> GetRunResponse
s {$sel:status:GetRunResponse' :: Maybe RunStatus
status = Maybe RunStatus
a} :: GetRunResponse)

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

-- | The run\'s stop time.
getRunResponse_stopTime :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.UTCTime)
getRunResponse_stopTime :: Lens' GetRunResponse (Maybe UTCTime)
getRunResponse_stopTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe ISO8601
stopTime :: Maybe ISO8601
$sel:stopTime:GetRunResponse' :: GetRunResponse -> Maybe ISO8601
stopTime} -> Maybe ISO8601
stopTime) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe ISO8601
a -> GetRunResponse
s {$sel:stopTime:GetRunResponse' :: Maybe ISO8601
stopTime = Maybe ISO8601
a} :: GetRunResponse) 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 run\'s storage capacity.
getRunResponse_storageCapacity :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.Natural)
getRunResponse_storageCapacity :: Lens' GetRunResponse (Maybe Natural)
getRunResponse_storageCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe Natural
storageCapacity :: Maybe Natural
$sel:storageCapacity:GetRunResponse' :: GetRunResponse -> Maybe Natural
storageCapacity} -> Maybe Natural
storageCapacity) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe Natural
a -> GetRunResponse
s {$sel:storageCapacity:GetRunResponse' :: Maybe Natural
storageCapacity = Maybe Natural
a} :: GetRunResponse)

-- | The run\'s tags.
getRunResponse_tags :: Lens.Lens' GetRunResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getRunResponse_tags :: Lens' GetRunResponse (Maybe (HashMap Text Text))
getRunResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetRunResponse' :: GetRunResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe (HashMap Text Text)
a -> GetRunResponse
s {$sel:tags:GetRunResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetRunResponse) 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 run\'s workflow ID.
getRunResponse_workflowId :: Lens.Lens' GetRunResponse (Prelude.Maybe Prelude.Text)
getRunResponse_workflowId :: Lens' GetRunResponse (Maybe Text)
getRunResponse_workflowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe Text
workflowId :: Maybe Text
$sel:workflowId:GetRunResponse' :: GetRunResponse -> Maybe Text
workflowId} -> Maybe Text
workflowId) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe Text
a -> GetRunResponse
s {$sel:workflowId:GetRunResponse' :: Maybe Text
workflowId = Maybe Text
a} :: GetRunResponse)

-- | The run\'s workflow type.
getRunResponse_workflowType :: Lens.Lens' GetRunResponse (Prelude.Maybe WorkflowType)
getRunResponse_workflowType :: Lens' GetRunResponse (Maybe WorkflowType)
getRunResponse_workflowType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRunResponse' {Maybe WorkflowType
workflowType :: Maybe WorkflowType
$sel:workflowType:GetRunResponse' :: GetRunResponse -> Maybe WorkflowType
workflowType} -> Maybe WorkflowType
workflowType) (\s :: GetRunResponse
s@GetRunResponse' {} Maybe WorkflowType
a -> GetRunResponse
s {$sel:workflowType:GetRunResponse' :: Maybe WorkflowType
workflowType = Maybe WorkflowType
a} :: GetRunResponse)

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

instance Prelude.NFData GetRunResponse where
  rnf :: GetRunResponse -> ()
rnf GetRunResponse' {Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe ISO8601
Maybe RunLogLevel
Maybe RunParameters
Maybe RunStatus
Maybe WorkflowType
httpStatus :: Int
workflowType :: Maybe WorkflowType
workflowId :: Maybe Text
tags :: Maybe (HashMap Text Text)
storageCapacity :: Maybe Natural
stopTime :: Maybe ISO8601
statusMessage :: Maybe Text
status :: Maybe RunStatus
startedBy :: Maybe Text
startTime :: Maybe ISO8601
runId :: Maybe Text
runGroupId :: Maybe Text
roleArn :: Maybe Text
resourceDigests :: Maybe (HashMap Text Text)
priority :: Maybe Natural
parameters :: Maybe RunParameters
outputUri :: Maybe Text
name :: Maybe Text
logLevel :: Maybe RunLogLevel
id :: Maybe Text
digest :: Maybe Text
definition :: Maybe Text
creationTime :: Maybe ISO8601
arn :: Maybe Text
$sel:httpStatus:GetRunResponse' :: GetRunResponse -> Int
$sel:workflowType:GetRunResponse' :: GetRunResponse -> Maybe WorkflowType
$sel:workflowId:GetRunResponse' :: GetRunResponse -> Maybe Text
$sel:tags:GetRunResponse' :: GetRunResponse -> Maybe (HashMap Text Text)
$sel:storageCapacity:GetRunResponse' :: GetRunResponse -> Maybe Natural
$sel:stopTime:GetRunResponse' :: GetRunResponse -> Maybe ISO8601
$sel:statusMessage:GetRunResponse' :: GetRunResponse -> Maybe Text
$sel:status:GetRunResponse' :: GetRunResponse -> Maybe RunStatus
$sel:startedBy:GetRunResponse' :: GetRunResponse -> Maybe Text
$sel:startTime:GetRunResponse' :: GetRunResponse -> Maybe ISO8601
$sel:runId:GetRunResponse' :: GetRunResponse -> Maybe Text
$sel:runGroupId:GetRunResponse' :: GetRunResponse -> Maybe Text
$sel:roleArn:GetRunResponse' :: GetRunResponse -> Maybe Text
$sel:resourceDigests:GetRunResponse' :: GetRunResponse -> Maybe (HashMap Text Text)
$sel:priority:GetRunResponse' :: GetRunResponse -> Maybe Natural
$sel:parameters:GetRunResponse' :: GetRunResponse -> Maybe RunParameters
$sel:outputUri:GetRunResponse' :: GetRunResponse -> Maybe Text
$sel:name:GetRunResponse' :: GetRunResponse -> Maybe Text
$sel:logLevel:GetRunResponse' :: GetRunResponse -> Maybe RunLogLevel
$sel:id:GetRunResponse' :: GetRunResponse -> Maybe Text
$sel:digest:GetRunResponse' :: GetRunResponse -> Maybe Text
$sel:definition:GetRunResponse' :: GetRunResponse -> Maybe Text
$sel:creationTime:GetRunResponse' :: GetRunResponse -> Maybe ISO8601
$sel:arn:GetRunResponse' :: GetRunResponse -> 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
digest
      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 RunLogLevel
logLevel
      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 Text
outputUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RunParameters
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
priority
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
resourceDigests
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
runGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
runId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
startedBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RunStatus
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 ISO8601
stopTime
      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 Text
workflowId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowType
workflowType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus