preserve Alonzo script integrity hash bug

In the Alonzo era, the map of languages to cost models was mistakenly encoded using an indefinite CBOR map (contrary to cannonical CBOR, as intended) when computing the script integrity hash. For this reason, PlutusV1 remains with this encoding. Future versions of Plutus, starting with PlutusV2 in the Babbage era, will use the intended definite length encoding. PR #2703 accidentally reversed this Alonzo bug, this commit restores it.
IntersectMBO · Apr 18, 2022 · 2838e76 · 2838e76
1 parent 1db68a3
commit 2838e76
Show file tree

Hide file tree

Showing 3 changed files with 100 additions and 2 deletions.
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs
@@ -42,9 +42,11 @@ import Cardano.Binary
   )
 import Cardano.Ledger.Alonzo.Language (Language (..))
 import Cardano.Ledger.Alonzo.Scripts
-  ( CostModels (..),
+  ( CostModel,
+    CostModels (..),
     ExUnits (..),
     Prices (..),
+    getCostModelParams,
   )
 import Cardano.Ledger.BaseTypes
   ( NonNegativeInterval,
@@ -74,6 +76,7 @@ import Data.Coders
     Wrapped (..),
     decode,
     encode,
+    encodeFoldableAsIndefinite,
     field,
     (!>),
     (<!),
@@ -478,6 +481,15 @@ updatePParams pp ppup =
 data LangDepView = LangDepView {tag :: ByteString, params :: ByteString}
   deriving (Eq, Show, Ord, Generic, NoThunks)
 
+-- In the Alonzo era, the map of languages to cost models was mistakenly encoded
+-- using an indefinite CBOR map (contrary to cannonical CBOR, as intended) when
+-- computing the script integrity hash.
+-- For this reason, PlutusV1 remains with this encoding.
+-- Future versions of Plutus, starting with PlutusV2 in the Babbage era, will
+-- use the intended definite length encoding.
+legacyNonCannonicalCostModelEncoder :: CostModel -> Encoding
+legacyNonCannonicalCostModelEncoder = encodeFoldableAsIndefinite . getCostModelParams
+
 getLanguageView ::
   forall era.
   (HasField "_costmdls" (Core.PParams era) CostModels) =>
@@ -489,7 +501,7 @@ getLanguageView pp lang@PlutusV1 =
     (serialize' (serialize' lang))
     ( serialize'
         ( serializeEncoding' $
-            maybe encodeNull toCBOR $
+            maybe encodeNull legacyNonCannonicalCostModelEncoder $
               Map.lookup lang (unCostModels $ getField @"_costmdls" pp)
         )
     )

diff --git a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -7,21 +8,35 @@
 module Test.Cardano.Ledger.Alonzo.Golden
   ( goldenUTxOEntryMinAda,
     goldenSerialization,
+    goldenScriptIntegrity,
   )
 where
 
 import Cardano.Binary (serialize)
 import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Data (Data (..), hashData)
+import Cardano.Ledger.Alonzo.Language (Language (..))
+import Cardano.Ledger.Alonzo.PParams
+  ( LangDepView (..),
+    PParams,
+    PParams' (..),
+    emptyPParams,
+    getLanguageView,
+  )
 import Cardano.Ledger.Alonzo.Rules.Utxo (utxoEntrySize)
+import Cardano.Ledger.Alonzo.Scripts (CostModels (..))
 import Cardano.Ledger.Alonzo.TxBody (TxOut (..))
 import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Mary.Value (Value (..), valueFromList)
+import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Lazy as BSL
 import Data.Char (chr)
+import Data.Either (fromRight)
+import qualified Data.Map.Strict as Map
 import Plutus.V1.Ledger.Api (Data (..))
 import Test.Cardano.Ledger.Alonzo.Examples.Consensus (ledgerExamplesAlonzo)
+import Test.Cardano.Ledger.Alonzo.PlutusScripts (testingCostModelV1, testingCostModelV2)
 import Test.Cardano.Ledger.EraBuffet (StandardCrypto)
 import Test.Cardano.Ledger.Mary.Golden
   ( largestName,
@@ -174,3 +189,72 @@ goldenSerialization =
         expected <- (BSL.readFile "golden/tx.cbor")
         serialize (SLE.sleTx ledgerExamplesAlonzo) @?= expected
     ]
+
+exPP :: PParams (AlonzoEra StandardCrypto)
+exPP =
+  emptyPParams
+    { _costmdls =
+        CostModels $
+          Map.fromList [(PlutusV1, testingCostModelV1), (PlutusV2, testingCostModelV2)]
+    }
+
+exampleLangDepViewPV1 :: LangDepView
+exampleLangDepViewPV1 = LangDepView b1 b2
+  where
+    b1 =
+      fromRight (error "invalid hex encoding of the language inside exampleLangDepViewPV1") $
+        B16.decode "4100"
+    b2 =
+      fromRight (error "invalid hex encoding of the cost model inside exampleLangDepViewPV1") $
+        B16.decode $
+          "5901d59f1a000302590001011a00060bc719026d00011a000249f01903e80001"
+            <> "1a000249f018201a0025cea81971f70419744d186419744d186419744d186419"
+            <> "744d186419744d186419744d18641864186419744d18641a000249f018201a00"
+            <> "0249f018201a000249f018201a000249f01903e800011a000249f018201a0002"
+            <> "49f01903e800081a000242201a00067e2318760001011a000249f01903e80008"
+            <> "1a000249f01a0001b79818f7011a000249f0192710011a0002155e19052e0119"
+            <> "03e81a000249f01903e8011a000249f018201a000249f018201a000249f01820"
+            <> "01011a000249f0011a000249f0041a000194af18f8011a000194af18f8011a00"
+            <> "02377c190556011a0002bdea1901f1011a000249f018201a000249f018201a00"
+            <> "0249f018201a000249f018201a000249f018201a000249f018201a000242201a"
+            <> "00067e23187600010119f04c192bd200011a000249f018201a000242201a0006"
+            <> "7e2318760001011a000242201a00067e2318760001011a0025cea81971f70400"
+            <> "1a000141bb041a000249f019138800011a000249f018201a000302590001011a"
+            <> "000249f018201a000249f018201a000249f018201a000249f018201a000249f0"
+            <> "18201a000249f018201a000249f018201a00330da70101ff"
+
+exampleLangDepViewPV2 :: LangDepView
+exampleLangDepViewPV2 = LangDepView b1 b2
+  where
+    b1 =
+      fromRight (error "invalid hex encoding of the language inside exampleLangDepViewPV2") $
+        B16.decode "01"
+    b2 =
+      fromRight (error "invalid hex encoding of the cost model inside exampleLangDepViewPV2") $
+        B16.decode $
+          "98a61a000302590001011a00060bc719026d00011a000249f01903e800011a00"
+            <> "0249f018201a0025cea81971f70419744d186419744d186419744d186419744d"
+            <> "186419744d186419744d18641864186419744d18641a000249f018201a000249"
+            <> "f018201a000249f018201a000249f01903e800011a000249f018201a000249f0"
+            <> "1903e800081a000242201a00067e2318760001011a000249f01903e800081a00"
+            <> "0249f01a0001b79818f7011a000249f0192710011a0002155e19052e011903e8"
+            <> "1a000249f01903e8011a000249f018201a000249f018201a000249f018200101"
+            <> "1a000249f0011a000249f0041a000194af18f8011a000194af18f8011a000237"
+            <> "7c190556011a0002bdea1901f1011a000249f018201a000249f018201a000249"
+            <> "f018201a000249f018201a000249f018201a000249f018201a000242201a0006"
+            <> "7e23187600010119f04c192bd200011a000249f018201a000242201a00067e23"
+            <> "18760001011a000242201a00067e2318760001011a0025cea81971f704001a00"
+            <> "0141bb041a000249f019138800011a000249f018201a000302590001011a0002"
+            <> "49f018201a000249f018201a000249f018201a000249f018201a000249f01820"
+            <> "1a000249f018201a000249f018201a00330da70101"
+
+testScriptIntegritpHash :: PParams (AlonzoEra StandardCrypto) -> Language -> LangDepView -> IO ()
+testScriptIntegritpHash pp lang view = getLanguageView pp lang @?= view
+
+goldenScriptIntegrity :: TestTree
+goldenScriptIntegrity =
+  testGroup
+    "golden tests - script integrity hash"
+    [ testCase "PlutusV1" $ testScriptIntegritpHash exPP PlutusV1 exampleLangDepViewPV1,
+      testCase "PlutusV2" $ testScriptIntegritpHash exPP PlutusV2 exampleLangDepViewPV2
+    ]
diff --git a/eras/alonzo/test-suite/test/Tests.hs b/eras/alonzo/test-suite/test/Tests.hs
@@ -38,6 +38,7 @@ mainTests =
       CDDL.tests 5,
       Golden.goldenUTxOEntryMinAda,
       Golden.goldenSerialization,
+      Golden.goldenScriptIntegrity,
       plutusScriptExamples,
       txInfoTests
     ]
@@ -51,6 +52,7 @@ fastTests =
       CDDL.tests 1,
       Golden.goldenUTxOEntryMinAda,
       Golden.goldenSerialization,
+      Golden.goldenScriptIntegrity,
       plutusScriptExamples,
       txInfoTests
     ]