module Stratosphere.CloudFront.ContinuousDeploymentPolicy.SessionStickinessConfigProperty (
        SessionStickinessConfigProperty(..),
        mkSessionStickinessConfigProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data SessionStickinessConfigProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cloudfront-continuousdeploymentpolicy-sessionstickinessconfig.html>
    SessionStickinessConfigProperty {SessionStickinessConfigProperty -> ()
haddock_workaround_ :: (),
                                     -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cloudfront-continuousdeploymentpolicy-sessionstickinessconfig.html#cfn-cloudfront-continuousdeploymentpolicy-sessionstickinessconfig-idlettl>
                                     SessionStickinessConfigProperty -> Value Integer
idleTTL :: (Value Prelude.Integer),
                                     -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cloudfront-continuousdeploymentpolicy-sessionstickinessconfig.html#cfn-cloudfront-continuousdeploymentpolicy-sessionstickinessconfig-maximumttl>
                                     SessionStickinessConfigProperty -> Value Integer
maximumTTL :: (Value Prelude.Integer)}
  deriving stock (SessionStickinessConfigProperty
-> SessionStickinessConfigProperty -> Bool
(SessionStickinessConfigProperty
 -> SessionStickinessConfigProperty -> Bool)
-> (SessionStickinessConfigProperty
    -> SessionStickinessConfigProperty -> Bool)
-> Eq SessionStickinessConfigProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionStickinessConfigProperty
-> SessionStickinessConfigProperty -> Bool
== :: SessionStickinessConfigProperty
-> SessionStickinessConfigProperty -> Bool
$c/= :: SessionStickinessConfigProperty
-> SessionStickinessConfigProperty -> Bool
/= :: SessionStickinessConfigProperty
-> SessionStickinessConfigProperty -> Bool
Prelude.Eq, Int -> SessionStickinessConfigProperty -> ShowS
[SessionStickinessConfigProperty] -> ShowS
SessionStickinessConfigProperty -> String
(Int -> SessionStickinessConfigProperty -> ShowS)
-> (SessionStickinessConfigProperty -> String)
-> ([SessionStickinessConfigProperty] -> ShowS)
-> Show SessionStickinessConfigProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionStickinessConfigProperty -> ShowS
showsPrec :: Int -> SessionStickinessConfigProperty -> ShowS
$cshow :: SessionStickinessConfigProperty -> String
show :: SessionStickinessConfigProperty -> String
$cshowList :: [SessionStickinessConfigProperty] -> ShowS
showList :: [SessionStickinessConfigProperty] -> ShowS
Prelude.Show)
mkSessionStickinessConfigProperty ::
  Value Prelude.Integer
  -> Value Prelude.Integer -> SessionStickinessConfigProperty
mkSessionStickinessConfigProperty :: Value Integer -> Value Integer -> SessionStickinessConfigProperty
mkSessionStickinessConfigProperty Value Integer
idleTTL Value Integer
maximumTTL
  = SessionStickinessConfigProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), idleTTL :: Value Integer
idleTTL = Value Integer
idleTTL,
       maximumTTL :: Value Integer
maximumTTL = Value Integer
maximumTTL}
instance ToResourceProperties SessionStickinessConfigProperty where
  toResourceProperties :: SessionStickinessConfigProperty -> ResourceProperties
toResourceProperties SessionStickinessConfigProperty {()
Value Integer
haddock_workaround_ :: SessionStickinessConfigProperty -> ()
idleTTL :: SessionStickinessConfigProperty -> Value Integer
maximumTTL :: SessionStickinessConfigProperty -> Value Integer
haddock_workaround_ :: ()
idleTTL :: Value Integer
maximumTTL :: Value Integer
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::CloudFront::ContinuousDeploymentPolicy.SessionStickinessConfig",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"IdleTTL" 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
idleTTL,
                       Key
"MaximumTTL" 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
maximumTTL]}
instance JSON.ToJSON SessionStickinessConfigProperty where
  toJSON :: SessionStickinessConfigProperty -> Value
toJSON SessionStickinessConfigProperty {()
Value Integer
haddock_workaround_ :: SessionStickinessConfigProperty -> ()
idleTTL :: SessionStickinessConfigProperty -> Value Integer
maximumTTL :: SessionStickinessConfigProperty -> Value Integer
haddock_workaround_ :: ()
idleTTL :: Value Integer
maximumTTL :: Value Integer
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"IdleTTL" 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
idleTTL, Key
"MaximumTTL" 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
maximumTTL]
instance Property "IdleTTL" SessionStickinessConfigProperty where
  type PropertyType "IdleTTL" SessionStickinessConfigProperty = Value Prelude.Integer
  set :: PropertyType "IdleTTL" SessionStickinessConfigProperty
-> SessionStickinessConfigProperty
-> SessionStickinessConfigProperty
set PropertyType "IdleTTL" SessionStickinessConfigProperty
newValue SessionStickinessConfigProperty {()
Value Integer
haddock_workaround_ :: SessionStickinessConfigProperty -> ()
idleTTL :: SessionStickinessConfigProperty -> Value Integer
maximumTTL :: SessionStickinessConfigProperty -> Value Integer
haddock_workaround_ :: ()
idleTTL :: Value Integer
maximumTTL :: Value Integer
..}
    = SessionStickinessConfigProperty {idleTTL :: Value Integer
idleTTL = PropertyType "IdleTTL" SessionStickinessConfigProperty
Value Integer
newValue, ()
Value Integer
haddock_workaround_ :: ()
maximumTTL :: Value Integer
haddock_workaround_ :: ()
maximumTTL :: Value Integer
..}
instance Property "MaximumTTL" SessionStickinessConfigProperty where
  type PropertyType "MaximumTTL" SessionStickinessConfigProperty = Value Prelude.Integer
  set :: PropertyType "MaximumTTL" SessionStickinessConfigProperty
-> SessionStickinessConfigProperty
-> SessionStickinessConfigProperty
set PropertyType "MaximumTTL" SessionStickinessConfigProperty
newValue SessionStickinessConfigProperty {()
Value Integer
haddock_workaround_ :: SessionStickinessConfigProperty -> ()
idleTTL :: SessionStickinessConfigProperty -> Value Integer
maximumTTL :: SessionStickinessConfigProperty -> Value Integer
haddock_workaround_ :: ()
idleTTL :: Value Integer
maximumTTL :: Value Integer
..}
    = SessionStickinessConfigProperty {maximumTTL :: Value Integer
maximumTTL = PropertyType "MaximumTTL" SessionStickinessConfigProperty
Value Integer
newValue, ()
Value Integer
haddock_workaround_ :: ()
idleTTL :: Value Integer
haddock_workaround_ :: ()
idleTTL :: Value Integer
..}