Blueprints: calculate script hash the right way.

doc/docusaurus/docs/using-plutus-tx/producing-a-blueprint.md

@@ -129,19 +129,20 @@ Our contract can contain one or more validators. For each one we need to provide
 
 > ``` haskell
 > data ValidatorBlueprint (referencedTypes :: [Type]) = MkValidatorBlueprint
->   { validatorTitle        :: Text
+>   { validatorTitle       :: Text
 >   -- ^ A short and descriptive name for the validator.
->   , validatorDescription  :: Maybe Text
+>   , validatorDescription :: Maybe Text
 >   -- ^ An informative description of the validator.
->   , validatorRedeemer     :: ArgumentBlueprint referencedTypes
+>   , validatorRedeemer    :: ArgumentBlueprint referencedTypes
 >   -- ^ A description of the redeemer format expected by this validator.
->   , validatorDatum        :: Maybe (ArgumentBlueprint referencedTypes)
+>   , validatorDatum       :: Maybe (ArgumentBlueprint referencedTypes)
 >   -- ^ A description of the datum format expected by this validator.
->   , validatorParameters   :: Maybe (NonEmpty (ParameterBlueprint referencedTypes))
+>   , validatorParameters  :: [ParameterBlueprint referencedTypes]
 >   -- ^ A list of parameters required by the script.
->   , validatorCompiledCode :: Maybe ByteString
->   -- ^ A full compiled and CBOR-encoded serialized flat script.
+>   , validatorCompiled    :: Maybe CompiledValidator
+>   -- ^ A full compiled and CBOR-encoded serialized flat script together with its hash.
 >   }
+>   deriving stock (Show, Eq, Ord)
 > ```
 
 In our example, this would be:
@@ -151,6 +152,17 @@ In our example, this would be:
 The `definitionRef` function is used to reference a schema definition of a given type. 
 It is smart enough to discover the schema definition from the `referencedType` list and fails to compile if the referenced type is not included.
 
+If you want to provide validator code with its hash, you can use the `compiledValidator` function:
+
+``` haskell
+compiledValidator
+  :: PlutusVersion
+  -- ^ Plutus version (e.g. `PlutusV3`) to calculate the hash of the validator code.
+  -> ByteString
+  -- ^ The compiled validator code.
+  -> CompiledValidator
+```
+
 ## Writing the blueprint to a file
 
 With all the pieces in place, we can now write the blueprint to a file:

doc/docusaurus/static/code/Example/Cip57/Blueprint/Main.hs

@@ -208,7 +208,7 @@ myValidator =
             , argumentPurpose = Set.singleton Spend
             , argumentSchema = definitionRef @MyDatum
             }
-    , validatorCompiledCode = Nothing -- you can optionally provide the compiled code here
+    , validatorCompiled = Nothing -- you can optionally provide the compiled code here
     }
 
 -- END validator blueprint declaration

plutus-tx-plugin/plutus-tx-plugin.cabal

@@ -179,6 +179,7 @@ test-suite plutus-tx-plugin-tests
 
   build-depends:
     , base                                            >=4.9   && <5
+    , base16-bytestring
     , bytestring
     , containers
     , deepseq

plutus-tx-plugin/test/Blueprint/Acme.golden.json

@@ -44,7 +44,7 @@
         }
       ],
       "compiledCode": "587701010032222801199a891119a891199a891119999999a891001111111400401a00b004801c00a00221290028008014021208080808080808080800233500248008cd4009200433500248019400d3010103004881001800091400c00a00212122900380140050002129002800a001002212290038014005",
-      "hash": "22ba8372284337707303706f7a8d8949119c58511813cffd2b7c9298"
+      "hash": "7497943bb3e80ca9da349bac55008ddc5e77ca900abb3aecbde1e857"
     },
     {
       "title": "Acme Validator #2",
@@ -76,7 +76,7 @@
         }
       ],
       "compiledCode": "58290101003322222800199a89110014002004424520070028008ccd4488800e0010022122900380140041",
-      "hash": "67923a88b5dfccdef62abd8b3f4ff857d7582b52cde4c07b8cd34175"
+      "hash": "6dee6f39b916e9cae585bbc13d5b474937f1a992a8a0d742001bfceb"
     }
   ],
   "definitions": {

plutus-tx-plugin/test/Blueprint/Tests.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE TypeOperators     #-}
@@ -12,22 +13,35 @@ import Blueprint.Tests.Lib (Bytes, Datum, DatumPayload, Param2a, Param2b, Params
                             Redeemer2, goldenJson, serialisedScript, validatorScript1,
                             validatorScript2)
 import Blueprint.Tests.Lib.AsData.Blueprint (Datum2)
+import Control.Monad.Reader.Class (asks)
+import Data.ByteString.Base16 qualified as Base16
 import Data.Set qualified as Set
+import Data.Text qualified as Text
+import Data.Text.Encoding qualified as Text
+import Data.Text.IO qualified as Text
 import Data.Type.Equality (type (:~:) (..))
 import Data.Void (Void)
 import PlutusTx.Blueprint.Contract (ContractBlueprint (..))
 import PlutusTx.Blueprint.Definition (UnrollAll, definitionRef, deriveDefinitions)
-import PlutusTx.Blueprint.PlutusVersion (PlutusVersion (PlutusV3))
+import PlutusTx.Blueprint.PlutusVersion (PlutusVersion (..))
 import PlutusTx.Blueprint.Preamble (Preamble (..))
 import PlutusTx.Blueprint.Purpose qualified as Purpose
 import PlutusTx.Blueprint.TH (deriveArgumentBlueprint, deriveParameterBlueprint)
-import PlutusTx.Blueprint.Validator (ValidatorBlueprint (..))
+import PlutusTx.Blueprint.Validator (CompiledValidator (..), ValidatorBlueprint (..),
+                                     compiledValidator)
 import PlutusTx.Blueprint.Write (writeBlueprint)
 import PlutusTx.Builtins (BuiltinByteString, BuiltinData, BuiltinString)
-import Test.Tasty.Extras (TestNested, testNested)
+import System.FilePath (joinPath)
+import Test.Tasty.Extras (TestNested, embed, testNested)
+import Test.Tasty.HUnit
 
-goldenTests :: TestNested
-goldenTests = testNested "Blueprint" [goldenJson "Acme" (`writeBlueprint` contractBlueprint)]
+tests :: TestNested
+tests =
+  testNested
+    "Blueprint"
+    [ goldenJson "Acme" (`writeBlueprint` contractBlueprint)
+    , testCompiledValidator
+    ]
 
 contractBlueprint :: ContractBlueprint
 contractBlueprint =
@@ -54,8 +68,8 @@ contractBlueprint =
                   $(deriveArgumentBlueprint ''Redeemer (Set.singleton Purpose.Spend))
               , validatorDatum =
                   Just $(deriveArgumentBlueprint ''Datum (Set.singleton Purpose.Spend))
-              , validatorCompiledCode =
-                  Just (serialisedScript validatorScript1)
+              , validatorCompiled =
+                  Just (compiledValidator PlutusV3 (serialisedScript validatorScript1))
               }
           , MkValidatorBlueprint
               { validatorTitle =
@@ -70,8 +84,8 @@ contractBlueprint =
                   $(deriveArgumentBlueprint ''Redeemer2 (Set.singleton Purpose.Mint))
               , validatorDatum =
                   Just $(deriveArgumentBlueprint ''Datum2 (Set.singleton Purpose.Mint))
-              , validatorCompiledCode =
-                  Just (serialisedScript validatorScript2)
+              , validatorCompiled =
+                  Just (compiledValidator PlutusV3 (serialisedScript validatorScript2))
               }
           ]
     , contractDefinitions =
@@ -86,16 +100,16 @@ contractBlueprint =
            ]
     }
 
-testAllRequredDefinitions ::
-  UnrollAll
-    [ Params
-    , Param2a
-    , Param2b
-    , Redeemer
-    , Redeemer2
-    , Datum
-    , Datum2
-    ]
+testAllRequredDefinitions
+  :: UnrollAll
+      [ Params
+      , Param2a
+      , Param2b
+      , Redeemer
+      , Redeemer2
+      , Datum
+      , Datum2
+      ]
     :~: [ Params
         , Bool
         , ()
@@ -112,3 +126,16 @@ testAllRequredDefinitions ::
         , Datum2
         ]
 testAllRequredDefinitions = Refl
+
+testCompiledValidator :: TestNested
+testCompiledValidator = do
+  exampleScriptPath <- asks $ joinPath . (<> ["Tests", "CompiledValidator.hex"])
+  embed . testCase "compiledValidator" $ do
+    compiledScriptInHex <- Text.readFile exampleScriptPath
+    let fromHex = Base16.decode . Text.encodeUtf8 . Text.strip
+        toHex = Text.decodeUtf8 . Base16.encode
+    MkCompiledValidator{..} <-
+      case compiledValidator PlutusV2 <$> fromHex compiledScriptInHex of
+        Left err -> fail $ "Error when hex-decoding: " <> err
+        Right x  -> pure x
+    toHex compiledValidatorHash @?= "ffbd2f1be8910706804dcb12a1ca72a5573374e9a6c7b93a4e8858a4"

plutus-tx-plugin/test/Blueprint/Tests/CompiledValidator.hex

@@ -0,0 +1 @@
+590853010000332332233223232232323232323232323232323232323232225335323230012235002222222222222325335301400510011029533533024027008102822135002222533500415335333573466e3c00cc05088cccd400498800498980b80b44ccd5cd19b87480080040b80b440b48840bd4c8c8c94cd4ccd5cd19b87480000080740704cc8848cc00400c008c8c8c94cd4ccd5cd19b874800000808007c4c8c8c8c8c8c8c8c8c8c8c8c8c8c8cccccccccccc88888888888848cccccccccccc00403403002c02802402001c01801401000c008c008d5d080798011aba100e3301c0213574201a60026ae84030c004d5d08059980e00f1aba100a33302602275a6ae84024c8c8c94cd4ccd5cd19b87480000080c40c04cc8848cc00400c008c8c8c94cd4ccd5cd19b87480000080d00cc4cc8848cc00400c008cc085d69aba10013020357426ae880044c0a9241035054310035573c0046aae74004dd51aba10013232325335333573466e1d20000020340331332212330010030023302175a6ae84004c080d5d09aba20011302a491035054310035573c0046aae74004dd51aba1357440022604e921035054310035573c0046aae74004dd51aba10083301c75c6ae8401cccc098074064d5d08031980180c9aba10053020357426ae88014c00800cc0688c8c8c94cd4ccd5cd19b87480000080c00bc4cc8848cc00400c008c084d5d080098119aba1357440022604c921035054310035573c0046aae74004dd50009811bae5021357440026ae88004d5d10009aba2001357440026ae88004d5d10009aba2001357440026ae880044c0592401035054310035573c0046aae74004dd51aba1001300c357426ae880044c04d241035054310035573c0046aae74004dd5001191919299a999ab9a3370e900000100e00d880a898092481035054310035573c0046aae74004dd50010a4c2601e9210350543500301722533500110172215335333573466e3c05000806806440684c01000480048c8c8c94cd4ccd5cd19b874800000806005c405c54cd4ccd5cd19b874800800806005c40604c039241035054310035573c0046aae74004dd500091191919299a999ab9a3370e900000100c00b889110010a99a999ab9a3370e900100100c00b8990911180180218029aba100115335333573466e1d2004002018017112220011300e4901035054310035573c0046aae74004dd5000919118011bac00130142233335573e0024028466a02660086ae84008c00cd5d10010071191919299a999ab9a3370e900000100a80a0990911118018029bae357420022a66a666ae68cdc3a400400402a02826424444600200a600c6ae8400454cd4ccd5cd19b87480100080540504c848888c008014c024d5d08008a99a999ab9a3370e900300100a80a09909111180200298029aba10011300b4901035054310035573c0046aae74004dd50009191919299a999ab9a3370e900000100a00989909111111180280418041aba100115335333573466e1d20020020140131321222222230070083008357420022a66a666ae68cdc3a400800402802626644244444446600c01201060106ae84004dd71aba1357440022a66a666ae68cdc3a400c0040280262664424444444660040120106eb8d5d08009bae357426ae8800454cd4ccd5cd19b874802000805004c4cc8848888888cc004024020dd71aba1001375a6ae84d5d10008a99a999ab9a3370e900500100a0098891111110020a99a999ab9a3370e900600100a009889111111001898052481035054310035573c0046aae74004dd50009191919299a999ab9a3370e900000100980909991091980080180118029aba1001375a6ae84d5d100089804a49035054310035573c0046aae74004dd50009191919299a999ab9a3370e900000100900889bae35742002260109201035054310035573c0046aae74004dd50009191919299a999ab9a3370e9000001008808099191919999111091999800802802001801191919299a999ab9a3370e900000100b80b09991091980080180118061aba10013300400b357426ae880044c035241035054310035573c0046aae74004dd51aba100433300c75ca0166ae8400cc8c8c94cd4ccd5cd19b874800000805c0584488800c54cd4ccd5cd19b874800800805c0584c84888c004010dd71aba100115335333573466e1d200400201701613212223002004357420022601a921035054310035573c0046aae74004dd51aba10023300175c6ae84d5d100111191919299a999ab9a3370e900100100c00b88910008a99a999ab9a3370e900000100c00b899091180100198029aba10011300e491035054310035573c0046aae74004dd50009aba2001357440022600e921035054310035573c0046aae74004dd50009191919299a999ab9a3370e9000001008007899091180100198029aba100115335333573466e1d200200201000f132333222122333001005004003375a6ae84008dd69aba1001375a6ae84d5d10009aba2001130064901035054310035573c0046aae74004dd50009191919299a999ab9a3370e900000100780709909118010019bae357420022a66a666ae68cdc3a400400401e01c26424460020066eb8d5d080089802a481035054310035573c0046aae74004dd5000919319ab9c00100413300175ceb488c88c008dd58009805911999aab9f001200b23233500b33221233001003002300635573a002600a6aae78004c010d5d10019aba100200512001300622253350011002221350022233007333008002006001003300522225335001100222135002225335333573466e1d200000100c00b13330080070060031333008007335009123330010080030020060031220021221223300100400312200212200123230010012300223300200200148811c0e20ac97864bbc44b7742f4ad7cbf065d1c077643ce844f2f4909f0b0001

plutus-tx-plugin/test/Spec.hs

@@ -39,7 +39,7 @@ tests =
     , AsData.Budget.tests
     , Optimization.tests
     , Strictness.tests
-    , Blueprint.Tests.goldenTests
+    , Blueprint.Tests.tests
     , AssocMap.goldenTests
     , embed ShortCircuit.tests
     , embed Unicode.tests

plutus-tx/src/PlutusTx/Blueprint/Validator.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE KindSignatures     #-}
+{-# LANGUAGE LambdaCase         #-}
 {-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE RecordWildCards    #-}
 
@@ -11,6 +12,7 @@ import Prelude
 import Data.Aeson (ToJSON (..))
 import Data.Aeson.Extra (buildObject, optionalField, requiredField)
 import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
 import Data.ByteString.Base16 qualified as Base16
 import Data.Kind (Type)
 import Data.List.NonEmpty qualified as NE
@@ -19,6 +21,7 @@ import Data.Text.Encoding qualified as Text
 import PlutusCore.Crypto.Hash (blake2b_224)
 import PlutusTx.Blueprint.Argument (ArgumentBlueprint)
 import PlutusTx.Blueprint.Parameter (ParameterBlueprint)
+import PlutusTx.Blueprint.PlutusVersion (PlutusVersion (..))
 
 {- | A blueprint of a validator, as defined by the CIP-0057
 
@@ -27,21 +30,40 @@ making sure their schemas are included in the blueprint and that they are refere
 in a type-safe way.
 -}
 data ValidatorBlueprint (referencedTypes :: [Type]) = MkValidatorBlueprint
-  { validatorTitle        :: Text
+  { validatorTitle       :: Text
   -- ^ A short and descriptive name for the validator.
-  , validatorDescription  :: Maybe Text
+  , validatorDescription :: Maybe Text
   -- ^ An informative description of the validator.
-  , validatorRedeemer     :: ArgumentBlueprint referencedTypes
+  , validatorRedeemer    :: ArgumentBlueprint referencedTypes
   -- ^ A description of the redeemer format expected by this validator.
-  , validatorDatum        :: Maybe (ArgumentBlueprint referencedTypes)
+  , validatorDatum       :: Maybe (ArgumentBlueprint referencedTypes)
   -- ^ A description of the datum format expected by this validator.
-  , validatorParameters   :: [ParameterBlueprint referencedTypes]
+  , validatorParameters  :: [ParameterBlueprint referencedTypes]
   -- ^ A list of parameters required by the script.
-  , validatorCompiledCode :: Maybe ByteString
-  -- ^ A full compiled and CBOR-encoded serialized flat script.
+  , validatorCompiled    :: Maybe CompiledValidator
+  -- ^ A full compiled and CBOR-encoded serialized flat script together with its hash.
   }
   deriving stock (Show, Eq, Ord)
 
+data CompiledValidator = MkCompiledValidator
+  { compiledValidatorCode :: ByteString
+  , compiledValidatorHash :: ByteString
+  }
+  deriving stock (Show, Eq, Ord)
+
+compiledValidator :: PlutusVersion -> ByteString -> CompiledValidator
+compiledValidator version code =
+  MkCompiledValidator
+    { compiledValidatorCode = code
+    , compiledValidatorHash =
+        blake2b_224 (BS.singleton (versionTag version) <> code)
+    }
+  where
+    versionTag = \case
+      PlutusV1 -> 0x1
+      PlutusV2 -> 0x2
+      PlutusV3 -> 0x3
+
 instance ToJSON (ValidatorBlueprint referencedTypes) where
   toJSON MkValidatorBlueprint{..} =
     buildObject $
@@ -50,8 +72,8 @@ instance ToJSON (ValidatorBlueprint referencedTypes) where
         . optionalField "description" validatorDescription
         . optionalField "datum" validatorDatum
         . optionalField "parameters" (NE.nonEmpty validatorParameters)
-        . optionalField "compiledCode" (toHex <$> validatorCompiledCode)
-        . optionalField "hash" (toHex . blake2b_224 <$> validatorCompiledCode)
-   where
-    toHex :: ByteString -> Text
-    toHex = Text.decodeUtf8 . Base16.encode
+        . optionalField "compiledCode" (toHex . compiledValidatorCode <$> validatorCompiled)
+        . optionalField "hash" (toHex . compiledValidatorHash <$> validatorCompiled)
+    where
+      toHex :: ByteString -> Text
+      toHex = Text.decodeUtf8 . Base16.encode