{-# 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.SetTerminationProtection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- SetTerminationProtection locks a cluster (job flow) so the EC2 instances
-- in the cluster cannot be terminated by user intervention, an API call,
-- or in the event of a job-flow error. The cluster still terminates upon
-- successful completion of the job flow. Calling
-- @SetTerminationProtection@ on a cluster is similar to calling the Amazon
-- EC2 @DisableAPITermination@ API on all EC2 instances in a cluster.
--
-- @SetTerminationProtection@ is used to prevent accidental termination of
-- a cluster and to ensure that in the event of an error, the instances
-- persist so that you can recover any data stored in their ephemeral
-- instance storage.
--
-- To terminate a cluster that has been locked by setting
-- @SetTerminationProtection@ to @true@, you must first unlock the job flow
-- by a subsequent call to @SetTerminationProtection@ in which you set the
-- value to @false@.
--
-- For more information,
-- see<https://docs.aws.amazon.com/emr/latest/ManagementGuide/UsingEMR_TerminationProtection.html Managing Cluster Termination>
-- in the /Amazon EMR Management Guide/.
module Amazonka.EMR.SetTerminationProtection
  ( -- * Creating a Request
    SetTerminationProtection (..),
    newSetTerminationProtection,

    -- * Request Lenses
    setTerminationProtection_jobFlowIds,
    setTerminationProtection_terminationProtected,

    -- * Destructuring the Response
    SetTerminationProtectionResponse (..),
    newSetTerminationProtectionResponse,
  )
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 TerminationProtection operation.
--
-- /See:/ 'newSetTerminationProtection' smart constructor.
data SetTerminationProtection = SetTerminationProtection'
  { -- | A list of strings that uniquely identify the clusters to protect. This
    -- identifier is returned by RunJobFlow and can also be obtained from
    -- DescribeJobFlows .
    SetTerminationProtection -> [Text]
jobFlowIds :: [Prelude.Text],
    -- | A Boolean that indicates whether to protect the cluster and prevent the
    -- Amazon EC2 instances in the cluster from shutting down due to API calls,
    -- user intervention, or job-flow error.
    SetTerminationProtection -> Bool
terminationProtected :: Prelude.Bool
  }
  deriving (SetTerminationProtection -> SetTerminationProtection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetTerminationProtection -> SetTerminationProtection -> Bool
$c/= :: SetTerminationProtection -> SetTerminationProtection -> Bool
== :: SetTerminationProtection -> SetTerminationProtection -> Bool
$c== :: SetTerminationProtection -> SetTerminationProtection -> Bool
Prelude.Eq, ReadPrec [SetTerminationProtection]
ReadPrec SetTerminationProtection
Int -> ReadS SetTerminationProtection
ReadS [SetTerminationProtection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetTerminationProtection]
$creadListPrec :: ReadPrec [SetTerminationProtection]
readPrec :: ReadPrec SetTerminationProtection
$creadPrec :: ReadPrec SetTerminationProtection
readList :: ReadS [SetTerminationProtection]
$creadList :: ReadS [SetTerminationProtection]
readsPrec :: Int -> ReadS SetTerminationProtection
$creadsPrec :: Int -> ReadS SetTerminationProtection
Prelude.Read, Int -> SetTerminationProtection -> ShowS
[SetTerminationProtection] -> ShowS
SetTerminationProtection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetTerminationProtection] -> ShowS
$cshowList :: [SetTerminationProtection] -> ShowS
show :: SetTerminationProtection -> String
$cshow :: SetTerminationProtection -> String
showsPrec :: Int -> SetTerminationProtection -> ShowS
$cshowsPrec :: Int -> SetTerminationProtection -> ShowS
Prelude.Show, forall x.
Rep SetTerminationProtection x -> SetTerminationProtection
forall x.
SetTerminationProtection -> Rep SetTerminationProtection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetTerminationProtection x -> SetTerminationProtection
$cfrom :: forall x.
SetTerminationProtection -> Rep SetTerminationProtection x
Prelude.Generic)

-- |
-- Create a value of 'SetTerminationProtection' 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', 'setTerminationProtection_jobFlowIds' - A list of strings that uniquely identify the clusters to protect. This
-- identifier is returned by RunJobFlow and can also be obtained from
-- DescribeJobFlows .
--
-- 'terminationProtected', 'setTerminationProtection_terminationProtected' - A Boolean that indicates whether to protect the cluster and prevent the
-- Amazon EC2 instances in the cluster from shutting down due to API calls,
-- user intervention, or job-flow error.
newSetTerminationProtection ::
  -- | 'terminationProtected'
  Prelude.Bool ->
  SetTerminationProtection
newSetTerminationProtection :: Bool -> SetTerminationProtection
newSetTerminationProtection Bool
pTerminationProtected_ =
  SetTerminationProtection'
    { $sel:jobFlowIds:SetTerminationProtection' :: [Text]
jobFlowIds =
        forall a. Monoid a => a
Prelude.mempty,
      $sel:terminationProtected:SetTerminationProtection' :: Bool
terminationProtected = Bool
pTerminationProtected_
    }

-- | A list of strings that uniquely identify the clusters to protect. This
-- identifier is returned by RunJobFlow and can also be obtained from
-- DescribeJobFlows .
setTerminationProtection_jobFlowIds :: Lens.Lens' SetTerminationProtection [Prelude.Text]
setTerminationProtection_jobFlowIds :: Lens' SetTerminationProtection [Text]
setTerminationProtection_jobFlowIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetTerminationProtection' {[Text]
jobFlowIds :: [Text]
$sel:jobFlowIds:SetTerminationProtection' :: SetTerminationProtection -> [Text]
jobFlowIds} -> [Text]
jobFlowIds) (\s :: SetTerminationProtection
s@SetTerminationProtection' {} [Text]
a -> SetTerminationProtection
s {$sel:jobFlowIds:SetTerminationProtection' :: [Text]
jobFlowIds = [Text]
a} :: SetTerminationProtection) 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

-- | A Boolean that indicates whether to protect the cluster and prevent the
-- Amazon EC2 instances in the cluster from shutting down due to API calls,
-- user intervention, or job-flow error.
setTerminationProtection_terminationProtected :: Lens.Lens' SetTerminationProtection Prelude.Bool
setTerminationProtection_terminationProtected :: Lens' SetTerminationProtection Bool
setTerminationProtection_terminationProtected = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetTerminationProtection' {Bool
terminationProtected :: Bool
$sel:terminationProtected:SetTerminationProtection' :: SetTerminationProtection -> Bool
terminationProtected} -> Bool
terminationProtected) (\s :: SetTerminationProtection
s@SetTerminationProtection' {} Bool
a -> SetTerminationProtection
s {$sel:terminationProtected:SetTerminationProtection' :: Bool
terminationProtected = Bool
a} :: SetTerminationProtection)

instance Core.AWSRequest SetTerminationProtection where
  type
    AWSResponse SetTerminationProtection =
      SetTerminationProtectionResponse
  request :: (Service -> Service)
-> SetTerminationProtection -> Request SetTerminationProtection
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 SetTerminationProtection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetTerminationProtection)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      SetTerminationProtectionResponse
SetTerminationProtectionResponse'

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

instance Prelude.NFData SetTerminationProtection where
  rnf :: SetTerminationProtection -> ()
rnf SetTerminationProtection' {Bool
[Text]
terminationProtected :: Bool
jobFlowIds :: [Text]
$sel:terminationProtected:SetTerminationProtection' :: SetTerminationProtection -> Bool
$sel:jobFlowIds:SetTerminationProtection' :: SetTerminationProtection -> [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Text]
jobFlowIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
terminationProtected

instance Data.ToHeaders SetTerminationProtection where
  toHeaders :: SetTerminationProtection -> [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.SetTerminationProtection" ::
                          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 SetTerminationProtection where
  toJSON :: SetTerminationProtection -> Value
toJSON SetTerminationProtection' {Bool
[Text]
terminationProtected :: Bool
jobFlowIds :: [Text]
$sel:terminationProtected:SetTerminationProtection' :: SetTerminationProtection -> Bool
$sel:jobFlowIds:SetTerminationProtection' :: SetTerminationProtection -> [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),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"TerminationProtected"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
terminationProtected
              )
          ]
      )

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

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

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

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

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