module Stratosphere.CloudFront.DistributionTenant.CustomizationsProperty (
        module Exports, CustomizationsProperty(..),
        mkCustomizationsProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.CloudFront.DistributionTenant.CertificateProperty as Exports
import {-# SOURCE #-} Stratosphere.CloudFront.DistributionTenant.GeoRestrictionCustomizationProperty as Exports
import {-# SOURCE #-} Stratosphere.CloudFront.DistributionTenant.WebAclCustomizationProperty as Exports
import Stratosphere.ResourceProperties
data CustomizationsProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cloudfront-distributiontenant-customizations.html>
    CustomizationsProperty {CustomizationsProperty -> ()
haddock_workaround_ :: (),
                            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cloudfront-distributiontenant-customizations.html#cfn-cloudfront-distributiontenant-customizations-certificate>
                            CustomizationsProperty -> Maybe CertificateProperty
certificate :: (Prelude.Maybe CertificateProperty),
                            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cloudfront-distributiontenant-customizations.html#cfn-cloudfront-distributiontenant-customizations-georestrictions>
                            CustomizationsProperty -> Maybe GeoRestrictionCustomizationProperty
geoRestrictions :: (Prelude.Maybe GeoRestrictionCustomizationProperty),
                            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-cloudfront-distributiontenant-customizations.html#cfn-cloudfront-distributiontenant-customizations-webacl>
                            CustomizationsProperty -> Maybe WebAclCustomizationProperty
webAcl :: (Prelude.Maybe WebAclCustomizationProperty)}
  deriving stock (CustomizationsProperty -> CustomizationsProperty -> Bool
(CustomizationsProperty -> CustomizationsProperty -> Bool)
-> (CustomizationsProperty -> CustomizationsProperty -> Bool)
-> Eq CustomizationsProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomizationsProperty -> CustomizationsProperty -> Bool
== :: CustomizationsProperty -> CustomizationsProperty -> Bool
$c/= :: CustomizationsProperty -> CustomizationsProperty -> Bool
/= :: CustomizationsProperty -> CustomizationsProperty -> Bool
Prelude.Eq, Int -> CustomizationsProperty -> ShowS
[CustomizationsProperty] -> ShowS
CustomizationsProperty -> String
(Int -> CustomizationsProperty -> ShowS)
-> (CustomizationsProperty -> String)
-> ([CustomizationsProperty] -> ShowS)
-> Show CustomizationsProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomizationsProperty -> ShowS
showsPrec :: Int -> CustomizationsProperty -> ShowS
$cshow :: CustomizationsProperty -> String
show :: CustomizationsProperty -> String
$cshowList :: [CustomizationsProperty] -> ShowS
showList :: [CustomizationsProperty] -> ShowS
Prelude.Show)
mkCustomizationsProperty :: CustomizationsProperty
mkCustomizationsProperty :: CustomizationsProperty
mkCustomizationsProperty
  = CustomizationsProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), certificate :: Maybe CertificateProperty
certificate = Maybe CertificateProperty
forall a. Maybe a
Prelude.Nothing,
       geoRestrictions :: Maybe GeoRestrictionCustomizationProperty
geoRestrictions = Maybe GeoRestrictionCustomizationProperty
forall a. Maybe a
Prelude.Nothing, webAcl :: Maybe WebAclCustomizationProperty
webAcl = Maybe WebAclCustomizationProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties CustomizationsProperty where
  toResourceProperties :: CustomizationsProperty -> ResourceProperties
toResourceProperties CustomizationsProperty {Maybe CertificateProperty
Maybe GeoRestrictionCustomizationProperty
Maybe WebAclCustomizationProperty
()
haddock_workaround_ :: CustomizationsProperty -> ()
certificate :: CustomizationsProperty -> Maybe CertificateProperty
geoRestrictions :: CustomizationsProperty -> Maybe GeoRestrictionCustomizationProperty
webAcl :: CustomizationsProperty -> Maybe WebAclCustomizationProperty
haddock_workaround_ :: ()
certificate :: Maybe CertificateProperty
geoRestrictions :: Maybe GeoRestrictionCustomizationProperty
webAcl :: Maybe WebAclCustomizationProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::CloudFront::DistributionTenant.Customizations",
         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 -> CertificateProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Certificate" (CertificateProperty -> (Key, Value))
-> Maybe CertificateProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CertificateProperty
certificate,
                            Key -> GeoRestrictionCustomizationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"GeoRestrictions" (GeoRestrictionCustomizationProperty -> (Key, Value))
-> Maybe GeoRestrictionCustomizationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe GeoRestrictionCustomizationProperty
geoRestrictions,
                            Key -> WebAclCustomizationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"WebAcl" (WebAclCustomizationProperty -> (Key, Value))
-> Maybe WebAclCustomizationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe WebAclCustomizationProperty
webAcl])}
instance JSON.ToJSON CustomizationsProperty where
  toJSON :: CustomizationsProperty -> Value
toJSON CustomizationsProperty {Maybe CertificateProperty
Maybe GeoRestrictionCustomizationProperty
Maybe WebAclCustomizationProperty
()
haddock_workaround_ :: CustomizationsProperty -> ()
certificate :: CustomizationsProperty -> Maybe CertificateProperty
geoRestrictions :: CustomizationsProperty -> Maybe GeoRestrictionCustomizationProperty
webAcl :: CustomizationsProperty -> Maybe WebAclCustomizationProperty
haddock_workaround_ :: ()
certificate :: Maybe CertificateProperty
geoRestrictions :: Maybe GeoRestrictionCustomizationProperty
webAcl :: Maybe WebAclCustomizationProperty
..}
    = [(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 -> CertificateProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Certificate" (CertificateProperty -> (Key, Value))
-> Maybe CertificateProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CertificateProperty
certificate,
               Key -> GeoRestrictionCustomizationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"GeoRestrictions" (GeoRestrictionCustomizationProperty -> (Key, Value))
-> Maybe GeoRestrictionCustomizationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe GeoRestrictionCustomizationProperty
geoRestrictions,
               Key -> WebAclCustomizationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"WebAcl" (WebAclCustomizationProperty -> (Key, Value))
-> Maybe WebAclCustomizationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe WebAclCustomizationProperty
webAcl]))
instance Property "Certificate" CustomizationsProperty where
  type PropertyType "Certificate" CustomizationsProperty = CertificateProperty
  set :: PropertyType "Certificate" CustomizationsProperty
-> CustomizationsProperty -> CustomizationsProperty
set PropertyType "Certificate" CustomizationsProperty
newValue CustomizationsProperty {Maybe CertificateProperty
Maybe GeoRestrictionCustomizationProperty
Maybe WebAclCustomizationProperty
()
haddock_workaround_ :: CustomizationsProperty -> ()
certificate :: CustomizationsProperty -> Maybe CertificateProperty
geoRestrictions :: CustomizationsProperty -> Maybe GeoRestrictionCustomizationProperty
webAcl :: CustomizationsProperty -> Maybe WebAclCustomizationProperty
haddock_workaround_ :: ()
certificate :: Maybe CertificateProperty
geoRestrictions :: Maybe GeoRestrictionCustomizationProperty
webAcl :: Maybe WebAclCustomizationProperty
..}
    = CustomizationsProperty {certificate :: Maybe CertificateProperty
certificate = CertificateProperty -> Maybe CertificateProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Certificate" CustomizationsProperty
CertificateProperty
newValue, Maybe GeoRestrictionCustomizationProperty
Maybe WebAclCustomizationProperty
()
haddock_workaround_ :: ()
geoRestrictions :: Maybe GeoRestrictionCustomizationProperty
webAcl :: Maybe WebAclCustomizationProperty
haddock_workaround_ :: ()
geoRestrictions :: Maybe GeoRestrictionCustomizationProperty
webAcl :: Maybe WebAclCustomizationProperty
..}
instance Property "GeoRestrictions" CustomizationsProperty where
  type PropertyType "GeoRestrictions" CustomizationsProperty = GeoRestrictionCustomizationProperty
  set :: PropertyType "GeoRestrictions" CustomizationsProperty
-> CustomizationsProperty -> CustomizationsProperty
set PropertyType "GeoRestrictions" CustomizationsProperty
newValue CustomizationsProperty {Maybe CertificateProperty
Maybe GeoRestrictionCustomizationProperty
Maybe WebAclCustomizationProperty
()
haddock_workaround_ :: CustomizationsProperty -> ()
certificate :: CustomizationsProperty -> Maybe CertificateProperty
geoRestrictions :: CustomizationsProperty -> Maybe GeoRestrictionCustomizationProperty
webAcl :: CustomizationsProperty -> Maybe WebAclCustomizationProperty
haddock_workaround_ :: ()
certificate :: Maybe CertificateProperty
geoRestrictions :: Maybe GeoRestrictionCustomizationProperty
webAcl :: Maybe WebAclCustomizationProperty
..}
    = CustomizationsProperty
        {geoRestrictions :: Maybe GeoRestrictionCustomizationProperty
geoRestrictions = GeoRestrictionCustomizationProperty
-> Maybe GeoRestrictionCustomizationProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "GeoRestrictions" CustomizationsProperty
GeoRestrictionCustomizationProperty
newValue, Maybe CertificateProperty
Maybe WebAclCustomizationProperty
()
haddock_workaround_ :: ()
certificate :: Maybe CertificateProperty
webAcl :: Maybe WebAclCustomizationProperty
haddock_workaround_ :: ()
certificate :: Maybe CertificateProperty
webAcl :: Maybe WebAclCustomizationProperty
..}
instance Property "WebAcl" CustomizationsProperty where
  type PropertyType "WebAcl" CustomizationsProperty = WebAclCustomizationProperty
  set :: PropertyType "WebAcl" CustomizationsProperty
-> CustomizationsProperty -> CustomizationsProperty
set PropertyType "WebAcl" CustomizationsProperty
newValue CustomizationsProperty {Maybe CertificateProperty
Maybe GeoRestrictionCustomizationProperty
Maybe WebAclCustomizationProperty
()
haddock_workaround_ :: CustomizationsProperty -> ()
certificate :: CustomizationsProperty -> Maybe CertificateProperty
geoRestrictions :: CustomizationsProperty -> Maybe GeoRestrictionCustomizationProperty
webAcl :: CustomizationsProperty -> Maybe WebAclCustomizationProperty
haddock_workaround_ :: ()
certificate :: Maybe CertificateProperty
geoRestrictions :: Maybe GeoRestrictionCustomizationProperty
webAcl :: Maybe WebAclCustomizationProperty
..}
    = CustomizationsProperty {webAcl :: Maybe WebAclCustomizationProperty
webAcl = WebAclCustomizationProperty -> Maybe WebAclCustomizationProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "WebAcl" CustomizationsProperty
WebAclCustomizationProperty
newValue, Maybe CertificateProperty
Maybe GeoRestrictionCustomizationProperty
()
haddock_workaround_ :: ()
certificate :: Maybe CertificateProperty
geoRestrictions :: Maybe GeoRestrictionCustomizationProperty
haddock_workaround_ :: ()
certificate :: Maybe CertificateProperty
geoRestrictions :: Maybe GeoRestrictionCustomizationProperty
..}