module Stratosphere.Cognito.IdentityPoolRoleAttachment.RulesConfigurationTypeProperty (
        module Exports, RulesConfigurationTypeProperty(..),
        mkRulesConfigurationTypeProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Cognito.IdentityPoolRoleAttachment.MappingRuleProperty as Exports
import Stratosphere.ResourceProperties
data RulesConfigurationTypeProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cognito-identitypoolroleattachment-rulesconfigurationtype.html>
    RulesConfigurationTypeProperty {RulesConfigurationTypeProperty -> ()
haddock_workaround_ :: (),
                                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cognito-identitypoolroleattachment-rulesconfigurationtype.html#cfn-cognito-identitypoolroleattachment-rulesconfigurationtype-rules>
                                    RulesConfigurationTypeProperty -> [MappingRuleProperty]
rules :: [MappingRuleProperty]}
  deriving stock (RulesConfigurationTypeProperty
-> RulesConfigurationTypeProperty -> Bool
(RulesConfigurationTypeProperty
 -> RulesConfigurationTypeProperty -> Bool)
-> (RulesConfigurationTypeProperty
    -> RulesConfigurationTypeProperty -> Bool)
-> Eq RulesConfigurationTypeProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RulesConfigurationTypeProperty
-> RulesConfigurationTypeProperty -> Bool
== :: RulesConfigurationTypeProperty
-> RulesConfigurationTypeProperty -> Bool
$c/= :: RulesConfigurationTypeProperty
-> RulesConfigurationTypeProperty -> Bool
/= :: RulesConfigurationTypeProperty
-> RulesConfigurationTypeProperty -> Bool
Prelude.Eq, Int -> RulesConfigurationTypeProperty -> ShowS
[RulesConfigurationTypeProperty] -> ShowS
RulesConfigurationTypeProperty -> String
(Int -> RulesConfigurationTypeProperty -> ShowS)
-> (RulesConfigurationTypeProperty -> String)
-> ([RulesConfigurationTypeProperty] -> ShowS)
-> Show RulesConfigurationTypeProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RulesConfigurationTypeProperty -> ShowS
showsPrec :: Int -> RulesConfigurationTypeProperty -> ShowS
$cshow :: RulesConfigurationTypeProperty -> String
show :: RulesConfigurationTypeProperty -> String
$cshowList :: [RulesConfigurationTypeProperty] -> ShowS
showList :: [RulesConfigurationTypeProperty] -> ShowS
Prelude.Show)
mkRulesConfigurationTypeProperty ::
  [MappingRuleProperty] -> RulesConfigurationTypeProperty
mkRulesConfigurationTypeProperty :: [MappingRuleProperty] -> RulesConfigurationTypeProperty
mkRulesConfigurationTypeProperty [MappingRuleProperty]
rules
  = RulesConfigurationTypeProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), rules :: [MappingRuleProperty]
rules = [MappingRuleProperty]
rules}
instance ToResourceProperties RulesConfigurationTypeProperty where
  toResourceProperties :: RulesConfigurationTypeProperty -> ResourceProperties
toResourceProperties RulesConfigurationTypeProperty {[MappingRuleProperty]
()
haddock_workaround_ :: RulesConfigurationTypeProperty -> ()
rules :: RulesConfigurationTypeProperty -> [MappingRuleProperty]
haddock_workaround_ :: ()
rules :: [MappingRuleProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Cognito::IdentityPoolRoleAttachment.RulesConfigurationType",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False, properties :: Object
properties = [Key
"Rules" Key -> [MappingRuleProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [MappingRuleProperty]
rules]}
instance JSON.ToJSON RulesConfigurationTypeProperty where
  toJSON :: RulesConfigurationTypeProperty -> Value
toJSON RulesConfigurationTypeProperty {[MappingRuleProperty]
()
haddock_workaround_ :: RulesConfigurationTypeProperty -> ()
rules :: RulesConfigurationTypeProperty -> [MappingRuleProperty]
haddock_workaround_ :: ()
rules :: [MappingRuleProperty]
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"Rules" Key -> [MappingRuleProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [MappingRuleProperty]
rules]
instance Property "Rules" RulesConfigurationTypeProperty where
  type PropertyType "Rules" RulesConfigurationTypeProperty = [MappingRuleProperty]
  set :: PropertyType "Rules" RulesConfigurationTypeProperty
-> RulesConfigurationTypeProperty -> RulesConfigurationTypeProperty
set PropertyType "Rules" RulesConfigurationTypeProperty
newValue RulesConfigurationTypeProperty {[MappingRuleProperty]
()
haddock_workaround_ :: RulesConfigurationTypeProperty -> ()
rules :: RulesConfigurationTypeProperty -> [MappingRuleProperty]
haddock_workaround_ :: ()
rules :: [MappingRuleProperty]
..}
    = RulesConfigurationTypeProperty {rules :: [MappingRuleProperty]
rules = [MappingRuleProperty]
PropertyType "Rules" RulesConfigurationTypeProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}