{-# 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.StepFunctions.StartExecution
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts a state machine execution. If the given state machine Amazon
-- Resource Name (ARN) is a qualified state machine ARN, it will fail with
-- ValidationException.
--
-- A qualified state machine ARN refers to a /Distributed Map state/
-- defined within a state machine. For example, the qualified state machine
-- ARN
-- @arn:partition:states:region:account-id:stateMachine:stateMachineName\/mapStateLabel@
-- refers to a /Distributed Map state/ with a label @mapStateLabel@ in the
-- state machine named @stateMachineName@.
--
-- @StartExecution@ is idempotent for @STANDARD@ workflows. For a
-- @STANDARD@ workflow, if @StartExecution@ is called with the same name
-- and input as a running execution, the call will succeed and return the
-- same response as the original request. If the execution is closed or if
-- the input is different, it will return a @400 ExecutionAlreadyExists@
-- error. Names can be reused after 90 days.
--
-- @StartExecution@ is not idempotent for @EXPRESS@ workflows.
module Amazonka.StepFunctions.StartExecution
  ( -- * Creating a Request
    StartExecution (..),
    newStartExecution,

    -- * Request Lenses
    startExecution_input,
    startExecution_name,
    startExecution_traceHeader,
    startExecution_stateMachineArn,

    -- * Destructuring the Response
    StartExecutionResponse (..),
    newStartExecutionResponse,

    -- * Response Lenses
    startExecutionResponse_httpStatus,
    startExecutionResponse_executionArn,
    startExecutionResponse_startDate,
  )
where

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

-- | /See:/ 'newStartExecution' smart constructor.
data StartExecution = StartExecution'
  { -- | The string that contains the JSON input data for the execution, for
    -- example:
    --
    -- @\"input\": \"{\\\"first_name\\\" : \\\"test\\\"}\"@
    --
    -- If you don\'t include any JSON input data, you still must include the
    -- two braces, for example: @\"input\": \"{}\"@
    --
    -- Length constraints apply to the payload size, and are expressed as bytes
    -- in UTF-8 encoding.
    StartExecution -> Maybe (Sensitive Text)
input :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The name of the execution. This name must be unique for your Amazon Web
    -- Services account, region, and state machine for 90 days. For more
    -- information, see
    -- <https://docs.aws.amazon.com/step-functions/latest/dg/limits.html#service-limits-state-machine-executions Limits Related to State Machine Executions>
    -- in the /Step Functions Developer Guide/.
    --
    -- A name must /not/ contain:
    --
    -- -   white space
    --
    -- -   brackets @\< > { } [ ]@
    --
    -- -   wildcard characters @? *@
    --
    -- -   special characters @\" # % \\ ^ | ~ \` $ & , ; : \/@
    --
    -- -   control characters (@U+0000-001F@, @U+007F-009F@)
    --
    -- To enable logging with CloudWatch Logs, the name should only contain
    -- 0-9, A-Z, a-z, - and _.
    StartExecution -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Passes the X-Ray trace header. The trace header can also be passed in
    -- the request payload.
    StartExecution -> Maybe Text
traceHeader :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the state machine to execute.
    StartExecution -> Text
stateMachineArn :: Prelude.Text
  }
  deriving (StartExecution -> StartExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartExecution -> StartExecution -> Bool
$c/= :: StartExecution -> StartExecution -> Bool
== :: StartExecution -> StartExecution -> Bool
$c== :: StartExecution -> StartExecution -> Bool
Prelude.Eq, Int -> StartExecution -> ShowS
[StartExecution] -> ShowS
StartExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartExecution] -> ShowS
$cshowList :: [StartExecution] -> ShowS
show :: StartExecution -> String
$cshow :: StartExecution -> String
showsPrec :: Int -> StartExecution -> ShowS
$cshowsPrec :: Int -> StartExecution -> ShowS
Prelude.Show, forall x. Rep StartExecution x -> StartExecution
forall x. StartExecution -> Rep StartExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartExecution x -> StartExecution
$cfrom :: forall x. StartExecution -> Rep StartExecution x
Prelude.Generic)

-- |
-- Create a value of 'StartExecution' 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:
--
-- 'input', 'startExecution_input' - The string that contains the JSON input data for the execution, for
-- example:
--
-- @\"input\": \"{\\\"first_name\\\" : \\\"test\\\"}\"@
--
-- If you don\'t include any JSON input data, you still must include the
-- two braces, for example: @\"input\": \"{}\"@
--
-- Length constraints apply to the payload size, and are expressed as bytes
-- in UTF-8 encoding.
--
-- 'name', 'startExecution_name' - The name of the execution. This name must be unique for your Amazon Web
-- Services account, region, and state machine for 90 days. For more
-- information, see
-- <https://docs.aws.amazon.com/step-functions/latest/dg/limits.html#service-limits-state-machine-executions Limits Related to State Machine Executions>
-- in the /Step Functions Developer Guide/.
--
-- A name must /not/ contain:
--
-- -   white space
--
-- -   brackets @\< > { } [ ]@
--
-- -   wildcard characters @? *@
--
-- -   special characters @\" # % \\ ^ | ~ \` $ & , ; : \/@
--
-- -   control characters (@U+0000-001F@, @U+007F-009F@)
--
-- To enable logging with CloudWatch Logs, the name should only contain
-- 0-9, A-Z, a-z, - and _.
--
-- 'traceHeader', 'startExecution_traceHeader' - Passes the X-Ray trace header. The trace header can also be passed in
-- the request payload.
--
-- 'stateMachineArn', 'startExecution_stateMachineArn' - The Amazon Resource Name (ARN) of the state machine to execute.
newStartExecution ::
  -- | 'stateMachineArn'
  Prelude.Text ->
  StartExecution
newStartExecution :: Text -> StartExecution
newStartExecution Text
pStateMachineArn_ =
  StartExecution'
    { $sel:input:StartExecution' :: Maybe (Sensitive Text)
input = forall a. Maybe a
Prelude.Nothing,
      $sel:name:StartExecution' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:traceHeader:StartExecution' :: Maybe Text
traceHeader = forall a. Maybe a
Prelude.Nothing,
      $sel:stateMachineArn:StartExecution' :: Text
stateMachineArn = Text
pStateMachineArn_
    }

-- | The string that contains the JSON input data for the execution, for
-- example:
--
-- @\"input\": \"{\\\"first_name\\\" : \\\"test\\\"}\"@
--
-- If you don\'t include any JSON input data, you still must include the
-- two braces, for example: @\"input\": \"{}\"@
--
-- Length constraints apply to the payload size, and are expressed as bytes
-- in UTF-8 encoding.
startExecution_input :: Lens.Lens' StartExecution (Prelude.Maybe Prelude.Text)
startExecution_input :: Lens' StartExecution (Maybe Text)
startExecution_input = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartExecution' {Maybe (Sensitive Text)
input :: Maybe (Sensitive Text)
$sel:input:StartExecution' :: StartExecution -> Maybe (Sensitive Text)
input} -> Maybe (Sensitive Text)
input) (\s :: StartExecution
s@StartExecution' {} Maybe (Sensitive Text)
a -> StartExecution
s {$sel:input:StartExecution' :: Maybe (Sensitive Text)
input = Maybe (Sensitive Text)
a} :: StartExecution) 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. Iso' (Sensitive a) a
Data._Sensitive

-- | The name of the execution. This name must be unique for your Amazon Web
-- Services account, region, and state machine for 90 days. For more
-- information, see
-- <https://docs.aws.amazon.com/step-functions/latest/dg/limits.html#service-limits-state-machine-executions Limits Related to State Machine Executions>
-- in the /Step Functions Developer Guide/.
--
-- A name must /not/ contain:
--
-- -   white space
--
-- -   brackets @\< > { } [ ]@
--
-- -   wildcard characters @? *@
--
-- -   special characters @\" # % \\ ^ | ~ \` $ & , ; : \/@
--
-- -   control characters (@U+0000-001F@, @U+007F-009F@)
--
-- To enable logging with CloudWatch Logs, the name should only contain
-- 0-9, A-Z, a-z, - and _.
startExecution_name :: Lens.Lens' StartExecution (Prelude.Maybe Prelude.Text)
startExecution_name :: Lens' StartExecution (Maybe Text)
startExecution_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartExecution' {Maybe Text
name :: Maybe Text
$sel:name:StartExecution' :: StartExecution -> Maybe Text
name} -> Maybe Text
name) (\s :: StartExecution
s@StartExecution' {} Maybe Text
a -> StartExecution
s {$sel:name:StartExecution' :: Maybe Text
name = Maybe Text
a} :: StartExecution)

-- | Passes the X-Ray trace header. The trace header can also be passed in
-- the request payload.
startExecution_traceHeader :: Lens.Lens' StartExecution (Prelude.Maybe Prelude.Text)
startExecution_traceHeader :: Lens' StartExecution (Maybe Text)
startExecution_traceHeader = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartExecution' {Maybe Text
traceHeader :: Maybe Text
$sel:traceHeader:StartExecution' :: StartExecution -> Maybe Text
traceHeader} -> Maybe Text
traceHeader) (\s :: StartExecution
s@StartExecution' {} Maybe Text
a -> StartExecution
s {$sel:traceHeader:StartExecution' :: Maybe Text
traceHeader = Maybe Text
a} :: StartExecution)

-- | The Amazon Resource Name (ARN) of the state machine to execute.
startExecution_stateMachineArn :: Lens.Lens' StartExecution Prelude.Text
startExecution_stateMachineArn :: Lens' StartExecution Text
startExecution_stateMachineArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartExecution' {Text
stateMachineArn :: Text
$sel:stateMachineArn:StartExecution' :: StartExecution -> Text
stateMachineArn} -> Text
stateMachineArn) (\s :: StartExecution
s@StartExecution' {} Text
a -> StartExecution
s {$sel:stateMachineArn:StartExecution' :: Text
stateMachineArn = Text
a} :: StartExecution)

instance Core.AWSRequest StartExecution where
  type
    AWSResponse StartExecution =
      StartExecutionResponse
  request :: (Service -> Service) -> StartExecution -> Request StartExecution
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 StartExecution
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartExecution)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> POSIX -> StartExecutionResponse
StartExecutionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"executionArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"startDate")
      )

instance Prelude.Hashable StartExecution where
  hashWithSalt :: Int -> StartExecution -> Int
hashWithSalt Int
_salt StartExecution' {Maybe Text
Maybe (Sensitive Text)
Text
stateMachineArn :: Text
traceHeader :: Maybe Text
name :: Maybe Text
input :: Maybe (Sensitive Text)
$sel:stateMachineArn:StartExecution' :: StartExecution -> Text
$sel:traceHeader:StartExecution' :: StartExecution -> Maybe Text
$sel:name:StartExecution' :: StartExecution -> Maybe Text
$sel:input:StartExecution' :: StartExecution -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
input
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
traceHeader
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stateMachineArn

instance Prelude.NFData StartExecution where
  rnf :: StartExecution -> ()
rnf StartExecution' {Maybe Text
Maybe (Sensitive Text)
Text
stateMachineArn :: Text
traceHeader :: Maybe Text
name :: Maybe Text
input :: Maybe (Sensitive Text)
$sel:stateMachineArn:StartExecution' :: StartExecution -> Text
$sel:traceHeader:StartExecution' :: StartExecution -> Maybe Text
$sel:name:StartExecution' :: StartExecution -> Maybe Text
$sel:input:StartExecution' :: StartExecution -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
input
      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
traceHeader
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stateMachineArn

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

instance Data.ToJSON StartExecution where
  toJSON :: StartExecution -> Value
toJSON StartExecution' {Maybe Text
Maybe (Sensitive Text)
Text
stateMachineArn :: Text
traceHeader :: Maybe Text
name :: Maybe Text
input :: Maybe (Sensitive Text)
$sel:stateMachineArn:StartExecution' :: StartExecution -> Text
$sel:traceHeader:StartExecution' :: StartExecution -> Maybe Text
$sel:name:StartExecution' :: StartExecution -> Maybe Text
$sel:input:StartExecution' :: StartExecution -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"input" 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 (Sensitive Text)
input,
            (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
"traceHeader" 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
traceHeader,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"stateMachineArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stateMachineArn)
          ]
      )

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

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

-- | /See:/ 'newStartExecutionResponse' smart constructor.
data StartExecutionResponse = StartExecutionResponse'
  { -- | The response's http status code.
    StartExecutionResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) that identifies the execution.
    StartExecutionResponse -> Text
executionArn :: Prelude.Text,
    -- | The date the execution is started.
    StartExecutionResponse -> POSIX
startDate :: Data.POSIX
  }
  deriving (StartExecutionResponse -> StartExecutionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartExecutionResponse -> StartExecutionResponse -> Bool
$c/= :: StartExecutionResponse -> StartExecutionResponse -> Bool
== :: StartExecutionResponse -> StartExecutionResponse -> Bool
$c== :: StartExecutionResponse -> StartExecutionResponse -> Bool
Prelude.Eq, ReadPrec [StartExecutionResponse]
ReadPrec StartExecutionResponse
Int -> ReadS StartExecutionResponse
ReadS [StartExecutionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartExecutionResponse]
$creadListPrec :: ReadPrec [StartExecutionResponse]
readPrec :: ReadPrec StartExecutionResponse
$creadPrec :: ReadPrec StartExecutionResponse
readList :: ReadS [StartExecutionResponse]
$creadList :: ReadS [StartExecutionResponse]
readsPrec :: Int -> ReadS StartExecutionResponse
$creadsPrec :: Int -> ReadS StartExecutionResponse
Prelude.Read, Int -> StartExecutionResponse -> ShowS
[StartExecutionResponse] -> ShowS
StartExecutionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartExecutionResponse] -> ShowS
$cshowList :: [StartExecutionResponse] -> ShowS
show :: StartExecutionResponse -> String
$cshow :: StartExecutionResponse -> String
showsPrec :: Int -> StartExecutionResponse -> ShowS
$cshowsPrec :: Int -> StartExecutionResponse -> ShowS
Prelude.Show, forall x. Rep StartExecutionResponse x -> StartExecutionResponse
forall x. StartExecutionResponse -> Rep StartExecutionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartExecutionResponse x -> StartExecutionResponse
$cfrom :: forall x. StartExecutionResponse -> Rep StartExecutionResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartExecutionResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'startExecutionResponse_httpStatus' - The response's http status code.
--
-- 'executionArn', 'startExecutionResponse_executionArn' - The Amazon Resource Name (ARN) that identifies the execution.
--
-- 'startDate', 'startExecutionResponse_startDate' - The date the execution is started.
newStartExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'executionArn'
  Prelude.Text ->
  -- | 'startDate'
  Prelude.UTCTime ->
  StartExecutionResponse
newStartExecutionResponse :: Int -> Text -> UTCTime -> StartExecutionResponse
newStartExecutionResponse
  Int
pHttpStatus_
  Text
pExecutionArn_
  UTCTime
pStartDate_ =
    StartExecutionResponse'
      { $sel:httpStatus:StartExecutionResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:executionArn:StartExecutionResponse' :: Text
executionArn = Text
pExecutionArn_,
        $sel:startDate:StartExecutionResponse' :: POSIX
startDate = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartDate_
      }

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

-- | The Amazon Resource Name (ARN) that identifies the execution.
startExecutionResponse_executionArn :: Lens.Lens' StartExecutionResponse Prelude.Text
startExecutionResponse_executionArn :: Lens' StartExecutionResponse Text
startExecutionResponse_executionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartExecutionResponse' {Text
executionArn :: Text
$sel:executionArn:StartExecutionResponse' :: StartExecutionResponse -> Text
executionArn} -> Text
executionArn) (\s :: StartExecutionResponse
s@StartExecutionResponse' {} Text
a -> StartExecutionResponse
s {$sel:executionArn:StartExecutionResponse' :: Text
executionArn = Text
a} :: StartExecutionResponse)

-- | The date the execution is started.
startExecutionResponse_startDate :: Lens.Lens' StartExecutionResponse Prelude.UTCTime
startExecutionResponse_startDate :: Lens' StartExecutionResponse UTCTime
startExecutionResponse_startDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartExecutionResponse' {POSIX
startDate :: POSIX
$sel:startDate:StartExecutionResponse' :: StartExecutionResponse -> POSIX
startDate} -> POSIX
startDate) (\s :: StartExecutionResponse
s@StartExecutionResponse' {} POSIX
a -> StartExecutionResponse
s {$sel:startDate:StartExecutionResponse' :: POSIX
startDate = POSIX
a} :: StartExecutionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

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