Merge pull request #4115 from IntersectMBO/lehins/use-correct-stake-p…

…ool-distr-voting

Switch to using the correct stake pool distribution for voting

eras/conway/impl/CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## 1.13.0.0
 
+* Switch `EPOCH` rule environment back to `()`. Start using the latest stake pool
+  distribution: #4115
 * Add:
   * `transTxInInfoV1`
   * `transTxOutV1`

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

@@ -928,8 +928,9 @@ data DRepPulser era (m :: Type -> Type) ans where
     -- ^ The object we are iterating over. Shrinks with each pulse
     , dpStakeDistr :: !(Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin))
     -- ^ Snapshot of the stake distr (comes from the IncrementalStake)
-    , dpStakePoolDistr :: !(PoolDistr (EraCrypto era))
-    -- ^ Snapshot of the pool distr
+    , dpStakePoolDistr :: PoolDistr (EraCrypto era)
+    -- ^ Snapshot of the pool distr. Lazy on purpose: See `ssStakeMarkPoolDistr` and ADR-7
+    -- for explanation.
     , dpDRepDistr :: !(Map (DRep (EraCrypto era)) (CompactForm Coin))
     -- ^ The partial result that grows with each pulse. The purpose of the pulsing.
     , dpDRepState :: !(Map (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
@@ -974,8 +975,8 @@ instance EraPParams era => NoThunks (DRepPulser era Identity (RatifyState era))
       , noThunks ctxt (dpUMap drp)
       , noThunks ctxt (dpBalance drp)
       , noThunks ctxt (dpStakeDistr drp)
-      , noThunks ctxt (dpStakePoolDistr drp)
-      , noThunks ctxt (dpDRepDistr drp)
+      , -- dpStakePoolDistr is allowed to have thunks
+        noThunks ctxt (dpDRepDistr drp)
       , noThunks ctxt (dpDRepState drp)
       , noThunks ctxt (dpCurrentEpoch drp)
       , noThunks ctxt (dpCommitteeState drp)

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Epoch.hs

@@ -63,8 +63,7 @@ import Cardano.Ledger.Conway.Governance (
   setFreshDRepPulsingState,
  )
 import Cardano.Ledger.Conway.Governance.Procedures (Committee (..))
-import Cardano.Ledger.EpochBoundary (SnapShots)
-import Cardano.Ledger.PoolDistr (PoolDistr)
+import Cardano.Ledger.EpochBoundary (SnapShots (..))
 import Cardano.Ledger.Shelley.LedgerState (
   AccountState (..),
   DState (..),
@@ -147,7 +146,7 @@ instance
   where
   type State (ConwayEPOCH era) = EpochState era
   type Signal (ConwayEPOCH era) = EpochNo
-  type Environment (ConwayEPOCH era) = PoolDistr (EraCrypto era)
+  type Environment (ConwayEPOCH era) = ()
   type BaseM (ConwayEPOCH era) = ShelleyBase
 
   -- EPOCH rule can never fail
@@ -249,7 +248,7 @@ epochTransition ::
   TransitionRule (ConwayEPOCH era)
 epochTransition = do
   TRC
-    ( stakePoolDistr
+    ( ()
       , epochState0@EpochState
           { esAccountState = accountState0
           , esSnapshots = snapshots0
@@ -277,6 +276,7 @@ epochTransition = do
       TRC (ShelleyPoolreapEnv vState, PoolreapState utxoState0 accountState0 dState0 pState1, eNo)
 
   let
+    stakePoolDistr = ssStakeMarkPoolDistr snapshots1
     pulsingState = epochState0 ^. epochStateDRepPulsingStateL
 
     ratState0@RatifyState {rsEnactState, rsEnacted, rsExpired} =

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/NewEpoch.hs

@@ -92,7 +92,7 @@ instance
   , ConwayEraGov era
   , Embed (EraRule "EPOCH" era) (ConwayNEWEPOCH era)
   , Event (EraRule "RUPD" era) ~ RupdEvent (EraCrypto era)
-  , Environment (EraRule "EPOCH" era) ~ PoolDistr (EraCrypto era)
+  , Environment (EraRule "EPOCH" era) ~ ()
   , State (EraRule "EPOCH" era) ~ EpochState era
   , Signal (EraRule "EPOCH" era) ~ EpochNo
   , Default (EpochState era)
@@ -132,7 +132,7 @@ newEpochTransition ::
   ( EraTxOut era
   , ConwayEraGov era
   , Embed (EraRule "EPOCH" era) (ConwayNEWEPOCH era)
-  , Environment (EraRule "EPOCH" era) ~ PoolDistr (EraCrypto era)
+  , Environment (EraRule "EPOCH" era) ~ ()
   , State (EraRule "EPOCH" era) ~ EpochState era
   , Signal (EraRule "EPOCH" era) ~ EpochNo
   , Default (StashedAVVMAddresses era)
@@ -148,7 +148,7 @@ newEpochTransition ::
 newEpochTransition = do
   TRC
     ( _
-      , nes@(NewEpochState eL _ bcur es0 ru pd _)
+      , nes@(NewEpochState eL _ bcur es0 ru _ _)
       , eNo
       ) <-
     judgmentContext
@@ -162,7 +162,7 @@ newEpochTransition = do
           tellReward (DeltaRewardEvent (RupdEvent eNo event))
           updateRewards es0 eNo ans
         SJust (Complete ru') -> updateRewards es0 eNo ru'
-      es2 <- trans @(EraRule "EPOCH" era) $ TRC (pd, es1, eNo)
+      es2 <- trans @(EraRule "EPOCH" era) $ TRC ((), es1, eNo)
       let adaPots = totalAdaPotsES es2
       tellEvent $ TotalAdaPotsEvent adaPots
       let pd' = ssStakeMarkPoolDistr (esSnapshots es0)

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

@@ -1224,7 +1224,7 @@ spec =
           addCCGaid <- submitGovAction addCCAction
           -- Submit the vote
           submitVote_ VoteYes (StakePoolVoter poolKH1) addCCGaid
-          passNEpochs 4 -- FIXME
+          passNEpochs 2
           -- The vote should not result in a ratification
           logRatificationChecks addCCGaid
           isSpoAccepted addCCGaid `shouldReturn` False
@@ -1234,9 +1234,7 @@ spec =
           sendCoinTo
             (Addr Testnet delegatorCPayment1 (StakeRefBase delegatorCStaking1))
             (Coin 200_000)
-          -- FIXME: For SPOs, updates in stake distribution appear to reflect after 4 epochs for enactment.
-          -- https://github.com/IntersectMBO/cardano-ledger/issues/4108
-          passNEpochs 4
+          passNEpochs 2
           -- The same vote should now successfully ratify the proposal
           getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId addCCGaid)
         it "Rewards contribute to active voting stake" $ do
@@ -1260,7 +1258,7 @@ spec =
           addCCGaid <- submitGovAction addCCAction
           -- Submit the vote
           submitVote_ VoteYes (StakePoolVoter poolKH1) addCCGaid
-          passNEpochs 4 -- FIXME
+          passNEpochs 2
           -- The vote should not result in a ratification
           isSpoAccepted addCCGaid `shouldReturn` False
           getLastEnactedCommittee `shouldReturn` SNothing
@@ -1272,9 +1270,7 @@ spec =
                 (\(UM.RDPair r d) -> UM.RDPair (r <> UM.CompactCoin 200_000) d)
                 delegatorCStaking1
                 . UM.RewDepUView
-          -- FIXME: For SPOs, updates in stake distribution appear to reflect after 4 epochs for enactment.
-          -- https://github.com/IntersectMBO/cardano-ledger/issues/4108
-          passNEpochs 4
+          passNEpochs 2
           -- The same vote should now successfully ratify the proposal
           getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId addCCGaid)
     describe "Committee actions validation" $ do

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs

@@ -90,7 +90,6 @@ snapTransition ::
 snapTransition = do
   TRC (snapEnv, s, _) <- judgmentContext
 
-  -- TODO Handle VState
   let SnapEnv (LedgerState (UTxOState _utxo _ fees _ incStake _) (CertState _ pstate dstate)) pp = snapEnv
       -- per the spec: stakeSnap = stakeDistr @era utxo dstate pstate
       istakeSnap = incrementalStakeDistr pp incStake dstate pstate

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/STSTestUtils.hs

@@ -20,7 +20,6 @@ module Test.Cardano.Ledger.Examples.STSTestUtils (
   someKeys,
   someScriptAddr,
   testBBODY,
-  runEPOCH,
   runLEDGER,
   testUTXOW,
   testUTXOWsubset,
@@ -51,7 +50,6 @@ import Cardano.Ledger.BHeaderView (BHeaderView (..))
 import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..))
 import Cardano.Ledger.Babbage.Rules as Babbage (BabbageUtxowPredFailure (..))
 import Cardano.Ledger.BaseTypes (
-  EpochNo (..),
   Network (..),
   mkTxIxPartial,
  )
@@ -66,10 +64,8 @@ import Cardano.Ledger.Keys (KeyRole (..), hashKey)
 import Cardano.Ledger.Plutus.Data (Data (..), hashData)
 import Cardano.Ledger.Shelley.API (
   Block (..),
-  EpochState (..),
   LedgerEnv (..),
   LedgerState (..),
-  PoolDistr,
   UTxO (..),
  )
 import Cardano.Ledger.Shelley.Core hiding (TranslationError)
@@ -362,26 +358,6 @@ runLEDGER wit@(LEDGER proof) state pparams tx =
         Allegra -> runSTS' wit (TRC (env, state, tx))
         Shelley -> runSTS' wit (TRC (env, state, tx))
 
-runEPOCH ::
-  forall era.
-  ( GoodCrypto (EraCrypto era)
-  , EraTx era
-  , EraGov era
-  ) =>
-  WitRule "EPOCH" era ->
-  EpochState era ->
-  EpochNo ->
-  PoolDistr (EraCrypto era) ->
-  Either [PredicateFailure (EraRule "EPOCH" era)] (State (EraRule "EPOCH" era))
-runEPOCH wit@(EPOCH proof) state epochNo poolDistr =
-  case proof of
-    Conway -> runSTS' wit (TRC (poolDistr, state, epochNo))
-    Babbage -> runSTS' wit (TRC ((), state, epochNo))
-    Alonzo -> runSTS' wit (TRC ((), state, epochNo))
-    Mary -> runSTS' wit (TRC ((), state, epochNo))
-    Allegra -> runSTS' wit (TRC ((), state, epochNo))
-    Shelley -> runSTS' wit (TRC ((), state, epochNo))
-
 -- ======================================================================
 -- =========================  Internal helper functions  ================
 -- ======================================================================