1678: epoch_stake missing entries

Author: Cmdv

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

@@ -94,7 +94,7 @@ applyAndInsertBlockMaybe syncEnv tracer cblk = do
         Right _
           | Just epochNo <- getNewEpoch applyRes ->
               liftIO $ logInfo tracer $ "Reached " <> textShow epochNo
-        _ -> pure ()
+        _otherwise -> pure ()
   where
     mkApplyResult :: Bool -> IO (ApplyResult, Bool)
     mkApplyResult isCons = do

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

@@ -3,7 +3,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeOperators #-}
@@ -46,12 +45,13 @@ import Prelude (id)
 data StakeSliceRes
   = Slice !StakeSlice !Bool -- True if this is the final slice for this epoch. Can be used for logging.
   | NoSlices
+  deriving (Show)
 
 data StakeSlice = StakeSlice
   { sliceEpochNo :: !EpochNo
   , sliceDistr :: !(Map StakeCred (Coin, PoolKeyHash))
   }
-  deriving (Eq)
+  deriving (Show, Eq)
 
 emptySlice :: EpochNo -> StakeSlice
 emptySlice epoch = StakeSlice epoch Map.empty
@@ -95,11 +95,13 @@ genericStakeSlice ::
   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
+genericStakeSlice pInfo epochBlockNo lstate isMigration = do
+  case compare index delegationsLen of
+      GT -> NoSlices
+      EQ -> Slice (emptySlice epoch) True
+      LT -> case compare (index + size) delegationsLen of
+              GT -> Slice (mkSlice (delegationsLen - index)) True
+              _otherwise  -> Slice (mkSlice size) False
   where
     epoch :: EpochNo
     epoch = EpochNo $ 1 + unEpochNo (Shelley.nesEL (Consensus.shelleyLedgerState lstate))
@@ -149,10 +151,10 @@ genericStakeSlice pInfo epochBlockNo lstate isMigration
 
     -- 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.
-      | otherwise = (epochBlockNo - k) * epochSliceSize
+    index =
+      if isMigration
+        then 0
+        else (epochBlockNo - k) * epochSliceSize
 
     size :: Word64
     size
@@ -176,6 +178,121 @@ genericStakeSlice pInfo epochBlockNo lstate isMigration
             VMap.mapMaybe id $
               VMap.mapWithKey (\a p -> (,p) <$> lookupStake a) delegationsSliced
 
+-- 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 ->
+--   IO StakeSliceRes
+-- genericStakeSlice trce pInfo epochBlockNo lstate isMigration = do
+--   let shouldLog = unEpochNo epoch `elem` [12, 14]
+--   when shouldLog logStakeSliceInfo
+--   -- when shouldLog $ logStakeSliceInfo trce epochBlockNo delegationsLen index size k epochSliceSize isMigration epoch
+--   let result = case compare index delegationsLen of
+--         GT -> NoSlices
+--         EQ -> Slice (emptySlice epoch) True
+--         LT -> case compare (index + size) delegationsLen of
+--           GT -> Slice (mkSlice (delegationsLen - index)) True
+--           _other -> Slice (mkSlice size) False
+
+--   -- when shouldLog $ logResult trce result
+--   pure result
+--   where
+--     index :: Word64
+--     index
+--       | isMigration = 0
+--       | epochBlockNo < k = 0  -- Changed from delegationsLen + 1
+--       | otherwise = min ((epochBlockNo - k) * epochSliceSize) delegationsLen
+
+--     size :: Word64
+--     size
+--       | isMigration, epochBlockNo + 1 < k = 0
+--       | isMigration = (epochBlockNo + 1 - k) * epochSliceSize
+--       | otherwise = max 1 (min epochSliceSize delegationsLen)  -- Ensure we always process at least one delegation
+
+--     epochSliceSize :: Word64
+--     epochSliceSize =
+--       max minSliceSize (max 1 defaultEpochSliceSize)  -- Ensure epochSliceSize is never 0
+
+--     defaultEpochSliceSize :: Word64
+--     defaultEpochSliceSize = max 1 (1 + div (delegationsLen * 5) expectedBlocks)  -- Ensure it's never 0
+
+--     delegationsLen :: Word64
+--     delegationsLen = fromIntegral $ VG.length delegations
+
+--     delegations :: VMap.KVVector VB VB (Credential 'Staking c, KeyHash 'StakePool c)
+--     delegations = VMap.unVMap $ Ledger.ssDelegations stakeSnapshot
+
+--     epoch :: EpochNo
+--     epoch = EpochNo $ 1 + unEpochNo (Shelley.nesEL (Consensus.shelleyLedgerState lstate))
+
+--     minSliceSize :: Word64
+--     minSliceSize = 2000
+
+--     -- On mainnet this is 2160
+--     k :: Word64
+--     k = getSecurityParameter pInfo
+
+--     -- We use 'ssStakeMark' here. That means that when these values
+--     -- are added to the database, the epoch number where they become active is the current
+--     -- epoch plus one.
+--     stakeSnapshot :: Ledger.SnapShot c
+--     stakeSnapshot =
+--       Ledger.ssStakeMark . Shelley.esSnapshots . Shelley.nesEs $
+--         Consensus.shelleyLedgerState lstate
+
+--     stakes :: VMap VB VP (Credential 'Staking c) (Ledger.CompactForm Coin)
+--     stakes = Ledger.unStake $ Ledger.ssStake stakeSnapshot
+
+--     lookupStake :: Credential 'Staking c -> Maybe Coin
+--     lookupStake cred = Ledger.fromCompact <$> VMap.lookup cred stakes
+
+--     -- On mainnet this is 21600
+--     expectedBlocks :: Word64
+--     expectedBlocks = 10 * k
+
+--     mkSlice :: Word64 -> StakeSlice
+--     mkSlice actualSize =
+--       StakeSlice
+--         { sliceEpochNo = epoch
+--         , sliceDistr = distribution
+--         }
+--       where
+--         delegationsSliced :: VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
+--         delegationsSliced = VMap $ VG.slice (fromIntegral index) (fromIntegral actualSize) delegations
+
+--         distribution :: Map StakeCred (Coin, PoolKeyHash)
+--         distribution =
+--           VMap.toMap $
+--             VMap.mapMaybe id $
+--               VMap.mapWithKey (\a p -> (,p) <$> lookupStake a) delegationsSliced
+
+--     logStakeSliceInfo = do
+--       logInfo trce $ unlines
+--         [ "Stake Slice Debug Info:"
+--         , "  epoch: " <> (pack . show $ unEpochNo epoch)
+--         , "  epochBlockNo: " <> show epochBlockNo
+--         , "  isMigration: " <> show isMigration
+--         , "  index: " <> show index
+--         , "  delegationsLen: " <> show delegationsLen
+--         , "  size: " <> show size
+--         , "  epochSliceSize: " <> show epochSliceSize
+--         , "  remaining: " <> show (delegationsLen - index)
+--         , "  k: " <> show k
+--         , "  expectedBlocks: " <> show expectedBlocks
+--         , "  defaultEpochSliceSize: " <> show defaultEpochSliceSize
+--         ]
+
+-- _logResult :: Trace IO Text -> StakeSliceRes -> IO ()
+-- _logResult trce result =
+--     logInfo trce $ unlines
+--         [ "Stake Slice Result:"
+--         , "  " <> show result
+--         ]
+
 getPoolDistr ::
   ExtLedgerState CardanoBlock ->
   Maybe (Map PoolKeyHash (Coin, Word64), Map PoolKeyHash Natural)

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

@@ -198,15 +198,21 @@ insertStakeSlice ::
   SyncEnv ->
   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 stakeSliceRes = do
+  case stakeSliceRes of
+    Generic.NoSlices -> pure ()
+    Generic.Slice slice isfinalSlice -> do
+      insertEpochStake
+        syncEnv
+        network
+        (Generic.sliceEpochNo slice)
+        (Map.toList $ Generic.sliceDistr slice)
+      when isfinalSlice $ 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 +374,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) =>

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

@@ -40,9 +40,9 @@ migrateStakeDistr env mcls =
                   lift $
                     DB.insertEpochStakeProgress (mkProgress True <$> [minEpoch .. (maxEpoch - 1)])
                 lift $ DB.insertEpochStakeProgress [mkProgress isFinal maxEpoch]
-              _ -> pure ()
+              _otherwise -> pure ()
         lift $ DB.insertExtraMigration DB.StakeDistrEnded
-    _ -> pure False
+    _otherwise -> pure False
   where
     trce = getTrace env
     mkProgress isCompleted e =

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

@@ -314,7 +314,7 @@ getStakeSlice env cls isMigration =
         n
         (clsState cls)
         isMigration
-    _ -> Generic.NoSlices
+    _otherwise -> Generic.NoSlices
 
 getSliceMeta :: Generic.StakeSliceRes -> Maybe (Bool, EpochNo)
 getSliceMeta (Generic.Slice (Generic.StakeSlice epochNo _) isFinal) = Just (isFinal, epochNo)

cardano-db-sync/src/Cardano/DbSync/Rollback.hs

@@ -55,6 +55,7 @@ rollbackFromBlockNo syncEnv blkNo = do
       DB.deleteDrepDistr epochNo
       DB.deleteRewardRest epochNo
       DB.deletePoolStat epochNo
+      DB.deleteEpochStake epochNo
       DB.setNullEnacted epochNo
       DB.setNullRatified epochNo
       DB.setNullDropped epochNo

cardano-db/src/Cardano/Db/Delete.hs

@@ -19,6 +19,7 @@ module Cardano.Db.Delete (
   deletePoolStat,
   deleteAdaPots,
   deleteTxOut,
+  deleteEpochStake,
   -- for testing
   queryFirstAndDeleteAfter,
 ) where
@@ -255,3 +256,7 @@ deleteAdaPots blkId = do
 
 deleteTxOut :: MonadIO m => ReaderT SqlBackend m Int64
 deleteTxOut = deleteWhereCount ([] :: [Filter TxOut])
+
+deleteEpochStake :: MonadIO m => Word64 -> ReaderT SqlBackend m ()
+deleteEpochStake epochNum =
+  deleteWhere [EpochStakeEpochNo >=. epochNum]