From 7a4b91b6f7dbab34824e9d30f4cd48f8ecaf5aff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= Date: Mon, 27 Oct 2025 16:01:08 +0200 Subject: [PATCH 1/3] Disable old redeemer deserialization --- eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs | 6 +++++- .../testlib/Test/Cardano/Ledger/Alonzo/Binary/Annotator.hs | 6 +++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs index 0779f5384d1..b45fcbab070 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs @@ -578,7 +578,11 @@ instance AlonzoEraScript era => DecCBOR (Annotator (RedeemersRaw era)) where ( peekTokenType >>= \case TypeMapLenIndef -> decodeMapRedeemers TypeMapLen -> decodeMapRedeemers - _ -> decodeListRedeemers + _ -> + ifDecoderVersionAtLeast + (natVersion @12) + (fail "List encoding of redeemers not supported starting with PV 12") + decodeListRedeemers ) ( mapTraverseableDecoderA (decodeList decodeAnnElement) diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Annotator.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Annotator.hs index 5cfc9414f84..6c9c4b56dbf 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Annotator.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Annotator.hs @@ -209,7 +209,11 @@ instance AlonzoEraScript era => DecCBOR (RedeemersRaw era) where ( peekTokenType >>= \case TypeMapLenIndef -> decodeMapRedeemers TypeMapLen -> decodeMapRedeemers - _ -> decodeListRedeemers + _ -> + ifDecoderVersionAtLeast + (natVersion @12) + (fail "List encoding of redeemers not supported starting with PV 12") + decodeListRedeemers ) (RedeemersRaw . Map.fromList <$> decodeList decodeElement) where From ac400ceb1f6f664494709d4c645364c6e95d492c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= Date: Thu, 30 Oct 2025 14:25:55 +0200 Subject: [PATCH 2/3] Added tests for list Redeemers --- eras/conway/impl/cardano-ledger-conway.cabal | 1 + .../Cardano/Ledger/Conway/Binary/Golden.hs | 107 ++++++++++++++++++ .../Test/Cardano/Ledger/Conway/Spec.hs | 2 + .../impl/cardano-ledger-dijkstra.cabal | 3 +- eras/dijkstra/impl/test/Main.hs | 3 + .../Cardano/Ledger/Dijkstra/Binary/Golden.hs | 27 +++++ 6 files changed, 142 insertions(+), 1 deletion(-) create mode 100644 eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs create mode 100644 eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Golden.hs diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index 5414e2f1f25..5ad4aeafe4d 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -127,6 +127,7 @@ library testlib Test.Cardano.Ledger.Conway.Arbitrary Test.Cardano.Ledger.Conway.Binary.Annotator Test.Cardano.Ledger.Conway.Binary.Cddl + Test.Cardano.Ledger.Conway.Binary.Golden Test.Cardano.Ledger.Conway.Binary.Regression Test.Cardano.Ledger.Conway.Binary.RoundTrip Test.Cardano.Ledger.Conway.BinarySpec diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs new file mode 100644 index 00000000000..13342ff0173 --- /dev/null +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-unused-foralls #-} + +module Test.Cardano.Ledger.Conway.Binary.Golden ( + expectDecoderResultOn, + expectDecoderFailure, + listRedeemersEnc, + goldenListRedeemers, +) where + +import Cardano.Ledger.Alonzo.Core ( + AsIx (..), + eraProtVerLow, + pattern SpendingPurpose, + ) +import Cardano.Ledger.Alonzo.Scripts (ExUnits (..)) +import Cardano.Ledger.Alonzo.TxWits (Redeemers (..)) +import Cardano.Ledger.BaseTypes (Version) +import Cardano.Ledger.Binary ( + Annotator (..), + DecCBOR (..), + ToCBOR (..), + decodeFullAnnotator, + toStrictByteString, + ) +import Cardano.Ledger.Binary.Plain (DecoderError (..), Tokens (..)) +import Cardano.Ledger.Plutus (Data (..)) +import Data.ByteString (fromStrict) +import qualified Data.Map as Map +import Data.Typeable (Proxy (..), Typeable) +import PlutusLedgerApi.Common (Data (..)) +import Test.Cardano.Ledger.Binary.Plain.Golden (Enc (..)) +import Test.Cardano.Ledger.Common ( + Expectation, + Spec, + ToExpr, + expectationFailure, + it, + shouldBe, + shouldBeExpr, + showExpr, + ) +import Test.Cardano.Ledger.Conway.Era (ConwayEraTest) + +expectDecoderFailure :: + forall a. + (ToExpr a, DecCBOR (Annotator a), Typeable a) => + Version -> + Enc -> + DecoderError -> + Expectation +expectDecoderFailure version enc expectedErr = + case result of + Left err -> err `shouldBe` expectedErr + Right x -> + expectationFailure $ + "Expected a failure, but decoder succeeded:\n" + <> showExpr x + where + bytes = fromStrict . toStrictByteString $ toCBOR enc + result = decodeFullAnnotator @a version (label $ Proxy @(Annotator a)) decCBOR bytes + +expectDecoderResultOn :: + forall a b. + (ToExpr b, DecCBOR (Annotator a), Typeable a, Eq b) => + Version -> Enc -> a -> (a -> b) -> Expectation +expectDecoderResultOn version enc expected f = + case result of + Left err -> expectationFailure $ "Decoder failed with:\n" <> show err + Right x -> f x `shouldBeExpr` f expected + where + bytes = fromStrict . toStrictByteString $ toCBOR enc + result = decodeFullAnnotator @a version (label $ Proxy @(Annotator a)) decCBOR bytes + +-- | A simple redeemer encoded as a list +listRedeemersEnc :: Enc +listRedeemersEnc = + mconcat + [ E (TkListLen 1) + , mconcat + [ E (TkListLen 4) + , E (0 :: Int) + , E (0 :: Int) + , E (0 :: Int) + , mconcat + [ E (TkListLen 2) + , E (0 :: Int) + , E (0 :: Int) + ] + ] + ] + +goldenListRedeemers :: forall era. ConwayEraTest era => Spec +goldenListRedeemers = + it "Decoding Redeemers encoded as a list succeeds" $ + expectDecoderResultOn @(Redeemers era) + (eraProtVerLow @era) + listRedeemersEnc + (Redeemers $ Map.singleton (SpendingPurpose $ AsIx 0) (Data $ I 0, ExUnits 0 0)) + (\(Redeemers m) -> m) diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Spec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Spec.hs index ff3a4a9ecbb..16d6a1b892e 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Spec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Spec.hs @@ -20,6 +20,7 @@ import qualified Test.Cardano.Ledger.Alonzo.Binary.CostModelsSpec as CostModelsS import qualified Test.Cardano.Ledger.Alonzo.Binary.TxWitsSpec as TxWitsSpec import qualified Test.Cardano.Ledger.Babbage.TxInfoSpec as BabbageTxInfo import Test.Cardano.Ledger.Common +import qualified Test.Cardano.Ledger.Conway.Binary.Golden as Golden import qualified Test.Cardano.Ledger.Conway.Binary.Regression as Regression import qualified Test.Cardano.Ledger.Conway.BinarySpec as Binary import qualified Test.Cardano.Ledger.Conway.CommitteeRatifySpec as CommitteeRatify @@ -60,3 +61,4 @@ spec = BabbageTxInfo.spec @era describe "PlutusV3" $ BabbageTxInfo.txInfoSpec @era SPlutusV3 + describe "Golden" $ Golden.goldenListRedeemers @era diff --git a/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal b/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal index ce5b9ead322..9d305f33346 100644 --- a/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal +++ b/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal @@ -112,6 +112,7 @@ library testlib Test.Cardano.Ledger.Dijkstra.Arbitrary Test.Cardano.Ledger.Dijkstra.Binary.Annotator Test.Cardano.Ledger.Dijkstra.Binary.Cddl + Test.Cardano.Ledger.Dijkstra.Binary.Golden Test.Cardano.Ledger.Dijkstra.Binary.RoundTrip Test.Cardano.Ledger.Dijkstra.CDDL Test.Cardano.Ledger.Dijkstra.Era @@ -137,7 +138,7 @@ library testlib bytestring, cardano-data, cardano-ledger-allegra:{cardano-ledger-allegra, testlib}, - cardano-ledger-alonzo:testlib, + cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib}, cardano-ledger-babbage:{cardano-ledger-babbage, testlib}, cardano-ledger-binary, cardano-ledger-conway:{cardano-ledger-conway, testlib}, diff --git a/eras/dijkstra/impl/test/Main.hs b/eras/dijkstra/impl/test/Main.hs index 712c4b59deb..cc628db1428 100644 --- a/eras/dijkstra/impl/test/Main.hs +++ b/eras/dijkstra/impl/test/Main.hs @@ -10,6 +10,7 @@ import qualified Test.Cardano.Ledger.Babbage.TxInfoSpec as BabbageTxInfo import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Dijkstra.Binary.Annotator () import qualified Test.Cardano.Ledger.Dijkstra.Binary.CddlSpec as Cddl +import qualified Test.Cardano.Ledger.Dijkstra.Binary.Golden as Golden import Test.Cardano.Ledger.Dijkstra.Binary.RoundTrip () import qualified Test.Cardano.Ledger.Dijkstra.GoldenSpec as GoldenSpec import qualified Test.Cardano.Ledger.Dijkstra.Imp as Imp @@ -29,3 +30,5 @@ main = BabbageTxInfo.spec @DijkstraEra txInfoSpec @DijkstraEra SPlutusV3 txInfoSpec @DijkstraEra SPlutusV4 + describe "Golden" $ do + Golden.goldenListRedeemersDisallowed @DijkstraEra diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Golden.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Golden.hs new file mode 100644 index 00000000000..900315ea9c7 --- /dev/null +++ b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Golden.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Test.Cardano.Ledger.Dijkstra.Binary.Golden ( + goldenListRedeemersDisallowed, +) where + +import Cardano.Ledger.Alonzo.TxWits (Redeemers) +import Cardano.Ledger.Binary (DecoderError (..), DeserialiseFailure (..)) +import Cardano.Ledger.Dijkstra.Core (eraProtVerLow) +import Test.Cardano.Ledger.Common (Spec, it) +import Test.Cardano.Ledger.Conway.Binary.Golden (expectDecoderFailure, listRedeemersEnc) +import Test.Cardano.Ledger.Dijkstra.Era (DijkstraEraTest) + +goldenListRedeemersDisallowed :: forall era. DijkstraEraTest era => Spec +goldenListRedeemersDisallowed = + it "Decoding Redeemers encoded as a list fails" $ + expectDecoderFailure @(Redeemers era) + (eraProtVerLow @era) + listRedeemersEnc + ( DecoderErrorDeserialiseFailure + "Annotator (MemoBytes (RedeemersRaw DijkstraEra))" + (DeserialiseFailure 0 "List encoding of redeemers not supported starting with PV 12") + ) From 3a834220cdb18c7f29b1ddb44a811b73535050f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= Date: Thu, 30 Oct 2025 14:46:02 +0000 Subject: [PATCH 3/3] Review Co-authored-by: Alexey Kuleshevich --- .../Cardano/Ledger/Conway/Binary/Golden.hs | 32 ++++++++----------- .../src/Cardano/Ledger/Binary.hs | 2 ++ 2 files changed, 16 insertions(+), 18 deletions(-) diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs index 13342ff0173..e43873e61bd 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs @@ -21,24 +21,25 @@ import Cardano.Ledger.Alonzo.Core ( pattern SpendingPurpose, ) import Cardano.Ledger.Alonzo.Scripts (ExUnits (..)) -import Cardano.Ledger.Alonzo.TxWits (Redeemers (..)) +import Cardano.Ledger.Alonzo.TxWits (Redeemers (..), unRedeemers) import Cardano.Ledger.BaseTypes (Version) import Cardano.Ledger.Binary ( Annotator (..), DecCBOR (..), ToCBOR (..), decodeFullAnnotator, - toStrictByteString, + toLazyByteString, ) import Cardano.Ledger.Binary.Plain (DecoderError (..), Tokens (..)) import Cardano.Ledger.Plutus (Data (..)) -import Data.ByteString (fromStrict) import qualified Data.Map as Map import Data.Typeable (Proxy (..), Typeable) import PlutusLedgerApi.Common (Data (..)) import Test.Cardano.Ledger.Binary.Plain.Golden (Enc (..)) +import Test.Cardano.Ledger.Binary.RoundTrip (embedTripAnnExpectation) import Test.Cardano.Ledger.Common ( Expectation, + HasCallStack, Spec, ToExpr, expectationFailure, @@ -51,7 +52,7 @@ import Test.Cardano.Ledger.Conway.Era (ConwayEraTest) expectDecoderFailure :: forall a. - (ToExpr a, DecCBOR (Annotator a), Typeable a) => + (ToExpr a, DecCBOR (Annotator a), Typeable a, HasCallStack) => Version -> Enc -> DecoderError -> @@ -64,20 +65,15 @@ expectDecoderFailure version enc expectedErr = "Expected a failure, but decoder succeeded:\n" <> showExpr x where - bytes = fromStrict . toStrictByteString $ toCBOR enc + bytes = toLazyByteString $ toCBOR enc result = decodeFullAnnotator @a version (label $ Proxy @(Annotator a)) decCBOR bytes expectDecoderResultOn :: forall a b. - (ToExpr b, DecCBOR (Annotator a), Typeable a, Eq b) => + (ToExpr b, DecCBOR (Annotator a), Eq b, HasCallStack) => Version -> Enc -> a -> (a -> b) -> Expectation expectDecoderResultOn version enc expected f = - case result of - Left err -> expectationFailure $ "Decoder failed with:\n" <> show err - Right x -> f x `shouldBeExpr` f expected - where - bytes = fromStrict . toStrictByteString $ toCBOR enc - result = decodeFullAnnotator @a version (label $ Proxy @(Annotator a)) decCBOR bytes + embedTripAnnExpectation version version (\x _ -> f x `shouldBeExpr` f expected) enc -- | A simple redeemer encoded as a list listRedeemersEnc :: Enc @@ -87,12 +83,12 @@ listRedeemersEnc = , mconcat [ E (TkListLen 4) , E (0 :: Int) - , E (0 :: Int) - , E (0 :: Int) + , E (10 :: Int) + , E (20 :: Int) , mconcat [ E (TkListLen 2) - , E (0 :: Int) - , E (0 :: Int) + , E (30 :: Int) + , E (40 :: Int) ] ] ] @@ -103,5 +99,5 @@ goldenListRedeemers = expectDecoderResultOn @(Redeemers era) (eraProtVerLow @era) listRedeemersEnc - (Redeemers $ Map.singleton (SpendingPurpose $ AsIx 0) (Data $ I 0, ExUnits 0 0)) - (\(Redeemers m) -> m) + (Redeemers $ Map.singleton (SpendingPurpose $ AsIx 10) (Data $ I 20, ExUnits 30 40)) + unRedeemers diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary.hs index 76681635f81..4e2b762d408 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary.hs @@ -9,6 +9,7 @@ module Cardano.Ledger.Binary ( Term (..), C.DeserialiseFailure (..), translateViaCBORAnnotator, + toLazyByteString, ) where import Cardano.Ledger.Binary.Decoding @@ -40,6 +41,7 @@ import qualified Cardano.Ledger.Binary.Plain as Plain import Cardano.Ledger.Binary.Version import qualified Codec.CBOR.Read as C (DeserialiseFailure (..)) import Codec.CBOR.Term (Term (..)) +import Codec.CBOR.Write (toLazyByteString) import Control.Monad.Except (Except, MonadError (throwError)) import Data.Text (Text)