{-# 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.ClusterStatus
-- 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.ClusterStatus 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.ClusterState
import Amazonka.EMR.Types.ClusterStateChangeReason
import Amazonka.EMR.Types.ClusterTimeline
import qualified Amazonka.Prelude as Prelude

-- | The detailed status of the cluster.
--
-- /See:/ 'newClusterStatus' smart constructor.
data ClusterStatus = ClusterStatus'
  { -- | The current state of the cluster.
    ClusterStatus -> Maybe ClusterState
state :: Prelude.Maybe ClusterState,
    -- | The reason for the cluster status change.
    ClusterStatus -> Maybe ClusterStateChangeReason
stateChangeReason :: Prelude.Maybe ClusterStateChangeReason,
    -- | A timeline that represents the status of a cluster over the lifetime of
    -- the cluster.
    ClusterStatus -> Maybe ClusterTimeline
timeline :: Prelude.Maybe ClusterTimeline
  }
  deriving (ClusterStatus -> ClusterStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterStatus -> ClusterStatus -> Bool
$c/= :: ClusterStatus -> ClusterStatus -> Bool
== :: ClusterStatus -> ClusterStatus -> Bool
$c== :: ClusterStatus -> ClusterStatus -> Bool
Prelude.Eq, ReadPrec [ClusterStatus]
ReadPrec ClusterStatus
Int -> ReadS ClusterStatus
ReadS [ClusterStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClusterStatus]
$creadListPrec :: ReadPrec [ClusterStatus]
readPrec :: ReadPrec ClusterStatus
$creadPrec :: ReadPrec ClusterStatus
readList :: ReadS [ClusterStatus]
$creadList :: ReadS [ClusterStatus]
readsPrec :: Int -> ReadS ClusterStatus
$creadsPrec :: Int -> ReadS ClusterStatus
Prelude.Read, Int -> ClusterStatus -> ShowS
[ClusterStatus] -> ShowS
ClusterStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterStatus] -> ShowS
$cshowList :: [ClusterStatus] -> ShowS
show :: ClusterStatus -> String
$cshow :: ClusterStatus -> String
showsPrec :: Int -> ClusterStatus -> ShowS
$cshowsPrec :: Int -> ClusterStatus -> ShowS
Prelude.Show, forall x. Rep ClusterStatus x -> ClusterStatus
forall x. ClusterStatus -> Rep ClusterStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClusterStatus x -> ClusterStatus
$cfrom :: forall x. ClusterStatus -> Rep ClusterStatus x
Prelude.Generic)

-- |
-- Create a value of 'ClusterStatus' 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:
--
-- 'state', 'clusterStatus_state' - The current state of the cluster.
--
-- 'stateChangeReason', 'clusterStatus_stateChangeReason' - The reason for the cluster status change.
--
-- 'timeline', 'clusterStatus_timeline' - A timeline that represents the status of a cluster over the lifetime of
-- the cluster.
newClusterStatus ::
  ClusterStatus
newClusterStatus :: ClusterStatus
newClusterStatus =
  ClusterStatus'
    { $sel:state:ClusterStatus' :: Maybe ClusterState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:stateChangeReason:ClusterStatus' :: Maybe ClusterStateChangeReason
stateChangeReason = forall a. Maybe a
Prelude.Nothing,
      $sel:timeline:ClusterStatus' :: Maybe ClusterTimeline
timeline = forall a. Maybe a
Prelude.Nothing
    }

-- | The current state of the cluster.
clusterStatus_state :: Lens.Lens' ClusterStatus (Prelude.Maybe ClusterState)
clusterStatus_state :: Lens' ClusterStatus (Maybe ClusterState)
clusterStatus_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterStatus' {Maybe ClusterState
state :: Maybe ClusterState
$sel:state:ClusterStatus' :: ClusterStatus -> Maybe ClusterState
state} -> Maybe ClusterState
state) (\s :: ClusterStatus
s@ClusterStatus' {} Maybe ClusterState
a -> ClusterStatus
s {$sel:state:ClusterStatus' :: Maybe ClusterState
state = Maybe ClusterState
a} :: ClusterStatus)

-- | The reason for the cluster status change.
clusterStatus_stateChangeReason :: Lens.Lens' ClusterStatus (Prelude.Maybe ClusterStateChangeReason)
clusterStatus_stateChangeReason :: Lens' ClusterStatus (Maybe ClusterStateChangeReason)
clusterStatus_stateChangeReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterStatus' {Maybe ClusterStateChangeReason
stateChangeReason :: Maybe ClusterStateChangeReason
$sel:stateChangeReason:ClusterStatus' :: ClusterStatus -> Maybe ClusterStateChangeReason
stateChangeReason} -> Maybe ClusterStateChangeReason
stateChangeReason) (\s :: ClusterStatus
s@ClusterStatus' {} Maybe ClusterStateChangeReason
a -> ClusterStatus
s {$sel:stateChangeReason:ClusterStatus' :: Maybe ClusterStateChangeReason
stateChangeReason = Maybe ClusterStateChangeReason
a} :: ClusterStatus)

-- | A timeline that represents the status of a cluster over the lifetime of
-- the cluster.
clusterStatus_timeline :: Lens.Lens' ClusterStatus (Prelude.Maybe ClusterTimeline)
clusterStatus_timeline :: Lens' ClusterStatus (Maybe ClusterTimeline)
clusterStatus_timeline = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterStatus' {Maybe ClusterTimeline
timeline :: Maybe ClusterTimeline
$sel:timeline:ClusterStatus' :: ClusterStatus -> Maybe ClusterTimeline
timeline} -> Maybe ClusterTimeline
timeline) (\s :: ClusterStatus
s@ClusterStatus' {} Maybe ClusterTimeline
a -> ClusterStatus
s {$sel:timeline:ClusterStatus' :: Maybe ClusterTimeline
timeline = Maybe ClusterTimeline
a} :: ClusterStatus)

instance Data.FromJSON ClusterStatus where
  parseJSON :: Value -> Parser ClusterStatus
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ClusterStatus"
      ( \Object
x ->
          Maybe ClusterState
-> Maybe ClusterStateChangeReason
-> Maybe ClusterTimeline
-> ClusterStatus
ClusterStatus'
            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
"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 ClusterStatus where
  hashWithSalt :: Int -> ClusterStatus -> Int
hashWithSalt Int
_salt ClusterStatus' {Maybe ClusterState
Maybe ClusterStateChangeReason
Maybe ClusterTimeline
timeline :: Maybe ClusterTimeline
stateChangeReason :: Maybe ClusterStateChangeReason
state :: Maybe ClusterState
$sel:timeline:ClusterStatus' :: ClusterStatus -> Maybe ClusterTimeline
$sel:stateChangeReason:ClusterStatus' :: ClusterStatus -> Maybe ClusterStateChangeReason
$sel:state:ClusterStatus' :: ClusterStatus -> Maybe ClusterState
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClusterState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClusterStateChangeReason
stateChangeReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClusterTimeline
timeline

instance Prelude.NFData ClusterStatus where
  rnf :: ClusterStatus -> ()
rnf ClusterStatus' {Maybe ClusterState
Maybe ClusterStateChangeReason
Maybe ClusterTimeline
timeline :: Maybe ClusterTimeline
stateChangeReason :: Maybe ClusterStateChangeReason
state :: Maybe ClusterState
$sel:timeline:ClusterStatus' :: ClusterStatus -> Maybe ClusterTimeline
$sel:stateChangeReason:ClusterStatus' :: ClusterStatus -> Maybe ClusterStateChangeReason
$sel:state:ClusterStatus' :: ClusterStatus -> Maybe ClusterState
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ClusterState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClusterStateChangeReason
stateChangeReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClusterTimeline
timeline