-- | See:
-- http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/template-anatomy.html

module Stratosphere.Template
  ( Template(..)
  , Mapping
  , encodeTemplate
  , mkTemplate
  )
where

import Data.Aeson
import Data.Aeson.Encode.Pretty
import Prelude
import Stratosphere.Output
import Stratosphere.Parameter
import Stratosphere.Prelude
import Stratosphere.Property
import Stratosphere.Resource

import qualified Data.ByteString.Lazy as BS
import qualified Data.Aeson           as JSON
import qualified Data.Char            as Char

type Mapping = Map Text Object

data Template =
  Template
  { Template -> Maybe Object
conditions :: Maybe Object
    -- ^ Defines conditions that control whether certain resources are created
    -- or whether certain resource properties are assigned a value during stack
    -- creation or update. For example, you could conditionally create a
    -- resource that depends on whether the stack is for a production or test
    -- environment.
  , Template -> Maybe Text
description :: Maybe Text
    -- ^ A text string that describes the template. This section must always
    -- follow the template format version section.
  , Template -> Maybe Text
formatVersion :: Maybe Text
    -- ^ Specifies the AWS CloudFormation template version that the template
    -- conforms to. The template format version is not the same as the API or
    -- WSDL version. The template format version can change independently of
    -- the API and WSDL versions.
  , Template -> Maybe (Map Text Mapping)
mappings :: Maybe (Map Text Mapping)
    -- ^ A mapping of keys and associated values that you can use to specify
    -- conditional parameter values, similar to a lookup table. You can match a
    -- key to a corresponding value by using the Fn::FindInMap intrinsic
    -- function in the Resources and Outputs section.
  , Template -> Maybe Object
metadata :: Maybe Object
    -- ^ JSON objects that provide additional information about the template.
  , Template -> Maybe Outputs
outputs :: Maybe Outputs
    -- ^ Describes the values that are returned whenever you view your stack's
    -- properties. For example, you can declare an output for an Amazon S3
    -- bucket name and then call the aws cloudformation describe-stacks AWS CLI
    -- command to view the name.
  , Template -> Maybe Parameters
parameters :: Maybe Parameters
    -- ^ Specifies values that you can pass in to your template at runtime
    -- (when you create or update a stack). You can refer to parameters in the
    -- Resources and Outputs sections of the template.
  , Template -> Resources
resources :: Resources
    -- ^ Specifies the stack resources and their properties, such as an Amazon
    -- Elastic Compute Cloud instance or an Amazon Simple Storage Service
    -- bucket. You can refer to resources in the Resources and Outputs sections
    -- of the template.
  }
  deriving (Int -> Template -> ShowS
[Template] -> ShowS
Template -> String
(Int -> Template -> ShowS)
-> (Template -> String) -> ([Template] -> ShowS) -> Show Template
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Template -> ShowS
showsPrec :: Int -> Template -> ShowS
$cshow :: Template -> String
show :: Template -> String
$cshowList :: [Template] -> ShowS
showList :: [Template] -> ShowS
Show, Template -> Template -> Bool
(Template -> Template -> Bool)
-> (Template -> Template -> Bool) -> Eq Template
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Template -> Template -> Bool
== :: Template -> Template -> Bool
$c/= :: Template -> Template -> Bool
/= :: Template -> Template -> Bool
Eq, (forall x. Template -> Rep Template x)
-> (forall x. Rep Template x -> Template) -> Generic Template
forall x. Rep Template x -> Template
forall x. Template -> Rep Template x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Template -> Rep Template x
from :: forall x. Template -> Rep Template x
$cto :: forall x. Rep Template x -> Template
to :: forall x. Rep Template x -> Template
Generic)

instance Property "Conditions" Template where
  type PropertyType "Conditions" Template = Object
  set :: PropertyType "Conditions" Template -> Template -> Template
set PropertyType "Conditions" Template
newValue Template{Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
conditions :: Template -> Maybe Object
description :: Template -> Maybe Text
formatVersion :: Template -> Maybe Text
mappings :: Template -> Maybe (Map Text Mapping)
metadata :: Template -> Maybe Object
outputs :: Template -> Maybe Outputs
parameters :: Template -> Maybe Parameters
resources :: Template -> Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..} = Template{conditions :: Maybe Object
conditions = Object -> Maybe Object
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
PropertyType "Conditions" Template
newValue, Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..}

instance Property "Description" Template where
  type PropertyType "Description" Template = Text
  set :: PropertyType "Description" Template -> Template -> Template
set PropertyType "Description" Template
newValue Template{Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
conditions :: Template -> Maybe Object
description :: Template -> Maybe Text
formatVersion :: Template -> Maybe Text
mappings :: Template -> Maybe (Map Text Mapping)
metadata :: Template -> Maybe Object
outputs :: Template -> Maybe Outputs
parameters :: Template -> Maybe Parameters
resources :: Template -> Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..} = Template{description :: Maybe Text
description = Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
PropertyType "Description" Template
newValue, Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
conditions :: Maybe Object
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
conditions :: Maybe Object
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..}

instance Property "FormatVersion" Template where
  type PropertyType "FormatVersion" Template = Text
  set :: PropertyType "FormatVersion" Template -> Template -> Template
set PropertyType "FormatVersion" Template
newValue Template{Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
conditions :: Template -> Maybe Object
description :: Template -> Maybe Text
formatVersion :: Template -> Maybe Text
mappings :: Template -> Maybe (Map Text Mapping)
metadata :: Template -> Maybe Object
outputs :: Template -> Maybe Outputs
parameters :: Template -> Maybe Parameters
resources :: Template -> Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..} = Template{formatVersion :: Maybe Text
formatVersion = Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
PropertyType "FormatVersion" Template
newValue, Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
conditions :: Maybe Object
description :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
conditions :: Maybe Object
description :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..}

instance Property "Mappings" Template where
  type PropertyType "Mappings" Template = Map Text Mapping
  set :: PropertyType "Mappings" Template -> Template -> Template
set PropertyType "Mappings" Template
newValue Template{Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
conditions :: Template -> Maybe Object
description :: Template -> Maybe Text
formatVersion :: Template -> Maybe Text
mappings :: Template -> Maybe (Map Text Mapping)
metadata :: Template -> Maybe Object
outputs :: Template -> Maybe Outputs
parameters :: Template -> Maybe Parameters
resources :: Template -> Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..} = Template{mappings :: Maybe (Map Text Mapping)
mappings = Map Text Mapping -> Maybe (Map Text Mapping)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Mapping
PropertyType "Mappings" Template
newValue, Maybe Object
Maybe Text
Maybe Parameters
Maybe Outputs
Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..}

instance Property "Metadata" Template where
  type PropertyType "Metadata" Template = JSON.Object
  set :: PropertyType "Metadata" Template -> Template -> Template
set PropertyType "Metadata" Template
newValue Template{Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
conditions :: Template -> Maybe Object
description :: Template -> Maybe Text
formatVersion :: Template -> Maybe Text
mappings :: Template -> Maybe (Map Text Mapping)
metadata :: Template -> Maybe Object
outputs :: Template -> Maybe Outputs
parameters :: Template -> Maybe Parameters
resources :: Template -> Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..} = Template{metadata :: Maybe Object
metadata = Object -> Maybe Object
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
PropertyType "Metadata" Template
newValue, Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..}

instance Property "Outputs" Template where
  type PropertyType "Outputs" Template = Outputs
  set :: PropertyType "Outputs" Template -> Template -> Template
set PropertyType "Outputs" Template
newValue Template{Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
conditions :: Template -> Maybe Object
description :: Template -> Maybe Text
formatVersion :: Template -> Maybe Text
mappings :: Template -> Maybe (Map Text Mapping)
metadata :: Template -> Maybe Object
outputs :: Template -> Maybe Outputs
parameters :: Template -> Maybe Parameters
resources :: Template -> Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..} = Template{outputs :: Maybe Outputs
outputs = Outputs -> Maybe Outputs
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PropertyType "Outputs" Template
Outputs
newValue, Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
parameters :: Maybe Parameters
resources :: Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
parameters :: Maybe Parameters
resources :: Resources
..}

instance Property "Parameters" Template where
  type PropertyType "Parameters" Template = Parameters
  set :: PropertyType "Parameters" Template -> Template -> Template
set PropertyType "Parameters" Template
newValue Template{Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
conditions :: Template -> Maybe Object
description :: Template -> Maybe Text
formatVersion :: Template -> Maybe Text
mappings :: Template -> Maybe (Map Text Mapping)
metadata :: Template -> Maybe Object
outputs :: Template -> Maybe Outputs
parameters :: Template -> Maybe Parameters
resources :: Template -> Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..} = Template{parameters :: Maybe Parameters
parameters = Parameters -> Maybe Parameters
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PropertyType "Parameters" Template
Parameters
newValue, Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Outputs
Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
resources :: Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
resources :: Resources
..}

instance Property "Resources" Template where
  type PropertyType "Resources" Template = Resources
  set :: PropertyType "Resources" Template -> Template -> Template
set PropertyType "Resources" Template
newValue Template{Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
Resources
conditions :: Template -> Maybe Object
description :: Template -> Maybe Text
formatVersion :: Template -> Maybe Text
mappings :: Template -> Maybe (Map Text Mapping)
metadata :: Template -> Maybe Object
outputs :: Template -> Maybe Outputs
parameters :: Template -> Maybe Parameters
resources :: Template -> Resources
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
resources :: Resources
..} = Template{resources :: Resources
resources = PropertyType "Resources" Template
Resources
newValue, Maybe Object
Maybe Text
Maybe (Map Text Mapping)
Maybe Parameters
Maybe Outputs
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
conditions :: Maybe Object
description :: Maybe Text
formatVersion :: Maybe Text
mappings :: Maybe (Map Text Mapping)
metadata :: Maybe Object
outputs :: Maybe Outputs
parameters :: Maybe Parameters
..}

instance JSON.ToJSON Template where
  toJSON :: Template -> Value
toJSON
    = Options -> Template -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
JSON.genericToJSON
    (Options -> Template -> Value) -> Options -> Template -> Value
forall a b. (a -> b) -> a -> b
$ Options
JSON.defaultOptions
    { JSON.fieldLabelModifier = upperHead
    , JSON.omitNothingFields  = True
    }
    where
      upperHead :: String -> String
      upperHead :: ShowS
upperHead = \case
        (Char
headc:String
tails) -> Char -> Char
Char.toUpper Char
headc Char -> ShowS
forall a. a -> [a] -> [a]
: String
tails
        String
other         -> String
other

-- | Convenient constructor for 'Template' with required arguments.
mkTemplate :: Resources -> Template
mkTemplate :: Resources -> Template
mkTemplate Resources
resources
  = Template
  { formatVersion :: Maybe Text
formatVersion = Maybe Text
forall a. Maybe a
Nothing
  , description :: Maybe Text
description   = Maybe Text
forall a. Maybe a
Nothing
  , metadata :: Maybe Object
metadata      = Maybe Object
forall a. Maybe a
Nothing
  , parameters :: Maybe Parameters
parameters    = Maybe Parameters
forall a. Maybe a
Nothing
  , mappings :: Maybe (Map Text Mapping)
mappings      = Maybe (Map Text Mapping)
forall a. Maybe a
Nothing
  , conditions :: Maybe Object
conditions    = Maybe Object
forall a. Maybe a
Nothing
  , outputs :: Maybe Outputs
outputs       = Maybe Outputs
forall a. Maybe a
Nothing
  , Resources
resources :: Resources
resources :: Resources
..
  }

-- | Pretty print a template using aeson-pretty.
encodeTemplate :: Template -> BS.ByteString
encodeTemplate :: Template -> ByteString
encodeTemplate = Config -> Template -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
defConfig { confIndent = Spaces 2, confCompare = comp }
  where
    comp :: Text -> Text -> Ordering
comp
      = [Text] -> Text -> Text -> Ordering
keyOrder
      [ Text
Item [Text]
"AWSTemplateFormatVersion"
      , Text
Item [Text]
"Description"
      , Text
Item [Text]
"Metadata"
      , Text
Item [Text]
"Parameters"
      , Text
Item [Text]
"Mappings"
      , Text
Item [Text]
"Conditions"
      , Text
Item [Text]
"Resources"
      , Text
Item [Text]
"Outputs"
      ]