diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs index f061b672bd2..aaacd9b2293 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs +++ b/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 diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs index 7fbeff70cd5..8b069313608 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs +++ b/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 diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs index d1d7c2ee170..3d68d4abd18 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs +++ b/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, diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs index a34d752452f..e185c7380a7 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs +++ b/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 = diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/TwoPools.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/TwoPools.hs index 57c9fe390a4..1f350c8f5ca 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/TwoPools.hs +++ b/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)] diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs index 8e1da4935cd..1b4d6f1f1d5 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs +++ b/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 =