force the reward pulser to completion sooner

Some tools, such ad db-sync and the stake credential history tool rely
on being able to inspect the ledger state for the reward update. If the
pulser does not finish before the end of the epoch (which has happened
on the Shelley-QA network, see
IntersectMBO/cardano-db-sync#882) then the
pulser is forced to completion at the moment it is applied, as is
therefore invisible to downstream tools.

To solve this problem, we force completion of the reward pulser by
(2k/f)-many slots before the end of the epoch (one day on mainnet).

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