Implement a Conway regression test for IncrementalStake deserializaiton

IntersectMBO · Aug 31, 2024 · 1e20125 · 1e20125
1 parent 32bbf40
commit 1e20125
Show file tree

Hide file tree

Showing 4 changed files with 25 additions and 0 deletions.
diff --git 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
@@ -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
@@ -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
@@ -127,6 +127,7 @@ module Cardano.Ledger.Shelley.LedgerState (
   vsDRepsL,
   vsCommitteeStateL,
   credMapL,
+  ptrMapL,
 
   -- * Lenses from SnapShot(s)
   ssStakeMarkL,