Skip to content

Commit 4775489

Browse files
CmdvCmdv
committed
1678: epoch_stake missing entries
1 parent 572095c commit 4775489

File tree

6 files changed

+113
-69
lines changed

6 files changed

+113
-69
lines changed

‎cardano-db-sync/src/Cardano/DbSync/Default.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -99,7 +99,7 @@ applyAndInsertBlockMaybe syncEnv tracer cblk = do
9999
mkApplyResult :: Bool -> IO (ApplyResult, Bool)
100100
mkApplyResult isCons = do
101101
case envLedgerEnv syncEnv of
102-
HasLedger hle -> applyBlockAndSnapshot hle cblk isCons
102+
HasLedger hle -> applyBlockAndSnapshot tracer hle cblk isCons
103103
NoLedger nle -> do
104104
slotDetails <- getSlotDetailsNode nle (cardanoBlockSlotNo cblk)
105105
pure (defaultApplyResult slotDetails, False)

‎cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs

+47-25
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,8 @@ module Cardano.DbSync.Era.Shelley.Generic.StakeDist (
1717
getPoolDistr,
1818
) where
1919

20+
import Cardano.BM.Data.Trace (Trace)
21+
import Cardano.BM.Trace (logInfo)
2022
import Cardano.DbSync.Types
2123
import Cardano.Ledger.Coin (Coin (..))
2224
import qualified Cardano.Ledger.Compactible as Ledger
@@ -72,35 +74,55 @@ getSecurityParameter = maxRollbacks . configSecurityParam . pInfoConfig
7274
-- will be adjusted.
7375
getStakeSlice ::
7476
ConsensusProtocol (BlockProtocol blk) =>
77+
Trace IO Text ->
7578
ProtocolInfo blk ->
7679
Word64 ->
7780
ExtLedgerState CardanoBlock ->
7881
Bool ->
79-
StakeSliceRes
80-
getStakeSlice pInfo !epochBlockNo els isMigration =
82+
IO StakeSliceRes
83+
getStakeSlice trce pInfo !epochBlockNo els isMigration =
8184
case ledgerState els of
82-
LedgerStateByron _ -> NoSlices
83-
LedgerStateShelley sls -> genericStakeSlice pInfo epochBlockNo sls isMigration
84-
LedgerStateAllegra als -> genericStakeSlice pInfo epochBlockNo als isMigration
85-
LedgerStateMary mls -> genericStakeSlice pInfo epochBlockNo mls isMigration
86-
LedgerStateAlonzo als -> genericStakeSlice pInfo epochBlockNo als isMigration
87-
LedgerStateBabbage bls -> genericStakeSlice pInfo epochBlockNo bls isMigration
88-
LedgerStateConway cls -> genericStakeSlice pInfo epochBlockNo cls isMigration
89-
85+
LedgerStateByron _ -> pure NoSlices
86+
LedgerStateShelley sls -> genericStakeSlice trce pInfo epochBlockNo sls isMigration
87+
LedgerStateAllegra als -> genericStakeSlice trce pInfo epochBlockNo als isMigration
88+
LedgerStateMary mls -> genericStakeSlice trce pInfo epochBlockNo mls isMigration
89+
LedgerStateAlonzo als -> genericStakeSlice trce pInfo epochBlockNo als isMigration
90+
LedgerStateBabbage bls -> genericStakeSlice trce pInfo epochBlockNo bls isMigration
91+
LedgerStateConway cls -> genericStakeSlice trce pInfo epochBlockNo cls isMigration
92+
93+
-- TODO: Cmdv
9094
genericStakeSlice ::
9195
forall era c blk p.
9296
(c ~ StandardCrypto, EraCrypto era ~ c, ConsensusProtocol (BlockProtocol blk)) =>
97+
Trace IO Text ->
9398
ProtocolInfo blk ->
9499
Word64 ->
95100
LedgerState (ShelleyBlock p era) ->
96101
Bool ->
97-
StakeSliceRes
98-
genericStakeSlice pInfo epochBlockNo lstate isMigration
99-
| index > delegationsLen = NoSlices
100-
| index == delegationsLen = Slice (emptySlice epoch) True
101-
| index + size > delegationsLen = Slice (mkSlice (delegationsLen - index)) True
102-
| otherwise = Slice (mkSlice size) False
102+
IO StakeSliceRes
103+
genericStakeSlice trce pInfo epochBlockNo lstate isMigration =
104+
case compare index delegationsLen of
105+
GT -> pure NoSlices
106+
EQ -> pure $ Slice (emptySlice epoch) True
107+
LT -> case compare (index + size) delegationsLen of
108+
GT -> pure $ Slice (mkSlice (delegationsLen - index)) True
109+
_other -> pure $ Slice (mkSlice size) False
103110
where
111+
_logStuff :: Text -> IO ()
112+
_logStuff text = do
113+
when (unEpochNo epoch > 11 && unEpochNo epoch < 24) $ do
114+
liftIO $ logInfo trce ("----- " <> show epochBlockNo <> " -----")
115+
liftIO $ logInfo trce $ "----- " <> text
116+
liftIO $ logInfo trce $ "----- k: " <> show k
117+
liftIO $ logInfo trce $ "----- isMigration: " <> show isMigration
118+
liftIO $ logInfo trce $ "----- index: " <> show index
119+
liftIO $ logInfo trce $ "----- delegationsLen: " <> show delegationsLen
120+
liftIO $ logInfo trce $ "----- size: " <> show size
121+
liftIO $ logInfo trce $ "----- epochSliceSize: " <> show epochSliceSize
122+
liftIO $ logInfo trce $ "----- minSliceSize: " <> show minSliceSize
123+
liftIO $ logInfo trce $ "----- defaultEpochSliceSize: " <> show defaultEpochSliceSize
124+
liftIO $ logInfo trce "--------------------"
125+
104126
epoch :: EpochNo
105127
epoch = EpochNo $ 1 + unEpochNo (Shelley.nesEL (Consensus.shelleyLedgerState lstate))
106128

@@ -137,21 +159,21 @@ genericStakeSlice pInfo epochBlockNo lstate isMigration
137159
epochSliceSize :: Word64
138160
epochSliceSize =
139161
max minSliceSize defaultEpochSliceSize
140-
where
141-
-- On mainnet this is 21600
142-
expectedBlocks :: Word64
143-
expectedBlocks = 10 * k
144162

145-
-- This size of slices is enough to cover the whole list, even if only
146-
-- the 20% of the expected blocks appear in an epoch.
147-
defaultEpochSliceSize :: Word64
148-
defaultEpochSliceSize = 1 + div (delegationsLen * 5) expectedBlocks
163+
-- On mainnet this is 21600
164+
expectedBlocks :: Word64
165+
expectedBlocks = 10 * k
166+
167+
-- This size of slices is enough to cover the whole list, even if only
168+
-- the 20% of the expected blocks appear in an epoch.
169+
defaultEpochSliceSize :: Word64
170+
defaultEpochSliceSize = 1 + div (delegationsLen * 5) expectedBlocks
149171

150172
-- The starting index of the data in the delegation vector.
151173
index :: Word64
152174
index
153175
| isMigration = 0
154-
| epochBlockNo < k = delegationsLen + 1 -- so it creates the empty Slice.
176+
| epochBlockNo < k = epochBlockNo * epochSliceSize
155177
| otherwise = (epochBlockNo - k) * epochSliceSize
156178

157179
size :: Word64

‎cardano-db-sync/src/Cardano/DbSync/Era/Universal/Block.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -149,7 +149,7 @@ insertBlockUniversal syncEnv shouldLog withinTwoMins withinHalfHour blk details
149149
whenStrictJust (apNewEpoch applyResult) $ \newEpoch -> do
150150
insertOnNewEpoch syncEnv blkId (Generic.blkSlotNo blk) epochNo newEpoch
151151

152-
insertStakeSlice syncEnv $ apStakeSlice applyResult
152+
insertStakeSlice syncEnv (unEpochNo epochNo) $ apStakeSlice applyResult
153153

154154
when (ioGov iopts && (withinHalfHour || unBlockNo (Generic.blkBlockNo blk) `mod` 10000 == 0))
155155
. lift

‎cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs

+28-11
Original file line numberDiff line numberDiff line change
@@ -196,17 +196,31 @@ hasEpochStartEvent = any isNewEpoch
196196
insertStakeSlice ::
197197
(MonadBaseControl IO m, MonadIO m) =>
198198
SyncEnv ->
199+
Word64 ->
199200
Generic.StakeSliceRes ->
200201
ExceptT SyncNodeError (ReaderT SqlBackend m) ()
201-
insertStakeSlice _ Generic.NoSlices = pure ()
202-
insertStakeSlice syncEnv (Generic.Slice slice finalSlice) = do
203-
insertEpochStake syncEnv network (Generic.sliceEpochNo slice) (Map.toList $ Generic.sliceDistr slice)
204-
when finalSlice $ do
205-
lift $ DB.updateSetComplete $ unEpochNo $ Generic.sliceEpochNo slice
206-
size <- lift $ DB.queryEpochStakeCount (unEpochNo $ Generic.sliceEpochNo slice)
207-
liftIO
208-
. logInfo tracer
209-
$ mconcat ["Inserted ", show size, " EpochStake for ", show (Generic.sliceEpochNo slice)]
202+
insertStakeSlice syncEnv _epochNo stakeSliceRes = do
203+
case stakeSliceRes of
204+
Generic.NoSlices -> do
205+
-- when (epochNo > 12 && epochNo < 23) $ do
206+
-- liftIO . logInfo tracer $ "---------------------------------"
207+
-- liftIO . logInfo tracer $ "----------- NoSlices epoch: " <> show epochNo <> " -------------"
208+
-- liftIO . logInfo tracer $ "---------------------------------"
209+
pure ()
210+
(Generic.Slice slice finalSlice) -> do
211+
let poo = Map.toList $ Generic.sliceDistr slice
212+
-- epochNum = unEpochNo $ Generic.sliceEpochNo slice
213+
-- when (epochNum > 12 && epochNum < 23) $ do
214+
-- liftIO . logInfo tracer $ "---------------------------------"
215+
-- liftIO . logInfo tracer $ mconcat ["Length of Generic.sliceDistr: ", show $ length poo]
216+
-- liftIO . logInfo tracer $ "---------------------------------"
217+
insertEpochStake syncEnv network (Generic.sliceEpochNo slice) poo
218+
when finalSlice $ do
219+
lift $ DB.updateSetComplete $ unEpochNo $ Generic.sliceEpochNo slice
220+
size <- lift $ DB.queryEpochStakeCount (unEpochNo $ Generic.sliceEpochNo slice)
221+
liftIO
222+
. logInfo tracer
223+
$ mconcat ["Inserted ", show size, " EpochStake for ", show (Generic.sliceEpochNo slice)]
210224
where
211225
tracer :: Trace IO Text
212226
tracer = getTrace syncEnv
@@ -368,8 +382,11 @@ splittRecordsEvery val = go
368382
where
369383
go [] = []
370384
go ys =
371-
let (as, bs) = splitAt val ys
372-
in as : go bs
385+
if length ys > val
386+
then
387+
let (as, bs) = splitAt val ys
388+
in as : go bs
389+
else [ys]
373390

374391
insertPoolDepositRefunds ::
375392
(MonadBaseControl IO m, MonadIO m) =>

‎cardano-db-sync/src/Cardano/DbSync/Fix/EpochStake.hs

+3-4
Original file line numberDiff line numberDiff line change
@@ -25,13 +25,12 @@ migrateStakeDistr env mcls =
2525
ems <- lift DB.queryAllExtraMigrations
2626
runWhen (not $ DB.isStakeDistrComplete ems) $ do
2727
liftIO $ logInfo trce "Starting Stake Distribution migration on table epoch_stake"
28-
let stakeSlice = getStakeSlice lenv cls True
28+
stakeSlice <- liftIO $ getStakeSlice trce lenv cls True
2929
case stakeSlice of
30-
NoSlices ->
31-
liftIO $ logInsert 0
30+
NoSlices -> liftIO $ logInsert 0
3231
Slice (StakeSlice _epochNo distr) isFinal -> do
3332
liftIO $ logInsert (Map.size distr)
34-
insertStakeSlice env stakeSlice
33+
insertStakeSlice env 0 stakeSlice
3534
(mminEpoch, mmaxEpoch) <- lift DB.queryMinMaxEpochStake
3635
liftIO $ logMinMax mminEpoch mmaxEpoch
3736
case (mminEpoch, mmaxEpoch) of

‎cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs

+33-27
Original file line numberDiff line numberDiff line change
@@ -214,19 +214,19 @@ readStateUnsafe env = do
214214
Strict.Nothing -> throwSTM $ userError "LedgerState.readStateUnsafe: Ledger state is not found"
215215
Strict.Just st -> pure st
216216

217-
applyBlockAndSnapshot :: HasLedgerEnv -> CardanoBlock -> Bool -> IO (ApplyResult, Bool)
218-
applyBlockAndSnapshot ledgerEnv blk isCons = do
219-
(oldState, appResult) <- applyBlock ledgerEnv blk
217+
applyBlockAndSnapshot :: Trace IO Text -> HasLedgerEnv -> CardanoBlock -> Bool -> IO (ApplyResult, Bool)
218+
applyBlockAndSnapshot trce ledgerEnv blk isCons = do
219+
(oldState, appResult) <- applyBlock trce ledgerEnv blk
220220
tookSnapshot <- storeSnapshotAndCleanupMaybe ledgerEnv oldState appResult (blockNo blk) isCons (isSyncedWithinSeconds (apSlotDetails appResult) 600)
221221
pure (appResult, tookSnapshot)
222222

223223
-- The function 'tickThenReapply' does zero validation, so add minimal validation ('blockPrevHash'
224224
-- matches the tip hash of the 'LedgerState'). This was originally for debugging but the check is
225225
-- cheap enough to keep.
226-
applyBlock :: HasLedgerEnv -> CardanoBlock -> IO (CardanoLedgerState, ApplyResult)
227-
applyBlock env blk = do
226+
applyBlock :: Trace IO Text -> HasLedgerEnv -> CardanoBlock -> IO (CardanoLedgerState, ApplyResult)
227+
applyBlock trce env blk = do
228228
time <- getCurrentTime
229-
atomically $ do
229+
(oldState, newState, intermediateResults) <- atomically $ do
230230
!ledgerDB <- readStateUnsafe env
231231
let oldState = ledgerDbCurrent ledgerDB
232232
!result <- fromEitherSTM $ tickThenReapplyCheckHash (ExtLedgerCfg (getTopLevelconfigHasLedger env)) blk (clsState oldState)
@@ -239,24 +239,29 @@ applyBlock env blk = do
239239
let !newState = CardanoLedgerState newLedgerState newEpochBlockNo
240240
let !ledgerDB' = pushLedgerDB ledgerDB newState
241241
writeTVar (leStateVar env) (Strict.Just ledgerDB')
242-
let !appResult =
243-
if leUseLedger env
244-
then
245-
ApplyResult
246-
{ apPrices = getPrices newState
247-
, apGovExpiresAfter = getGovExpiration newState
248-
, apPoolsRegistered = getRegisteredPools oldState
249-
, apNewEpoch = maybeToStrict newEpoch
250-
, apOldLedger = Strict.Just oldState
251-
, apDeposits = maybeToStrict $ Generic.getDeposits newLedgerState
252-
, apSlotDetails = details
253-
, apStakeSlice = getStakeSlice env newState False
254-
, apEvents = ledgerEvents
255-
, apGovActionState = getGovState newLedgerState
256-
, apDepositsMap = DepositsMap deposits
257-
}
258-
else defaultApplyResult details
259-
pure (oldState, appResult)
242+
pure (oldState, newState, (ledgerEvents, deposits, details, newEpoch))
243+
stakeSlices <- liftIO $ getStakeSlice trce env newState False
244+
appResult <- atomically $ do
245+
let (ledgerEvents, deposits, details, newEpoch) = intermediateResults
246+
pure $
247+
if leUseLedger env
248+
then
249+
ApplyResult
250+
{ apPrices = getPrices newState
251+
, apGovExpiresAfter = getGovExpiration newState
252+
, apPoolsRegistered = getRegisteredPools oldState
253+
, apNewEpoch = maybeToStrict newEpoch
254+
, apOldLedger = Strict.Just oldState
255+
, apDeposits = maybeToStrict $ Generic.getDeposits (clsState newState)
256+
, apSlotDetails = details
257+
, apStakeSlice = stakeSlices
258+
, apEvents = ledgerEvents
259+
, apGovActionState = getGovState (clsState newState)
260+
, apDepositsMap = DepositsMap deposits
261+
}
262+
else defaultApplyResult details
263+
264+
pure (oldState, appResult)
260265
where
261266
mkOnNewEpoch :: ExtLedgerState CardanoBlock -> ExtLedgerState CardanoBlock -> Maybe AdaPots -> Either SyncNodeError (Maybe Generic.NewEpoch)
262267
mkOnNewEpoch oldState newState mPots = do
@@ -305,16 +310,17 @@ getGovState ls = case ledgerState ls of
305310
Just $ Consensus.shelleyLedgerState cls ^. Shelley.newEpochStateGovStateL
306311
_ -> Nothing
307312

308-
getStakeSlice :: HasLedgerEnv -> CardanoLedgerState -> Bool -> Generic.StakeSliceRes
309-
getStakeSlice env cls isMigration =
313+
getStakeSlice :: Trace IO Text -> HasLedgerEnv -> CardanoLedgerState -> Bool -> IO Generic.StakeSliceRes
314+
getStakeSlice trce env cls isMigration =
310315
case clsEpochBlockNo cls of
311316
EpochBlockNo n ->
312317
Generic.getStakeSlice
318+
trce
313319
(leProtocolInfo env)
314320
n
315321
(clsState cls)
316322
isMigration
317-
_ -> Generic.NoSlices
323+
_ -> pure Generic.NoSlices
318324

319325
getSliceMeta :: Generic.StakeSliceRes -> Maybe (Bool, EpochNo)
320326
getSliceMeta (Generic.Slice (Generic.StakeSlice epochNo _) isFinal) = Just (isFinal, epochNo)

0 commit comments

Comments
 (0)