{-# 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.SendCommand
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Runs commands on one or more managed nodes.
module Amazonka.SSM.SendCommand
  ( -- * Creating a Request
    SendCommand (..),
    newSendCommand,

    -- * Request Lenses
    sendCommand_alarmConfiguration,
    sendCommand_cloudWatchOutputConfig,
    sendCommand_comment,
    sendCommand_documentHash,
    sendCommand_documentHashType,
    sendCommand_documentVersion,
    sendCommand_instanceIds,
    sendCommand_maxConcurrency,
    sendCommand_maxErrors,
    sendCommand_notificationConfig,
    sendCommand_outputS3BucketName,
    sendCommand_outputS3KeyPrefix,
    sendCommand_outputS3Region,
    sendCommand_parameters,
    sendCommand_serviceRoleArn,
    sendCommand_targets,
    sendCommand_timeoutSeconds,
    sendCommand_documentName,

    -- * Destructuring the Response
    SendCommandResponse (..),
    newSendCommandResponse,

    -- * Response Lenses
    sendCommandResponse_command,
    sendCommandResponse_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:/ 'newSendCommand' smart constructor.
data SendCommand = SendCommand'
  { -- | The CloudWatch alarm you want to apply to your command.
    SendCommand -> Maybe AlarmConfiguration
alarmConfiguration :: Prelude.Maybe AlarmConfiguration,
    -- | Enables Amazon Web Services Systems Manager to send Run Command output
    -- to Amazon CloudWatch Logs. Run Command is a capability of Amazon Web
    -- Services Systems Manager.
    SendCommand -> Maybe CloudWatchOutputConfig
cloudWatchOutputConfig :: Prelude.Maybe CloudWatchOutputConfig,
    -- | User-specified information about the command, such as a brief
    -- description of what the command should do.
    SendCommand -> Maybe Text
comment :: Prelude.Maybe Prelude.Text,
    -- | The Sha256 or Sha1 hash created by the system when the document was
    -- created.
    --
    -- Sha1 hashes have been deprecated.
    SendCommand -> Maybe Text
documentHash :: Prelude.Maybe Prelude.Text,
    -- | Sha256 or Sha1.
    --
    -- Sha1 hashes have been deprecated.
    SendCommand -> Maybe DocumentHashType
documentHashType :: Prelude.Maybe DocumentHashType,
    -- | The SSM document version to use in the request. You can specify
    -- \$DEFAULT, $LATEST, or a specific version number. If you run commands by
    -- using the Command Line Interface (Amazon Web Services CLI), then you
    -- must escape the first two options by using a backslash. If you specify a
    -- version number, then you don\'t need to use the backslash. For example:
    --
    -- --document-version \"\\$DEFAULT\"
    --
    -- --document-version \"\\$LATEST\"
    --
    -- --document-version \"3\"
    SendCommand -> Maybe Text
documentVersion :: Prelude.Maybe Prelude.Text,
    -- | The IDs of the managed nodes where the command should run. Specifying
    -- managed node IDs is most useful when you are targeting a limited number
    -- of managed nodes, though you can specify up to 50 IDs.
    --
    -- To target a larger number of managed nodes, or if you prefer not to list
    -- individual node IDs, we recommend using the @Targets@ option instead.
    -- Using @Targets@, which accepts tag key-value pairs to identify the
    -- managed nodes to send commands to, you can a send command to tens,
    -- hundreds, or thousands of nodes at once.
    --
    -- For more information about how to use targets, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html Using targets and rate controls to send commands to a fleet>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    SendCommand -> Maybe [Text]
instanceIds :: Prelude.Maybe [Prelude.Text],
    -- | (Optional) The maximum number of managed nodes that are allowed to run
    -- the command at the same time. You can specify a number such as 10 or a
    -- percentage such as 10%. The default value is @50@. For more information
    -- about how to use @MaxConcurrency@, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html#send-commands-velocity Using concurrency controls>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    SendCommand -> Maybe Text
maxConcurrency :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of errors allowed without the command failing. When
    -- the command fails one more time beyond the value of @MaxErrors@, the
    -- systems stops sending the command to additional targets. You can specify
    -- a number like 10 or a percentage like 10%. The default value is @0@. For
    -- more information about how to use @MaxErrors@, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html#send-commands-maxerrors Using error controls>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    SendCommand -> Maybe Text
maxErrors :: Prelude.Maybe Prelude.Text,
    -- | Configurations for sending notifications.
    SendCommand -> Maybe NotificationConfig
notificationConfig :: Prelude.Maybe NotificationConfig,
    -- | The name of the S3 bucket where command execution responses should be
    -- stored.
    SendCommand -> Maybe Text
outputS3BucketName :: Prelude.Maybe Prelude.Text,
    -- | The directory structure within the S3 bucket where the responses should
    -- be stored.
    SendCommand -> Maybe Text
outputS3KeyPrefix :: Prelude.Maybe Prelude.Text,
    -- | (Deprecated) You can no longer specify this parameter. The system
    -- ignores it. Instead, Systems Manager automatically determines the Amazon
    -- Web Services Region of the S3 bucket.
    SendCommand -> Maybe Text
outputS3Region :: Prelude.Maybe Prelude.Text,
    -- | The required and optional parameters specified in the document being
    -- run.
    SendCommand -> Maybe (Sensitive (HashMap Text [Text]))
parameters :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text [Prelude.Text])),
    -- | The ARN of the Identity and Access Management (IAM) service role to use
    -- to publish Amazon Simple Notification Service (Amazon SNS) notifications
    -- for Run Command commands.
    --
    -- This role must provide the @sns:Publish@ permission for your
    -- notification topic. For information about creating and using this
    -- service role, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/monitoring-sns-notifications.html Monitoring Systems Manager status changes using Amazon SNS notifications>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    SendCommand -> Maybe Text
serviceRoleArn :: Prelude.Maybe Prelude.Text,
    -- | An array of search criteria that targets managed nodes using a
    -- @Key,Value@ combination that you specify. Specifying targets is most
    -- useful when you want to send a command to a large number of managed
    -- nodes at once. Using @Targets@, which accepts tag key-value pairs to
    -- identify managed nodes, you can send a command to tens, hundreds, or
    -- thousands of nodes at once.
    --
    -- To send a command to a smaller number of managed nodes, you can use the
    -- @InstanceIds@ option instead.
    --
    -- For more information about how to use targets, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html Sending commands to a fleet>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    SendCommand -> Maybe [Target]
targets :: Prelude.Maybe [Target],
    -- | If this time is reached and the command hasn\'t already started running,
    -- it won\'t run.
    SendCommand -> Maybe Natural
timeoutSeconds :: Prelude.Maybe Prelude.Natural,
    -- | The name of the Amazon Web Services Systems Manager document (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
    -- Amazon Resource Name (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/.
    --
    -- If you specify a document name or ARN that hasn\'t been shared with your
    -- account, you receive an @InvalidDocument@ error.
    SendCommand -> Text
documentName :: Prelude.Text
  }
  deriving (SendCommand -> SendCommand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendCommand -> SendCommand -> Bool
$c/= :: SendCommand -> SendCommand -> Bool
== :: SendCommand -> SendCommand -> Bool
$c== :: SendCommand -> SendCommand -> Bool
Prelude.Eq, Int -> SendCommand -> ShowS
[SendCommand] -> ShowS
SendCommand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendCommand] -> ShowS
$cshowList :: [SendCommand] -> ShowS
show :: SendCommand -> String
$cshow :: SendCommand -> String
showsPrec :: Int -> SendCommand -> ShowS
$cshowsPrec :: Int -> SendCommand -> ShowS
Prelude.Show, forall x. Rep SendCommand x -> SendCommand
forall x. SendCommand -> Rep SendCommand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendCommand x -> SendCommand
$cfrom :: forall x. SendCommand -> Rep SendCommand x
Prelude.Generic)

-- |
-- Create a value of 'SendCommand' 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', 'sendCommand_alarmConfiguration' - The CloudWatch alarm you want to apply to your command.
--
-- 'cloudWatchOutputConfig', 'sendCommand_cloudWatchOutputConfig' - Enables Amazon Web Services Systems Manager to send Run Command output
-- to Amazon CloudWatch Logs. Run Command is a capability of Amazon Web
-- Services Systems Manager.
--
-- 'comment', 'sendCommand_comment' - User-specified information about the command, such as a brief
-- description of what the command should do.
--
-- 'documentHash', 'sendCommand_documentHash' - The Sha256 or Sha1 hash created by the system when the document was
-- created.
--
-- Sha1 hashes have been deprecated.
--
-- 'documentHashType', 'sendCommand_documentHashType' - Sha256 or Sha1.
--
-- Sha1 hashes have been deprecated.
--
-- 'documentVersion', 'sendCommand_documentVersion' - The SSM document version to use in the request. You can specify
-- \$DEFAULT, $LATEST, or a specific version number. If you run commands by
-- using the Command Line Interface (Amazon Web Services CLI), then you
-- must escape the first two options by using a backslash. If you specify a
-- version number, then you don\'t need to use the backslash. For example:
--
-- --document-version \"\\$DEFAULT\"
--
-- --document-version \"\\$LATEST\"
--
-- --document-version \"3\"
--
-- 'instanceIds', 'sendCommand_instanceIds' - The IDs of the managed nodes where the command should run. Specifying
-- managed node IDs is most useful when you are targeting a limited number
-- of managed nodes, though you can specify up to 50 IDs.
--
-- To target a larger number of managed nodes, or if you prefer not to list
-- individual node IDs, we recommend using the @Targets@ option instead.
-- Using @Targets@, which accepts tag key-value pairs to identify the
-- managed nodes to send commands to, you can a send command to tens,
-- hundreds, or thousands of nodes at once.
--
-- For more information about how to use targets, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html Using targets and rate controls to send commands to a fleet>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'maxConcurrency', 'sendCommand_maxConcurrency' - (Optional) The maximum number of managed nodes that are allowed to run
-- the command at the same time. You can specify a number such as 10 or a
-- percentage such as 10%. The default value is @50@. For more information
-- about how to use @MaxConcurrency@, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html#send-commands-velocity Using concurrency controls>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'maxErrors', 'sendCommand_maxErrors' - The maximum number of errors allowed without the command failing. When
-- the command fails one more time beyond the value of @MaxErrors@, the
-- systems stops sending the command to additional targets. You can specify
-- a number like 10 or a percentage like 10%. The default value is @0@. For
-- more information about how to use @MaxErrors@, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html#send-commands-maxerrors Using error controls>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'notificationConfig', 'sendCommand_notificationConfig' - Configurations for sending notifications.
--
-- 'outputS3BucketName', 'sendCommand_outputS3BucketName' - The name of the S3 bucket where command execution responses should be
-- stored.
--
-- 'outputS3KeyPrefix', 'sendCommand_outputS3KeyPrefix' - The directory structure within the S3 bucket where the responses should
-- be stored.
--
-- 'outputS3Region', 'sendCommand_outputS3Region' - (Deprecated) You can no longer specify this parameter. The system
-- ignores it. Instead, Systems Manager automatically determines the Amazon
-- Web Services Region of the S3 bucket.
--
-- 'parameters', 'sendCommand_parameters' - The required and optional parameters specified in the document being
-- run.
--
-- 'serviceRoleArn', 'sendCommand_serviceRoleArn' - The ARN of the Identity and Access Management (IAM) service role to use
-- to publish Amazon Simple Notification Service (Amazon SNS) notifications
-- for Run Command commands.
--
-- This role must provide the @sns:Publish@ permission for your
-- notification topic. For information about creating and using this
-- service role, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/monitoring-sns-notifications.html Monitoring Systems Manager status changes using Amazon SNS notifications>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'targets', 'sendCommand_targets' - An array of search criteria that targets managed nodes using a
-- @Key,Value@ combination that you specify. Specifying targets is most
-- useful when you want to send a command to a large number of managed
-- nodes at once. Using @Targets@, which accepts tag key-value pairs to
-- identify managed nodes, you can send a command to tens, hundreds, or
-- thousands of nodes at once.
--
-- To send a command to a smaller number of managed nodes, you can use the
-- @InstanceIds@ option instead.
--
-- For more information about how to use targets, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html Sending commands to a fleet>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'timeoutSeconds', 'sendCommand_timeoutSeconds' - If this time is reached and the command hasn\'t already started running,
-- it won\'t run.
--
-- 'documentName', 'sendCommand_documentName' - The name of the Amazon Web Services Systems Manager document (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
-- Amazon Resource Name (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/.
--
-- If you specify a document name or ARN that hasn\'t been shared with your
-- account, you receive an @InvalidDocument@ error.
newSendCommand ::
  -- | 'documentName'
  Prelude.Text ->
  SendCommand
newSendCommand :: Text -> SendCommand
newSendCommand Text
pDocumentName_ =
  SendCommand'
    { $sel:alarmConfiguration:SendCommand' :: Maybe AlarmConfiguration
alarmConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:cloudWatchOutputConfig:SendCommand' :: Maybe CloudWatchOutputConfig
cloudWatchOutputConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:comment:SendCommand' :: Maybe Text
comment = forall a. Maybe a
Prelude.Nothing,
      $sel:documentHash:SendCommand' :: Maybe Text
documentHash = forall a. Maybe a
Prelude.Nothing,
      $sel:documentHashType:SendCommand' :: Maybe DocumentHashType
documentHashType = forall a. Maybe a
Prelude.Nothing,
      $sel:documentVersion:SendCommand' :: Maybe Text
documentVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceIds:SendCommand' :: Maybe [Text]
instanceIds = forall a. Maybe a
Prelude.Nothing,
      $sel:maxConcurrency:SendCommand' :: Maybe Text
maxConcurrency = forall a. Maybe a
Prelude.Nothing,
      $sel:maxErrors:SendCommand' :: Maybe Text
maxErrors = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationConfig:SendCommand' :: Maybe NotificationConfig
notificationConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:outputS3BucketName:SendCommand' :: Maybe Text
outputS3BucketName = forall a. Maybe a
Prelude.Nothing,
      $sel:outputS3KeyPrefix:SendCommand' :: Maybe Text
outputS3KeyPrefix = forall a. Maybe a
Prelude.Nothing,
      $sel:outputS3Region:SendCommand' :: Maybe Text
outputS3Region = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:SendCommand' :: Maybe (Sensitive (HashMap Text [Text]))
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceRoleArn:SendCommand' :: Maybe Text
serviceRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:targets:SendCommand' :: Maybe [Target]
targets = forall a. Maybe a
Prelude.Nothing,
      $sel:timeoutSeconds:SendCommand' :: Maybe Natural
timeoutSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:documentName:SendCommand' :: Text
documentName = Text
pDocumentName_
    }

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

-- | Enables Amazon Web Services Systems Manager to send Run Command output
-- to Amazon CloudWatch Logs. Run Command is a capability of Amazon Web
-- Services Systems Manager.
sendCommand_cloudWatchOutputConfig :: Lens.Lens' SendCommand (Prelude.Maybe CloudWatchOutputConfig)
sendCommand_cloudWatchOutputConfig :: Lens' SendCommand (Maybe CloudWatchOutputConfig)
sendCommand_cloudWatchOutputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe CloudWatchOutputConfig
cloudWatchOutputConfig :: Maybe CloudWatchOutputConfig
$sel:cloudWatchOutputConfig:SendCommand' :: SendCommand -> Maybe CloudWatchOutputConfig
cloudWatchOutputConfig} -> Maybe CloudWatchOutputConfig
cloudWatchOutputConfig) (\s :: SendCommand
s@SendCommand' {} Maybe CloudWatchOutputConfig
a -> SendCommand
s {$sel:cloudWatchOutputConfig:SendCommand' :: Maybe CloudWatchOutputConfig
cloudWatchOutputConfig = Maybe CloudWatchOutputConfig
a} :: SendCommand)

-- | User-specified information about the command, such as a brief
-- description of what the command should do.
sendCommand_comment :: Lens.Lens' SendCommand (Prelude.Maybe Prelude.Text)
sendCommand_comment :: Lens' SendCommand (Maybe Text)
sendCommand_comment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe Text
comment :: Maybe Text
$sel:comment:SendCommand' :: SendCommand -> Maybe Text
comment} -> Maybe Text
comment) (\s :: SendCommand
s@SendCommand' {} Maybe Text
a -> SendCommand
s {$sel:comment:SendCommand' :: Maybe Text
comment = Maybe Text
a} :: SendCommand)

-- | The Sha256 or Sha1 hash created by the system when the document was
-- created.
--
-- Sha1 hashes have been deprecated.
sendCommand_documentHash :: Lens.Lens' SendCommand (Prelude.Maybe Prelude.Text)
sendCommand_documentHash :: Lens' SendCommand (Maybe Text)
sendCommand_documentHash = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe Text
documentHash :: Maybe Text
$sel:documentHash:SendCommand' :: SendCommand -> Maybe Text
documentHash} -> Maybe Text
documentHash) (\s :: SendCommand
s@SendCommand' {} Maybe Text
a -> SendCommand
s {$sel:documentHash:SendCommand' :: Maybe Text
documentHash = Maybe Text
a} :: SendCommand)

-- | Sha256 or Sha1.
--
-- Sha1 hashes have been deprecated.
sendCommand_documentHashType :: Lens.Lens' SendCommand (Prelude.Maybe DocumentHashType)
sendCommand_documentHashType :: Lens' SendCommand (Maybe DocumentHashType)
sendCommand_documentHashType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe DocumentHashType
documentHashType :: Maybe DocumentHashType
$sel:documentHashType:SendCommand' :: SendCommand -> Maybe DocumentHashType
documentHashType} -> Maybe DocumentHashType
documentHashType) (\s :: SendCommand
s@SendCommand' {} Maybe DocumentHashType
a -> SendCommand
s {$sel:documentHashType:SendCommand' :: Maybe DocumentHashType
documentHashType = Maybe DocumentHashType
a} :: SendCommand)

-- | The SSM document version to use in the request. You can specify
-- \$DEFAULT, $LATEST, or a specific version number. If you run commands by
-- using the Command Line Interface (Amazon Web Services CLI), then you
-- must escape the first two options by using a backslash. If you specify a
-- version number, then you don\'t need to use the backslash. For example:
--
-- --document-version \"\\$DEFAULT\"
--
-- --document-version \"\\$LATEST\"
--
-- --document-version \"3\"
sendCommand_documentVersion :: Lens.Lens' SendCommand (Prelude.Maybe Prelude.Text)
sendCommand_documentVersion :: Lens' SendCommand (Maybe Text)
sendCommand_documentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe Text
documentVersion :: Maybe Text
$sel:documentVersion:SendCommand' :: SendCommand -> Maybe Text
documentVersion} -> Maybe Text
documentVersion) (\s :: SendCommand
s@SendCommand' {} Maybe Text
a -> SendCommand
s {$sel:documentVersion:SendCommand' :: Maybe Text
documentVersion = Maybe Text
a} :: SendCommand)

-- | The IDs of the managed nodes where the command should run. Specifying
-- managed node IDs is most useful when you are targeting a limited number
-- of managed nodes, though you can specify up to 50 IDs.
--
-- To target a larger number of managed nodes, or if you prefer not to list
-- individual node IDs, we recommend using the @Targets@ option instead.
-- Using @Targets@, which accepts tag key-value pairs to identify the
-- managed nodes to send commands to, you can a send command to tens,
-- hundreds, or thousands of nodes at once.
--
-- For more information about how to use targets, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html Using targets and rate controls to send commands to a fleet>
-- in the /Amazon Web Services Systems Manager User Guide/.
sendCommand_instanceIds :: Lens.Lens' SendCommand (Prelude.Maybe [Prelude.Text])
sendCommand_instanceIds :: Lens' SendCommand (Maybe [Text])
sendCommand_instanceIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe [Text]
instanceIds :: Maybe [Text]
$sel:instanceIds:SendCommand' :: SendCommand -> Maybe [Text]
instanceIds} -> Maybe [Text]
instanceIds) (\s :: SendCommand
s@SendCommand' {} Maybe [Text]
a -> SendCommand
s {$sel:instanceIds:SendCommand' :: Maybe [Text]
instanceIds = Maybe [Text]
a} :: SendCommand) 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) The maximum number of managed nodes that are allowed to run
-- the command at the same time. You can specify a number such as 10 or a
-- percentage such as 10%. The default value is @50@. For more information
-- about how to use @MaxConcurrency@, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html#send-commands-velocity Using concurrency controls>
-- in the /Amazon Web Services Systems Manager User Guide/.
sendCommand_maxConcurrency :: Lens.Lens' SendCommand (Prelude.Maybe Prelude.Text)
sendCommand_maxConcurrency :: Lens' SendCommand (Maybe Text)
sendCommand_maxConcurrency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe Text
maxConcurrency :: Maybe Text
$sel:maxConcurrency:SendCommand' :: SendCommand -> Maybe Text
maxConcurrency} -> Maybe Text
maxConcurrency) (\s :: SendCommand
s@SendCommand' {} Maybe Text
a -> SendCommand
s {$sel:maxConcurrency:SendCommand' :: Maybe Text
maxConcurrency = Maybe Text
a} :: SendCommand)

-- | The maximum number of errors allowed without the command failing. When
-- the command fails one more time beyond the value of @MaxErrors@, the
-- systems stops sending the command to additional targets. You can specify
-- a number like 10 or a percentage like 10%. The default value is @0@. For
-- more information about how to use @MaxErrors@, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html#send-commands-maxerrors Using error controls>
-- in the /Amazon Web Services Systems Manager User Guide/.
sendCommand_maxErrors :: Lens.Lens' SendCommand (Prelude.Maybe Prelude.Text)
sendCommand_maxErrors :: Lens' SendCommand (Maybe Text)
sendCommand_maxErrors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe Text
maxErrors :: Maybe Text
$sel:maxErrors:SendCommand' :: SendCommand -> Maybe Text
maxErrors} -> Maybe Text
maxErrors) (\s :: SendCommand
s@SendCommand' {} Maybe Text
a -> SendCommand
s {$sel:maxErrors:SendCommand' :: Maybe Text
maxErrors = Maybe Text
a} :: SendCommand)

-- | Configurations for sending notifications.
sendCommand_notificationConfig :: Lens.Lens' SendCommand (Prelude.Maybe NotificationConfig)
sendCommand_notificationConfig :: Lens' SendCommand (Maybe NotificationConfig)
sendCommand_notificationConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe NotificationConfig
notificationConfig :: Maybe NotificationConfig
$sel:notificationConfig:SendCommand' :: SendCommand -> Maybe NotificationConfig
notificationConfig} -> Maybe NotificationConfig
notificationConfig) (\s :: SendCommand
s@SendCommand' {} Maybe NotificationConfig
a -> SendCommand
s {$sel:notificationConfig:SendCommand' :: Maybe NotificationConfig
notificationConfig = Maybe NotificationConfig
a} :: SendCommand)

-- | The name of the S3 bucket where command execution responses should be
-- stored.
sendCommand_outputS3BucketName :: Lens.Lens' SendCommand (Prelude.Maybe Prelude.Text)
sendCommand_outputS3BucketName :: Lens' SendCommand (Maybe Text)
sendCommand_outputS3BucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe Text
outputS3BucketName :: Maybe Text
$sel:outputS3BucketName:SendCommand' :: SendCommand -> Maybe Text
outputS3BucketName} -> Maybe Text
outputS3BucketName) (\s :: SendCommand
s@SendCommand' {} Maybe Text
a -> SendCommand
s {$sel:outputS3BucketName:SendCommand' :: Maybe Text
outputS3BucketName = Maybe Text
a} :: SendCommand)

-- | The directory structure within the S3 bucket where the responses should
-- be stored.
sendCommand_outputS3KeyPrefix :: Lens.Lens' SendCommand (Prelude.Maybe Prelude.Text)
sendCommand_outputS3KeyPrefix :: Lens' SendCommand (Maybe Text)
sendCommand_outputS3KeyPrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe Text
outputS3KeyPrefix :: Maybe Text
$sel:outputS3KeyPrefix:SendCommand' :: SendCommand -> Maybe Text
outputS3KeyPrefix} -> Maybe Text
outputS3KeyPrefix) (\s :: SendCommand
s@SendCommand' {} Maybe Text
a -> SendCommand
s {$sel:outputS3KeyPrefix:SendCommand' :: Maybe Text
outputS3KeyPrefix = Maybe Text
a} :: SendCommand)

-- | (Deprecated) You can no longer specify this parameter. The system
-- ignores it. Instead, Systems Manager automatically determines the Amazon
-- Web Services Region of the S3 bucket.
sendCommand_outputS3Region :: Lens.Lens' SendCommand (Prelude.Maybe Prelude.Text)
sendCommand_outputS3Region :: Lens' SendCommand (Maybe Text)
sendCommand_outputS3Region = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe Text
outputS3Region :: Maybe Text
$sel:outputS3Region:SendCommand' :: SendCommand -> Maybe Text
outputS3Region} -> Maybe Text
outputS3Region) (\s :: SendCommand
s@SendCommand' {} Maybe Text
a -> SendCommand
s {$sel:outputS3Region:SendCommand' :: Maybe Text
outputS3Region = Maybe Text
a} :: SendCommand)

-- | The required and optional parameters specified in the document being
-- run.
sendCommand_parameters :: Lens.Lens' SendCommand (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
sendCommand_parameters :: Lens' SendCommand (Maybe (HashMap Text [Text]))
sendCommand_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe (Sensitive (HashMap Text [Text]))
parameters :: Maybe (Sensitive (HashMap Text [Text]))
$sel:parameters:SendCommand' :: SendCommand -> Maybe (Sensitive (HashMap Text [Text]))
parameters} -> Maybe (Sensitive (HashMap Text [Text]))
parameters) (\s :: SendCommand
s@SendCommand' {} Maybe (Sensitive (HashMap Text [Text]))
a -> SendCommand
s {$sel:parameters:SendCommand' :: Maybe (Sensitive (HashMap Text [Text]))
parameters = Maybe (Sensitive (HashMap Text [Text]))
a} :: SendCommand) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | The ARN of the Identity and Access Management (IAM) service role to use
-- to publish Amazon Simple Notification Service (Amazon SNS) notifications
-- for Run Command commands.
--
-- This role must provide the @sns:Publish@ permission for your
-- notification topic. For information about creating and using this
-- service role, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/monitoring-sns-notifications.html Monitoring Systems Manager status changes using Amazon SNS notifications>
-- in the /Amazon Web Services Systems Manager User Guide/.
sendCommand_serviceRoleArn :: Lens.Lens' SendCommand (Prelude.Maybe Prelude.Text)
sendCommand_serviceRoleArn :: Lens' SendCommand (Maybe Text)
sendCommand_serviceRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe Text
serviceRoleArn :: Maybe Text
$sel:serviceRoleArn:SendCommand' :: SendCommand -> Maybe Text
serviceRoleArn} -> Maybe Text
serviceRoleArn) (\s :: SendCommand
s@SendCommand' {} Maybe Text
a -> SendCommand
s {$sel:serviceRoleArn:SendCommand' :: Maybe Text
serviceRoleArn = Maybe Text
a} :: SendCommand)

-- | An array of search criteria that targets managed nodes using a
-- @Key,Value@ combination that you specify. Specifying targets is most
-- useful when you want to send a command to a large number of managed
-- nodes at once. Using @Targets@, which accepts tag key-value pairs to
-- identify managed nodes, you can send a command to tens, hundreds, or
-- thousands of nodes at once.
--
-- To send a command to a smaller number of managed nodes, you can use the
-- @InstanceIds@ option instead.
--
-- For more information about how to use targets, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/send-commands-multiple.html Sending commands to a fleet>
-- in the /Amazon Web Services Systems Manager User Guide/.
sendCommand_targets :: Lens.Lens' SendCommand (Prelude.Maybe [Target])
sendCommand_targets :: Lens' SendCommand (Maybe [Target])
sendCommand_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe [Target]
targets :: Maybe [Target]
$sel:targets:SendCommand' :: SendCommand -> Maybe [Target]
targets} -> Maybe [Target]
targets) (\s :: SendCommand
s@SendCommand' {} Maybe [Target]
a -> SendCommand
s {$sel:targets:SendCommand' :: Maybe [Target]
targets = Maybe [Target]
a} :: SendCommand) 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

-- | If this time is reached and the command hasn\'t already started running,
-- it won\'t run.
sendCommand_timeoutSeconds :: Lens.Lens' SendCommand (Prelude.Maybe Prelude.Natural)
sendCommand_timeoutSeconds :: Lens' SendCommand (Maybe Natural)
sendCommand_timeoutSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Maybe Natural
timeoutSeconds :: Maybe Natural
$sel:timeoutSeconds:SendCommand' :: SendCommand -> Maybe Natural
timeoutSeconds} -> Maybe Natural
timeoutSeconds) (\s :: SendCommand
s@SendCommand' {} Maybe Natural
a -> SendCommand
s {$sel:timeoutSeconds:SendCommand' :: Maybe Natural
timeoutSeconds = Maybe Natural
a} :: SendCommand)

-- | The name of the Amazon Web Services Systems Manager document (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
-- Amazon Resource Name (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/.
--
-- If you specify a document name or ARN that hasn\'t been shared with your
-- account, you receive an @InvalidDocument@ error.
sendCommand_documentName :: Lens.Lens' SendCommand Prelude.Text
sendCommand_documentName :: Lens' SendCommand Text
sendCommand_documentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommand' {Text
documentName :: Text
$sel:documentName:SendCommand' :: SendCommand -> Text
documentName} -> Text
documentName) (\s :: SendCommand
s@SendCommand' {} Text
a -> SendCommand
s {$sel:documentName:SendCommand' :: Text
documentName = Text
a} :: SendCommand)

instance Core.AWSRequest SendCommand where
  type AWSResponse SendCommand = SendCommandResponse
  request :: (Service -> Service) -> SendCommand -> Request SendCommand
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 SendCommand
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SendCommand)))
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 Command -> Int -> SendCommandResponse
SendCommandResponse'
            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
"Command")
            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 SendCommand where
  hashWithSalt :: Int -> SendCommand -> Int
hashWithSalt Int
_salt SendCommand' {Maybe Natural
Maybe [Text]
Maybe [Target]
Maybe Text
Maybe (Sensitive (HashMap Text [Text]))
Maybe AlarmConfiguration
Maybe CloudWatchOutputConfig
Maybe DocumentHashType
Maybe NotificationConfig
Text
documentName :: Text
timeoutSeconds :: Maybe Natural
targets :: Maybe [Target]
serviceRoleArn :: Maybe Text
parameters :: Maybe (Sensitive (HashMap Text [Text]))
outputS3Region :: Maybe Text
outputS3KeyPrefix :: Maybe Text
outputS3BucketName :: Maybe Text
notificationConfig :: Maybe NotificationConfig
maxErrors :: Maybe Text
maxConcurrency :: Maybe Text
instanceIds :: Maybe [Text]
documentVersion :: Maybe Text
documentHashType :: Maybe DocumentHashType
documentHash :: Maybe Text
comment :: Maybe Text
cloudWatchOutputConfig :: Maybe CloudWatchOutputConfig
alarmConfiguration :: Maybe AlarmConfiguration
$sel:documentName:SendCommand' :: SendCommand -> Text
$sel:timeoutSeconds:SendCommand' :: SendCommand -> Maybe Natural
$sel:targets:SendCommand' :: SendCommand -> Maybe [Target]
$sel:serviceRoleArn:SendCommand' :: SendCommand -> Maybe Text
$sel:parameters:SendCommand' :: SendCommand -> Maybe (Sensitive (HashMap Text [Text]))
$sel:outputS3Region:SendCommand' :: SendCommand -> Maybe Text
$sel:outputS3KeyPrefix:SendCommand' :: SendCommand -> Maybe Text
$sel:outputS3BucketName:SendCommand' :: SendCommand -> Maybe Text
$sel:notificationConfig:SendCommand' :: SendCommand -> Maybe NotificationConfig
$sel:maxErrors:SendCommand' :: SendCommand -> Maybe Text
$sel:maxConcurrency:SendCommand' :: SendCommand -> Maybe Text
$sel:instanceIds:SendCommand' :: SendCommand -> Maybe [Text]
$sel:documentVersion:SendCommand' :: SendCommand -> Maybe Text
$sel:documentHashType:SendCommand' :: SendCommand -> Maybe DocumentHashType
$sel:documentHash:SendCommand' :: SendCommand -> Maybe Text
$sel:comment:SendCommand' :: SendCommand -> Maybe Text
$sel:cloudWatchOutputConfig:SendCommand' :: SendCommand -> Maybe CloudWatchOutputConfig
$sel:alarmConfiguration:SendCommand' :: SendCommand -> 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 CloudWatchOutputConfig
cloudWatchOutputConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
comment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
documentHash
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DocumentHashType
documentHashType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
documentVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
instanceIds
      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 NotificationConfig
notificationConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outputS3BucketName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outputS3KeyPrefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outputS3Region
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (HashMap Text [Text]))
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Target]
targets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timeoutSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
documentName

instance Prelude.NFData SendCommand where
  rnf :: SendCommand -> ()
rnf SendCommand' {Maybe Natural
Maybe [Text]
Maybe [Target]
Maybe Text
Maybe (Sensitive (HashMap Text [Text]))
Maybe AlarmConfiguration
Maybe CloudWatchOutputConfig
Maybe DocumentHashType
Maybe NotificationConfig
Text
documentName :: Text
timeoutSeconds :: Maybe Natural
targets :: Maybe [Target]
serviceRoleArn :: Maybe Text
parameters :: Maybe (Sensitive (HashMap Text [Text]))
outputS3Region :: Maybe Text
outputS3KeyPrefix :: Maybe Text
outputS3BucketName :: Maybe Text
notificationConfig :: Maybe NotificationConfig
maxErrors :: Maybe Text
maxConcurrency :: Maybe Text
instanceIds :: Maybe [Text]
documentVersion :: Maybe Text
documentHashType :: Maybe DocumentHashType
documentHash :: Maybe Text
comment :: Maybe Text
cloudWatchOutputConfig :: Maybe CloudWatchOutputConfig
alarmConfiguration :: Maybe AlarmConfiguration
$sel:documentName:SendCommand' :: SendCommand -> Text
$sel:timeoutSeconds:SendCommand' :: SendCommand -> Maybe Natural
$sel:targets:SendCommand' :: SendCommand -> Maybe [Target]
$sel:serviceRoleArn:SendCommand' :: SendCommand -> Maybe Text
$sel:parameters:SendCommand' :: SendCommand -> Maybe (Sensitive (HashMap Text [Text]))
$sel:outputS3Region:SendCommand' :: SendCommand -> Maybe Text
$sel:outputS3KeyPrefix:SendCommand' :: SendCommand -> Maybe Text
$sel:outputS3BucketName:SendCommand' :: SendCommand -> Maybe Text
$sel:notificationConfig:SendCommand' :: SendCommand -> Maybe NotificationConfig
$sel:maxErrors:SendCommand' :: SendCommand -> Maybe Text
$sel:maxConcurrency:SendCommand' :: SendCommand -> Maybe Text
$sel:instanceIds:SendCommand' :: SendCommand -> Maybe [Text]
$sel:documentVersion:SendCommand' :: SendCommand -> Maybe Text
$sel:documentHashType:SendCommand' :: SendCommand -> Maybe DocumentHashType
$sel:documentHash:SendCommand' :: SendCommand -> Maybe Text
$sel:comment:SendCommand' :: SendCommand -> Maybe Text
$sel:cloudWatchOutputConfig:SendCommand' :: SendCommand -> Maybe CloudWatchOutputConfig
$sel:alarmConfiguration:SendCommand' :: SendCommand -> 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 CloudWatchOutputConfig
cloudWatchOutputConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
comment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
documentHash
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DocumentHashType
documentHashType
      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]
instanceIds
      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 NotificationConfig
notificationConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outputS3BucketName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outputS3KeyPrefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outputS3Region
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text [Text]))
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceRoleArn
      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 Natural
timeoutSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
documentName

instance Data.ToHeaders SendCommand where
  toHeaders :: SendCommand -> 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.SendCommand" :: 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 SendCommand where
  toJSON :: SendCommand -> Value
toJSON SendCommand' {Maybe Natural
Maybe [Text]
Maybe [Target]
Maybe Text
Maybe (Sensitive (HashMap Text [Text]))
Maybe AlarmConfiguration
Maybe CloudWatchOutputConfig
Maybe DocumentHashType
Maybe NotificationConfig
Text
documentName :: Text
timeoutSeconds :: Maybe Natural
targets :: Maybe [Target]
serviceRoleArn :: Maybe Text
parameters :: Maybe (Sensitive (HashMap Text [Text]))
outputS3Region :: Maybe Text
outputS3KeyPrefix :: Maybe Text
outputS3BucketName :: Maybe Text
notificationConfig :: Maybe NotificationConfig
maxErrors :: Maybe Text
maxConcurrency :: Maybe Text
instanceIds :: Maybe [Text]
documentVersion :: Maybe Text
documentHashType :: Maybe DocumentHashType
documentHash :: Maybe Text
comment :: Maybe Text
cloudWatchOutputConfig :: Maybe CloudWatchOutputConfig
alarmConfiguration :: Maybe AlarmConfiguration
$sel:documentName:SendCommand' :: SendCommand -> Text
$sel:timeoutSeconds:SendCommand' :: SendCommand -> Maybe Natural
$sel:targets:SendCommand' :: SendCommand -> Maybe [Target]
$sel:serviceRoleArn:SendCommand' :: SendCommand -> Maybe Text
$sel:parameters:SendCommand' :: SendCommand -> Maybe (Sensitive (HashMap Text [Text]))
$sel:outputS3Region:SendCommand' :: SendCommand -> Maybe Text
$sel:outputS3KeyPrefix:SendCommand' :: SendCommand -> Maybe Text
$sel:outputS3BucketName:SendCommand' :: SendCommand -> Maybe Text
$sel:notificationConfig:SendCommand' :: SendCommand -> Maybe NotificationConfig
$sel:maxErrors:SendCommand' :: SendCommand -> Maybe Text
$sel:maxConcurrency:SendCommand' :: SendCommand -> Maybe Text
$sel:instanceIds:SendCommand' :: SendCommand -> Maybe [Text]
$sel:documentVersion:SendCommand' :: SendCommand -> Maybe Text
$sel:documentHashType:SendCommand' :: SendCommand -> Maybe DocumentHashType
$sel:documentHash:SendCommand' :: SendCommand -> Maybe Text
$sel:comment:SendCommand' :: SendCommand -> Maybe Text
$sel:cloudWatchOutputConfig:SendCommand' :: SendCommand -> Maybe CloudWatchOutputConfig
$sel:alarmConfiguration:SendCommand' :: SendCommand -> 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
"CloudWatchOutputConfig" 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 CloudWatchOutputConfig
cloudWatchOutputConfig,
            (Key
"Comment" 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
comment,
            (Key
"DocumentHash" 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
documentHash,
            (Key
"DocumentHashType" 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 DocumentHashType
documentHashType,
            (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
"InstanceIds" 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]
instanceIds,
            (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
"NotificationConfig" 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 NotificationConfig
notificationConfig,
            (Key
"OutputS3BucketName" 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
outputS3BucketName,
            (Key
"OutputS3KeyPrefix" 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
outputS3KeyPrefix,
            (Key
"OutputS3Region" 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
outputS3Region,
            (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 (Sensitive (HashMap Text [Text]))
parameters,
            (Key
"ServiceRoleArn" 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
serviceRoleArn,
            (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,
            (Key
"TimeoutSeconds" 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 Natural
timeoutSeconds,
            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 SendCommand where
  toPath :: SendCommand -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newSendCommandResponse' smart constructor.
data SendCommandResponse = SendCommandResponse'
  { -- | The request as it was received by Systems Manager. Also provides the
    -- command ID which can be used future references to this request.
    SendCommandResponse -> Maybe Command
command :: Prelude.Maybe Command,
    -- | The response's http status code.
    SendCommandResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SendCommandResponse -> SendCommandResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendCommandResponse -> SendCommandResponse -> Bool
$c/= :: SendCommandResponse -> SendCommandResponse -> Bool
== :: SendCommandResponse -> SendCommandResponse -> Bool
$c== :: SendCommandResponse -> SendCommandResponse -> Bool
Prelude.Eq, Int -> SendCommandResponse -> ShowS
[SendCommandResponse] -> ShowS
SendCommandResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendCommandResponse] -> ShowS
$cshowList :: [SendCommandResponse] -> ShowS
show :: SendCommandResponse -> String
$cshow :: SendCommandResponse -> String
showsPrec :: Int -> SendCommandResponse -> ShowS
$cshowsPrec :: Int -> SendCommandResponse -> ShowS
Prelude.Show, forall x. Rep SendCommandResponse x -> SendCommandResponse
forall x. SendCommandResponse -> Rep SendCommandResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendCommandResponse x -> SendCommandResponse
$cfrom :: forall x. SendCommandResponse -> Rep SendCommandResponse x
Prelude.Generic)

-- |
-- Create a value of 'SendCommandResponse' 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:
--
-- 'command', 'sendCommandResponse_command' - The request as it was received by Systems Manager. Also provides the
-- command ID which can be used future references to this request.
--
-- 'httpStatus', 'sendCommandResponse_httpStatus' - The response's http status code.
newSendCommandResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SendCommandResponse
newSendCommandResponse :: Int -> SendCommandResponse
newSendCommandResponse Int
pHttpStatus_ =
  SendCommandResponse'
    { $sel:command:SendCommandResponse' :: Maybe Command
command = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SendCommandResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The request as it was received by Systems Manager. Also provides the
-- command ID which can be used future references to this request.
sendCommandResponse_command :: Lens.Lens' SendCommandResponse (Prelude.Maybe Command)
sendCommandResponse_command :: Lens' SendCommandResponse (Maybe Command)
sendCommandResponse_command = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendCommandResponse' {Maybe Command
command :: Maybe Command
$sel:command:SendCommandResponse' :: SendCommandResponse -> Maybe Command
command} -> Maybe Command
command) (\s :: SendCommandResponse
s@SendCommandResponse' {} Maybe Command
a -> SendCommandResponse
s {$sel:command:SendCommandResponse' :: Maybe Command
command = Maybe Command
a} :: SendCommandResponse)

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

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