{-# 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.Glue.CancelMLTaskRun
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Cancels (stops) a task run. Machine learning task runs are asynchronous
-- tasks that Glue runs on your behalf as part of various machine learning
-- workflows. You can cancel a machine learning task run at any time by
-- calling @CancelMLTaskRun@ with a task run\'s parent transform\'s
-- @TransformID@ and the task run\'s @TaskRunId@.
module Amazonka.Glue.CancelMLTaskRun
  ( -- * Creating a Request
    CancelMLTaskRun (..),
    newCancelMLTaskRun,

    -- * Request Lenses
    cancelMLTaskRun_transformId,
    cancelMLTaskRun_taskRunId,

    -- * Destructuring the Response
    CancelMLTaskRunResponse (..),
    newCancelMLTaskRunResponse,

    -- * Response Lenses
    cancelMLTaskRunResponse_status,
    cancelMLTaskRunResponse_taskRunId,
    cancelMLTaskRunResponse_transformId,
    cancelMLTaskRunResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCancelMLTaskRun' smart constructor.
data CancelMLTaskRun = CancelMLTaskRun'
  { -- | The unique identifier of the machine learning transform.
    CancelMLTaskRun -> Text
transformId :: Prelude.Text,
    -- | A unique identifier for the task run.
    CancelMLTaskRun -> Text
taskRunId :: Prelude.Text
  }
  deriving (CancelMLTaskRun -> CancelMLTaskRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelMLTaskRun -> CancelMLTaskRun -> Bool
$c/= :: CancelMLTaskRun -> CancelMLTaskRun -> Bool
== :: CancelMLTaskRun -> CancelMLTaskRun -> Bool
$c== :: CancelMLTaskRun -> CancelMLTaskRun -> Bool
Prelude.Eq, ReadPrec [CancelMLTaskRun]
ReadPrec CancelMLTaskRun
Int -> ReadS CancelMLTaskRun
ReadS [CancelMLTaskRun]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelMLTaskRun]
$creadListPrec :: ReadPrec [CancelMLTaskRun]
readPrec :: ReadPrec CancelMLTaskRun
$creadPrec :: ReadPrec CancelMLTaskRun
readList :: ReadS [CancelMLTaskRun]
$creadList :: ReadS [CancelMLTaskRun]
readsPrec :: Int -> ReadS CancelMLTaskRun
$creadsPrec :: Int -> ReadS CancelMLTaskRun
Prelude.Read, Int -> CancelMLTaskRun -> ShowS
[CancelMLTaskRun] -> ShowS
CancelMLTaskRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelMLTaskRun] -> ShowS
$cshowList :: [CancelMLTaskRun] -> ShowS
show :: CancelMLTaskRun -> String
$cshow :: CancelMLTaskRun -> String
showsPrec :: Int -> CancelMLTaskRun -> ShowS
$cshowsPrec :: Int -> CancelMLTaskRun -> ShowS
Prelude.Show, forall x. Rep CancelMLTaskRun x -> CancelMLTaskRun
forall x. CancelMLTaskRun -> Rep CancelMLTaskRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelMLTaskRun x -> CancelMLTaskRun
$cfrom :: forall x. CancelMLTaskRun -> Rep CancelMLTaskRun x
Prelude.Generic)

-- |
-- Create a value of 'CancelMLTaskRun' 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:
--
-- 'transformId', 'cancelMLTaskRun_transformId' - The unique identifier of the machine learning transform.
--
-- 'taskRunId', 'cancelMLTaskRun_taskRunId' - A unique identifier for the task run.
newCancelMLTaskRun ::
  -- | 'transformId'
  Prelude.Text ->
  -- | 'taskRunId'
  Prelude.Text ->
  CancelMLTaskRun
newCancelMLTaskRun :: Text -> Text -> CancelMLTaskRun
newCancelMLTaskRun Text
pTransformId_ Text
pTaskRunId_ =
  CancelMLTaskRun'
    { $sel:transformId:CancelMLTaskRun' :: Text
transformId = Text
pTransformId_,
      $sel:taskRunId:CancelMLTaskRun' :: Text
taskRunId = Text
pTaskRunId_
    }

-- | The unique identifier of the machine learning transform.
cancelMLTaskRun_transformId :: Lens.Lens' CancelMLTaskRun Prelude.Text
cancelMLTaskRun_transformId :: Lens' CancelMLTaskRun Text
cancelMLTaskRun_transformId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelMLTaskRun' {Text
transformId :: Text
$sel:transformId:CancelMLTaskRun' :: CancelMLTaskRun -> Text
transformId} -> Text
transformId) (\s :: CancelMLTaskRun
s@CancelMLTaskRun' {} Text
a -> CancelMLTaskRun
s {$sel:transformId:CancelMLTaskRun' :: Text
transformId = Text
a} :: CancelMLTaskRun)

-- | A unique identifier for the task run.
cancelMLTaskRun_taskRunId :: Lens.Lens' CancelMLTaskRun Prelude.Text
cancelMLTaskRun_taskRunId :: Lens' CancelMLTaskRun Text
cancelMLTaskRun_taskRunId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelMLTaskRun' {Text
taskRunId :: Text
$sel:taskRunId:CancelMLTaskRun' :: CancelMLTaskRun -> Text
taskRunId} -> Text
taskRunId) (\s :: CancelMLTaskRun
s@CancelMLTaskRun' {} Text
a -> CancelMLTaskRun
s {$sel:taskRunId:CancelMLTaskRun' :: Text
taskRunId = Text
a} :: CancelMLTaskRun)

instance Core.AWSRequest CancelMLTaskRun where
  type
    AWSResponse CancelMLTaskRun =
      CancelMLTaskRunResponse
  request :: (Service -> Service) -> CancelMLTaskRun -> Request CancelMLTaskRun
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 CancelMLTaskRun
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CancelMLTaskRun)))
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 TaskStatusType
-> Maybe Text -> Maybe Text -> Int -> CancelMLTaskRunResponse
CancelMLTaskRunResponse'
            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
"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
"TaskRunId")
            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
"TransformId")
            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 CancelMLTaskRun where
  hashWithSalt :: Int -> CancelMLTaskRun -> Int
hashWithSalt Int
_salt CancelMLTaskRun' {Text
taskRunId :: Text
transformId :: Text
$sel:taskRunId:CancelMLTaskRun' :: CancelMLTaskRun -> Text
$sel:transformId:CancelMLTaskRun' :: CancelMLTaskRun -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transformId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
taskRunId

instance Prelude.NFData CancelMLTaskRun where
  rnf :: CancelMLTaskRun -> ()
rnf CancelMLTaskRun' {Text
taskRunId :: Text
transformId :: Text
$sel:taskRunId:CancelMLTaskRun' :: CancelMLTaskRun -> Text
$sel:transformId:CancelMLTaskRun' :: CancelMLTaskRun -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
transformId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
taskRunId

instance Data.ToHeaders CancelMLTaskRun where
  toHeaders :: CancelMLTaskRun -> 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
"AWSGlue.CancelMLTaskRun" :: 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 CancelMLTaskRun where
  toJSON :: CancelMLTaskRun -> Value
toJSON CancelMLTaskRun' {Text
taskRunId :: Text
transformId :: Text
$sel:taskRunId:CancelMLTaskRun' :: CancelMLTaskRun -> Text
$sel:transformId:CancelMLTaskRun' :: CancelMLTaskRun -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"TransformId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
transformId),
            forall a. a -> Maybe a
Prelude.Just (Key
"TaskRunId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
taskRunId)
          ]
      )

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

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

-- | /See:/ 'newCancelMLTaskRunResponse' smart constructor.
data CancelMLTaskRunResponse = CancelMLTaskRunResponse'
  { -- | The status for this run.
    CancelMLTaskRunResponse -> Maybe TaskStatusType
status :: Prelude.Maybe TaskStatusType,
    -- | The unique identifier for the task run.
    CancelMLTaskRunResponse -> Maybe Text
taskRunId :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the machine learning transform.
    CancelMLTaskRunResponse -> Maybe Text
transformId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CancelMLTaskRunResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CancelMLTaskRunResponse -> CancelMLTaskRunResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelMLTaskRunResponse -> CancelMLTaskRunResponse -> Bool
$c/= :: CancelMLTaskRunResponse -> CancelMLTaskRunResponse -> Bool
== :: CancelMLTaskRunResponse -> CancelMLTaskRunResponse -> Bool
$c== :: CancelMLTaskRunResponse -> CancelMLTaskRunResponse -> Bool
Prelude.Eq, ReadPrec [CancelMLTaskRunResponse]
ReadPrec CancelMLTaskRunResponse
Int -> ReadS CancelMLTaskRunResponse
ReadS [CancelMLTaskRunResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelMLTaskRunResponse]
$creadListPrec :: ReadPrec [CancelMLTaskRunResponse]
readPrec :: ReadPrec CancelMLTaskRunResponse
$creadPrec :: ReadPrec CancelMLTaskRunResponse
readList :: ReadS [CancelMLTaskRunResponse]
$creadList :: ReadS [CancelMLTaskRunResponse]
readsPrec :: Int -> ReadS CancelMLTaskRunResponse
$creadsPrec :: Int -> ReadS CancelMLTaskRunResponse
Prelude.Read, Int -> CancelMLTaskRunResponse -> ShowS
[CancelMLTaskRunResponse] -> ShowS
CancelMLTaskRunResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelMLTaskRunResponse] -> ShowS
$cshowList :: [CancelMLTaskRunResponse] -> ShowS
show :: CancelMLTaskRunResponse -> String
$cshow :: CancelMLTaskRunResponse -> String
showsPrec :: Int -> CancelMLTaskRunResponse -> ShowS
$cshowsPrec :: Int -> CancelMLTaskRunResponse -> ShowS
Prelude.Show, forall x. Rep CancelMLTaskRunResponse x -> CancelMLTaskRunResponse
forall x. CancelMLTaskRunResponse -> Rep CancelMLTaskRunResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelMLTaskRunResponse x -> CancelMLTaskRunResponse
$cfrom :: forall x. CancelMLTaskRunResponse -> Rep CancelMLTaskRunResponse x
Prelude.Generic)

-- |
-- Create a value of 'CancelMLTaskRunResponse' 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:
--
-- 'status', 'cancelMLTaskRunResponse_status' - The status for this run.
--
-- 'taskRunId', 'cancelMLTaskRunResponse_taskRunId' - The unique identifier for the task run.
--
-- 'transformId', 'cancelMLTaskRunResponse_transformId' - The unique identifier of the machine learning transform.
--
-- 'httpStatus', 'cancelMLTaskRunResponse_httpStatus' - The response's http status code.
newCancelMLTaskRunResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CancelMLTaskRunResponse
newCancelMLTaskRunResponse :: Int -> CancelMLTaskRunResponse
newCancelMLTaskRunResponse Int
pHttpStatus_ =
  CancelMLTaskRunResponse'
    { $sel:status:CancelMLTaskRunResponse' :: Maybe TaskStatusType
status = forall a. Maybe a
Prelude.Nothing,
      $sel:taskRunId:CancelMLTaskRunResponse' :: Maybe Text
taskRunId = forall a. Maybe a
Prelude.Nothing,
      $sel:transformId:CancelMLTaskRunResponse' :: Maybe Text
transformId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CancelMLTaskRunResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The status for this run.
cancelMLTaskRunResponse_status :: Lens.Lens' CancelMLTaskRunResponse (Prelude.Maybe TaskStatusType)
cancelMLTaskRunResponse_status :: Lens' CancelMLTaskRunResponse (Maybe TaskStatusType)
cancelMLTaskRunResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelMLTaskRunResponse' {Maybe TaskStatusType
status :: Maybe TaskStatusType
$sel:status:CancelMLTaskRunResponse' :: CancelMLTaskRunResponse -> Maybe TaskStatusType
status} -> Maybe TaskStatusType
status) (\s :: CancelMLTaskRunResponse
s@CancelMLTaskRunResponse' {} Maybe TaskStatusType
a -> CancelMLTaskRunResponse
s {$sel:status:CancelMLTaskRunResponse' :: Maybe TaskStatusType
status = Maybe TaskStatusType
a} :: CancelMLTaskRunResponse)

-- | The unique identifier for the task run.
cancelMLTaskRunResponse_taskRunId :: Lens.Lens' CancelMLTaskRunResponse (Prelude.Maybe Prelude.Text)
cancelMLTaskRunResponse_taskRunId :: Lens' CancelMLTaskRunResponse (Maybe Text)
cancelMLTaskRunResponse_taskRunId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelMLTaskRunResponse' {Maybe Text
taskRunId :: Maybe Text
$sel:taskRunId:CancelMLTaskRunResponse' :: CancelMLTaskRunResponse -> Maybe Text
taskRunId} -> Maybe Text
taskRunId) (\s :: CancelMLTaskRunResponse
s@CancelMLTaskRunResponse' {} Maybe Text
a -> CancelMLTaskRunResponse
s {$sel:taskRunId:CancelMLTaskRunResponse' :: Maybe Text
taskRunId = Maybe Text
a} :: CancelMLTaskRunResponse)

-- | The unique identifier of the machine learning transform.
cancelMLTaskRunResponse_transformId :: Lens.Lens' CancelMLTaskRunResponse (Prelude.Maybe Prelude.Text)
cancelMLTaskRunResponse_transformId :: Lens' CancelMLTaskRunResponse (Maybe Text)
cancelMLTaskRunResponse_transformId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelMLTaskRunResponse' {Maybe Text
transformId :: Maybe Text
$sel:transformId:CancelMLTaskRunResponse' :: CancelMLTaskRunResponse -> Maybe Text
transformId} -> Maybe Text
transformId) (\s :: CancelMLTaskRunResponse
s@CancelMLTaskRunResponse' {} Maybe Text
a -> CancelMLTaskRunResponse
s {$sel:transformId:CancelMLTaskRunResponse' :: Maybe Text
transformId = Maybe Text
a} :: CancelMLTaskRunResponse)

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

instance Prelude.NFData CancelMLTaskRunResponse where
  rnf :: CancelMLTaskRunResponse -> ()
rnf CancelMLTaskRunResponse' {Int
Maybe Text
Maybe TaskStatusType
httpStatus :: Int
transformId :: Maybe Text
taskRunId :: Maybe Text
status :: Maybe TaskStatusType
$sel:httpStatus:CancelMLTaskRunResponse' :: CancelMLTaskRunResponse -> Int
$sel:transformId:CancelMLTaskRunResponse' :: CancelMLTaskRunResponse -> Maybe Text
$sel:taskRunId:CancelMLTaskRunResponse' :: CancelMLTaskRunResponse -> Maybe Text
$sel:status:CancelMLTaskRunResponse' :: CancelMLTaskRunResponse -> Maybe TaskStatusType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe TaskStatusType
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
taskRunId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
transformId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus