force the reward pulser to completion sooner

eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs

@@ -1115,7 +1115,20 @@ startStep slotsPerEpoch b@(BlocksMade b') es@(EpochState acnt ss ls pr _ nm) max
       numPools = fromIntegral (Map.size poolParams)
       k = fromIntegral secparam
       f = unboundRational (activeSlotVal asc)
-      pulseSize = max 1 (ceiling ((numPools * f) / (6 * k)))
+
+      -- We expect approximately (10k/f)-many blocks to be produced each epoch.
+      -- The reward calculation begins (4k/f)-many slots into the epoch,
+      -- and we guarantee that it ends (2k/f)-many slots before the end
+      -- of the epoch (to allow tools such as db-sync to see the reward
+      -- values in advance of them being applied to the ledger state).
+      --
+      -- Therefore to evenly space out the reward calculation, we divide
+      -- the number of stake pools by 4k/f in order to determine how many
+      -- stake pools' rewards we should calculate each block.
+      -- If it does not finish in this amount of time, the calculation is
+      -- forced to completion.
+      pulseSize = max 1 (ceiling ((numPools * f) / (4 * k)))
+
       Coin reserves = _reserves acnt
       ds = _dstate $ _delegationState ls
       -- reserves and rewards change

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

@@ -102,6 +102,18 @@ instance
   initialRules = [pure SNothing]
   transitionRules = [rupdTransition]
 
+-- | The Goldilocks labeling of when to do the reward calculation.
+data RewardTiming = RewardsTooEarly | RewardsJustRight | RewardsTooLate
+
+determineRewardTiming :: SlotNo -> SlotNo -> SlotNo -> RewardTiming
+determineRewardTiming currentSlot startAftterSlot endSlot =
+  if currentSlot > endSlot
+    then RewardsTooLate
+    else
+      if currentSlot <= startAftterSlot
+        then RewardsTooEarly
+        else RewardsJustRight
+
 rupdTransition ::
   ( Era era,
     HasField "_a0" (Core.PParams era) NonNegativeInterval,
@@ -114,7 +126,7 @@ rupdTransition ::
   TransitionRule (RUPD era)
 rupdTransition = do
   TRC (RupdEnv b es, ru, s) <- judgmentContext
-  (slotsPerEpoch, slot, maxLL, asc, k) <- liftSTS $ do
+  (slotsPerEpoch, slot, slotForce, maxLL, asc, k) <- liftSTS $ do
     ei <- asks epochInfo
     sr <- asks randomnessStabilisationWindow
     e <- epochInfoEpoch ei s
@@ -123,14 +135,21 @@ rupdTransition = do
     maxLL <- asks maxLovelaceSupply
     asc <- asks activeSlotCoeff
     k <- asks securityParameter -- Maximum number of blocks we are allowed to roll back
-    return (slotsPerEpoch, slot, maxLL, asc, k)
+    return (slotsPerEpoch, slot, (slot +* Duration sr), maxLL, asc, k)
   let maxsupply = Coin (fromIntegral maxLL)
-  case s <= slot of
+  case determineRewardTiming s slot slotForce of
     -- Waiting for the stabiliy point, do nothing, keep waiting
-    True -> pure SNothing
+    RewardsTooEarly -> pure SNothing
     -- More blocks to come, get things started or take a step
-    False ->
+    RewardsJustRight ->
       case ru of
         SNothing -> liftSTS $ runProvM $ pure $ SJust $ fst $ startStep slotsPerEpoch b es maxsupply asc k
         (SJust p@(Pulsing _ _)) -> liftSTS $ runProvM $ (SJust <$> pulseStep p)
         (SJust p@(Complete _)) -> pure (SJust p)
+    -- Time to force the completion of the pulser so that downstream tools such as db-sync
+    -- have time to see the reward update before the epoch boundary rollover.
+    RewardsTooLate ->
+      case ru of
+        SNothing -> SJust <$> (liftSTS . runProvM . completeStep . fst $ startStep slotsPerEpoch b es maxsupply asc k)
+        SJust p@(Pulsing _ _) -> SJust <$> (liftSTS . runProvM . completeStep $ p)
+        complete@(SJust (Complete _)) -> pure complete

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs

@@ -13,6 +13,7 @@
 module Test.Cardano.Ledger.Shelley.Examples.PoolLifetime
   ( makePulser,
     makePulser',
+    makeCompletedPulser,
     poolLifetimeExample,
   )
 where
@@ -39,8 +40,9 @@ import Cardano.Ledger.Shelley.API (getRewardProvenance)
 import qualified Cardano.Ledger.Shelley.EpochBoundary as EB
 import Cardano.Ledger.Shelley.LedgerState
   ( NewEpochState (..),
-    PulsingRewUpdate,
+    PulsingRewUpdate (..),
     RewardUpdate (..),
+    completeRupd,
     decayFactor,
     emptyRewardUpdate,
     startStep,
@@ -94,6 +96,7 @@ import Cardano.Protocol.TPraos
   )
 import Cardano.Protocol.TPraos.BHeader (BHeader, bhHash, hashHeaderToNonce)
 import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
+import Control.Provenance (runProvM)
 import Data.Default.Class (def)
 import Data.Foldable (fold)
 import Data.Group (invert)
@@ -353,8 +356,16 @@ makePulser' ::
   PulsingRewUpdate (Crypto era)
 makePulser' = makePulser (BlocksMade mempty)
 
+makeCompletedPulser ::
+  forall era.
+  (C.UsesPP era) =>
+  BlocksMade (Crypto era) ->
+  ChainState era ->
+  PulsingRewUpdate (Crypto era)
+makeCompletedPulser bs cs = Complete . runShelleyBase . runProvM . completeRupd $ makePulser bs cs
+
 pulserEx2 :: forall c. (ExMock (Crypto (ShelleyEra c))) => PulsingRewUpdate c
-pulserEx2 = makePulser (BlocksMade mempty) expectedStEx1
+pulserEx2 = makeCompletedPulser (BlocksMade mempty) expectedStEx1
 
 expectedStEx2 ::
   forall c.
@@ -486,7 +497,7 @@ blockEx4 =
     (mkOCert (coreNodeKeysBySchedule @(ShelleyEra c) ppEx 190) 0 (KESPeriod 0))
 
 pulserEx4 :: forall c. (ExMock c) => PulsingRewUpdate c
-pulserEx4 = makePulser (BlocksMade mempty) expectedStEx3
+pulserEx4 = makeCompletedPulser (BlocksMade mempty) expectedStEx3
 
 rewardUpdateEx4 :: forall c. RewardUpdate c
 rewardUpdateEx4 =
@@ -620,7 +631,7 @@ rewardUpdateEx6 =
     }
 
 pulserEx6 :: forall c. (ExMock c) => PulsingRewUpdate c
-pulserEx6 = makePulser (BlocksMade mempty) expectedStEx5
+pulserEx6 = makeCompletedPulser (BlocksMade mempty) expectedStEx5
 
 expectedStEx6 :: forall c. (ExMock (Crypto (ShelleyEra c))) => ChainState (ShelleyEra c)
 expectedStEx6 =
@@ -735,7 +746,7 @@ nonMyopicEx8 =
     rewardPot8
 
 pulserEx8 :: forall c. (ExMock c) => PulsingRewUpdate c
-pulserEx8 = makePulser (BlocksMade $ Map.singleton (hk Cast.alicePoolKeys) 1) expectedStEx7
+pulserEx8 = makeCompletedPulser (BlocksMade $ Map.singleton (hk Cast.alicePoolKeys) 1) expectedStEx7
 
 rewardUpdateEx8 :: forall c. Cr.Crypto c => RewardUpdate c
 rewardUpdateEx8 =
@@ -1027,7 +1038,7 @@ nonMyopicEx11 =
     (Coin 0)
 
 pulserEx11 :: forall c. (ExMock c) => PulsingRewUpdate c
-pulserEx11 = makePulser (BlocksMade mempty) expectedStEx10
+pulserEx11 = makeCompletedPulser (BlocksMade mempty) expectedStEx10
 
 rewardUpdateEx11 :: forall c. Cr.Crypto c => RewardUpdate c
 rewardUpdateEx11 =
@@ -1121,7 +1132,7 @@ poolLifetimeExample =
   testGroup
     "pool lifetime"
     [ testCase "initial registrations" $ testCHAINExample poolLifetime1,
-      testCase "elegate stake and create reward update" $ testCHAINExample poolLifetime2,
+      testCase "delegate stake and create reward update" $ testCHAINExample poolLifetime2,
       testCase "new epoch changes" $ testCHAINExample poolLifetime3,
       testCase "second reward update" $ testCHAINExample poolLifetime4,
       testCase "nonempty pool distr" $ testCHAINExample poolLifetime5,

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs

@@ -16,7 +16,8 @@ module Test.Cardano.Ledger.Shelley.Examples.PoolReReg
 where
 
 import Cardano.Ledger.BaseTypes
-  ( Globals (..),
+  ( BlocksMade (..),
+    Globals (..),
     Nonce,
     StrictMaybe (..),
   )
@@ -65,7 +66,7 @@ import Test.Cardano.Ledger.Shelley.Examples.Init
     nonce0,
     ppEx,
   )
-import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (makePulser')
+import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (makeCompletedPulser)
 import Test.Cardano.Ledger.Shelley.Generator.Core
   ( AllIssuerKeys (..),
     NatNonce (..),
@@ -249,7 +250,7 @@ poolReReg2A :: (ExMock (Crypto (ShelleyEra c))) => CHAINExample BHeader (Shelley
 poolReReg2A = CHAINExample expectedStEx1 blockEx2A (Right expectedStEx2A)
 
 pulserEx2 :: forall c. (ExMock c) => PulsingRewUpdate c
-pulserEx2 = makePulser' expectedStEx2
+pulserEx2 = makeCompletedPulser (BlocksMade mempty) expectedStEx2
 
 expectedStEx2B :: forall c. (ExMock (Crypto (ShelleyEra c))) => ChainState (ShelleyEra c)
 expectedStEx2B =

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/TwoPools.hs

@@ -121,7 +121,7 @@ import Test.Cardano.Ledger.Shelley.Examples.Init
     nonce0,
     ppEx,
   )
-import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (makePulser)
+import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (makeCompletedPulser)
 import Test.Cardano.Ledger.Shelley.Generator.Core
   ( AllIssuerKeys (..),
     NatNonce (..),
@@ -773,7 +773,7 @@ pulserEx9 ::
   PParams era ->
   PulsingRewUpdate (Crypto era)
 pulserEx9 pp =
-  makePulser
+  makeCompletedPulser
     ( BlocksMade $
         Map.fromList
           [(hk Cast.alicePoolKeys, 2), (hk Cast.bobPoolKeys, 1)]

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs

@@ -15,7 +15,8 @@ module Test.Cardano.Ledger.Shelley.Examples.Updates
 where
 
 import Cardano.Ledger.BaseTypes
-  ( Nonce,
+  ( BlocksMade (..),
+    Nonce,
     StrictMaybe (..),
     mkNonceFromNumber,
     (⭒),
@@ -74,7 +75,7 @@ import Test.Cardano.Ledger.Shelley.Examples.Init
     nonce0,
     ppEx,
   )
-import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (makePulser')
+import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (makeCompletedPulser)
 import Test.Cardano.Ledger.Shelley.Generator.Core
   ( AllIssuerKeys (..),
     NatNonce (..),
@@ -353,7 +354,7 @@ blockEx3 =
     (mkOCert (coreNodeKeysBySchedule @(ShelleyEra c) ppEx 80) 0 (KESPeriod 0))
 
 pulserEx3 :: forall c. (ExMock c) => PulsingRewUpdate c
-pulserEx3 = makePulser' expectedStEx2
+pulserEx3 = makeCompletedPulser (BlocksMade mempty) expectedStEx2
 
 expectedStEx3 :: forall c. (ExMock (Crypto (ShelleyEra c))) => ChainState (ShelleyEra c)
 expectedStEx3 =