Skip to content
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

Jump to bottom

Introduce RestrainedRewards event #2726

Merged
merged 1 commit into from
Apr 7, 2022
Merged

Introduce RestrainedRewards event #2726

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
25 changes: 18 additions & 7 deletions eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1260,23 +1260,29 @@ applyRUpd ::
EpochState era ->
EpochState era
applyRUpd ru es =
let (es', _) = applyRUpd' ru es
let (es', _, _, _) = applyRUpd' ru es
in es'

applyRUpd' ::
( HasField "_protocolVersion" (Core.PParams era) ProtVer
) =>
RewardUpdate (Crypto era) ->
EpochState era ->
(EpochState era, Map (Credential 'Staking (Crypto era)) (Set (Reward (Crypto era))))
( EpochState era,
Map (Credential 'Staking (Crypto era)) (Set (Reward (Crypto era))),
Map (Credential 'Staking (Crypto era)) (Set (Reward (Crypto era))),
Set (Credential 'Staking (Crypto era))
)
applyRUpd'
ru
es@(EpochState as ss ls pr pp _nm) = (EpochState as' ss ls' pr pp nm', registered)
es@(EpochState as ss ls pr pp _nm) =
(EpochState as' ss ls' pr pp nm', registered, eraIgnored, unregistered)
where
utxoState_ = lsUTxOState ls
delegState = lsDPState ls
dState = dpsDState delegState
(registered, totalUnregistered) = filterAllRewards (rs ru) es
(registered, eraIgnored, unregistered, totalUnregistered) =
filterAllRewards (rs ru) es
registeredAggregated = aggregateRewards pp registered
as' =
as
Expand All @@ -1302,9 +1308,13 @@ filterAllRewards ::
) =>
Map (Credential 'Staking (Crypto era)) (Set (Reward (Crypto era))) ->
EpochState era ->
(Map (Credential 'Staking (Crypto era)) (Set (Reward (Crypto era))), Coin)
( Map (Credential 'Staking (Crypto era)) (Set (Reward (Crypto era))),
Map (Credential 'Staking (Crypto era)) (Set (Reward (Crypto era))),
Set (Credential 'Staking (Crypto era)),
Coin
)
filterAllRewards rs' (EpochState _as _ss ls pr _pp _nm) =
(registered, totalUnregistered)
(registered, eraIgnored, unregistered, totalUnregistered)
where
delegState = lsDPState ls
dState = dpsDState delegState
Expand All @@ -1313,7 +1323,8 @@ filterAllRewards rs' (EpochState _as _ss ls pr _pp _nm) =
(\k _ -> eval (k ∈ dom (rewards dState)))
rs'
totalUnregistered = fold $ aggregateRewards pr unregRU
registered = filterRewards pr regRU
unregistered = Map.keysSet unregRU
(registered, eraIgnored) = filterRewards pr regRU

decayFactor :: Float
decayFactor = 0.9
Expand Down
12 changes: 8 additions & 4 deletions eras/shelley/impl/src/Cardano/Ledger/Shelley/Rewards.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -187,11 +187,15 @@ filterRewards ::
(HasField "_protocolVersion" pp ProtVer) =>
pp ->
Map (Credential 'Staking crypto) (Set (Reward crypto)) ->
Map (Credential 'Staking crypto) (Set (Reward crypto))
( Map (Credential 'Staking crypto) (Set (Reward crypto)),
Map (Credential 'Staking crypto) (Set (Reward crypto))
)
filterRewards pp rewards =
if HardForks.aggregatedRewards pp
then rewards
else Map.map (Set.singleton . Set.findMin) rewards
then (rewards, Map.empty)
else
let mp = Map.map Set.deleteFindMin rewards
in (Map.map (Set.singleton . fst) mp, Map.filter (not . Set.null) $ Map.map snd mp)

aggregateRewards ::
forall crypto pp.
Expand All @@ -200,7 +204,7 @@ aggregateRewards ::
Map (Credential 'Staking crypto) (Set (Reward crypto)) ->
Map (Credential 'Staking crypto) Coin
aggregateRewards pp rewards =
Map.map (foldMap' rewardAmount) $ filterRewards pp rewards
Map.map (foldMap' rewardAmount) $ fst $ filterRewards pp rewards

data LeaderOnlyReward crypto = LeaderOnlyReward
{ lRewardPool :: !(KeyHash 'StakePool crypto),
Expand Down
4 changes: 3 additions & 1 deletion eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -78,6 +78,7 @@ instance

data NewEpochEvent era
= DeltaRewardEvent (Event (Core.EraRule "RUPD" era))
| RestrainedRewards EpochNo (Map.Map (Credential 'Staking (Crypto era)) (Set (Reward (Crypto era)))) (Set (Credential 'Staking (Crypto era)))
| TotalRewardEvent EpochNo (Map.Map (Credential 'Staking (Crypto era)) (Set (Reward (Crypto era))))
| EpochEvent (Event (Core.EraRule "EPOCH" era))
| MirEvent (Event (Core.EraRule "MIR" era))
Expand Down Expand Up @@ -156,7 +157,8 @@ newEpochTransition = do
let updateRewards ru'@(RewardUpdate dt dr rs_ df _) = do
let totRs = sumRewards (esPrevPp es) rs_
Val.isZero (dt <> (dr <> toDeltaCoin totRs <> df)) ?! CorruptRewardUpdate ru'
let (es', regRU) = applyRUpd' ru' es
let (es', regRU, eraIgnored, unregistered) = applyRUpd' ru' es
tellEvent $ RestrainedRewards e eraIgnored unregistered
-- This event (which is only generated once per epoch) must be generated even if the
-- map is empty (db-sync depends on it).
tellEvent $ TotalRewardEvent e regRU
Expand Down
2 changes: 1 addition & 1 deletion eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Rewards.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -782,7 +782,7 @@ eventsMirrorRewards events nes = same eventRew compRew
(completed, lastevent) = complete pulser
total = getMostRecentTotalRewardEvent events
aggevent = aggIncrementalRewardEvents events
(aggFilteredEvent, _) = filterAllRewards aggevent (nesEs nes)
(aggFilteredEvent, _, _, _) = filterAllRewards aggevent (nesEs nes)
same x y = withMaxSuccess 1 $ counterexample message (x === y)
where
message =
Expand Down