{-# 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.StopTask
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops a running task. Any tags associated with the task will be deleted.
--
-- When StopTask is called on a task, the equivalent of @docker stop@ is
-- issued to the containers running in the task. This results in a
-- @SIGTERM@ value and a default 30-second timeout, after which the
-- @SIGKILL@ value is sent and the containers are forcibly stopped. If the
-- container handles the @SIGTERM@ value gracefully and exits within 30
-- seconds from receiving it, no @SIGKILL@ value is sent.
--
-- The default 30-second timeout can be configured on the Amazon ECS
-- container agent with the @ECS_CONTAINER_STOP_TIMEOUT@ variable. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-agent-config.html Amazon ECS Container Agent Configuration>
-- in the /Amazon Elastic Container Service Developer Guide/.
module Amazonka.ECS.StopTask
  ( -- * Creating a Request
    StopTask (..),
    newStopTask,

    -- * Request Lenses
    stopTask_cluster,
    stopTask_reason,
    stopTask_task,

    -- * Destructuring the Response
    StopTaskResponse (..),
    newStopTaskResponse,

    -- * Response Lenses
    stopTaskResponse_task,
    stopTaskResponse_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:/ 'newStopTask' smart constructor.
data StopTask = StopTask'
  { -- | The short name or full Amazon Resource Name (ARN) of the cluster that
    -- hosts the task to stop. If you do not specify a cluster, the default
    -- cluster is assumed.
    StopTask -> Maybe Text
cluster :: Prelude.Maybe Prelude.Text,
    -- | An optional message specified when a task is stopped. For example, if
    -- you\'re using a custom scheduler, you can use this parameter to specify
    -- the reason for stopping the task here, and the message appears in
    -- subsequent DescribeTasks API operations on this task. Up to 255
    -- characters are allowed in this message.
    StopTask -> Maybe Text
reason :: Prelude.Maybe Prelude.Text,
    -- | The task ID or full Amazon Resource Name (ARN) of the task to stop.
    StopTask -> Text
task :: Prelude.Text
  }
  deriving (StopTask -> StopTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopTask -> StopTask -> Bool
$c/= :: StopTask -> StopTask -> Bool
== :: StopTask -> StopTask -> Bool
$c== :: StopTask -> StopTask -> Bool
Prelude.Eq, ReadPrec [StopTask]
ReadPrec StopTask
Int -> ReadS StopTask
ReadS [StopTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopTask]
$creadListPrec :: ReadPrec [StopTask]
readPrec :: ReadPrec StopTask
$creadPrec :: ReadPrec StopTask
readList :: ReadS [StopTask]
$creadList :: ReadS [StopTask]
readsPrec :: Int -> ReadS StopTask
$creadsPrec :: Int -> ReadS StopTask
Prelude.Read, Int -> StopTask -> ShowS
[StopTask] -> ShowS
StopTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopTask] -> ShowS
$cshowList :: [StopTask] -> ShowS
show :: StopTask -> String
$cshow :: StopTask -> String
showsPrec :: Int -> StopTask -> ShowS
$cshowsPrec :: Int -> StopTask -> ShowS
Prelude.Show, forall x. Rep StopTask x -> StopTask
forall x. StopTask -> Rep StopTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopTask x -> StopTask
$cfrom :: forall x. StopTask -> Rep StopTask x
Prelude.Generic)

-- |
-- Create a value of 'StopTask' 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', 'stopTask_cluster' - The short name or full Amazon Resource Name (ARN) of the cluster that
-- hosts the task to stop. If you do not specify a cluster, the default
-- cluster is assumed.
--
-- 'reason', 'stopTask_reason' - An optional message specified when a task is stopped. For example, if
-- you\'re using a custom scheduler, you can use this parameter to specify
-- the reason for stopping the task here, and the message appears in
-- subsequent DescribeTasks API operations on this task. Up to 255
-- characters are allowed in this message.
--
-- 'task', 'stopTask_task' - The task ID or full Amazon Resource Name (ARN) of the task to stop.
newStopTask ::
  -- | 'task'
  Prelude.Text ->
  StopTask
newStopTask :: Text -> StopTask
newStopTask Text
pTask_ =
  StopTask'
    { $sel:cluster:StopTask' :: Maybe Text
cluster = forall a. Maybe a
Prelude.Nothing,
      $sel:reason:StopTask' :: Maybe Text
reason = forall a. Maybe a
Prelude.Nothing,
      $sel:task:StopTask' :: Text
task = Text
pTask_
    }

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

-- | An optional message specified when a task is stopped. For example, if
-- you\'re using a custom scheduler, you can use this parameter to specify
-- the reason for stopping the task here, and the message appears in
-- subsequent DescribeTasks API operations on this task. Up to 255
-- characters are allowed in this message.
stopTask_reason :: Lens.Lens' StopTask (Prelude.Maybe Prelude.Text)
stopTask_reason :: Lens' StopTask (Maybe Text)
stopTask_reason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopTask' {Maybe Text
reason :: Maybe Text
$sel:reason:StopTask' :: StopTask -> Maybe Text
reason} -> Maybe Text
reason) (\s :: StopTask
s@StopTask' {} Maybe Text
a -> StopTask
s {$sel:reason:StopTask' :: Maybe Text
reason = Maybe Text
a} :: StopTask)

-- | The task ID or full Amazon Resource Name (ARN) of the task to stop.
stopTask_task :: Lens.Lens' StopTask Prelude.Text
stopTask_task :: Lens' StopTask Text
stopTask_task = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopTask' {Text
task :: Text
$sel:task:StopTask' :: StopTask -> Text
task} -> Text
task) (\s :: StopTask
s@StopTask' {} Text
a -> StopTask
s {$sel:task:StopTask' :: Text
task = Text
a} :: StopTask)

instance Core.AWSRequest StopTask where
  type AWSResponse StopTask = StopTaskResponse
  request :: (Service -> Service) -> StopTask -> Request StopTask
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 StopTask
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StopTask)))
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 Task -> Int -> StopTaskResponse
StopTaskResponse'
            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
"task")
            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 StopTask where
  hashWithSalt :: Int -> StopTask -> Int
hashWithSalt Int
_salt StopTask' {Maybe Text
Text
task :: Text
reason :: Maybe Text
cluster :: Maybe Text
$sel:task:StopTask' :: StopTask -> Text
$sel:reason:StopTask' :: StopTask -> Maybe Text
$sel:cluster:StopTask' :: StopTask -> 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
reason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
task

instance Prelude.NFData StopTask where
  rnf :: StopTask -> ()
rnf StopTask' {Maybe Text
Text
task :: Text
reason :: Maybe Text
cluster :: Maybe Text
$sel:task:StopTask' :: StopTask -> Text
$sel:reason:StopTask' :: StopTask -> Maybe Text
$sel:cluster:StopTask' :: StopTask -> 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
reason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
task

instance Data.ToHeaders StopTask where
  toHeaders :: StopTask -> 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.StopTask" ::
                          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 StopTask where
  toJSON :: StopTask -> Value
toJSON StopTask' {Maybe Text
Text
task :: Text
reason :: Maybe Text
cluster :: Maybe Text
$sel:task:StopTask' :: StopTask -> Text
$sel:reason:StopTask' :: StopTask -> Maybe Text
$sel:cluster:StopTask' :: StopTask -> 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
"reason" 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
reason,
            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 StopTask where
  toPath :: StopTask -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newStopTaskResponse' smart constructor.
data StopTaskResponse = StopTaskResponse'
  { -- | The task that was stopped.
    StopTaskResponse -> Maybe Task
task :: Prelude.Maybe Task,
    -- | The response's http status code.
    StopTaskResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StopTaskResponse -> StopTaskResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopTaskResponse -> StopTaskResponse -> Bool
$c/= :: StopTaskResponse -> StopTaskResponse -> Bool
== :: StopTaskResponse -> StopTaskResponse -> Bool
$c== :: StopTaskResponse -> StopTaskResponse -> Bool
Prelude.Eq, ReadPrec [StopTaskResponse]
ReadPrec StopTaskResponse
Int -> ReadS StopTaskResponse
ReadS [StopTaskResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopTaskResponse]
$creadListPrec :: ReadPrec [StopTaskResponse]
readPrec :: ReadPrec StopTaskResponse
$creadPrec :: ReadPrec StopTaskResponse
readList :: ReadS [StopTaskResponse]
$creadList :: ReadS [StopTaskResponse]
readsPrec :: Int -> ReadS StopTaskResponse
$creadsPrec :: Int -> ReadS StopTaskResponse
Prelude.Read, Int -> StopTaskResponse -> ShowS
[StopTaskResponse] -> ShowS
StopTaskResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopTaskResponse] -> ShowS
$cshowList :: [StopTaskResponse] -> ShowS
show :: StopTaskResponse -> String
$cshow :: StopTaskResponse -> String
showsPrec :: Int -> StopTaskResponse -> ShowS
$cshowsPrec :: Int -> StopTaskResponse -> ShowS
Prelude.Show, forall x. Rep StopTaskResponse x -> StopTaskResponse
forall x. StopTaskResponse -> Rep StopTaskResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopTaskResponse x -> StopTaskResponse
$cfrom :: forall x. StopTaskResponse -> Rep StopTaskResponse x
Prelude.Generic)

-- |
-- Create a value of 'StopTaskResponse' 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:
--
-- 'task', 'stopTaskResponse_task' - The task that was stopped.
--
-- 'httpStatus', 'stopTaskResponse_httpStatus' - The response's http status code.
newStopTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StopTaskResponse
newStopTaskResponse :: Int -> StopTaskResponse
newStopTaskResponse Int
pHttpStatus_ =
  StopTaskResponse'
    { $sel:task:StopTaskResponse' :: Maybe Task
task = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StopTaskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The task that was stopped.
stopTaskResponse_task :: Lens.Lens' StopTaskResponse (Prelude.Maybe Task)
stopTaskResponse_task :: Lens' StopTaskResponse (Maybe Task)
stopTaskResponse_task = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopTaskResponse' {Maybe Task
task :: Maybe Task
$sel:task:StopTaskResponse' :: StopTaskResponse -> Maybe Task
task} -> Maybe Task
task) (\s :: StopTaskResponse
s@StopTaskResponse' {} Maybe Task
a -> StopTaskResponse
s {$sel:task:StopTaskResponse' :: Maybe Task
task = Maybe Task
a} :: StopTaskResponse)

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

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