module Stratosphere.NetworkFirewall.RuleGroup.RulesSourceProperty (
        module Exports, RulesSourceProperty(..), mkRulesSourceProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.NetworkFirewall.RuleGroup.RulesSourceListProperty as Exports
import {-# SOURCE #-} Stratosphere.NetworkFirewall.RuleGroup.StatefulRuleProperty as Exports
import {-# SOURCE #-} Stratosphere.NetworkFirewall.RuleGroup.StatelessRulesAndCustomActionsProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data RulesSourceProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-networkfirewall-rulegroup-rulessource.html>
    RulesSourceProperty {RulesSourceProperty -> ()
haddock_workaround_ :: (),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-networkfirewall-rulegroup-rulessource.html#cfn-networkfirewall-rulegroup-rulessource-rulessourcelist>
                         RulesSourceProperty -> Maybe RulesSourceListProperty
rulesSourceList :: (Prelude.Maybe RulesSourceListProperty),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-networkfirewall-rulegroup-rulessource.html#cfn-networkfirewall-rulegroup-rulessource-rulesstring>
                         RulesSourceProperty -> Maybe (Value Text)
rulesString :: (Prelude.Maybe (Value Prelude.Text)),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-networkfirewall-rulegroup-rulessource.html#cfn-networkfirewall-rulegroup-rulessource-statefulrules>
                         RulesSourceProperty -> Maybe [StatefulRuleProperty]
statefulRules :: (Prelude.Maybe [StatefulRuleProperty]),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-networkfirewall-rulegroup-rulessource.html#cfn-networkfirewall-rulegroup-rulessource-statelessrulesandcustomactions>
                         RulesSourceProperty -> Maybe StatelessRulesAndCustomActionsProperty
statelessRulesAndCustomActions :: (Prelude.Maybe StatelessRulesAndCustomActionsProperty)}
  deriving stock (RulesSourceProperty -> RulesSourceProperty -> Bool
(RulesSourceProperty -> RulesSourceProperty -> Bool)
-> (RulesSourceProperty -> RulesSourceProperty -> Bool)
-> Eq RulesSourceProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RulesSourceProperty -> RulesSourceProperty -> Bool
== :: RulesSourceProperty -> RulesSourceProperty -> Bool
$c/= :: RulesSourceProperty -> RulesSourceProperty -> Bool
/= :: RulesSourceProperty -> RulesSourceProperty -> Bool
Prelude.Eq, Int -> RulesSourceProperty -> ShowS
[RulesSourceProperty] -> ShowS
RulesSourceProperty -> String
(Int -> RulesSourceProperty -> ShowS)
-> (RulesSourceProperty -> String)
-> ([RulesSourceProperty] -> ShowS)
-> Show RulesSourceProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RulesSourceProperty -> ShowS
showsPrec :: Int -> RulesSourceProperty -> ShowS
$cshow :: RulesSourceProperty -> String
show :: RulesSourceProperty -> String
$cshowList :: [RulesSourceProperty] -> ShowS
showList :: [RulesSourceProperty] -> ShowS
Prelude.Show)
mkRulesSourceProperty :: RulesSourceProperty
mkRulesSourceProperty :: RulesSourceProperty
mkRulesSourceProperty
  = RulesSourceProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), rulesSourceList :: Maybe RulesSourceListProperty
rulesSourceList = Maybe RulesSourceListProperty
forall a. Maybe a
Prelude.Nothing,
       rulesString :: Maybe (Value Text)
rulesString = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing, statefulRules :: Maybe [StatefulRuleProperty]
statefulRules = Maybe [StatefulRuleProperty]
forall a. Maybe a
Prelude.Nothing,
       statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
statelessRulesAndCustomActions = Maybe StatelessRulesAndCustomActionsProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties RulesSourceProperty where
  toResourceProperties :: RulesSourceProperty -> ResourceProperties
toResourceProperties RulesSourceProperty {Maybe [StatefulRuleProperty]
Maybe (Value Text)
Maybe RulesSourceListProperty
Maybe StatelessRulesAndCustomActionsProperty
()
haddock_workaround_ :: RulesSourceProperty -> ()
rulesSourceList :: RulesSourceProperty -> Maybe RulesSourceListProperty
rulesString :: RulesSourceProperty -> Maybe (Value Text)
statefulRules :: RulesSourceProperty -> Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: RulesSourceProperty -> Maybe StatelessRulesAndCustomActionsProperty
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
rulesString :: Maybe (Value Text)
statefulRules :: Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::NetworkFirewall::RuleGroup.RulesSource",
         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 -> RulesSourceListProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RulesSourceList" (RulesSourceListProperty -> (Key, Value))
-> Maybe RulesSourceListProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RulesSourceListProperty
rulesSourceList,
                            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..=) Key
"RulesString" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
rulesString,
                            Key -> [StatefulRuleProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"StatefulRules" ([StatefulRuleProperty] -> (Key, Value))
-> Maybe [StatefulRuleProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [StatefulRuleProperty]
statefulRules,
                            Key -> StatelessRulesAndCustomActionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"StatelessRulesAndCustomActions"
                              (StatelessRulesAndCustomActionsProperty -> (Key, Value))
-> Maybe StatelessRulesAndCustomActionsProperty
-> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe StatelessRulesAndCustomActionsProperty
statelessRulesAndCustomActions])}
instance JSON.ToJSON RulesSourceProperty where
  toJSON :: RulesSourceProperty -> Value
toJSON RulesSourceProperty {Maybe [StatefulRuleProperty]
Maybe (Value Text)
Maybe RulesSourceListProperty
Maybe StatelessRulesAndCustomActionsProperty
()
haddock_workaround_ :: RulesSourceProperty -> ()
rulesSourceList :: RulesSourceProperty -> Maybe RulesSourceListProperty
rulesString :: RulesSourceProperty -> Maybe (Value Text)
statefulRules :: RulesSourceProperty -> Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: RulesSourceProperty -> Maybe StatelessRulesAndCustomActionsProperty
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
rulesString :: Maybe (Value Text)
statefulRules :: Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
..}
    = [(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 -> RulesSourceListProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RulesSourceList" (RulesSourceListProperty -> (Key, Value))
-> Maybe RulesSourceListProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RulesSourceListProperty
rulesSourceList,
               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..=) Key
"RulesString" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
rulesString,
               Key -> [StatefulRuleProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"StatefulRules" ([StatefulRuleProperty] -> (Key, Value))
-> Maybe [StatefulRuleProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [StatefulRuleProperty]
statefulRules,
               Key -> StatelessRulesAndCustomActionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"StatelessRulesAndCustomActions"
                 (StatelessRulesAndCustomActionsProperty -> (Key, Value))
-> Maybe StatelessRulesAndCustomActionsProperty
-> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe StatelessRulesAndCustomActionsProperty
statelessRulesAndCustomActions]))
instance Property "RulesSourceList" RulesSourceProperty where
  type PropertyType "RulesSourceList" RulesSourceProperty = RulesSourceListProperty
  set :: PropertyType "RulesSourceList" RulesSourceProperty
-> RulesSourceProperty -> RulesSourceProperty
set PropertyType "RulesSourceList" RulesSourceProperty
newValue RulesSourceProperty {Maybe [StatefulRuleProperty]
Maybe (Value Text)
Maybe RulesSourceListProperty
Maybe StatelessRulesAndCustomActionsProperty
()
haddock_workaround_ :: RulesSourceProperty -> ()
rulesSourceList :: RulesSourceProperty -> Maybe RulesSourceListProperty
rulesString :: RulesSourceProperty -> Maybe (Value Text)
statefulRules :: RulesSourceProperty -> Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: RulesSourceProperty -> Maybe StatelessRulesAndCustomActionsProperty
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
rulesString :: Maybe (Value Text)
statefulRules :: Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
..}
    = RulesSourceProperty {rulesSourceList :: Maybe RulesSourceListProperty
rulesSourceList = RulesSourceListProperty -> Maybe RulesSourceListProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "RulesSourceList" RulesSourceProperty
RulesSourceListProperty
newValue, Maybe [StatefulRuleProperty]
Maybe (Value Text)
Maybe StatelessRulesAndCustomActionsProperty
()
haddock_workaround_ :: ()
rulesString :: Maybe (Value Text)
statefulRules :: Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
haddock_workaround_ :: ()
rulesString :: Maybe (Value Text)
statefulRules :: Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
..}
instance Property "RulesString" RulesSourceProperty where
  type PropertyType "RulesString" RulesSourceProperty = Value Prelude.Text
  set :: PropertyType "RulesString" RulesSourceProperty
-> RulesSourceProperty -> RulesSourceProperty
set PropertyType "RulesString" RulesSourceProperty
newValue RulesSourceProperty {Maybe [StatefulRuleProperty]
Maybe (Value Text)
Maybe RulesSourceListProperty
Maybe StatelessRulesAndCustomActionsProperty
()
haddock_workaround_ :: RulesSourceProperty -> ()
rulesSourceList :: RulesSourceProperty -> Maybe RulesSourceListProperty
rulesString :: RulesSourceProperty -> Maybe (Value Text)
statefulRules :: RulesSourceProperty -> Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: RulesSourceProperty -> Maybe StatelessRulesAndCustomActionsProperty
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
rulesString :: Maybe (Value Text)
statefulRules :: Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
..}
    = RulesSourceProperty {rulesString :: Maybe (Value Text)
rulesString = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "RulesString" RulesSourceProperty
Value Text
newValue, Maybe [StatefulRuleProperty]
Maybe RulesSourceListProperty
Maybe StatelessRulesAndCustomActionsProperty
()
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
statefulRules :: Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
statefulRules :: Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
..}
instance Property "StatefulRules" RulesSourceProperty where
  type PropertyType "StatefulRules" RulesSourceProperty = [StatefulRuleProperty]
  set :: PropertyType "StatefulRules" RulesSourceProperty
-> RulesSourceProperty -> RulesSourceProperty
set PropertyType "StatefulRules" RulesSourceProperty
newValue RulesSourceProperty {Maybe [StatefulRuleProperty]
Maybe (Value Text)
Maybe RulesSourceListProperty
Maybe StatelessRulesAndCustomActionsProperty
()
haddock_workaround_ :: RulesSourceProperty -> ()
rulesSourceList :: RulesSourceProperty -> Maybe RulesSourceListProperty
rulesString :: RulesSourceProperty -> Maybe (Value Text)
statefulRules :: RulesSourceProperty -> Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: RulesSourceProperty -> Maybe StatelessRulesAndCustomActionsProperty
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
rulesString :: Maybe (Value Text)
statefulRules :: Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
..}
    = RulesSourceProperty {statefulRules :: Maybe [StatefulRuleProperty]
statefulRules = [StatefulRuleProperty] -> Maybe [StatefulRuleProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [StatefulRuleProperty]
PropertyType "StatefulRules" RulesSourceProperty
newValue, Maybe (Value Text)
Maybe RulesSourceListProperty
Maybe StatelessRulesAndCustomActionsProperty
()
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
rulesString :: Maybe (Value Text)
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
rulesString :: Maybe (Value Text)
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
..}
instance Property "StatelessRulesAndCustomActions" RulesSourceProperty where
  type PropertyType "StatelessRulesAndCustomActions" RulesSourceProperty = StatelessRulesAndCustomActionsProperty
  set :: PropertyType "StatelessRulesAndCustomActions" RulesSourceProperty
-> RulesSourceProperty -> RulesSourceProperty
set PropertyType "StatelessRulesAndCustomActions" RulesSourceProperty
newValue RulesSourceProperty {Maybe [StatefulRuleProperty]
Maybe (Value Text)
Maybe RulesSourceListProperty
Maybe StatelessRulesAndCustomActionsProperty
()
haddock_workaround_ :: RulesSourceProperty -> ()
rulesSourceList :: RulesSourceProperty -> Maybe RulesSourceListProperty
rulesString :: RulesSourceProperty -> Maybe (Value Text)
statefulRules :: RulesSourceProperty -> Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: RulesSourceProperty -> Maybe StatelessRulesAndCustomActionsProperty
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
rulesString :: Maybe (Value Text)
statefulRules :: Maybe [StatefulRuleProperty]
statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
..}
    = RulesSourceProperty
        {statelessRulesAndCustomActions :: Maybe StatelessRulesAndCustomActionsProperty
statelessRulesAndCustomActions = StatelessRulesAndCustomActionsProperty
-> Maybe StatelessRulesAndCustomActionsProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "StatelessRulesAndCustomActions" RulesSourceProperty
StatelessRulesAndCustomActionsProperty
newValue, Maybe [StatefulRuleProperty]
Maybe (Value Text)
Maybe RulesSourceListProperty
()
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
rulesString :: Maybe (Value Text)
statefulRules :: Maybe [StatefulRuleProperty]
haddock_workaround_ :: ()
rulesSourceList :: Maybe RulesSourceListProperty
rulesString :: Maybe (Value Text)
statefulRules :: Maybe [StatefulRuleProperty]
..}