{-# 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.ECS.ExecuteCommand
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Runs a command remotely on a container within a task.
--
-- If you use a condition key in your IAM policy to refine the conditions
-- for the policy statement, for example limit the actions to a specific
-- cluster, you receive an @AccessDeniedException@ when there is a mismatch
-- between the condition key value and the corresponding parameter value.
--
-- For information about required permissions and considerations, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-exec.htm Using Amazon ECS Exec for debugging>
-- in the /Amazon ECS Developer Guide/.
module Amazonka.ECS.ExecuteCommand
  ( -- * Creating a Request
    ExecuteCommand (..),
    newExecuteCommand,

    -- * Request Lenses
    executeCommand_cluster,
    executeCommand_container,
    executeCommand_command,
    executeCommand_interactive,
    executeCommand_task,

    -- * Destructuring the Response
    ExecuteCommandResponse (..),
    newExecuteCommandResponse,

    -- * Response Lenses
    executeCommandResponse_clusterArn,
    executeCommandResponse_containerArn,
    executeCommandResponse_containerName,
    executeCommandResponse_interactive,
    executeCommandResponse_session,
    executeCommandResponse_taskArn,
    executeCommandResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ECS.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newExecuteCommand' smart constructor.
data ExecuteCommand = ExecuteCommand'
  { -- | The Amazon Resource Name (ARN) or short name of the cluster the task is
    -- running in. If you do not specify a cluster, the default cluster is
    -- assumed.
    ExecuteCommand -> Maybe Text
cluster :: Prelude.Maybe Prelude.Text,
    -- | The name of the container to execute the command on. A container name
    -- only needs to be specified for tasks containing multiple containers.
    ExecuteCommand -> Maybe Text
container :: Prelude.Maybe Prelude.Text,
    -- | The command to run on the container.
    ExecuteCommand -> Text
command :: Prelude.Text,
    -- | Use this flag to run your command in interactive mode.
    ExecuteCommand -> Bool
interactive :: Prelude.Bool,
    -- | The Amazon Resource Name (ARN) or ID of the task the container is part
    -- of.
    ExecuteCommand -> Text
task :: Prelude.Text
  }
  deriving (ExecuteCommand -> ExecuteCommand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecuteCommand -> ExecuteCommand -> Bool
$c/= :: ExecuteCommand -> ExecuteCommand -> Bool
== :: ExecuteCommand -> ExecuteCommand -> Bool
$c== :: ExecuteCommand -> ExecuteCommand -> Bool
Prelude.Eq, ReadPrec [ExecuteCommand]
ReadPrec ExecuteCommand
Int -> ReadS ExecuteCommand
ReadS [ExecuteCommand]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecuteCommand]
$creadListPrec :: ReadPrec [ExecuteCommand]
readPrec :: ReadPrec ExecuteCommand
$creadPrec :: ReadPrec ExecuteCommand
readList :: ReadS [ExecuteCommand]
$creadList :: ReadS [ExecuteCommand]
readsPrec :: Int -> ReadS ExecuteCommand
$creadsPrec :: Int -> ReadS ExecuteCommand
Prelude.Read, Int -> ExecuteCommand -> ShowS
[ExecuteCommand] -> ShowS
ExecuteCommand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecuteCommand] -> ShowS
$cshowList :: [ExecuteCommand] -> ShowS
show :: ExecuteCommand -> String
$cshow :: ExecuteCommand -> String
showsPrec :: Int -> ExecuteCommand -> ShowS
$cshowsPrec :: Int -> ExecuteCommand -> ShowS
Prelude.Show, forall x. Rep ExecuteCommand x -> ExecuteCommand
forall x. ExecuteCommand -> Rep ExecuteCommand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExecuteCommand x -> ExecuteCommand
$cfrom :: forall x. ExecuteCommand -> Rep ExecuteCommand x
Prelude.Generic)

-- |
-- Create a value of 'ExecuteCommand' 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:
--
-- 'cluster', 'executeCommand_cluster' - The Amazon Resource Name (ARN) or short name of the cluster the task is
-- running in. If you do not specify a cluster, the default cluster is
-- assumed.
--
-- 'container', 'executeCommand_container' - The name of the container to execute the command on. A container name
-- only needs to be specified for tasks containing multiple containers.
--
-- 'command', 'executeCommand_command' - The command to run on the container.
--
-- 'interactive', 'executeCommand_interactive' - Use this flag to run your command in interactive mode.
--
-- 'task', 'executeCommand_task' - The Amazon Resource Name (ARN) or ID of the task the container is part
-- of.
newExecuteCommand ::
  -- | 'command'
  Prelude.Text ->
  -- | 'interactive'
  Prelude.Bool ->
  -- | 'task'
  Prelude.Text ->
  ExecuteCommand
newExecuteCommand :: Text -> Bool -> Text -> ExecuteCommand
newExecuteCommand Text
pCommand_ Bool
pInteractive_ Text
pTask_ =
  ExecuteCommand'
    { $sel:cluster:ExecuteCommand' :: Maybe Text
cluster = forall a. Maybe a
Prelude.Nothing,
      $sel:container:ExecuteCommand' :: Maybe Text
container = forall a. Maybe a
Prelude.Nothing,
      $sel:command:ExecuteCommand' :: Text
command = Text
pCommand_,
      $sel:interactive:ExecuteCommand' :: Bool
interactive = Bool
pInteractive_,
      $sel:task:ExecuteCommand' :: Text
task = Text
pTask_
    }

-- | The Amazon Resource Name (ARN) or short name of the cluster the task is
-- running in. If you do not specify a cluster, the default cluster is
-- assumed.
executeCommand_cluster :: Lens.Lens' ExecuteCommand (Prelude.Maybe Prelude.Text)
executeCommand_cluster :: Lens' ExecuteCommand (Maybe Text)
executeCommand_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteCommand' {Maybe Text
cluster :: Maybe Text
$sel:cluster:ExecuteCommand' :: ExecuteCommand -> Maybe Text
cluster} -> Maybe Text
cluster) (\s :: ExecuteCommand
s@ExecuteCommand' {} Maybe Text
a -> ExecuteCommand
s {$sel:cluster:ExecuteCommand' :: Maybe Text
cluster = Maybe Text
a} :: ExecuteCommand)

-- | The name of the container to execute the command on. A container name
-- only needs to be specified for tasks containing multiple containers.
executeCommand_container :: Lens.Lens' ExecuteCommand (Prelude.Maybe Prelude.Text)
executeCommand_container :: Lens' ExecuteCommand (Maybe Text)
executeCommand_container = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteCommand' {Maybe Text
container :: Maybe Text
$sel:container:ExecuteCommand' :: ExecuteCommand -> Maybe Text
container} -> Maybe Text
container) (\s :: ExecuteCommand
s@ExecuteCommand' {} Maybe Text
a -> ExecuteCommand
s {$sel:container:ExecuteCommand' :: Maybe Text
container = Maybe Text
a} :: ExecuteCommand)

-- | The command to run on the container.
executeCommand_command :: Lens.Lens' ExecuteCommand Prelude.Text
executeCommand_command :: Lens' ExecuteCommand Text
executeCommand_command = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteCommand' {Text
command :: Text
$sel:command:ExecuteCommand' :: ExecuteCommand -> Text
command} -> Text
command) (\s :: ExecuteCommand
s@ExecuteCommand' {} Text
a -> ExecuteCommand
s {$sel:command:ExecuteCommand' :: Text
command = Text
a} :: ExecuteCommand)

-- | Use this flag to run your command in interactive mode.
executeCommand_interactive :: Lens.Lens' ExecuteCommand Prelude.Bool
executeCommand_interactive :: Lens' ExecuteCommand Bool
executeCommand_interactive = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteCommand' {Bool
interactive :: Bool
$sel:interactive:ExecuteCommand' :: ExecuteCommand -> Bool
interactive} -> Bool
interactive) (\s :: ExecuteCommand
s@ExecuteCommand' {} Bool
a -> ExecuteCommand
s {$sel:interactive:ExecuteCommand' :: Bool
interactive = Bool
a} :: ExecuteCommand)

-- | The Amazon Resource Name (ARN) or ID of the task the container is part
-- of.
executeCommand_task :: Lens.Lens' ExecuteCommand Prelude.Text
executeCommand_task :: Lens' ExecuteCommand Text
executeCommand_task = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteCommand' {Text
task :: Text
$sel:task:ExecuteCommand' :: ExecuteCommand -> Text
task} -> Text
task) (\s :: ExecuteCommand
s@ExecuteCommand' {} Text
a -> ExecuteCommand
s {$sel:task:ExecuteCommand' :: Text
task = Text
a} :: ExecuteCommand)

instance Core.AWSRequest ExecuteCommand where
  type
    AWSResponse ExecuteCommand =
      ExecuteCommandResponse
  request :: (Service -> Service) -> ExecuteCommand -> Request ExecuteCommand
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 ExecuteCommand
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ExecuteCommand)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Session
-> Maybe Text
-> Int
-> ExecuteCommandResponse
ExecuteCommandResponse'
            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
"clusterArn")
            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
"containerArn")
            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
"containerName")
            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
"interactive")
            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
"session")
            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
"taskArn")
            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 ExecuteCommand where
  hashWithSalt :: Int -> ExecuteCommand -> Int
hashWithSalt Int
_salt ExecuteCommand' {Bool
Maybe Text
Text
task :: Text
interactive :: Bool
command :: Text
container :: Maybe Text
cluster :: Maybe Text
$sel:task:ExecuteCommand' :: ExecuteCommand -> Text
$sel:interactive:ExecuteCommand' :: ExecuteCommand -> Bool
$sel:command:ExecuteCommand' :: ExecuteCommand -> Text
$sel:container:ExecuteCommand' :: ExecuteCommand -> Maybe Text
$sel:cluster:ExecuteCommand' :: ExecuteCommand -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cluster
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
container
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
command
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
interactive
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
task

instance Prelude.NFData ExecuteCommand where
  rnf :: ExecuteCommand -> ()
rnf ExecuteCommand' {Bool
Maybe Text
Text
task :: Text
interactive :: Bool
command :: Text
container :: Maybe Text
cluster :: Maybe Text
$sel:task:ExecuteCommand' :: ExecuteCommand -> Text
$sel:interactive:ExecuteCommand' :: ExecuteCommand -> Bool
$sel:command:ExecuteCommand' :: ExecuteCommand -> Text
$sel:container:ExecuteCommand' :: ExecuteCommand -> Maybe Text
$sel:cluster:ExecuteCommand' :: ExecuteCommand -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cluster
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
container
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
command
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
interactive
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
task

instance Data.ToHeaders ExecuteCommand where
  toHeaders :: ExecuteCommand -> 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
"AmazonEC2ContainerServiceV20141113.ExecuteCommand" ::
                          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 ExecuteCommand where
  toJSON :: ExecuteCommand -> Value
toJSON ExecuteCommand' {Bool
Maybe Text
Text
task :: Text
interactive :: Bool
command :: Text
container :: Maybe Text
cluster :: Maybe Text
$sel:task:ExecuteCommand' :: ExecuteCommand -> Text
$sel:interactive:ExecuteCommand' :: ExecuteCommand -> Bool
$sel:command:ExecuteCommand' :: ExecuteCommand -> Text
$sel:container:ExecuteCommand' :: ExecuteCommand -> Maybe Text
$sel:cluster:ExecuteCommand' :: ExecuteCommand -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cluster" 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
cluster,
            (Key
"container" 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
container,
            forall a. a -> Maybe a
Prelude.Just (Key
"command" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
command),
            forall a. a -> Maybe a
Prelude.Just (Key
"interactive" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
interactive),
            forall a. a -> Maybe a
Prelude.Just (Key
"task" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
task)
          ]
      )

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

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

-- | /See:/ 'newExecuteCommandResponse' smart constructor.
data ExecuteCommandResponse = ExecuteCommandResponse'
  { -- | The Amazon Resource Name (ARN) of the cluster.
    ExecuteCommandResponse -> Maybe Text
clusterArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the container.
    ExecuteCommandResponse -> Maybe Text
containerArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the container.
    ExecuteCommandResponse -> Maybe Text
containerName :: Prelude.Maybe Prelude.Text,
    -- | Determines whether the execute command session is running in interactive
    -- mode. Amazon ECS only supports initiating interactive sessions, so you
    -- must specify @true@ for this value.
    ExecuteCommandResponse -> Maybe Bool
interactive :: Prelude.Maybe Prelude.Bool,
    -- | The details of the SSM session that was created for this instance of
    -- execute-command.
    ExecuteCommandResponse -> Maybe Session
session :: Prelude.Maybe Session,
    -- | The Amazon Resource Name (ARN) of the task.
    ExecuteCommandResponse -> Maybe Text
taskArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ExecuteCommandResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ExecuteCommandResponse -> ExecuteCommandResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecuteCommandResponse -> ExecuteCommandResponse -> Bool
$c/= :: ExecuteCommandResponse -> ExecuteCommandResponse -> Bool
== :: ExecuteCommandResponse -> ExecuteCommandResponse -> Bool
$c== :: ExecuteCommandResponse -> ExecuteCommandResponse -> Bool
Prelude.Eq, Int -> ExecuteCommandResponse -> ShowS
[ExecuteCommandResponse] -> ShowS
ExecuteCommandResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecuteCommandResponse] -> ShowS
$cshowList :: [ExecuteCommandResponse] -> ShowS
show :: ExecuteCommandResponse -> String
$cshow :: ExecuteCommandResponse -> String
showsPrec :: Int -> ExecuteCommandResponse -> ShowS
$cshowsPrec :: Int -> ExecuteCommandResponse -> ShowS
Prelude.Show, forall x. Rep ExecuteCommandResponse x -> ExecuteCommandResponse
forall x. ExecuteCommandResponse -> Rep ExecuteCommandResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExecuteCommandResponse x -> ExecuteCommandResponse
$cfrom :: forall x. ExecuteCommandResponse -> Rep ExecuteCommandResponse x
Prelude.Generic)

-- |
-- Create a value of 'ExecuteCommandResponse' 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:
--
-- 'clusterArn', 'executeCommandResponse_clusterArn' - The Amazon Resource Name (ARN) of the cluster.
--
-- 'containerArn', 'executeCommandResponse_containerArn' - The Amazon Resource Name (ARN) of the container.
--
-- 'containerName', 'executeCommandResponse_containerName' - The name of the container.
--
-- 'interactive', 'executeCommandResponse_interactive' - Determines whether the execute command session is running in interactive
-- mode. Amazon ECS only supports initiating interactive sessions, so you
-- must specify @true@ for this value.
--
-- 'session', 'executeCommandResponse_session' - The details of the SSM session that was created for this instance of
-- execute-command.
--
-- 'taskArn', 'executeCommandResponse_taskArn' - The Amazon Resource Name (ARN) of the task.
--
-- 'httpStatus', 'executeCommandResponse_httpStatus' - The response's http status code.
newExecuteCommandResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExecuteCommandResponse
newExecuteCommandResponse :: Int -> ExecuteCommandResponse
newExecuteCommandResponse Int
pHttpStatus_ =
  ExecuteCommandResponse'
    { $sel:clusterArn:ExecuteCommandResponse' :: Maybe Text
clusterArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:containerArn:ExecuteCommandResponse' :: Maybe Text
containerArn = forall a. Maybe a
Prelude.Nothing,
      $sel:containerName:ExecuteCommandResponse' :: Maybe Text
containerName = forall a. Maybe a
Prelude.Nothing,
      $sel:interactive:ExecuteCommandResponse' :: Maybe Bool
interactive = forall a. Maybe a
Prelude.Nothing,
      $sel:session:ExecuteCommandResponse' :: Maybe Session
session = forall a. Maybe a
Prelude.Nothing,
      $sel:taskArn:ExecuteCommandResponse' :: Maybe Text
taskArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ExecuteCommandResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the cluster.
executeCommandResponse_clusterArn :: Lens.Lens' ExecuteCommandResponse (Prelude.Maybe Prelude.Text)
executeCommandResponse_clusterArn :: Lens' ExecuteCommandResponse (Maybe Text)
executeCommandResponse_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteCommandResponse' {Maybe Text
clusterArn :: Maybe Text
$sel:clusterArn:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Text
clusterArn} -> Maybe Text
clusterArn) (\s :: ExecuteCommandResponse
s@ExecuteCommandResponse' {} Maybe Text
a -> ExecuteCommandResponse
s {$sel:clusterArn:ExecuteCommandResponse' :: Maybe Text
clusterArn = Maybe Text
a} :: ExecuteCommandResponse)

-- | The Amazon Resource Name (ARN) of the container.
executeCommandResponse_containerArn :: Lens.Lens' ExecuteCommandResponse (Prelude.Maybe Prelude.Text)
executeCommandResponse_containerArn :: Lens' ExecuteCommandResponse (Maybe Text)
executeCommandResponse_containerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteCommandResponse' {Maybe Text
containerArn :: Maybe Text
$sel:containerArn:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Text
containerArn} -> Maybe Text
containerArn) (\s :: ExecuteCommandResponse
s@ExecuteCommandResponse' {} Maybe Text
a -> ExecuteCommandResponse
s {$sel:containerArn:ExecuteCommandResponse' :: Maybe Text
containerArn = Maybe Text
a} :: ExecuteCommandResponse)

-- | The name of the container.
executeCommandResponse_containerName :: Lens.Lens' ExecuteCommandResponse (Prelude.Maybe Prelude.Text)
executeCommandResponse_containerName :: Lens' ExecuteCommandResponse (Maybe Text)
executeCommandResponse_containerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteCommandResponse' {Maybe Text
containerName :: Maybe Text
$sel:containerName:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Text
containerName} -> Maybe Text
containerName) (\s :: ExecuteCommandResponse
s@ExecuteCommandResponse' {} Maybe Text
a -> ExecuteCommandResponse
s {$sel:containerName:ExecuteCommandResponse' :: Maybe Text
containerName = Maybe Text
a} :: ExecuteCommandResponse)

-- | Determines whether the execute command session is running in interactive
-- mode. Amazon ECS only supports initiating interactive sessions, so you
-- must specify @true@ for this value.
executeCommandResponse_interactive :: Lens.Lens' ExecuteCommandResponse (Prelude.Maybe Prelude.Bool)
executeCommandResponse_interactive :: Lens' ExecuteCommandResponse (Maybe Bool)
executeCommandResponse_interactive = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteCommandResponse' {Maybe Bool
interactive :: Maybe Bool
$sel:interactive:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Bool
interactive} -> Maybe Bool
interactive) (\s :: ExecuteCommandResponse
s@ExecuteCommandResponse' {} Maybe Bool
a -> ExecuteCommandResponse
s {$sel:interactive:ExecuteCommandResponse' :: Maybe Bool
interactive = Maybe Bool
a} :: ExecuteCommandResponse)

-- | The details of the SSM session that was created for this instance of
-- execute-command.
executeCommandResponse_session :: Lens.Lens' ExecuteCommandResponse (Prelude.Maybe Session)
executeCommandResponse_session :: Lens' ExecuteCommandResponse (Maybe Session)
executeCommandResponse_session = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteCommandResponse' {Maybe Session
session :: Maybe Session
$sel:session:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Session
session} -> Maybe Session
session) (\s :: ExecuteCommandResponse
s@ExecuteCommandResponse' {} Maybe Session
a -> ExecuteCommandResponse
s {$sel:session:ExecuteCommandResponse' :: Maybe Session
session = Maybe Session
a} :: ExecuteCommandResponse)

-- | The Amazon Resource Name (ARN) of the task.
executeCommandResponse_taskArn :: Lens.Lens' ExecuteCommandResponse (Prelude.Maybe Prelude.Text)
executeCommandResponse_taskArn :: Lens' ExecuteCommandResponse (Maybe Text)
executeCommandResponse_taskArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExecuteCommandResponse' {Maybe Text
taskArn :: Maybe Text
$sel:taskArn:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Text
taskArn} -> Maybe Text
taskArn) (\s :: ExecuteCommandResponse
s@ExecuteCommandResponse' {} Maybe Text
a -> ExecuteCommandResponse
s {$sel:taskArn:ExecuteCommandResponse' :: Maybe Text
taskArn = Maybe Text
a} :: ExecuteCommandResponse)

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

instance Prelude.NFData ExecuteCommandResponse where
  rnf :: ExecuteCommandResponse -> ()
rnf ExecuteCommandResponse' {Int
Maybe Bool
Maybe Text
Maybe Session
httpStatus :: Int
taskArn :: Maybe Text
session :: Maybe Session
interactive :: Maybe Bool
containerName :: Maybe Text
containerArn :: Maybe Text
clusterArn :: Maybe Text
$sel:httpStatus:ExecuteCommandResponse' :: ExecuteCommandResponse -> Int
$sel:taskArn:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Text
$sel:session:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Session
$sel:interactive:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Bool
$sel:containerName:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Text
$sel:containerArn:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Text
$sel:clusterArn:ExecuteCommandResponse' :: ExecuteCommandResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
containerArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
containerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
interactive
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Session
session
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
taskArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus