{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.SSM.Types.StepExecution
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.SSM.Types.StepExecution 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 Amazonka.SSM.Types.AlarmStateInformation
import Amazonka.SSM.Types.AutomationExecutionStatus
import Amazonka.SSM.Types.FailureDetails
import Amazonka.SSM.Types.Target
import Amazonka.SSM.Types.TargetLocation

-- | Detailed information about an the execution state of an Automation step.
--
-- /See:/ 'newStepExecution' smart constructor.
data StepExecution = StepExecution'
  { -- | The action this step performs. The action determines the behavior of the
    -- step.
    StepExecution -> Maybe Text
action :: Prelude.Maybe Prelude.Text,
    -- | If a step has finished execution, this contains the time the execution
    -- ended. If the step hasn\'t yet concluded, this field isn\'t populated.
    StepExecution -> Maybe POSIX
executionEndTime :: Prelude.Maybe Data.POSIX,
    -- | If a step has begun execution, this contains the time the step started.
    -- If the step is in Pending status, this field isn\'t populated.
    StepExecution -> Maybe POSIX
executionStartTime :: Prelude.Maybe Data.POSIX,
    -- | Information about the Automation failure.
    StepExecution -> Maybe FailureDetails
failureDetails :: Prelude.Maybe FailureDetails,
    -- | If a step failed, this message explains why the execution failed.
    StepExecution -> Maybe Text
failureMessage :: Prelude.Maybe Prelude.Text,
    -- | Fully-resolved values passed into the step before execution.
    StepExecution -> Maybe (HashMap Text Text)
inputs :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The flag which can be used to help decide whether the failure of current
    -- step leads to the Automation failure.
    StepExecution -> Maybe Bool
isCritical :: Prelude.Maybe Prelude.Bool,
    -- | The flag which can be used to end automation no matter whether the step
    -- succeeds or fails.
    StepExecution -> Maybe Bool
isEnd :: Prelude.Maybe Prelude.Bool,
    -- | The maximum number of tries to run the action of the step. The default
    -- value is @1@.
    StepExecution -> Maybe Int
maxAttempts :: Prelude.Maybe Prelude.Int,
    -- | The next step after the step succeeds.
    StepExecution -> Maybe Text
nextStep :: Prelude.Maybe Prelude.Text,
    -- | The action to take if the step fails. The default value is @Abort@.
    StepExecution -> Maybe Text
onFailure :: Prelude.Maybe Prelude.Text,
    -- | Returned values from the execution of the step.
    StepExecution -> Maybe (HashMap Text [Text])
outputs :: Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]),
    -- | A user-specified list of parameters to override when running a step.
    StepExecution -> Maybe (HashMap Text [Text])
overriddenParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]),
    -- | A message associated with the response code for an execution.
    StepExecution -> Maybe Text
response :: Prelude.Maybe Prelude.Text,
    -- | The response code returned by the execution of the step.
    StepExecution -> Maybe Text
responseCode :: Prelude.Maybe Prelude.Text,
    -- | The unique ID of a step execution.
    StepExecution -> Maybe Text
stepExecutionId :: Prelude.Maybe Prelude.Text,
    -- | The name of this execution step.
    StepExecution -> Maybe Text
stepName :: Prelude.Maybe Prelude.Text,
    -- | The execution status for this step.
    StepExecution -> Maybe AutomationExecutionStatus
stepStatus :: Prelude.Maybe AutomationExecutionStatus,
    -- | The combination of Amazon Web Services Regions and Amazon Web Services
    -- accounts targeted by the current Automation execution.
    StepExecution -> Maybe TargetLocation
targetLocation :: Prelude.Maybe TargetLocation,
    -- | The targets for the step execution.
    StepExecution -> Maybe [Target]
targets :: Prelude.Maybe [Target],
    -- | The timeout seconds of the step.
    StepExecution -> Maybe Integer
timeoutSeconds :: Prelude.Maybe Prelude.Integer,
    -- | The CloudWatch alarms that were invoked by the automation.
    StepExecution -> Maybe (NonEmpty AlarmStateInformation)
triggeredAlarms :: Prelude.Maybe (Prelude.NonEmpty AlarmStateInformation),
    -- | Strategies used when step fails, we support Continue and Abort. Abort
    -- will fail the automation when the step fails. Continue will ignore the
    -- failure of current step and allow automation to run the next step. With
    -- conditional branching, we add step:stepName to support the automation to
    -- go to another specific step.
    StepExecution -> Maybe [Text]
validNextSteps :: Prelude.Maybe [Prelude.Text]
  }
  deriving (StepExecution -> StepExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StepExecution -> StepExecution -> Bool
$c/= :: StepExecution -> StepExecution -> Bool
== :: StepExecution -> StepExecution -> Bool
$c== :: StepExecution -> StepExecution -> Bool
Prelude.Eq, ReadPrec [StepExecution]
ReadPrec StepExecution
Int -> ReadS StepExecution
ReadS [StepExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StepExecution]
$creadListPrec :: ReadPrec [StepExecution]
readPrec :: ReadPrec StepExecution
$creadPrec :: ReadPrec StepExecution
readList :: ReadS [StepExecution]
$creadList :: ReadS [StepExecution]
readsPrec :: Int -> ReadS StepExecution
$creadsPrec :: Int -> ReadS StepExecution
Prelude.Read, Int -> StepExecution -> ShowS
[StepExecution] -> ShowS
StepExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StepExecution] -> ShowS
$cshowList :: [StepExecution] -> ShowS
show :: StepExecution -> String
$cshow :: StepExecution -> String
showsPrec :: Int -> StepExecution -> ShowS
$cshowsPrec :: Int -> StepExecution -> ShowS
Prelude.Show, forall x. Rep StepExecution x -> StepExecution
forall x. StepExecution -> Rep StepExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StepExecution x -> StepExecution
$cfrom :: forall x. StepExecution -> Rep StepExecution x
Prelude.Generic)

-- |
-- Create a value of 'StepExecution' 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:
--
-- 'action', 'stepExecution_action' - The action this step performs. The action determines the behavior of the
-- step.
--
-- 'executionEndTime', 'stepExecution_executionEndTime' - If a step has finished execution, this contains the time the execution
-- ended. If the step hasn\'t yet concluded, this field isn\'t populated.
--
-- 'executionStartTime', 'stepExecution_executionStartTime' - If a step has begun execution, this contains the time the step started.
-- If the step is in Pending status, this field isn\'t populated.
--
-- 'failureDetails', 'stepExecution_failureDetails' - Information about the Automation failure.
--
-- 'failureMessage', 'stepExecution_failureMessage' - If a step failed, this message explains why the execution failed.
--
-- 'inputs', 'stepExecution_inputs' - Fully-resolved values passed into the step before execution.
--
-- 'isCritical', 'stepExecution_isCritical' - The flag which can be used to help decide whether the failure of current
-- step leads to the Automation failure.
--
-- 'isEnd', 'stepExecution_isEnd' - The flag which can be used to end automation no matter whether the step
-- succeeds or fails.
--
-- 'maxAttempts', 'stepExecution_maxAttempts' - The maximum number of tries to run the action of the step. The default
-- value is @1@.
--
-- 'nextStep', 'stepExecution_nextStep' - The next step after the step succeeds.
--
-- 'onFailure', 'stepExecution_onFailure' - The action to take if the step fails. The default value is @Abort@.
--
-- 'outputs', 'stepExecution_outputs' - Returned values from the execution of the step.
--
-- 'overriddenParameters', 'stepExecution_overriddenParameters' - A user-specified list of parameters to override when running a step.
--
-- 'response', 'stepExecution_response' - A message associated with the response code for an execution.
--
-- 'responseCode', 'stepExecution_responseCode' - The response code returned by the execution of the step.
--
-- 'stepExecutionId', 'stepExecution_stepExecutionId' - The unique ID of a step execution.
--
-- 'stepName', 'stepExecution_stepName' - The name of this execution step.
--
-- 'stepStatus', 'stepExecution_stepStatus' - The execution status for this step.
--
-- 'targetLocation', 'stepExecution_targetLocation' - The combination of Amazon Web Services Regions and Amazon Web Services
-- accounts targeted by the current Automation execution.
--
-- 'targets', 'stepExecution_targets' - The targets for the step execution.
--
-- 'timeoutSeconds', 'stepExecution_timeoutSeconds' - The timeout seconds of the step.
--
-- 'triggeredAlarms', 'stepExecution_triggeredAlarms' - The CloudWatch alarms that were invoked by the automation.
--
-- 'validNextSteps', 'stepExecution_validNextSteps' - Strategies used when step fails, we support Continue and Abort. Abort
-- will fail the automation when the step fails. Continue will ignore the
-- failure of current step and allow automation to run the next step. With
-- conditional branching, we add step:stepName to support the automation to
-- go to another specific step.
newStepExecution ::
  StepExecution
newStepExecution :: StepExecution
newStepExecution =
  StepExecution'
    { $sel:action:StepExecution' :: Maybe Text
action = forall a. Maybe a
Prelude.Nothing,
      $sel:executionEndTime:StepExecution' :: Maybe POSIX
executionEndTime = forall a. Maybe a
Prelude.Nothing,
      $sel:executionStartTime:StepExecution' :: Maybe POSIX
executionStartTime = forall a. Maybe a
Prelude.Nothing,
      $sel:failureDetails:StepExecution' :: Maybe FailureDetails
failureDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:failureMessage:StepExecution' :: Maybe Text
failureMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:inputs:StepExecution' :: Maybe (HashMap Text Text)
inputs = forall a. Maybe a
Prelude.Nothing,
      $sel:isCritical:StepExecution' :: Maybe Bool
isCritical = forall a. Maybe a
Prelude.Nothing,
      $sel:isEnd:StepExecution' :: Maybe Bool
isEnd = forall a. Maybe a
Prelude.Nothing,
      $sel:maxAttempts:StepExecution' :: Maybe Int
maxAttempts = forall a. Maybe a
Prelude.Nothing,
      $sel:nextStep:StepExecution' :: Maybe Text
nextStep = forall a. Maybe a
Prelude.Nothing,
      $sel:onFailure:StepExecution' :: Maybe Text
onFailure = forall a. Maybe a
Prelude.Nothing,
      $sel:outputs:StepExecution' :: Maybe (HashMap Text [Text])
outputs = forall a. Maybe a
Prelude.Nothing,
      $sel:overriddenParameters:StepExecution' :: Maybe (HashMap Text [Text])
overriddenParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:response:StepExecution' :: Maybe Text
response = forall a. Maybe a
Prelude.Nothing,
      $sel:responseCode:StepExecution' :: Maybe Text
responseCode = forall a. Maybe a
Prelude.Nothing,
      $sel:stepExecutionId:StepExecution' :: Maybe Text
stepExecutionId = forall a. Maybe a
Prelude.Nothing,
      $sel:stepName:StepExecution' :: Maybe Text
stepName = forall a. Maybe a
Prelude.Nothing,
      $sel:stepStatus:StepExecution' :: Maybe AutomationExecutionStatus
stepStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:targetLocation:StepExecution' :: Maybe TargetLocation
targetLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:targets:StepExecution' :: Maybe [Target]
targets = forall a. Maybe a
Prelude.Nothing,
      $sel:timeoutSeconds:StepExecution' :: Maybe Integer
timeoutSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:triggeredAlarms:StepExecution' :: Maybe (NonEmpty AlarmStateInformation)
triggeredAlarms = forall a. Maybe a
Prelude.Nothing,
      $sel:validNextSteps:StepExecution' :: Maybe [Text]
validNextSteps = forall a. Maybe a
Prelude.Nothing
    }

-- | The action this step performs. The action determines the behavior of the
-- step.
stepExecution_action :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Text)
stepExecution_action :: Lens' StepExecution (Maybe Text)
stepExecution_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Text
action :: Maybe Text
$sel:action:StepExecution' :: StepExecution -> Maybe Text
action} -> Maybe Text
action) (\s :: StepExecution
s@StepExecution' {} Maybe Text
a -> StepExecution
s {$sel:action:StepExecution' :: Maybe Text
action = Maybe Text
a} :: StepExecution)

-- | If a step has finished execution, this contains the time the execution
-- ended. If the step hasn\'t yet concluded, this field isn\'t populated.
stepExecution_executionEndTime :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.UTCTime)
stepExecution_executionEndTime :: Lens' StepExecution (Maybe UTCTime)
stepExecution_executionEndTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe POSIX
executionEndTime :: Maybe POSIX
$sel:executionEndTime:StepExecution' :: StepExecution -> Maybe POSIX
executionEndTime} -> Maybe POSIX
executionEndTime) (\s :: StepExecution
s@StepExecution' {} Maybe POSIX
a -> StepExecution
s {$sel:executionEndTime:StepExecution' :: Maybe POSIX
executionEndTime = Maybe POSIX
a} :: StepExecution) 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

-- | If a step has begun execution, this contains the time the step started.
-- If the step is in Pending status, this field isn\'t populated.
stepExecution_executionStartTime :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.UTCTime)
stepExecution_executionStartTime :: Lens' StepExecution (Maybe UTCTime)
stepExecution_executionStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe POSIX
executionStartTime :: Maybe POSIX
$sel:executionStartTime:StepExecution' :: StepExecution -> Maybe POSIX
executionStartTime} -> Maybe POSIX
executionStartTime) (\s :: StepExecution
s@StepExecution' {} Maybe POSIX
a -> StepExecution
s {$sel:executionStartTime:StepExecution' :: Maybe POSIX
executionStartTime = Maybe POSIX
a} :: StepExecution) 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

-- | Information about the Automation failure.
stepExecution_failureDetails :: Lens.Lens' StepExecution (Prelude.Maybe FailureDetails)
stepExecution_failureDetails :: Lens' StepExecution (Maybe FailureDetails)
stepExecution_failureDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe FailureDetails
failureDetails :: Maybe FailureDetails
$sel:failureDetails:StepExecution' :: StepExecution -> Maybe FailureDetails
failureDetails} -> Maybe FailureDetails
failureDetails) (\s :: StepExecution
s@StepExecution' {} Maybe FailureDetails
a -> StepExecution
s {$sel:failureDetails:StepExecution' :: Maybe FailureDetails
failureDetails = Maybe FailureDetails
a} :: StepExecution)

-- | If a step failed, this message explains why the execution failed.
stepExecution_failureMessage :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Text)
stepExecution_failureMessage :: Lens' StepExecution (Maybe Text)
stepExecution_failureMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Text
failureMessage :: Maybe Text
$sel:failureMessage:StepExecution' :: StepExecution -> Maybe Text
failureMessage} -> Maybe Text
failureMessage) (\s :: StepExecution
s@StepExecution' {} Maybe Text
a -> StepExecution
s {$sel:failureMessage:StepExecution' :: Maybe Text
failureMessage = Maybe Text
a} :: StepExecution)

-- | Fully-resolved values passed into the step before execution.
stepExecution_inputs :: Lens.Lens' StepExecution (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
stepExecution_inputs :: Lens' StepExecution (Maybe (HashMap Text Text))
stepExecution_inputs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe (HashMap Text Text)
inputs :: Maybe (HashMap Text Text)
$sel:inputs:StepExecution' :: StepExecution -> Maybe (HashMap Text Text)
inputs} -> Maybe (HashMap Text Text)
inputs) (\s :: StepExecution
s@StepExecution' {} Maybe (HashMap Text Text)
a -> StepExecution
s {$sel:inputs:StepExecution' :: Maybe (HashMap Text Text)
inputs = Maybe (HashMap Text Text)
a} :: StepExecution) 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 flag which can be used to help decide whether the failure of current
-- step leads to the Automation failure.
stepExecution_isCritical :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Bool)
stepExecution_isCritical :: Lens' StepExecution (Maybe Bool)
stepExecution_isCritical = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Bool
isCritical :: Maybe Bool
$sel:isCritical:StepExecution' :: StepExecution -> Maybe Bool
isCritical} -> Maybe Bool
isCritical) (\s :: StepExecution
s@StepExecution' {} Maybe Bool
a -> StepExecution
s {$sel:isCritical:StepExecution' :: Maybe Bool
isCritical = Maybe Bool
a} :: StepExecution)

-- | The flag which can be used to end automation no matter whether the step
-- succeeds or fails.
stepExecution_isEnd :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Bool)
stepExecution_isEnd :: Lens' StepExecution (Maybe Bool)
stepExecution_isEnd = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Bool
isEnd :: Maybe Bool
$sel:isEnd:StepExecution' :: StepExecution -> Maybe Bool
isEnd} -> Maybe Bool
isEnd) (\s :: StepExecution
s@StepExecution' {} Maybe Bool
a -> StepExecution
s {$sel:isEnd:StepExecution' :: Maybe Bool
isEnd = Maybe Bool
a} :: StepExecution)

-- | The maximum number of tries to run the action of the step. The default
-- value is @1@.
stepExecution_maxAttempts :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Int)
stepExecution_maxAttempts :: Lens' StepExecution (Maybe Int)
stepExecution_maxAttempts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Int
maxAttempts :: Maybe Int
$sel:maxAttempts:StepExecution' :: StepExecution -> Maybe Int
maxAttempts} -> Maybe Int
maxAttempts) (\s :: StepExecution
s@StepExecution' {} Maybe Int
a -> StepExecution
s {$sel:maxAttempts:StepExecution' :: Maybe Int
maxAttempts = Maybe Int
a} :: StepExecution)

-- | The next step after the step succeeds.
stepExecution_nextStep :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Text)
stepExecution_nextStep :: Lens' StepExecution (Maybe Text)
stepExecution_nextStep = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Text
nextStep :: Maybe Text
$sel:nextStep:StepExecution' :: StepExecution -> Maybe Text
nextStep} -> Maybe Text
nextStep) (\s :: StepExecution
s@StepExecution' {} Maybe Text
a -> StepExecution
s {$sel:nextStep:StepExecution' :: Maybe Text
nextStep = Maybe Text
a} :: StepExecution)

-- | The action to take if the step fails. The default value is @Abort@.
stepExecution_onFailure :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Text)
stepExecution_onFailure :: Lens' StepExecution (Maybe Text)
stepExecution_onFailure = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Text
onFailure :: Maybe Text
$sel:onFailure:StepExecution' :: StepExecution -> Maybe Text
onFailure} -> Maybe Text
onFailure) (\s :: StepExecution
s@StepExecution' {} Maybe Text
a -> StepExecution
s {$sel:onFailure:StepExecution' :: Maybe Text
onFailure = Maybe Text
a} :: StepExecution)

-- | Returned values from the execution of the step.
stepExecution_outputs :: Lens.Lens' StepExecution (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
stepExecution_outputs :: Lens' StepExecution (Maybe (HashMap Text [Text]))
stepExecution_outputs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe (HashMap Text [Text])
outputs :: Maybe (HashMap Text [Text])
$sel:outputs:StepExecution' :: StepExecution -> Maybe (HashMap Text [Text])
outputs} -> Maybe (HashMap Text [Text])
outputs) (\s :: StepExecution
s@StepExecution' {} Maybe (HashMap Text [Text])
a -> StepExecution
s {$sel:outputs:StepExecution' :: Maybe (HashMap Text [Text])
outputs = Maybe (HashMap Text [Text])
a} :: StepExecution) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A user-specified list of parameters to override when running a step.
stepExecution_overriddenParameters :: Lens.Lens' StepExecution (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
stepExecution_overriddenParameters :: Lens' StepExecution (Maybe (HashMap Text [Text]))
stepExecution_overriddenParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe (HashMap Text [Text])
overriddenParameters :: Maybe (HashMap Text [Text])
$sel:overriddenParameters:StepExecution' :: StepExecution -> Maybe (HashMap Text [Text])
overriddenParameters} -> Maybe (HashMap Text [Text])
overriddenParameters) (\s :: StepExecution
s@StepExecution' {} Maybe (HashMap Text [Text])
a -> StepExecution
s {$sel:overriddenParameters:StepExecution' :: Maybe (HashMap Text [Text])
overriddenParameters = Maybe (HashMap Text [Text])
a} :: StepExecution) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A message associated with the response code for an execution.
stepExecution_response :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Text)
stepExecution_response :: Lens' StepExecution (Maybe Text)
stepExecution_response = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Text
response :: Maybe Text
$sel:response:StepExecution' :: StepExecution -> Maybe Text
response} -> Maybe Text
response) (\s :: StepExecution
s@StepExecution' {} Maybe Text
a -> StepExecution
s {$sel:response:StepExecution' :: Maybe Text
response = Maybe Text
a} :: StepExecution)

-- | The response code returned by the execution of the step.
stepExecution_responseCode :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Text)
stepExecution_responseCode :: Lens' StepExecution (Maybe Text)
stepExecution_responseCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Text
responseCode :: Maybe Text
$sel:responseCode:StepExecution' :: StepExecution -> Maybe Text
responseCode} -> Maybe Text
responseCode) (\s :: StepExecution
s@StepExecution' {} Maybe Text
a -> StepExecution
s {$sel:responseCode:StepExecution' :: Maybe Text
responseCode = Maybe Text
a} :: StepExecution)

-- | The unique ID of a step execution.
stepExecution_stepExecutionId :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Text)
stepExecution_stepExecutionId :: Lens' StepExecution (Maybe Text)
stepExecution_stepExecutionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Text
stepExecutionId :: Maybe Text
$sel:stepExecutionId:StepExecution' :: StepExecution -> Maybe Text
stepExecutionId} -> Maybe Text
stepExecutionId) (\s :: StepExecution
s@StepExecution' {} Maybe Text
a -> StepExecution
s {$sel:stepExecutionId:StepExecution' :: Maybe Text
stepExecutionId = Maybe Text
a} :: StepExecution)

-- | The name of this execution step.
stepExecution_stepName :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Text)
stepExecution_stepName :: Lens' StepExecution (Maybe Text)
stepExecution_stepName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Text
stepName :: Maybe Text
$sel:stepName:StepExecution' :: StepExecution -> Maybe Text
stepName} -> Maybe Text
stepName) (\s :: StepExecution
s@StepExecution' {} Maybe Text
a -> StepExecution
s {$sel:stepName:StepExecution' :: Maybe Text
stepName = Maybe Text
a} :: StepExecution)

-- | The execution status for this step.
stepExecution_stepStatus :: Lens.Lens' StepExecution (Prelude.Maybe AutomationExecutionStatus)
stepExecution_stepStatus :: Lens' StepExecution (Maybe AutomationExecutionStatus)
stepExecution_stepStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe AutomationExecutionStatus
stepStatus :: Maybe AutomationExecutionStatus
$sel:stepStatus:StepExecution' :: StepExecution -> Maybe AutomationExecutionStatus
stepStatus} -> Maybe AutomationExecutionStatus
stepStatus) (\s :: StepExecution
s@StepExecution' {} Maybe AutomationExecutionStatus
a -> StepExecution
s {$sel:stepStatus:StepExecution' :: Maybe AutomationExecutionStatus
stepStatus = Maybe AutomationExecutionStatus
a} :: StepExecution)

-- | The combination of Amazon Web Services Regions and Amazon Web Services
-- accounts targeted by the current Automation execution.
stepExecution_targetLocation :: Lens.Lens' StepExecution (Prelude.Maybe TargetLocation)
stepExecution_targetLocation :: Lens' StepExecution (Maybe TargetLocation)
stepExecution_targetLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe TargetLocation
targetLocation :: Maybe TargetLocation
$sel:targetLocation:StepExecution' :: StepExecution -> Maybe TargetLocation
targetLocation} -> Maybe TargetLocation
targetLocation) (\s :: StepExecution
s@StepExecution' {} Maybe TargetLocation
a -> StepExecution
s {$sel:targetLocation:StepExecution' :: Maybe TargetLocation
targetLocation = Maybe TargetLocation
a} :: StepExecution)

-- | The targets for the step execution.
stepExecution_targets :: Lens.Lens' StepExecution (Prelude.Maybe [Target])
stepExecution_targets :: Lens' StepExecution (Maybe [Target])
stepExecution_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe [Target]
targets :: Maybe [Target]
$sel:targets:StepExecution' :: StepExecution -> Maybe [Target]
targets} -> Maybe [Target]
targets) (\s :: StepExecution
s@StepExecution' {} Maybe [Target]
a -> StepExecution
s {$sel:targets:StepExecution' :: Maybe [Target]
targets = Maybe [Target]
a} :: StepExecution) 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 timeout seconds of the step.
stepExecution_timeoutSeconds :: Lens.Lens' StepExecution (Prelude.Maybe Prelude.Integer)
stepExecution_timeoutSeconds :: Lens' StepExecution (Maybe Integer)
stepExecution_timeoutSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe Integer
timeoutSeconds :: Maybe Integer
$sel:timeoutSeconds:StepExecution' :: StepExecution -> Maybe Integer
timeoutSeconds} -> Maybe Integer
timeoutSeconds) (\s :: StepExecution
s@StepExecution' {} Maybe Integer
a -> StepExecution
s {$sel:timeoutSeconds:StepExecution' :: Maybe Integer
timeoutSeconds = Maybe Integer
a} :: StepExecution)

-- | The CloudWatch alarms that were invoked by the automation.
stepExecution_triggeredAlarms :: Lens.Lens' StepExecution (Prelude.Maybe (Prelude.NonEmpty AlarmStateInformation))
stepExecution_triggeredAlarms :: Lens' StepExecution (Maybe (NonEmpty AlarmStateInformation))
stepExecution_triggeredAlarms = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe (NonEmpty AlarmStateInformation)
triggeredAlarms :: Maybe (NonEmpty AlarmStateInformation)
$sel:triggeredAlarms:StepExecution' :: StepExecution -> Maybe (NonEmpty AlarmStateInformation)
triggeredAlarms} -> Maybe (NonEmpty AlarmStateInformation)
triggeredAlarms) (\s :: StepExecution
s@StepExecution' {} Maybe (NonEmpty AlarmStateInformation)
a -> StepExecution
s {$sel:triggeredAlarms:StepExecution' :: Maybe (NonEmpty AlarmStateInformation)
triggeredAlarms = Maybe (NonEmpty AlarmStateInformation)
a} :: StepExecution) 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

-- | Strategies used when step fails, we support Continue and Abort. Abort
-- will fail the automation when the step fails. Continue will ignore the
-- failure of current step and allow automation to run the next step. With
-- conditional branching, we add step:stepName to support the automation to
-- go to another specific step.
stepExecution_validNextSteps :: Lens.Lens' StepExecution (Prelude.Maybe [Prelude.Text])
stepExecution_validNextSteps :: Lens' StepExecution (Maybe [Text])
stepExecution_validNextSteps = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepExecution' {Maybe [Text]
validNextSteps :: Maybe [Text]
$sel:validNextSteps:StepExecution' :: StepExecution -> Maybe [Text]
validNextSteps} -> Maybe [Text]
validNextSteps) (\s :: StepExecution
s@StepExecution' {} Maybe [Text]
a -> StepExecution
s {$sel:validNextSteps:StepExecution' :: Maybe [Text]
validNextSteps = Maybe [Text]
a} :: StepExecution) 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

instance Data.FromJSON StepExecution where
  parseJSON :: Value -> Parser StepExecution
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"StepExecution"
      ( \Object
x ->
          Maybe Text
-> Maybe POSIX
-> Maybe POSIX
-> Maybe FailureDetails
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe (HashMap Text [Text])
-> Maybe (HashMap Text [Text])
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe AutomationExecutionStatus
-> Maybe TargetLocation
-> Maybe [Target]
-> Maybe Integer
-> Maybe (NonEmpty AlarmStateInformation)
-> Maybe [Text]
-> StepExecution
StepExecution'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Action")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ExecutionEndTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ExecutionStartTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"FailureDetails")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"FailureMessage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Inputs" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"IsCritical")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"IsEnd")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"MaxAttempts")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"NextStep")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"OnFailure")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Outputs" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"OverriddenParameters"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"Response")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ResponseCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"StepExecutionId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"StepName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"StepStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"TargetLocation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Targets" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"TimeoutSeconds")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"TriggeredAlarms")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ValidNextSteps"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable StepExecution where
  hashWithSalt :: Int -> StepExecution -> Int
hashWithSalt Int
_salt StepExecution' {Maybe Bool
Maybe Int
Maybe Integer
Maybe [Text]
Maybe [Target]
Maybe (NonEmpty AlarmStateInformation)
Maybe Text
Maybe (HashMap Text [Text])
Maybe (HashMap Text Text)
Maybe POSIX
Maybe AutomationExecutionStatus
Maybe FailureDetails
Maybe TargetLocation
validNextSteps :: Maybe [Text]
triggeredAlarms :: Maybe (NonEmpty AlarmStateInformation)
timeoutSeconds :: Maybe Integer
targets :: Maybe [Target]
targetLocation :: Maybe TargetLocation
stepStatus :: Maybe AutomationExecutionStatus
stepName :: Maybe Text
stepExecutionId :: Maybe Text
responseCode :: Maybe Text
response :: Maybe Text
overriddenParameters :: Maybe (HashMap Text [Text])
outputs :: Maybe (HashMap Text [Text])
onFailure :: Maybe Text
nextStep :: Maybe Text
maxAttempts :: Maybe Int
isEnd :: Maybe Bool
isCritical :: Maybe Bool
inputs :: Maybe (HashMap Text Text)
failureMessage :: Maybe Text
failureDetails :: Maybe FailureDetails
executionStartTime :: Maybe POSIX
executionEndTime :: Maybe POSIX
action :: Maybe Text
$sel:validNextSteps:StepExecution' :: StepExecution -> Maybe [Text]
$sel:triggeredAlarms:StepExecution' :: StepExecution -> Maybe (NonEmpty AlarmStateInformation)
$sel:timeoutSeconds:StepExecution' :: StepExecution -> Maybe Integer
$sel:targets:StepExecution' :: StepExecution -> Maybe [Target]
$sel:targetLocation:StepExecution' :: StepExecution -> Maybe TargetLocation
$sel:stepStatus:StepExecution' :: StepExecution -> Maybe AutomationExecutionStatus
$sel:stepName:StepExecution' :: StepExecution -> Maybe Text
$sel:stepExecutionId:StepExecution' :: StepExecution -> Maybe Text
$sel:responseCode:StepExecution' :: StepExecution -> Maybe Text
$sel:response:StepExecution' :: StepExecution -> Maybe Text
$sel:overriddenParameters:StepExecution' :: StepExecution -> Maybe (HashMap Text [Text])
$sel:outputs:StepExecution' :: StepExecution -> Maybe (HashMap Text [Text])
$sel:onFailure:StepExecution' :: StepExecution -> Maybe Text
$sel:nextStep:StepExecution' :: StepExecution -> Maybe Text
$sel:maxAttempts:StepExecution' :: StepExecution -> Maybe Int
$sel:isEnd:StepExecution' :: StepExecution -> Maybe Bool
$sel:isCritical:StepExecution' :: StepExecution -> Maybe Bool
$sel:inputs:StepExecution' :: StepExecution -> Maybe (HashMap Text Text)
$sel:failureMessage:StepExecution' :: StepExecution -> Maybe Text
$sel:failureDetails:StepExecution' :: StepExecution -> Maybe FailureDetails
$sel:executionStartTime:StepExecution' :: StepExecution -> Maybe POSIX
$sel:executionEndTime:StepExecution' :: StepExecution -> Maybe POSIX
$sel:action:StepExecution' :: StepExecution -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
executionEndTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
executionStartTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FailureDetails
failureDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
failureMessage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
inputs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isCritical
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isEnd
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxAttempts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextStep
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
onFailure
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text [Text])
outputs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text [Text])
overriddenParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
response
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
responseCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stepExecutionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stepName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutomationExecutionStatus
stepStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetLocation
targetLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Target]
targets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
timeoutSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty AlarmStateInformation)
triggeredAlarms
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
validNextSteps

instance Prelude.NFData StepExecution where
  rnf :: StepExecution -> ()
rnf StepExecution' {Maybe Bool
Maybe Int
Maybe Integer
Maybe [Text]
Maybe [Target]
Maybe (NonEmpty AlarmStateInformation)
Maybe Text
Maybe (HashMap Text [Text])
Maybe (HashMap Text Text)
Maybe POSIX
Maybe AutomationExecutionStatus
Maybe FailureDetails
Maybe TargetLocation
validNextSteps :: Maybe [Text]
triggeredAlarms :: Maybe (NonEmpty AlarmStateInformation)
timeoutSeconds :: Maybe Integer
targets :: Maybe [Target]
targetLocation :: Maybe TargetLocation
stepStatus :: Maybe AutomationExecutionStatus
stepName :: Maybe Text
stepExecutionId :: Maybe Text
responseCode :: Maybe Text
response :: Maybe Text
overriddenParameters :: Maybe (HashMap Text [Text])
outputs :: Maybe (HashMap Text [Text])
onFailure :: Maybe Text
nextStep :: Maybe Text
maxAttempts :: Maybe Int
isEnd :: Maybe Bool
isCritical :: Maybe Bool
inputs :: Maybe (HashMap Text Text)
failureMessage :: Maybe Text
failureDetails :: Maybe FailureDetails
executionStartTime :: Maybe POSIX
executionEndTime :: Maybe POSIX
action :: Maybe Text
$sel:validNextSteps:StepExecution' :: StepExecution -> Maybe [Text]
$sel:triggeredAlarms:StepExecution' :: StepExecution -> Maybe (NonEmpty AlarmStateInformation)
$sel:timeoutSeconds:StepExecution' :: StepExecution -> Maybe Integer
$sel:targets:StepExecution' :: StepExecution -> Maybe [Target]
$sel:targetLocation:StepExecution' :: StepExecution -> Maybe TargetLocation
$sel:stepStatus:StepExecution' :: StepExecution -> Maybe AutomationExecutionStatus
$sel:stepName:StepExecution' :: StepExecution -> Maybe Text
$sel:stepExecutionId:StepExecution' :: StepExecution -> Maybe Text
$sel:responseCode:StepExecution' :: StepExecution -> Maybe Text
$sel:response:StepExecution' :: StepExecution -> Maybe Text
$sel:overriddenParameters:StepExecution' :: StepExecution -> Maybe (HashMap Text [Text])
$sel:outputs:StepExecution' :: StepExecution -> Maybe (HashMap Text [Text])
$sel:onFailure:StepExecution' :: StepExecution -> Maybe Text
$sel:nextStep:StepExecution' :: StepExecution -> Maybe Text
$sel:maxAttempts:StepExecution' :: StepExecution -> Maybe Int
$sel:isEnd:StepExecution' :: StepExecution -> Maybe Bool
$sel:isCritical:StepExecution' :: StepExecution -> Maybe Bool
$sel:inputs:StepExecution' :: StepExecution -> Maybe (HashMap Text Text)
$sel:failureMessage:StepExecution' :: StepExecution -> Maybe Text
$sel:failureDetails:StepExecution' :: StepExecution -> Maybe FailureDetails
$sel:executionStartTime:StepExecution' :: StepExecution -> Maybe POSIX
$sel:executionEndTime:StepExecution' :: StepExecution -> Maybe POSIX
$sel:action:StepExecution' :: StepExecution -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
executionEndTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
executionStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FailureDetails
failureDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
failureMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
inputs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isCritical
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isEnd
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxAttempts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextStep
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
onFailure
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [Text])
outputs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [Text])
overriddenParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
response
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
responseCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stepExecutionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stepName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AutomationExecutionStatus
stepStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TargetLocation
targetLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Target]
targets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
timeoutSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe (NonEmpty AlarmStateInformation)
triggeredAlarms
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [Text]
validNextSteps