{-# 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.EMR.CancelSteps
-- 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 a pending step or steps in a running cluster. Available only in
-- Amazon EMR versions 4.8.0 and later, excluding version 5.0.0. A maximum
-- of 256 steps are allowed in each CancelSteps request. CancelSteps is
-- idempotent but asynchronous; it does not guarantee that a step will be
-- canceled, even if the request is successfully submitted. When you use
-- Amazon EMR versions 5.28.0 and later, you can cancel steps that are in a
-- @PENDING@ or @RUNNING@ state. In earlier versions of Amazon EMR, you can
-- only cancel steps that are in a @PENDING@ state.
module Amazonka.EMR.CancelSteps
  ( -- * Creating a Request
    CancelSteps (..),
    newCancelSteps,

    -- * Request Lenses
    cancelSteps_stepCancellationOption,
    cancelSteps_clusterId,
    cancelSteps_stepIds,

    -- * Destructuring the Response
    CancelStepsResponse (..),
    newCancelStepsResponse,

    -- * Response Lenses
    cancelStepsResponse_cancelStepsInfoList,
    cancelStepsResponse_httpStatus,
  )
where

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

-- | The input argument to the CancelSteps operation.
--
-- /See:/ 'newCancelSteps' smart constructor.
data CancelSteps = CancelSteps'
  { -- | The option to choose to cancel @RUNNING@ steps. By default, the value is
    -- @SEND_INTERRUPT@.
    CancelSteps -> Maybe StepCancellationOption
stepCancellationOption :: Prelude.Maybe StepCancellationOption,
    -- | The @ClusterID@ for the specified steps that will be canceled. Use
    -- RunJobFlow and ListClusters to get ClusterIDs.
    CancelSteps -> Text
clusterId :: Prelude.Text,
    -- | The list of @StepIDs@ to cancel. Use ListSteps to get steps and their
    -- states for the specified cluster.
    CancelSteps -> [Text]
stepIds :: [Prelude.Text]
  }
  deriving (CancelSteps -> CancelSteps -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelSteps -> CancelSteps -> Bool
$c/= :: CancelSteps -> CancelSteps -> Bool
== :: CancelSteps -> CancelSteps -> Bool
$c== :: CancelSteps -> CancelSteps -> Bool
Prelude.Eq, ReadPrec [CancelSteps]
ReadPrec CancelSteps
Int -> ReadS CancelSteps
ReadS [CancelSteps]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelSteps]
$creadListPrec :: ReadPrec [CancelSteps]
readPrec :: ReadPrec CancelSteps
$creadPrec :: ReadPrec CancelSteps
readList :: ReadS [CancelSteps]
$creadList :: ReadS [CancelSteps]
readsPrec :: Int -> ReadS CancelSteps
$creadsPrec :: Int -> ReadS CancelSteps
Prelude.Read, Int -> CancelSteps -> ShowS
[CancelSteps] -> ShowS
CancelSteps -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelSteps] -> ShowS
$cshowList :: [CancelSteps] -> ShowS
show :: CancelSteps -> String
$cshow :: CancelSteps -> String
showsPrec :: Int -> CancelSteps -> ShowS
$cshowsPrec :: Int -> CancelSteps -> ShowS
Prelude.Show, forall x. Rep CancelSteps x -> CancelSteps
forall x. CancelSteps -> Rep CancelSteps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelSteps x -> CancelSteps
$cfrom :: forall x. CancelSteps -> Rep CancelSteps x
Prelude.Generic)

-- |
-- Create a value of 'CancelSteps' 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:
--
-- 'stepCancellationOption', 'cancelSteps_stepCancellationOption' - The option to choose to cancel @RUNNING@ steps. By default, the value is
-- @SEND_INTERRUPT@.
--
-- 'clusterId', 'cancelSteps_clusterId' - The @ClusterID@ for the specified steps that will be canceled. Use
-- RunJobFlow and ListClusters to get ClusterIDs.
--
-- 'stepIds', 'cancelSteps_stepIds' - The list of @StepIDs@ to cancel. Use ListSteps to get steps and their
-- states for the specified cluster.
newCancelSteps ::
  -- | 'clusterId'
  Prelude.Text ->
  CancelSteps
newCancelSteps :: Text -> CancelSteps
newCancelSteps Text
pClusterId_ =
  CancelSteps'
    { $sel:stepCancellationOption:CancelSteps' :: Maybe StepCancellationOption
stepCancellationOption =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clusterId:CancelSteps' :: Text
clusterId = Text
pClusterId_,
      $sel:stepIds:CancelSteps' :: [Text]
stepIds = forall a. Monoid a => a
Prelude.mempty
    }

-- | The option to choose to cancel @RUNNING@ steps. By default, the value is
-- @SEND_INTERRUPT@.
cancelSteps_stepCancellationOption :: Lens.Lens' CancelSteps (Prelude.Maybe StepCancellationOption)
cancelSteps_stepCancellationOption :: Lens' CancelSteps (Maybe StepCancellationOption)
cancelSteps_stepCancellationOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelSteps' {Maybe StepCancellationOption
stepCancellationOption :: Maybe StepCancellationOption
$sel:stepCancellationOption:CancelSteps' :: CancelSteps -> Maybe StepCancellationOption
stepCancellationOption} -> Maybe StepCancellationOption
stepCancellationOption) (\s :: CancelSteps
s@CancelSteps' {} Maybe StepCancellationOption
a -> CancelSteps
s {$sel:stepCancellationOption:CancelSteps' :: Maybe StepCancellationOption
stepCancellationOption = Maybe StepCancellationOption
a} :: CancelSteps)

-- | The @ClusterID@ for the specified steps that will be canceled. Use
-- RunJobFlow and ListClusters to get ClusterIDs.
cancelSteps_clusterId :: Lens.Lens' CancelSteps Prelude.Text
cancelSteps_clusterId :: Lens' CancelSteps Text
cancelSteps_clusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelSteps' {Text
clusterId :: Text
$sel:clusterId:CancelSteps' :: CancelSteps -> Text
clusterId} -> Text
clusterId) (\s :: CancelSteps
s@CancelSteps' {} Text
a -> CancelSteps
s {$sel:clusterId:CancelSteps' :: Text
clusterId = Text
a} :: CancelSteps)

-- | The list of @StepIDs@ to cancel. Use ListSteps to get steps and their
-- states for the specified cluster.
cancelSteps_stepIds :: Lens.Lens' CancelSteps [Prelude.Text]
cancelSteps_stepIds :: Lens' CancelSteps [Text]
cancelSteps_stepIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelSteps' {[Text]
stepIds :: [Text]
$sel:stepIds:CancelSteps' :: CancelSteps -> [Text]
stepIds} -> [Text]
stepIds) (\s :: CancelSteps
s@CancelSteps' {} [Text]
a -> CancelSteps
s {$sel:stepIds:CancelSteps' :: [Text]
stepIds = [Text]
a} :: CancelSteps) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CancelSteps where
  type AWSResponse CancelSteps = CancelStepsResponse
  request :: (Service -> Service) -> CancelSteps -> Request CancelSteps
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 CancelSteps
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CancelSteps)))
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 [CancelStepsInfo] -> Int -> CancelStepsResponse
CancelStepsResponse'
            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
"CancelStepsInfoList"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 CancelSteps where
  hashWithSalt :: Int -> CancelSteps -> Int
hashWithSalt Int
_salt CancelSteps' {[Text]
Maybe StepCancellationOption
Text
stepIds :: [Text]
clusterId :: Text
stepCancellationOption :: Maybe StepCancellationOption
$sel:stepIds:CancelSteps' :: CancelSteps -> [Text]
$sel:clusterId:CancelSteps' :: CancelSteps -> Text
$sel:stepCancellationOption:CancelSteps' :: CancelSteps -> Maybe StepCancellationOption
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StepCancellationOption
stepCancellationOption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
stepIds

instance Prelude.NFData CancelSteps where
  rnf :: CancelSteps -> ()
rnf CancelSteps' {[Text]
Maybe StepCancellationOption
Text
stepIds :: [Text]
clusterId :: Text
stepCancellationOption :: Maybe StepCancellationOption
$sel:stepIds:CancelSteps' :: CancelSteps -> [Text]
$sel:clusterId:CancelSteps' :: CancelSteps -> Text
$sel:stepCancellationOption:CancelSteps' :: CancelSteps -> Maybe StepCancellationOption
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe StepCancellationOption
stepCancellationOption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
stepIds

instance Data.ToHeaders CancelSteps where
  toHeaders :: CancelSteps -> 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
"ElasticMapReduce.CancelSteps" ::
                          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 CancelSteps where
  toJSON :: CancelSteps -> Value
toJSON CancelSteps' {[Text]
Maybe StepCancellationOption
Text
stepIds :: [Text]
clusterId :: Text
stepCancellationOption :: Maybe StepCancellationOption
$sel:stepIds:CancelSteps' :: CancelSteps -> [Text]
$sel:clusterId:CancelSteps' :: CancelSteps -> Text
$sel:stepCancellationOption:CancelSteps' :: CancelSteps -> Maybe StepCancellationOption
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"StepCancellationOption" 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 StepCancellationOption
stepCancellationOption,
            forall a. a -> Maybe a
Prelude.Just (Key
"ClusterId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterId),
            forall a. a -> Maybe a
Prelude.Just (Key
"StepIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
stepIds)
          ]
      )

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

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

-- | The output for the CancelSteps operation.
--
-- /See:/ 'newCancelStepsResponse' smart constructor.
data CancelStepsResponse = CancelStepsResponse'
  { -- | A list of CancelStepsInfo, which shows the status of specified cancel
    -- requests for each @StepID@ specified.
    CancelStepsResponse -> Maybe [CancelStepsInfo]
cancelStepsInfoList :: Prelude.Maybe [CancelStepsInfo],
    -- | The response's http status code.
    CancelStepsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CancelStepsResponse -> CancelStepsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelStepsResponse -> CancelStepsResponse -> Bool
$c/= :: CancelStepsResponse -> CancelStepsResponse -> Bool
== :: CancelStepsResponse -> CancelStepsResponse -> Bool
$c== :: CancelStepsResponse -> CancelStepsResponse -> Bool
Prelude.Eq, ReadPrec [CancelStepsResponse]
ReadPrec CancelStepsResponse
Int -> ReadS CancelStepsResponse
ReadS [CancelStepsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelStepsResponse]
$creadListPrec :: ReadPrec [CancelStepsResponse]
readPrec :: ReadPrec CancelStepsResponse
$creadPrec :: ReadPrec CancelStepsResponse
readList :: ReadS [CancelStepsResponse]
$creadList :: ReadS [CancelStepsResponse]
readsPrec :: Int -> ReadS CancelStepsResponse
$creadsPrec :: Int -> ReadS CancelStepsResponse
Prelude.Read, Int -> CancelStepsResponse -> ShowS
[CancelStepsResponse] -> ShowS
CancelStepsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelStepsResponse] -> ShowS
$cshowList :: [CancelStepsResponse] -> ShowS
show :: CancelStepsResponse -> String
$cshow :: CancelStepsResponse -> String
showsPrec :: Int -> CancelStepsResponse -> ShowS
$cshowsPrec :: Int -> CancelStepsResponse -> ShowS
Prelude.Show, forall x. Rep CancelStepsResponse x -> CancelStepsResponse
forall x. CancelStepsResponse -> Rep CancelStepsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelStepsResponse x -> CancelStepsResponse
$cfrom :: forall x. CancelStepsResponse -> Rep CancelStepsResponse x
Prelude.Generic)

-- |
-- Create a value of 'CancelStepsResponse' 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:
--
-- 'cancelStepsInfoList', 'cancelStepsResponse_cancelStepsInfoList' - A list of CancelStepsInfo, which shows the status of specified cancel
-- requests for each @StepID@ specified.
--
-- 'httpStatus', 'cancelStepsResponse_httpStatus' - The response's http status code.
newCancelStepsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CancelStepsResponse
newCancelStepsResponse :: Int -> CancelStepsResponse
newCancelStepsResponse Int
pHttpStatus_ =
  CancelStepsResponse'
    { $sel:cancelStepsInfoList:CancelStepsResponse' :: Maybe [CancelStepsInfo]
cancelStepsInfoList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CancelStepsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of CancelStepsInfo, which shows the status of specified cancel
-- requests for each @StepID@ specified.
cancelStepsResponse_cancelStepsInfoList :: Lens.Lens' CancelStepsResponse (Prelude.Maybe [CancelStepsInfo])
cancelStepsResponse_cancelStepsInfoList :: Lens' CancelStepsResponse (Maybe [CancelStepsInfo])
cancelStepsResponse_cancelStepsInfoList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelStepsResponse' {Maybe [CancelStepsInfo]
cancelStepsInfoList :: Maybe [CancelStepsInfo]
$sel:cancelStepsInfoList:CancelStepsResponse' :: CancelStepsResponse -> Maybe [CancelStepsInfo]
cancelStepsInfoList} -> Maybe [CancelStepsInfo]
cancelStepsInfoList) (\s :: CancelStepsResponse
s@CancelStepsResponse' {} Maybe [CancelStepsInfo]
a -> CancelStepsResponse
s {$sel:cancelStepsInfoList:CancelStepsResponse' :: Maybe [CancelStepsInfo]
cancelStepsInfoList = Maybe [CancelStepsInfo]
a} :: CancelStepsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData CancelStepsResponse where
  rnf :: CancelStepsResponse -> ()
rnf CancelStepsResponse' {Int
Maybe [CancelStepsInfo]
httpStatus :: Int
cancelStepsInfoList :: Maybe [CancelStepsInfo]
$sel:httpStatus:CancelStepsResponse' :: CancelStepsResponse -> Int
$sel:cancelStepsInfoList:CancelStepsResponse' :: CancelStepsResponse -> Maybe [CancelStepsInfo]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CancelStepsInfo]
cancelStepsInfoList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus