{-# 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.CodePipeline.Types.StageState
-- 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.CodePipeline.Types.StageState where

import Amazonka.CodePipeline.Types.ActionState
import Amazonka.CodePipeline.Types.StageExecution
import Amazonka.CodePipeline.Types.TransitionState
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | Represents information about the state of the stage.
--
-- /See:/ 'newStageState' smart constructor.
data StageState = StageState'
  { -- | The state of the stage.
    StageState -> Maybe [ActionState]
actionStates :: Prelude.Maybe [ActionState],
    StageState -> Maybe StageExecution
inboundExecution :: Prelude.Maybe StageExecution,
    -- | The state of the inbound transition, which is either enabled or
    -- disabled.
    StageState -> Maybe TransitionState
inboundTransitionState :: Prelude.Maybe TransitionState,
    -- | Information about the latest execution in the stage, including its ID
    -- and status.
    StageState -> Maybe StageExecution
latestExecution :: Prelude.Maybe StageExecution,
    -- | The name of the stage.
    StageState -> Maybe Text
stageName :: Prelude.Maybe Prelude.Text
  }
  deriving (StageState -> StageState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StageState -> StageState -> Bool
$c/= :: StageState -> StageState -> Bool
== :: StageState -> StageState -> Bool
$c== :: StageState -> StageState -> Bool
Prelude.Eq, ReadPrec [StageState]
ReadPrec StageState
Int -> ReadS StageState
ReadS [StageState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StageState]
$creadListPrec :: ReadPrec [StageState]
readPrec :: ReadPrec StageState
$creadPrec :: ReadPrec StageState
readList :: ReadS [StageState]
$creadList :: ReadS [StageState]
readsPrec :: Int -> ReadS StageState
$creadsPrec :: Int -> ReadS StageState
Prelude.Read, Int -> StageState -> ShowS
[StageState] -> ShowS
StageState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StageState] -> ShowS
$cshowList :: [StageState] -> ShowS
show :: StageState -> String
$cshow :: StageState -> String
showsPrec :: Int -> StageState -> ShowS
$cshowsPrec :: Int -> StageState -> ShowS
Prelude.Show, forall x. Rep StageState x -> StageState
forall x. StageState -> Rep StageState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StageState x -> StageState
$cfrom :: forall x. StageState -> Rep StageState x
Prelude.Generic)

-- |
-- Create a value of 'StageState' 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:
--
-- 'actionStates', 'stageState_actionStates' - The state of the stage.
--
-- 'inboundExecution', 'stageState_inboundExecution' - Undocumented member.
--
-- 'inboundTransitionState', 'stageState_inboundTransitionState' - The state of the inbound transition, which is either enabled or
-- disabled.
--
-- 'latestExecution', 'stageState_latestExecution' - Information about the latest execution in the stage, including its ID
-- and status.
--
-- 'stageName', 'stageState_stageName' - The name of the stage.
newStageState ::
  StageState
newStageState :: StageState
newStageState =
  StageState'
    { $sel:actionStates:StageState' :: Maybe [ActionState]
actionStates = forall a. Maybe a
Prelude.Nothing,
      $sel:inboundExecution:StageState' :: Maybe StageExecution
inboundExecution = forall a. Maybe a
Prelude.Nothing,
      $sel:inboundTransitionState:StageState' :: Maybe TransitionState
inboundTransitionState = forall a. Maybe a
Prelude.Nothing,
      $sel:latestExecution:StageState' :: Maybe StageExecution
latestExecution = forall a. Maybe a
Prelude.Nothing,
      $sel:stageName:StageState' :: Maybe Text
stageName = forall a. Maybe a
Prelude.Nothing
    }

-- | The state of the stage.
stageState_actionStates :: Lens.Lens' StageState (Prelude.Maybe [ActionState])
stageState_actionStates :: Lens' StageState (Maybe [ActionState])
stageState_actionStates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StageState' {Maybe [ActionState]
actionStates :: Maybe [ActionState]
$sel:actionStates:StageState' :: StageState -> Maybe [ActionState]
actionStates} -> Maybe [ActionState]
actionStates) (\s :: StageState
s@StageState' {} Maybe [ActionState]
a -> StageState
s {$sel:actionStates:StageState' :: Maybe [ActionState]
actionStates = Maybe [ActionState]
a} :: StageState) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Undocumented member.
stageState_inboundExecution :: Lens.Lens' StageState (Prelude.Maybe StageExecution)
stageState_inboundExecution :: Lens' StageState (Maybe StageExecution)
stageState_inboundExecution = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StageState' {Maybe StageExecution
inboundExecution :: Maybe StageExecution
$sel:inboundExecution:StageState' :: StageState -> Maybe StageExecution
inboundExecution} -> Maybe StageExecution
inboundExecution) (\s :: StageState
s@StageState' {} Maybe StageExecution
a -> StageState
s {$sel:inboundExecution:StageState' :: Maybe StageExecution
inboundExecution = Maybe StageExecution
a} :: StageState)

-- | The state of the inbound transition, which is either enabled or
-- disabled.
stageState_inboundTransitionState :: Lens.Lens' StageState (Prelude.Maybe TransitionState)
stageState_inboundTransitionState :: Lens' StageState (Maybe TransitionState)
stageState_inboundTransitionState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StageState' {Maybe TransitionState
inboundTransitionState :: Maybe TransitionState
$sel:inboundTransitionState:StageState' :: StageState -> Maybe TransitionState
inboundTransitionState} -> Maybe TransitionState
inboundTransitionState) (\s :: StageState
s@StageState' {} Maybe TransitionState
a -> StageState
s {$sel:inboundTransitionState:StageState' :: Maybe TransitionState
inboundTransitionState = Maybe TransitionState
a} :: StageState)

-- | Information about the latest execution in the stage, including its ID
-- and status.
stageState_latestExecution :: Lens.Lens' StageState (Prelude.Maybe StageExecution)
stageState_latestExecution :: Lens' StageState (Maybe StageExecution)
stageState_latestExecution = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StageState' {Maybe StageExecution
latestExecution :: Maybe StageExecution
$sel:latestExecution:StageState' :: StageState -> Maybe StageExecution
latestExecution} -> Maybe StageExecution
latestExecution) (\s :: StageState
s@StageState' {} Maybe StageExecution
a -> StageState
s {$sel:latestExecution:StageState' :: Maybe StageExecution
latestExecution = Maybe StageExecution
a} :: StageState)

-- | The name of the stage.
stageState_stageName :: Lens.Lens' StageState (Prelude.Maybe Prelude.Text)
stageState_stageName :: Lens' StageState (Maybe Text)
stageState_stageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StageState' {Maybe Text
stageName :: Maybe Text
$sel:stageName:StageState' :: StageState -> Maybe Text
stageName} -> Maybe Text
stageName) (\s :: StageState
s@StageState' {} Maybe Text
a -> StageState
s {$sel:stageName:StageState' :: Maybe Text
stageName = Maybe Text
a} :: StageState)

instance Data.FromJSON StageState where
  parseJSON :: Value -> Parser StageState
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"StageState"
      ( \Object
x ->
          Maybe [ActionState]
-> Maybe StageExecution
-> Maybe TransitionState
-> Maybe StageExecution
-> Maybe Text
-> StageState
StageState'
            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
"actionStates" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            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
"inboundExecution")
            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
"inboundTransitionState")
            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
"latestExecution")
            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
"stageName")
      )

instance Prelude.Hashable StageState where
  hashWithSalt :: Int -> StageState -> Int
hashWithSalt Int
_salt StageState' {Maybe [ActionState]
Maybe Text
Maybe StageExecution
Maybe TransitionState
stageName :: Maybe Text
latestExecution :: Maybe StageExecution
inboundTransitionState :: Maybe TransitionState
inboundExecution :: Maybe StageExecution
actionStates :: Maybe [ActionState]
$sel:stageName:StageState' :: StageState -> Maybe Text
$sel:latestExecution:StageState' :: StageState -> Maybe StageExecution
$sel:inboundTransitionState:StageState' :: StageState -> Maybe TransitionState
$sel:inboundExecution:StageState' :: StageState -> Maybe StageExecution
$sel:actionStates:StageState' :: StageState -> Maybe [ActionState]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ActionState]
actionStates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StageExecution
inboundExecution
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TransitionState
inboundTransitionState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StageExecution
latestExecution
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stageName

instance Prelude.NFData StageState where
  rnf :: StageState -> ()
rnf StageState' {Maybe [ActionState]
Maybe Text
Maybe StageExecution
Maybe TransitionState
stageName :: Maybe Text
latestExecution :: Maybe StageExecution
inboundTransitionState :: Maybe TransitionState
inboundExecution :: Maybe StageExecution
actionStates :: Maybe [ActionState]
$sel:stageName:StageState' :: StageState -> Maybe Text
$sel:latestExecution:StageState' :: StageState -> Maybe StageExecution
$sel:inboundTransitionState:StageState' :: StageState -> Maybe TransitionState
$sel:inboundExecution:StageState' :: StageState -> Maybe StageExecution
$sel:actionStates:StageState' :: StageState -> Maybe [ActionState]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ActionState]
actionStates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StageExecution
inboundExecution
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TransitionState
inboundTransitionState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StageExecution
latestExecution
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stageName