module Stratosphere.WAF.SizeConstraintSet.SizeConstraintProperty (
        module Exports, SizeConstraintProperty(..),
        mkSizeConstraintProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.WAF.SizeConstraintSet.FieldToMatchProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data SizeConstraintProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-waf-sizeconstraintset-sizeconstraint.html>
    SizeConstraintProperty {SizeConstraintProperty -> ()
haddock_workaround_ :: (),
                            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-waf-sizeconstraintset-sizeconstraint.html#cfn-waf-sizeconstraintset-sizeconstraint-comparisonoperator>
                            SizeConstraintProperty -> Value Text
comparisonOperator :: (Value Prelude.Text),
                            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-waf-sizeconstraintset-sizeconstraint.html#cfn-waf-sizeconstraintset-sizeconstraint-fieldtomatch>
                            SizeConstraintProperty -> FieldToMatchProperty
fieldToMatch :: FieldToMatchProperty,
                            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-waf-sizeconstraintset-sizeconstraint.html#cfn-waf-sizeconstraintset-sizeconstraint-size>
                            SizeConstraintProperty -> Value Integer
size :: (Value Prelude.Integer),
                            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-waf-sizeconstraintset-sizeconstraint.html#cfn-waf-sizeconstraintset-sizeconstraint-texttransformation>
                            SizeConstraintProperty -> Value Text
textTransformation :: (Value Prelude.Text)}
  deriving stock (SizeConstraintProperty -> SizeConstraintProperty -> Bool
(SizeConstraintProperty -> SizeConstraintProperty -> Bool)
-> (SizeConstraintProperty -> SizeConstraintProperty -> Bool)
-> Eq SizeConstraintProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SizeConstraintProperty -> SizeConstraintProperty -> Bool
== :: SizeConstraintProperty -> SizeConstraintProperty -> Bool
$c/= :: SizeConstraintProperty -> SizeConstraintProperty -> Bool
/= :: SizeConstraintProperty -> SizeConstraintProperty -> Bool
Prelude.Eq, Int -> SizeConstraintProperty -> ShowS
[SizeConstraintProperty] -> ShowS
SizeConstraintProperty -> String
(Int -> SizeConstraintProperty -> ShowS)
-> (SizeConstraintProperty -> String)
-> ([SizeConstraintProperty] -> ShowS)
-> Show SizeConstraintProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SizeConstraintProperty -> ShowS
showsPrec :: Int -> SizeConstraintProperty -> ShowS
$cshow :: SizeConstraintProperty -> String
show :: SizeConstraintProperty -> String
$cshowList :: [SizeConstraintProperty] -> ShowS
showList :: [SizeConstraintProperty] -> ShowS
Prelude.Show)
mkSizeConstraintProperty ::
  Value Prelude.Text
  -> FieldToMatchProperty
     -> Value Prelude.Integer
        -> Value Prelude.Text -> SizeConstraintProperty
mkSizeConstraintProperty :: Value Text
-> FieldToMatchProperty
-> Value Integer
-> Value Text
-> SizeConstraintProperty
mkSizeConstraintProperty
  Value Text
comparisonOperator
  FieldToMatchProperty
fieldToMatch
  Value Integer
size
  Value Text
textTransformation
  = SizeConstraintProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), comparisonOperator :: Value Text
comparisonOperator = Value Text
comparisonOperator,
       fieldToMatch :: FieldToMatchProperty
fieldToMatch = FieldToMatchProperty
fieldToMatch, size :: Value Integer
size = Value Integer
size,
       textTransformation :: Value Text
textTransformation = Value Text
textTransformation}
instance ToResourceProperties SizeConstraintProperty where
  toResourceProperties :: SizeConstraintProperty -> ResourceProperties
toResourceProperties SizeConstraintProperty {()
Value Integer
Value Text
FieldToMatchProperty
haddock_workaround_ :: SizeConstraintProperty -> ()
comparisonOperator :: SizeConstraintProperty -> Value Text
fieldToMatch :: SizeConstraintProperty -> FieldToMatchProperty
size :: SizeConstraintProperty -> Value Integer
textTransformation :: SizeConstraintProperty -> Value Text
haddock_workaround_ :: ()
comparisonOperator :: Value Text
fieldToMatch :: FieldToMatchProperty
size :: Value Integer
textTransformation :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::WAF::SizeConstraintSet.SizeConstraint",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"ComparisonOperator" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
comparisonOperator,
                       Key
"FieldToMatch" Key -> FieldToMatchProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= FieldToMatchProperty
fieldToMatch, Key
"Size" 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
size,
                       Key
"TextTransformation" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
textTransformation]}
instance JSON.ToJSON SizeConstraintProperty where
  toJSON :: SizeConstraintProperty -> Value
toJSON SizeConstraintProperty {()
Value Integer
Value Text
FieldToMatchProperty
haddock_workaround_ :: SizeConstraintProperty -> ()
comparisonOperator :: SizeConstraintProperty -> Value Text
fieldToMatch :: SizeConstraintProperty -> FieldToMatchProperty
size :: SizeConstraintProperty -> Value Integer
textTransformation :: SizeConstraintProperty -> Value Text
haddock_workaround_ :: ()
comparisonOperator :: Value Text
fieldToMatch :: FieldToMatchProperty
size :: Value Integer
textTransformation :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"ComparisonOperator" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
comparisonOperator,
         Key
"FieldToMatch" Key -> FieldToMatchProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= FieldToMatchProperty
fieldToMatch, Key
"Size" 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
size,
         Key
"TextTransformation" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
textTransformation]
instance Property "ComparisonOperator" SizeConstraintProperty where
  type PropertyType "ComparisonOperator" SizeConstraintProperty = Value Prelude.Text
  set :: PropertyType "ComparisonOperator" SizeConstraintProperty
-> SizeConstraintProperty -> SizeConstraintProperty
set PropertyType "ComparisonOperator" SizeConstraintProperty
newValue SizeConstraintProperty {()
Value Integer
Value Text
FieldToMatchProperty
haddock_workaround_ :: SizeConstraintProperty -> ()
comparisonOperator :: SizeConstraintProperty -> Value Text
fieldToMatch :: SizeConstraintProperty -> FieldToMatchProperty
size :: SizeConstraintProperty -> Value Integer
textTransformation :: SizeConstraintProperty -> Value Text
haddock_workaround_ :: ()
comparisonOperator :: Value Text
fieldToMatch :: FieldToMatchProperty
size :: Value Integer
textTransformation :: Value Text
..}
    = SizeConstraintProperty {comparisonOperator :: Value Text
comparisonOperator = PropertyType "ComparisonOperator" SizeConstraintProperty
Value Text
newValue, ()
Value Integer
Value Text
FieldToMatchProperty
haddock_workaround_ :: ()
fieldToMatch :: FieldToMatchProperty
size :: Value Integer
textTransformation :: Value Text
haddock_workaround_ :: ()
fieldToMatch :: FieldToMatchProperty
size :: Value Integer
textTransformation :: Value Text
..}
instance Property "FieldToMatch" SizeConstraintProperty where
  type PropertyType "FieldToMatch" SizeConstraintProperty = FieldToMatchProperty
  set :: PropertyType "FieldToMatch" SizeConstraintProperty
-> SizeConstraintProperty -> SizeConstraintProperty
set PropertyType "FieldToMatch" SizeConstraintProperty
newValue SizeConstraintProperty {()
Value Integer
Value Text
FieldToMatchProperty
haddock_workaround_ :: SizeConstraintProperty -> ()
comparisonOperator :: SizeConstraintProperty -> Value Text
fieldToMatch :: SizeConstraintProperty -> FieldToMatchProperty
size :: SizeConstraintProperty -> Value Integer
textTransformation :: SizeConstraintProperty -> Value Text
haddock_workaround_ :: ()
comparisonOperator :: Value Text
fieldToMatch :: FieldToMatchProperty
size :: Value Integer
textTransformation :: Value Text
..}
    = SizeConstraintProperty {fieldToMatch :: FieldToMatchProperty
fieldToMatch = PropertyType "FieldToMatch" SizeConstraintProperty
FieldToMatchProperty
newValue, ()
Value Integer
Value Text
haddock_workaround_ :: ()
comparisonOperator :: Value Text
size :: Value Integer
textTransformation :: Value Text
haddock_workaround_ :: ()
comparisonOperator :: Value Text
size :: Value Integer
textTransformation :: Value Text
..}
instance Property "Size" SizeConstraintProperty where
  type PropertyType "Size" SizeConstraintProperty = Value Prelude.Integer
  set :: PropertyType "Size" SizeConstraintProperty
-> SizeConstraintProperty -> SizeConstraintProperty
set PropertyType "Size" SizeConstraintProperty
newValue SizeConstraintProperty {()
Value Integer
Value Text
FieldToMatchProperty
haddock_workaround_ :: SizeConstraintProperty -> ()
comparisonOperator :: SizeConstraintProperty -> Value Text
fieldToMatch :: SizeConstraintProperty -> FieldToMatchProperty
size :: SizeConstraintProperty -> Value Integer
textTransformation :: SizeConstraintProperty -> Value Text
haddock_workaround_ :: ()
comparisonOperator :: Value Text
fieldToMatch :: FieldToMatchProperty
size :: Value Integer
textTransformation :: Value Text
..}
    = SizeConstraintProperty {size :: Value Integer
size = PropertyType "Size" SizeConstraintProperty
Value Integer
newValue, ()
Value Text
FieldToMatchProperty
haddock_workaround_ :: ()
comparisonOperator :: Value Text
fieldToMatch :: FieldToMatchProperty
textTransformation :: Value Text
haddock_workaround_ :: ()
comparisonOperator :: Value Text
fieldToMatch :: FieldToMatchProperty
textTransformation :: Value Text
..}
instance Property "TextTransformation" SizeConstraintProperty where
  type PropertyType "TextTransformation" SizeConstraintProperty = Value Prelude.Text
  set :: PropertyType "TextTransformation" SizeConstraintProperty
-> SizeConstraintProperty -> SizeConstraintProperty
set PropertyType "TextTransformation" SizeConstraintProperty
newValue SizeConstraintProperty {()
Value Integer
Value Text
FieldToMatchProperty
haddock_workaround_ :: SizeConstraintProperty -> ()
comparisonOperator :: SizeConstraintProperty -> Value Text
fieldToMatch :: SizeConstraintProperty -> FieldToMatchProperty
size :: SizeConstraintProperty -> Value Integer
textTransformation :: SizeConstraintProperty -> Value Text
haddock_workaround_ :: ()
comparisonOperator :: Value Text
fieldToMatch :: FieldToMatchProperty
size :: Value Integer
textTransformation :: Value Text
..}
    = SizeConstraintProperty {textTransformation :: Value Text
textTransformation = PropertyType "TextTransformation" SizeConstraintProperty
Value Text
newValue, ()
Value Integer
Value Text
FieldToMatchProperty
haddock_workaround_ :: ()
comparisonOperator :: Value Text
fieldToMatch :: FieldToMatchProperty
size :: Value Integer
haddock_workaround_ :: ()
comparisonOperator :: Value Text
fieldToMatch :: FieldToMatchProperty
size :: Value Integer
..}