Fixes

Author: kderme

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

@@ -243,6 +243,7 @@ extractSyncOptions snp aop snc =
         not isTxOutConsumedBootstrap'
           && ioInOut iopts
           && not (enpEpochDisabled snp || not (enpHasCache snp))
+          && False
     , soptAbortOnInvalid = aop
     , soptCache = enpHasCache snp
     , soptPruneConsumeMigration =

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

@@ -7,6 +7,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs #-}
 
 {-# OPTIONS_GHC -Wno-unused-matches #-}
 
@@ -49,6 +50,7 @@ import Control.Monad.Extra (whenJust)
 import Database.Persist.Sql
 import Cardano.DbSync.Threads.Ledger
 import Control.Concurrent.Class.MonadSTM.Strict (readTMVar)
+import qualified Cardano.DbSync.Era.Byron.Util as Byron
 
 insertListBlocks ::
   SyncEnv ->
@@ -104,7 +106,7 @@ applyAndInsertBlocks syncEnv firstAfterRollback = go
   where
     go [] = pure ()
     go ls@(blk : rest) = do
-      prevBlockId <- DB.runDbLoggingExceptT backend tracer $ queryPrevBlockWithCache "applyAndInsertBlocks" (envCache syncEnv) (cardanoBlockHash blk)
+      prevBlockId <- DB.runDbLoggingExceptT backend tracer $ getPrevBlockId syncEnv blk
       let newBlockId = 1 + DB.unBlockKey prevBlockId
       let flagList = firstAfterRollback : replicate (length rest) False
       let zippedArgs = zip (DB.BlockKey <$> [newBlockId..]) flagList
@@ -119,12 +121,12 @@ applyAndInsertByronBlock ::
   SyncEnv ->
   ((DB.BlockId, Bool), ByronBlock) ->
   ExceptT SyncNodeError (ReaderT SqlBackend (LoggingT IO)) ()
-applyAndInsertByronBlock syncEnv ((_blockId, firstAfterRollback), blk) = do
+applyAndInsertByronBlock syncEnv ((blockId, firstAfterRollback), blk) = do
   (applyResult, tookSnapshot) <- liftIO (mkApplyResult syncEnv (BlockByron blk)) -- TODO use writeLedgerAction here as well for better performance
   let isStartEventOrRollback = hasEpochStartEvent (apEvents applyResult) || firstAfterRollback
   let details = apSlotDetails applyResult
   insertNewEpochLedgerEvents syncEnv (sdEpochNo (apSlotDetails applyResult)) (apEvents applyResult)
-  ExceptT $ insertByronBlock syncEnv isStartEventOrRollback blk details
+  ExceptT $ insertByronBlock syncEnv isStartEventOrRollback blockId blk details
   insertBlockRest syncEnv blkNo applyResult tookSnapshot
   where
     cblk :: CardanoBlock = BlockByron blk
@@ -278,3 +280,19 @@ toGenericBlock iopts = \case
 
 cardanoBlockHash :: CardanoBlock -> ByteString
 cardanoBlockHash = SBS.fromShort . Consensus.getOneEraHash . blockHash
+
+getPrevBlockId :: MonadIO m => SyncEnv -> CardanoBlock -> ExceptT SyncNodeError (ReaderT SqlBackend m) DB.BlockId
+getPrevBlockId syncEnv = \case
+  BlockByron blk -> getByHash $ Byron.prevHash blk
+  BlockShelley blk -> getPrev $ Generic.blockPrevHash blk
+  BlockAllegra blk -> getPrev $ Generic.blockPrevHash blk
+  BlockMary blk -> getPrev $ Generic.blockPrevHash blk
+  BlockAlonzo blk -> getPrev $ Generic.blockPrevHash blk
+  BlockBabbage blk -> getPrev $ Generic.blockPrevHash blk
+  BlockConway blk -> getPrev $ Generic.blockPrevHash blk
+  where
+    getPrev = \case
+      Nothing -> liftLookupFail "getPrevBlockId" DB.queryGenesis
+      Just hsh -> getByHash hsh
+
+    getByHash = queryPrevBlockWithCache "getPrevBlockId" (envCache syncEnv)

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

@@ -55,14 +55,15 @@ insertByronBlock ::
   (MonadBaseControl IO m, MonadIO m) =>
   SyncEnv ->
   Bool ->
+  DB.BlockId ->
   ByronBlock ->
   SlotDetails ->
   ReaderT SqlBackend m (Either SyncNodeError ())
-insertByronBlock syncEnv firstBlockOfEpoch blk details = do
+insertByronBlock syncEnv firstBlockOfEpoch blkId blk details = do
   res <- runExceptT $
     case byronBlockRaw blk of
-      Byron.ABOBBlock ablk -> insertABlock syncEnv firstBlockOfEpoch ablk details
-      Byron.ABOBBoundary abblk -> insertABOBBoundary syncEnv abblk details
+      Byron.ABOBBlock ablk -> insertABlock syncEnv firstBlockOfEpoch blkId ablk details
+      Byron.ABOBBoundary abblk -> insertABOBBoundary syncEnv blkId abblk details
   -- Serializing things during syncing can drastically slow down full sync
   -- times (ie 10x or more).
   when
@@ -73,15 +74,15 @@ insertByronBlock syncEnv firstBlockOfEpoch blk details = do
 insertABOBBoundary ::
   (MonadBaseControl IO m, MonadIO m) =>
   SyncEnv ->
+  DB.BlockId ->
   Byron.ABoundaryBlock ByteString ->
   SlotDetails ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
-insertABOBBoundary syncEnv blk details = do
+insertABOBBoundary syncEnv blkId blk details = do
   let tracer = getTrace syncEnv
       cache = envCache syncEnv
   -- Will not get called in the OBFT part of the Byron era.
   pbid <- queryPrevBlockWithCache "insertABOBBoundary" cache (Byron.ebbPrevHash blk)
-  let blkId = DB.BlockKey $ 1 + DB.unBlockKey pbid
   let epochNo = unEpochNo $ sdEpochNo details
   slid <-
     lift . DB.insertSlotLeader $
@@ -141,12 +142,12 @@ insertABlock ::
   (MonadBaseControl IO m, MonadIO m) =>
   SyncEnv ->
   Bool ->
+  DB.BlockId ->
   Byron.ABlock ByteString ->
   SlotDetails ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
-insertABlock syncEnv firstBlockOfEpoch blk details = do
+insertABlock syncEnv firstBlockOfEpoch blkId blk details = do
   pbid <- queryPrevBlockWithCache "insertABlock" cache (Byron.blockPreviousHash blk)
-  let blkId = DB.BlockKey $ 1 + DB.unBlockKey pbid
   slid <- lift . DB.insertSlotLeader $ Byron.mkSlotLeader blk
   let txs = Byron.blockPayload blk
   lift $

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

@@ -51,12 +51,6 @@ insertNewEpochLedgerEvents syncEnv currentEpochNo@(EpochNo curEpoch) =
     cache = envCache syncEnv
     ntw = getNetwork syncEnv
 
-    subFromCurrentEpoch :: Word64 -> EpochNo
-    subFromCurrentEpoch m =
-      if unEpochNo currentEpochNo >= m
-        then EpochNo $ unEpochNo currentEpochNo - m
-        else EpochNo 0
-
     toSyncState :: SyncState -> DB.SyncState
     toSyncState SyncLagging = DB.SyncLagging
     toSyncState SyncFollowing = DB.SyncFollowing
@@ -91,7 +85,7 @@ insertNewEpochLedgerEvents syncEnv currentEpochNo@(EpochNo curEpoch) =
         LedgerRestrainedRewards e rwd creds ->
           lift $ adjustEpochRewards syncEnv e rwd creds
         LedgerTotalRewards _e rwd ->
-          lift $ validateEpochRewards tracer ntw (subFromCurrentEpoch 2) currentEpochNo rwd
+          lift $ validateEpochRewards tracer ntw currentEpochNo rwd
         LedgerAdaPots _ ->
           pure () -- These are handled separately by insertBlock
         LedgerGovInfo enacted dropped expired uncl -> do

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

@@ -53,10 +53,9 @@ validateEpochRewards ::
   Trace IO Text ->
   Network ->
   EpochNo ->
-  EpochNo ->
   Map StakeCred (Set (Ledger.Reward StandardCrypto)) ->
   ReaderT SqlBackend m ()
-validateEpochRewards tracer network _earnedEpochNo spendableEpochNo rmap = do
+validateEpochRewards tracer network spendableEpochNo rmap = do
   actualCount <- Db.queryNormalEpochRewardCount (unEpochNo spendableEpochNo)
   if actualCount /= expectedCount
     then do

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

@@ -476,4 +476,5 @@ splitRewardsEpochBoundary les =
       LedgerDeltaRewards {} -> Left le
       LedgerRestrainedRewards {} -> Left le
       LedgerTotalRewards {} -> Left le
+      LedgerPoolReap {} -> Left le
       _ -> Right le