{-# 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.GetCommandInvocation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns detailed information about command execution for an invocation
-- or plugin.
--
-- @GetCommandInvocation@ only gives the execution status of a plugin in a
-- document. To get the command execution status on a specific managed
-- node, use ListCommandInvocations. To get the command execution status
-- across managed nodes, use ListCommands.
module Amazonka.SSM.GetCommandInvocation
  ( -- * Creating a Request
    GetCommandInvocation (..),
    newGetCommandInvocation,

    -- * Request Lenses
    getCommandInvocation_pluginName,
    getCommandInvocation_commandId,
    getCommandInvocation_instanceId,

    -- * Destructuring the Response
    GetCommandInvocationResponse (..),
    newGetCommandInvocationResponse,

    -- * Response Lenses
    getCommandInvocationResponse_cloudWatchOutputConfig,
    getCommandInvocationResponse_commandId,
    getCommandInvocationResponse_comment,
    getCommandInvocationResponse_documentName,
    getCommandInvocationResponse_documentVersion,
    getCommandInvocationResponse_executionElapsedTime,
    getCommandInvocationResponse_executionEndDateTime,
    getCommandInvocationResponse_executionStartDateTime,
    getCommandInvocationResponse_instanceId,
    getCommandInvocationResponse_pluginName,
    getCommandInvocationResponse_responseCode,
    getCommandInvocationResponse_standardErrorContent,
    getCommandInvocationResponse_standardErrorUrl,
    getCommandInvocationResponse_standardOutputContent,
    getCommandInvocationResponse_standardOutputUrl,
    getCommandInvocationResponse_status,
    getCommandInvocationResponse_statusDetails,
    getCommandInvocationResponse_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:/ 'newGetCommandInvocation' smart constructor.
data GetCommandInvocation = GetCommandInvocation'
  { -- | The name of the step for which you want detailed results. If the
    -- document contains only one step, you can omit the name and details for
    -- that step. If the document contains more than one step, you must specify
    -- the name of the step for which you want to view details. Be sure to
    -- specify the name of the step, not the name of a plugin like
    -- @aws:RunShellScript@.
    --
    -- To find the @PluginName@, check the document content and find the name
    -- of the step you want details for. Alternatively, use
    -- ListCommandInvocations with the @CommandId@ and @Details@ parameters.
    -- The @PluginName@ is the @Name@ attribute of the @CommandPlugin@ object
    -- in the @CommandPlugins@ list.
    GetCommandInvocation -> Maybe Text
pluginName :: Prelude.Maybe Prelude.Text,
    -- | (Required) The parent command ID of the invocation plugin.
    GetCommandInvocation -> Text
commandId :: Prelude.Text,
    -- | (Required) The ID of the managed node targeted by the command. A
    -- /managed node/ can be an Amazon Elastic Compute Cloud (Amazon EC2)
    -- instance, edge device, and on-premises server or VM in your hybrid
    -- environment that is configured for Amazon Web Services Systems Manager.
    GetCommandInvocation -> Text
instanceId :: Prelude.Text
  }
  deriving (GetCommandInvocation -> GetCommandInvocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCommandInvocation -> GetCommandInvocation -> Bool
$c/= :: GetCommandInvocation -> GetCommandInvocation -> Bool
== :: GetCommandInvocation -> GetCommandInvocation -> Bool
$c== :: GetCommandInvocation -> GetCommandInvocation -> Bool
Prelude.Eq, ReadPrec [GetCommandInvocation]
ReadPrec GetCommandInvocation
Int -> ReadS GetCommandInvocation
ReadS [GetCommandInvocation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCommandInvocation]
$creadListPrec :: ReadPrec [GetCommandInvocation]
readPrec :: ReadPrec GetCommandInvocation
$creadPrec :: ReadPrec GetCommandInvocation
readList :: ReadS [GetCommandInvocation]
$creadList :: ReadS [GetCommandInvocation]
readsPrec :: Int -> ReadS GetCommandInvocation
$creadsPrec :: Int -> ReadS GetCommandInvocation
Prelude.Read, Int -> GetCommandInvocation -> ShowS
[GetCommandInvocation] -> ShowS
GetCommandInvocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCommandInvocation] -> ShowS
$cshowList :: [GetCommandInvocation] -> ShowS
show :: GetCommandInvocation -> String
$cshow :: GetCommandInvocation -> String
showsPrec :: Int -> GetCommandInvocation -> ShowS
$cshowsPrec :: Int -> GetCommandInvocation -> ShowS
Prelude.Show, forall x. Rep GetCommandInvocation x -> GetCommandInvocation
forall x. GetCommandInvocation -> Rep GetCommandInvocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCommandInvocation x -> GetCommandInvocation
$cfrom :: forall x. GetCommandInvocation -> Rep GetCommandInvocation x
Prelude.Generic)

-- |
-- Create a value of 'GetCommandInvocation' 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:
--
-- 'pluginName', 'getCommandInvocation_pluginName' - The name of the step for which you want detailed results. If the
-- document contains only one step, you can omit the name and details for
-- that step. If the document contains more than one step, you must specify
-- the name of the step for which you want to view details. Be sure to
-- specify the name of the step, not the name of a plugin like
-- @aws:RunShellScript@.
--
-- To find the @PluginName@, check the document content and find the name
-- of the step you want details for. Alternatively, use
-- ListCommandInvocations with the @CommandId@ and @Details@ parameters.
-- The @PluginName@ is the @Name@ attribute of the @CommandPlugin@ object
-- in the @CommandPlugins@ list.
--
-- 'commandId', 'getCommandInvocation_commandId' - (Required) The parent command ID of the invocation plugin.
--
-- 'instanceId', 'getCommandInvocation_instanceId' - (Required) The ID of the managed node targeted by the command. A
-- /managed node/ can be an Amazon Elastic Compute Cloud (Amazon EC2)
-- instance, edge device, and on-premises server or VM in your hybrid
-- environment that is configured for Amazon Web Services Systems Manager.
newGetCommandInvocation ::
  -- | 'commandId'
  Prelude.Text ->
  -- | 'instanceId'
  Prelude.Text ->
  GetCommandInvocation
newGetCommandInvocation :: Text -> Text -> GetCommandInvocation
newGetCommandInvocation Text
pCommandId_ Text
pInstanceId_ =
  GetCommandInvocation'
    { $sel:pluginName:GetCommandInvocation' :: Maybe Text
pluginName = forall a. Maybe a
Prelude.Nothing,
      $sel:commandId:GetCommandInvocation' :: Text
commandId = Text
pCommandId_,
      $sel:instanceId:GetCommandInvocation' :: Text
instanceId = Text
pInstanceId_
    }

-- | The name of the step for which you want detailed results. If the
-- document contains only one step, you can omit the name and details for
-- that step. If the document contains more than one step, you must specify
-- the name of the step for which you want to view details. Be sure to
-- specify the name of the step, not the name of a plugin like
-- @aws:RunShellScript@.
--
-- To find the @PluginName@, check the document content and find the name
-- of the step you want details for. Alternatively, use
-- ListCommandInvocations with the @CommandId@ and @Details@ parameters.
-- The @PluginName@ is the @Name@ attribute of the @CommandPlugin@ object
-- in the @CommandPlugins@ list.
getCommandInvocation_pluginName :: Lens.Lens' GetCommandInvocation (Prelude.Maybe Prelude.Text)
getCommandInvocation_pluginName :: Lens' GetCommandInvocation (Maybe Text)
getCommandInvocation_pluginName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocation' {Maybe Text
pluginName :: Maybe Text
$sel:pluginName:GetCommandInvocation' :: GetCommandInvocation -> Maybe Text
pluginName} -> Maybe Text
pluginName) (\s :: GetCommandInvocation
s@GetCommandInvocation' {} Maybe Text
a -> GetCommandInvocation
s {$sel:pluginName:GetCommandInvocation' :: Maybe Text
pluginName = Maybe Text
a} :: GetCommandInvocation)

-- | (Required) The parent command ID of the invocation plugin.
getCommandInvocation_commandId :: Lens.Lens' GetCommandInvocation Prelude.Text
getCommandInvocation_commandId :: Lens' GetCommandInvocation Text
getCommandInvocation_commandId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocation' {Text
commandId :: Text
$sel:commandId:GetCommandInvocation' :: GetCommandInvocation -> Text
commandId} -> Text
commandId) (\s :: GetCommandInvocation
s@GetCommandInvocation' {} Text
a -> GetCommandInvocation
s {$sel:commandId:GetCommandInvocation' :: Text
commandId = Text
a} :: GetCommandInvocation)

-- | (Required) The ID of the managed node targeted by the command. A
-- /managed node/ can be an Amazon Elastic Compute Cloud (Amazon EC2)
-- instance, edge device, and on-premises server or VM in your hybrid
-- environment that is configured for Amazon Web Services Systems Manager.
getCommandInvocation_instanceId :: Lens.Lens' GetCommandInvocation Prelude.Text
getCommandInvocation_instanceId :: Lens' GetCommandInvocation Text
getCommandInvocation_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocation' {Text
instanceId :: Text
$sel:instanceId:GetCommandInvocation' :: GetCommandInvocation -> Text
instanceId} -> Text
instanceId) (\s :: GetCommandInvocation
s@GetCommandInvocation' {} Text
a -> GetCommandInvocation
s {$sel:instanceId:GetCommandInvocation' :: Text
instanceId = Text
a} :: GetCommandInvocation)

instance Core.AWSRequest GetCommandInvocation where
  type
    AWSResponse GetCommandInvocation =
      GetCommandInvocationResponse
  request :: (Service -> Service)
-> GetCommandInvocation -> Request GetCommandInvocation
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 GetCommandInvocation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCommandInvocation)))
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 CloudWatchOutputConfig
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe CommandInvocationStatus
-> Maybe Text
-> Int
-> GetCommandInvocationResponse
GetCommandInvocationResponse'
            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
"CloudWatchOutputConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (Maybe a)
Data..?> Key
"ExecutionElapsedTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ExecutionEndDateTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ExecutionStartDateTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (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 -> Either String (Maybe a)
Data..?> Key
"PluginName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ResponseCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StandardErrorContent")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (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 -> Either String (Maybe a)
Data..?> Key
"StandardOutputContent")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (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 -> Either String (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 -> Either String (Maybe a)
Data..?> Key
"StatusDetails")
            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 GetCommandInvocation where
  hashWithSalt :: Int -> GetCommandInvocation -> Int
hashWithSalt Int
_salt GetCommandInvocation' {Maybe Text
Text
instanceId :: Text
commandId :: Text
pluginName :: Maybe Text
$sel:instanceId:GetCommandInvocation' :: GetCommandInvocation -> Text
$sel:commandId:GetCommandInvocation' :: GetCommandInvocation -> Text
$sel:pluginName:GetCommandInvocation' :: GetCommandInvocation -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pluginName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
commandId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

instance Prelude.NFData GetCommandInvocation where
  rnf :: GetCommandInvocation -> ()
rnf GetCommandInvocation' {Maybe Text
Text
instanceId :: Text
commandId :: Text
pluginName :: Maybe Text
$sel:instanceId:GetCommandInvocation' :: GetCommandInvocation -> Text
$sel:commandId:GetCommandInvocation' :: GetCommandInvocation -> Text
$sel:pluginName:GetCommandInvocation' :: GetCommandInvocation -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pluginName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
commandId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId

instance Data.ToHeaders GetCommandInvocation where
  toHeaders :: GetCommandInvocation -> 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.GetCommandInvocation" ::
                          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 GetCommandInvocation where
  toJSON :: GetCommandInvocation -> Value
toJSON GetCommandInvocation' {Maybe Text
Text
instanceId :: Text
commandId :: Text
pluginName :: Maybe Text
$sel:instanceId:GetCommandInvocation' :: GetCommandInvocation -> Text
$sel:commandId:GetCommandInvocation' :: GetCommandInvocation -> Text
$sel:pluginName:GetCommandInvocation' :: GetCommandInvocation -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"PluginName" 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
pluginName,
            forall a. a -> Maybe a
Prelude.Just (Key
"CommandId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
commandId),
            forall a. a -> Maybe a
Prelude.Just (Key
"InstanceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceId)
          ]
      )

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

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

-- | /See:/ 'newGetCommandInvocationResponse' smart constructor.
data GetCommandInvocationResponse = GetCommandInvocationResponse'
  { -- | Amazon CloudWatch Logs information where Systems Manager sent the
    -- command output.
    GetCommandInvocationResponse -> Maybe CloudWatchOutputConfig
cloudWatchOutputConfig :: Prelude.Maybe CloudWatchOutputConfig,
    -- | The parent command ID of the invocation plugin.
    GetCommandInvocationResponse -> Maybe Text
commandId :: Prelude.Maybe Prelude.Text,
    -- | The comment text for the command.
    GetCommandInvocationResponse -> Maybe Text
comment :: Prelude.Maybe Prelude.Text,
    -- | The name of the document that was run. For example,
    -- @AWS-RunShellScript@.
    GetCommandInvocationResponse -> Maybe Text
documentName :: Prelude.Maybe Prelude.Text,
    -- | The Systems Manager document (SSM document) version used in the request.
    GetCommandInvocationResponse -> Maybe Text
documentVersion :: Prelude.Maybe Prelude.Text,
    -- | Duration since @ExecutionStartDateTime@.
    GetCommandInvocationResponse -> Maybe Text
executionElapsedTime :: Prelude.Maybe Prelude.Text,
    -- | The date and time the plugin finished running. Date and time are written
    -- in ISO 8601 format. For example, June 7, 2017 is represented as
    -- 2017-06-7. The following sample Amazon Web Services CLI command uses the
    -- @InvokedAfter@ filter.
    --
    -- @aws ssm list-commands --filters key=InvokedAfter,value=2017-06-07T00:00:00Z@
    --
    -- If the plugin hasn\'t started to run, the string is empty.
    GetCommandInvocationResponse -> Maybe Text
executionEndDateTime :: Prelude.Maybe Prelude.Text,
    -- | The date and time the plugin started running. Date and time are written
    -- in ISO 8601 format. For example, June 7, 2017 is represented as
    -- 2017-06-7. The following sample Amazon Web Services CLI command uses the
    -- @InvokedBefore@ filter.
    --
    -- @aws ssm list-commands --filters key=InvokedBefore,value=2017-06-07T00:00:00Z@
    --
    -- If the plugin hasn\'t started to run, the string is empty.
    GetCommandInvocationResponse -> Maybe Text
executionStartDateTime :: Prelude.Maybe Prelude.Text,
    -- | The ID of the managed node targeted by the command. A /managed node/ can
    -- be an Amazon Elastic Compute Cloud (Amazon EC2) instance, edge device,
    -- or on-premises server or VM in your hybrid environment that is
    -- configured for Amazon Web Services Systems Manager.
    GetCommandInvocationResponse -> Maybe Text
instanceId :: Prelude.Maybe Prelude.Text,
    -- | The name of the plugin, or /step name/, for which details are reported.
    -- For example, @aws:RunShellScript@ is a plugin.
    GetCommandInvocationResponse -> Maybe Text
pluginName :: Prelude.Maybe Prelude.Text,
    -- | The error level response code for the plugin script. If the response
    -- code is @-1@, then the command hasn\'t started running on the managed
    -- node, or it wasn\'t received by the node.
    GetCommandInvocationResponse -> Maybe Int
responseCode :: Prelude.Maybe Prelude.Int,
    -- | The first 8,000 characters written by the plugin to @stderr@. If the
    -- command hasn\'t finished running, then this string is empty.
    GetCommandInvocationResponse -> Maybe Text
standardErrorContent :: Prelude.Maybe Prelude.Text,
    -- | The URL for the complete text written by the plugin to @stderr@. If the
    -- command hasn\'t finished running, then this string is empty.
    GetCommandInvocationResponse -> Maybe Text
standardErrorUrl :: Prelude.Maybe Prelude.Text,
    -- | The first 24,000 characters written by the plugin to @stdout@. If the
    -- command hasn\'t finished running, if @ExecutionStatus@ is neither
    -- Succeeded nor Failed, then this string is empty.
    GetCommandInvocationResponse -> Maybe Text
standardOutputContent :: Prelude.Maybe Prelude.Text,
    -- | The URL for the complete text written by the plugin to @stdout@ in
    -- Amazon Simple Storage Service (Amazon S3). If an S3 bucket wasn\'t
    -- specified, then this string is empty.
    GetCommandInvocationResponse -> Maybe Text
standardOutputUrl :: Prelude.Maybe Prelude.Text,
    -- | The status of this invocation plugin. This status can be different than
    -- @StatusDetails@.
    GetCommandInvocationResponse -> Maybe CommandInvocationStatus
status :: Prelude.Maybe CommandInvocationStatus,
    -- | A detailed status of the command execution for an invocation.
    -- @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.
    --
    -- -   Delayed: The system attempted to send the command to the target, but
    --     the target wasn\'t available. The managed node might not be
    --     available because of network issues, because the node was stopped,
    --     or for similar reasons. The system will try to send the command
    --     again.
    --
    -- -   Success: The command or plugin ran successfully. 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: The command started to run on the managed node,
    --     but the execution wasn\'t complete before the timeout expired.
    --     Execution timeouts count against the @MaxErrors@ limit of the parent
    --     command. This is a terminal state.
    --
    -- -   Failed: The command wasn\'t run successfully 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 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.
    GetCommandInvocationResponse -> Maybe Text
statusDetails :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetCommandInvocationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCommandInvocationResponse
-> GetCommandInvocationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCommandInvocationResponse
-> GetCommandInvocationResponse -> Bool
$c/= :: GetCommandInvocationResponse
-> GetCommandInvocationResponse -> Bool
== :: GetCommandInvocationResponse
-> GetCommandInvocationResponse -> Bool
$c== :: GetCommandInvocationResponse
-> GetCommandInvocationResponse -> Bool
Prelude.Eq, ReadPrec [GetCommandInvocationResponse]
ReadPrec GetCommandInvocationResponse
Int -> ReadS GetCommandInvocationResponse
ReadS [GetCommandInvocationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCommandInvocationResponse]
$creadListPrec :: ReadPrec [GetCommandInvocationResponse]
readPrec :: ReadPrec GetCommandInvocationResponse
$creadPrec :: ReadPrec GetCommandInvocationResponse
readList :: ReadS [GetCommandInvocationResponse]
$creadList :: ReadS [GetCommandInvocationResponse]
readsPrec :: Int -> ReadS GetCommandInvocationResponse
$creadsPrec :: Int -> ReadS GetCommandInvocationResponse
Prelude.Read, Int -> GetCommandInvocationResponse -> ShowS
[GetCommandInvocationResponse] -> ShowS
GetCommandInvocationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCommandInvocationResponse] -> ShowS
$cshowList :: [GetCommandInvocationResponse] -> ShowS
show :: GetCommandInvocationResponse -> String
$cshow :: GetCommandInvocationResponse -> String
showsPrec :: Int -> GetCommandInvocationResponse -> ShowS
$cshowsPrec :: Int -> GetCommandInvocationResponse -> ShowS
Prelude.Show, forall x.
Rep GetCommandInvocationResponse x -> GetCommandInvocationResponse
forall x.
GetCommandInvocationResponse -> Rep GetCommandInvocationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCommandInvocationResponse x -> GetCommandInvocationResponse
$cfrom :: forall x.
GetCommandInvocationResponse -> Rep GetCommandInvocationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCommandInvocationResponse' 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', 'getCommandInvocationResponse_cloudWatchOutputConfig' - Amazon CloudWatch Logs information where Systems Manager sent the
-- command output.
--
-- 'commandId', 'getCommandInvocationResponse_commandId' - The parent command ID of the invocation plugin.
--
-- 'comment', 'getCommandInvocationResponse_comment' - The comment text for the command.
--
-- 'documentName', 'getCommandInvocationResponse_documentName' - The name of the document that was run. For example,
-- @AWS-RunShellScript@.
--
-- 'documentVersion', 'getCommandInvocationResponse_documentVersion' - The Systems Manager document (SSM document) version used in the request.
--
-- 'executionElapsedTime', 'getCommandInvocationResponse_executionElapsedTime' - Duration since @ExecutionStartDateTime@.
--
-- 'executionEndDateTime', 'getCommandInvocationResponse_executionEndDateTime' - The date and time the plugin finished running. Date and time are written
-- in ISO 8601 format. For example, June 7, 2017 is represented as
-- 2017-06-7. The following sample Amazon Web Services CLI command uses the
-- @InvokedAfter@ filter.
--
-- @aws ssm list-commands --filters key=InvokedAfter,value=2017-06-07T00:00:00Z@
--
-- If the plugin hasn\'t started to run, the string is empty.
--
-- 'executionStartDateTime', 'getCommandInvocationResponse_executionStartDateTime' - The date and time the plugin started running. Date and time are written
-- in ISO 8601 format. For example, June 7, 2017 is represented as
-- 2017-06-7. The following sample Amazon Web Services CLI command uses the
-- @InvokedBefore@ filter.
--
-- @aws ssm list-commands --filters key=InvokedBefore,value=2017-06-07T00:00:00Z@
--
-- If the plugin hasn\'t started to run, the string is empty.
--
-- 'instanceId', 'getCommandInvocationResponse_instanceId' - The ID of the managed node targeted by the command. A /managed node/ can
-- be an Amazon Elastic Compute Cloud (Amazon EC2) instance, edge device,
-- or on-premises server or VM in your hybrid environment that is
-- configured for Amazon Web Services Systems Manager.
--
-- 'pluginName', 'getCommandInvocationResponse_pluginName' - The name of the plugin, or /step name/, for which details are reported.
-- For example, @aws:RunShellScript@ is a plugin.
--
-- 'responseCode', 'getCommandInvocationResponse_responseCode' - The error level response code for the plugin script. If the response
-- code is @-1@, then the command hasn\'t started running on the managed
-- node, or it wasn\'t received by the node.
--
-- 'standardErrorContent', 'getCommandInvocationResponse_standardErrorContent' - The first 8,000 characters written by the plugin to @stderr@. If the
-- command hasn\'t finished running, then this string is empty.
--
-- 'standardErrorUrl', 'getCommandInvocationResponse_standardErrorUrl' - The URL for the complete text written by the plugin to @stderr@. If the
-- command hasn\'t finished running, then this string is empty.
--
-- 'standardOutputContent', 'getCommandInvocationResponse_standardOutputContent' - The first 24,000 characters written by the plugin to @stdout@. If the
-- command hasn\'t finished running, if @ExecutionStatus@ is neither
-- Succeeded nor Failed, then this string is empty.
--
-- 'standardOutputUrl', 'getCommandInvocationResponse_standardOutputUrl' - The URL for the complete text written by the plugin to @stdout@ in
-- Amazon Simple Storage Service (Amazon S3). If an S3 bucket wasn\'t
-- specified, then this string is empty.
--
-- 'status', 'getCommandInvocationResponse_status' - The status of this invocation plugin. This status can be different than
-- @StatusDetails@.
--
-- 'statusDetails', 'getCommandInvocationResponse_statusDetails' - A detailed status of the command execution for an invocation.
-- @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.
--
-- -   Delayed: The system attempted to send the command to the target, but
--     the target wasn\'t available. The managed node might not be
--     available because of network issues, because the node was stopped,
--     or for similar reasons. The system will try to send the command
--     again.
--
-- -   Success: The command or plugin ran successfully. 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: The command started to run on the managed node,
--     but the execution wasn\'t complete before the timeout expired.
--     Execution timeouts count against the @MaxErrors@ limit of the parent
--     command. This is a terminal state.
--
-- -   Failed: The command wasn\'t run successfully 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 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.
--
-- 'httpStatus', 'getCommandInvocationResponse_httpStatus' - The response's http status code.
newGetCommandInvocationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCommandInvocationResponse
newGetCommandInvocationResponse :: Int -> GetCommandInvocationResponse
newGetCommandInvocationResponse Int
pHttpStatus_ =
  GetCommandInvocationResponse'
    { $sel:cloudWatchOutputConfig:GetCommandInvocationResponse' :: Maybe CloudWatchOutputConfig
cloudWatchOutputConfig =
        forall a. Maybe a
Prelude.Nothing,
      $sel:commandId:GetCommandInvocationResponse' :: Maybe Text
commandId = forall a. Maybe a
Prelude.Nothing,
      $sel:comment:GetCommandInvocationResponse' :: Maybe Text
comment = forall a. Maybe a
Prelude.Nothing,
      $sel:documentName:GetCommandInvocationResponse' :: Maybe Text
documentName = forall a. Maybe a
Prelude.Nothing,
      $sel:documentVersion:GetCommandInvocationResponse' :: Maybe Text
documentVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:executionElapsedTime:GetCommandInvocationResponse' :: Maybe Text
executionElapsedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:executionEndDateTime:GetCommandInvocationResponse' :: Maybe Text
executionEndDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:executionStartDateTime:GetCommandInvocationResponse' :: Maybe Text
executionStartDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:GetCommandInvocationResponse' :: Maybe Text
instanceId = forall a. Maybe a
Prelude.Nothing,
      $sel:pluginName:GetCommandInvocationResponse' :: Maybe Text
pluginName = forall a. Maybe a
Prelude.Nothing,
      $sel:responseCode:GetCommandInvocationResponse' :: Maybe Int
responseCode = forall a. Maybe a
Prelude.Nothing,
      $sel:standardErrorContent:GetCommandInvocationResponse' :: Maybe Text
standardErrorContent = forall a. Maybe a
Prelude.Nothing,
      $sel:standardErrorUrl:GetCommandInvocationResponse' :: Maybe Text
standardErrorUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:standardOutputContent:GetCommandInvocationResponse' :: Maybe Text
standardOutputContent = forall a. Maybe a
Prelude.Nothing,
      $sel:standardOutputUrl:GetCommandInvocationResponse' :: Maybe Text
standardOutputUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetCommandInvocationResponse' :: Maybe CommandInvocationStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusDetails:GetCommandInvocationResponse' :: Maybe Text
statusDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCommandInvocationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Amazon CloudWatch Logs information where Systems Manager sent the
-- command output.
getCommandInvocationResponse_cloudWatchOutputConfig :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe CloudWatchOutputConfig)
getCommandInvocationResponse_cloudWatchOutputConfig :: Lens' GetCommandInvocationResponse (Maybe CloudWatchOutputConfig)
getCommandInvocationResponse_cloudWatchOutputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe CloudWatchOutputConfig
cloudWatchOutputConfig :: Maybe CloudWatchOutputConfig
$sel:cloudWatchOutputConfig:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe CloudWatchOutputConfig
cloudWatchOutputConfig} -> Maybe CloudWatchOutputConfig
cloudWatchOutputConfig) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe CloudWatchOutputConfig
a -> GetCommandInvocationResponse
s {$sel:cloudWatchOutputConfig:GetCommandInvocationResponse' :: Maybe CloudWatchOutputConfig
cloudWatchOutputConfig = Maybe CloudWatchOutputConfig
a} :: GetCommandInvocationResponse)

-- | The parent command ID of the invocation plugin.
getCommandInvocationResponse_commandId :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_commandId :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_commandId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
commandId :: Maybe Text
$sel:commandId:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
commandId} -> Maybe Text
commandId) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:commandId:GetCommandInvocationResponse' :: Maybe Text
commandId = Maybe Text
a} :: GetCommandInvocationResponse)

-- | The comment text for the command.
getCommandInvocationResponse_comment :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_comment :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_comment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
comment :: Maybe Text
$sel:comment:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
comment} -> Maybe Text
comment) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:comment:GetCommandInvocationResponse' :: Maybe Text
comment = Maybe Text
a} :: GetCommandInvocationResponse)

-- | The name of the document that was run. For example,
-- @AWS-RunShellScript@.
getCommandInvocationResponse_documentName :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_documentName :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_documentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
documentName :: Maybe Text
$sel:documentName:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
documentName} -> Maybe Text
documentName) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:documentName:GetCommandInvocationResponse' :: Maybe Text
documentName = Maybe Text
a} :: GetCommandInvocationResponse)

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

-- | Duration since @ExecutionStartDateTime@.
getCommandInvocationResponse_executionElapsedTime :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_executionElapsedTime :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_executionElapsedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
executionElapsedTime :: Maybe Text
$sel:executionElapsedTime:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
executionElapsedTime} -> Maybe Text
executionElapsedTime) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:executionElapsedTime:GetCommandInvocationResponse' :: Maybe Text
executionElapsedTime = Maybe Text
a} :: GetCommandInvocationResponse)

-- | The date and time the plugin finished running. Date and time are written
-- in ISO 8601 format. For example, June 7, 2017 is represented as
-- 2017-06-7. The following sample Amazon Web Services CLI command uses the
-- @InvokedAfter@ filter.
--
-- @aws ssm list-commands --filters key=InvokedAfter,value=2017-06-07T00:00:00Z@
--
-- If the plugin hasn\'t started to run, the string is empty.
getCommandInvocationResponse_executionEndDateTime :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_executionEndDateTime :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_executionEndDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
executionEndDateTime :: Maybe Text
$sel:executionEndDateTime:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
executionEndDateTime} -> Maybe Text
executionEndDateTime) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:executionEndDateTime:GetCommandInvocationResponse' :: Maybe Text
executionEndDateTime = Maybe Text
a} :: GetCommandInvocationResponse)

-- | The date and time the plugin started running. Date and time are written
-- in ISO 8601 format. For example, June 7, 2017 is represented as
-- 2017-06-7. The following sample Amazon Web Services CLI command uses the
-- @InvokedBefore@ filter.
--
-- @aws ssm list-commands --filters key=InvokedBefore,value=2017-06-07T00:00:00Z@
--
-- If the plugin hasn\'t started to run, the string is empty.
getCommandInvocationResponse_executionStartDateTime :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_executionStartDateTime :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_executionStartDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
executionStartDateTime :: Maybe Text
$sel:executionStartDateTime:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
executionStartDateTime} -> Maybe Text
executionStartDateTime) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:executionStartDateTime:GetCommandInvocationResponse' :: Maybe Text
executionStartDateTime = Maybe Text
a} :: GetCommandInvocationResponse)

-- | The ID of the managed node targeted by the command. A /managed node/ can
-- be an Amazon Elastic Compute Cloud (Amazon EC2) instance, edge device,
-- or on-premises server or VM in your hybrid environment that is
-- configured for Amazon Web Services Systems Manager.
getCommandInvocationResponse_instanceId :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_instanceId :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
instanceId :: Maybe Text
$sel:instanceId:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
instanceId} -> Maybe Text
instanceId) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:instanceId:GetCommandInvocationResponse' :: Maybe Text
instanceId = Maybe Text
a} :: GetCommandInvocationResponse)

-- | The name of the plugin, or /step name/, for which details are reported.
-- For example, @aws:RunShellScript@ is a plugin.
getCommandInvocationResponse_pluginName :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_pluginName :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_pluginName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
pluginName :: Maybe Text
$sel:pluginName:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
pluginName} -> Maybe Text
pluginName) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:pluginName:GetCommandInvocationResponse' :: Maybe Text
pluginName = Maybe Text
a} :: GetCommandInvocationResponse)

-- | The error level response code for the plugin script. If the response
-- code is @-1@, then the command hasn\'t started running on the managed
-- node, or it wasn\'t received by the node.
getCommandInvocationResponse_responseCode :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Int)
getCommandInvocationResponse_responseCode :: Lens' GetCommandInvocationResponse (Maybe Int)
getCommandInvocationResponse_responseCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Int
responseCode :: Maybe Int
$sel:responseCode:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Int
responseCode} -> Maybe Int
responseCode) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Int
a -> GetCommandInvocationResponse
s {$sel:responseCode:GetCommandInvocationResponse' :: Maybe Int
responseCode = Maybe Int
a} :: GetCommandInvocationResponse)

-- | The first 8,000 characters written by the plugin to @stderr@. If the
-- command hasn\'t finished running, then this string is empty.
getCommandInvocationResponse_standardErrorContent :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_standardErrorContent :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_standardErrorContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
standardErrorContent :: Maybe Text
$sel:standardErrorContent:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
standardErrorContent} -> Maybe Text
standardErrorContent) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:standardErrorContent:GetCommandInvocationResponse' :: Maybe Text
standardErrorContent = Maybe Text
a} :: GetCommandInvocationResponse)

-- | The URL for the complete text written by the plugin to @stderr@. If the
-- command hasn\'t finished running, then this string is empty.
getCommandInvocationResponse_standardErrorUrl :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_standardErrorUrl :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_standardErrorUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
standardErrorUrl :: Maybe Text
$sel:standardErrorUrl:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
standardErrorUrl} -> Maybe Text
standardErrorUrl) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:standardErrorUrl:GetCommandInvocationResponse' :: Maybe Text
standardErrorUrl = Maybe Text
a} :: GetCommandInvocationResponse)

-- | The first 24,000 characters written by the plugin to @stdout@. If the
-- command hasn\'t finished running, if @ExecutionStatus@ is neither
-- Succeeded nor Failed, then this string is empty.
getCommandInvocationResponse_standardOutputContent :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_standardOutputContent :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_standardOutputContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
standardOutputContent :: Maybe Text
$sel:standardOutputContent:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
standardOutputContent} -> Maybe Text
standardOutputContent) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:standardOutputContent:GetCommandInvocationResponse' :: Maybe Text
standardOutputContent = Maybe Text
a} :: GetCommandInvocationResponse)

-- | The URL for the complete text written by the plugin to @stdout@ in
-- Amazon Simple Storage Service (Amazon S3). If an S3 bucket wasn\'t
-- specified, then this string is empty.
getCommandInvocationResponse_standardOutputUrl :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_standardOutputUrl :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_standardOutputUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
standardOutputUrl :: Maybe Text
$sel:standardOutputUrl:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
standardOutputUrl} -> Maybe Text
standardOutputUrl) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:standardOutputUrl:GetCommandInvocationResponse' :: Maybe Text
standardOutputUrl = Maybe Text
a} :: GetCommandInvocationResponse)

-- | The status of this invocation plugin. This status can be different than
-- @StatusDetails@.
getCommandInvocationResponse_status :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe CommandInvocationStatus)
getCommandInvocationResponse_status :: Lens' GetCommandInvocationResponse (Maybe CommandInvocationStatus)
getCommandInvocationResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe CommandInvocationStatus
status :: Maybe CommandInvocationStatus
$sel:status:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe CommandInvocationStatus
status} -> Maybe CommandInvocationStatus
status) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe CommandInvocationStatus
a -> GetCommandInvocationResponse
s {$sel:status:GetCommandInvocationResponse' :: Maybe CommandInvocationStatus
status = Maybe CommandInvocationStatus
a} :: GetCommandInvocationResponse)

-- | A detailed status of the command execution for an invocation.
-- @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.
--
-- -   Delayed: The system attempted to send the command to the target, but
--     the target wasn\'t available. The managed node might not be
--     available because of network issues, because the node was stopped,
--     or for similar reasons. The system will try to send the command
--     again.
--
-- -   Success: The command or plugin ran successfully. 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: The command started to run on the managed node,
--     but the execution wasn\'t complete before the timeout expired.
--     Execution timeouts count against the @MaxErrors@ limit of the parent
--     command. This is a terminal state.
--
-- -   Failed: The command wasn\'t run successfully 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 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.
getCommandInvocationResponse_statusDetails :: Lens.Lens' GetCommandInvocationResponse (Prelude.Maybe Prelude.Text)
getCommandInvocationResponse_statusDetails :: Lens' GetCommandInvocationResponse (Maybe Text)
getCommandInvocationResponse_statusDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommandInvocationResponse' {Maybe Text
statusDetails :: Maybe Text
$sel:statusDetails:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
statusDetails} -> Maybe Text
statusDetails) (\s :: GetCommandInvocationResponse
s@GetCommandInvocationResponse' {} Maybe Text
a -> GetCommandInvocationResponse
s {$sel:statusDetails:GetCommandInvocationResponse' :: Maybe Text
statusDetails = Maybe Text
a} :: GetCommandInvocationResponse)

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

instance Prelude.NFData GetCommandInvocationResponse where
  rnf :: GetCommandInvocationResponse -> ()
rnf GetCommandInvocationResponse' {Int
Maybe Int
Maybe Text
Maybe CloudWatchOutputConfig
Maybe CommandInvocationStatus
httpStatus :: Int
statusDetails :: Maybe Text
status :: Maybe CommandInvocationStatus
standardOutputUrl :: Maybe Text
standardOutputContent :: Maybe Text
standardErrorUrl :: Maybe Text
standardErrorContent :: Maybe Text
responseCode :: Maybe Int
pluginName :: Maybe Text
instanceId :: Maybe Text
executionStartDateTime :: Maybe Text
executionEndDateTime :: Maybe Text
executionElapsedTime :: Maybe Text
documentVersion :: Maybe Text
documentName :: Maybe Text
comment :: Maybe Text
commandId :: Maybe Text
cloudWatchOutputConfig :: Maybe CloudWatchOutputConfig
$sel:httpStatus:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Int
$sel:statusDetails:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:status:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe CommandInvocationStatus
$sel:standardOutputUrl:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:standardOutputContent:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:standardErrorUrl:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:standardErrorContent:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:responseCode:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Int
$sel:pluginName:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:instanceId:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:executionStartDateTime:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:executionEndDateTime:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:executionElapsedTime:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:documentVersion:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:documentName:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:comment:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:commandId:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> Maybe Text
$sel:cloudWatchOutputConfig:GetCommandInvocationResponse' :: GetCommandInvocationResponse -> 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 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
executionElapsedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
executionEndDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
executionStartDateTime
      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
pluginName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
responseCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
standardErrorContent
      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
standardOutputContent
      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 Int
httpStatus