devide queries and use statements

Author: Cmdv

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

@@ -89,6 +89,7 @@ import qualified Data.Strict.Maybe as Strict
 import Data.Time.Clock (getCurrentTime)
 import Database.Persist.Postgresql (ConnectionString)
 import Database.Persist.Sql (SqlBackend)
+import qualified Hasql.Connection as HqlC
 import Ouroboros.Consensus.Block.Abstract (BlockProtocol, HeaderHash, Point (..), fromRawHash)
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types (SystemStart (..))
 import Ouroboros.Consensus.Config (SecurityParam (..), TopLevelConfig, configSecurityParam)
@@ -98,7 +99,6 @@ import Ouroboros.Consensus.Protocol.Abstract (ConsensusProtocol)
 import Ouroboros.Network.Block (BlockNo (..), Point (..))
 import Ouroboros.Network.Magic (NetworkMagic (..))
 import qualified Ouroboros.Network.Point as Point
-import qualified Hasql.Connection as HqlC
 
 setConsistentLevel :: SyncEnv -> ConsistentLevel -> IO ()
 setConsistentLevel env cst = do
@@ -192,10 +192,10 @@ runAddJsonbToSchema :: SyncEnv -> IO ()
 runAddJsonbToSchema syncEnv =
   void $ DB.runDbIohkNoLogging (envDbEnv syncEnv) DB.enableJsonbInSchema
 
-runRemoveJsonbFromSchema
-  :: (MonadIO m, AsDbError e)
-  => SyncEnv
-  -> DbAction e m ()
+runRemoveJsonbFromSchema ::
+  (MonadIO m, AsDbError e) =>
+  SyncEnv ->
+  DbAction e m ()
 runRemoveJsonbFromSchema syncEnv = do
   DB.runDbT DB.Write transx
   where

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

@@ -38,7 +38,6 @@ data NextState
   | Done
   deriving (Eq)
 
-
 runDbThread ::
   SyncEnv ->
   MetricSetters ->
@@ -76,8 +75,8 @@ runDbThread syncEnv metricsSetters queue = do
       -- Handle the result of running the actions
       case result of
         Left err -> logError tracer $ "Error: " <> show err
-        Right Continue -> processQueue  -- Continue processing
-        Right Done -> pure ()           -- Stop processing
+        Right Continue -> processQueue -- Continue processing
+        Right Done -> pure () -- Stop processing
 
     -- Handle the case where the syncing thread has restarted
     handleRestart :: TMVar (LatestPoints, CurrentTip) -> IO ()
@@ -87,7 +86,7 @@ runDbThread syncEnv metricsSetters queue = do
       currentTip <- getCurrentTipBlockNo syncEnv
       logDbState syncEnv
       atomically $ putTMVar resultVar (latestPoints, currentTip)
-      processQueue  -- Continue processing
+      processQueue -- Continue processing
 
     -- Update block and slot height metrics
     updateBlockMetrics :: IO ()
@@ -97,7 +96,6 @@ runDbThread syncEnv metricsSetters queue = do
         setDbBlockHeight metricsSetters $ bBlockNo block
         setDbSlotHeight metricsSetters $ bSlotNo block
 
-
 -- runDbThread ::
 --   SyncEnv ->
 --   MetricSetters ->
@@ -138,7 +136,6 @@ runDbThread syncEnv metricsSetters queue = do
 --           atomically $ putTMVar resultVar (latestPoints, currentTip)
 --           loop
 
-
 -- | Run the list of 'DbAction's. Block are applied in a single set (as a transaction)
 -- and other operations are applied one-by-one.
 runActions ::

cardano-db/cardano-db.cabal

@@ -102,7 +102,6 @@ library
                       , filepath
                       , file-embed
                       , hasql
-                      , hasql-transaction
                       , iohk-monitoring
                       , lifted-base
                       , memory

cardano-db/src/Cardano/Db/Error.hs

@@ -1,73 +1,74 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 
 module Cardano.Db.Error (
-  AsDbError (..),
+  -- AsDbError (..),
   CallSite (..),
   DbError (..),
   runOrThrowIODb,
   runOrThrowIO,
   logAndThrowIO,
-  base16encode
+  base16encode,
 ) where
 
 import Cardano.BM.Trace (Trace, logError)
-import Cardano.Db.Schema.Ids
-import Cardano.Prelude (throwIO, MonadIO)
+import Cardano.Prelude (MonadIO, throwIO)
 import Control.Exception (Exception)
+import qualified Data.ByteString.Base16 as Base16
 import Data.ByteString.Char8 (ByteString)
 import Data.Text (Text)
-import Data.Word (Word16, Word64)
-import GHC.Generics (Generic)
-import qualified Data.ByteString.Base16 as Base16
 import qualified Data.Text.Encoding as Text
-import qualified Hasql.Session as HsqlS
 
-class AsDbError e where
-  toDbError :: DbError -> e
-  fromDbError :: e -> Maybe DbError
+import qualified Hasql.Session as HsqlSes
 
-data DbError
-  = DbError !CallSite !Text !HsqlS.SessionError
-  | DbLookupError !CallSite !Text !LookupContext
-  deriving (Show, Eq)
+data DbError = DbError
+  { dbErrorCallSite :: !CallSite
+  , dbErrorMessage :: !Text
+  , dbErrorCause :: !(Maybe HsqlSes.SessionError) -- Now a Maybe
+  }
+
+-- class AsDbError e where
+--   toDbError :: DbError -> e
+--   fromDbError :: e -> Maybe DbError
+
+-- data DbError
+--   = DbError !CallSite !Text !HsqlS.SessionError
+--   | DbLookupError !CallSite !Text !LookupContext
+--   deriving (Show, Eq)
 
-instance Exception DbError
+-- instance Exception DbError
 
 data CallSite = CallSite
   { csModule :: !Text
   , csFile :: !Text
   , csLine :: !Int
-  } deriving (Show, Eq)
-
-data LookupContext
-  = BlockHashContext !ByteString
-  | BlockIdContext !Word64
-  | MessageContext !Text
-  | TxHashContext !ByteString
-  | TxOutPairContext !ByteString !Word16
-  | EpochNoContext !Word64
-  | SlotNoContext !Word64
-  | GovActionPairContext !TxId !Word64
-  | MetaEmptyContext
-  | MetaMultipleRowsContext
-  | MultipleGenesisContext
-  | ExtraMigrationContext !String
-  | PruneConsumedContext !String
-  | RJsonbInSchemaContext !String
-  | TxOutVariantContext !String
-  deriving (Show, Eq, Generic)
-
-instance Exception LookupContext
+  }
+  deriving (Show, Eq)
+
+-- data LookupContext
+--   = BlockHashContext !ByteString
+--   | BlockIdContext !Word64
+--   | MessageContext !Text
+--   | TxHashContext !ByteString
+--   | TxOutPairContext !ByteString !Word16
+--   | EpochNoContext !Word64
+--   | SlotNoContext !Word64
+--   | GovActionPairContext !TxId !Word64
+--   | MetaEmptyContext
+--   | MetaMultipleRowsContext
+--   | MultipleGenesisContext
+--   | ExtraMigrationContext !String
+--   | PruneConsumedContext !String
+--   | RJsonbInSchemaContext !String
+--   | TxOutVariantContext !String
+--   deriving (Show, Eq, Generic)
+
+-- instance Exception LookupContext
 
 -- catchDbError :: String -> HsqlT.Transaction a -> HsqlT.Transaction a
 -- catchDbError context action =
 --   action `catch` \e ->
 --     throwError $ DbError $ context ++ ": " ++ show e
 
-
 -- instance Show LookupFail where
 --   show =
 --     \case