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

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

-- |
-- Module      : Amazonka.SSM.Types.CommandInvocation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.SSM.Types.CommandInvocation where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.SSM.Types.CloudWatchOutputConfig
import Amazonka.SSM.Types.CommandInvocationStatus
import Amazonka.SSM.Types.CommandPlugin
import Amazonka.SSM.Types.NotificationConfig

-- | An invocation is a copy of a command sent to a specific managed node. A
-- command can apply to one or more managed nodes. A command invocation
-- applies to one managed node. For example, if a user runs @SendCommand@
-- against three managed nodes, then a command invocation is created for
-- each requested managed node ID. A command invocation returns status and
-- detail information about a command you ran.
--
-- /See:/ 'newCommandInvocation' smart constructor.
data CommandInvocation = CommandInvocation'
  { -- | Amazon CloudWatch Logs information where you want Amazon Web Services
    -- Systems Manager to send the command output.
    CommandInvocation -> Maybe CloudWatchOutputConfig
cloudWatchOutputConfig :: Prelude.Maybe CloudWatchOutputConfig,
    -- | The command against which this invocation was requested.
    CommandInvocation -> Maybe Text
commandId :: Prelude.Maybe Prelude.Text,
    -- | Plugins processed by the command.
    CommandInvocation -> Maybe [CommandPlugin]
commandPlugins :: Prelude.Maybe [CommandPlugin],
    -- | User-specified information about the command, such as a brief
    -- description of what the command should do.
    CommandInvocation -> Maybe Text
comment :: Prelude.Maybe Prelude.Text,
    -- | The document name that was requested for execution.
    CommandInvocation -> Maybe Text
documentName :: Prelude.Maybe Prelude.Text,
    -- | The Systems Manager document (SSM document) version.
    CommandInvocation -> Maybe Text
documentVersion :: Prelude.Maybe Prelude.Text,
    -- | The managed node ID in which this invocation was requested.
    CommandInvocation -> Maybe Text
instanceId :: Prelude.Maybe Prelude.Text,
    -- | The fully qualified host name of the managed node.
    CommandInvocation -> Maybe Text
instanceName :: Prelude.Maybe Prelude.Text,
    -- | Configurations for sending notifications about command status changes on
    -- a per managed node basis.
    CommandInvocation -> Maybe NotificationConfig
notificationConfig :: Prelude.Maybe NotificationConfig,
    -- | The time and date the request was sent to this managed node.
    CommandInvocation -> Maybe POSIX
requestedDateTime :: Prelude.Maybe Data.POSIX,
    -- | The Identity and Access Management (IAM) service role that Run Command,
    -- a capability of Amazon Web Services Systems Manager, uses to act on your
    -- behalf when sending notifications about command status changes on a per
    -- managed node basis.
    CommandInvocation -> Maybe Text
serviceRole :: Prelude.Maybe Prelude.Text,
    -- | The URL to the plugin\'s StdErr file in Amazon Simple Storage Service
    -- (Amazon S3), if the S3 bucket was defined for the parent command. For an
    -- invocation, @StandardErrorUrl@ is populated if there is just one plugin
    -- defined for the command, and the S3 bucket was defined for the command.
    CommandInvocation -> Maybe Text
standardErrorUrl :: Prelude.Maybe Prelude.Text,
    -- | The URL to the plugin\'s StdOut file in Amazon Simple Storage Service
    -- (Amazon S3), if the S3 bucket was defined for the parent command. For an
    -- invocation, @StandardOutputUrl@ is populated if there is just one plugin
    -- defined for the command, and the S3 bucket was defined for the command.
    CommandInvocation -> Maybe Text
standardOutputUrl :: Prelude.Maybe Prelude.Text,
    -- | Whether or not the invocation succeeded, failed, or is pending.
    CommandInvocation -> Maybe CommandInvocationStatus
status :: Prelude.Maybe CommandInvocationStatus,
    -- | A detailed status of the command execution for each invocation (each
    -- managed node targeted by the command). StatusDetails includes more
    -- information than Status because it includes states resulting from error
    -- and concurrency control parameters. StatusDetails can show different
    -- results than Status. For more information about these statuses, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/monitor-commands.html Understanding command statuses>
    -- in the /Amazon Web Services Systems Manager User Guide/. StatusDetails
    -- can be one of the following values:
    --
    -- -   Pending: The command hasn\'t been sent to the managed node.
    --
    -- -   In Progress: The command has been sent to the managed node but
    --     hasn\'t reached a terminal state.
    --
    -- -   Success: The execution of the command or plugin was successfully
    --     completed. This is a terminal state.
    --
    -- -   Delivery Timed Out: The command wasn\'t delivered to the managed
    --     node before the delivery timeout expired. Delivery timeouts don\'t
    --     count against the parent command\'s @MaxErrors@ limit, but they do
    --     contribute to whether the parent command status is Success or
    --     Incomplete. This is a terminal state.
    --
    -- -   Execution Timed Out: Command execution started on the managed node,
    --     but the execution wasn\'t complete before the execution timeout
    --     expired. Execution timeouts count against the @MaxErrors@ limit of
    --     the parent command. This is a terminal state.
    --
    -- -   Failed: The command wasn\'t successful on the managed node. For a
    --     plugin, this indicates that the result code wasn\'t zero. For a
    --     command invocation, this indicates that the result code for one or
    --     more plugins wasn\'t zero. Invocation failures count against the
    --     @MaxErrors@ limit of the parent command. This is a terminal state.
    --
    -- -   Cancelled: The command was terminated before it was completed. This
    --     is a terminal state.
    --
    -- -   Undeliverable: The command can\'t be delivered to the managed node.
    --     The managed node might not exist or might not be responding.
    --     Undeliverable invocations don\'t count against the parent command\'s
    --     MaxErrors limit and don\'t contribute to whether the parent command
    --     status is Success or Incomplete. This is a terminal state.
    --
    -- -   Terminated: The parent command exceeded its MaxErrors limit and
    --     subsequent command invocations were canceled by the system. This is
    --     a terminal state.
    --
    -- -   Delayed: The system attempted to send the command to the managed
    --     node but wasn\'t successful. The system retries again.
    CommandInvocation -> Maybe Text
statusDetails :: Prelude.Maybe Prelude.Text,
    -- | Gets the trace output sent by the agent.
    CommandInvocation -> Maybe Text
traceOutput :: Prelude.Maybe Prelude.Text
  }
  deriving (CommandInvocation -> CommandInvocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandInvocation -> CommandInvocation -> Bool
$c/= :: CommandInvocation -> CommandInvocation -> Bool
== :: CommandInvocation -> CommandInvocation -> Bool
$c== :: CommandInvocation -> CommandInvocation -> Bool
Prelude.Eq, ReadPrec [CommandInvocation]
ReadPrec CommandInvocation
Int -> ReadS CommandInvocation
ReadS [CommandInvocation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommandInvocation]
$creadListPrec :: ReadPrec [CommandInvocation]
readPrec :: ReadPrec CommandInvocation
$creadPrec :: ReadPrec CommandInvocation
readList :: ReadS [CommandInvocation]
$creadList :: ReadS [CommandInvocation]
readsPrec :: Int -> ReadS CommandInvocation
$creadsPrec :: Int -> ReadS CommandInvocation
Prelude.Read, Int -> CommandInvocation -> ShowS
[CommandInvocation] -> ShowS
CommandInvocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandInvocation] -> ShowS
$cshowList :: [CommandInvocation] -> ShowS
show :: CommandInvocation -> String
$cshow :: CommandInvocation -> String
showsPrec :: Int -> CommandInvocation -> ShowS
$cshowsPrec :: Int -> CommandInvocation -> ShowS
Prelude.Show, forall x. Rep CommandInvocation x -> CommandInvocation
forall x. CommandInvocation -> Rep CommandInvocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CommandInvocation x -> CommandInvocation
$cfrom :: forall x. CommandInvocation -> Rep CommandInvocation x
Prelude.Generic)

-- |
-- Create a value of 'CommandInvocation' 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:
--
-- 'cloudWatchOutputConfig', 'commandInvocation_cloudWatchOutputConfig' - Amazon CloudWatch Logs information where you want Amazon Web Services
-- Systems Manager to send the command output.
--
-- 'commandId', 'commandInvocation_commandId' - The command against which this invocation was requested.
--
-- 'commandPlugins', 'commandInvocation_commandPlugins' - Plugins processed by the command.
--
-- 'comment', 'commandInvocation_comment' - User-specified information about the command, such as a brief
-- description of what the command should do.
--
-- 'documentName', 'commandInvocation_documentName' - The document name that was requested for execution.
--
-- 'documentVersion', 'commandInvocation_documentVersion' - The Systems Manager document (SSM document) version.
--
-- 'instanceId', 'commandInvocation_instanceId' - The managed node ID in which this invocation was requested.
--
-- 'instanceName', 'commandInvocation_instanceName' - The fully qualified host name of the managed node.
--
-- 'notificationConfig', 'commandInvocation_notificationConfig' - Configurations for sending notifications about command status changes on
-- a per managed node basis.
--
-- 'requestedDateTime', 'commandInvocation_requestedDateTime' - The time and date the request was sent to this managed node.
--
-- 'serviceRole', 'commandInvocation_serviceRole' - The Identity and Access Management (IAM) service role that Run Command,
-- a capability of Amazon Web Services Systems Manager, uses to act on your
-- behalf when sending notifications about command status changes on a per
-- managed node basis.
--
-- 'standardErrorUrl', 'commandInvocation_standardErrorUrl' - The URL to the plugin\'s StdErr file in Amazon Simple Storage Service
-- (Amazon S3), if the S3 bucket was defined for the parent command. For an
-- invocation, @StandardErrorUrl@ is populated if there is just one plugin
-- defined for the command, and the S3 bucket was defined for the command.
--
-- 'standardOutputUrl', 'commandInvocation_standardOutputUrl' - The URL to the plugin\'s StdOut file in Amazon Simple Storage Service
-- (Amazon S3), if the S3 bucket was defined for the parent command. For an
-- invocation, @StandardOutputUrl@ is populated if there is just one plugin
-- defined for the command, and the S3 bucket was defined for the command.
--
-- 'status', 'commandInvocation_status' - Whether or not the invocation succeeded, failed, or is pending.
--
-- 'statusDetails', 'commandInvocation_statusDetails' - A detailed status of the command execution for each invocation (each
-- managed node targeted by the command). StatusDetails includes more
-- information than Status because it includes states resulting from error
-- and concurrency control parameters. StatusDetails can show different
-- results than Status. For more information about these statuses, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/monitor-commands.html Understanding command statuses>
-- in the /Amazon Web Services Systems Manager User Guide/. StatusDetails
-- can be one of the following values:
--
-- -   Pending: The command hasn\'t been sent to the managed node.
--
-- -   In Progress: The command has been sent to the managed node but
--     hasn\'t reached a terminal state.
--
-- -   Success: The execution of the command or plugin was successfully
--     completed. This is a terminal state.
--
-- -   Delivery Timed Out: The command wasn\'t delivered to the managed
--     node before the delivery timeout expired. Delivery timeouts don\'t
--     count against the parent command\'s @MaxErrors@ limit, but they do
--     contribute to whether the parent command status is Success or
--     Incomplete. This is a terminal state.
--
-- -   Execution Timed Out: Command execution started on the managed node,
--     but the execution wasn\'t complete before the execution timeout
--     expired. Execution timeouts count against the @MaxErrors@ limit of
--     the parent command. This is a terminal state.
--
-- -   Failed: The command wasn\'t successful on the managed node. For a
--     plugin, this indicates that the result code wasn\'t zero. For a
--     command invocation, this indicates that the result code for one or
--     more plugins wasn\'t zero. Invocation failures count against the
--     @MaxErrors@ limit of the parent command. This is a terminal state.
--
-- -   Cancelled: The command was terminated before it was completed. This
--     is a terminal state.
--
-- -   Undeliverable: The command can\'t be delivered to the managed node.
--     The managed node might not exist or might not be responding.
--     Undeliverable invocations don\'t count against the parent command\'s
--     MaxErrors limit and don\'t contribute to whether the parent command
--     status is Success or Incomplete. This is a terminal state.
--
-- -   Terminated: The parent command exceeded its MaxErrors limit and
--     subsequent command invocations were canceled by the system. This is
--     a terminal state.
--
-- -   Delayed: The system attempted to send the command to the managed
--     node but wasn\'t successful. The system retries again.
--
-- 'traceOutput', 'commandInvocation_traceOutput' - Gets the trace output sent by the agent.
newCommandInvocation ::
  CommandInvocation
newCommandInvocation :: CommandInvocation
newCommandInvocation =
  CommandInvocation'
    { $sel:cloudWatchOutputConfig:CommandInvocation' :: Maybe CloudWatchOutputConfig
cloudWatchOutputConfig =
        forall a. Maybe a
Prelude.Nothing,
      $sel:commandId:CommandInvocation' :: Maybe Text
commandId = forall a. Maybe a
Prelude.Nothing,
      $sel:commandPlugins:CommandInvocation' :: Maybe [CommandPlugin]
commandPlugins = forall a. Maybe a
Prelude.Nothing,
      $sel:comment:CommandInvocation' :: Maybe Text
comment = forall a. Maybe a
Prelude.Nothing,
      $sel:documentName:CommandInvocation' :: Maybe Text
documentName = forall a. Maybe a
Prelude.Nothing,
      $sel:documentVersion:CommandInvocation' :: Maybe Text
documentVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:CommandInvocation' :: Maybe Text
instanceId = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceName:CommandInvocation' :: Maybe Text
instanceName = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationConfig:CommandInvocation' :: Maybe NotificationConfig
notificationConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:requestedDateTime:CommandInvocation' :: Maybe POSIX
requestedDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceRole:CommandInvocation' :: Maybe Text
serviceRole = forall a. Maybe a
Prelude.Nothing,
      $sel:standardErrorUrl:CommandInvocation' :: Maybe Text
standardErrorUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:standardOutputUrl:CommandInvocation' :: Maybe Text
standardOutputUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:status:CommandInvocation' :: Maybe CommandInvocationStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusDetails:CommandInvocation' :: Maybe Text
statusDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:traceOutput:CommandInvocation' :: Maybe Text
traceOutput = forall a. Maybe a
Prelude.Nothing
    }

-- | Amazon CloudWatch Logs information where you want Amazon Web Services
-- Systems Manager to send the command output.
commandInvocation_cloudWatchOutputConfig :: Lens.Lens' CommandInvocation (Prelude.Maybe CloudWatchOutputConfig)
commandInvocation_cloudWatchOutputConfig :: Lens' CommandInvocation (Maybe CloudWatchOutputConfig)
commandInvocation_cloudWatchOutputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe CloudWatchOutputConfig
cloudWatchOutputConfig :: Maybe CloudWatchOutputConfig
$sel:cloudWatchOutputConfig:CommandInvocation' :: CommandInvocation -> Maybe CloudWatchOutputConfig
cloudWatchOutputConfig} -> Maybe CloudWatchOutputConfig
cloudWatchOutputConfig) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe CloudWatchOutputConfig
a -> CommandInvocation
s {$sel:cloudWatchOutputConfig:CommandInvocation' :: Maybe CloudWatchOutputConfig
cloudWatchOutputConfig = Maybe CloudWatchOutputConfig
a} :: CommandInvocation)

-- | The command against which this invocation was requested.
commandInvocation_commandId :: Lens.Lens' CommandInvocation (Prelude.Maybe Prelude.Text)
commandInvocation_commandId :: Lens' CommandInvocation (Maybe Text)
commandInvocation_commandId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe Text
commandId :: Maybe Text
$sel:commandId:CommandInvocation' :: CommandInvocation -> Maybe Text
commandId} -> Maybe Text
commandId) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe Text
a -> CommandInvocation
s {$sel:commandId:CommandInvocation' :: Maybe Text
commandId = Maybe Text
a} :: CommandInvocation)

-- | Plugins processed by the command.
commandInvocation_commandPlugins :: Lens.Lens' CommandInvocation (Prelude.Maybe [CommandPlugin])
commandInvocation_commandPlugins :: Lens' CommandInvocation (Maybe [CommandPlugin])
commandInvocation_commandPlugins = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe [CommandPlugin]
commandPlugins :: Maybe [CommandPlugin]
$sel:commandPlugins:CommandInvocation' :: CommandInvocation -> Maybe [CommandPlugin]
commandPlugins} -> Maybe [CommandPlugin]
commandPlugins) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe [CommandPlugin]
a -> CommandInvocation
s {$sel:commandPlugins:CommandInvocation' :: Maybe [CommandPlugin]
commandPlugins = Maybe [CommandPlugin]
a} :: CommandInvocation) 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

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

-- | The document name that was requested for execution.
commandInvocation_documentName :: Lens.Lens' CommandInvocation (Prelude.Maybe Prelude.Text)
commandInvocation_documentName :: Lens' CommandInvocation (Maybe Text)
commandInvocation_documentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe Text
documentName :: Maybe Text
$sel:documentName:CommandInvocation' :: CommandInvocation -> Maybe Text
documentName} -> Maybe Text
documentName) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe Text
a -> CommandInvocation
s {$sel:documentName:CommandInvocation' :: Maybe Text
documentName = Maybe Text
a} :: CommandInvocation)

-- | The Systems Manager document (SSM document) version.
commandInvocation_documentVersion :: Lens.Lens' CommandInvocation (Prelude.Maybe Prelude.Text)
commandInvocation_documentVersion :: Lens' CommandInvocation (Maybe Text)
commandInvocation_documentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe Text
documentVersion :: Maybe Text
$sel:documentVersion:CommandInvocation' :: CommandInvocation -> Maybe Text
documentVersion} -> Maybe Text
documentVersion) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe Text
a -> CommandInvocation
s {$sel:documentVersion:CommandInvocation' :: Maybe Text
documentVersion = Maybe Text
a} :: CommandInvocation)

-- | The managed node ID in which this invocation was requested.
commandInvocation_instanceId :: Lens.Lens' CommandInvocation (Prelude.Maybe Prelude.Text)
commandInvocation_instanceId :: Lens' CommandInvocation (Maybe Text)
commandInvocation_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe Text
instanceId :: Maybe Text
$sel:instanceId:CommandInvocation' :: CommandInvocation -> Maybe Text
instanceId} -> Maybe Text
instanceId) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe Text
a -> CommandInvocation
s {$sel:instanceId:CommandInvocation' :: Maybe Text
instanceId = Maybe Text
a} :: CommandInvocation)

-- | The fully qualified host name of the managed node.
commandInvocation_instanceName :: Lens.Lens' CommandInvocation (Prelude.Maybe Prelude.Text)
commandInvocation_instanceName :: Lens' CommandInvocation (Maybe Text)
commandInvocation_instanceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe Text
instanceName :: Maybe Text
$sel:instanceName:CommandInvocation' :: CommandInvocation -> Maybe Text
instanceName} -> Maybe Text
instanceName) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe Text
a -> CommandInvocation
s {$sel:instanceName:CommandInvocation' :: Maybe Text
instanceName = Maybe Text
a} :: CommandInvocation)

-- | Configurations for sending notifications about command status changes on
-- a per managed node basis.
commandInvocation_notificationConfig :: Lens.Lens' CommandInvocation (Prelude.Maybe NotificationConfig)
commandInvocation_notificationConfig :: Lens' CommandInvocation (Maybe NotificationConfig)
commandInvocation_notificationConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe NotificationConfig
notificationConfig :: Maybe NotificationConfig
$sel:notificationConfig:CommandInvocation' :: CommandInvocation -> Maybe NotificationConfig
notificationConfig} -> Maybe NotificationConfig
notificationConfig) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe NotificationConfig
a -> CommandInvocation
s {$sel:notificationConfig:CommandInvocation' :: Maybe NotificationConfig
notificationConfig = Maybe NotificationConfig
a} :: CommandInvocation)

-- | The time and date the request was sent to this managed node.
commandInvocation_requestedDateTime :: Lens.Lens' CommandInvocation (Prelude.Maybe Prelude.UTCTime)
commandInvocation_requestedDateTime :: Lens' CommandInvocation (Maybe UTCTime)
commandInvocation_requestedDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe POSIX
requestedDateTime :: Maybe POSIX
$sel:requestedDateTime:CommandInvocation' :: CommandInvocation -> Maybe POSIX
requestedDateTime} -> Maybe POSIX
requestedDateTime) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe POSIX
a -> CommandInvocation
s {$sel:requestedDateTime:CommandInvocation' :: Maybe POSIX
requestedDateTime = Maybe POSIX
a} :: CommandInvocation) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The Identity and Access Management (IAM) service role that Run Command,
-- a capability of Amazon Web Services Systems Manager, uses to act on your
-- behalf when sending notifications about command status changes on a per
-- managed node basis.
commandInvocation_serviceRole :: Lens.Lens' CommandInvocation (Prelude.Maybe Prelude.Text)
commandInvocation_serviceRole :: Lens' CommandInvocation (Maybe Text)
commandInvocation_serviceRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe Text
serviceRole :: Maybe Text
$sel:serviceRole:CommandInvocation' :: CommandInvocation -> Maybe Text
serviceRole} -> Maybe Text
serviceRole) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe Text
a -> CommandInvocation
s {$sel:serviceRole:CommandInvocation' :: Maybe Text
serviceRole = Maybe Text
a} :: CommandInvocation)

-- | The URL to the plugin\'s StdErr file in Amazon Simple Storage Service
-- (Amazon S3), if the S3 bucket was defined for the parent command. For an
-- invocation, @StandardErrorUrl@ is populated if there is just one plugin
-- defined for the command, and the S3 bucket was defined for the command.
commandInvocation_standardErrorUrl :: Lens.Lens' CommandInvocation (Prelude.Maybe Prelude.Text)
commandInvocation_standardErrorUrl :: Lens' CommandInvocation (Maybe Text)
commandInvocation_standardErrorUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe Text
standardErrorUrl :: Maybe Text
$sel:standardErrorUrl:CommandInvocation' :: CommandInvocation -> Maybe Text
standardErrorUrl} -> Maybe Text
standardErrorUrl) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe Text
a -> CommandInvocation
s {$sel:standardErrorUrl:CommandInvocation' :: Maybe Text
standardErrorUrl = Maybe Text
a} :: CommandInvocation)

-- | The URL to the plugin\'s StdOut file in Amazon Simple Storage Service
-- (Amazon S3), if the S3 bucket was defined for the parent command. For an
-- invocation, @StandardOutputUrl@ is populated if there is just one plugin
-- defined for the command, and the S3 bucket was defined for the command.
commandInvocation_standardOutputUrl :: Lens.Lens' CommandInvocation (Prelude.Maybe Prelude.Text)
commandInvocation_standardOutputUrl :: Lens' CommandInvocation (Maybe Text)
commandInvocation_standardOutputUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe Text
standardOutputUrl :: Maybe Text
$sel:standardOutputUrl:CommandInvocation' :: CommandInvocation -> Maybe Text
standardOutputUrl} -> Maybe Text
standardOutputUrl) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe Text
a -> CommandInvocation
s {$sel:standardOutputUrl:CommandInvocation' :: Maybe Text
standardOutputUrl = Maybe Text
a} :: CommandInvocation)

-- | Whether or not the invocation succeeded, failed, or is pending.
commandInvocation_status :: Lens.Lens' CommandInvocation (Prelude.Maybe CommandInvocationStatus)
commandInvocation_status :: Lens' CommandInvocation (Maybe CommandInvocationStatus)
commandInvocation_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe CommandInvocationStatus
status :: Maybe CommandInvocationStatus
$sel:status:CommandInvocation' :: CommandInvocation -> Maybe CommandInvocationStatus
status} -> Maybe CommandInvocationStatus
status) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe CommandInvocationStatus
a -> CommandInvocation
s {$sel:status:CommandInvocation' :: Maybe CommandInvocationStatus
status = Maybe CommandInvocationStatus
a} :: CommandInvocation)

-- | A detailed status of the command execution for each invocation (each
-- managed node targeted by the command). StatusDetails includes more
-- information than Status because it includes states resulting from error
-- and concurrency control parameters. StatusDetails can show different
-- results than Status. For more information about these statuses, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/monitor-commands.html Understanding command statuses>
-- in the /Amazon Web Services Systems Manager User Guide/. StatusDetails
-- can be one of the following values:
--
-- -   Pending: The command hasn\'t been sent to the managed node.
--
-- -   In Progress: The command has been sent to the managed node but
--     hasn\'t reached a terminal state.
--
-- -   Success: The execution of the command or plugin was successfully
--     completed. This is a terminal state.
--
-- -   Delivery Timed Out: The command wasn\'t delivered to the managed
--     node before the delivery timeout expired. Delivery timeouts don\'t
--     count against the parent command\'s @MaxErrors@ limit, but they do
--     contribute to whether the parent command status is Success or
--     Incomplete. This is a terminal state.
--
-- -   Execution Timed Out: Command execution started on the managed node,
--     but the execution wasn\'t complete before the execution timeout
--     expired. Execution timeouts count against the @MaxErrors@ limit of
--     the parent command. This is a terminal state.
--
-- -   Failed: The command wasn\'t successful on the managed node. For a
--     plugin, this indicates that the result code wasn\'t zero. For a
--     command invocation, this indicates that the result code for one or
--     more plugins wasn\'t zero. Invocation failures count against the
--     @MaxErrors@ limit of the parent command. This is a terminal state.
--
-- -   Cancelled: The command was terminated before it was completed. This
--     is a terminal state.
--
-- -   Undeliverable: The command can\'t be delivered to the managed node.
--     The managed node might not exist or might not be responding.
--     Undeliverable invocations don\'t count against the parent command\'s
--     MaxErrors limit and don\'t contribute to whether the parent command
--     status is Success or Incomplete. This is a terminal state.
--
-- -   Terminated: The parent command exceeded its MaxErrors limit and
--     subsequent command invocations were canceled by the system. This is
--     a terminal state.
--
-- -   Delayed: The system attempted to send the command to the managed
--     node but wasn\'t successful. The system retries again.
commandInvocation_statusDetails :: Lens.Lens' CommandInvocation (Prelude.Maybe Prelude.Text)
commandInvocation_statusDetails :: Lens' CommandInvocation (Maybe Text)
commandInvocation_statusDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe Text
statusDetails :: Maybe Text
$sel:statusDetails:CommandInvocation' :: CommandInvocation -> Maybe Text
statusDetails} -> Maybe Text
statusDetails) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe Text
a -> CommandInvocation
s {$sel:statusDetails:CommandInvocation' :: Maybe Text
statusDetails = Maybe Text
a} :: CommandInvocation)

-- | Gets the trace output sent by the agent.
commandInvocation_traceOutput :: Lens.Lens' CommandInvocation (Prelude.Maybe Prelude.Text)
commandInvocation_traceOutput :: Lens' CommandInvocation (Maybe Text)
commandInvocation_traceOutput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CommandInvocation' {Maybe Text
traceOutput :: Maybe Text
$sel:traceOutput:CommandInvocation' :: CommandInvocation -> Maybe Text
traceOutput} -> Maybe Text
traceOutput) (\s :: CommandInvocation
s@CommandInvocation' {} Maybe Text
a -> CommandInvocation
s {$sel:traceOutput:CommandInvocation' :: Maybe Text
traceOutput = Maybe Text
a} :: CommandInvocation)

instance Data.FromJSON CommandInvocation where
  parseJSON :: Value -> Parser CommandInvocation
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"CommandInvocation"
      ( \Object
x ->
          Maybe CloudWatchOutputConfig
-> Maybe Text
-> Maybe [CommandPlugin]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe NotificationConfig
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe CommandInvocationStatus
-> Maybe Text
-> Maybe Text
-> CommandInvocation
CommandInvocation'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CloudWatchOutputConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CommandId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CommandPlugins" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Comment")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DocumentName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DocumentVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"InstanceId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"InstanceName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"NotificationConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RequestedDateTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ServiceRole")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"StandardErrorUrl")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"StandardOutputUrl")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"StatusDetails")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"TraceOutput")
      )

instance Prelude.Hashable CommandInvocation where
  hashWithSalt :: Int -> CommandInvocation -> Int
hashWithSalt Int
_salt CommandInvocation' {Maybe [CommandPlugin]
Maybe Text
Maybe POSIX
Maybe CloudWatchOutputConfig
Maybe CommandInvocationStatus
Maybe NotificationConfig
traceOutput :: Maybe Text
statusDetails :: Maybe Text
status :: Maybe CommandInvocationStatus
standardOutputUrl :: Maybe Text
standardErrorUrl :: Maybe Text
serviceRole :: Maybe Text
requestedDateTime :: Maybe POSIX
notificationConfig :: Maybe NotificationConfig
instanceName :: Maybe Text
instanceId :: Maybe Text
documentVersion :: Maybe Text
documentName :: Maybe Text
comment :: Maybe Text
commandPlugins :: Maybe [CommandPlugin]
commandId :: Maybe Text
cloudWatchOutputConfig :: Maybe CloudWatchOutputConfig
$sel:traceOutput:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:statusDetails:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:status:CommandInvocation' :: CommandInvocation -> Maybe CommandInvocationStatus
$sel:standardOutputUrl:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:standardErrorUrl:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:serviceRole:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:requestedDateTime:CommandInvocation' :: CommandInvocation -> Maybe POSIX
$sel:notificationConfig:CommandInvocation' :: CommandInvocation -> Maybe NotificationConfig
$sel:instanceName:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:instanceId:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:documentVersion:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:documentName:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:comment:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:commandPlugins:CommandInvocation' :: CommandInvocation -> Maybe [CommandPlugin]
$sel:commandId:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:cloudWatchOutputConfig:CommandInvocation' :: CommandInvocation -> Maybe CloudWatchOutputConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloudWatchOutputConfig
cloudWatchOutputConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
commandId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CommandPlugin]
commandPlugins
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
comment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
documentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
documentVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NotificationConfig
notificationConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
requestedDateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
standardErrorUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
standardOutputUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CommandInvocationStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
traceOutput

instance Prelude.NFData CommandInvocation where
  rnf :: CommandInvocation -> ()
rnf CommandInvocation' {Maybe [CommandPlugin]
Maybe Text
Maybe POSIX
Maybe CloudWatchOutputConfig
Maybe CommandInvocationStatus
Maybe NotificationConfig
traceOutput :: Maybe Text
statusDetails :: Maybe Text
status :: Maybe CommandInvocationStatus
standardOutputUrl :: Maybe Text
standardErrorUrl :: Maybe Text
serviceRole :: Maybe Text
requestedDateTime :: Maybe POSIX
notificationConfig :: Maybe NotificationConfig
instanceName :: Maybe Text
instanceId :: Maybe Text
documentVersion :: Maybe Text
documentName :: Maybe Text
comment :: Maybe Text
commandPlugins :: Maybe [CommandPlugin]
commandId :: Maybe Text
cloudWatchOutputConfig :: Maybe CloudWatchOutputConfig
$sel:traceOutput:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:statusDetails:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:status:CommandInvocation' :: CommandInvocation -> Maybe CommandInvocationStatus
$sel:standardOutputUrl:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:standardErrorUrl:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:serviceRole:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:requestedDateTime:CommandInvocation' :: CommandInvocation -> Maybe POSIX
$sel:notificationConfig:CommandInvocation' :: CommandInvocation -> Maybe NotificationConfig
$sel:instanceName:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:instanceId:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:documentVersion:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:documentName:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:comment:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:commandPlugins:CommandInvocation' :: CommandInvocation -> Maybe [CommandPlugin]
$sel:commandId:CommandInvocation' :: CommandInvocation -> Maybe Text
$sel:cloudWatchOutputConfig:CommandInvocation' :: CommandInvocation -> Maybe CloudWatchOutputConfig
..} =
    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
commandId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CommandPlugin]
commandPlugins
      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
documentName
      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
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceName
      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 POSIX
requestedDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
standardErrorUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
standardOutputUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CommandInvocationStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
traceOutput