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/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) 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 ------------------------------------------------------------------------------------------ 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 () 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 (..))