{-# 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.SSM.StartAutomationExecution
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Initiates execution of an Automation runbook.
module Amazonka.SSM.StartAutomationExecution
  ( -- * Creating a Request
    StartAutomationExecution (..),
    newStartAutomationExecution,

    -- * Request Lenses
    startAutomationExecution_alarmConfiguration,
    startAutomationExecution_clientToken,
    startAutomationExecution_documentVersion,
    startAutomationExecution_maxConcurrency,
    startAutomationExecution_maxErrors,
    startAutomationExecution_mode,
    startAutomationExecution_parameters,
    startAutomationExecution_tags,
    startAutomationExecution_targetLocations,
    startAutomationExecution_targetMaps,
    startAutomationExecution_targetParameterName,
    startAutomationExecution_targets,
    startAutomationExecution_documentName,

    -- * Destructuring the Response
    StartAutomationExecutionResponse (..),
    newStartAutomationExecutionResponse,

    -- * Response Lenses
    startAutomationExecutionResponse_automationExecutionId,
    startAutomationExecutionResponse_httpStatus,
  )
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.SSM.Types

-- | /See:/ 'newStartAutomationExecution' smart constructor.
data StartAutomationExecution = StartAutomationExecution'
  { -- | The CloudWatch alarm you want to apply to your automation.
    StartAutomationExecution -> Maybe AlarmConfiguration
alarmConfiguration :: Prelude.Maybe AlarmConfiguration,
    -- | User-provided idempotency token. The token must be unique, is case
    -- insensitive, enforces the UUID format, and can\'t be reused.
    StartAutomationExecution -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The version of the Automation runbook to use for this execution.
    StartAutomationExecution -> Maybe Text
documentVersion :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of targets allowed to run this task in parallel. You
    -- can specify a number, such as 10, or a percentage, such as 10%. The
    -- default value is @10@.
    StartAutomationExecution -> Maybe Text
maxConcurrency :: Prelude.Maybe Prelude.Text,
    -- | The number of errors that are allowed before the system stops running
    -- the automation on additional targets. You can specify either an absolute
    -- number of errors, for example 10, or a percentage of the target set, for
    -- example 10%. If you specify 3, for example, the system stops running the
    -- automation when the fourth error is received. If you specify 0, then the
    -- system stops running the automation on additional targets after the
    -- first error result is returned. If you run an automation on 50 resources
    -- and set max-errors to 10%, then the system stops running the automation
    -- on additional targets when the sixth error is received.
    --
    -- Executions that are already running an automation when max-errors is
    -- reached are allowed to complete, but some of these executions may fail
    -- as well. If you need to ensure that there won\'t be more than max-errors
    -- failed executions, set max-concurrency to 1 so the executions proceed
    -- one at a time.
    StartAutomationExecution -> Maybe Text
maxErrors :: Prelude.Maybe Prelude.Text,
    -- | The execution mode of the automation. Valid modes include the following:
    -- Auto and Interactive. The default mode is Auto.
    StartAutomationExecution -> Maybe ExecutionMode
mode :: Prelude.Maybe ExecutionMode,
    -- | A key-value map of execution parameters, which match the declared
    -- parameters in the Automation runbook.
    StartAutomationExecution -> Maybe (HashMap Text [Text])
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]),
    -- | Optional metadata that you assign to a resource. You can specify a
    -- maximum of five tags for an automation. Tags enable you to categorize a
    -- resource in different ways, such as by purpose, owner, or environment.
    -- For example, you might want to tag an automation to identify an
    -- environment or operating system. In this case, you could specify the
    -- following key-value pairs:
    --
    -- -   @Key=environment,Value=test@
    --
    -- -   @Key=OS,Value=Windows@
    --
    -- To add tags to an existing automation, use the AddTagsToResource
    -- operation.
    StartAutomationExecution -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A location is a combination of Amazon Web Services Regions and\/or
    -- Amazon Web Services accounts where you want to run the automation. Use
    -- this operation to start an automation in multiple Amazon Web Services
    -- Regions and multiple Amazon Web Services accounts. For more information,
    -- see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/systems-manager-automation-multiple-accounts-and-regions.html Running Automation workflows in multiple Amazon Web Services Regions and Amazon Web Services accounts>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    StartAutomationExecution -> Maybe (NonEmpty TargetLocation)
targetLocations :: Prelude.Maybe (Prelude.NonEmpty TargetLocation),
    -- | A key-value mapping of document parameters to target resources. Both
    -- Targets and TargetMaps can\'t be specified together.
    StartAutomationExecution -> Maybe [HashMap Text [Text]]
targetMaps :: Prelude.Maybe [Prelude.HashMap Prelude.Text [Prelude.Text]],
    -- | The name of the parameter used as the target resource for the
    -- rate-controlled execution. Required if you specify targets.
    StartAutomationExecution -> Maybe Text
targetParameterName :: Prelude.Maybe Prelude.Text,
    -- | A key-value mapping to target resources. Required if you specify
    -- TargetParameterName.
    StartAutomationExecution -> Maybe [Target]
targets :: Prelude.Maybe [Target],
    -- | The name of the SSM document to run. This can be a public document or a
    -- custom document. To run a shared document belonging to another account,
    -- specify the document ARN. For more information about how to use shared
    -- documents, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/ssm-using-shared.html Using shared SSM documents>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    StartAutomationExecution -> Text
documentName :: Prelude.Text
  }
  deriving (StartAutomationExecution -> StartAutomationExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartAutomationExecution -> StartAutomationExecution -> Bool
$c/= :: StartAutomationExecution -> StartAutomationExecution -> Bool
== :: StartAutomationExecution -> StartAutomationExecution -> Bool
$c== :: StartAutomationExecution -> StartAutomationExecution -> Bool
Prelude.Eq, ReadPrec [StartAutomationExecution]
ReadPrec StartAutomationExecution
Int -> ReadS StartAutomationExecution
ReadS [StartAutomationExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartAutomationExecution]
$creadListPrec :: ReadPrec [StartAutomationExecution]
readPrec :: ReadPrec StartAutomationExecution
$creadPrec :: ReadPrec StartAutomationExecution
readList :: ReadS [StartAutomationExecution]
$creadList :: ReadS [StartAutomationExecution]
readsPrec :: Int -> ReadS StartAutomationExecution
$creadsPrec :: Int -> ReadS StartAutomationExecution
Prelude.Read, Int -> StartAutomationExecution -> ShowS
[StartAutomationExecution] -> ShowS
StartAutomationExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartAutomationExecution] -> ShowS
$cshowList :: [StartAutomationExecution] -> ShowS
show :: StartAutomationExecution -> String
$cshow :: StartAutomationExecution -> String
showsPrec :: Int -> StartAutomationExecution -> ShowS
$cshowsPrec :: Int -> StartAutomationExecution -> ShowS
Prelude.Show, forall x.
Rep StartAutomationExecution x -> StartAutomationExecution
forall x.
StartAutomationExecution -> Rep StartAutomationExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartAutomationExecution x -> StartAutomationExecution
$cfrom :: forall x.
StartAutomationExecution -> Rep StartAutomationExecution x
Prelude.Generic)

-- |
-- Create a value of 'StartAutomationExecution' 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:
--
-- 'alarmConfiguration', 'startAutomationExecution_alarmConfiguration' - The CloudWatch alarm you want to apply to your automation.
--
-- 'clientToken', 'startAutomationExecution_clientToken' - User-provided idempotency token. The token must be unique, is case
-- insensitive, enforces the UUID format, and can\'t be reused.
--
-- 'documentVersion', 'startAutomationExecution_documentVersion' - The version of the Automation runbook to use for this execution.
--
-- 'maxConcurrency', 'startAutomationExecution_maxConcurrency' - The maximum number of targets allowed to run this task in parallel. You
-- can specify a number, such as 10, or a percentage, such as 10%. The
-- default value is @10@.
--
-- 'maxErrors', 'startAutomationExecution_maxErrors' - The number of errors that are allowed before the system stops running
-- the automation on additional targets. You can specify either an absolute
-- number of errors, for example 10, or a percentage of the target set, for
-- example 10%. If you specify 3, for example, the system stops running the
-- automation when the fourth error is received. If you specify 0, then the
-- system stops running the automation on additional targets after the
-- first error result is returned. If you run an automation on 50 resources
-- and set max-errors to 10%, then the system stops running the automation
-- on additional targets when the sixth error is received.
--
-- Executions that are already running an automation when max-errors is
-- reached are allowed to complete, but some of these executions may fail
-- as well. If you need to ensure that there won\'t be more than max-errors
-- failed executions, set max-concurrency to 1 so the executions proceed
-- one at a time.
--
-- 'mode', 'startAutomationExecution_mode' - The execution mode of the automation. Valid modes include the following:
-- Auto and Interactive. The default mode is Auto.
--
-- 'parameters', 'startAutomationExecution_parameters' - A key-value map of execution parameters, which match the declared
-- parameters in the Automation runbook.
--
-- 'tags', 'startAutomationExecution_tags' - Optional metadata that you assign to a resource. You can specify a
-- maximum of five tags for an automation. Tags enable you to categorize a
-- resource in different ways, such as by purpose, owner, or environment.
-- For example, you might want to tag an automation to identify an
-- environment or operating system. In this case, you could specify the
-- following key-value pairs:
--
-- -   @Key=environment,Value=test@
--
-- -   @Key=OS,Value=Windows@
--
-- To add tags to an existing automation, use the AddTagsToResource
-- operation.
--
-- 'targetLocations', 'startAutomationExecution_targetLocations' - A location is a combination of Amazon Web Services Regions and\/or
-- Amazon Web Services accounts where you want to run the automation. Use
-- this operation to start an automation in multiple Amazon Web Services
-- Regions and multiple Amazon Web Services accounts. For more information,
-- see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/systems-manager-automation-multiple-accounts-and-regions.html Running Automation workflows in multiple Amazon Web Services Regions and Amazon Web Services accounts>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'targetMaps', 'startAutomationExecution_targetMaps' - A key-value mapping of document parameters to target resources. Both
-- Targets and TargetMaps can\'t be specified together.
--
-- 'targetParameterName', 'startAutomationExecution_targetParameterName' - The name of the parameter used as the target resource for the
-- rate-controlled execution. Required if you specify targets.
--
-- 'targets', 'startAutomationExecution_targets' - A key-value mapping to target resources. Required if you specify
-- TargetParameterName.
--
-- 'documentName', 'startAutomationExecution_documentName' - The name of the SSM document to run. This can be a public document or a
-- custom document. To run a shared document belonging to another account,
-- specify the document ARN. For more information about how to use shared
-- documents, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/ssm-using-shared.html Using shared SSM documents>
-- in the /Amazon Web Services Systems Manager User Guide/.
newStartAutomationExecution ::
  -- | 'documentName'
  Prelude.Text ->
  StartAutomationExecution
newStartAutomationExecution :: Text -> StartAutomationExecution
newStartAutomationExecution Text
pDocumentName_ =
  StartAutomationExecution'
    { $sel:alarmConfiguration:StartAutomationExecution' :: Maybe AlarmConfiguration
alarmConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:StartAutomationExecution' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:documentVersion:StartAutomationExecution' :: Maybe Text
documentVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:maxConcurrency:StartAutomationExecution' :: Maybe Text
maxConcurrency = forall a. Maybe a
Prelude.Nothing,
      $sel:maxErrors:StartAutomationExecution' :: Maybe Text
maxErrors = forall a. Maybe a
Prelude.Nothing,
      $sel:mode:StartAutomationExecution' :: Maybe ExecutionMode
mode = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:StartAutomationExecution' :: Maybe (HashMap Text [Text])
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:StartAutomationExecution' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:targetLocations:StartAutomationExecution' :: Maybe (NonEmpty TargetLocation)
targetLocations = forall a. Maybe a
Prelude.Nothing,
      $sel:targetMaps:StartAutomationExecution' :: Maybe [HashMap Text [Text]]
targetMaps = forall a. Maybe a
Prelude.Nothing,
      $sel:targetParameterName:StartAutomationExecution' :: Maybe Text
targetParameterName = forall a. Maybe a
Prelude.Nothing,
      $sel:targets:StartAutomationExecution' :: Maybe [Target]
targets = forall a. Maybe a
Prelude.Nothing,
      $sel:documentName:StartAutomationExecution' :: Text
documentName = Text
pDocumentName_
    }

-- | The CloudWatch alarm you want to apply to your automation.
startAutomationExecution_alarmConfiguration :: Lens.Lens' StartAutomationExecution (Prelude.Maybe AlarmConfiguration)
startAutomationExecution_alarmConfiguration :: Lens' StartAutomationExecution (Maybe AlarmConfiguration)
startAutomationExecution_alarmConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe AlarmConfiguration
alarmConfiguration :: Maybe AlarmConfiguration
$sel:alarmConfiguration:StartAutomationExecution' :: StartAutomationExecution -> Maybe AlarmConfiguration
alarmConfiguration} -> Maybe AlarmConfiguration
alarmConfiguration) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe AlarmConfiguration
a -> StartAutomationExecution
s {$sel:alarmConfiguration:StartAutomationExecution' :: Maybe AlarmConfiguration
alarmConfiguration = Maybe AlarmConfiguration
a} :: StartAutomationExecution)

-- | User-provided idempotency token. The token must be unique, is case
-- insensitive, enforces the UUID format, and can\'t be reused.
startAutomationExecution_clientToken :: Lens.Lens' StartAutomationExecution (Prelude.Maybe Prelude.Text)
startAutomationExecution_clientToken :: Lens' StartAutomationExecution (Maybe Text)
startAutomationExecution_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe Text
a -> StartAutomationExecution
s {$sel:clientToken:StartAutomationExecution' :: Maybe Text
clientToken = Maybe Text
a} :: StartAutomationExecution)

-- | The version of the Automation runbook to use for this execution.
startAutomationExecution_documentVersion :: Lens.Lens' StartAutomationExecution (Prelude.Maybe Prelude.Text)
startAutomationExecution_documentVersion :: Lens' StartAutomationExecution (Maybe Text)
startAutomationExecution_documentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe Text
documentVersion :: Maybe Text
$sel:documentVersion:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
documentVersion} -> Maybe Text
documentVersion) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe Text
a -> StartAutomationExecution
s {$sel:documentVersion:StartAutomationExecution' :: Maybe Text
documentVersion = Maybe Text
a} :: StartAutomationExecution)

-- | The maximum number of targets allowed to run this task in parallel. You
-- can specify a number, such as 10, or a percentage, such as 10%. The
-- default value is @10@.
startAutomationExecution_maxConcurrency :: Lens.Lens' StartAutomationExecution (Prelude.Maybe Prelude.Text)
startAutomationExecution_maxConcurrency :: Lens' StartAutomationExecution (Maybe Text)
startAutomationExecution_maxConcurrency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe Text
maxConcurrency :: Maybe Text
$sel:maxConcurrency:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
maxConcurrency} -> Maybe Text
maxConcurrency) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe Text
a -> StartAutomationExecution
s {$sel:maxConcurrency:StartAutomationExecution' :: Maybe Text
maxConcurrency = Maybe Text
a} :: StartAutomationExecution)

-- | The number of errors that are allowed before the system stops running
-- the automation on additional targets. You can specify either an absolute
-- number of errors, for example 10, or a percentage of the target set, for
-- example 10%. If you specify 3, for example, the system stops running the
-- automation when the fourth error is received. If you specify 0, then the
-- system stops running the automation on additional targets after the
-- first error result is returned. If you run an automation on 50 resources
-- and set max-errors to 10%, then the system stops running the automation
-- on additional targets when the sixth error is received.
--
-- Executions that are already running an automation when max-errors is
-- reached are allowed to complete, but some of these executions may fail
-- as well. If you need to ensure that there won\'t be more than max-errors
-- failed executions, set max-concurrency to 1 so the executions proceed
-- one at a time.
startAutomationExecution_maxErrors :: Lens.Lens' StartAutomationExecution (Prelude.Maybe Prelude.Text)
startAutomationExecution_maxErrors :: Lens' StartAutomationExecution (Maybe Text)
startAutomationExecution_maxErrors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe Text
maxErrors :: Maybe Text
$sel:maxErrors:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
maxErrors} -> Maybe Text
maxErrors) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe Text
a -> StartAutomationExecution
s {$sel:maxErrors:StartAutomationExecution' :: Maybe Text
maxErrors = Maybe Text
a} :: StartAutomationExecution)

-- | The execution mode of the automation. Valid modes include the following:
-- Auto and Interactive. The default mode is Auto.
startAutomationExecution_mode :: Lens.Lens' StartAutomationExecution (Prelude.Maybe ExecutionMode)
startAutomationExecution_mode :: Lens' StartAutomationExecution (Maybe ExecutionMode)
startAutomationExecution_mode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe ExecutionMode
mode :: Maybe ExecutionMode
$sel:mode:StartAutomationExecution' :: StartAutomationExecution -> Maybe ExecutionMode
mode} -> Maybe ExecutionMode
mode) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe ExecutionMode
a -> StartAutomationExecution
s {$sel:mode:StartAutomationExecution' :: Maybe ExecutionMode
mode = Maybe ExecutionMode
a} :: StartAutomationExecution)

-- | A key-value map of execution parameters, which match the declared
-- parameters in the Automation runbook.
startAutomationExecution_parameters :: Lens.Lens' StartAutomationExecution (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
startAutomationExecution_parameters :: Lens' StartAutomationExecution (Maybe (HashMap Text [Text]))
startAutomationExecution_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe (HashMap Text [Text])
parameters :: Maybe (HashMap Text [Text])
$sel:parameters:StartAutomationExecution' :: StartAutomationExecution -> Maybe (HashMap Text [Text])
parameters} -> Maybe (HashMap Text [Text])
parameters) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe (HashMap Text [Text])
a -> StartAutomationExecution
s {$sel:parameters:StartAutomationExecution' :: Maybe (HashMap Text [Text])
parameters = Maybe (HashMap Text [Text])
a} :: StartAutomationExecution) 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

-- | Optional metadata that you assign to a resource. You can specify a
-- maximum of five tags for an automation. Tags enable you to categorize a
-- resource in different ways, such as by purpose, owner, or environment.
-- For example, you might want to tag an automation to identify an
-- environment or operating system. In this case, you could specify the
-- following key-value pairs:
--
-- -   @Key=environment,Value=test@
--
-- -   @Key=OS,Value=Windows@
--
-- To add tags to an existing automation, use the AddTagsToResource
-- operation.
startAutomationExecution_tags :: Lens.Lens' StartAutomationExecution (Prelude.Maybe [Tag])
startAutomationExecution_tags :: Lens' StartAutomationExecution (Maybe [Tag])
startAutomationExecution_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:StartAutomationExecution' :: StartAutomationExecution -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe [Tag]
a -> StartAutomationExecution
s {$sel:tags:StartAutomationExecution' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: StartAutomationExecution) 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 location is a combination of Amazon Web Services Regions and\/or
-- Amazon Web Services accounts where you want to run the automation. Use
-- this operation to start an automation in multiple Amazon Web Services
-- Regions and multiple Amazon Web Services accounts. For more information,
-- see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/systems-manager-automation-multiple-accounts-and-regions.html Running Automation workflows in multiple Amazon Web Services Regions and Amazon Web Services accounts>
-- in the /Amazon Web Services Systems Manager User Guide/.
startAutomationExecution_targetLocations :: Lens.Lens' StartAutomationExecution (Prelude.Maybe (Prelude.NonEmpty TargetLocation))
startAutomationExecution_targetLocations :: Lens' StartAutomationExecution (Maybe (NonEmpty TargetLocation))
startAutomationExecution_targetLocations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe (NonEmpty TargetLocation)
targetLocations :: Maybe (NonEmpty TargetLocation)
$sel:targetLocations:StartAutomationExecution' :: StartAutomationExecution -> Maybe (NonEmpty TargetLocation)
targetLocations} -> Maybe (NonEmpty TargetLocation)
targetLocations) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe (NonEmpty TargetLocation)
a -> StartAutomationExecution
s {$sel:targetLocations:StartAutomationExecution' :: Maybe (NonEmpty TargetLocation)
targetLocations = Maybe (NonEmpty TargetLocation)
a} :: StartAutomationExecution) 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 key-value mapping of document parameters to target resources. Both
-- Targets and TargetMaps can\'t be specified together.
startAutomationExecution_targetMaps :: Lens.Lens' StartAutomationExecution (Prelude.Maybe [Prelude.HashMap Prelude.Text [Prelude.Text]])
startAutomationExecution_targetMaps :: Lens' StartAutomationExecution (Maybe [HashMap Text [Text]])
startAutomationExecution_targetMaps = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe [HashMap Text [Text]]
targetMaps :: Maybe [HashMap Text [Text]]
$sel:targetMaps:StartAutomationExecution' :: StartAutomationExecution -> Maybe [HashMap Text [Text]]
targetMaps} -> Maybe [HashMap Text [Text]]
targetMaps) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe [HashMap Text [Text]]
a -> StartAutomationExecution
s {$sel:targetMaps:StartAutomationExecution' :: Maybe [HashMap Text [Text]]
targetMaps = Maybe [HashMap Text [Text]]
a} :: StartAutomationExecution) 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 name of the parameter used as the target resource for the
-- rate-controlled execution. Required if you specify targets.
startAutomationExecution_targetParameterName :: Lens.Lens' StartAutomationExecution (Prelude.Maybe Prelude.Text)
startAutomationExecution_targetParameterName :: Lens' StartAutomationExecution (Maybe Text)
startAutomationExecution_targetParameterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe Text
targetParameterName :: Maybe Text
$sel:targetParameterName:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
targetParameterName} -> Maybe Text
targetParameterName) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe Text
a -> StartAutomationExecution
s {$sel:targetParameterName:StartAutomationExecution' :: Maybe Text
targetParameterName = Maybe Text
a} :: StartAutomationExecution)

-- | A key-value mapping to target resources. Required if you specify
-- TargetParameterName.
startAutomationExecution_targets :: Lens.Lens' StartAutomationExecution (Prelude.Maybe [Target])
startAutomationExecution_targets :: Lens' StartAutomationExecution (Maybe [Target])
startAutomationExecution_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Maybe [Target]
targets :: Maybe [Target]
$sel:targets:StartAutomationExecution' :: StartAutomationExecution -> Maybe [Target]
targets} -> Maybe [Target]
targets) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Maybe [Target]
a -> StartAutomationExecution
s {$sel:targets:StartAutomationExecution' :: Maybe [Target]
targets = Maybe [Target]
a} :: StartAutomationExecution) 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 name of the SSM document to run. This can be a public document or a
-- custom document. To run a shared document belonging to another account,
-- specify the document ARN. For more information about how to use shared
-- documents, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/ssm-using-shared.html Using shared SSM documents>
-- in the /Amazon Web Services Systems Manager User Guide/.
startAutomationExecution_documentName :: Lens.Lens' StartAutomationExecution Prelude.Text
startAutomationExecution_documentName :: Lens' StartAutomationExecution Text
startAutomationExecution_documentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecution' {Text
documentName :: Text
$sel:documentName:StartAutomationExecution' :: StartAutomationExecution -> Text
documentName} -> Text
documentName) (\s :: StartAutomationExecution
s@StartAutomationExecution' {} Text
a -> StartAutomationExecution
s {$sel:documentName:StartAutomationExecution' :: Text
documentName = Text
a} :: StartAutomationExecution)

instance Core.AWSRequest StartAutomationExecution where
  type
    AWSResponse StartAutomationExecution =
      StartAutomationExecutionResponse
  request :: (Service -> Service)
-> StartAutomationExecution -> Request StartAutomationExecution
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 StartAutomationExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartAutomationExecution)))
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 -> Int -> StartAutomationExecutionResponse
StartAutomationExecutionResponse'
            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
"AutomationExecutionId")
            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 StartAutomationExecution where
  hashWithSalt :: Int -> StartAutomationExecution -> Int
hashWithSalt Int
_salt StartAutomationExecution' {Maybe [HashMap Text [Text]]
Maybe [Tag]
Maybe [Target]
Maybe (NonEmpty TargetLocation)
Maybe Text
Maybe (HashMap Text [Text])
Maybe AlarmConfiguration
Maybe ExecutionMode
Text
documentName :: Text
targets :: Maybe [Target]
targetParameterName :: Maybe Text
targetMaps :: Maybe [HashMap Text [Text]]
targetLocations :: Maybe (NonEmpty TargetLocation)
tags :: Maybe [Tag]
parameters :: Maybe (HashMap Text [Text])
mode :: Maybe ExecutionMode
maxErrors :: Maybe Text
maxConcurrency :: Maybe Text
documentVersion :: Maybe Text
clientToken :: Maybe Text
alarmConfiguration :: Maybe AlarmConfiguration
$sel:documentName:StartAutomationExecution' :: StartAutomationExecution -> Text
$sel:targets:StartAutomationExecution' :: StartAutomationExecution -> Maybe [Target]
$sel:targetParameterName:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:targetMaps:StartAutomationExecution' :: StartAutomationExecution -> Maybe [HashMap Text [Text]]
$sel:targetLocations:StartAutomationExecution' :: StartAutomationExecution -> Maybe (NonEmpty TargetLocation)
$sel:tags:StartAutomationExecution' :: StartAutomationExecution -> Maybe [Tag]
$sel:parameters:StartAutomationExecution' :: StartAutomationExecution -> Maybe (HashMap Text [Text])
$sel:mode:StartAutomationExecution' :: StartAutomationExecution -> Maybe ExecutionMode
$sel:maxErrors:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:maxConcurrency:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:documentVersion:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:clientToken:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:alarmConfiguration:StartAutomationExecution' :: StartAutomationExecution -> Maybe AlarmConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AlarmConfiguration
alarmConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
documentVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maxConcurrency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maxErrors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExecutionMode
mode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text [Text])
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty TargetLocation)
targetLocations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [HashMap Text [Text]]
targetMaps
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetParameterName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Target]
targets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
documentName

instance Prelude.NFData StartAutomationExecution where
  rnf :: StartAutomationExecution -> ()
rnf StartAutomationExecution' {Maybe [HashMap Text [Text]]
Maybe [Tag]
Maybe [Target]
Maybe (NonEmpty TargetLocation)
Maybe Text
Maybe (HashMap Text [Text])
Maybe AlarmConfiguration
Maybe ExecutionMode
Text
documentName :: Text
targets :: Maybe [Target]
targetParameterName :: Maybe Text
targetMaps :: Maybe [HashMap Text [Text]]
targetLocations :: Maybe (NonEmpty TargetLocation)
tags :: Maybe [Tag]
parameters :: Maybe (HashMap Text [Text])
mode :: Maybe ExecutionMode
maxErrors :: Maybe Text
maxConcurrency :: Maybe Text
documentVersion :: Maybe Text
clientToken :: Maybe Text
alarmConfiguration :: Maybe AlarmConfiguration
$sel:documentName:StartAutomationExecution' :: StartAutomationExecution -> Text
$sel:targets:StartAutomationExecution' :: StartAutomationExecution -> Maybe [Target]
$sel:targetParameterName:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:targetMaps:StartAutomationExecution' :: StartAutomationExecution -> Maybe [HashMap Text [Text]]
$sel:targetLocations:StartAutomationExecution' :: StartAutomationExecution -> Maybe (NonEmpty TargetLocation)
$sel:tags:StartAutomationExecution' :: StartAutomationExecution -> Maybe [Tag]
$sel:parameters:StartAutomationExecution' :: StartAutomationExecution -> Maybe (HashMap Text [Text])
$sel:mode:StartAutomationExecution' :: StartAutomationExecution -> Maybe ExecutionMode
$sel:maxErrors:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:maxConcurrency:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:documentVersion:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:clientToken:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:alarmConfiguration:StartAutomationExecution' :: StartAutomationExecution -> Maybe AlarmConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AlarmConfiguration
alarmConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
documentVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maxConcurrency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maxErrors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExecutionMode
mode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [Text])
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty TargetLocation)
targetLocations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [HashMap Text [Text]]
targetMaps
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetParameterName
      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 Text
documentName

instance Data.ToHeaders StartAutomationExecution where
  toHeaders :: StartAutomationExecution -> 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
"AmazonSSM.StartAutomationExecution" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StartAutomationExecution where
  toJSON :: StartAutomationExecution -> Value
toJSON StartAutomationExecution' {Maybe [HashMap Text [Text]]
Maybe [Tag]
Maybe [Target]
Maybe (NonEmpty TargetLocation)
Maybe Text
Maybe (HashMap Text [Text])
Maybe AlarmConfiguration
Maybe ExecutionMode
Text
documentName :: Text
targets :: Maybe [Target]
targetParameterName :: Maybe Text
targetMaps :: Maybe [HashMap Text [Text]]
targetLocations :: Maybe (NonEmpty TargetLocation)
tags :: Maybe [Tag]
parameters :: Maybe (HashMap Text [Text])
mode :: Maybe ExecutionMode
maxErrors :: Maybe Text
maxConcurrency :: Maybe Text
documentVersion :: Maybe Text
clientToken :: Maybe Text
alarmConfiguration :: Maybe AlarmConfiguration
$sel:documentName:StartAutomationExecution' :: StartAutomationExecution -> Text
$sel:targets:StartAutomationExecution' :: StartAutomationExecution -> Maybe [Target]
$sel:targetParameterName:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:targetMaps:StartAutomationExecution' :: StartAutomationExecution -> Maybe [HashMap Text [Text]]
$sel:targetLocations:StartAutomationExecution' :: StartAutomationExecution -> Maybe (NonEmpty TargetLocation)
$sel:tags:StartAutomationExecution' :: StartAutomationExecution -> Maybe [Tag]
$sel:parameters:StartAutomationExecution' :: StartAutomationExecution -> Maybe (HashMap Text [Text])
$sel:mode:StartAutomationExecution' :: StartAutomationExecution -> Maybe ExecutionMode
$sel:maxErrors:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:maxConcurrency:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:documentVersion:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:clientToken:StartAutomationExecution' :: StartAutomationExecution -> Maybe Text
$sel:alarmConfiguration:StartAutomationExecution' :: StartAutomationExecution -> Maybe AlarmConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AlarmConfiguration" 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 AlarmConfiguration
alarmConfiguration,
            (Key
"ClientToken" 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
clientToken,
            (Key
"DocumentVersion" 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
documentVersion,
            (Key
"MaxConcurrency" 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
maxConcurrency,
            (Key
"MaxErrors" 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
maxErrors,
            (Key
"Mode" 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 ExecutionMode
mode,
            (Key
"Parameters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text [Text])
parameters,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            (Key
"TargetLocations" 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 (NonEmpty TargetLocation)
targetLocations,
            (Key
"TargetMaps" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [HashMap Text [Text]]
targetMaps,
            (Key
"TargetParameterName" 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
targetParameterName,
            (Key
"Targets" 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 [Target]
targets,
            forall a. a -> Maybe a
Prelude.Just (Key
"DocumentName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
documentName)
          ]
      )

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

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

-- | /See:/ 'newStartAutomationExecutionResponse' smart constructor.
data StartAutomationExecutionResponse = StartAutomationExecutionResponse'
  { -- | The unique ID of a newly scheduled automation execution.
    StartAutomationExecutionResponse -> Maybe Text
automationExecutionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartAutomationExecutionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartAutomationExecutionResponse
-> StartAutomationExecutionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartAutomationExecutionResponse
-> StartAutomationExecutionResponse -> Bool
$c/= :: StartAutomationExecutionResponse
-> StartAutomationExecutionResponse -> Bool
== :: StartAutomationExecutionResponse
-> StartAutomationExecutionResponse -> Bool
$c== :: StartAutomationExecutionResponse
-> StartAutomationExecutionResponse -> Bool
Prelude.Eq, ReadPrec [StartAutomationExecutionResponse]
ReadPrec StartAutomationExecutionResponse
Int -> ReadS StartAutomationExecutionResponse
ReadS [StartAutomationExecutionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartAutomationExecutionResponse]
$creadListPrec :: ReadPrec [StartAutomationExecutionResponse]
readPrec :: ReadPrec StartAutomationExecutionResponse
$creadPrec :: ReadPrec StartAutomationExecutionResponse
readList :: ReadS [StartAutomationExecutionResponse]
$creadList :: ReadS [StartAutomationExecutionResponse]
readsPrec :: Int -> ReadS StartAutomationExecutionResponse
$creadsPrec :: Int -> ReadS StartAutomationExecutionResponse
Prelude.Read, Int -> StartAutomationExecutionResponse -> ShowS
[StartAutomationExecutionResponse] -> ShowS
StartAutomationExecutionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartAutomationExecutionResponse] -> ShowS
$cshowList :: [StartAutomationExecutionResponse] -> ShowS
show :: StartAutomationExecutionResponse -> String
$cshow :: StartAutomationExecutionResponse -> String
showsPrec :: Int -> StartAutomationExecutionResponse -> ShowS
$cshowsPrec :: Int -> StartAutomationExecutionResponse -> ShowS
Prelude.Show, forall x.
Rep StartAutomationExecutionResponse x
-> StartAutomationExecutionResponse
forall x.
StartAutomationExecutionResponse
-> Rep StartAutomationExecutionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartAutomationExecutionResponse x
-> StartAutomationExecutionResponse
$cfrom :: forall x.
StartAutomationExecutionResponse
-> Rep StartAutomationExecutionResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartAutomationExecutionResponse' 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:
--
-- 'automationExecutionId', 'startAutomationExecutionResponse_automationExecutionId' - The unique ID of a newly scheduled automation execution.
--
-- 'httpStatus', 'startAutomationExecutionResponse_httpStatus' - The response's http status code.
newStartAutomationExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartAutomationExecutionResponse
newStartAutomationExecutionResponse :: Int -> StartAutomationExecutionResponse
newStartAutomationExecutionResponse Int
pHttpStatus_ =
  StartAutomationExecutionResponse'
    { $sel:automationExecutionId:StartAutomationExecutionResponse' :: Maybe Text
automationExecutionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartAutomationExecutionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique ID of a newly scheduled automation execution.
startAutomationExecutionResponse_automationExecutionId :: Lens.Lens' StartAutomationExecutionResponse (Prelude.Maybe Prelude.Text)
startAutomationExecutionResponse_automationExecutionId :: Lens' StartAutomationExecutionResponse (Maybe Text)
startAutomationExecutionResponse_automationExecutionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAutomationExecutionResponse' {Maybe Text
automationExecutionId :: Maybe Text
$sel:automationExecutionId:StartAutomationExecutionResponse' :: StartAutomationExecutionResponse -> Maybe Text
automationExecutionId} -> Maybe Text
automationExecutionId) (\s :: StartAutomationExecutionResponse
s@StartAutomationExecutionResponse' {} Maybe Text
a -> StartAutomationExecutionResponse
s {$sel:automationExecutionId:StartAutomationExecutionResponse' :: Maybe Text
automationExecutionId = Maybe Text
a} :: StartAutomationExecutionResponse)

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

instance
  Prelude.NFData
    StartAutomationExecutionResponse
  where
  rnf :: StartAutomationExecutionResponse -> ()
rnf StartAutomationExecutionResponse' {Int
Maybe Text
httpStatus :: Int
automationExecutionId :: Maybe Text
$sel:httpStatus:StartAutomationExecutionResponse' :: StartAutomationExecutionResponse -> Int
$sel:automationExecutionId:StartAutomationExecutionResponse' :: StartAutomationExecutionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
automationExecutionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus