{-# 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.SnowDeviceManagement.CancelTask
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sends a cancel request for a specified task. You can cancel a task only
-- if it\'s still in a @QUEUED@ state. Tasks that are already running
-- can\'t be cancelled.
--
-- A task might still run if it\'s processed from the queue before the
-- @CancelTask@ operation changes the task\'s state.
module Amazonka.SnowDeviceManagement.CancelTask
  ( -- * Creating a Request
    CancelTask (..),
    newCancelTask,

    -- * Request Lenses
    cancelTask_taskId,

    -- * Destructuring the Response
    CancelTaskResponse (..),
    newCancelTaskResponse,

    -- * Response Lenses
    cancelTaskResponse_taskId,
    cancelTaskResponse_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.SnowDeviceManagement.Types

-- | /See:/ 'newCancelTask' smart constructor.
data CancelTask = CancelTask'
  { -- | The ID of the task that you are attempting to cancel. You can retrieve a
    -- task ID by using the @ListTasks@ operation.
    CancelTask -> Text
taskId :: Prelude.Text
  }
  deriving (CancelTask -> CancelTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelTask -> CancelTask -> Bool
$c/= :: CancelTask -> CancelTask -> Bool
== :: CancelTask -> CancelTask -> Bool
$c== :: CancelTask -> CancelTask -> Bool
Prelude.Eq, ReadPrec [CancelTask]
ReadPrec CancelTask
Int -> ReadS CancelTask
ReadS [CancelTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelTask]
$creadListPrec :: ReadPrec [CancelTask]
readPrec :: ReadPrec CancelTask
$creadPrec :: ReadPrec CancelTask
readList :: ReadS [CancelTask]
$creadList :: ReadS [CancelTask]
readsPrec :: Int -> ReadS CancelTask
$creadsPrec :: Int -> ReadS CancelTask
Prelude.Read, Int -> CancelTask -> ShowS
[CancelTask] -> ShowS
CancelTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelTask] -> ShowS
$cshowList :: [CancelTask] -> ShowS
show :: CancelTask -> String
$cshow :: CancelTask -> String
showsPrec :: Int -> CancelTask -> ShowS
$cshowsPrec :: Int -> CancelTask -> ShowS
Prelude.Show, forall x. Rep CancelTask x -> CancelTask
forall x. CancelTask -> Rep CancelTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelTask x -> CancelTask
$cfrom :: forall x. CancelTask -> Rep CancelTask x
Prelude.Generic)

-- |
-- Create a value of 'CancelTask' 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:
--
-- 'taskId', 'cancelTask_taskId' - The ID of the task that you are attempting to cancel. You can retrieve a
-- task ID by using the @ListTasks@ operation.
newCancelTask ::
  -- | 'taskId'
  Prelude.Text ->
  CancelTask
newCancelTask :: Text -> CancelTask
newCancelTask Text
pTaskId_ =
  CancelTask' {$sel:taskId:CancelTask' :: Text
taskId = Text
pTaskId_}

-- | The ID of the task that you are attempting to cancel. You can retrieve a
-- task ID by using the @ListTasks@ operation.
cancelTask_taskId :: Lens.Lens' CancelTask Prelude.Text
cancelTask_taskId :: Lens' CancelTask Text
cancelTask_taskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelTask' {Text
taskId :: Text
$sel:taskId:CancelTask' :: CancelTask -> Text
taskId} -> Text
taskId) (\s :: CancelTask
s@CancelTask' {} Text
a -> CancelTask
s {$sel:taskId:CancelTask' :: Text
taskId = Text
a} :: CancelTask)

instance Core.AWSRequest CancelTask where
  type AWSResponse CancelTask = CancelTaskResponse
  request :: (Service -> Service) -> CancelTask -> Request CancelTask
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 CancelTask
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CancelTask)))
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 -> Int -> CancelTaskResponse
CancelTaskResponse'
            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
"taskId")
            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 CancelTask where
  hashWithSalt :: Int -> CancelTask -> Int
hashWithSalt Int
_salt CancelTask' {Text
taskId :: Text
$sel:taskId:CancelTask' :: CancelTask -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
taskId

instance Prelude.NFData CancelTask where
  rnf :: CancelTask -> ()
rnf CancelTask' {Text
taskId :: Text
$sel:taskId:CancelTask' :: CancelTask -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
taskId

instance Data.ToHeaders CancelTask where
  toHeaders :: CancelTask -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CancelTask where
  toJSON :: CancelTask -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath CancelTask where
  toPath :: CancelTask -> ByteString
toPath CancelTask' {Text
taskId :: Text
$sel:taskId:CancelTask' :: CancelTask -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/task/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
taskId, ByteString
"/cancel"]

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

-- | /See:/ 'newCancelTaskResponse' smart constructor.
data CancelTaskResponse = CancelTaskResponse'
  { -- | The ID of the task that you are attempting to cancel.
    CancelTaskResponse -> Maybe Text
taskId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CancelTaskResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CancelTaskResponse -> CancelTaskResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelTaskResponse -> CancelTaskResponse -> Bool
$c/= :: CancelTaskResponse -> CancelTaskResponse -> Bool
== :: CancelTaskResponse -> CancelTaskResponse -> Bool
$c== :: CancelTaskResponse -> CancelTaskResponse -> Bool
Prelude.Eq, ReadPrec [CancelTaskResponse]
ReadPrec CancelTaskResponse
Int -> ReadS CancelTaskResponse
ReadS [CancelTaskResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelTaskResponse]
$creadListPrec :: ReadPrec [CancelTaskResponse]
readPrec :: ReadPrec CancelTaskResponse
$creadPrec :: ReadPrec CancelTaskResponse
readList :: ReadS [CancelTaskResponse]
$creadList :: ReadS [CancelTaskResponse]
readsPrec :: Int -> ReadS CancelTaskResponse
$creadsPrec :: Int -> ReadS CancelTaskResponse
Prelude.Read, Int -> CancelTaskResponse -> ShowS
[CancelTaskResponse] -> ShowS
CancelTaskResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelTaskResponse] -> ShowS
$cshowList :: [CancelTaskResponse] -> ShowS
show :: CancelTaskResponse -> String
$cshow :: CancelTaskResponse -> String
showsPrec :: Int -> CancelTaskResponse -> ShowS
$cshowsPrec :: Int -> CancelTaskResponse -> ShowS
Prelude.Show, forall x. Rep CancelTaskResponse x -> CancelTaskResponse
forall x. CancelTaskResponse -> Rep CancelTaskResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelTaskResponse x -> CancelTaskResponse
$cfrom :: forall x. CancelTaskResponse -> Rep CancelTaskResponse x
Prelude.Generic)

-- |
-- Create a value of 'CancelTaskResponse' 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:
--
-- 'taskId', 'cancelTaskResponse_taskId' - The ID of the task that you are attempting to cancel.
--
-- 'httpStatus', 'cancelTaskResponse_httpStatus' - The response's http status code.
newCancelTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CancelTaskResponse
newCancelTaskResponse :: Int -> CancelTaskResponse
newCancelTaskResponse Int
pHttpStatus_ =
  CancelTaskResponse'
    { $sel:taskId:CancelTaskResponse' :: Maybe Text
taskId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CancelTaskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the task that you are attempting to cancel.
cancelTaskResponse_taskId :: Lens.Lens' CancelTaskResponse (Prelude.Maybe Prelude.Text)
cancelTaskResponse_taskId :: Lens' CancelTaskResponse (Maybe Text)
cancelTaskResponse_taskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelTaskResponse' {Maybe Text
taskId :: Maybe Text
$sel:taskId:CancelTaskResponse' :: CancelTaskResponse -> Maybe Text
taskId} -> Maybe Text
taskId) (\s :: CancelTaskResponse
s@CancelTaskResponse' {} Maybe Text
a -> CancelTaskResponse
s {$sel:taskId:CancelTaskResponse' :: Maybe Text
taskId = Maybe Text
a} :: CancelTaskResponse)

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

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