module Stratosphere.Connect.EmailAddress.AliasConfigurationProperty (
AliasConfigurationProperty(..), mkAliasConfigurationProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data AliasConfigurationProperty
=
AliasConfigurationProperty {AliasConfigurationProperty -> ()
haddock_workaround_ :: (),
AliasConfigurationProperty -> Value Text
emailAddressArn :: (Value Prelude.Text)}
deriving stock (AliasConfigurationProperty -> AliasConfigurationProperty -> Bool
(AliasConfigurationProperty -> AliasConfigurationProperty -> Bool)
-> (AliasConfigurationProperty
-> AliasConfigurationProperty -> Bool)
-> Eq AliasConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AliasConfigurationProperty -> AliasConfigurationProperty -> Bool
== :: AliasConfigurationProperty -> AliasConfigurationProperty -> Bool
$c/= :: AliasConfigurationProperty -> AliasConfigurationProperty -> Bool
/= :: AliasConfigurationProperty -> AliasConfigurationProperty -> Bool
Prelude.Eq, Int -> AliasConfigurationProperty -> ShowS
[AliasConfigurationProperty] -> ShowS
AliasConfigurationProperty -> String
(Int -> AliasConfigurationProperty -> ShowS)
-> (AliasConfigurationProperty -> String)
-> ([AliasConfigurationProperty] -> ShowS)
-> Show AliasConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AliasConfigurationProperty -> ShowS
showsPrec :: Int -> AliasConfigurationProperty -> ShowS
$cshow :: AliasConfigurationProperty -> String
show :: AliasConfigurationProperty -> String
$cshowList :: [AliasConfigurationProperty] -> ShowS
showList :: [AliasConfigurationProperty] -> ShowS
Prelude.Show)
mkAliasConfigurationProperty ::
Value Prelude.Text -> AliasConfigurationProperty
mkAliasConfigurationProperty :: Value Text -> AliasConfigurationProperty
mkAliasConfigurationProperty Value Text
emailAddressArn
= AliasConfigurationProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), emailAddressArn :: Value Text
emailAddressArn = Value Text
emailAddressArn}
instance ToResourceProperties AliasConfigurationProperty where
toResourceProperties :: AliasConfigurationProperty -> ResourceProperties
toResourceProperties AliasConfigurationProperty {()
Value Text
haddock_workaround_ :: AliasConfigurationProperty -> ()
emailAddressArn :: AliasConfigurationProperty -> Value Text
haddock_workaround_ :: ()
emailAddressArn :: Value Text
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::Connect::EmailAddress.AliasConfiguration",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Key
"EmailAddressArn" 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
emailAddressArn]}
instance JSON.ToJSON AliasConfigurationProperty where
toJSON :: AliasConfigurationProperty -> Value
toJSON AliasConfigurationProperty {()
Value Text
haddock_workaround_ :: AliasConfigurationProperty -> ()
emailAddressArn :: AliasConfigurationProperty -> Value Text
haddock_workaround_ :: ()
emailAddressArn :: Value Text
..}
= [(Key, Value)] -> Value
JSON.object [Key
"EmailAddressArn" 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
emailAddressArn]
instance Property "EmailAddressArn" AliasConfigurationProperty where
type PropertyType "EmailAddressArn" AliasConfigurationProperty = Value Prelude.Text
set :: PropertyType "EmailAddressArn" AliasConfigurationProperty
-> AliasConfigurationProperty -> AliasConfigurationProperty
set PropertyType "EmailAddressArn" AliasConfigurationProperty
newValue AliasConfigurationProperty {()
Value Text
haddock_workaround_ :: AliasConfigurationProperty -> ()
emailAddressArn :: AliasConfigurationProperty -> Value Text
haddock_workaround_ :: ()
emailAddressArn :: Value Text
..}
= AliasConfigurationProperty {emailAddressArn :: Value Text
emailAddressArn = PropertyType "EmailAddressArn" AliasConfigurationProperty
Value Text
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}