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

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]