Improve resilience of future PParams

eras/conway/impl/cardano-ledger-conway.cabal

@@ -92,7 +92,7 @@ library
         cardano-ledger-babbage ^>=1.8,
         cardano-ledger-core ^>=1.13,
         cardano-ledger-mary ^>=1.6,
-        cardano-ledger-shelley ^>=1.12.1,
+        cardano-ledger-shelley ^>=1.12.2,
         cardano-slotting,
         cardano-strict-containers,
         containers,

eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs

@@ -467,29 +467,30 @@ setFreshDRepPulsingState epochNo stakePoolDistr epochState = do
       umap = dsUnified dState
       umapSize = Map.size $ umElems umap
       pulseSize = max 1 (umapSize `div` (fromIntegral :: Word64 -> Int) (4 * k))
-      epochState' =
-        epochState
-          & epochStateGovStateL . cgsDRepPulsingStateL
-            .~ DRPulsing
-              ( DRepPulser
-                  { dpPulseSize = pulseSize
-                  , dpUMap = dsUnified dState
-                  , dpIndex = 0 -- used as the index of the remaining UMap
-                  , dpStakeDistr = stakeDistr -- used as part of the snapshot
-                  , dpStakePoolDistr = stakePoolDistr
-                  , dpDRepDistr = Map.empty -- The partial result starts as the empty map
-                  , dpDRepState = vsDReps vState
-                  , dpCurrentEpoch = epochNo
-                  , dpCommitteeState = vsCommitteeState vState
-                  , dpEnactState =
-                      mkEnactState govState
-                        & ensTreasuryL .~ epochState ^. epochStateTreasuryL
-                  , dpProposals = proposalsActions props
-                  , dpProposalDeposits = proposalsDeposits props
-                  , dpGlobals = globals
-                  }
-              )
-  pure epochState'
+      govState' =
+        predictFuturePParams $
+          govState
+            & cgsDRepPulsingStateL
+              .~ DRPulsing
+                ( DRepPulser
+                    { dpPulseSize = pulseSize
+                    , dpUMap = dsUnified dState
+                    , dpIndex = 0 -- used as the index of the remaining UMap
+                    , dpStakeDistr = stakeDistr -- used as part of the snapshot
+                    , dpStakePoolDistr = stakePoolDistr
+                    , dpDRepDistr = Map.empty -- The partial result starts as the empty map
+                    , dpDRepState = vsDReps vState
+                    , dpCurrentEpoch = epochNo
+                    , dpCommitteeState = vsCommitteeState vState
+                    , dpEnactState =
+                        mkEnactState govState
+                          & ensTreasuryL .~ epochState ^. epochStateTreasuryL
+                    , dpProposals = proposalsActions props
+                    , dpProposalDeposits = proposalsDeposits props
+                    , dpGlobals = globals
+                    }
+                )
+  pure $ epochState & epochStateGovStateL .~ govState'
 
 -- | Force computation of DRep stake distribution and figure out the next enact
 -- state. This operation is useful in cases when access to new EnactState or DRep stake

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs

@@ -62,6 +62,7 @@ relevantDuringBootstrapSpec ::
 relevantDuringBootstrapSpec = do
   actionPrioritySpec
   hardForkInitiationNoDRepsSpec
+  pparamPredictionSpec
 
 treasuryWithdrawalsSpec ::
   forall era.
@@ -241,6 +242,27 @@ hardForkInitiationNoDRepsSpec =
     passNEpochs 2
     getProtVer `shouldReturn` nextProtVer
 
+pparamPredictionSpec :: ConwayEraImp era => SpecWith (ImpTestState era)
+pparamPredictionSpec =
+  it "futurePParams" $ do
+    committeeMembers' <- registerInitialCommittee
+    modifyPParams $ ppPoolVotingThresholdsL . pvtHardForkInitiationL .~ 2 %! 3
+    whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL . dvtHardForkInitiationL .~ def)
+    _ <- setupPoolWithStake $ Coin 22_000_000
+    (stakePoolId1, _, _) <- setupPoolWithStake $ Coin 22_000_000
+    (stakePoolId2, _, _) <- setupPoolWithStake $ Coin 22_000_000
+    curProtVer <- getProtVer
+    nextMajorVersion <- succVersion $ pvMajor curProtVer
+    let nextProtVer = curProtVer {pvMajor = nextMajorVersion}
+    govActionId <- submitGovAction $ HardForkInitiation SNothing nextProtVer
+    submitYesVoteCCs_ committeeMembers' govActionId
+    submitYesVote_ (StakePoolVoter stakePoolId1) govActionId
+    submitYesVote_ (StakePoolVoter stakePoolId2) govActionId
+    passEpoch
+    advanceToPointOfNoReturn
+    passEpoch
+    getProtVer `shouldReturn` nextProtVer
+
 noConfidenceSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
 noConfidenceSpec =
   it "NoConfidence" $ do

eras/shelley/impl/CHANGELOG.md

@@ -1,9 +1,13 @@
 # Version history for `cardano-ledger-shelley`
 
-## 1.12.1.1
+## 1.12.2.0
 
 *
 
+### `testlib`
+
+* Add `advanceToPointOfNoReturn`
+
 ## 1.12.1.0
 
 *

eras/shelley/impl/cardano-ledger-shelley.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               cardano-ledger-shelley
-version:            1.12.1.0
+version:            1.12.2.0
 license:            Apache-2.0
 maintainer:         [email protected]
 author:             IOHK

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs

@@ -111,6 +111,7 @@ module Test.Cardano.Ledger.Shelley.ImpTest (
   impKeyPairsG,
   impNativeScriptsG,
   produceScript,
+  advanceToPointOfNoReturn,
 ) where
 
 import qualified Cardano.Chain.Common as Byron
@@ -180,6 +181,7 @@ import Cardano.Ledger.Shelley.Scripts (
   pattern RequireMOf,
   pattern RequireSignature,
  )
+import Cardano.Ledger.Slot (getTheSlotOfNoReturn)
 import Cardano.Ledger.Tools (calcMinFeeTxNativeScriptWits, integralToByteStringN)
 import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
 import Cardano.Ledger.UMap as UMap
@@ -751,8 +753,10 @@ runImpTestM mQCSize impState (ImpTestM m) = do
   endState <- readIORef ioRef
   pure (res, endState)
 
-runShelleyBase :: Globals -> ShelleyBase a -> a
-runShelleyBase globals act = runIdentity $ runReaderT act globals
+runShelleyBase :: ShelleyBase a -> ImpTestM era a
+runShelleyBase act = do
+  globals <- use impGlobalsL
+  pure $ runIdentity $ runReaderT act globals
 
 getRewardAccountAmount :: RewardAccount (EraCrypto era) -> ImpTestM era Coin
 getRewardAccountAmount rewardAcount = do
@@ -1016,15 +1020,14 @@ tryRunImpRule ::
     )
 tryRunImpRule stsEnv stsState stsSignal = do
   let trc = TRC (stsEnv, stsState, stsSignal)
-  globals <- use impGlobalsL
   let
     stsOpts =
       ApplySTSOpts
         { asoValidation = ValidateAll
         , asoEvents = EPReturn
         , asoAssertions = AssertionsAll
         }
-  pure $ runShelleyBase globals (applySTSOptsEither @(EraRule rule era) stsOpts trc)
+  runShelleyBase (applySTSOptsEither @(EraRule rule era) stsOpts trc)
 
 runImpRule ::
   forall rule era.
@@ -1546,3 +1549,9 @@ produceScript scriptHash = do
         mkBasicTx mkBasicTxBody
           & bodyTxL . outputsTxBodyL .~ SSeq.singleton (mkBasicTxOut addr (inject (Coin 10)))
   txInAt (0 :: Int) <$> submitTx tx
+
+advanceToPointOfNoReturn :: ImpTestM era ()
+advanceToPointOfNoReturn = do
+  impLastTick <- gets impLastTick
+  (_, slotOfNoReturn, _) <- runShelleyBase $ getTheSlotOfNoReturn impLastTick
+  impLastTickL .= slotOfNoReturn