From 4d6e7e8ca9def9279da3121ce25da1f661533cfd Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 31 Aug 2024 12:16:19 -0600 Subject: [PATCH 1/4] Implement a fix for inability to deserialize pointers in Conway --- .../src/Cardano/Ledger/Shelley/LedgerState/Types.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/Types.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/Types.hs index 3a652a9825a..4d84599cece 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/Types.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/Types.hs @@ -27,7 +27,7 @@ import Cardano.Ledger.BaseTypes ( StrictMaybe (..), ) import Cardano.Ledger.Binary ( - DecCBOR (decCBOR), + DecCBOR (decCBOR, dropCBOR), DecShareCBOR (Share, decShareCBOR, decSharePlusCBOR), EncCBOR (encCBOR), FromCBOR (..), @@ -38,6 +38,9 @@ import Cardano.Ledger.Binary ( decodeRecordNamed, decodeRecordNamedT, encodeListLen, + enforceDecoderVersion, + ifDecoderVersionAtLeast, + natVersion, toPlainDecoder, ) import Cardano.Ledger.Binary.Coders (Decode (From, RecD), Encode (..), decode, encode, (!>), ( DecShareCBOR (IncrementalStake c) where decShareCBOR credInterns = decodeRecordNamed "Stake" (const 2) $ do stake <- decShareCBOR (credInterns, mempty) - IStake stake <$> decCBOR + let dropPtrs = + mempty + <$ enforceDecoderVersion (natVersion @8) (dropCBOR (Proxy @(Map Ptr (CompactForm Coin)))) + ptrs <- ifDecoderVersionAtLeast (natVersion @9) dropPtrs decCBOR + pure $ IStake stake ptrs instance Semigroup (IncrementalStake c) where (IStake a b) <> (IStake c d) = IStake (Map.unionWith (<>) a c) (Map.unionWith (<>) b d) From 32bbf40fc05796eb1a3a9379024dd15feddf9cc9 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 31 Aug 2024 12:25:47 -0600 Subject: [PATCH 2/4] Fix spelling mistake --- .../src/Cardano/Ledger/Binary/Decoding/DecCBOR.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/DecCBOR.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/DecCBOR.hs index cca270e5833..9b41743131c 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/DecCBOR.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/DecCBOR.hs @@ -106,7 +106,7 @@ class Typeable a => DecCBOR a where {-# INLINE decCBOR #-} -- | Validate decoding of a Haskell value, without the need to actually construct - -- it. Coule be slightly faster than `decCBOR`, however it should respect this law: + -- it. Could be slightly faster than `decCBOR`, however it should respect this law: -- -- > dropCBOR (proxy :: Proxy a) = () <$ (decCBOR :: Decoder s a) dropCBOR :: Proxy a -> Decoder s () From 7cb30c27feaa0ef884750640e3b5774df09fd152 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 31 Aug 2024 13:08:09 -0600 Subject: [PATCH 3/4] Implement a Conway regression test for IncrementalStake deserializaiton --- eras/conway/impl/cardano-ledger-conway.cabal | 2 ++ .../Test/Cardano/Ledger/Conway/BinarySpec.hs | 21 +++++++++++++++++++ eras/shelley/impl/CHANGELOG.md | 1 + .../src/Cardano/Ledger/Shelley/LedgerState.hs | 1 + .../Test/Cardano/Ledger/Constrained/Vars.hs | 1 + 5 files changed, 26 insertions(+) diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index fdb476e2779..63714ccf2a6 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -209,9 +209,11 @@ test-suite tests cardano-ledger-alonzo:testlib, cardano-ledger-alonzo, cardano-ledger-babbage, + cardano-ledger-binary, cardano-ledger-conway, cardano-ledger-core, cardano-ledger-binary:testlib, + cardano-ledger-shelley >=1.14, cardano-slotting:testlib, cardano-strict-containers, containers, diff --git a/eras/conway/impl/test/Test/Cardano/Ledger/Conway/BinarySpec.hs b/eras/conway/impl/test/Test/Cardano/Ledger/Conway/BinarySpec.hs index 5aac13774ae..e58f9c6d4c2 100644 --- a/eras/conway/impl/test/Test/Cardano/Ledger/Conway/BinarySpec.hs +++ b/eras/conway/impl/test/Test/Cardano/Ledger/Conway/BinarySpec.hs @@ -1,13 +1,22 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Test.Cardano.Ledger.Conway.BinarySpec (spec) where +import Cardano.Ledger.Babbage +import Cardano.Ledger.BaseTypes +import Cardano.Ledger.Binary import Cardano.Ledger.Conway +import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Genesis import Cardano.Ledger.Conway.Governance +import Cardano.Ledger.Credential import Cardano.Ledger.Crypto +import Cardano.Ledger.Shelley.LedgerState import Data.Default.Class (def) +import qualified Data.Map.Strict as Map +import Lens.Micro import Test.Cardano.Ledger.Binary.RoundTrip import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Conway.Arbitrary () @@ -30,3 +39,15 @@ spec = do roundTripConwayCommonSpec @Conway -- ConwayGenesis only makes sense in Conway era roundTripEraSpec @Conway @(ConwayGenesis StandardCrypto) + describe "Regression" $ do + prop "Drop Ptrs from Incrementasl Stake" $ \(ls :: LedgerState Babbage) conwayGenesis slotNo testCoin -> do + let + badPtr = Ptr slotNo (TxIx maxBound) (CertIx maxBound) + lsBabbage :: LedgerState Babbage + lsBabbage = ls & lsUTxOStateL . utxosStakeDistrL . ptrMapL <>~ Map.singleton badPtr testCoin + lsConway :: LedgerState Conway + lsConway = translateEra' conwayGenesis lsBabbage + v = eraProtVerLow @Conway + expectNoBadPtr :: LedgerState Conway -> LedgerState Conway -> Expectation + expectNoBadPtr x y = x `shouldBe` (y & lsUTxOStateL . utxosStakeDistrL . ptrMapL .~ mempty) + embedTripExpectation v v (mkTrip encCBOR decNoShareCBOR) expectNoBadPtr lsConway diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index 6b14ad668d7..b3cb2d8072a 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -6,6 +6,7 @@ * Added `EncCBOR` instances for: * `UtxoEnv` * `CertEnv` +* Expose `ptrMapL` ### `testlib` diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs index f1a616823d9..5d1782a87f4 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs @@ -127,6 +127,7 @@ module Cardano.Ledger.Shelley.LedgerState ( vsDRepsL, vsCommitteeStateL, credMapL, + ptrMapL, -- * Lenses from SnapShot(s) ssStakeMarkL, diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs index 4cbde7bdab6..9c13de475d3 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs @@ -83,6 +83,7 @@ import Cardano.Ledger.Shelley.LedgerState hiding ( deltaReserves, deltaTreasury, ptrMap, + ptrMapL, rewards, ) import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..)) From ac0d1d17d09f79e47b9a484b2e8abe6c073e7044 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 31 Aug 2024 20:27:19 -0600 Subject: [PATCH 4/4] Disbale generation of a Ptr map for IncrementalStake Tomorrow we are going into Conway, so this Map will no longer be useful as soon as we clean up the Ptr resolution. If we generate Ptr map in IncrementalStake we will run into issues with roundtripping serialization for Conway. So the easiest path forward is to disable generation now and completely get rid of the field later. --- .../impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs index 180c7f7d697..dc5f8598849 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs @@ -213,7 +213,7 @@ instance Arbitrary AccountState where shrink = genericShrink instance Crypto c => Arbitrary (IncrementalStake c) where - arbitrary = IStake <$> arbitrary <*> arbitrary + arbitrary = IStake <$> arbitrary <*> pure mempty -- Once in Conway Ptrs Map will be removed shrink = genericShrink ------------------------------------------------------------------------------------------