Address review comments.

Make rewards a result of proposal expiry and pool retirement as it
should be, without directly modified the NewEpochState

eras/conway/impl/CHANGELOG.md

@@ -54,7 +54,14 @@
 
 ### `testlib`
 
-* Add `setupDRepWithoutStake` to `Conway.ImpTest`. #4273
+* Add the following utilities. #4273
+  * to `Conway.ImpTest`
+    * `setupDRepWithoutStake`
+    * `setupPoolWithoutStake` 
+    * `submitAndExpireProposalToMakeReward`
+  * to `Shelley.ImpTest`
+    * `getRewardAccountFor`
+    * `registerAndRetirePoolToMakeReward`
 * Implement `ConwayUtxowPredFailure` instances:
   * `Arbitrary`
   * `ToExpr`

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

@@ -243,7 +243,7 @@ instance Pulsable (DRepPulser era) where
   pulseM pulser@(DRepPulser {..})
     | done pulser = pure pulser {dpIndex = 0}
     | otherwise =
-        let !chunk = Map.drop dpIndex $ Map.take (dpIndex + dpPulseSize) $ UMap.umElems dpUMap
+        let !chunk = Map.take dpPulseSize $ Map.drop dpIndex $ UMap.umElems dpUMap
             dRepDistr = computeDRepDistr dpStakeDistr dpDRepState dpDRepDistr chunk
          in pure (pulser {dpIndex = dpIndex + dpPulseSize, dpDRepDistr = dRepDistr})
 

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

@@ -581,27 +581,28 @@ votingSpec =
                   , dvtCommitteeNoConfidence = 51 %! 100
                   }
               & ppCommitteeMaxTermLengthL .~ EpochInterval 20
+              & ppGovActionDepositL .~ Coin 1_000_000
+              & ppPoolDepositL .~ Coin 200_000
+              & ppEMaxL .~ EpochInterval 5
+              & ppGovActionLifetimeL .~ EpochInterval 5
           -- Setup DRep delegation #1
           (drepKH1, stakingKH1) <- setupDRepWithoutStake
           -- Add rewards to delegation #1
-          modifyNES $
-            nesEsL . epochStateUMapL
-              %~ UM.adjust
-                (\(UM.RDPair r d) -> UM.RDPair (r <> UM.CompactCoin 1_000_000) d)
-                (KeyHashObj stakingKH1)
-                . UM.RewDepUView
+          submitAndExpireProposalToMakeReward 1_000_000 $ KeyHashObj stakingKH1
+          lookupReward (KeyHashObj stakingKH1) `shouldReturn` Coin 1_000_000
           -- Setup DRep delegation #2
           (_drepKH2, stakingKH2) <- setupDRepWithoutStake
           -- Add rewards to delegation #2
-          modifyNES $
-            nesEsL . epochStateUMapL
-              %~ UM.adjust
-                (\(UM.RDPair r d) -> UM.RDPair (r <> UM.CompactCoin 1_000_000) d)
-                (KeyHashObj stakingKH2)
-                . UM.RewDepUView
+          submitAndExpireProposalToMakeReward 1_000_000 $ KeyHashObj stakingKH2
+          lookupReward (KeyHashObj stakingKH2) `shouldReturn` Coin 1_000_000
           -- Submit a committee proposal
           cc <- KeyHashObj <$> freshKeyHash
-          let addCCAction = UpdateCommittee SNothing mempty (Map.singleton cc 10) (75 %! 100)
+          let addCCAction =
+                UpdateCommittee
+                  SNothing
+                  mempty
+                  (Map.singleton cc $ 10 + 2 * 5) -- some + 2 * GovActionLifetime
+                  (75 %! 100)
           addCCGaid <- submitGovAction addCCAction
           -- Submit the vote
           submitVote_ VoteYes (DRepVoter $ KeyHashObj drepKH1) addCCGaid
@@ -611,17 +612,12 @@ votingSpec =
           getLastEnactedCommittee `shouldReturn` SNothing
           -- Increase the rewards of the delegator to this DRep
           -- to barely make the threshold (51 %! 100)
-          modifyNES $
-            nesEsL . epochStateUMapL
-              %~ UM.adjust
-                (\(UM.RDPair r d) -> UM.RDPair (r <> UM.CompactCoin 200_000) d)
-                (KeyHashObj stakingKH1)
-                . UM.RewDepUView
+          registerAndRetirePoolToMakeReward $ KeyHashObj stakingKH1
           passEpoch
-          -- The same vote should now qualify for ratification
+          lookupReward (KeyHashObj stakingKH1) `shouldReturn` Coin 1_200_000
           isDRepAccepted addCCGaid `shouldReturn` True
-          passEpoch
           -- The same vote should now successfully ratify the proposal
+          passEpoch
           getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId addCCGaid)
       describe "StakePool" $ do
         it "UTxOs contribute to active voting stake" $ do
@@ -707,27 +703,28 @@ votingSpec =
                   , pvtCommitteeNoConfidence = 51 %! 100
                   }
               & ppCommitteeMaxTermLengthL .~ EpochInterval 20
+              & ppGovActionDepositL .~ Coin 1_000_000
+              & ppPoolDepositL .~ Coin 200_000
+              & ppEMaxL .~ EpochInterval 5
+              & ppGovActionLifetimeL .~ EpochInterval 5
           -- Setup Pool delegation #1
           (poolKH1, delegatorCStaking1) <- setupPoolWithoutStake
           -- Add rewards to delegation #1
-          modifyNES $
-            nesEsL . epochStateUMapL
-              %~ UM.adjust
-                (\(UM.RDPair r d) -> UM.RDPair (r <> UM.CompactCoin 1_000_000) d)
-                delegatorCStaking1
-                . UM.RewDepUView
+          submitAndExpireProposalToMakeReward 1_000_000 delegatorCStaking1
+          lookupReward delegatorCStaking1 `shouldReturn` Coin 1_000_000
           -- Setup Pool delegation #2
           (poolKH2, delegatorCStaking2) <- setupPoolWithoutStake
           -- Add rewards to delegation #2
-          modifyNES $
-            nesEsL . epochStateUMapL
-              %~ UM.adjust
-                (\(UM.RDPair r d) -> UM.RDPair (r <> UM.CompactCoin 1_000_000) d)
-                delegatorCStaking2
-                . UM.RewDepUView
+          submitAndExpireProposalToMakeReward 1_000_000 delegatorCStaking2
+          lookupReward delegatorCStaking2 `shouldReturn` Coin 1_000_000
           -- Submit a committee proposal
           cc <- KeyHashObj <$> freshKeyHash
-          let addCCAction = UpdateCommittee SNothing mempty (Map.singleton cc 10) (75 %! 100)
+          let addCCAction =
+                UpdateCommittee
+                  SNothing
+                  mempty
+                  (Map.singleton cc $ 10 + 2 * 5) -- some + 2 * GovActionLifetime
+                  (75 %! 100)
           addCCGaid <- submitGovAction addCCAction
           -- Submit the vote
           submitVote_ VoteYes (StakePoolVoter poolKH1) addCCGaid
@@ -739,14 +736,13 @@ votingSpec =
           logRatificationChecks addCCGaid
           -- Add to the rewards of the delegator to this SPO
           -- to barely make the threshold (51 %! 100)
-          modifyNES $
-            nesEsL . epochStateUMapL
-              %~ UM.adjust
-                (\(UM.RDPair r d) -> UM.RDPair (r <> UM.CompactCoin 200_000) d)
-                delegatorCStaking1
-                . UM.RewDepUView
-          passNEpochs 2
+          registerAndRetirePoolToMakeReward $ delegatorCStaking1
+          passEpoch
+          lookupReward delegatorCStaking1 `shouldReturn` Coin 1_200_000
           -- The same vote should now successfully ratify the proposal
+          -- NOTE: It takes 2 epochs for SPO votes as opposed to 1 epoch
+          -- for DRep votes to ratify a proposal.
+          passNEpochs 2
           getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId addCCGaid)
 
 delayingActionsSpec ::

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs

@@ -26,6 +26,7 @@ module Test.Cardano.Ledger.Conway.ImpTest (
   submitGovAction_,
   submitGovActions,
   submitProposal,
+  submitAndExpireProposalToMakeReward,
   submitProposal_,
   submitProposals,
   submitFailingProposal,
@@ -321,14 +322,15 @@ setupDRepWithoutStake ::
 setupDRepWithoutStake = do
   drepKH <- registerDRep
   delegatorKH <- freshKeyHash
+  deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
   submitTxAnn_ "Delegate to DRep" $
     mkBasicTx mkBasicTxBody
       & bodyTxL . certsTxBodyL
         .~ SSeq.fromList
           [ mkRegDepositDelegTxCert @era
               (KeyHashObj delegatorKH)
               (DelegVote (DRepCredential $ KeyHashObj drepKH))
-              zero
+              deposit
           ]
   pure (drepKH, delegatorKH)
 
@@ -605,6 +607,25 @@ trySubmitGovAction ga = do
   let mkGovActionId tx = GovActionId (txIdTx tx) (GovActionIx 0)
   fmap mkGovActionId <$> trySubmitGovActions (pure ga)
 
+submitAndExpireProposalToMakeReward ::
+  ConwayEraImp era =>
+  Int ->
+  Credential 'Staking (EraCrypto era) ->
+  ImpTestM era ()
+submitAndExpireProposalToMakeReward expectedReward stakingC = do
+  rewardAccount <- getRewardAccountFor stakingC
+  EpochInterval lifetime <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionLifetimeL
+  gai <-
+    submitProposal $
+      ProposalProcedure
+        { pProcDeposit = Coin $ fromIntegral expectedReward
+        , pProcReturnAddr = rewardAccount
+        , pProcGovAction = TreasuryWithdrawals mempty def
+        , pProcAnchor = def
+        }
+  passNEpochs $ 2 + fromIntegral lifetime
+  expectMissingGovActionId gai
+
 -- | Submits a transaction that proposes the given governance action
 trySubmitGovActions ::
   (ShelleyEraImp era, ConwayEraTxBody era) =>

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

@@ -66,8 +66,10 @@ module Test.Cardano.Ledger.Shelley.ImpTest (
   runImpRule,
   tryRunImpRule,
   registerRewardAccount,
+  getRewardAccountFor,
   lookupReward,
   registerPool,
+  registerAndRetirePoolToMakeReward,
   getRewardAccountAmount,
   withImpState,
   shelleyFixupTx,
@@ -114,18 +116,7 @@ import Cardano.Ledger.Address (
   RewardAccount (..),
   bootstrapKeyHash,
  )
-import Cardano.Ledger.BaseTypes (
-  BlocksMade (..),
-  EpochSize (..),
-  Globals (..),
-  Network (..),
-  ShelleyBase,
-  SlotNo,
-  StrictMaybe (..),
-  TxIx (..),
-  inject,
-  mkTxIxPartial,
- )
+import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
 import Cardano.Ledger.CertState (certDStateL, dsUnifiedL)
 import Cardano.Ledger.Coin (Coin (..))
@@ -1288,6 +1279,13 @@ submitTxAnn_ ::
   (HasCallStack, ShelleyEraImp era) => String -> Tx era -> ImpTestM era ()
 submitTxAnn_ msg = void . submitTxAnn msg
 
+getRewardAccountFor ::
+  Credential 'Staking (EraCrypto era) ->
+  ImpTestM era (RewardAccount (EraCrypto era))
+getRewardAccountFor stakingC = do
+  networkId <- use (to impGlobals . to networkId)
+  pure $ RewardAccount networkId stakingC
+
 registerRewardAccount ::
   forall era.
   ( HasCallStack
@@ -1347,6 +1345,39 @@ registerPool = do
       & bodyTxL . certsTxBodyL .~ SSeq.singleton (RegPoolTxCert poolParams)
   pure khPool
 
+registerAndRetirePoolToMakeReward ::
+  ShelleyEraImp era =>
+  Credential 'Staking (EraCrypto era) ->
+  ImpTestM era ()
+registerAndRetirePoolToMakeReward stakingC = do
+  poolKH <- freshKeyHash
+  networkId <- use (to impGlobals . to networkId)
+  vrfKH <- freshKeyHashVRF
+  Positive pledge <- arbitrary
+  Positive cost <- arbitrary
+  let poolParams =
+        PoolParams
+          { ppVrf = vrfKH
+          , ppId = poolKH
+          , ppRewardAccount = RewardAccount networkId stakingC
+          , ppPledge = Coin pledge
+          , ppCost = Coin cost
+          , ppOwners = mempty
+          , ppMetadata = SNothing
+          , ppMargin = def
+          , ppRelays = mempty
+          }
+  submitTxAnn_ "Registering a temporary stake pool" $
+    mkBasicTx mkBasicTxBody
+      & bodyTxL . certsTxBodyL .~ SSeq.singleton (RegPoolTxCert poolParams)
+  passEpoch
+  currentEpochNo <- getsNES nesELL
+  submitTxAnn_ "Retiring the temporary stake pool" $
+    mkBasicTx mkBasicTxBody
+      & bodyTxL . certsTxBodyL
+        .~ SSeq.singleton (RetirePoolTxCert poolKH $ addEpochInterval currentEpochNo $ EpochInterval 2)
+  passEpoch
+
 -- | Compose given function with the configured fixup
 withCustomFixup ::
   ((Tx era -> ImpTestM era (Tx era)) -> Tx era -> ImpTestM era (Tx era)) ->

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances.hs

@@ -1216,7 +1216,7 @@ instance IsConwayUniv fn => HasSpec fn (PulsingSnapshot (ConwayEra StandardCrypt
 type DRepPulserTypes =
   '[ Int
    , UMap StandardCrypto
-   , Int -- Map (Credential 'Staking StandardCrypto) (CompactForm Coin)
+   , Int
    , Map (Credential 'Staking StandardCrypto) (CompactForm Coin)
    , PoolDistr StandardCrypto
    , Map (DRep StandardCrypto) (CompactForm Coin)