SAM Policy document (#3)

* add json decoder

* decode statements

* implement root template decoder

* add mkJson* functions

* convert policy template to valid json

* use pretty render

* gen sam policy-template

* refactor to use JSON.dhall

* mk package.dhall

* refactor:move sam module;remove union type for CfnText

* update readme dhall

* fix unit test

* bump version

* freeze JSON sha

* fix dhall version

* use nix to package

* upload cache

Author: jcouyang

.github/workflows/build.yml

@@ -49,6 +49,10 @@ jobs:
         docker tag ghcr.io/jcouyang/dhall-aws-cloudformation:latest ghcr.io/jcouyang/dhall-aws-cloudformation:$LOCAL_VERSION
         docker push ghcr.io/jcouyang/dhall-aws-cloudformation:latest
         docker push ghcr.io/jcouyang/dhall-aws-cloudformation:$LOCAL_VERSION
+    - name: package cache
+      run: |
+        nix-build package.nix
+        tar -czhf cache.tar.gz ./result
     - name: tag release
       env:
         GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
@@ -57,7 +61,7 @@ jobs:
         LOCAL_VERSION=$(dhall text < ./version.dhall)
         echo "main version is $LAST_RELEASE and current version is $LOCAL_VERSION"
         if [ ${LAST_RELEASE:-0} != $LOCAL_VERSION ];then
-          hub release create -m "${LOCAL_VERSION}" "${LOCAL_VERSION}"
+          hub release create -m "${LOCAL_VERSION}" -a ./cache.tar.gz "${LOCAL_VERSION}"
         fi
     - name: publish doc
       env:

Fn.dhall

@@ -1,8 +1,6 @@
-let JSON =
-      https://raw.githubusercontent.com/dhall-lang/dhall-lang/v20.0.0/Prelude/JSON/package.dhall
+let JSON = (./Prelude.dhall).JSON
 
-let map =
-      https://raw.githubusercontent.com/dhall-lang/dhall-lang/v20.0.0/Prelude/List/map.dhall
+let map = (./Prelude.dhall).List.map
 
 let _Pi =
       λ(Fn : Type) →
@@ -160,12 +158,6 @@ let toJSON =
           , String = λ(x : Text) → JSON.string x
           }
 
-let CfnText = < Plain : Text | Fn : JSON.Type >
-
-let string = λ(a : Text) → CfnText.Plain a
-
-let fn = λ(a : Fn/Type) → CfnText.Fn (toJSON a)
-
 let exampleImportValue =
         assert
       :   toJSON (ImportValue (Sub "\${NetworkStackNameParameter}-SubnetID"))
@@ -302,7 +294,8 @@ in  { Ref
     , GetAZs
     , Join
     , Select
-    , string
-    , fn
-    , CfnText
+    , Type = Fn/Type
+    , CfnText = JSON.Type
+    , render = toJSON
+    , renderText = λ(s : Text) → toJSON (String s)
     }

Prelude.dhall

@@ -0,0 +1 @@
+https://prelude.dhall-lang.org/v20.1.0/package.dhall sha256:26b0ef498663d269e4dc6a82b0ee289ec565d683ef4c00d0ebdd25333a5a3c98

README.md.dhall

@@ -54,6 +54,63 @@ in  ''
     ```
 
     So the compiler can just help you find the correct attribute.
+    #### Sam Policy Templates
+    Cloudformation's Policy document is loosy type as just JSON, it is hard to get the policy right and too many boilerplates to create a Dhall JSON data
+
+    Thanks to [AWS SAM](https://docs.aws.amazon.com/serverless-application-model/latest/developerguide/serverless-policy-templates.html) there are some common policy documents we can laverage
+
+    All these templates are translated into Dhall functions, so you don't need to use SAM to be able to use these policy documents.
+
+    ```dhall
+    Policies = Some [Policy::{
+      , PolicyDocument = DynamoDBReadPolicy (Fn.String "DBName")
+      , PolicyName = s "dynamo read only"
+    }]
+    ```
+
+    will generates
+
+    ```json
+    {
+      "Policies": [
+        {
+          "PolicyDocument": {
+            "Statement": [
+              {
+                "Action": [
+                  "dynamodb:GetItem",
+                  "dynamodb:Scan",
+                  "dynamodb:Query",
+                  "dynamodb:BatchGetItem",
+                  "dynamodb:DescribeTable"
+                ],
+                "Effect": "Allow",
+                "Resource": [
+                  {
+                    "Fn::Sub": [
+                      "arn:${AWS::Partition}:dynamodb:${AWS::Region}:${AWS::AccountId}:table/${tableName}",
+                      {
+                        "tableName": "DBName"
+                      }
+                    ]
+                  },
+                  {
+                    "Fn::Sub": [
+                      "arn:${AWS::Partition}:dynamodb:${AWS::Region}:${AWS::AccountId}:table/${tableName}/index/*",
+                      {
+                        "tableName": "DBName"
+                      }
+                    ]
+                  }
+                ]
+              }
+            ]
+          },
+          "PolicyName": "dynamo read only"
+        }
+      ]
+    }
+    ```
 
     ## :mag: [Examples](./examples)
 
@@ -65,7 +122,6 @@ in  ''
     $ stack build
     $ stack test
     ```
-
     ### Generate Type Definitions
 
     Type definitions are generated from config file `./config.dhall` which contains specifications used by [AWS CDK](https://github.com/aws/aws-cdk/blob/master/packages/%40aws-cdk/cfnspec/build-tools/update.sh) as well:

UpdatePolicy.dhall

@@ -1,5 +1,4 @@
-let JSON =
-      https://raw.githubusercontent.com/dhall-lang/dhall-lang/v20.0.0/Prelude/JSON/package.dhall
+let JSON = (./Prelude.dhall).JSON
 
 let CodeDeployPolicyType =
       { AfterAllowTrafficHook : Optional JSON.Type

app/Main.hs

@@ -10,47 +10,64 @@ import           Data.Foldable             (traverse_)
 import           Data.Map                  (Map, size, toList)
 import           Data.Maybe
 import           Data.Text                 (Text, unpack)
-import qualified Data.Text.IO              as TIO
 import           Data.Text.Lazy            (pack)
+import qualified Data.Text.Lazy            as Lazy
 import           Data.Text.Lazy.Encoding   (encodeUtf8)
+import qualified Data.Text.Lazy.IO         as TIO
 import           Dhall                     (Decoder, FromDhall, auto, field,
                                             input, inputFile, record, string)
 import           Dhall.Cloudformation
-import           Dhall.Core                (pretty)
+import qualified Dhall.Core                as Dhall
+import qualified Dhall.Pretty
+import           Dhall.Sam.Template        (parseTemplates)
 import           GHC.Generics              (Generic)
+import qualified Prettyprinter.Render.Text as Pretty.Text
 import           System.Directory          (createDirectoryIfMissing)
 import           System.FilePath.Posix     (takeDirectory, (</>))
 
 data Config = Config
   {specifications :: Map Text Text
   ,excludes       :: [Text]
+  ,templates      :: Map Text Text
   } deriving stock (Show)
 
 readConfig :: Decoder Config
 readConfig =
   record
     ( Config <$> field "specifications" auto
              <*> field "excludes" auto
+             <*> field "templates" auto
     )
 main :: IO ()
 main = do
   config <- inputFile readConfig "./config.dhall" :: IO Config
   traverse_ (genRegionSpec (excludes config)) $ toList (specifications config)
+  traverse_ genTemplate $ toList (templates config)
     where
       genRegionSpec :: [Text] -> (Text, Text) -> IO ()
       genRegionSpec excl (region, url) = do
         spec <- input string (url <> " as Text")
         case convert spec excl of
           Left e       -> putStr e
           Right (v, s) -> traverse_ (genFile v region) (toList s)
-      convert :: String -> [Text] -> Either String (Text, Map Text Text)
+      genTemplate (name, url) = do
+        template <- input auto (url <> " as Text")
+        case (eitherDecode . encodeUtf8)  template of
+          Left e     -> do
+            putStr e
+          Right maps -> traverse_ (genFile "" name) (toList $ prettyPrint <$> parseTemplates maps)
+      convert :: String -> [Text] -> Either String (Text, Map Text Lazy.Text)
       convert spec excl= versioned excl <$> (decodeSpec spec :: Either String Spec)
-      versioned excl s = (resourceSpecificationVersion s, ((fmap pretty) . convertSpec excl) s)
+      versioned excl s = (resourceSpecificationVersion s, (fmap prettyPrint . convertSpec excl) s)
       decodeSpec = eitherDecode . encodeUtf8 . pack
       genFile _ region (k, v) = mkFile (unpack region) (unpack k) v
 
-mkFile :: String -> FilePath -> Text -> IO ()
+prettyPrint :: DhallExpr -> Lazy.Text
+prettyPrint expr = Pretty.Text.renderLazy stream
+  where
+    stream = Dhall.Pretty.layout $ Dhall.Pretty.prettyCharacterSet Dhall.Pretty.ASCII expr
+mkFile :: String -> FilePath -> Lazy.Text -> IO ()
 mkFile prefix path content = do
-  let d = prefix </> path
+  let d = prefix </> path <> ".dhall"
   createDirectoryIfMissing True $ takeDirectory d
   TIO.writeFile d content