-- | To specify how AWS CloudFormation handles updates for the MinSize,
-- MaxSize, and DesiredCapacity properties when the
-- AWS::AutoScaling::AutoScalingGroup resource has an associated scheduled
-- action, use the AutoScalingScheduledAction policy. With scheduled actions,
-- the group size properties of an Auto Scaling group can change at any time.
-- When you update a stack with an Auto Scaling group and scheduled action,
-- AWS CloudFormation always sets the group size property values of your Auto
-- Scaling group to the values that are defined in the
-- AWS::AutoScaling::AutoScalingGroup resource of your template, even if a
-- scheduled action is in effect. If you do not want AWS CloudFormation to
-- change any of the group size property values when you have a scheduled
-- action in effect, use the AutoScalingScheduledAction update policy to
-- prevent AWS CloudFormation from changing the MinSize, MaxSize, or
-- DesiredCapacity properties unless you have modified these values in your
-- template.

module Stratosphere.ResourceAttributes.AutoScalingScheduledActionPolicy where

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

import qualified Data.Aeson as JSON

-- | Full data type definition for AutoScalingScheduledActionPolicy. See
-- 'mkAutoScalingScheduledActionPolicy' for a more convenient constructor.
data AutoScalingScheduledActionPolicy = AutoScalingScheduledActionPolicy
  { AutoScalingScheduledActionPolicy -> Maybe (Value Bool)
ignoreUnmodifiedGroupSizeProperties :: Maybe (Value Bool)
  }
  deriving (Int -> AutoScalingScheduledActionPolicy -> ShowS
[AutoScalingScheduledActionPolicy] -> ShowS
AutoScalingScheduledActionPolicy -> String
(Int -> AutoScalingScheduledActionPolicy -> ShowS)
-> (AutoScalingScheduledActionPolicy -> String)
-> ([AutoScalingScheduledActionPolicy] -> ShowS)
-> Show AutoScalingScheduledActionPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AutoScalingScheduledActionPolicy -> ShowS
showsPrec :: Int -> AutoScalingScheduledActionPolicy -> ShowS
$cshow :: AutoScalingScheduledActionPolicy -> String
show :: AutoScalingScheduledActionPolicy -> String
$cshowList :: [AutoScalingScheduledActionPolicy] -> ShowS
showList :: [AutoScalingScheduledActionPolicy] -> ShowS
Show, AutoScalingScheduledActionPolicy
-> AutoScalingScheduledActionPolicy -> Bool
(AutoScalingScheduledActionPolicy
 -> AutoScalingScheduledActionPolicy -> Bool)
-> (AutoScalingScheduledActionPolicy
    -> AutoScalingScheduledActionPolicy -> Bool)
-> Eq AutoScalingScheduledActionPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutoScalingScheduledActionPolicy
-> AutoScalingScheduledActionPolicy -> Bool
== :: AutoScalingScheduledActionPolicy
-> AutoScalingScheduledActionPolicy -> Bool
$c/= :: AutoScalingScheduledActionPolicy
-> AutoScalingScheduledActionPolicy -> Bool
/= :: AutoScalingScheduledActionPolicy
-> AutoScalingScheduledActionPolicy -> Bool
Eq)

instance Property "IgnoreUnmodifiedGroupSizeProperties" AutoScalingScheduledActionPolicy where
  type PropertyType "IgnoreUnmodifiedGroupSizeProperties" AutoScalingScheduledActionPolicy = Value Bool
  set :: PropertyType
  "IgnoreUnmodifiedGroupSizeProperties"
  AutoScalingScheduledActionPolicy
-> AutoScalingScheduledActionPolicy
-> AutoScalingScheduledActionPolicy
set PropertyType
  "IgnoreUnmodifiedGroupSizeProperties"
  AutoScalingScheduledActionPolicy
newValue AutoScalingScheduledActionPolicy{}
    = AutoScalingScheduledActionPolicy
    { ignoreUnmodifiedGroupSizeProperties :: Maybe (Value Bool)
ignoreUnmodifiedGroupSizeProperties = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PropertyType
  "IgnoreUnmodifiedGroupSizeProperties"
  AutoScalingScheduledActionPolicy
Value Bool
newValue
    }

instance JSON.ToJSON AutoScalingScheduledActionPolicy where
  toJSON :: AutoScalingScheduledActionPolicy -> Value
toJSON AutoScalingScheduledActionPolicy{Maybe (Value Bool)
ignoreUnmodifiedGroupSizeProperties :: AutoScalingScheduledActionPolicy -> Maybe (Value Bool)
ignoreUnmodifiedGroupSizeProperties :: 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 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
"IgnoreUnmodifiedGroupSizeProperties",) (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)
ignoreUnmodifiedGroupSizeProperties
    ]

-- | Constructor for 'AutoScalingScheduledActionPolicy' containing required fields
-- as arguments.
mkAutoScalingScheduledActionPolicy :: AutoScalingScheduledActionPolicy
mkAutoScalingScheduledActionPolicy :: AutoScalingScheduledActionPolicy
mkAutoScalingScheduledActionPolicy
  = AutoScalingScheduledActionPolicy
  { ignoreUnmodifiedGroupSizeProperties :: Maybe (Value Bool)
ignoreUnmodifiedGroupSizeProperties = Maybe (Value Bool)
forall a. Maybe a
Nothing
  }