Find epochs that have missing epoch_stake entries

Caused by bug #1678

Author: kderme

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

@@ -157,7 +157,7 @@ insertBlock syncEnv cblk applyRes firstAfterRollback tookSnapshot = do
   let !details = apSlotDetails applyResult
   let !withinTwoMin = isWithinTwoMin details
   let !withinHalfHour = isWithinHalfHour details
-  insertNewEpochLedgerEvents syncEnv (sdEpochNo details) (apEvents applyResult)
+  insertNewEpochLedgerEvents syncEnv applyResult (sdEpochNo details) (apEvents applyResult)
 
   let isNewEpochEvent = hasNewEpochEvent (apEvents applyResult)
   let isStartEventOrRollback = hasEpochStartEvent (apEvents applyResult) || firstAfterRollback

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

@@ -12,6 +12,7 @@ module Cardano.DbSync.Era.Shelley.Generic.StakeDist (
   StakeSlice (..),
   getSecurityParameter,
   getStakeSlice,
+  countEpochStake,
   getPoolDistr,
 ) where
 
@@ -175,6 +176,46 @@ genericStakeSlice pInfo epochBlockNo lstate isMigration
             VMap.mapMaybe id $
               VMap.mapWithKey (\a p -> (,p) <$> lookupStake a) delegationsSliced
 
+countEpochStake ::
+  ExtLedgerState CardanoBlock mk ->
+  Maybe (Word64, EpochNo)
+countEpochStake els =
+  case ledgerState els of
+    LedgerStateByron _ -> Nothing
+    LedgerStateShelley sls -> genericCountEpochStake sls
+    LedgerStateAllegra als -> genericCountEpochStake als
+    LedgerStateMary mls -> genericCountEpochStake mls
+    LedgerStateAlonzo als -> genericCountEpochStake als
+    LedgerStateBabbage bls -> genericCountEpochStake bls
+    LedgerStateConway cls -> genericCountEpochStake cls
+    LedgerStateDijkstra dls -> genericCountEpochStake dls
+
+genericCountEpochStake ::
+  LedgerState (ShelleyBlock p era) mk ->
+  Maybe (Word64, EpochNo)
+genericCountEpochStake lstate =
+    Just (delegationsLen, epoch)
+  where
+    epoch :: EpochNo
+    epoch = EpochNo $ 1 + unEpochNo (Shelley.nesEL (Consensus.shelleyLedgerState lstate))
+
+    stakeSnapshot :: Ledger.SnapShot
+    stakeSnapshot =
+      Ledger.ssStakeMark . Shelley.esSnapshots . Shelley.nesEs $
+        Consensus.shelleyLedgerState lstate
+
+    delegations :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
+    delegations = Ledger.ssDelegations stakeSnapshot
+
+    delegationsLen :: Word64
+    delegationsLen = fromIntegral $ VMap.size $ VMap.filter (\k _ -> hasStake k) delegations
+
+    stakes :: VMap VB VP (Credential 'Staking) (Ledger.CompactForm Coin)
+    stakes = Ledger.unStake $ Ledger.ssStake stakeSnapshot
+
+    hasStake :: Credential 'Staking -> Bool
+    hasStake cred = isJust (VMap.lookup cred stakes)
+
 getPoolDistr ::
   ExtLedgerState CardanoBlock mk ->
   Maybe (Map PoolKeyHash (Coin, Word64), Map PoolKeyHash Natural)

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

@@ -25,7 +25,7 @@ import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
 import Cardano.DbSync.Era.Universal.Adjust (adjustEpochRewards)
 import Cardano.DbSync.Era.Universal.Epoch (insertPoolDepositRefunds, insertProposalRefunds, insertRewardRests, insertRewards)
 import Cardano.DbSync.Era.Universal.Insert.GovAction
-import Cardano.DbSync.Era.Universal.Validate (validateEpochRewards)
+import Cardano.DbSync.Era.Universal.Validate (validateEpochStake, validateEpochRewards)
 import Cardano.DbSync.Ledger.Event
 import Cardano.DbSync.Types
 
@@ -38,16 +38,18 @@ import qualified Data.Set as Set
 import qualified Data.Text as Text
 import Data.Time (UTCTime, diffUTCTime, getCurrentTime)
 import Text.Printf (printf)
+import Cardano.DbSync.Ledger.Types
 
 --------------------------------------------------------------------------------------------
 -- Insert LedgerEvents
 --------------------------------------------------------------------------------------------
 insertNewEpochLedgerEvents ::
   SyncEnv ->
+  ApplyResult ->
   EpochNo ->
   [LedgerEvent] ->
   ExceptT SyncNodeError DB.DbM ()
-insertNewEpochLedgerEvents syncEnv currentEpochNo@(EpochNo curEpoch) =
+insertNewEpochLedgerEvents syncEnv applyRes currentEpochNo@(EpochNo curEpoch) =
   mapM_ handler
   where
     metricSetters = envMetricSetters syncEnv
@@ -72,6 +74,7 @@ insertNewEpochLedgerEvents syncEnv currentEpochNo@(EpochNo curEpoch) =
     handler ev =
       case ev of
         LedgerNewEpoch en ss -> do
+          validateEpochStake tracer applyRes
           databaseCacheSize <- lift DB.queryStatementCacheSize
           liftIO . logInfo tracer $ "Database Statement Cache size is " <> textShow databaseCacheSize
           currentTime <- liftIO getCurrentTime

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

@@ -5,6 +5,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 
 module Cardano.DbSync.Era.Universal.Validate (
+  validateEpochStake,
   validateEpochRewards,
 ) where
 
@@ -24,6 +25,36 @@ import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
 import Cardano.DbSync.Error (SyncNodeError)
 import Cardano.DbSync.Ledger.Event
 import Cardano.DbSync.Types
+import Cardano.DbSync.Ledger.Types
+import qualified Data.Strict.Maybe as Strict
+
+validateEpochStake ::
+  Trace IO Text ->
+  ApplyResult -> ExceptT SyncNodeError DB.DbM ()
+validateEpochStake tracer applyRes = case apOldLedger applyRes of
+  Strict.Just lstate | Just (expectedCount, epoch) <- Generic.countEpochStake (clsState lstate) -> do
+    actualCount <- lift $ DB.queryNormalEpochStakeCount (unEpochNo epoch)
+    if actualCount /= expectedCount then
+      liftIO
+        . logWarning tracer
+        $ mconcat
+          [ "validateEpochStake: epoch stake in epoch "
+          , textShow (unEpochNo epoch)
+          , " expected total of "
+          , textShow expectedCount
+          , " but got "
+          , textShow actualCount
+          ]
+    else
+      liftIO $ logInfo tracer
+        $ mconcat
+          [ "Validate Epoch Stake: total entries in epoch "
+          , textShow (unEpochNo epoch)
+          , " are "
+          , textShow actualCount
+          ]
+  _ -> pure ()
+
 
 validateEpochRewards ::
   Trace IO Text ->

cardano-db/src/Cardano/Db/Statement/StakeDelegation.hs

@@ -216,6 +216,29 @@ queryNormalEpochRewardCount epochNum =
   runSession mkDbCallStack $
     HsqlSes.statement epochNum queryNormalEpochRewardCountStmt
 
+-- | QUERY ---------------------------------------------------------------------
+queryNormalEpochStakeCountStmt :: HsqlStmt.Statement Word64 Word64
+queryNormalEpochStakeCountStmt =
+  HsqlStmt.Statement sql encoder decoder True
+  where
+    sql =
+      TextEnc.encodeUtf8 $
+        Text.concat
+          [ "SELECT COUNT(*)::bigint"
+          , " FROM epoch_stake"
+          , " WHERE epoch_no = $1"
+          ]
+
+    encoder = HsqlE.param (HsqlE.nonNullable $ fromIntegral >$< HsqlE.int8)
+    decoder =
+      HsqlD.singleRow $
+        fromIntegral <$> HsqlD.column (HsqlD.nonNullable HsqlD.int8)
+
+queryNormalEpochStakeCount :: Word64 -> DbM Word64
+queryNormalEpochStakeCount epochNum =
+  runSession mkDbCallStack $
+    HsqlSes.statement epochNum queryNormalEpochStakeCountStmt
+
 --------------------------------------------------------------------------------
 queryRewardCount :: DbM Word64
 queryRewardCount =