{-# 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.TerminateJobFlows
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- TerminateJobFlows shuts a list of clusters (job flows) down. When a job
-- flow is shut down, any step not yet completed is canceled and the EC2
-- instances on which the cluster is running are stopped. Any log files not
-- already saved are uploaded to Amazon S3 if a LogUri was specified when
-- the cluster was created.
--
-- The maximum number of clusters allowed is 10. The call to
-- @TerminateJobFlows@ is asynchronous. Depending on the configuration of
-- the cluster, it may take up to 1-5 minutes for the cluster to completely
-- terminate and release allocated resources, such as Amazon EC2 instances.
module Amazonka.EMR.TerminateJobFlows
  ( -- * Creating a Request
    TerminateJobFlows (..),
    newTerminateJobFlows,

    -- * Request Lenses
    terminateJobFlows_jobFlowIds,

    -- * Destructuring the Response
    TerminateJobFlowsResponse (..),
    newTerminateJobFlowsResponse,
  )
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

-- | Input to the TerminateJobFlows operation.
--
-- /See:/ 'newTerminateJobFlows' smart constructor.
data TerminateJobFlows = TerminateJobFlows'
  { -- | A list of job flows to be shut down.
    TerminateJobFlows -> [Text]
jobFlowIds :: [Prelude.Text]
  }
  deriving (TerminateJobFlows -> TerminateJobFlows -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TerminateJobFlows -> TerminateJobFlows -> Bool
$c/= :: TerminateJobFlows -> TerminateJobFlows -> Bool
== :: TerminateJobFlows -> TerminateJobFlows -> Bool
$c== :: TerminateJobFlows -> TerminateJobFlows -> Bool
Prelude.Eq, ReadPrec [TerminateJobFlows]
ReadPrec TerminateJobFlows
Int -> ReadS TerminateJobFlows
ReadS [TerminateJobFlows]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TerminateJobFlows]
$creadListPrec :: ReadPrec [TerminateJobFlows]
readPrec :: ReadPrec TerminateJobFlows
$creadPrec :: ReadPrec TerminateJobFlows
readList :: ReadS [TerminateJobFlows]
$creadList :: ReadS [TerminateJobFlows]
readsPrec :: Int -> ReadS TerminateJobFlows
$creadsPrec :: Int -> ReadS TerminateJobFlows
Prelude.Read, Int -> TerminateJobFlows -> ShowS
[TerminateJobFlows] -> ShowS
TerminateJobFlows -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TerminateJobFlows] -> ShowS
$cshowList :: [TerminateJobFlows] -> ShowS
show :: TerminateJobFlows -> String
$cshow :: TerminateJobFlows -> String
showsPrec :: Int -> TerminateJobFlows -> ShowS
$cshowsPrec :: Int -> TerminateJobFlows -> ShowS
Prelude.Show, forall x. Rep TerminateJobFlows x -> TerminateJobFlows
forall x. TerminateJobFlows -> Rep TerminateJobFlows x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TerminateJobFlows x -> TerminateJobFlows
$cfrom :: forall x. TerminateJobFlows -> Rep TerminateJobFlows x
Prelude.Generic)

-- |
-- Create a value of 'TerminateJobFlows' 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:
--
-- 'jobFlowIds', 'terminateJobFlows_jobFlowIds' - A list of job flows to be shut down.
newTerminateJobFlows ::
  TerminateJobFlows
newTerminateJobFlows :: TerminateJobFlows
newTerminateJobFlows =
  TerminateJobFlows' {$sel:jobFlowIds:TerminateJobFlows' :: [Text]
jobFlowIds = forall a. Monoid a => a
Prelude.mempty}

-- | A list of job flows to be shut down.
terminateJobFlows_jobFlowIds :: Lens.Lens' TerminateJobFlows [Prelude.Text]
terminateJobFlows_jobFlowIds :: Lens' TerminateJobFlows [Text]
terminateJobFlows_jobFlowIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TerminateJobFlows' {[Text]
jobFlowIds :: [Text]
$sel:jobFlowIds:TerminateJobFlows' :: TerminateJobFlows -> [Text]
jobFlowIds} -> [Text]
jobFlowIds) (\s :: TerminateJobFlows
s@TerminateJobFlows' {} [Text]
a -> TerminateJobFlows
s {$sel:jobFlowIds:TerminateJobFlows' :: [Text]
jobFlowIds = [Text]
a} :: TerminateJobFlows) 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 TerminateJobFlows where
  type
    AWSResponse TerminateJobFlows =
      TerminateJobFlowsResponse
  request :: (Service -> Service)
-> TerminateJobFlows -> Request TerminateJobFlows
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 TerminateJobFlows
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse TerminateJobFlows)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull TerminateJobFlowsResponse
TerminateJobFlowsResponse'

instance Prelude.Hashable TerminateJobFlows where
  hashWithSalt :: Int -> TerminateJobFlows -> Int
hashWithSalt Int
_salt TerminateJobFlows' {[Text]
jobFlowIds :: [Text]
$sel:jobFlowIds:TerminateJobFlows' :: TerminateJobFlows -> [Text]
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
jobFlowIds

instance Prelude.NFData TerminateJobFlows where
  rnf :: TerminateJobFlows -> ()
rnf TerminateJobFlows' {[Text]
jobFlowIds :: [Text]
$sel:jobFlowIds:TerminateJobFlows' :: TerminateJobFlows -> [Text]
..} = forall a. NFData a => a -> ()
Prelude.rnf [Text]
jobFlowIds

instance Data.ToHeaders TerminateJobFlows where
  toHeaders :: TerminateJobFlows -> [Header]
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 -> [Header]
Data.=# ( ByteString
"ElasticMapReduce.TerminateJobFlows" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON TerminateJobFlows where
  toJSON :: TerminateJobFlows -> Value
toJSON TerminateJobFlows' {[Text]
jobFlowIds :: [Text]
$sel:jobFlowIds:TerminateJobFlows' :: TerminateJobFlows -> [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"JobFlowIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
jobFlowIds)]
      )

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

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

-- | /See:/ 'newTerminateJobFlowsResponse' smart constructor.
data TerminateJobFlowsResponse = TerminateJobFlowsResponse'
  {
  }
  deriving (TerminateJobFlowsResponse -> TerminateJobFlowsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TerminateJobFlowsResponse -> TerminateJobFlowsResponse -> Bool
$c/= :: TerminateJobFlowsResponse -> TerminateJobFlowsResponse -> Bool
== :: TerminateJobFlowsResponse -> TerminateJobFlowsResponse -> Bool
$c== :: TerminateJobFlowsResponse -> TerminateJobFlowsResponse -> Bool
Prelude.Eq, ReadPrec [TerminateJobFlowsResponse]
ReadPrec TerminateJobFlowsResponse
Int -> ReadS TerminateJobFlowsResponse
ReadS [TerminateJobFlowsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TerminateJobFlowsResponse]
$creadListPrec :: ReadPrec [TerminateJobFlowsResponse]
readPrec :: ReadPrec TerminateJobFlowsResponse
$creadPrec :: ReadPrec TerminateJobFlowsResponse
readList :: ReadS [TerminateJobFlowsResponse]
$creadList :: ReadS [TerminateJobFlowsResponse]
readsPrec :: Int -> ReadS TerminateJobFlowsResponse
$creadsPrec :: Int -> ReadS TerminateJobFlowsResponse
Prelude.Read, Int -> TerminateJobFlowsResponse -> ShowS
[TerminateJobFlowsResponse] -> ShowS
TerminateJobFlowsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TerminateJobFlowsResponse] -> ShowS
$cshowList :: [TerminateJobFlowsResponse] -> ShowS
show :: TerminateJobFlowsResponse -> String
$cshow :: TerminateJobFlowsResponse -> String
showsPrec :: Int -> TerminateJobFlowsResponse -> ShowS
$cshowsPrec :: Int -> TerminateJobFlowsResponse -> ShowS
Prelude.Show, forall x.
Rep TerminateJobFlowsResponse x -> TerminateJobFlowsResponse
forall x.
TerminateJobFlowsResponse -> Rep TerminateJobFlowsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TerminateJobFlowsResponse x -> TerminateJobFlowsResponse
$cfrom :: forall x.
TerminateJobFlowsResponse -> Rep TerminateJobFlowsResponse x
Prelude.Generic)

-- |
-- Create a value of 'TerminateJobFlowsResponse' 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.
newTerminateJobFlowsResponse ::
  TerminateJobFlowsResponse
newTerminateJobFlowsResponse :: TerminateJobFlowsResponse
newTerminateJobFlowsResponse =
  TerminateJobFlowsResponse
TerminateJobFlowsResponse'

instance Prelude.NFData TerminateJobFlowsResponse where
  rnf :: TerminateJobFlowsResponse -> ()
rnf TerminateJobFlowsResponse
_ = ()