Fix missing epoch_stake

Fixes #1678

Author: kderme

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

@@ -13,6 +13,7 @@ module Cardano.DbSync.Era.Shelley.Generic.StakeDist (
   getSecurityParameter,
   getStakeSlice,
   countEpochStake,
+  fullEpochStake,
   getPoolDistr,
 ) where
 
@@ -216,6 +217,70 @@ genericCountEpochStake lstate =
     hasStake :: Credential 'Staking -> Bool
     hasStake cred = isJust (VMap.lookup cred stakes)
 
+fullEpochStake ::
+  ExtLedgerState CardanoBlock mk ->
+  StakeSliceRes
+fullEpochStake els =
+  case ledgerState els of
+    LedgerStateByron _ -> NoSlices
+    LedgerStateShelley sls -> genericFullStakeSlice sls
+    LedgerStateAllegra als -> genericFullStakeSlice als
+    LedgerStateMary mls -> genericFullStakeSlice mls
+    LedgerStateAlonzo als -> genericFullStakeSlice als
+    LedgerStateBabbage bls -> genericFullStakeSlice bls
+    LedgerStateConway cls -> genericFullStakeSlice cls
+    LedgerStateDijkstra dls -> genericFullStakeSlice dls
+
+genericFullStakeSlice ::
+  forall era p mk.
+  LedgerState (ShelleyBlock p era) mk ->
+  StakeSliceRes
+genericFullStakeSlice lstate =
+    Slice stakeSlice True
+  where
+    epoch :: EpochNo
+    epoch = EpochNo $ 1 + unEpochNo (Shelley.nesEL (Consensus.shelleyLedgerState lstate))
+
+    -- 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
+    stakeSnapshot =
+      Ledger.ssStakeMark . Shelley.esSnapshots . Shelley.nesEs $
+        Consensus.shelleyLedgerState lstate
+
+    delegations :: VMap.KVVector VB VB (Credential 'Staking, KeyHash 'StakePool)
+    delegations = VMap.unVMap $ Ledger.ssDelegations stakeSnapshot
+
+    delegationsLen :: Word64
+    delegationsLen = fromIntegral $ VG.length delegations
+
+    stakes :: VMap VB VP (Credential 'Staking) (Ledger.CompactForm Coin)
+    stakes = Ledger.unStake $ Ledger.ssStake stakeSnapshot
+
+    lookupStake :: Credential 'Staking -> Maybe Coin
+    lookupStake cred = Ledger.fromCompact <$> VMap.lookup cred stakes
+
+    -- The starting index of the data in the delegation vector.
+    index :: Word64
+    index = 0
+
+    stakeSlice :: StakeSlice
+    stakeSlice =
+      StakeSlice
+        { sliceEpochNo = epoch
+        , sliceDistr = distribution
+        }
+      where
+        delegationsSliced :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
+        delegationsSliced = VMap $ VG.slice (fromIntegral index) (fromIntegral delegationsLen) delegations
+
+        distribution :: Map StakeCred (Coin, PoolKeyHash)
+        distribution =
+          VMap.toMap $
+            VMap.mapMaybe id $
+              VMap.mapWithKey (\a p -> (,p) <$> lookupStake a) delegationsSliced
+
 getPoolDistr ::
   ExtLedgerState CardanoBlock mk ->
   Maybe (Map PoolKeyHash (Coin, Word64), Map PoolKeyHash Natural)

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

@@ -74,7 +74,7 @@ insertNewEpochLedgerEvents syncEnv applyRes currentEpochNo@(EpochNo curEpoch) =
     handler ev =
       case ev of
         LedgerNewEpoch en ss -> do
-          validateEpochStake tracer applyRes
+          validateEpochStake syncEnv 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

@@ -27,33 +27,42 @@ import Cardano.DbSync.Ledger.Event
 import Cardano.DbSync.Types
 import Cardano.DbSync.Ledger.Types
 import qualified Data.Strict.Maybe as Strict
+import Cardano.DbSync.Api.Types
+import Cardano.DbSync.Api
+import Cardano.DbSync.Era.Universal.Epoch
+import Cardano.DbSync.Util.Constraint
 
 validateEpochStake ::
-  Trace IO Text ->
+  SyncEnv ->
   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 ()
+validateEpochStake syncEnv 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 do
+        liftIO
+          . logWarning tracer
+          $ mconcat
+            [ "validateEpochStake: epoch stake in epoch "
+            , textShow (unEpochNo epoch)
+            , " expected total of "
+            , textShow expectedCount
+            , " but got "
+            , textShow actualCount
+            ]
+        let slice = Generic.fullEpochStake (clsState lstate)
+        addStakeConstraintsIfNotExist syncEnv tracer
+        insertStakeSlice syncEnv slice
+      else
+        liftIO $ logInfo tracer
+          $ mconcat
+            [ "Validate Epoch Stake: total entries in epoch "
+            , textShow (unEpochNo epoch)
+            , " are "
+            , textShow actualCount
+            ]
+    _ -> pure ()
+  where
+    tracer = getTrace syncEnv
 
 
 validateEpochRewards ::