Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
4 changed files
with
90 additions
and
7 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,79 @@ | ||
{-# LANGUAGE DataKinds #-} | ||
{-# LANGUAGE FlexibleContexts #-} | ||
{-# LANGUAGE NoImplicitPrelude #-} | ||
{-# LANGUAGE OverloadedStrings #-} | ||
{-# LANGUAGE RankNTypes #-} | ||
{-# LANGUAGE ScopedTypeVariables #-} | ||
{-# LANGUAGE TypeFamilies #-} | ||
|
||
module Cardano.DbSync.Era.Shelley.Adjust | ||
( adjustEpochRewards | ||
) where | ||
|
||
import Cardano.Prelude hiding (from, on) | ||
|
||
import Cardano.BM.Trace (Trace, logInfo) | ||
|
||
import qualified Cardano.Db as Db | ||
|
||
import Cardano.Sync.Util | ||
|
||
import Cardano.Slotting.Slot (EpochNo (..)) | ||
|
||
import Control.Monad.Trans.Control (MonadBaseControl) | ||
|
||
import Database.Esqueleto.Legacy (InnerJoin (..), SqlExpr, Value (..), ValueList, delete, | ||
from, in_, not_, on, select, subSelectList, unValue, val, valList, where_, (==.), | ||
(^.)) | ||
|
||
import Database.Persist.Sql (SqlBackend) | ||
|
||
|
||
-- This is a hack/workaround for an issue around the `Reward` table. The problem is as | ||
-- follows: | ||
-- | ||
-- * Rewards for epoch `N` are made available by ledger state towards the end of epoch `N + 1` | ||
-- at which time they are inserted into the database in chunks of say 1000 so interleaved | ||
-- between the insertion of regular block data. | ||
-- * If the stake address for the reward is de-registered after they are extracted from the | ||
-- ledger state but before the end of epoch `N + 1` (and not re-registered) then they should | ||
-- have been orphaned *instead* of being added to the `Reward` table. | ||
-- | ||
-- To fix this, we call this function at the start of the epoch `N + 2`, find all the stake | ||
-- addresses that were de-registered (and not re-registered) in epoch `N - 1` and delete any | ||
-- `Reward` table entries destined for that stake address. | ||
|
||
adjustEpochRewards | ||
:: (MonadBaseControl IO m, MonadIO m) | ||
=> Trace IO Text -> EpochNo | ||
-> ReaderT SqlBackend m () | ||
adjustEpochRewards tracer epochNo = do | ||
liftIO . logInfo tracer $ "adjustEpochRewards: epoch " <> textShow (unEpochNo epochNo) | ||
addrs <- queryOrphanedAddrs (epochNo - 1) | ||
liftIO . logInfo tracer $ "adjustEpochiRewards: " <> textShow addrs | ||
deleteOrphanedRewards addrs | ||
|
||
-- ------------------------------------------------------------------------------------------------ | ||
|
||
deleteOrphanedRewards :: MonadIO m => [Db.StakeAddressId] -> ReaderT SqlBackend m () | ||
deleteOrphanedRewards xs = | ||
delete . from $ \ rwd -> | ||
where_ (rwd ^. Db.RewardAddrId `in_` valList xs) | ||
|
||
-- Find all stake addresses that have been de-registered in the specified epoch and not | ||
-- re-registered in the same epoch. | ||
queryOrphanedAddrs :: MonadIO m => EpochNo -> ReaderT SqlBackend m [Db.StakeAddressId] | ||
queryOrphanedAddrs (EpochNo epochNo) = do | ||
res <- select . from $ \ (sa `InnerJoin` dereg) -> do | ||
on (sa ^. Db.StakeAddressId ==. dereg ^. Db.StakeDeregistrationAddrId) | ||
where_ (dereg ^. Db.StakeDeregistrationEpochNo ==. val epochNo) | ||
where_ (not_ $ sa ^. Db.StakeAddressId `in_` reregistered) | ||
pure (sa ^. Db.StakeAddressId) | ||
pure $ map unValue res | ||
where | ||
reregistered :: SqlExpr (ValueList Db.StakeAddressId) | ||
reregistered = | ||
subSelectList . from $ \ reg -> do | ||
where_ (reg ^. Db.StakeRegistrationEpochNo ==. val epochNo) | ||
pure (reg ^. Db.StakeRegistrationAddrId) | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters