Skip to content

Ts=new reward pulser #4196

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft

Ts=new reward pulser #4196

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
6dcd875
Added the 'initial' set to RSLP.
TimSheard Mar 12, 2024
860a071
Changes to RewardPulsing to enable seriralizing from initial state.
TimSheard Mar 12, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 4 additions & 3 deletions eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/PulsingReward.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand Down Expand Up @@ -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_
Expand Down
54 changes: 44 additions & 10 deletions eras/shelley/impl/src/Cardano/Ledger/Shelley/RewardUpdate.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,8 @@ module Cardano.Ledger.Shelley.RewardUpdate (
RewardPulser (..),
clearRecent,
PulsingRewUpdate (..),
encodeUsingInitial,
decodeFromInitial,
) where

import Cardano.Ledger.BaseTypes (ProtVer (..), ShelleyBase)
Expand Down Expand Up @@ -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))
Expand Down Expand Up @@ -287,6 +292,9 @@ 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 working value. Changed at every pulse.
!(VMap.VMap VMap.VB VMap.VP (Credential 'Staking c) (CompactForm Coin)) ->
!ans ->
RewardPulser c m ans
Expand All @@ -299,16 +307,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)
Expand All @@ -317,24 +325,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 <! From <! From <! From <! From)
decode (RecD RSLP <! From <! From <! From <! From <! From)

-- =========================================================================

Expand All @@ -355,6 +364,31 @@ instance Crypto c => DecCBOR (PulsingRewUpdate c) where
decPS 1 = SumD Complete <! From
decPS n = Invalid n

-- ===============================

initPulsing ::
RewardSnapShot c ->
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 <! From <! From <! From <! From
-- At this point we could complete the Pulser, as it has all the information needed.
decPS 1 = SumD Complete <! From
decPS n = Invalid n

-- ======================================================

instance NFData (PulsingRewUpdate c)

instance Crypto c => ToJSON (PulsingRewUpdate c) where
Expand Down
2 changes: 1 addition & 1 deletion eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -262,7 +262,7 @@ instance Crypto c => 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 =
Expand Down