diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs index 4a740721ae8..25c97a222a0 100644 --- 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, (!>), ( 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 index b7b8327696e..088e44d5f39 100644 --- 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 index df3b20acc9c..ff98ead3fc5 100644 --- 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 ]