module Stratosphere.ControlTower.LandingZone (
        LandingZone(..), mkLandingZone
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Tag
import Stratosphere.Value
data LandingZone
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-controltower-landingzone.html>
    LandingZone {LandingZone -> ()
haddock_workaround_ :: (),
                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-controltower-landingzone.html#cfn-controltower-landingzone-manifest>
                 LandingZone -> Object
manifest :: JSON.Object,
                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-controltower-landingzone.html#cfn-controltower-landingzone-tags>
                 LandingZone -> Maybe [Tag]
tags :: (Prelude.Maybe [Tag]),
                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-controltower-landingzone.html#cfn-controltower-landingzone-version>
                 LandingZone -> Value Text
version :: (Value Prelude.Text)}
  deriving stock (LandingZone -> LandingZone -> Bool
(LandingZone -> LandingZone -> Bool)
-> (LandingZone -> LandingZone -> Bool) -> Eq LandingZone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LandingZone -> LandingZone -> Bool
== :: LandingZone -> LandingZone -> Bool
$c/= :: LandingZone -> LandingZone -> Bool
/= :: LandingZone -> LandingZone -> Bool
Prelude.Eq, Int -> LandingZone -> ShowS
[LandingZone] -> ShowS
LandingZone -> String
(Int -> LandingZone -> ShowS)
-> (LandingZone -> String)
-> ([LandingZone] -> ShowS)
-> Show LandingZone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LandingZone -> ShowS
showsPrec :: Int -> LandingZone -> ShowS
$cshow :: LandingZone -> String
show :: LandingZone -> String
$cshowList :: [LandingZone] -> ShowS
showList :: [LandingZone] -> ShowS
Prelude.Show)
mkLandingZone :: JSON.Object -> Value Prelude.Text -> LandingZone
mkLandingZone :: Object -> Value Text -> LandingZone
mkLandingZone Object
manifest Value Text
version
  = LandingZone
      {haddock_workaround_ :: ()
haddock_workaround_ = (), manifest :: Object
manifest = Object
manifest, version :: Value Text
version = Value Text
version,
       tags :: Maybe [Tag]
tags = Maybe [Tag]
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties LandingZone where
  toResourceProperties :: LandingZone -> ResourceProperties
toResourceProperties LandingZone {Maybe [Tag]
()
Object
Value Text
haddock_workaround_ :: LandingZone -> ()
manifest :: LandingZone -> Object
tags :: LandingZone -> Maybe [Tag]
version :: LandingZone -> Value Text
haddock_workaround_ :: ()
manifest :: Object
tags :: Maybe [Tag]
version :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::ControlTower::LandingZone",
         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
"Manifest" Key -> Object -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Object
manifest, Key
"Version" 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
version]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes [Key -> [Tag] -> (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" ([Tag] -> (Key, Value)) -> Maybe [Tag] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags]))}
instance JSON.ToJSON LandingZone where
  toJSON :: LandingZone -> Value
toJSON LandingZone {Maybe [Tag]
()
Object
Value Text
haddock_workaround_ :: LandingZone -> ()
manifest :: LandingZone -> Object
tags :: LandingZone -> Maybe [Tag]
version :: LandingZone -> Value Text
haddock_workaround_ :: ()
manifest :: Object
tags :: Maybe [Tag]
version :: Value Text
..}
    = [(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
"Manifest" Key -> Object -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Object
manifest, Key
"Version" 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
version]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes [Key -> [Tag] -> (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" ([Tag] -> (Key, Value)) -> Maybe [Tag] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags])))
instance Property "Manifest" LandingZone where
  type PropertyType "Manifest" LandingZone = JSON.Object
  set :: PropertyType "Manifest" LandingZone -> LandingZone -> LandingZone
set PropertyType "Manifest" LandingZone
newValue LandingZone {Maybe [Tag]
()
Object
Value Text
haddock_workaround_ :: LandingZone -> ()
manifest :: LandingZone -> Object
tags :: LandingZone -> Maybe [Tag]
version :: LandingZone -> Value Text
haddock_workaround_ :: ()
manifest :: Object
tags :: Maybe [Tag]
version :: Value Text
..}
    = LandingZone {manifest :: Object
manifest = Object
PropertyType "Manifest" LandingZone
newValue, Maybe [Tag]
()
Value Text
haddock_workaround_ :: ()
tags :: Maybe [Tag]
version :: Value Text
haddock_workaround_ :: ()
tags :: Maybe [Tag]
version :: Value Text
..}
instance Property "Tags" LandingZone where
  type PropertyType "Tags" LandingZone = [Tag]
  set :: PropertyType "Tags" LandingZone -> LandingZone -> LandingZone
set PropertyType "Tags" LandingZone
newValue LandingZone {Maybe [Tag]
()
Object
Value Text
haddock_workaround_ :: LandingZone -> ()
manifest :: LandingZone -> Object
tags :: LandingZone -> Maybe [Tag]
version :: LandingZone -> Value Text
haddock_workaround_ :: ()
manifest :: Object
tags :: Maybe [Tag]
version :: Value Text
..}
    = LandingZone {tags :: Maybe [Tag]
tags = [Tag] -> Maybe [Tag]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [Tag]
PropertyType "Tags" LandingZone
newValue, ()
Object
Value Text
haddock_workaround_ :: ()
manifest :: Object
version :: Value Text
haddock_workaround_ :: ()
manifest :: Object
version :: Value Text
..}
instance Property "Version" LandingZone where
  type PropertyType "Version" LandingZone = Value Prelude.Text
  set :: PropertyType "Version" LandingZone -> LandingZone -> LandingZone
set PropertyType "Version" LandingZone
newValue LandingZone {Maybe [Tag]
()
Object
Value Text
haddock_workaround_ :: LandingZone -> ()
manifest :: LandingZone -> Object
tags :: LandingZone -> Maybe [Tag]
version :: LandingZone -> Value Text
haddock_workaround_ :: ()
manifest :: Object
tags :: Maybe [Tag]
version :: Value Text
..}
    = LandingZone {version :: Value Text
version = PropertyType "Version" LandingZone
Value Text
newValue, Maybe [Tag]
()
Object
haddock_workaround_ :: ()
manifest :: Object
tags :: Maybe [Tag]
haddock_workaround_ :: ()
manifest :: Object
tags :: Maybe [Tag]
..}