module Stratosphere.WAFv2.WebACL.RuleActionProperty (
        module Exports, RuleActionProperty(..), mkRuleActionProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.WAFv2.WebACL.AllowActionProperty as Exports
import {-# SOURCE #-} Stratosphere.WAFv2.WebACL.BlockActionProperty as Exports
import {-# SOURCE #-} Stratosphere.WAFv2.WebACL.CaptchaActionProperty as Exports
import {-# SOURCE #-} Stratosphere.WAFv2.WebACL.ChallengeActionProperty as Exports
import {-# SOURCE #-} Stratosphere.WAFv2.WebACL.CountActionProperty as Exports
import Stratosphere.ResourceProperties
data RuleActionProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-wafv2-webacl-ruleaction.html>
    RuleActionProperty {RuleActionProperty -> ()
haddock_workaround_ :: (),
                        -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-wafv2-webacl-ruleaction.html#cfn-wafv2-webacl-ruleaction-allow>
                        RuleActionProperty -> Maybe AllowActionProperty
allow :: (Prelude.Maybe AllowActionProperty),
                        -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-wafv2-webacl-ruleaction.html#cfn-wafv2-webacl-ruleaction-block>
                        RuleActionProperty -> Maybe BlockActionProperty
block :: (Prelude.Maybe BlockActionProperty),
                        -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-wafv2-webacl-ruleaction.html#cfn-wafv2-webacl-ruleaction-captcha>
                        RuleActionProperty -> Maybe CaptchaActionProperty
captcha :: (Prelude.Maybe CaptchaActionProperty),
                        -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-wafv2-webacl-ruleaction.html#cfn-wafv2-webacl-ruleaction-challenge>
                        RuleActionProperty -> Maybe ChallengeActionProperty
challenge :: (Prelude.Maybe ChallengeActionProperty),
                        -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-wafv2-webacl-ruleaction.html#cfn-wafv2-webacl-ruleaction-count>
                        RuleActionProperty -> Maybe CountActionProperty
count :: (Prelude.Maybe CountActionProperty)}
  deriving stock (RuleActionProperty -> RuleActionProperty -> Bool
(RuleActionProperty -> RuleActionProperty -> Bool)
-> (RuleActionProperty -> RuleActionProperty -> Bool)
-> Eq RuleActionProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RuleActionProperty -> RuleActionProperty -> Bool
== :: RuleActionProperty -> RuleActionProperty -> Bool
$c/= :: RuleActionProperty -> RuleActionProperty -> Bool
/= :: RuleActionProperty -> RuleActionProperty -> Bool
Prelude.Eq, Int -> RuleActionProperty -> ShowS
[RuleActionProperty] -> ShowS
RuleActionProperty -> String
(Int -> RuleActionProperty -> ShowS)
-> (RuleActionProperty -> String)
-> ([RuleActionProperty] -> ShowS)
-> Show RuleActionProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuleActionProperty -> ShowS
showsPrec :: Int -> RuleActionProperty -> ShowS
$cshow :: RuleActionProperty -> String
show :: RuleActionProperty -> String
$cshowList :: [RuleActionProperty] -> ShowS
showList :: [RuleActionProperty] -> ShowS
Prelude.Show)
mkRuleActionProperty :: RuleActionProperty
mkRuleActionProperty :: RuleActionProperty
mkRuleActionProperty
  = RuleActionProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), allow :: Maybe AllowActionProperty
allow = Maybe AllowActionProperty
forall a. Maybe a
Prelude.Nothing,
       block :: Maybe BlockActionProperty
block = Maybe BlockActionProperty
forall a. Maybe a
Prelude.Nothing, captcha :: Maybe CaptchaActionProperty
captcha = Maybe CaptchaActionProperty
forall a. Maybe a
Prelude.Nothing,
       challenge :: Maybe ChallengeActionProperty
challenge = Maybe ChallengeActionProperty
forall a. Maybe a
Prelude.Nothing, count :: Maybe CountActionProperty
count = Maybe CountActionProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties RuleActionProperty where
  toResourceProperties :: RuleActionProperty -> ResourceProperties
toResourceProperties RuleActionProperty {Maybe CountActionProperty
Maybe ChallengeActionProperty
Maybe CaptchaActionProperty
Maybe AllowActionProperty
Maybe BlockActionProperty
()
haddock_workaround_ :: RuleActionProperty -> ()
allow :: RuleActionProperty -> Maybe AllowActionProperty
block :: RuleActionProperty -> Maybe BlockActionProperty
captcha :: RuleActionProperty -> Maybe CaptchaActionProperty
challenge :: RuleActionProperty -> Maybe ChallengeActionProperty
count :: RuleActionProperty -> Maybe CountActionProperty
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::WAFv2::WebACL.RuleAction",
         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 -> AllowActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Allow" (AllowActionProperty -> (Key, Value))
-> Maybe AllowActionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AllowActionProperty
allow,
                            Key -> BlockActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Block" (BlockActionProperty -> (Key, Value))
-> Maybe BlockActionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BlockActionProperty
block,
                            Key -> CaptchaActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Captcha" (CaptchaActionProperty -> (Key, Value))
-> Maybe CaptchaActionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CaptchaActionProperty
captcha,
                            Key -> ChallengeActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Challenge" (ChallengeActionProperty -> (Key, Value))
-> Maybe ChallengeActionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ChallengeActionProperty
challenge,
                            Key -> CountActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Count" (CountActionProperty -> (Key, Value))
-> Maybe CountActionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CountActionProperty
count])}
instance JSON.ToJSON RuleActionProperty where
  toJSON :: RuleActionProperty -> Value
toJSON RuleActionProperty {Maybe CountActionProperty
Maybe ChallengeActionProperty
Maybe CaptchaActionProperty
Maybe AllowActionProperty
Maybe BlockActionProperty
()
haddock_workaround_ :: RuleActionProperty -> ()
allow :: RuleActionProperty -> Maybe AllowActionProperty
block :: RuleActionProperty -> Maybe BlockActionProperty
captcha :: RuleActionProperty -> Maybe CaptchaActionProperty
challenge :: RuleActionProperty -> Maybe ChallengeActionProperty
count :: RuleActionProperty -> Maybe CountActionProperty
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
..}
    = [(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 -> AllowActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Allow" (AllowActionProperty -> (Key, Value))
-> Maybe AllowActionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AllowActionProperty
allow,
               Key -> BlockActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Block" (BlockActionProperty -> (Key, Value))
-> Maybe BlockActionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BlockActionProperty
block,
               Key -> CaptchaActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Captcha" (CaptchaActionProperty -> (Key, Value))
-> Maybe CaptchaActionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CaptchaActionProperty
captcha,
               Key -> ChallengeActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Challenge" (ChallengeActionProperty -> (Key, Value))
-> Maybe ChallengeActionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ChallengeActionProperty
challenge,
               Key -> CountActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Count" (CountActionProperty -> (Key, Value))
-> Maybe CountActionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CountActionProperty
count]))
instance Property "Allow" RuleActionProperty where
  type PropertyType "Allow" RuleActionProperty = AllowActionProperty
  set :: PropertyType "Allow" RuleActionProperty
-> RuleActionProperty -> RuleActionProperty
set PropertyType "Allow" RuleActionProperty
newValue RuleActionProperty {Maybe CountActionProperty
Maybe ChallengeActionProperty
Maybe CaptchaActionProperty
Maybe AllowActionProperty
Maybe BlockActionProperty
()
haddock_workaround_ :: RuleActionProperty -> ()
allow :: RuleActionProperty -> Maybe AllowActionProperty
block :: RuleActionProperty -> Maybe BlockActionProperty
captcha :: RuleActionProperty -> Maybe CaptchaActionProperty
challenge :: RuleActionProperty -> Maybe ChallengeActionProperty
count :: RuleActionProperty -> Maybe CountActionProperty
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
..}
    = RuleActionProperty {allow :: Maybe AllowActionProperty
allow = AllowActionProperty -> Maybe AllowActionProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Allow" RuleActionProperty
AllowActionProperty
newValue, Maybe CountActionProperty
Maybe ChallengeActionProperty
Maybe CaptchaActionProperty
Maybe BlockActionProperty
()
haddock_workaround_ :: ()
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
haddock_workaround_ :: ()
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
..}
instance Property "Block" RuleActionProperty where
  type PropertyType "Block" RuleActionProperty = BlockActionProperty
  set :: PropertyType "Block" RuleActionProperty
-> RuleActionProperty -> RuleActionProperty
set PropertyType "Block" RuleActionProperty
newValue RuleActionProperty {Maybe CountActionProperty
Maybe ChallengeActionProperty
Maybe CaptchaActionProperty
Maybe AllowActionProperty
Maybe BlockActionProperty
()
haddock_workaround_ :: RuleActionProperty -> ()
allow :: RuleActionProperty -> Maybe AllowActionProperty
block :: RuleActionProperty -> Maybe BlockActionProperty
captcha :: RuleActionProperty -> Maybe CaptchaActionProperty
challenge :: RuleActionProperty -> Maybe ChallengeActionProperty
count :: RuleActionProperty -> Maybe CountActionProperty
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
..}
    = RuleActionProperty {block :: Maybe BlockActionProperty
block = BlockActionProperty -> Maybe BlockActionProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Block" RuleActionProperty
BlockActionProperty
newValue, Maybe CountActionProperty
Maybe ChallengeActionProperty
Maybe CaptchaActionProperty
Maybe AllowActionProperty
()
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
..}
instance Property "Captcha" RuleActionProperty where
  type PropertyType "Captcha" RuleActionProperty = CaptchaActionProperty
  set :: PropertyType "Captcha" RuleActionProperty
-> RuleActionProperty -> RuleActionProperty
set PropertyType "Captcha" RuleActionProperty
newValue RuleActionProperty {Maybe CountActionProperty
Maybe ChallengeActionProperty
Maybe CaptchaActionProperty
Maybe AllowActionProperty
Maybe BlockActionProperty
()
haddock_workaround_ :: RuleActionProperty -> ()
allow :: RuleActionProperty -> Maybe AllowActionProperty
block :: RuleActionProperty -> Maybe BlockActionProperty
captcha :: RuleActionProperty -> Maybe CaptchaActionProperty
challenge :: RuleActionProperty -> Maybe ChallengeActionProperty
count :: RuleActionProperty -> Maybe CountActionProperty
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
..}
    = RuleActionProperty {captcha :: Maybe CaptchaActionProperty
captcha = CaptchaActionProperty -> Maybe CaptchaActionProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Captcha" RuleActionProperty
CaptchaActionProperty
newValue, Maybe CountActionProperty
Maybe ChallengeActionProperty
Maybe AllowActionProperty
Maybe BlockActionProperty
()
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
..}
instance Property "Challenge" RuleActionProperty where
  type PropertyType "Challenge" RuleActionProperty = ChallengeActionProperty
  set :: PropertyType "Challenge" RuleActionProperty
-> RuleActionProperty -> RuleActionProperty
set PropertyType "Challenge" RuleActionProperty
newValue RuleActionProperty {Maybe CountActionProperty
Maybe ChallengeActionProperty
Maybe CaptchaActionProperty
Maybe AllowActionProperty
Maybe BlockActionProperty
()
haddock_workaround_ :: RuleActionProperty -> ()
allow :: RuleActionProperty -> Maybe AllowActionProperty
block :: RuleActionProperty -> Maybe BlockActionProperty
captcha :: RuleActionProperty -> Maybe CaptchaActionProperty
challenge :: RuleActionProperty -> Maybe ChallengeActionProperty
count :: RuleActionProperty -> Maybe CountActionProperty
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
..}
    = RuleActionProperty {challenge :: Maybe ChallengeActionProperty
challenge = ChallengeActionProperty -> Maybe ChallengeActionProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Challenge" RuleActionProperty
ChallengeActionProperty
newValue, Maybe CountActionProperty
Maybe CaptchaActionProperty
Maybe AllowActionProperty
Maybe BlockActionProperty
()
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
count :: Maybe CountActionProperty
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
count :: Maybe CountActionProperty
..}
instance Property "Count" RuleActionProperty where
  type PropertyType "Count" RuleActionProperty = CountActionProperty
  set :: PropertyType "Count" RuleActionProperty
-> RuleActionProperty -> RuleActionProperty
set PropertyType "Count" RuleActionProperty
newValue RuleActionProperty {Maybe CountActionProperty
Maybe ChallengeActionProperty
Maybe CaptchaActionProperty
Maybe AllowActionProperty
Maybe BlockActionProperty
()
haddock_workaround_ :: RuleActionProperty -> ()
allow :: RuleActionProperty -> Maybe AllowActionProperty
block :: RuleActionProperty -> Maybe BlockActionProperty
captcha :: RuleActionProperty -> Maybe CaptchaActionProperty
challenge :: RuleActionProperty -> Maybe ChallengeActionProperty
count :: RuleActionProperty -> Maybe CountActionProperty
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
count :: Maybe CountActionProperty
..}
    = RuleActionProperty {count :: Maybe CountActionProperty
count = CountActionProperty -> Maybe CountActionProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Count" RuleActionProperty
CountActionProperty
newValue, Maybe ChallengeActionProperty
Maybe CaptchaActionProperty
Maybe AllowActionProperty
Maybe BlockActionProperty
()
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
haddock_workaround_ :: ()
allow :: Maybe AllowActionProperty
block :: Maybe BlockActionProperty
captcha :: Maybe CaptchaActionProperty
challenge :: Maybe ChallengeActionProperty
..}