module Stratosphere.CodeDeploy.DeploymentConfig.ZonalConfigProperty (
        module Exports, ZonalConfigProperty(..), mkZonalConfigProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.CodeDeploy.DeploymentConfig.MinimumHealthyHostsPerZoneProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data ZonalConfigProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codedeploy-deploymentconfig-zonalconfig.html>
    ZonalConfigProperty {ZonalConfigProperty -> ()
haddock_workaround_ :: (),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codedeploy-deploymentconfig-zonalconfig.html#cfn-codedeploy-deploymentconfig-zonalconfig-firstzonemonitordurationinseconds>
                         ZonalConfigProperty -> Maybe (Value Integer)
firstZoneMonitorDurationInSeconds :: (Prelude.Maybe (Value Prelude.Integer)),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codedeploy-deploymentconfig-zonalconfig.html#cfn-codedeploy-deploymentconfig-zonalconfig-minimumhealthyhostsperzone>
                         ZonalConfigProperty -> Maybe MinimumHealthyHostsPerZoneProperty
minimumHealthyHostsPerZone :: (Prelude.Maybe MinimumHealthyHostsPerZoneProperty),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codedeploy-deploymentconfig-zonalconfig.html#cfn-codedeploy-deploymentconfig-zonalconfig-monitordurationinseconds>
                         ZonalConfigProperty -> Maybe (Value Integer)
monitorDurationInSeconds :: (Prelude.Maybe (Value Prelude.Integer))}
  deriving stock (ZonalConfigProperty -> ZonalConfigProperty -> Bool
(ZonalConfigProperty -> ZonalConfigProperty -> Bool)
-> (ZonalConfigProperty -> ZonalConfigProperty -> Bool)
-> Eq ZonalConfigProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ZonalConfigProperty -> ZonalConfigProperty -> Bool
== :: ZonalConfigProperty -> ZonalConfigProperty -> Bool
$c/= :: ZonalConfigProperty -> ZonalConfigProperty -> Bool
/= :: ZonalConfigProperty -> ZonalConfigProperty -> Bool
Prelude.Eq, Int -> ZonalConfigProperty -> ShowS
[ZonalConfigProperty] -> ShowS
ZonalConfigProperty -> String
(Int -> ZonalConfigProperty -> ShowS)
-> (ZonalConfigProperty -> String)
-> ([ZonalConfigProperty] -> ShowS)
-> Show ZonalConfigProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ZonalConfigProperty -> ShowS
showsPrec :: Int -> ZonalConfigProperty -> ShowS
$cshow :: ZonalConfigProperty -> String
show :: ZonalConfigProperty -> String
$cshowList :: [ZonalConfigProperty] -> ShowS
showList :: [ZonalConfigProperty] -> ShowS
Prelude.Show)
mkZonalConfigProperty :: ZonalConfigProperty
mkZonalConfigProperty :: ZonalConfigProperty
mkZonalConfigProperty
  = ZonalConfigProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (),
       firstZoneMonitorDurationInSeconds :: Maybe (Value Integer)
firstZoneMonitorDurationInSeconds = Maybe (Value Integer)
forall a. Maybe a
Prelude.Nothing,
       minimumHealthyHostsPerZone :: Maybe MinimumHealthyHostsPerZoneProperty
minimumHealthyHostsPerZone = Maybe MinimumHealthyHostsPerZoneProperty
forall a. Maybe a
Prelude.Nothing,
       monitorDurationInSeconds :: Maybe (Value Integer)
monitorDurationInSeconds = Maybe (Value Integer)
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties ZonalConfigProperty where
  toResourceProperties :: ZonalConfigProperty -> ResourceProperties
toResourceProperties ZonalConfigProperty {Maybe (Value Integer)
Maybe MinimumHealthyHostsPerZoneProperty
()
haddock_workaround_ :: ZonalConfigProperty -> ()
firstZoneMonitorDurationInSeconds :: ZonalConfigProperty -> Maybe (Value Integer)
minimumHealthyHostsPerZone :: ZonalConfigProperty -> Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: ZonalConfigProperty -> Maybe (Value Integer)
haddock_workaround_ :: ()
firstZoneMonitorDurationInSeconds :: Maybe (Value Integer)
minimumHealthyHostsPerZone :: Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: Maybe (Value Integer)
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::CodeDeploy::DeploymentConfig.ZonalConfig",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                           [Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"FirstZoneMonitorDurationInSeconds"
                              (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
firstZoneMonitorDurationInSeconds,
                            Key -> MinimumHealthyHostsPerZoneProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MinimumHealthyHostsPerZone"
                              (MinimumHealthyHostsPerZoneProperty -> (Key, Value))
-> Maybe MinimumHealthyHostsPerZoneProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MinimumHealthyHostsPerZoneProperty
minimumHealthyHostsPerZone,
                            Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MonitorDurationInSeconds"
                              (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
monitorDurationInSeconds])}
instance JSON.ToJSON ZonalConfigProperty where
  toJSON :: ZonalConfigProperty -> Value
toJSON ZonalConfigProperty {Maybe (Value Integer)
Maybe MinimumHealthyHostsPerZoneProperty
()
haddock_workaround_ :: ZonalConfigProperty -> ()
firstZoneMonitorDurationInSeconds :: ZonalConfigProperty -> Maybe (Value Integer)
minimumHealthyHostsPerZone :: ZonalConfigProperty -> Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: ZonalConfigProperty -> Maybe (Value Integer)
haddock_workaround_ :: ()
firstZoneMonitorDurationInSeconds :: Maybe (Value Integer)
minimumHealthyHostsPerZone :: Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: Maybe (Value Integer)
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
              [Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"FirstZoneMonitorDurationInSeconds"
                 (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
firstZoneMonitorDurationInSeconds,
               Key -> MinimumHealthyHostsPerZoneProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MinimumHealthyHostsPerZone"
                 (MinimumHealthyHostsPerZoneProperty -> (Key, Value))
-> Maybe MinimumHealthyHostsPerZoneProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MinimumHealthyHostsPerZoneProperty
minimumHealthyHostsPerZone,
               Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MonitorDurationInSeconds"
                 (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
monitorDurationInSeconds]))
instance Property "FirstZoneMonitorDurationInSeconds" ZonalConfigProperty where
  type PropertyType "FirstZoneMonitorDurationInSeconds" ZonalConfigProperty = Value Prelude.Integer
  set :: PropertyType
  "FirstZoneMonitorDurationInSeconds" ZonalConfigProperty
-> ZonalConfigProperty -> ZonalConfigProperty
set PropertyType
  "FirstZoneMonitorDurationInSeconds" ZonalConfigProperty
newValue ZonalConfigProperty {Maybe (Value Integer)
Maybe MinimumHealthyHostsPerZoneProperty
()
haddock_workaround_ :: ZonalConfigProperty -> ()
firstZoneMonitorDurationInSeconds :: ZonalConfigProperty -> Maybe (Value Integer)
minimumHealthyHostsPerZone :: ZonalConfigProperty -> Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: ZonalConfigProperty -> Maybe (Value Integer)
haddock_workaround_ :: ()
firstZoneMonitorDurationInSeconds :: Maybe (Value Integer)
minimumHealthyHostsPerZone :: Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: Maybe (Value Integer)
..}
    = ZonalConfigProperty
        {firstZoneMonitorDurationInSeconds :: Maybe (Value Integer)
firstZoneMonitorDurationInSeconds = Value Integer -> Maybe (Value Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "FirstZoneMonitorDurationInSeconds" ZonalConfigProperty
Value Integer
newValue, Maybe (Value Integer)
Maybe MinimumHealthyHostsPerZoneProperty
()
haddock_workaround_ :: ()
minimumHealthyHostsPerZone :: Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: Maybe (Value Integer)
haddock_workaround_ :: ()
minimumHealthyHostsPerZone :: Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: Maybe (Value Integer)
..}
instance Property "MinimumHealthyHostsPerZone" ZonalConfigProperty where
  type PropertyType "MinimumHealthyHostsPerZone" ZonalConfigProperty = MinimumHealthyHostsPerZoneProperty
  set :: PropertyType "MinimumHealthyHostsPerZone" ZonalConfigProperty
-> ZonalConfigProperty -> ZonalConfigProperty
set PropertyType "MinimumHealthyHostsPerZone" ZonalConfigProperty
newValue ZonalConfigProperty {Maybe (Value Integer)
Maybe MinimumHealthyHostsPerZoneProperty
()
haddock_workaround_ :: ZonalConfigProperty -> ()
firstZoneMonitorDurationInSeconds :: ZonalConfigProperty -> Maybe (Value Integer)
minimumHealthyHostsPerZone :: ZonalConfigProperty -> Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: ZonalConfigProperty -> Maybe (Value Integer)
haddock_workaround_ :: ()
firstZoneMonitorDurationInSeconds :: Maybe (Value Integer)
minimumHealthyHostsPerZone :: Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: Maybe (Value Integer)
..}
    = ZonalConfigProperty
        {minimumHealthyHostsPerZone :: Maybe MinimumHealthyHostsPerZoneProperty
minimumHealthyHostsPerZone = MinimumHealthyHostsPerZoneProperty
-> Maybe MinimumHealthyHostsPerZoneProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "MinimumHealthyHostsPerZone" ZonalConfigProperty
MinimumHealthyHostsPerZoneProperty
newValue, Maybe (Value Integer)
()
haddock_workaround_ :: ()
firstZoneMonitorDurationInSeconds :: Maybe (Value Integer)
monitorDurationInSeconds :: Maybe (Value Integer)
haddock_workaround_ :: ()
firstZoneMonitorDurationInSeconds :: Maybe (Value Integer)
monitorDurationInSeconds :: Maybe (Value Integer)
..}
instance Property "MonitorDurationInSeconds" ZonalConfigProperty where
  type PropertyType "MonitorDurationInSeconds" ZonalConfigProperty = Value Prelude.Integer
  set :: PropertyType "MonitorDurationInSeconds" ZonalConfigProperty
-> ZonalConfigProperty -> ZonalConfigProperty
set PropertyType "MonitorDurationInSeconds" ZonalConfigProperty
newValue ZonalConfigProperty {Maybe (Value Integer)
Maybe MinimumHealthyHostsPerZoneProperty
()
haddock_workaround_ :: ZonalConfigProperty -> ()
firstZoneMonitorDurationInSeconds :: ZonalConfigProperty -> Maybe (Value Integer)
minimumHealthyHostsPerZone :: ZonalConfigProperty -> Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: ZonalConfigProperty -> Maybe (Value Integer)
haddock_workaround_ :: ()
firstZoneMonitorDurationInSeconds :: Maybe (Value Integer)
minimumHealthyHostsPerZone :: Maybe MinimumHealthyHostsPerZoneProperty
monitorDurationInSeconds :: Maybe (Value Integer)
..}
    = ZonalConfigProperty
        {monitorDurationInSeconds :: Maybe (Value Integer)
monitorDurationInSeconds = Value Integer -> Maybe (Value Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "MonitorDurationInSeconds" ZonalConfigProperty
Value Integer
newValue, Maybe (Value Integer)
Maybe MinimumHealthyHostsPerZoneProperty
()
haddock_workaround_ :: ()
firstZoneMonitorDurationInSeconds :: Maybe (Value Integer)
minimumHealthyHostsPerZone :: Maybe MinimumHealthyHostsPerZoneProperty
haddock_workaround_ :: ()
firstZoneMonitorDurationInSeconds :: Maybe (Value Integer)
minimumHealthyHostsPerZone :: Maybe MinimumHealthyHostsPerZoneProperty
..}