{-# 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.StepStatus
-- 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.StepStatus 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.FailureDetails
import Amazonka.EMR.Types.StepState
import Amazonka.EMR.Types.StepStateChangeReason
import Amazonka.EMR.Types.StepTimeline
import qualified Amazonka.Prelude as Prelude

-- | The execution status details of the cluster step.
--
-- /See:/ 'newStepStatus' smart constructor.
data StepStatus = StepStatus'
  { -- | The details for the step failure including reason, message, and log file
    -- path where the root cause was identified.
    StepStatus -> Maybe FailureDetails
failureDetails :: Prelude.Maybe FailureDetails,
    -- | The execution state of the cluster step.
    StepStatus -> Maybe StepState
state :: Prelude.Maybe StepState,
    -- | The reason for the step execution status change.
    StepStatus -> Maybe StepStateChangeReason
stateChangeReason :: Prelude.Maybe StepStateChangeReason,
    -- | The timeline of the cluster step status over time.
    StepStatus -> Maybe StepTimeline
timeline :: Prelude.Maybe StepTimeline
  }
  deriving (StepStatus -> StepStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StepStatus -> StepStatus -> Bool
$c/= :: StepStatus -> StepStatus -> Bool
== :: StepStatus -> StepStatus -> Bool
$c== :: StepStatus -> StepStatus -> Bool
Prelude.Eq, ReadPrec [StepStatus]
ReadPrec StepStatus
Int -> ReadS StepStatus
ReadS [StepStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StepStatus]
$creadListPrec :: ReadPrec [StepStatus]
readPrec :: ReadPrec StepStatus
$creadPrec :: ReadPrec StepStatus
readList :: ReadS [StepStatus]
$creadList :: ReadS [StepStatus]
readsPrec :: Int -> ReadS StepStatus
$creadsPrec :: Int -> ReadS StepStatus
Prelude.Read, Int -> StepStatus -> ShowS
[StepStatus] -> ShowS
StepStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StepStatus] -> ShowS
$cshowList :: [StepStatus] -> ShowS
show :: StepStatus -> String
$cshow :: StepStatus -> String
showsPrec :: Int -> StepStatus -> ShowS
$cshowsPrec :: Int -> StepStatus -> ShowS
Prelude.Show, forall x. Rep StepStatus x -> StepStatus
forall x. StepStatus -> Rep StepStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StepStatus x -> StepStatus
$cfrom :: forall x. StepStatus -> Rep StepStatus x
Prelude.Generic)

-- |
-- Create a value of 'StepStatus' 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:
--
-- 'failureDetails', 'stepStatus_failureDetails' - The details for the step failure including reason, message, and log file
-- path where the root cause was identified.
--
-- 'state', 'stepStatus_state' - The execution state of the cluster step.
--
-- 'stateChangeReason', 'stepStatus_stateChangeReason' - The reason for the step execution status change.
--
-- 'timeline', 'stepStatus_timeline' - The timeline of the cluster step status over time.
newStepStatus ::
  StepStatus
newStepStatus :: StepStatus
newStepStatus =
  StepStatus'
    { $sel:failureDetails:StepStatus' :: Maybe FailureDetails
failureDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:state:StepStatus' :: Maybe StepState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:stateChangeReason:StepStatus' :: Maybe StepStateChangeReason
stateChangeReason = forall a. Maybe a
Prelude.Nothing,
      $sel:timeline:StepStatus' :: Maybe StepTimeline
timeline = forall a. Maybe a
Prelude.Nothing
    }

-- | The details for the step failure including reason, message, and log file
-- path where the root cause was identified.
stepStatus_failureDetails :: Lens.Lens' StepStatus (Prelude.Maybe FailureDetails)
stepStatus_failureDetails :: Lens' StepStatus (Maybe FailureDetails)
stepStatus_failureDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepStatus' {Maybe FailureDetails
failureDetails :: Maybe FailureDetails
$sel:failureDetails:StepStatus' :: StepStatus -> Maybe FailureDetails
failureDetails} -> Maybe FailureDetails
failureDetails) (\s :: StepStatus
s@StepStatus' {} Maybe FailureDetails
a -> StepStatus
s {$sel:failureDetails:StepStatus' :: Maybe FailureDetails
failureDetails = Maybe FailureDetails
a} :: StepStatus)

-- | The execution state of the cluster step.
stepStatus_state :: Lens.Lens' StepStatus (Prelude.Maybe StepState)
stepStatus_state :: Lens' StepStatus (Maybe StepState)
stepStatus_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepStatus' {Maybe StepState
state :: Maybe StepState
$sel:state:StepStatus' :: StepStatus -> Maybe StepState
state} -> Maybe StepState
state) (\s :: StepStatus
s@StepStatus' {} Maybe StepState
a -> StepStatus
s {$sel:state:StepStatus' :: Maybe StepState
state = Maybe StepState
a} :: StepStatus)

-- | The reason for the step execution status change.
stepStatus_stateChangeReason :: Lens.Lens' StepStatus (Prelude.Maybe StepStateChangeReason)
stepStatus_stateChangeReason :: Lens' StepStatus (Maybe StepStateChangeReason)
stepStatus_stateChangeReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepStatus' {Maybe StepStateChangeReason
stateChangeReason :: Maybe StepStateChangeReason
$sel:stateChangeReason:StepStatus' :: StepStatus -> Maybe StepStateChangeReason
stateChangeReason} -> Maybe StepStateChangeReason
stateChangeReason) (\s :: StepStatus
s@StepStatus' {} Maybe StepStateChangeReason
a -> StepStatus
s {$sel:stateChangeReason:StepStatus' :: Maybe StepStateChangeReason
stateChangeReason = Maybe StepStateChangeReason
a} :: StepStatus)

-- | The timeline of the cluster step status over time.
stepStatus_timeline :: Lens.Lens' StepStatus (Prelude.Maybe StepTimeline)
stepStatus_timeline :: Lens' StepStatus (Maybe StepTimeline)
stepStatus_timeline = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StepStatus' {Maybe StepTimeline
timeline :: Maybe StepTimeline
$sel:timeline:StepStatus' :: StepStatus -> Maybe StepTimeline
timeline} -> Maybe StepTimeline
timeline) (\s :: StepStatus
s@StepStatus' {} Maybe StepTimeline
a -> StepStatus
s {$sel:timeline:StepStatus' :: Maybe StepTimeline
timeline = Maybe StepTimeline
a} :: StepStatus)

instance Data.FromJSON StepStatus where
  parseJSON :: Value -> Parser StepStatus
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"StepStatus"
      ( \Object
x ->
          Maybe FailureDetails
-> Maybe StepState
-> Maybe StepStateChangeReason
-> Maybe StepTimeline
-> StepStatus
StepStatus'
            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
"FailureDetails")
            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
"State")
            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
"StateChangeReason")
            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
"Timeline")
      )

instance Prelude.Hashable StepStatus where
  hashWithSalt :: Int -> StepStatus -> Int
hashWithSalt Int
_salt StepStatus' {Maybe FailureDetails
Maybe StepState
Maybe StepStateChangeReason
Maybe StepTimeline
timeline :: Maybe StepTimeline
stateChangeReason :: Maybe StepStateChangeReason
state :: Maybe StepState
failureDetails :: Maybe FailureDetails
$sel:timeline:StepStatus' :: StepStatus -> Maybe StepTimeline
$sel:stateChangeReason:StepStatus' :: StepStatus -> Maybe StepStateChangeReason
$sel:state:StepStatus' :: StepStatus -> Maybe StepState
$sel:failureDetails:StepStatus' :: StepStatus -> Maybe FailureDetails
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FailureDetails
failureDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StepState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StepStateChangeReason
stateChangeReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StepTimeline
timeline

instance Prelude.NFData StepStatus where
  rnf :: StepStatus -> ()
rnf StepStatus' {Maybe FailureDetails
Maybe StepState
Maybe StepStateChangeReason
Maybe StepTimeline
timeline :: Maybe StepTimeline
stateChangeReason :: Maybe StepStateChangeReason
state :: Maybe StepState
failureDetails :: Maybe FailureDetails
$sel:timeline:StepStatus' :: StepStatus -> Maybe StepTimeline
$sel:stateChangeReason:StepStatus' :: StepStatus -> Maybe StepStateChangeReason
$sel:state:StepStatus' :: StepStatus -> Maybe StepState
$sel:failureDetails:StepStatus' :: StepStatus -> Maybe FailureDetails
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FailureDetails
failureDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StepState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StepStateChangeReason
stateChangeReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StepTimeline
timeline