{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.Step
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.EMR.Types.Step 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.ActionOnFailure
import Amazonka.EMR.Types.HadoopStepConfig
import Amazonka.EMR.Types.StepStatus
import qualified Amazonka.Prelude as Prelude

-- | This represents a step in a cluster.
--
-- /See:/ 'newStep' smart constructor.
data Step = Step'
  { -- | The action to take when the cluster step fails. Possible values are
    -- @TERMINATE_CLUSTER@, @CANCEL_AND_WAIT@, and @CONTINUE@.
    -- @TERMINATE_JOB_FLOW@ is provided for backward compatibility. We
    -- recommend using @TERMINATE_CLUSTER@ instead.
    --
    -- If a cluster\'s @StepConcurrencyLevel@ is greater than @1@, do not use
    -- @AddJobFlowSteps@ to submit a step with this parameter set to
    -- @CANCEL_AND_WAIT@ or @TERMINATE_CLUSTER@. The step is not submitted and
    -- the action fails with a message that the @ActionOnFailure@ setting is
    -- not valid.
    --
    -- If you change a cluster\'s @StepConcurrencyLevel@ to be greater than 1
    -- while a step is running, the @ActionOnFailure@ parameter may not behave
    -- as you expect. In this case, for a step that fails with this parameter
    -- set to @CANCEL_AND_WAIT@, pending steps and the running step are not
    -- canceled; for a step that fails with this parameter set to
    -- @TERMINATE_CLUSTER@, the cluster does not terminate.
    Step -> Maybe ActionOnFailure
actionOnFailure :: Prelude.Maybe ActionOnFailure,
    -- | The Hadoop job configuration of the cluster step.
    Step -> Maybe HadoopStepConfig
config :: Prelude.Maybe HadoopStepConfig,
    -- | The Amazon Resource Name (ARN) of the runtime role for a step on the
    -- cluster. The runtime role can be a cross-account IAM role. The runtime
    -- role ARN is a combination of account ID, role name, and role type using
    -- the following format: @arn:partition:service:region:account:resource@.
    --
    -- For example, @arn:aws:iam::1234567890:role\/ReadOnly@ is a correctly
    -- formatted runtime role ARN.
    Step -> Maybe Text
executionRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the cluster step.
    Step -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The name of the cluster step.
    Step -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The current execution status details of the cluster step.
    Step -> Maybe StepStatus
status :: Prelude.Maybe StepStatus
  }
  deriving (Step -> Step -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c== :: Step -> Step -> Bool
Prelude.Eq, ReadPrec [Step]
ReadPrec Step
Int -> ReadS Step
ReadS [Step]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Step]
$creadListPrec :: ReadPrec [Step]
readPrec :: ReadPrec Step
$creadPrec :: ReadPrec Step
readList :: ReadS [Step]
$creadList :: ReadS [Step]
readsPrec :: Int -> ReadS Step
$creadsPrec :: Int -> ReadS Step
Prelude.Read, Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Step] -> ShowS
$cshowList :: [Step] -> ShowS
show :: Step -> String
$cshow :: Step -> String
showsPrec :: Int -> Step -> ShowS
$cshowsPrec :: Int -> Step -> ShowS
Prelude.Show, forall x. Rep Step x -> Step
forall x. Step -> Rep Step x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Step x -> Step
$cfrom :: forall x. Step -> Rep Step x
Prelude.Generic)

-- |
-- Create a value of 'Step' 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:
--
-- 'actionOnFailure', 'step_actionOnFailure' - The action to take when the cluster step fails. Possible values are
-- @TERMINATE_CLUSTER@, @CANCEL_AND_WAIT@, and @CONTINUE@.
-- @TERMINATE_JOB_FLOW@ is provided for backward compatibility. We
-- recommend using @TERMINATE_CLUSTER@ instead.
--
-- If a cluster\'s @StepConcurrencyLevel@ is greater than @1@, do not use
-- @AddJobFlowSteps@ to submit a step with this parameter set to
-- @CANCEL_AND_WAIT@ or @TERMINATE_CLUSTER@. The step is not submitted and
-- the action fails with a message that the @ActionOnFailure@ setting is
-- not valid.
--
-- If you change a cluster\'s @StepConcurrencyLevel@ to be greater than 1
-- while a step is running, the @ActionOnFailure@ parameter may not behave
-- as you expect. In this case, for a step that fails with this parameter
-- set to @CANCEL_AND_WAIT@, pending steps and the running step are not
-- canceled; for a step that fails with this parameter set to
-- @TERMINATE_CLUSTER@, the cluster does not terminate.
--
-- 'config', 'step_config' - The Hadoop job configuration of the cluster step.
--
-- 'executionRoleArn', 'step_executionRoleArn' - The Amazon Resource Name (ARN) of the runtime role for a step on the
-- cluster. The runtime role can be a cross-account IAM role. The runtime
-- role ARN is a combination of account ID, role name, and role type using
-- the following format: @arn:partition:service:region:account:resource@.
--
-- For example, @arn:aws:iam::1234567890:role\/ReadOnly@ is a correctly
-- formatted runtime role ARN.
--
-- 'id', 'step_id' - The identifier of the cluster step.
--
-- 'name', 'step_name' - The name of the cluster step.
--
-- 'status', 'step_status' - The current execution status details of the cluster step.
newStep ::
  Step
newStep :: Step
newStep =
  Step'
    { $sel:actionOnFailure:Step' :: Maybe ActionOnFailure
actionOnFailure = forall a. Maybe a
Prelude.Nothing,
      $sel:config:Step' :: Maybe HadoopStepConfig
config = forall a. Maybe a
Prelude.Nothing,
      $sel:executionRoleArn:Step' :: Maybe Text
executionRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Step' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Step' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Step' :: Maybe StepStatus
status = forall a. Maybe a
Prelude.Nothing
    }

-- | The action to take when the cluster step fails. Possible values are
-- @TERMINATE_CLUSTER@, @CANCEL_AND_WAIT@, and @CONTINUE@.
-- @TERMINATE_JOB_FLOW@ is provided for backward compatibility. We
-- recommend using @TERMINATE_CLUSTER@ instead.
--
-- If a cluster\'s @StepConcurrencyLevel@ is greater than @1@, do not use
-- @AddJobFlowSteps@ to submit a step with this parameter set to
-- @CANCEL_AND_WAIT@ or @TERMINATE_CLUSTER@. The step is not submitted and
-- the action fails with a message that the @ActionOnFailure@ setting is
-- not valid.
--
-- If you change a cluster\'s @StepConcurrencyLevel@ to be greater than 1
-- while a step is running, the @ActionOnFailure@ parameter may not behave
-- as you expect. In this case, for a step that fails with this parameter
-- set to @CANCEL_AND_WAIT@, pending steps and the running step are not
-- canceled; for a step that fails with this parameter set to
-- @TERMINATE_CLUSTER@, the cluster does not terminate.
step_actionOnFailure :: Lens.Lens' Step (Prelude.Maybe ActionOnFailure)
step_actionOnFailure :: Lens' Step (Maybe ActionOnFailure)
step_actionOnFailure = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Step' {Maybe ActionOnFailure
actionOnFailure :: Maybe ActionOnFailure
$sel:actionOnFailure:Step' :: Step -> Maybe ActionOnFailure
actionOnFailure} -> Maybe ActionOnFailure
actionOnFailure) (\s :: Step
s@Step' {} Maybe ActionOnFailure
a -> Step
s {$sel:actionOnFailure:Step' :: Maybe ActionOnFailure
actionOnFailure = Maybe ActionOnFailure
a} :: Step)

-- | The Hadoop job configuration of the cluster step.
step_config :: Lens.Lens' Step (Prelude.Maybe HadoopStepConfig)
step_config :: Lens' Step (Maybe HadoopStepConfig)
step_config = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Step' {Maybe HadoopStepConfig
config :: Maybe HadoopStepConfig
$sel:config:Step' :: Step -> Maybe HadoopStepConfig
config} -> Maybe HadoopStepConfig
config) (\s :: Step
s@Step' {} Maybe HadoopStepConfig
a -> Step
s {$sel:config:Step' :: Maybe HadoopStepConfig
config = Maybe HadoopStepConfig
a} :: Step)

-- | The Amazon Resource Name (ARN) of the runtime role for a step on the
-- cluster. The runtime role can be a cross-account IAM role. The runtime
-- role ARN is a combination of account ID, role name, and role type using
-- the following format: @arn:partition:service:region:account:resource@.
--
-- For example, @arn:aws:iam::1234567890:role\/ReadOnly@ is a correctly
-- formatted runtime role ARN.
step_executionRoleArn :: Lens.Lens' Step (Prelude.Maybe Prelude.Text)
step_executionRoleArn :: Lens' Step (Maybe Text)
step_executionRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Step' {Maybe Text
executionRoleArn :: Maybe Text
$sel:executionRoleArn:Step' :: Step -> Maybe Text
executionRoleArn} -> Maybe Text
executionRoleArn) (\s :: Step
s@Step' {} Maybe Text
a -> Step
s {$sel:executionRoleArn:Step' :: Maybe Text
executionRoleArn = Maybe Text
a} :: Step)

-- | The identifier of the cluster step.
step_id :: Lens.Lens' Step (Prelude.Maybe Prelude.Text)
step_id :: Lens' Step (Maybe Text)
step_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Step' {Maybe Text
id :: Maybe Text
$sel:id:Step' :: Step -> Maybe Text
id} -> Maybe Text
id) (\s :: Step
s@Step' {} Maybe Text
a -> Step
s {$sel:id:Step' :: Maybe Text
id = Maybe Text
a} :: Step)

-- | The name of the cluster step.
step_name :: Lens.Lens' Step (Prelude.Maybe Prelude.Text)
step_name :: Lens' Step (Maybe Text)
step_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Step' {Maybe Text
name :: Maybe Text
$sel:name:Step' :: Step -> Maybe Text
name} -> Maybe Text
name) (\s :: Step
s@Step' {} Maybe Text
a -> Step
s {$sel:name:Step' :: Maybe Text
name = Maybe Text
a} :: Step)

-- | The current execution status details of the cluster step.
step_status :: Lens.Lens' Step (Prelude.Maybe StepStatus)
step_status :: Lens' Step (Maybe StepStatus)
step_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Step' {Maybe StepStatus
status :: Maybe StepStatus
$sel:status:Step' :: Step -> Maybe StepStatus
status} -> Maybe StepStatus
status) (\s :: Step
s@Step' {} Maybe StepStatus
a -> Step
s {$sel:status:Step' :: Maybe StepStatus
status = Maybe StepStatus
a} :: Step)

instance Data.FromJSON Step where
  parseJSON :: Value -> Parser Step
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Step"
      ( \Object
x ->
          Maybe ActionOnFailure
-> Maybe HadoopStepConfig
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe StepStatus
-> Step
Step'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ActionOnFailure")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Config")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ExecutionRoleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Status")
      )

instance Prelude.Hashable Step where
  hashWithSalt :: Int -> Step -> Int
hashWithSalt Int
_salt Step' {Maybe Text
Maybe ActionOnFailure
Maybe HadoopStepConfig
Maybe StepStatus
status :: Maybe StepStatus
name :: Maybe Text
id :: Maybe Text
executionRoleArn :: Maybe Text
config :: Maybe HadoopStepConfig
actionOnFailure :: Maybe ActionOnFailure
$sel:status:Step' :: Step -> Maybe StepStatus
$sel:name:Step' :: Step -> Maybe Text
$sel:id:Step' :: Step -> Maybe Text
$sel:executionRoleArn:Step' :: Step -> Maybe Text
$sel:config:Step' :: Step -> Maybe HadoopStepConfig
$sel:actionOnFailure:Step' :: Step -> Maybe ActionOnFailure
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ActionOnFailure
actionOnFailure
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HadoopStepConfig
config
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
executionRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StepStatus
status

instance Prelude.NFData Step where
  rnf :: Step -> ()
rnf Step' {Maybe Text
Maybe ActionOnFailure
Maybe HadoopStepConfig
Maybe StepStatus
status :: Maybe StepStatus
name :: Maybe Text
id :: Maybe Text
executionRoleArn :: Maybe Text
config :: Maybe HadoopStepConfig
actionOnFailure :: Maybe ActionOnFailure
$sel:status:Step' :: Step -> Maybe StepStatus
$sel:name:Step' :: Step -> Maybe Text
$sel:id:Step' :: Step -> Maybe Text
$sel:executionRoleArn:Step' :: Step -> Maybe Text
$sel:config:Step' :: Step -> Maybe HadoopStepConfig
$sel:actionOnFailure:Step' :: Step -> Maybe ActionOnFailure
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ActionOnFailure
actionOnFailure
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HadoopStepConfig
config
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
executionRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StepStatus
status