From 6dcd875de90469facfc931b60e784950fcbc3afc Mon Sep 17 00:00:00 2001 From: Tim Sheard Date: Tue, 12 Mar 2024 10:53:19 -0700 Subject: [PATCH 1/2] Added the 'initial' set to RSLP. --- .../Shelley/LedgerState/PulsingReward.hs | 7 +++--- .../Cardano/Ledger/Shelley/RewardUpdate.hs | 24 +++++++++++-------- .../Test/Cardano/Ledger/Shelley/Arbitrary.hs | 2 +- 3 files changed, 19 insertions(+), 14 deletions(-) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/PulsingReward.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/PulsingReward.hs index c49cdc4bd1b..b3aa58fa6ae 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/PulsingReward.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/PulsingReward.hs @@ -225,7 +225,8 @@ startStep slotsPerEpoch b@(BlocksMade b') es@(EpochState acnt ls ss nm) maxSuppl RSLP pulseSize free - (unStake stake) + (unStake stake) -- The initial valuse + (unStake stake) -- is the same as the working value, when the pulser is created. (RewardAns Map.empty Map.empty) in Pulsing rewsnap pulser @@ -239,7 +240,7 @@ pulseStep (Complete r_) = pure (Complete r_, mempty) pulseStep p@(Pulsing _ pulser) | done pulser = completeStep p pulseStep (Pulsing rewsnap pulser) = do -- The pulser might compute provenance, but using pulseM here does not compute it - p2@(RSLP _ _ _ (RewardAns _ event)) <- pulseM pulser + p2@(RSLP _ _ _ _ (RewardAns _ event)) <- pulseM pulser pure (Pulsing rewsnap p2, event) -- Phase 3 @@ -273,7 +274,7 @@ completeRupd , rewLeaders = lrewards , rewProtocolVersion = protVer } - pulser@(RSLP _size _free _source (RewardAns prev _now)) -- If prev is Map.empty, we have never pulsed. + pulser@(RSLP _size _free _init _source (RewardAns prev _now)) -- If prev is Map.empty, we have never pulsed. ) = do RewardAns rs_ events <- completeM pulser let rs' = Map.map Set.singleton rs_ diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/RewardUpdate.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/RewardUpdate.hs index 169455865dc..1126eb503d7 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/RewardUpdate.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/RewardUpdate.hs @@ -288,6 +288,9 @@ data RewardPulser c (m :: Type -> Type) ans where !Int -> !(FreeVars c) -> !(VMap.VMap VMap.VB VMap.VP (Credential 'Staking c) (CompactForm Coin)) -> + -- ^ The initial value (used for serialisation) + !(VMap.VMap VMap.VB VMap.VP (Credential 'Staking c) (CompactForm Coin)) -> + -- ^ The working value. Changed at every pulse. !ans -> RewardPulser c m ans @@ -299,16 +302,16 @@ clearRecent :: RewardAns c -> RewardAns c clearRecent (RewardAns accum _) = RewardAns accum Map.empty instance Pulsable (RewardPulser c) where - done (RSLP _n _free zs _ans) = VMap.null zs - current (RSLP _ _ _ ans) = ans - pulseM p@(RSLP n free balance (clearRecent -> ans)) = + done (RSLP _n _free _ zs _ans) = VMap.null zs + current (RSLP _ _ _ _ ans) = ans + pulseM p@(RSLP n free initial balance (clearRecent -> ans)) = if VMap.null balance then pure p else do let !(steps, !balance') = VMap.splitAt n balance ans' = VMap.foldlWithKey (rewardStakePoolMember free) ans steps - pure $! RSLP n free balance' ans' - completeM (RSLP _ free balance (clearRecent -> ans)) = + pure $! RSLP n free initial balance' ans' + completeM (RSLP _ free _ balance (clearRecent -> ans)) = pure $ VMap.foldlWithKey (rewardStakePoolMember free) ans balance deriving instance Eq ans => Eq (RewardPulser c m ans) @@ -317,24 +320,25 @@ deriving instance Show ans => Show (RewardPulser c m ans) instance Typeable c => NoThunks (Pulser c) where showTypeOf _ = "RewardPulser" - wNoThunks ctxt (RSLP n free balance ans) = + wNoThunks ctxt (RSLP n free initial balance ans) = allNoThunks [ noThunks ctxt n , noThunks ctxt free + , noThunks ctxt initial , noThunks ctxt balance , noThunks ctxt ans ] instance NFData (Pulser c) where - rnf (RSLP n1 c1 b1 a1) = seq (rnf n1) (seq (rnf c1) (seq (rnf b1) (rnf a1))) + rnf (RSLP n1 c1 i1 b1 a1) = seq (rnf n1) (seq (rnf c1) (seq (rnf i1) (seq (rnf b1) (rnf a1)))) instance Crypto c => EncCBOR (Pulser c) where - encCBOR (RSLP n free balance ans) = - encode (Rec RSLP !> To n !> To free !> To balance !> To ans) + encCBOR (RSLP n free initial balance ans) = + encode (Rec RSLP !> To n !> To free !> To initial !> To balance !> To ans) instance Crypto c => DecCBOR (Pulser c) where decCBOR = - decode (RecD RSLP Arbitrary (RewardAns c) where shrink = genericShrink instance (Crypto c, a ~ RewardAns c) => Arbitrary (RewardPulser c ShelleyBase a) where - arbitrary = RSLP <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + arbitrary = RSLP <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance Crypto c => Arbitrary (PulsingRewUpdate c) where arbitrary = From 860a071f5dd42c6725cf4b9a30356d4f5dccedf1 Mon Sep 17 00:00:00 2001 From: Tim Sheard Date: Tue, 12 Mar 2024 16:18:36 -0700 Subject: [PATCH 2/2] Changes to RewardPulsing to enable seriralizing from initial state. --- .../Cardano/Ledger/Shelley/RewardUpdate.hs | 34 +++++++++++++++++-- 1 file changed, 32 insertions(+), 2 deletions(-) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/RewardUpdate.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/RewardUpdate.hs index 1126eb503d7..f229f9637d6 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/RewardUpdate.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/RewardUpdate.hs @@ -30,6 +30,8 @@ module Cardano.Ledger.Shelley.RewardUpdate ( RewardPulser (..), clearRecent, PulsingRewUpdate (..), + encodeUsingInitial, + decodeFromInitial, ) where import Cardano.Ledger.BaseTypes (ProtVer (..), ShelleyBase) @@ -75,6 +77,9 @@ import Data.VMap as VMap import GHC.Generics (Generic) import NoThunks.Class (NoThunks (..), allNoThunks) +import Cardano.Ledger.Binary (Decoder, Encoding) +import Cardano.Ledger.Binary.Version (Version) + -- =============================================================== type RewardEvent c = Map (Credential 'Staking c) (Set (Reward c)) @@ -287,10 +292,10 @@ data RewardPulser c (m :: Type -> Type) ans where (ans ~ RewardAns c, m ~ ShelleyBase) => !Int -> !(FreeVars c) -> + -- | The initial value (used for serialisation) !(VMap.VMap VMap.VB VMap.VP (Credential 'Staking c) (CompactForm Coin)) -> - -- ^ The initial value (used for serialisation) + -- | The working value. Changed at every pulse. !(VMap.VMap VMap.VB VMap.VP (Credential 'Staking c) (CompactForm Coin)) -> - -- ^ The working value. Changed at every pulse. !ans -> RewardPulser c m ans @@ -359,6 +364,31 @@ instance Crypto c => DecCBOR (PulsingRewUpdate c) where decPS 1 = SumD Complete + Int -> + FreeVars c -> + VMap VB VP (Credential 'Staking c) (CompactForm Coin) -> + PulsingRewUpdate c +initPulsing snap step free initial = (Pulsing snap (RSLP step free initial initial (RewardAns Map.empty Map.empty))) + +encodeUsingInitial :: Crypto c => PulsingRewUpdate c -> Encoding +encodeUsingInitial (Pulsing s (RSLP step free initial _ (RewardAns _ _))) = + encode (Sum initPulsing 0 !> To s !> To step !> To free !> To initial) +encodeUsingInitial (Complete r) = encode (Sum Complete 1 !> To r) + +decodeFromInitial :: Crypto c => Decoder Version (PulsingRewUpdate c) +decodeFromInitial = decode (Summands "PulsingRewUpdate" decPS) + where + decPS 0 = SumD initPulsing ToJSON (PulsingRewUpdate c) where