From 4e43452b6e5df4d3b1395e03adada408beeae824 Mon Sep 17 00:00:00 2001 From: Jared Corduan Date: Thu, 14 Oct 2021 16:32:15 -0400 Subject: [PATCH] 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 https://github.com/input-output-hk/cardano-db-sync/issues/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). --- .../src/Cardano/Ledger/Shelley/LedgerState.hs | 15 +++++++++- .../src/Cardano/Ledger/Shelley/Rules/Rupd.hs | 29 +++++++++++++++---- .../Ledger/Shelley/Examples/PoolLifetime.hs | 25 +++++++++++----- .../Ledger/Shelley/Examples/PoolReReg.hs | 7 +++-- .../Ledger/Shelley/Examples/TwoPools.hs | 4 +-- .../Ledger/Shelley/Examples/Updates.hs | 7 +++-- 6 files changed, 66 insertions(+), 21 deletions(-) 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 =