CIP-0057: ContractBlueprint with derived schema definitions and safe …

…schema refs (#5824) CIP-0057: ContractBlueprint with derived schema definitions and safe schema refs (#5824)
IntersectMBO · Mar 18, 2024 · ac41901 · ac41901
1 parent a79131e
commit ac41901
Show file tree

Hide file tree

Showing 19 changed files with 610 additions and 280 deletions.
diff --git a/plutus-tx-plugin/test/Blueprint/Acme.golden.json b/plutus-tx-plugin/test/Blueprint/Acme.golden.json
@@ -15,17 +15,12 @@
   },
   "validators": [
     {
-      "title": "Acme Validator",
+      "title": "Acme Validator #1",
       "description": "A validator that does something awesome",
       "redeemer": {
         "title": "Acme Redeemer",
         "description": "A redeemer that does something awesome",
-        "purpose": {
-          "oneOf": [
-            "spend",
-            "mint"
-          ]
-        },
+        "purpose": "spend",
         "schema": {
           "$ref": "#/definitions/String"
         }
@@ -48,8 +43,40 @@
           }
         }
       ],
-      "compiledCode": "58ec01010032222323232300349103505435003232325333573466e1d200000218000a999ab9a3370e90010010c00cc8c8c94ccd5cd19b874800000860026eb4d5d0800cdd71aba13574400213008491035054310035573c0046aae74004dd51aba100109802a481035054310035573c0046aae74004dd50029919192999ab9a3370e90000010c0004c0112401035054310035573c0046aae74004dd5001119319ab9c001800199999a8911199a891199a89100111111400401600900380140044252005001001400084a400a0020038004008848a400e0050012410101010101010101000498101030048810001",
-      "hash": "21a5bbebc42a3d916719c975f622508a2c940ced5cd867cd3d87a019"
+      "compiledCode": "584f01010032222801199999a8911199a891199a89100111111400401600900380140044252005001001400084a400a0020038004008848a400e0050012410101010101010101000498101030048810001",
+      "hash": "a0a2b4161839094c666e8ea1952510e7f337aa10786cef62706244ba"
+    },
+    {
+      "title": "Acme Validator #2",
+      "description": "Another validator that does something awesome",
+      "redeemer": {
+        "purpose": "mint",
+        "schema": {
+          "$ref": "#/definitions/Integer"
+        }
+      },
+      "datum": {
+        "purpose": "mint",
+        "schema": {
+          "$ref": "#/definitions/Integer"
+        }
+      },
+      "parameters": [
+        {
+          "purpose": "spend",
+          "schema": {
+            "$ref": "#/definitions/Param2a"
+          }
+        },
+        {
+          "purpose": "mint",
+          "schema": {
+            "$ref": "#/definitions/Param2b"
+          }
+        }
+      ],
+      "compiledCode": "58290101003322222800199a89110014002004424520070028008ccd4488800e0010022122900380140041",
+      "hash": "67923a88b5dfccdef62abd8b3f4ff857d7582b52cde4c07b8cd34175"
     }
   ],
   "definitions": {
@@ -104,6 +131,24 @@
     "Integer": {
       "dataType": "integer"
     },
+    "Param2a": {
+      "dataType": "constructor",
+      "fields": [
+        {
+          "$ref": "#/definitions/Bool"
+        }
+      ],
+      "index": 0
+    },
+    "Param2b": {
+      "dataType": "constructor",
+      "fields": [
+        {
+          "$ref": "#/definitions/Bool"
+        }
+      ],
+      "index": 0
+    },
     "Params": {
       "dataType": "constructor",
       "fields": [

diff --git a/plutus-tx-plugin/test/Blueprint/Tests.hs b/plutus-tx-plugin/test/Blueprint/Tests.hs
@@ -1,58 +1,29 @@
-{-# LANGUAGE AllowAmbiguousTypes   #-}
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE DerivingStrategies    #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE PolyKinds             #-}
-{-# LANGUAGE TypeApplications      #-}
-{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TypeApplications  #-}
 
 module Blueprint.Tests where
 
-import PlutusTx.Blueprint
 import Prelude
 
-import Blueprint.Tests.Lib qualified as Fixture
-import Control.Monad.Reader (asks)
+import Blueprint.Tests.Lib (Datum, Datum2, Param2a, Param2b, Params, Redeemer, Redeemer2,
+                            goldenJson, serialisedScript, validatorScript1, validatorScript2)
 import Data.Set qualified as Set
-import Data.Void (Void)
+import PlutusTx.Blueprint.Contract (ContractBlueprint (..))
+import PlutusTx.Blueprint.Definition (definitionRef, deriveDefinitions)
+import PlutusTx.Blueprint.PlutusVersion (PlutusVersion (PlutusV3))
+import PlutusTx.Blueprint.Preamble (Preamble (..))
 import PlutusTx.Blueprint.Purpose qualified as Purpose
-import PlutusTx.Builtins (BuiltinByteString, BuiltinData)
-import System.FilePath ((</>))
-import Test.Tasty (TestName)
+import PlutusTx.Blueprint.TH (deriveArgumentBlueprint, deriveParameterBlueprint)
+import PlutusTx.Blueprint.Validator (ValidatorBlueprint (..))
+import PlutusTx.Blueprint.Write (writeBlueprint)
 import Test.Tasty.Extras (TestNested, testNested)
-import Test.Tasty.Golden (goldenVsFile)
 
 goldenTests :: TestNested
-goldenTests = testNested "Blueprint" [goldenBlueprint "Acme" contractBlueprint]
+goldenTests = testNested "Blueprint" [goldenJson "Acme" (`writeBlueprint` contractBlueprint)]
 
-goldenBlueprint :: TestName -> ContractBlueprint types -> TestNested
-goldenBlueprint name blueprint = do
-  goldenPath <- asks $ foldr (</>) name
-  let actual = goldenPath ++ ".actual.json"
-  let golden = goldenPath ++ ".golden.json"
-  pure $ goldenVsFile name golden actual (writeBlueprint actual blueprint)
-
-{- | All the data types exposed (directly or indirectly) by the type signature of the validator
-This type level list is used to:
-1. derive the schema definitions for the contract.
-2. make "safe" references to the [derived] schema definitions.
--}
-type ValidatorTypes =
-  [ Fixture.Datum
-  , Fixture.DatumPayload
-  , Fixture.Params
-  , Fixture.Redeemer
-  , Fixture.Bytes Void
-  , ()
-  , Bool
-  , Integer
-  , BuiltinData
-  , BuiltinByteString
-  ]
-
-contractBlueprint :: ContractBlueprint ValidatorTypes
+contractBlueprint :: ContractBlueprint
 contractBlueprint =
   MkContractBlueprint
     { contractId = Nothing
@@ -64,38 +35,39 @@ contractBlueprint =
           , preamblePlutusVersion = PlutusV3
           , preambleLicense = Just "MIT"
           }
-    , contractValidators = Set.singleton validatorBlueprint
-    , contractDefinitions = deriveSchemaDefinitions
-    }
-
-validatorBlueprint :: ValidatorBlueprint ValidatorTypes
-validatorBlueprint =
-  MkValidatorBlueprint
-    { validatorTitle = "Acme Validator"
-    , validatorDescription = Just "A validator that does something awesome"
-    , validatorParameters =
-        Just
-          $ pure
-            MkParameterBlueprint
-              { parameterTitle = Just "Acme Parameter"
-              , parameterDescription = Just "A parameter that does something awesome"
-              , parameterPurpose = Set.singleton Purpose.Spend
-              , parameterSchema = definitionRef @Fixture.Params
+    , contractValidators =
+        Set.fromList
+          [ MkValidatorBlueprint
+              { validatorTitle =
+                  "Acme Validator #1"
+              , validatorDescription =
+                  Just "A validator that does something awesome"
+              , validatorParameters =
+                  [$(deriveParameterBlueprint ''Params (Set.singleton Purpose.Spend))]
+              , validatorRedeemer =
+                  $(deriveArgumentBlueprint ''Redeemer (Set.singleton Purpose.Spend))
+              , validatorDatum =
+                  Just $(deriveArgumentBlueprint ''Datum (Set.singleton Purpose.Spend))
+              , validatorCompiledCode =
+                  Just (serialisedScript validatorScript1)
               }
-    , validatorRedeemer =
-        MkArgumentBlueprint
-          { argumentTitle = Just "Acme Redeemer"
-          , argumentDescription = Just "A redeemer that does something awesome"
-          , argumentPurpose = Set.fromList [Purpose.Spend, Purpose.Mint]
-          , argumentSchema = definitionRef @Fixture.Redeemer
-          }
-    , validatorDatum =
-        Just
-          MkArgumentBlueprint
-            { argumentTitle = Just "Acme Datum"
-            , argumentDescription = Just "A datum that contains something awesome"
-            , argumentPurpose = Set.singleton Purpose.Spend
-            , argumentSchema = definitionRef @Fixture.Datum
-            }
-    , validatorCompiledCode = Just Fixture.serialisedScript
+          , MkValidatorBlueprint
+              { validatorTitle =
+                  "Acme Validator #2"
+              , validatorDescription =
+                  Just "Another validator that does something awesome"
+              , validatorParameters =
+                  [ $(deriveParameterBlueprint ''Param2a (Set.singleton Purpose.Spend))
+                  , $(deriveParameterBlueprint ''Param2b (Set.singleton Purpose.Mint))
+                  ]
+              , validatorRedeemer =
+                  $(deriveArgumentBlueprint ''Redeemer2 (Set.singleton Purpose.Mint))
+              , validatorDatum =
+                  Just $(deriveArgumentBlueprint ''Datum2 (Set.singleton Purpose.Mint))
+              , validatorCompiledCode =
+                  Just (serialisedScript validatorScript2)
+              }
+          ]
+    , contractDefinitions =
+        deriveDefinitions @[Params, Redeemer, Datum, Param2a, Param2b, Redeemer2, Datum2]
     }