Generate cloudformation from dhall

README.md

Example Dhall Cloudformation stuff

Call it like this:

dhall text <<< './sqs-broker-template.dhall "myQueueName" (toMap {tag1 = "foo", tag2 = "bar"}) False'

(change False to True for a FIFO queue)

sqs-broker-template.dhall

let JSON =
      https://raw.githubusercontent.com/dhall-lang/dhall-lang/v18.0.0/Prelude/JSON/package.dhall sha256:79dfc281a05bc7b78f927e0da0c274ee5709b1c55c9e5f59499cb28e9d6f3ec0

let List/map =
      https://raw.githubusercontent.com/dhall-lang/dhall-lang/v18.0.0/Prelude/List/map.dhall sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680

let Map =
      https://raw.githubusercontent.com/dhall-lang/dhall-lang/v18.0.0/Prelude/Map/Type.dhall sha256:210c7a9eba71efbb0f7a66b3dcf8b9d3976ffc2bc0e907aadfb6aa29c333e8ed

let Ref
    : Text → JSON.Type
    = λ(name : Text) → JSON.object (toMap { Ref = JSON.string name })

let GetAtt
    : Text → Text → JSON.Type
    = λ(name : Text) →
      λ(attribute : Text) →
        JSON.object
          ( toMap
              { `Fn::GetAtt` =
                  JSON.array [ JSON.string name, JSON.string attribute ]
              }
          )

let FnEquals
    : JSON.Type → JSON.Type → JSON.Type
    = λ(l : JSON.Type) →
      λ(r : JSON.Type) →
        JSON.object (toMap { `Fn::Equals` = JSON.array [ l, r ] })

let FnIf
    : Text → JSON.Type → JSON.Type → JSON.Type
    = λ(condition : Text) →
      λ(valueIfTrue : JSON.Type) →
      λ(valueIfFalse : JSON.Type) →
        JSON.object
          ( toMap
              { `Fn::If` =
                  JSON.array
                    [ JSON.string condition, valueIfTrue, valueIfFalse ]
              }
          )

let FnSub2
    : Text → Map Text JSON.Type → JSON.Type
    = λ(toReplace : Text) →
      λ(replacements : Map Text JSON.Type) →
        JSON.object
          ( toMap
              { `Fn::Sub` =
                  JSON.array [ JSON.string toReplace, JSON.object replacements ]
              }
          )

let NoValue
    : JSON.Type
    = JSON.string "AWS::NoValue"

let NumberParameter
    : Map Text JSON.Type
    = toMap { Type = JSON.string "Number" }

let withDescription
    : Text → Map Text JSON.Type
    = λ(description : Text) →
        [ { mapKey = "Description", mapValue = JSON.string description } ]

let withField
    : Text → JSON.Type → Map Text JSON.Type
    = λ(name : Text) →
      λ(value : JSON.Type) →
        [ { mapKey = name, mapValue = value } ]

let toAWSTag
    : { mapKey : Text, mapValue : Text } → JSON.Type
    = λ(tag : { mapKey : Text, mapValue : Text }) →
        JSON.object
          ( toMap
              { Key = JSON.string tag.mapKey, Value = JSON.string tag.mapValue }
          )

let withTags
    : Map Text Text → Map Text JSON.Type
    = λ(tags : Map Text Text) →
        toMap
          { Tags =
              JSON.array
                ( List/map
                    { mapKey : Text, mapValue : Text }
                    JSON.Type
                    toAWSTag
                    tags
                )
          }

let withNaturalField
    : Text → Natural → Map Text JSON.Type
    = λ(fieldName : Text) →
      λ(value : Natural) →
        [ { mapKey = fieldName, mapValue = JSON.natural value } ]

let withDefault = withNaturalField "Default"

let withMinValue = withNaturalField "MinValue"

let withMaxValue = withNaturalField "MaxValue"

let Output
    : ∀(description : Text) →
      ∀(value : JSON.Type) →
      ∀(exportName : Text) →
        JSON.Type
    = λ(description : Text) →
      λ(value : JSON.Type) →
      λ(exportName : Text) →
        JSON.object
          ( toMap
              { Description = JSON.string description
              , Value = value
              , Export = JSON.object (toMap { Name = JSON.string exportName })
              }
          )

in  λ(queueName : Text) →
    λ(tags : Map Text Text) →
    λ(isFIFO : Bool) →
      let parameters =
            { DelaySeconds =
                JSON.object
                  (   NumberParameter
                    # withDescription
                        ''
                        The time in seconds for which the delivery of all
                        messages in the queue is delayed. You can specify an
                        integer value of 0 to 900 (15 minutes).
                        ''
                    # withDefault 0
                    # withMinValue 0
                    # withMaxValue 900
                  )
            , MaximumMessageSize =
                JSON.object
                  (   NumberParameter
                    # withDescription
                        ''
                        The limit of how many bytes that a message can contain before Amazon SQS rejects it. You can specify an integer value from 1,024 bytes (1 KiB) to 262,144 bytes (256 KiB). The default value is 262,144 (256 KiB).
                        ''
                    # withDefault 262144
                    # withMinValue 1024
                    # withMaxValue 262144
                  )
            , MessageRetentionPeriod = JSON.object NumberParameter
            , ReceiveMessageWaitTimeSeconds = JSON.object NumberParameter
            , RedriveMaxReceiveCount = JSON.object NumberParameter
            , VisibilityTimeout = JSON.object NumberParameter
            }

      let redrivePolicy
          : Text
          = JSON.render
              ( JSON.object
                  ( toMap
                      { deadLetterTargetArn =
                          JSON.string "\${DeadLetterTargetArn}"
                      , maxReceiveCount = JSON.string "\${MaxReceiveCount}"
                      }
                  )
              )

      let primaryQueue =
            { Type = JSON.string "AWS::SQS::Queue"
            , Properties =
                JSON.object
                  (   withField "QueueName" (JSON.string "${queueName}-pri")
                    # withTags (tags # toMap { QueueType = "Primary" })
                    # withField "DelaySeconds" (Ref "DelaySeconds")
                    # withField "FifoQueue" (JSON.bool isFIFO)
                    # withField "MaximumMessageSize" (Ref "MaximumMessageSize")
                    # withField
                        "MessageRetentionPeriod"
                        (Ref "MessageRetentionPeriod")
                    # withField
                        "ReceiveMessageWaitTimeSeconds"
                        (Ref "ReceiveMessageWaitTimeSeconds")
                    # withField
                        "RedrivePolicy"
                        ( FnIf
                            "ShouldNotUseDLQ"
                            NoValue
                            ( FnSub2
                                redrivePolicy
                                ( toMap
                                    { DeadLetterTargetArn =
                                        GetAtt "SecondaryQueue" "Arn"
                                    , MaxReceiveCount =
                                        Ref "RedriveMaxReceiveCount"
                                    }
                                )
                            )
                        )
                    # withField "VisibilityTimeout" (Ref "VisibilityTimeout")
                  )
            }

      let secondaryQueue =
            { Type = JSON.string "AWS::SQS::Queue"
            , Properties =
                JSON.object
                  (   withField "QueueName" (JSON.string "${queueName}-sec")
                    # withTags (tags # toMap { QueueType = "Secondary" })
                    # withField "FifoQueue" (JSON.bool isFIFO)
                    # withField
                        "MessageRetentionPeriod"
                        (Ref "MessageRetentionPeriod")
                    # withField "VisibilityTimeout" (Ref "VisibilityTimeout")
                  )
            }

      let outputs =
            { PrimaryQueueURL =
                Output
                  "Primary Queue URL"
                  (Ref "PrimaryQueue")
                  "${queueName}-PrimaryQueueURL"
            , PrimaryQueueARN =
                Output
                  "Primary Queue ARN"
                  (GetAtt "PrimaryQueue" "Arn")
                  "${queueName}-PrimaryQueueARN"
            , SecondaryQueueURL =
                Output
                  "Secondary Queue URL"
                  (Ref "SecondaryQueue")
                  "${queueName}-SecondaryQueueURL"
            , SecondaryQueueARN =
                Output
                  "Secondary Queue ARN"
                  (GetAtt "SecondaryQueue" "Arn")
                  "${queueName}-SecondaryQueueARN"
            }

      let template =
            { AWSTemplateFormatVersion = JSON.string "2010-09-09"
            , Parameters = JSON.object (toMap parameters)
            , Conditions =
                JSON.object
                  ( toMap
                      { ShouldNotUseDLQ =
                          FnEquals
                            (Ref "RedriveMaxReceiveCount")
                            (JSON.natural 0)
                      }
                  )
            , Resources =
                JSON.object
                  ( toMap
                      { PrimaryQueue = JSON.object (toMap primaryQueue)
                      , SecondaryQueue = JSON.object (toMap secondaryQueue)
                      }
                  )
            , Outputs = JSON.object (toMap outputs)
            }

      in  JSON.renderYAML (JSON.object (toMap template))