module Stratosphere.CodeDeploy.DeploymentConfig.TimeBasedLinearProperty (
        TimeBasedLinearProperty(..), mkTimeBasedLinearProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data TimeBasedLinearProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codedeploy-deploymentconfig-timebasedlinear.html>
    TimeBasedLinearProperty {TimeBasedLinearProperty -> ()
haddock_workaround_ :: (),
                             -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codedeploy-deploymentconfig-timebasedlinear.html#cfn-codedeploy-deploymentconfig-timebasedlinear-linearinterval>
                             TimeBasedLinearProperty -> Value Integer
linearInterval :: (Value Prelude.Integer),
                             -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-codedeploy-deploymentconfig-timebasedlinear.html#cfn-codedeploy-deploymentconfig-timebasedlinear-linearpercentage>
                             TimeBasedLinearProperty -> Value Integer
linearPercentage :: (Value Prelude.Integer)}
  deriving stock (TimeBasedLinearProperty -> TimeBasedLinearProperty -> Bool
(TimeBasedLinearProperty -> TimeBasedLinearProperty -> Bool)
-> (TimeBasedLinearProperty -> TimeBasedLinearProperty -> Bool)
-> Eq TimeBasedLinearProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeBasedLinearProperty -> TimeBasedLinearProperty -> Bool
== :: TimeBasedLinearProperty -> TimeBasedLinearProperty -> Bool
$c/= :: TimeBasedLinearProperty -> TimeBasedLinearProperty -> Bool
/= :: TimeBasedLinearProperty -> TimeBasedLinearProperty -> Bool
Prelude.Eq, Int -> TimeBasedLinearProperty -> ShowS
[TimeBasedLinearProperty] -> ShowS
TimeBasedLinearProperty -> String
(Int -> TimeBasedLinearProperty -> ShowS)
-> (TimeBasedLinearProperty -> String)
-> ([TimeBasedLinearProperty] -> ShowS)
-> Show TimeBasedLinearProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeBasedLinearProperty -> ShowS
showsPrec :: Int -> TimeBasedLinearProperty -> ShowS
$cshow :: TimeBasedLinearProperty -> String
show :: TimeBasedLinearProperty -> String
$cshowList :: [TimeBasedLinearProperty] -> ShowS
showList :: [TimeBasedLinearProperty] -> ShowS
Prelude.Show)
mkTimeBasedLinearProperty ::
  Value Prelude.Integer
  -> Value Prelude.Integer -> TimeBasedLinearProperty
mkTimeBasedLinearProperty :: Value Integer -> Value Integer -> TimeBasedLinearProperty
mkTimeBasedLinearProperty Value Integer
linearInterval Value Integer
linearPercentage
  = TimeBasedLinearProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), linearInterval :: Value Integer
linearInterval = Value Integer
linearInterval,
       linearPercentage :: Value Integer
linearPercentage = Value Integer
linearPercentage}
instance ToResourceProperties TimeBasedLinearProperty where
  toResourceProperties :: TimeBasedLinearProperty -> ResourceProperties
toResourceProperties TimeBasedLinearProperty {()
Value Integer
haddock_workaround_ :: TimeBasedLinearProperty -> ()
linearInterval :: TimeBasedLinearProperty -> Value Integer
linearPercentage :: TimeBasedLinearProperty -> Value Integer
haddock_workaround_ :: ()
linearInterval :: Value Integer
linearPercentage :: Value Integer
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::CodeDeploy::DeploymentConfig.TimeBasedLinear",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"LinearInterval" 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..= Value Integer
linearInterval,
                       Key
"LinearPercentage" 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..= Value Integer
linearPercentage]}
instance JSON.ToJSON TimeBasedLinearProperty where
  toJSON :: TimeBasedLinearProperty -> Value
toJSON TimeBasedLinearProperty {()
Value Integer
haddock_workaround_ :: TimeBasedLinearProperty -> ()
linearInterval :: TimeBasedLinearProperty -> Value Integer
linearPercentage :: TimeBasedLinearProperty -> Value Integer
haddock_workaround_ :: ()
linearInterval :: Value Integer
linearPercentage :: Value Integer
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"LinearInterval" 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..= Value Integer
linearInterval,
         Key
"LinearPercentage" 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..= Value Integer
linearPercentage]
instance Property "LinearInterval" TimeBasedLinearProperty where
  type PropertyType "LinearInterval" TimeBasedLinearProperty = Value Prelude.Integer
  set :: PropertyType "LinearInterval" TimeBasedLinearProperty
-> TimeBasedLinearProperty -> TimeBasedLinearProperty
set PropertyType "LinearInterval" TimeBasedLinearProperty
newValue TimeBasedLinearProperty {()
Value Integer
haddock_workaround_ :: TimeBasedLinearProperty -> ()
linearInterval :: TimeBasedLinearProperty -> Value Integer
linearPercentage :: TimeBasedLinearProperty -> Value Integer
haddock_workaround_ :: ()
linearInterval :: Value Integer
linearPercentage :: Value Integer
..}
    = TimeBasedLinearProperty {linearInterval :: Value Integer
linearInterval = PropertyType "LinearInterval" TimeBasedLinearProperty
Value Integer
newValue, ()
Value Integer
haddock_workaround_ :: ()
linearPercentage :: Value Integer
haddock_workaround_ :: ()
linearPercentage :: Value Integer
..}
instance Property "LinearPercentage" TimeBasedLinearProperty where
  type PropertyType "LinearPercentage" TimeBasedLinearProperty = Value Prelude.Integer
  set :: PropertyType "LinearPercentage" TimeBasedLinearProperty
-> TimeBasedLinearProperty -> TimeBasedLinearProperty
set PropertyType "LinearPercentage" TimeBasedLinearProperty
newValue TimeBasedLinearProperty {()
Value Integer
haddock_workaround_ :: TimeBasedLinearProperty -> ()
linearInterval :: TimeBasedLinearProperty -> Value Integer
linearPercentage :: TimeBasedLinearProperty -> Value Integer
haddock_workaround_ :: ()
linearInterval :: Value Integer
linearPercentage :: Value Integer
..}
    = TimeBasedLinearProperty {linearPercentage :: Value Integer
linearPercentage = PropertyType "LinearPercentage" TimeBasedLinearProperty
Value Integer
newValue, ()
Value Integer
haddock_workaround_ :: ()
linearInterval :: Value Integer
haddock_workaround_ :: ()
linearInterval :: Value Integer
..}