update errors

Author: Cmdv

cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs

@@ -150,20 +150,20 @@ assertBackoff env query delays check errMsg = go delays
 
 assertQuery :: DBSyncEnv -> DB.DbM a -> (a -> Bool) -> (a -> String) -> IO (Maybe String)
 assertQuery env query check errMsg = do
-  ma <- try @DB.DbError $ queryDBSync env query
+  ma <- try @DB.DbSessionError $ queryDBSync env query
   case ma of
-    Left dbErr | migrationNotDoneYet (DB.dbErrorMessage dbErr) -> do
+    Left dbErr | migrationNotDoneYet (DB.dbSessionErrMsg dbErr) -> do
       threadDelay 1_000_000
-      pure $ Just $ Text.unpack $ DB.dbErrorMessage dbErr
+      pure $ Just $ Text.unpack $ DB.dbSessionErrMsg dbErr
     Left err -> throwIO err
     Right a | not (check a) -> pure $ Just $ errMsg a
     _ -> pure Nothing
 
 runQuery :: DBSyncEnv -> DB.DbM a -> IO a
 runQuery env query = do
-  ma <- try @DB.DbError $ queryDBSync env query
+  ma <- try @DB.DbSessionError $ queryDBSync env query
   case ma of
-    Left dbErr | migrationNotDoneYet (DB.dbErrorMessage dbErr) -> do
+    Left dbErr | migrationNotDoneYet (DB.dbSessionErrMsg dbErr) -> do
       threadDelay 1_000_000
       runQuery env query
     Left err -> throwIO err

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

@@ -211,7 +211,7 @@ runSyncNode metricsSetters trce iomgr dbConnSetting runNearTipMigrationFnc syncN
                   then DB.createDbEnv dbConn (Just pool) (Just trce)
                   else DB.createDbEnv dbConn (Just pool) Nothing
           genCfg <- readCardanoGenesisConfig syncNodeConfigFromFile
-          isJsonbInSchema <- liftDbError $ DB.queryJsonbInSchemaExists dbConn
+          isJsonbInSchema <- liftSessionIO mkSyncNodeCallStack $ DB.queryJsonbInSchemaExists dbConn
           logProtocolMagicId trce $ genesisProtocolMagicId genCfg
           syncEnv <-
             ExceptT $

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

@@ -51,7 +51,7 @@ import Cardano.DbSync.Cache.Epoch (rollbackMapEpochInCache)
 import qualified Cardano.DbSync.Cache.FIFO as FIFO
 import qualified Cardano.DbSync.Cache.LRU as LRU
 import Cardano.DbSync.Cache.Types (CacheAction (..), CacheInternal (..), CacheStatistics (..), CacheStatus (..), StakeCache (..), shouldCache)
-import Cardano.DbSync.DbEvent (liftFail)
+import Cardano.DbSync.DbEvent (liftDbLookup)
 import qualified Cardano.DbSync.Era.Shelley.Generic.Util as Generic
 import Cardano.DbSync.Era.Shelley.Query
 import Cardano.DbSync.Error (SyncNodeError (..), mkSyncNodeCallStack)
@@ -113,10 +113,10 @@ optimiseCaches cache =
         -- Trim pools Map to target size (keep most recent entries)
         atomically $ modifyTVar (cPools c) $ \poolMap ->
           Map.fromList $ take (fromIntegral $ cOptimisePools c) $ Map.toList poolMap
-        
+
         -- Trim stake stable cache to target size
         atomically $ modifyTVar (cStake c) $ \stakeCache ->
-          stakeCache { scStableCache = Map.fromList $ take (fromIntegral $ cOptimiseStake c) $ Map.toList (scStableCache stakeCache) }
+          stakeCache {scStableCache = Map.fromList $ take (fromIntegral $ cOptimiseStake c) $ Map.toList (scStableCache stakeCache)}
 
 queryOrInsertRewardAccount ::
   SyncEnv ->
@@ -218,13 +218,13 @@ queryPoolKeyWithCache ::
   SyncEnv ->
   CacheAction ->
   PoolKeyHash ->
-  ExceptT SyncNodeError DB.DbM (Either DB.DbError DB.PoolHashId)
+  ExceptT SyncNodeError DB.DbM (Either DB.DbSessionError DB.PoolHashId)
 queryPoolKeyWithCache syncEnv cacheUA hsh =
   case envCache syncEnv of
     NoCache -> do
       mPhId <- lift $ DB.queryPoolHashId (Generic.unKeyHashRaw hsh)
       case mPhId of
-        Nothing -> pure $ Left $ DB.DbError "queryPoolKeyWithCache: NoCache queryPoolHashId"
+        Nothing -> pure $ Left $ DB.DbSessionError DB.mkDbCallStack "queryPoolKeyWithCache: NoCache queryPoolHashId"
         Just phId -> pure $ Right phId
     ActiveCache ci -> do
       mp <- liftIO $ readTVarIO (cPools ci)
@@ -242,7 +242,7 @@ queryPoolKeyWithCache syncEnv cacheUA hsh =
           liftIO $ missPools syncEnv
           mPhId <- lift $ DB.queryPoolHashId (Generic.unKeyHashRaw hsh)
           case mPhId of
-            Nothing -> pure $ Left $ DB.DbError "queryPoolKeyWithCache: ActiveCache queryPoolHashId"
+            Nothing -> pure $ Left $ DB.DbSessionError DB.mkDbCallStack "queryPoolKeyWithCache: ActiveCache queryPoolHashId"
             Just phId -> do
               -- missed so we can't evict even with 'EvictAndReturn'
               when (shouldCache cacheUA) $
@@ -412,7 +412,7 @@ queryPrevBlockWithCache ::
 queryPrevBlockWithCache syncEnv hsh errMsg =
   case envCache syncEnv of
     NoCache ->
-      liftFail cs $ DB.queryBlockId hsh errMsg
+      liftDbLookup mkSyncNodeCallStack $ DB.queryBlockId hsh errMsg
     ActiveCache ci -> do
       mCachedPrev <- liftIO $ readTVarIO (cPrevBlock ci)
       case mCachedPrev of
@@ -425,18 +425,16 @@ queryPrevBlockWithCache syncEnv hsh errMsg =
             else queryFromDb
         Nothing -> queryFromDb
   where
-    cs = mkSyncNodeCallStack "queryPrevBlockWithCache"
-
     queryFromDb ::
       ExceptT SyncNodeError DB.DbM DB.BlockId
     queryFromDb = do
       liftIO $ missPrevBlock syncEnv
-      liftFail cs $ DB.queryBlockId hsh errMsg
+      liftDbLookup mkSyncNodeCallStack $ DB.queryBlockId hsh errMsg
 
 queryTxIdWithCache ::
   SyncEnv ->
   Ledger.TxId ->
-  ExceptT SyncNodeError DB.DbM (Either DB.DbError DB.TxId)
+  ExceptT SyncNodeError DB.DbM (Either DB.DbLookupError DB.TxId)
 queryTxIdWithCache syncEnv txIdLedger = do
   case envCache syncEnv of
     -- Direct database query if no cache.
@@ -470,7 +468,7 @@ queryTxIdWithCache syncEnv txIdLedger = do
       case result of
         Just txId -> pure $ Right txId
         Nothing ->
-          pure $ Left $ DB.DbError ("TxId not found for hash: " <> textShow txHash)
+          pure $ Left $ DB.DbLookupError DB.mkDbCallStack ("TxId not found for hash: " <> textShow txHash)
 
 tryUpdateCacheTx ::
   MonadIO m =>

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

@@ -64,8 +64,7 @@ writeEpochBlockDiffToCache ::
 writeEpochBlockDiffToCache cache epCurrent =
   case cache of
     NoCache -> do
-      let cs = mkSyncNodeCallStack "writeEpochBlockDiffToCache"
-      throwError $ SNErrDefault cs "Cache is NoCache"
+      throwError $ SNErrDefault mkSyncNodeCallStack "Cache is NoCache"
     ActiveCache ci -> do
       cE <- liftIO $ readTVarIO (cEpoch ci)
       case (ceMapEpoch cE, ceEpochBlockDiff cE) of
@@ -80,19 +79,18 @@ writeToMapEpochCache ::
   DB.Epoch ->
   ExceptT SyncNodeError DB.DbM ()
 writeToMapEpochCache syncEnv cache latestEpoch = do
-  let cs = mkSyncNodeCallStack "writeToMapEpochCache"
   -- this can also be tought of as max rollback number
   let securityParam =
         case envLedgerEnv syncEnv of
           HasLedger hle -> getSecurityParameter $ leProtocolInfo hle
           NoLedger nle -> getSecurityParameter $ nleProtocolInfo nle
   case cache of
-    NoCache -> throwError $ SNErrDefault cs "Cache is NoCache"
+    NoCache -> throwError $ SNErrDefault mkSyncNodeCallStack "Cache is NoCache"
     ActiveCache ci -> do
       -- get EpochBlockDiff so we can use the BlockId we stored when inserting blocks
       epochInternalCE <- readEpochBlockDiffFromCache cache
       case epochInternalCE of
-        Nothing -> throwError $ SNErrDefault cs "No epochInternalEpochCache"
+        Nothing -> throwError $ SNErrDefault mkSyncNodeCallStack "No epochInternalEpochCache"
         Just ei -> do
           cE <- liftIO $ readTVarIO (cEpoch ci)
           let currentBlockId = ebdBlockId ei

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

@@ -82,8 +82,8 @@ data CacheInternal = CacheInternal
   , cEpoch :: !(StrictTVar IO CacheEpoch)
   , cAddress :: !(StrictTVar IO (LRUCache ByteString DB.AddressId))
   , cTxIds :: !(StrictTVar IO (FIFOCache Ledger.TxId DB.TxId))
-  -- Optimisation target sizes for Map-based caches
-  , cOptimisePools :: !Word64
+  , -- Optimisation target sizes for Map-based caches
+    cOptimisePools :: !Word64
   , cOptimiseStake :: !Word64
   }
 
@@ -111,8 +111,8 @@ data CacheCapacity = CacheCapacity
   , cacheCapacityDatum :: !Word64
   , cacheCapacityMultiAsset :: !Word64
   , cacheCapacityTx :: !Word64
-  -- Optimisation target sizes for Map-based caches (used every 100k blocks)
-  , cacheOptimisePools :: !Word64
+  , -- Optimisation target sizes for Map-based caches (used every 100k blocks)
+    cacheOptimisePools :: !Word64
   , cacheOptimiseStake :: !Word64
   }
 

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

@@ -19,9 +19,8 @@ readByronGenesisConfig ::
   ExceptT SyncNodeError IO Byron.Config
 readByronGenesisConfig enc = do
   let file = unGenesisFile $ dncByronGenesisFile enc
-      cs = mkSyncNodeCallStack "readByronGenesisConfig"
   genHash <-
-    firstExceptT (SNErrDefault cs)
+    firstExceptT (SNErrDefault mkSyncNodeCallStack)
       . hoistEither
       $ decodeAbstractHash (unGenesisHashByron $ dncByronGenesisHash enc)
   firstExceptT (SNErrByronConfig file) $

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

@@ -139,7 +139,7 @@ validateConsistentLevel syncEnv stPoint = do
   where
     compareTips _ dbTip Unchecked =
       logAndThrowIO tracer $
-        SNErrDatabaseValConstLevel $
+        SNErrDbSessionErrValConstLevel $
           "Found Unchecked Consistent Level. " <> showContext dbTip Unchecked
     compareTips (Point Origin) Nothing Consistent = pure ()
     compareTips (Point Origin) _ DBAheadOfLedger = pure ()
@@ -151,7 +151,7 @@ validateConsistentLevel syncEnv stPoint = do
       | blockPointSlot blk <= bSlotNo tip = pure ()
     compareTips _ dbTip cLevel =
       logAndThrowIO tracer $
-        SNErrDatabaseValConstLevel $
+        SNErrDbSessionErrValConstLevel $
           "Unexpected Consistent Level. " <> showContext dbTip cLevel
 
     tracer = getTrace syncEnv

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

@@ -5,9 +5,11 @@
 module Cardano.DbSync.DbEvent (
   DbEvent (..),
   ThreadChannels (..),
-  liftFail,
-  liftFailEither,
-  liftDbError,
+  liftDbSession,
+  liftDbLookup,
+  liftDbSessionEither,
+  liftDbLookupEither,
+  liftSessionIO,
   acquireDbConnection,
   blockingFlushDbEventQueue,
   lengthDbEventQueue,
@@ -104,9 +106,9 @@ data ThreadChannels = ThreadChannels
 --   let dbAction = runExceptT exceptTAction
 --   eResult <- liftIO $ try $ DB.runDbDirectLogged tracer dbEnv dbAction
 --   case eResult of
---     Left (dbErr :: DB.DbError) -> do
+--     Left (dbErr :: DB.DbSessionError) -> do
 --       let cs = mkSyncNodeCallStack "runDbSyncTransaction"
---       pure $ Left $ SNErrDatabase cs dbErr
+--       pure $ Left $ SNErrDbSessionErr mkSyncNodeCallStack dbErr
 --     Right appResult -> pure appResult
 runDbSyncTransaction ::
   forall m a.
@@ -117,13 +119,12 @@ runDbSyncTransaction ::
   m (Either SyncNodeError a)
 runDbSyncTransaction tracer dbEnv exceptTAction = do
   -- OUTER TRY: Catch any exceptions from the entire database operation
-  -- This includes connection errors, DB.DbError exceptions thrown from runDbTransLogged,
+  -- This includes connection errors, DB.DbSessionError exceptions thrown from runDbTransLogged,
   -- or any other unexpected exceptions during database access
   eResult <- liftIO $ try $ DB.runDbTransLogged tracer dbEnv (runExceptT exceptTAction)
   case eResult of
-    Left (dbErr :: DB.DbError) -> do
-      let cs = mkSyncNodeCallStack "runDbSyncTransaction"
-      pure $ Left $ SNErrDatabase cs dbErr
+    Left (dbErr :: DB.DbSessionError) -> do
+      pure $ Left $ SNErrDbSessionErr mkSyncNodeCallStack dbErr
     Right appResult -> pure appResult
 
 runDbSyncTransactionNoLogging ::
@@ -136,9 +137,8 @@ runDbSyncTransactionNoLogging dbEnv exceptTAction = do
   let dbAction = runExceptT exceptTAction
   eResult <- liftIO $ try $ DB.runDbTransSilent dbEnv dbAction
   case eResult of
-    Left (dbErr :: DB.DbError) -> do
-      let cs = mkSyncNodeCallStack "runDbSyncTransactionNoLogging"
-      pure $ Left $ SNErrDatabase cs dbErr
+    Left (dbErr :: DB.DbSessionError) -> do
+      pure $ Left $ SNErrDbSessionErr mkSyncNodeCallStack dbErr
     Right appResult -> pure appResult
 
 runDbSyncNoTransaction ::
@@ -151,9 +151,8 @@ runDbSyncNoTransaction ::
 runDbSyncNoTransaction tracer dbEnv exceptTAction = do
   eResult <- liftIO $ try $ DB.runDbDirectLogged tracer dbEnv (runExceptT exceptTAction)
   case eResult of
-    Left (dbErr :: DB.DbError) -> do
-      let cs = mkSyncNodeCallStack "runDbSyncNoTransaction"
-      pure $ Left $ SNErrDatabase cs dbErr
+    Left (dbErr :: DB.DbSessionError) -> do
+      pure $ Left $ SNErrDbSessionErr mkSyncNodeCallStack dbErr
     Right appResult -> pure appResult
 
 runDbSyncNoTransactionNoLogging ::
@@ -166,9 +165,8 @@ runDbSyncNoTransactionNoLogging dbEnv exceptTAction = do
   let dbAction = runExceptT exceptTAction
   eResult <- liftIO $ try $ DB.runDbDirectSilent dbEnv dbAction
   case eResult of
-    Left (dbErr :: DB.DbError) -> do
-      let cs = mkSyncNodeCallStack "runDbSyncNoTransactionNoLogging"
-      pure $ Left $ SNErrDatabase cs dbErr
+    Left (dbErr :: DB.DbSessionError) -> do
+      pure $ Left $ SNErrDbSessionErr mkSyncNodeCallStack dbErr
     Right appResult -> pure appResult
 
 -- | Execute database operations in a single transaction using the connection pool
@@ -182,39 +180,55 @@ runDbSyncTransactionPool tracer dbEnv exceptTAction = do
   let dbAction = runExceptT exceptTAction
   eResult <- liftIO $ try $ DB.runDbPoolTransLogged tracer dbEnv dbAction -- Use pool
   case eResult of
-    Left (dbErr :: DB.DbError) -> do
-      let cs = mkSyncNodeCallStack "runDbSyncTransactionPool"
-      pure $ Left $ SNErrDatabase cs dbErr
+    Left (dbErr :: DB.DbSessionError) -> do
+      pure $ Left $ SNErrDbSessionErr mkSyncNodeCallStack dbErr
     Right appResult -> pure appResult
 
-liftFail :: SyncNodeCallStack -> DB.DbM (Either DB.DbError a) -> ExceptT SyncNodeError DB.DbM a
-liftFail cs dbAction = do
+liftDbSession :: SyncNodeCallStack -> DB.DbM (Either DB.DbSessionError a) -> ExceptT SyncNodeError DB.DbM a
+liftDbSession cs dbAction = do
   result <- lift dbAction
   case result of
-    Left dbErr -> throwError $ SNErrDatabase cs dbErr
+    Left dbErr -> throwError $ SNErrDbSessionErr cs dbErr
     Right val -> pure val
 
-liftFailEither :: SyncNodeCallStack -> ExceptT SyncNodeError DB.DbM (Either DB.DbError a) -> ExceptT SyncNodeError DB.DbM a
-liftFailEither cs mResult = do
+-- | Helper function to lift DbLookupError to SyncNodeError (similar to liftDbSession)
+liftDbLookup :: SyncNodeCallStack -> DB.DbM (Either DB.DbLookupError a) -> ExceptT SyncNodeError DB.DbM a
+liftDbLookup cs dbAction = do
+  result <- lift dbAction
+  case result of
+    Left dbErr -> throwError $ SNErrDbLookupError cs dbErr
+    Right val -> pure val
+
+liftDbSessionEither :: SyncNodeCallStack -> ExceptT SyncNodeError DB.DbM (Either DB.DbSessionError a) -> ExceptT SyncNodeError DB.DbM a
+liftDbSessionEither cs mResult = do
+  resultE <- lift $ runExceptT mResult
+  case resultE of
+    Left err -> throwError $ SNErrDefault cs (show err)
+    Right result -> case result of
+      Left dbErr -> throwError $ SNErrDbSessionErr cs dbErr
+      Right val -> pure val
+
+liftDbLookupEither :: SyncNodeCallStack -> ExceptT SyncNodeError DB.DbM (Either DB.DbLookupError a) -> ExceptT SyncNodeError DB.DbM a
+liftDbLookupEither cs mResult = do
   resultE <- lift $ runExceptT mResult
   case resultE of
     Left err -> throwError $ SNErrDefault cs (show err)
     Right result -> case result of
-      Left dbErr -> throwError $ SNErrDatabase cs dbErr
+      Left dbErr -> throwError $ SNErrDbLookupError cs dbErr
       Right val -> pure val
 
-liftDbError :: ExceptT DB.DbError IO a -> ExceptT SyncNodeError IO a
-liftDbError dbAction = do
+liftSessionIO :: SyncNodeCallStack -> ExceptT DB.DbSessionError IO a -> ExceptT SyncNodeError IO a
+liftSessionIO cs dbAction = do
   result <- liftIO $ runExceptT dbAction
   case result of
-    Left dbErr -> throwError $ SNErrDatabase (mkSyncNodeCallStack "liftDbError") dbErr
+    Left dbErr -> throwError $ SNErrDbSessionErr cs dbErr
     Right val -> pure val
 
 acquireDbConnection :: [HsqlSet.Setting] -> IO HsqlC.Connection
 acquireDbConnection settings = do
   result <- HsqlC.acquire settings
   case result of
-    Left connErr -> throwIO $ SNErrDatabase (mkSyncNodeCallStack "acquireDbConnection") $ DB.DbError (show connErr)
+    Left connErr -> throwIO $ SNErrDbSessionErr mkSyncNodeCallStack $ DB.mkDbSessionError (show connErr)
     Right conn -> pure conn
 
 mkDbApply :: CardanoBlock -> DbEvent

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

@@ -81,7 +81,7 @@ insertListBlocksWithStopCondition syncEnv blocks targetBlock = do
           "Reached stop condition at block "
             <> textShow targetBlock
             <> ". Stopping db-sync gracefully."
-      pure $ Left $ SNErrDefault (mkSyncNodeCallStack "insertListBlocks") "Stop condition reached"
+      pure $ Left $ SNErrDefault mkSyncNodeCallStack "Stop condition reached"
     _ -> pure result
 
 applyAndInsertBlockMaybe ::

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

@@ -221,7 +221,7 @@ handleEpochCachingWhenSyncing syncEnv cache newestEpochFromMap epochBlockDiffCac
       newEpoch <- lift $ DB.queryCalcEpochEntry $ ebdEpochNo currentEpC
       writeToMapEpochCache syncEnv cache newEpoch
     -- There will always be a EpochBlockDiff at this point in time
-    (_, _) -> throwError $ SNErrDefault (mkSyncNodeCallStack "handleEpochCachingWhenSyncing") "No caches available to update cache"
+    (_, _) -> throwError $ SNErrDefault mkSyncNodeCallStack "No caches available to update cache"
 
 -----------------------------------------------------------------------------------------------------
 -- Helper functions