preserve Alonzo script integrity hash bug

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 canonical 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.
+legacyNonCanonicalCostModelEncoder :: CostModel -> Encoding
+legacyNonCanonicalCostModelEncoder = 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 legacyNonCanonicalCostModelEncoder $
               Map.lookup lang (unCostModels $ getField @"_costmdls" pp)
         )
     )

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
+    ]

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
     ]