-- | To specify how AWS CloudFormation handles rolling updates for an Auto
-- Scaling group, use the AutoScalingRollingUpdatePolicy policy.

module Stratosphere.ResourceAttributes.AutoScalingRollingUpdatePolicy where

import Stratosphere.Prelude
import Stratosphere.Property
import Stratosphere.Value

import qualified Data.Aeson as JSON

-- | Full data type definition for AutoScalingRollingUpdatePolicy. See
-- 'mkAutoScalingRollingUpdatePolicy' for a more convenient constructor.
data AutoScalingRollingUpdatePolicy = AutoScalingRollingUpdatePolicy
  { AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
maxBatchSize                  :: Maybe (Value Integer)
  , AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minInstancesInService         :: Maybe (Value Integer)
  , AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
  , AutoScalingRollingUpdatePolicy -> Maybe (Value Text)
pauseTime                     :: Maybe (Value Text)
  , AutoScalingRollingUpdatePolicy -> Maybe (ValueList Text)
suspendProcesses              :: Maybe (ValueList Text)
  , AutoScalingRollingUpdatePolicy -> Maybe (Value Bool)
waitOnResourceSignals         :: Maybe (Value Bool)
  }
  deriving (Int -> AutoScalingRollingUpdatePolicy -> ShowS
[AutoScalingRollingUpdatePolicy] -> ShowS
AutoScalingRollingUpdatePolicy -> String
(Int -> AutoScalingRollingUpdatePolicy -> ShowS)
-> (AutoScalingRollingUpdatePolicy -> String)
-> ([AutoScalingRollingUpdatePolicy] -> ShowS)
-> Show AutoScalingRollingUpdatePolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AutoScalingRollingUpdatePolicy -> ShowS
showsPrec :: Int -> AutoScalingRollingUpdatePolicy -> ShowS
$cshow :: AutoScalingRollingUpdatePolicy -> String
show :: AutoScalingRollingUpdatePolicy -> String
$cshowList :: [AutoScalingRollingUpdatePolicy] -> ShowS
showList :: [AutoScalingRollingUpdatePolicy] -> ShowS
Show, AutoScalingRollingUpdatePolicy
-> AutoScalingRollingUpdatePolicy -> Bool
(AutoScalingRollingUpdatePolicy
 -> AutoScalingRollingUpdatePolicy -> Bool)
-> (AutoScalingRollingUpdatePolicy
    -> AutoScalingRollingUpdatePolicy -> Bool)
-> Eq AutoScalingRollingUpdatePolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutoScalingRollingUpdatePolicy
-> AutoScalingRollingUpdatePolicy -> Bool
== :: AutoScalingRollingUpdatePolicy
-> AutoScalingRollingUpdatePolicy -> Bool
$c/= :: AutoScalingRollingUpdatePolicy
-> AutoScalingRollingUpdatePolicy -> Bool
/= :: AutoScalingRollingUpdatePolicy
-> AutoScalingRollingUpdatePolicy -> Bool
Eq)

instance Property "MaxBatchSize" AutoScalingRollingUpdatePolicy where
  type PropertyType "MaxBatchSize" AutoScalingRollingUpdatePolicy = Value Integer
  set :: PropertyType "MaxBatchSize" AutoScalingRollingUpdatePolicy
-> AutoScalingRollingUpdatePolicy -> AutoScalingRollingUpdatePolicy
set PropertyType "MaxBatchSize" AutoScalingRollingUpdatePolicy
newValue AutoScalingRollingUpdatePolicy{Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
maxBatchSize :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minInstancesInService :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minSuccessfulInstancesPercent :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
pauseTime :: AutoScalingRollingUpdatePolicy -> Maybe (Value Text)
suspendProcesses :: AutoScalingRollingUpdatePolicy -> Maybe (ValueList Text)
waitOnResourceSignals :: AutoScalingRollingUpdatePolicy -> Maybe (Value Bool)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
..}
    = AutoScalingRollingUpdatePolicy
    { maxBatchSize :: Maybe (Value Integer)
maxBatchSize = Value Integer -> Maybe (Value Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PropertyType "MaxBatchSize" AutoScalingRollingUpdatePolicy
Value Integer
newValue
    , Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
..
    }

instance Property "MinInstancesInService" AutoScalingRollingUpdatePolicy where
  type PropertyType "MinInstancesInService" AutoScalingRollingUpdatePolicy = Value Integer
  set :: PropertyType "MinInstancesInService" AutoScalingRollingUpdatePolicy
-> AutoScalingRollingUpdatePolicy -> AutoScalingRollingUpdatePolicy
set PropertyType "MinInstancesInService" AutoScalingRollingUpdatePolicy
newValue AutoScalingRollingUpdatePolicy{Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
maxBatchSize :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minInstancesInService :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minSuccessfulInstancesPercent :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
pauseTime :: AutoScalingRollingUpdatePolicy -> Maybe (Value Text)
suspendProcesses :: AutoScalingRollingUpdatePolicy -> Maybe (ValueList Text)
waitOnResourceSignals :: AutoScalingRollingUpdatePolicy -> Maybe (Value Bool)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
..}
    = AutoScalingRollingUpdatePolicy
    { minInstancesInService :: Maybe (Value Integer)
minInstancesInService = Value Integer -> Maybe (Value Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PropertyType "MinInstancesInService" AutoScalingRollingUpdatePolicy
Value Integer
newValue
    , Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
maxBatchSize :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
maxBatchSize :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
..
    }

instance Property "MinSuccessfulInstancesPercent" AutoScalingRollingUpdatePolicy where
  type PropertyType "MinSuccessfulInstancesPercent" AutoScalingRollingUpdatePolicy = Value Integer
  set :: PropertyType
  "MinSuccessfulInstancesPercent" AutoScalingRollingUpdatePolicy
-> AutoScalingRollingUpdatePolicy -> AutoScalingRollingUpdatePolicy
set PropertyType
  "MinSuccessfulInstancesPercent" AutoScalingRollingUpdatePolicy
newValue AutoScalingRollingUpdatePolicy{Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
maxBatchSize :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minInstancesInService :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minSuccessfulInstancesPercent :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
pauseTime :: AutoScalingRollingUpdatePolicy -> Maybe (Value Text)
suspendProcesses :: AutoScalingRollingUpdatePolicy -> Maybe (ValueList Text)
waitOnResourceSignals :: AutoScalingRollingUpdatePolicy -> Maybe (Value Bool)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
..}
    = AutoScalingRollingUpdatePolicy
    { minSuccessfulInstancesPercent :: Maybe (Value Integer)
minSuccessfulInstancesPercent = Value Integer -> Maybe (Value Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PropertyType
  "MinSuccessfulInstancesPercent" AutoScalingRollingUpdatePolicy
Value Integer
newValue
    , Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
..
    }

instance Property "PauseTime" AutoScalingRollingUpdatePolicy where
  type PropertyType "PauseTime" AutoScalingRollingUpdatePolicy = Value Text
  set :: PropertyType "PauseTime" AutoScalingRollingUpdatePolicy
-> AutoScalingRollingUpdatePolicy -> AutoScalingRollingUpdatePolicy
set PropertyType "PauseTime" AutoScalingRollingUpdatePolicy
newValue AutoScalingRollingUpdatePolicy{Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
maxBatchSize :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minInstancesInService :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minSuccessfulInstancesPercent :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
pauseTime :: AutoScalingRollingUpdatePolicy -> Maybe (Value Text)
suspendProcesses :: AutoScalingRollingUpdatePolicy -> Maybe (ValueList Text)
waitOnResourceSignals :: AutoScalingRollingUpdatePolicy -> Maybe (Value Bool)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
..}
    = AutoScalingRollingUpdatePolicy
    { pauseTime :: Maybe (Value Text)
pauseTime = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PropertyType "PauseTime" AutoScalingRollingUpdatePolicy
Value Text
newValue
    , Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
..
    }

instance Property "SuspendProcesses" AutoScalingRollingUpdatePolicy where
  type PropertyType "SuspendProcesses" AutoScalingRollingUpdatePolicy = ValueList Text
  set :: PropertyType "SuspendProcesses" AutoScalingRollingUpdatePolicy
-> AutoScalingRollingUpdatePolicy -> AutoScalingRollingUpdatePolicy
set PropertyType "SuspendProcesses" AutoScalingRollingUpdatePolicy
newValue AutoScalingRollingUpdatePolicy{Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
maxBatchSize :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minInstancesInService :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minSuccessfulInstancesPercent :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
pauseTime :: AutoScalingRollingUpdatePolicy -> Maybe (Value Text)
suspendProcesses :: AutoScalingRollingUpdatePolicy -> Maybe (ValueList Text)
waitOnResourceSignals :: AutoScalingRollingUpdatePolicy -> Maybe (Value Bool)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
..}
    = AutoScalingRollingUpdatePolicy
    { suspendProcesses :: Maybe (ValueList Text)
suspendProcesses = ValueList Text -> Maybe (ValueList Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PropertyType "SuspendProcesses" AutoScalingRollingUpdatePolicy
ValueList Text
newValue
    , Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
waitOnResourceSignals :: Maybe (Value Bool)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
waitOnResourceSignals :: Maybe (Value Bool)
..
    }

instance Property "WaitOnResourceSignals" AutoScalingRollingUpdatePolicy where
  type PropertyType "WaitOnResourceSignals" AutoScalingRollingUpdatePolicy = Value Bool
  set :: PropertyType "WaitOnResourceSignals" AutoScalingRollingUpdatePolicy
-> AutoScalingRollingUpdatePolicy -> AutoScalingRollingUpdatePolicy
set PropertyType "WaitOnResourceSignals" AutoScalingRollingUpdatePolicy
newValue AutoScalingRollingUpdatePolicy{Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
maxBatchSize :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minInstancesInService :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minSuccessfulInstancesPercent :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
pauseTime :: AutoScalingRollingUpdatePolicy -> Maybe (Value Text)
suspendProcesses :: AutoScalingRollingUpdatePolicy -> Maybe (ValueList Text)
waitOnResourceSignals :: AutoScalingRollingUpdatePolicy -> Maybe (Value Bool)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
..}
    = AutoScalingRollingUpdatePolicy
    { waitOnResourceSignals :: Maybe (Value Bool)
waitOnResourceSignals = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PropertyType "WaitOnResourceSignals" AutoScalingRollingUpdatePolicy
Value Bool
newValue
    , Maybe (ValueList Text)
Maybe (Value Integer)
Maybe (Value Text)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
..
    }

instance JSON.ToJSON AutoScalingRollingUpdatePolicy where
  toJSON :: AutoScalingRollingUpdatePolicy -> Value
toJSON AutoScalingRollingUpdatePolicy{Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
maxBatchSize :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minInstancesInService :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
minSuccessfulInstancesPercent :: AutoScalingRollingUpdatePolicy -> Maybe (Value Integer)
pauseTime :: AutoScalingRollingUpdatePolicy -> Maybe (Value Text)
suspendProcesses :: AutoScalingRollingUpdatePolicy -> Maybe (ValueList Text)
waitOnResourceSignals :: AutoScalingRollingUpdatePolicy -> Maybe (Value Bool)
maxBatchSize :: Maybe (Value Integer)
minInstancesInService :: Maybe (Value Integer)
minSuccessfulInstancesPercent :: Maybe (Value Integer)
pauseTime :: Maybe (Value Text)
suspendProcesses :: Maybe (ValueList Text)
waitOnResourceSignals :: Maybe (Value Bool)
..}
    = [Pair] -> Value
JSON.object
    ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
    [ (Value Integer -> Pair) -> Maybe (Value Integer) -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"MaxBatchSize",) (Value -> Pair)
-> (Value Integer -> Value) -> Value Integer -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value Integer -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON) Maybe (Value Integer)
maxBatchSize
    , (Value Integer -> Pair) -> Maybe (Value Integer) -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"MinInstancesInService",) (Value -> Pair)
-> (Value Integer -> Value) -> Value Integer -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value Integer -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON) Maybe (Value Integer)
minInstancesInService
    , (Value Integer -> Pair) -> Maybe (Value Integer) -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"MinSuccessfulInstancesPercent",) (Value -> Pair)
-> (Value Integer -> Value) -> Value Integer -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value Integer -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON) Maybe (Value Integer)
minSuccessfulInstancesPercent
    , (Value Text -> Pair) -> Maybe (Value Text) -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"PauseTime",) (Value -> Pair) -> (Value Text -> Value) -> Value Text -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON) Maybe (Value Text)
pauseTime
    , (ValueList Text -> Pair) -> Maybe (ValueList Text) -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"SuspendProcesses",) (Value -> Pair)
-> (ValueList Text -> Value) -> ValueList Text -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueList Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON) Maybe (ValueList Text)
suspendProcesses
    , (Value Bool -> Pair) -> Maybe (Value Bool) -> Maybe Pair
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key
"WaitOnResourceSignals",) (Value -> Pair) -> (Value Bool -> Value) -> Value Bool -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value Bool -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON) Maybe (Value Bool)
waitOnResourceSignals
    ]

-- | Constructor for 'AutoScalingRollingUpdatePolicy' containing required fields as
-- arguments.
mkAutoScalingRollingUpdatePolicy :: AutoScalingRollingUpdatePolicy
mkAutoScalingRollingUpdatePolicy :: AutoScalingRollingUpdatePolicy
mkAutoScalingRollingUpdatePolicy
  = AutoScalingRollingUpdatePolicy
  { maxBatchSize :: Maybe (Value Integer)
maxBatchSize                  = Maybe (Value Integer)
forall a. Maybe a
Nothing
  , minInstancesInService :: Maybe (Value Integer)
minInstancesInService         = Maybe (Value Integer)
forall a. Maybe a
Nothing
  , minSuccessfulInstancesPercent :: Maybe (Value Integer)
minSuccessfulInstancesPercent = Maybe (Value Integer)
forall a. Maybe a
Nothing
  , pauseTime :: Maybe (Value Text)
pauseTime                     = Maybe (Value Text)
forall a. Maybe a
Nothing
  , suspendProcesses :: Maybe (ValueList Text)
suspendProcesses              = Maybe (ValueList Text)
forall a. Maybe a
Nothing
  , waitOnResourceSignals :: Maybe (Value Bool)
waitOnResourceSignals         = Maybe (Value Bool)
forall a. Maybe a
Nothing
  }