From 4775489017e2cb37212207f95dc0c28bac7237f9 Mon Sep 17 00:00:00 2001 From: Cmdv Date: Tue, 30 Jul 2024 19:08:51 +0100 Subject: [PATCH] 1678: epoch_stake missing entries --- cardano-db-sync/src/Cardano/DbSync/Default.hs | 2 +- .../DbSync/Era/Shelley/Generic/StakeDist.hs | 72 ++++++++++++------- .../src/Cardano/DbSync/Era/Universal/Block.hs | 2 +- .../src/Cardano/DbSync/Era/Universal/Epoch.hs | 39 +++++++--- .../src/Cardano/DbSync/Fix/EpochStake.hs | 7 +- .../src/Cardano/DbSync/Ledger/State.hs | 60 +++++++++------- 6 files changed, 113 insertions(+), 69 deletions(-) diff --git a/cardano-db-sync/src/Cardano/DbSync/Default.hs b/cardano-db-sync/src/Cardano/DbSync/Default.hs index 0285533c1..e8a0471a6 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Default.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Default.hs @@ -99,7 +99,7 @@ applyAndInsertBlockMaybe syncEnv tracer cblk = do mkApplyResult :: Bool -> IO (ApplyResult, Bool) mkApplyResult isCons = do case envLedgerEnv syncEnv of - HasLedger hle -> applyBlockAndSnapshot hle cblk isCons + HasLedger hle -> applyBlockAndSnapshot tracer hle cblk isCons NoLedger nle -> do slotDetails <- getSlotDetailsNode nle (cardanoBlockSlotNo cblk) pure (defaultApplyResult slotDetails, False) diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs index 3246ddc9d..824835d73 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs @@ -17,6 +17,8 @@ module Cardano.DbSync.Era.Shelley.Generic.StakeDist ( getPoolDistr, ) where +import Cardano.BM.Data.Trace (Trace) +import Cardano.BM.Trace (logInfo) import Cardano.DbSync.Types import Cardano.Ledger.Coin (Coin (..)) import qualified Cardano.Ledger.Compactible as Ledger @@ -72,35 +74,55 @@ getSecurityParameter = maxRollbacks . configSecurityParam . pInfoConfig -- will be adjusted. getStakeSlice :: ConsensusProtocol (BlockProtocol blk) => + Trace IO Text -> ProtocolInfo blk -> Word64 -> ExtLedgerState CardanoBlock -> Bool -> - StakeSliceRes -getStakeSlice pInfo !epochBlockNo els isMigration = + IO StakeSliceRes +getStakeSlice trce pInfo !epochBlockNo els isMigration = case ledgerState els of - LedgerStateByron _ -> NoSlices - LedgerStateShelley sls -> genericStakeSlice pInfo epochBlockNo sls isMigration - LedgerStateAllegra als -> genericStakeSlice pInfo epochBlockNo als isMigration - LedgerStateMary mls -> genericStakeSlice pInfo epochBlockNo mls isMigration - LedgerStateAlonzo als -> genericStakeSlice pInfo epochBlockNo als isMigration - LedgerStateBabbage bls -> genericStakeSlice pInfo epochBlockNo bls isMigration - LedgerStateConway cls -> genericStakeSlice pInfo epochBlockNo cls isMigration - + LedgerStateByron _ -> pure NoSlices + LedgerStateShelley sls -> genericStakeSlice trce pInfo epochBlockNo sls isMigration + LedgerStateAllegra als -> genericStakeSlice trce pInfo epochBlockNo als isMigration + LedgerStateMary mls -> genericStakeSlice trce pInfo epochBlockNo mls isMigration + LedgerStateAlonzo als -> genericStakeSlice trce pInfo epochBlockNo als isMigration + LedgerStateBabbage bls -> genericStakeSlice trce pInfo epochBlockNo bls isMigration + LedgerStateConway cls -> genericStakeSlice trce pInfo epochBlockNo cls isMigration + +-- TODO: Cmdv genericStakeSlice :: forall era c blk p. (c ~ StandardCrypto, EraCrypto era ~ c, ConsensusProtocol (BlockProtocol blk)) => + Trace IO Text -> ProtocolInfo blk -> Word64 -> LedgerState (ShelleyBlock p era) -> Bool -> - StakeSliceRes -genericStakeSlice pInfo epochBlockNo lstate isMigration - | index > delegationsLen = NoSlices - | index == delegationsLen = Slice (emptySlice epoch) True - | index + size > delegationsLen = Slice (mkSlice (delegationsLen - index)) True - | otherwise = Slice (mkSlice size) False + IO StakeSliceRes +genericStakeSlice trce pInfo epochBlockNo lstate isMigration = + case compare index delegationsLen of + GT -> pure NoSlices + EQ -> pure $ Slice (emptySlice epoch) True + LT -> case compare (index + size) delegationsLen of + GT -> pure $ Slice (mkSlice (delegationsLen - index)) True + _other -> pure $ Slice (mkSlice size) False where + _logStuff :: Text -> IO () + _logStuff text = do + when (unEpochNo epoch > 11 && unEpochNo epoch < 24) $ do + liftIO $ logInfo trce ("----- " <> show epochBlockNo <> " -----") + liftIO $ logInfo trce $ "----- " <> text + liftIO $ logInfo trce $ "----- k: " <> show k + liftIO $ logInfo trce $ "----- isMigration: " <> show isMigration + liftIO $ logInfo trce $ "----- index: " <> show index + liftIO $ logInfo trce $ "----- delegationsLen: " <> show delegationsLen + liftIO $ logInfo trce $ "----- size: " <> show size + liftIO $ logInfo trce $ "----- epochSliceSize: " <> show epochSliceSize + liftIO $ logInfo trce $ "----- minSliceSize: " <> show minSliceSize + liftIO $ logInfo trce $ "----- defaultEpochSliceSize: " <> show defaultEpochSliceSize + liftIO $ logInfo trce "--------------------" + epoch :: EpochNo epoch = EpochNo $ 1 + unEpochNo (Shelley.nesEL (Consensus.shelleyLedgerState lstate)) @@ -137,21 +159,21 @@ genericStakeSlice pInfo epochBlockNo lstate isMigration epochSliceSize :: Word64 epochSliceSize = max minSliceSize defaultEpochSliceSize - where - -- On mainnet this is 21600 - expectedBlocks :: Word64 - expectedBlocks = 10 * k - -- This size of slices is enough to cover the whole list, even if only - -- the 20% of the expected blocks appear in an epoch. - defaultEpochSliceSize :: Word64 - defaultEpochSliceSize = 1 + div (delegationsLen * 5) expectedBlocks + -- On mainnet this is 21600 + expectedBlocks :: Word64 + expectedBlocks = 10 * k + + -- This size of slices is enough to cover the whole list, even if only + -- the 20% of the expected blocks appear in an epoch. + defaultEpochSliceSize :: Word64 + defaultEpochSliceSize = 1 + div (delegationsLen * 5) expectedBlocks -- The starting index of the data in the delegation vector. index :: Word64 index | isMigration = 0 - | epochBlockNo < k = delegationsLen + 1 -- so it creates the empty Slice. + | epochBlockNo < k = epochBlockNo * epochSliceSize | otherwise = (epochBlockNo - k) * epochSliceSize size :: Word64 diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Block.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Block.hs index 2eed5603c..dd2a0c820 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Block.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Block.hs @@ -149,7 +149,7 @@ insertBlockUniversal syncEnv shouldLog withinTwoMins withinHalfHour blk details whenStrictJust (apNewEpoch applyResult) $ \newEpoch -> do insertOnNewEpoch syncEnv blkId (Generic.blkSlotNo blk) epochNo newEpoch - insertStakeSlice syncEnv $ apStakeSlice applyResult + insertStakeSlice syncEnv (unEpochNo epochNo) $ apStakeSlice applyResult when (ioGov iopts && (withinHalfHour || unBlockNo (Generic.blkBlockNo blk) `mod` 10000 == 0)) . lift diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs index cc1f86205..7a87344c7 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs @@ -196,17 +196,31 @@ hasEpochStartEvent = any isNewEpoch insertStakeSlice :: (MonadBaseControl IO m, MonadIO m) => SyncEnv -> + Word64 -> Generic.StakeSliceRes -> ExceptT SyncNodeError (ReaderT SqlBackend m) () -insertStakeSlice _ Generic.NoSlices = pure () -insertStakeSlice syncEnv (Generic.Slice slice finalSlice) = do - insertEpochStake syncEnv network (Generic.sliceEpochNo slice) (Map.toList $ Generic.sliceDistr slice) - when finalSlice $ do - lift $ DB.updateSetComplete $ unEpochNo $ Generic.sliceEpochNo slice - size <- lift $ DB.queryEpochStakeCount (unEpochNo $ Generic.sliceEpochNo slice) - liftIO - . logInfo tracer - $ mconcat ["Inserted ", show size, " EpochStake for ", show (Generic.sliceEpochNo slice)] +insertStakeSlice syncEnv _epochNo stakeSliceRes = do + case stakeSliceRes of + Generic.NoSlices -> do + -- when (epochNo > 12 && epochNo < 23) $ do + -- liftIO . logInfo tracer $ "---------------------------------" + -- liftIO . logInfo tracer $ "----------- NoSlices epoch: " <> show epochNo <> " -------------" + -- liftIO . logInfo tracer $ "---------------------------------" + pure () + (Generic.Slice slice finalSlice) -> do + let poo = Map.toList $ Generic.sliceDistr slice + -- epochNum = unEpochNo $ Generic.sliceEpochNo slice + -- when (epochNum > 12 && epochNum < 23) $ do + -- liftIO . logInfo tracer $ "---------------------------------" + -- liftIO . logInfo tracer $ mconcat ["Length of Generic.sliceDistr: ", show $ length poo] + -- liftIO . logInfo tracer $ "---------------------------------" + insertEpochStake syncEnv network (Generic.sliceEpochNo slice) poo + when finalSlice $ do + lift $ DB.updateSetComplete $ unEpochNo $ Generic.sliceEpochNo slice + size <- lift $ DB.queryEpochStakeCount (unEpochNo $ Generic.sliceEpochNo slice) + liftIO + . logInfo tracer + $ mconcat ["Inserted ", show size, " EpochStake for ", show (Generic.sliceEpochNo slice)] where tracer :: Trace IO Text tracer = getTrace syncEnv @@ -368,8 +382,11 @@ splittRecordsEvery val = go where go [] = [] go ys = - let (as, bs) = splitAt val ys - in as : go bs + if length ys > val + then + let (as, bs) = splitAt val ys + in as : go bs + else [ys] insertPoolDepositRefunds :: (MonadBaseControl IO m, MonadIO m) => diff --git a/cardano-db-sync/src/Cardano/DbSync/Fix/EpochStake.hs b/cardano-db-sync/src/Cardano/DbSync/Fix/EpochStake.hs index c1ff28caf..0fcd7a787 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Fix/EpochStake.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Fix/EpochStake.hs @@ -25,13 +25,12 @@ migrateStakeDistr env mcls = ems <- lift DB.queryAllExtraMigrations runWhen (not $ DB.isStakeDistrComplete ems) $ do liftIO $ logInfo trce "Starting Stake Distribution migration on table epoch_stake" - let stakeSlice = getStakeSlice lenv cls True + stakeSlice <- liftIO $ getStakeSlice trce lenv cls True case stakeSlice of - NoSlices -> - liftIO $ logInsert 0 + NoSlices -> liftIO $ logInsert 0 Slice (StakeSlice _epochNo distr) isFinal -> do liftIO $ logInsert (Map.size distr) - insertStakeSlice env stakeSlice + insertStakeSlice env 0 stakeSlice (mminEpoch, mmaxEpoch) <- lift DB.queryMinMaxEpochStake liftIO $ logMinMax mminEpoch mmaxEpoch case (mminEpoch, mmaxEpoch) of diff --git a/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs b/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs index 8df2f9a65..8fe421fcc 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs @@ -214,19 +214,19 @@ readStateUnsafe env = do Strict.Nothing -> throwSTM $ userError "LedgerState.readStateUnsafe: Ledger state is not found" Strict.Just st -> pure st -applyBlockAndSnapshot :: HasLedgerEnv -> CardanoBlock -> Bool -> IO (ApplyResult, Bool) -applyBlockAndSnapshot ledgerEnv blk isCons = do - (oldState, appResult) <- applyBlock ledgerEnv blk +applyBlockAndSnapshot :: Trace IO Text -> HasLedgerEnv -> CardanoBlock -> Bool -> IO (ApplyResult, Bool) +applyBlockAndSnapshot trce ledgerEnv blk isCons = do + (oldState, appResult) <- applyBlock trce ledgerEnv blk tookSnapshot <- storeSnapshotAndCleanupMaybe ledgerEnv oldState appResult (blockNo blk) isCons (isSyncedWithinSeconds (apSlotDetails appResult) 600) pure (appResult, tookSnapshot) -- The function 'tickThenReapply' does zero validation, so add minimal validation ('blockPrevHash' -- matches the tip hash of the 'LedgerState'). This was originally for debugging but the check is -- cheap enough to keep. -applyBlock :: HasLedgerEnv -> CardanoBlock -> IO (CardanoLedgerState, ApplyResult) -applyBlock env blk = do +applyBlock :: Trace IO Text -> HasLedgerEnv -> CardanoBlock -> IO (CardanoLedgerState, ApplyResult) +applyBlock trce env blk = do time <- getCurrentTime - atomically $ do + (oldState, newState, intermediateResults) <- atomically $ do !ledgerDB <- readStateUnsafe env let oldState = ledgerDbCurrent ledgerDB !result <- fromEitherSTM $ tickThenReapplyCheckHash (ExtLedgerCfg (getTopLevelconfigHasLedger env)) blk (clsState oldState) @@ -239,24 +239,29 @@ applyBlock env blk = do let !newState = CardanoLedgerState newLedgerState newEpochBlockNo let !ledgerDB' = pushLedgerDB ledgerDB newState writeTVar (leStateVar env) (Strict.Just ledgerDB') - let !appResult = - if leUseLedger env - then - ApplyResult - { apPrices = getPrices newState - , apGovExpiresAfter = getGovExpiration newState - , apPoolsRegistered = getRegisteredPools oldState - , apNewEpoch = maybeToStrict newEpoch - , apOldLedger = Strict.Just oldState - , apDeposits = maybeToStrict $ Generic.getDeposits newLedgerState - , apSlotDetails = details - , apStakeSlice = getStakeSlice env newState False - , apEvents = ledgerEvents - , apGovActionState = getGovState newLedgerState - , apDepositsMap = DepositsMap deposits - } - else defaultApplyResult details - pure (oldState, appResult) + pure (oldState, newState, (ledgerEvents, deposits, details, newEpoch)) + stakeSlices <- liftIO $ getStakeSlice trce env newState False + appResult <- atomically $ do + let (ledgerEvents, deposits, details, newEpoch) = intermediateResults + pure $ + if leUseLedger env + then + ApplyResult + { apPrices = getPrices newState + , apGovExpiresAfter = getGovExpiration newState + , apPoolsRegistered = getRegisteredPools oldState + , apNewEpoch = maybeToStrict newEpoch + , apOldLedger = Strict.Just oldState + , apDeposits = maybeToStrict $ Generic.getDeposits (clsState newState) + , apSlotDetails = details + , apStakeSlice = stakeSlices + , apEvents = ledgerEvents + , apGovActionState = getGovState (clsState newState) + , apDepositsMap = DepositsMap deposits + } + else defaultApplyResult details + + pure (oldState, appResult) where mkOnNewEpoch :: ExtLedgerState CardanoBlock -> ExtLedgerState CardanoBlock -> Maybe AdaPots -> Either SyncNodeError (Maybe Generic.NewEpoch) mkOnNewEpoch oldState newState mPots = do @@ -305,16 +310,17 @@ getGovState ls = case ledgerState ls of Just $ Consensus.shelleyLedgerState cls ^. Shelley.newEpochStateGovStateL _ -> Nothing -getStakeSlice :: HasLedgerEnv -> CardanoLedgerState -> Bool -> Generic.StakeSliceRes -getStakeSlice env cls isMigration = +getStakeSlice :: Trace IO Text -> HasLedgerEnv -> CardanoLedgerState -> Bool -> IO Generic.StakeSliceRes +getStakeSlice trce env cls isMigration = case clsEpochBlockNo cls of EpochBlockNo n -> Generic.getStakeSlice + trce (leProtocolInfo env) n (clsState cls) isMigration - _ -> Generic.NoSlices + _ -> pure Generic.NoSlices getSliceMeta :: Generic.StakeSliceRes -> Maybe (Bool, EpochNo) getSliceMeta (Generic.Slice (Generic.StakeSlice epochNo _) isFinal) = Just (isFinal, epochNo)