module Stratosphere.PinpointEmail.Identity (
        module Exports, Identity(..), mkIdentity
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.PinpointEmail.Identity.MailFromAttributesProperty as Exports
import {-# SOURCE #-} Stratosphere.PinpointEmail.Identity.TagsProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data Identity
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-pinpointemail-identity.html>
    Identity {Identity -> ()
haddock_workaround_ :: (),
              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-pinpointemail-identity.html#cfn-pinpointemail-identity-dkimsigningenabled>
              Identity -> Maybe (Value Bool)
dkimSigningEnabled :: (Prelude.Maybe (Value Prelude.Bool)),
              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-pinpointemail-identity.html#cfn-pinpointemail-identity-feedbackforwardingenabled>
              Identity -> Maybe (Value Bool)
feedbackForwardingEnabled :: (Prelude.Maybe (Value Prelude.Bool)),
              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-pinpointemail-identity.html#cfn-pinpointemail-identity-mailfromattributes>
              Identity -> Maybe MailFromAttributesProperty
mailFromAttributes :: (Prelude.Maybe MailFromAttributesProperty),
              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-pinpointemail-identity.html#cfn-pinpointemail-identity-name>
              Identity -> Value Text
name :: (Value Prelude.Text),
              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-pinpointemail-identity.html#cfn-pinpointemail-identity-tags>
              Identity -> Maybe [TagsProperty]
tags :: (Prelude.Maybe [TagsProperty])}
  deriving stock (Identity -> Identity -> Bool
(Identity -> Identity -> Bool)
-> (Identity -> Identity -> Bool) -> Eq Identity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Identity -> Identity -> Bool
== :: Identity -> Identity -> Bool
$c/= :: Identity -> Identity -> Bool
/= :: Identity -> Identity -> Bool
Prelude.Eq, Int -> Identity -> ShowS
[Identity] -> ShowS
Identity -> String
(Int -> Identity -> ShowS)
-> (Identity -> String) -> ([Identity] -> ShowS) -> Show Identity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Identity -> ShowS
showsPrec :: Int -> Identity -> ShowS
$cshow :: Identity -> String
show :: Identity -> String
$cshowList :: [Identity] -> ShowS
showList :: [Identity] -> ShowS
Prelude.Show)
mkIdentity :: Value Prelude.Text -> Identity
mkIdentity :: Value Text -> Identity
mkIdentity Value Text
name
  = Identity
      {haddock_workaround_ :: ()
haddock_workaround_ = (), name :: Value Text
name = Value Text
name,
       dkimSigningEnabled :: Maybe (Value Bool)
dkimSigningEnabled = Maybe (Value Bool)
forall a. Maybe a
Prelude.Nothing,
       feedbackForwardingEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled = Maybe (Value Bool)
forall a. Maybe a
Prelude.Nothing,
       mailFromAttributes :: Maybe MailFromAttributesProperty
mailFromAttributes = Maybe MailFromAttributesProperty
forall a. Maybe a
Prelude.Nothing, tags :: Maybe [TagsProperty]
tags = Maybe [TagsProperty]
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties Identity where
  toResourceProperties :: Identity -> ResourceProperties
toResourceProperties Identity {Maybe [TagsProperty]
Maybe (Value Bool)
Maybe MailFromAttributesProperty
()
Value Text
haddock_workaround_ :: Identity -> ()
dkimSigningEnabled :: Identity -> Maybe (Value Bool)
feedbackForwardingEnabled :: Identity -> Maybe (Value Bool)
mailFromAttributes :: Identity -> Maybe MailFromAttributesProperty
name :: Identity -> Value Text
tags :: Identity -> Maybe [TagsProperty]
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
tags :: Maybe [TagsProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::PinpointEmail::Identity",
         supportsTags :: Bool
supportsTags = Bool
Prelude.True,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
                           [Key
"Name" 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
name]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"DkimSigningEnabled" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
dkimSigningEnabled,
                               Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"FeedbackForwardingEnabled"
                                 (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
feedbackForwardingEnabled,
                               Key -> MailFromAttributesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MailFromAttributes" (MailFromAttributesProperty -> (Key, Value))
-> Maybe MailFromAttributesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MailFromAttributesProperty
mailFromAttributes,
                               Key -> [TagsProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Tags" ([TagsProperty] -> (Key, Value))
-> Maybe [TagsProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagsProperty]
tags]))}
instance JSON.ToJSON Identity where
  toJSON :: Identity -> Value
toJSON Identity {Maybe [TagsProperty]
Maybe (Value Bool)
Maybe MailFromAttributesProperty
()
Value Text
haddock_workaround_ :: Identity -> ()
dkimSigningEnabled :: Identity -> Maybe (Value Bool)
feedbackForwardingEnabled :: Identity -> Maybe (Value Bool)
mailFromAttributes :: Identity -> Maybe MailFromAttributesProperty
name :: Identity -> Value Text
tags :: Identity -> Maybe [TagsProperty]
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
tags :: Maybe [TagsProperty]
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
              [Key
"Name" 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
name]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"DkimSigningEnabled" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
dkimSigningEnabled,
                  Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"FeedbackForwardingEnabled"
                    (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
feedbackForwardingEnabled,
                  Key -> MailFromAttributesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MailFromAttributes" (MailFromAttributesProperty -> (Key, Value))
-> Maybe MailFromAttributesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MailFromAttributesProperty
mailFromAttributes,
                  Key -> [TagsProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Tags" ([TagsProperty] -> (Key, Value))
-> Maybe [TagsProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagsProperty]
tags])))
instance Property "DkimSigningEnabled" Identity where
  type PropertyType "DkimSigningEnabled" Identity = Value Prelude.Bool
  set :: PropertyType "DkimSigningEnabled" Identity -> Identity -> Identity
set PropertyType "DkimSigningEnabled" Identity
newValue Identity {Maybe [TagsProperty]
Maybe (Value Bool)
Maybe MailFromAttributesProperty
()
Value Text
haddock_workaround_ :: Identity -> ()
dkimSigningEnabled :: Identity -> Maybe (Value Bool)
feedbackForwardingEnabled :: Identity -> Maybe (Value Bool)
mailFromAttributes :: Identity -> Maybe MailFromAttributesProperty
name :: Identity -> Value Text
tags :: Identity -> Maybe [TagsProperty]
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
tags :: Maybe [TagsProperty]
..}
    = Identity {dkimSigningEnabled :: Maybe (Value Bool)
dkimSigningEnabled = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "DkimSigningEnabled" Identity
Value Bool
newValue, Maybe [TagsProperty]
Maybe (Value Bool)
Maybe MailFromAttributesProperty
()
Value Text
haddock_workaround_ :: ()
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
tags :: Maybe [TagsProperty]
haddock_workaround_ :: ()
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
tags :: Maybe [TagsProperty]
..}
instance Property "FeedbackForwardingEnabled" Identity where
  type PropertyType "FeedbackForwardingEnabled" Identity = Value Prelude.Bool
  set :: PropertyType "FeedbackForwardingEnabled" Identity
-> Identity -> Identity
set PropertyType "FeedbackForwardingEnabled" Identity
newValue Identity {Maybe [TagsProperty]
Maybe (Value Bool)
Maybe MailFromAttributesProperty
()
Value Text
haddock_workaround_ :: Identity -> ()
dkimSigningEnabled :: Identity -> Maybe (Value Bool)
feedbackForwardingEnabled :: Identity -> Maybe (Value Bool)
mailFromAttributes :: Identity -> Maybe MailFromAttributesProperty
name :: Identity -> Value Text
tags :: Identity -> Maybe [TagsProperty]
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
tags :: Maybe [TagsProperty]
..}
    = Identity {feedbackForwardingEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "FeedbackForwardingEnabled" Identity
Value Bool
newValue, Maybe [TagsProperty]
Maybe (Value Bool)
Maybe MailFromAttributesProperty
()
Value Text
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
tags :: Maybe [TagsProperty]
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
tags :: Maybe [TagsProperty]
..}
instance Property "MailFromAttributes" Identity where
  type PropertyType "MailFromAttributes" Identity = MailFromAttributesProperty
  set :: PropertyType "MailFromAttributes" Identity -> Identity -> Identity
set PropertyType "MailFromAttributes" Identity
newValue Identity {Maybe [TagsProperty]
Maybe (Value Bool)
Maybe MailFromAttributesProperty
()
Value Text
haddock_workaround_ :: Identity -> ()
dkimSigningEnabled :: Identity -> Maybe (Value Bool)
feedbackForwardingEnabled :: Identity -> Maybe (Value Bool)
mailFromAttributes :: Identity -> Maybe MailFromAttributesProperty
name :: Identity -> Value Text
tags :: Identity -> Maybe [TagsProperty]
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
tags :: Maybe [TagsProperty]
..}
    = Identity {mailFromAttributes :: Maybe MailFromAttributesProperty
mailFromAttributes = MailFromAttributesProperty -> Maybe MailFromAttributesProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "MailFromAttributes" Identity
MailFromAttributesProperty
newValue, Maybe [TagsProperty]
Maybe (Value Bool)
()
Value Text
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
name :: Value Text
tags :: Maybe [TagsProperty]
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
name :: Value Text
tags :: Maybe [TagsProperty]
..}
instance Property "Name" Identity where
  type PropertyType "Name" Identity = Value Prelude.Text
  set :: PropertyType "Name" Identity -> Identity -> Identity
set PropertyType "Name" Identity
newValue Identity {Maybe [TagsProperty]
Maybe (Value Bool)
Maybe MailFromAttributesProperty
()
Value Text
haddock_workaround_ :: Identity -> ()
dkimSigningEnabled :: Identity -> Maybe (Value Bool)
feedbackForwardingEnabled :: Identity -> Maybe (Value Bool)
mailFromAttributes :: Identity -> Maybe MailFromAttributesProperty
name :: Identity -> Value Text
tags :: Identity -> Maybe [TagsProperty]
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
tags :: Maybe [TagsProperty]
..} = Identity {name :: Value Text
name = PropertyType "Name" Identity
Value Text
newValue, Maybe [TagsProperty]
Maybe (Value Bool)
Maybe MailFromAttributesProperty
()
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
tags :: Maybe [TagsProperty]
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
tags :: Maybe [TagsProperty]
..}
instance Property "Tags" Identity where
  type PropertyType "Tags" Identity = [TagsProperty]
  set :: PropertyType "Tags" Identity -> Identity -> Identity
set PropertyType "Tags" Identity
newValue Identity {Maybe [TagsProperty]
Maybe (Value Bool)
Maybe MailFromAttributesProperty
()
Value Text
haddock_workaround_ :: Identity -> ()
dkimSigningEnabled :: Identity -> Maybe (Value Bool)
feedbackForwardingEnabled :: Identity -> Maybe (Value Bool)
mailFromAttributes :: Identity -> Maybe MailFromAttributesProperty
name :: Identity -> Value Text
tags :: Identity -> Maybe [TagsProperty]
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
tags :: Maybe [TagsProperty]
..}
    = Identity {tags :: Maybe [TagsProperty]
tags = [TagsProperty] -> Maybe [TagsProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [TagsProperty]
PropertyType "Tags" Identity
newValue, Maybe (Value Bool)
Maybe MailFromAttributesProperty
()
Value Text
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
haddock_workaround_ :: ()
dkimSigningEnabled :: Maybe (Value Bool)
feedbackForwardingEnabled :: Maybe (Value Bool)
mailFromAttributes :: Maybe MailFromAttributesProperty
name :: Value Text
..}