module Stratosphere.RolesAnywhere.Profile.AttributeMappingProperty (
        module Exports, AttributeMappingProperty(..),
        mkAttributeMappingProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.RolesAnywhere.Profile.MappingRuleProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data AttributeMappingProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-rolesanywhere-profile-attributemapping.html>
    AttributeMappingProperty {AttributeMappingProperty -> ()
haddock_workaround_ :: (),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-rolesanywhere-profile-attributemapping.html#cfn-rolesanywhere-profile-attributemapping-certificatefield>
                              AttributeMappingProperty -> Value Text
certificateField :: (Value Prelude.Text),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-rolesanywhere-profile-attributemapping.html#cfn-rolesanywhere-profile-attributemapping-mappingrules>
                              AttributeMappingProperty -> [MappingRuleProperty]
mappingRules :: [MappingRuleProperty]}
  deriving stock (AttributeMappingProperty -> AttributeMappingProperty -> Bool
(AttributeMappingProperty -> AttributeMappingProperty -> Bool)
-> (AttributeMappingProperty -> AttributeMappingProperty -> Bool)
-> Eq AttributeMappingProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttributeMappingProperty -> AttributeMappingProperty -> Bool
== :: AttributeMappingProperty -> AttributeMappingProperty -> Bool
$c/= :: AttributeMappingProperty -> AttributeMappingProperty -> Bool
/= :: AttributeMappingProperty -> AttributeMappingProperty -> Bool
Prelude.Eq, Int -> AttributeMappingProperty -> ShowS
[AttributeMappingProperty] -> ShowS
AttributeMappingProperty -> String
(Int -> AttributeMappingProperty -> ShowS)
-> (AttributeMappingProperty -> String)
-> ([AttributeMappingProperty] -> ShowS)
-> Show AttributeMappingProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttributeMappingProperty -> ShowS
showsPrec :: Int -> AttributeMappingProperty -> ShowS
$cshow :: AttributeMappingProperty -> String
show :: AttributeMappingProperty -> String
$cshowList :: [AttributeMappingProperty] -> ShowS
showList :: [AttributeMappingProperty] -> ShowS
Prelude.Show)
mkAttributeMappingProperty ::
  Value Prelude.Text
  -> [MappingRuleProperty] -> AttributeMappingProperty
mkAttributeMappingProperty :: Value Text -> [MappingRuleProperty] -> AttributeMappingProperty
mkAttributeMappingProperty Value Text
certificateField [MappingRuleProperty]
mappingRules
  = AttributeMappingProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), certificateField :: Value Text
certificateField = Value Text
certificateField,
       mappingRules :: [MappingRuleProperty]
mappingRules = [MappingRuleProperty]
mappingRules}
instance ToResourceProperties AttributeMappingProperty where
  toResourceProperties :: AttributeMappingProperty -> ResourceProperties
toResourceProperties AttributeMappingProperty {[MappingRuleProperty]
()
Value Text
haddock_workaround_ :: AttributeMappingProperty -> ()
certificateField :: AttributeMappingProperty -> Value Text
mappingRules :: AttributeMappingProperty -> [MappingRuleProperty]
haddock_workaround_ :: ()
certificateField :: Value Text
mappingRules :: [MappingRuleProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::RolesAnywhere::Profile.AttributeMapping",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"CertificateField" 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
certificateField,
                       Key
"MappingRules" 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]
mappingRules]}
instance JSON.ToJSON AttributeMappingProperty where
  toJSON :: AttributeMappingProperty -> Value
toJSON AttributeMappingProperty {[MappingRuleProperty]
()
Value Text
haddock_workaround_ :: AttributeMappingProperty -> ()
certificateField :: AttributeMappingProperty -> Value Text
mappingRules :: AttributeMappingProperty -> [MappingRuleProperty]
haddock_workaround_ :: ()
certificateField :: Value Text
mappingRules :: [MappingRuleProperty]
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"CertificateField" 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
certificateField,
         Key
"MappingRules" 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]
mappingRules]
instance Property "CertificateField" AttributeMappingProperty where
  type PropertyType "CertificateField" AttributeMappingProperty = Value Prelude.Text
  set :: PropertyType "CertificateField" AttributeMappingProperty
-> AttributeMappingProperty -> AttributeMappingProperty
set PropertyType "CertificateField" AttributeMappingProperty
newValue AttributeMappingProperty {[MappingRuleProperty]
()
Value Text
haddock_workaround_ :: AttributeMappingProperty -> ()
certificateField :: AttributeMappingProperty -> Value Text
mappingRules :: AttributeMappingProperty -> [MappingRuleProperty]
haddock_workaround_ :: ()
certificateField :: Value Text
mappingRules :: [MappingRuleProperty]
..}
    = AttributeMappingProperty {certificateField :: Value Text
certificateField = PropertyType "CertificateField" AttributeMappingProperty
Value Text
newValue, [MappingRuleProperty]
()
haddock_workaround_ :: ()
mappingRules :: [MappingRuleProperty]
haddock_workaround_ :: ()
mappingRules :: [MappingRuleProperty]
..}
instance Property "MappingRules" AttributeMappingProperty where
  type PropertyType "MappingRules" AttributeMappingProperty = [MappingRuleProperty]
  set :: PropertyType "MappingRules" AttributeMappingProperty
-> AttributeMappingProperty -> AttributeMappingProperty
set PropertyType "MappingRules" AttributeMappingProperty
newValue AttributeMappingProperty {[MappingRuleProperty]
()
Value Text
haddock_workaround_ :: AttributeMappingProperty -> ()
certificateField :: AttributeMappingProperty -> Value Text
mappingRules :: AttributeMappingProperty -> [MappingRuleProperty]
haddock_workaround_ :: ()
certificateField :: Value Text
mappingRules :: [MappingRuleProperty]
..}
    = AttributeMappingProperty {mappingRules :: [MappingRuleProperty]
mappingRules = [MappingRuleProperty]
PropertyType "MappingRules" AttributeMappingProperty
newValue, ()
Value Text
haddock_workaround_ :: ()
certificateField :: Value Text
haddock_workaround_ :: ()
certificateField :: Value Text
..}