add Entity instance to handle table ids columns

Author: Cmdv

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

@@ -23,6 +23,18 @@ module Cardano.DbSync (
   SimplifiedOffChainPoolData (..),
   extractSyncOptions,
 ) where
+import Control.Monad.Extra (whenJust)
+import qualified Data.Strict.Maybe as Strict
+import qualified Data.Text as Text
+import Data.Version (showVersion)
+import Database.Persist.Postgresql (ConnectionString, withPostgresqlConn)
+import qualified Ouroboros.Consensus.HardFork.Simple as HardFork
+import Ouroboros.Network.NodeToClient (IOManager, withIOManager)
+import Paths_cardano_db_sync (version)
+import System.Directory (createDirectoryIfMissing)
+import Prelude (id)
+import qualified Hasql.Connection as HsqlC
+import qualified Hasql.Connection.Setting as HsqlSet
 
 import Cardano.BM.Trace (Trace, logError, logInfo, logWarning)
 import qualified Cardano.Crypto as Crypto
@@ -47,17 +59,6 @@ import Cardano.DbSync.Util.Constraint (queryIsJsonbInSchema)
 import Cardano.Prelude hiding (Nat, (%))
 import Cardano.Slotting.Slot (EpochNo (..))
 import Control.Concurrent.Async
-import Control.Monad.Extra (whenJust)
-import qualified Data.Strict.Maybe as Strict
-import qualified Data.Text as Text
-import Data.Version (showVersion)
-import Database.Persist.Postgresql (ConnectionString, withPostgresqlConn)
-import Ouroboros.Consensus.Cardano (CardanoHardForkTrigger (..))
-import Ouroboros.Network.NodeToClient (IOManager, withIOManager)
-import Paths_cardano_db_sync (version)
-import System.Directory (createDirectoryIfMissing)
-import Prelude (id)
-import Hasql.Connection as HC
 
 runDbSyncNode :: MetricSetters -> [(Text, Text)] -> SyncNodeParams -> SyncNodeConfig -> IO ()
 runDbSyncNode metricsSetters knownMigrations params syncNodeConfigFromFile =
@@ -113,8 +114,7 @@ runDbSync metricsSetters knownMigrations iomgr trce params syncNodeConfigFromFil
     then logInfo trce "All user indexes were created"
     else logInfo trce "New user indexes were not created. They may be created later if necessary."
 
-  let setting = Db.toConnectionSetting pgConfig
-
+  let dbConnectionSetting = Db.toConnectionSetting pgConfig
 
   -- For testing and debugging.
   whenJust (enpMaybeRollback params) $ \slotNo ->
@@ -123,7 +123,7 @@ runDbSync metricsSetters knownMigrations iomgr trce params syncNodeConfigFromFil
     metricsSetters
     trce
     iomgr
-    connectionString
+    dbConnectionSetting
     (void . runMigration)
     syncNodeConfigFromFile
     params
@@ -150,14 +150,15 @@ runSyncNode ::
   MetricSetters ->
   Trace IO Text ->
   IOManager ->
-  Setting ->
+  -- | Database connection settings
+  HsqlSet.Setting ->
   -- | run migration function
   RunMigration ->
   SyncNodeConfig ->
   SyncNodeParams ->
   SyncOptions ->
   IO ()
-runSyncNode metricsSetters trce iomgr connSetting runMigrationFnc syncNodeConfigFromFile syncNodeParams syncOptions = do
+runSyncNode metricsSetters trce iomgr dbConnSetting runMigrationFnc syncNodeConfigFromFile syncNodeParams syncOptions = do
   whenJust maybeLedgerDir $
     \enpLedgerStateDir -> do
       createDirectoryIfMissing True (unLedgerStateDir enpLedgerStateDir)
@@ -168,11 +169,11 @@ runSyncNode metricsSetters trce iomgr connSetting runMigrationFnc syncNodeConfig
   let useLedger = shouldUseLedger (sioLedger $ dncInsertOptions syncNodeConfigFromFile)
   -- Our main thread
   bracket
-    (runOrThrowIO $ HC.acquire [connSetting])
+    (runOrThrowIO $ HsqlC.acquire [dbConnSetting])
     release
-    (\connection -> do
+    (\dbConn -> do
         runOrThrowIO $ runExceptT $ do
-          let dbEnv = Db.DbEnv connection (dncEnableDbLogging syncNodeConfigFromFile)
+          let dbEnv = Db.DbEnv dbConn (dncEnableDbLogging syncNodeConfigFromFile)
           genCfg <- readCardanoGenesisConfig syncNodeConfigFromFile
           isJsonbInSchema <- queryIsJsonbInSchema dbEnv
           logProtocolMagicId trce $ genesisProtocolMagicId genCfg

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

@@ -84,6 +84,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)
@@ -93,7 +94,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
@@ -119,7 +119,7 @@ getIsConsumedFixed env =
   where
     txOutTableType = getTxOutTableType env
     pcm = soptPruneConsumeMigration $ envOptions env
-    backend = envBackend env
+    backend = envDbEnv env
 
 getDisableInOutState :: SyncEnv -> IO Bool
 getDisableInOutState syncEnv = do
@@ -167,12 +167,12 @@ 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.runDbTx DB.Write transx
+  DB.runDbT DB.Write transx
   where
     dbEnv = envDbEnv syncEnv
     transx = mkDbTransaction "runRemoveJsonbFromSchema" mkCallSite (DB.disableJsonbInSchema (dbConnection dbEnv))
@@ -285,12 +285,12 @@ getDbLatestBlockInfo backend = do
 
 getDbTipBlockNo :: SyncEnv -> IO (Point.WithOrigin BlockNo)
 getDbTipBlockNo env = do
-  mblk <- getDbLatestBlockInfo (envBackend env)
+  mblk <- getDbLatestBlockInfo (envDbEnv env)
   pure $ maybe Point.Origin (Point.At . bBlockNo) mblk
 
 logDbState :: SyncEnv -> IO ()
 logDbState env = do
-  mblk <- getDbLatestBlockInfo (envBackend env)
+  mblk <- getDbLatestBlockInfo (envDbEnv env)
   case mblk of
     Nothing -> logInfo tracer "Database is empty"
     Just tip -> logInfo tracer $ mconcat ["Database tip is at ", showTip tip]
@@ -309,7 +309,7 @@ logDbState env = do
 
 getCurrentTipBlockNo :: SyncEnv -> IO (WithOrigin BlockNo)
 getCurrentTipBlockNo env = do
-  maybeTip <- getDbLatestBlockInfo (envBackend env)
+  maybeTip <- getDbLatestBlockInfo (envDbEnv env)
   case maybeTip of
     Just tip -> pure $ At (bBlockNo tip)
     Nothing -> pure Origin
@@ -379,11 +379,7 @@ mkSyncEnv ::
   SyncNodeParams ->
   RunMigration ->
   IO SyncEnv
-<<<<<<< HEAD
-mkSyncEnv trce backend connectionString syncOptions protoInfo nw nwMagic systemStart syncNodeConfigFromFile syncNP runMigrationFnc = do
-=======
-mkSyncEnv trce dbEnv connectionString syncOptions protoInfo nw nwMagic systemStart syncNodeConfigFromFile syncNP ranMigrations runMigrationFnc = do
->>>>>>> 29841e49 (more functionality)
+mkSyncEnv trce dbEnv connectionString syncOptions protoInfo nw nwMagic systemStart syncNodeConfigFromFile syncNP runMigrationFnc = do
   dbCNamesVar <- newTVarIO =<< dbConstraintNamesExists backend
   cache <-
     if soptCache syncOptions
@@ -512,7 +508,7 @@ getLatestPoints env = do
       verifySnapshotPoint env snapshotPoints
     NoLedger _ -> do
       -- Brings the 5 latest.
-      lastPoints <- DB.runDbIohkNoLogging (envBackend env) DB.queryLatestPoints
+      lastPoints <- DB.runDbIohkNoLogging (envDbEnv env) DB.queryLatestPoints
       pure $ mapMaybe convert lastPoints
   where
     convert (Nothing, _) = Nothing
@@ -524,7 +520,7 @@ verifySnapshotPoint env snapPoints =
   where
     validLedgerFileToPoint :: SnapshotPoint -> IO (Maybe (CardanoPoint, Bool))
     validLedgerFileToPoint (OnDisk lsf) = do
-      hashes <- getSlotHash (envBackend env) (lsfSlotNo lsf)
+      hashes <- getSlotHash (envDbEnv env) (lsfSlotNo lsf)
       let valid = find (\(_, h) -> lsfHash lsf == hashToAnnotation h) hashes
       case valid of
         Just (slot, hash) | slot == lsfSlotNo lsf -> pure $ convertToDiskPoint slot hash
@@ -533,7 +529,7 @@ verifySnapshotPoint env snapPoints =
       case pnt of
         GenesisPoint -> pure Nothing
         BlockPoint slotNo hsh -> do
-          hashes <- getSlotHash (envBackend env) slotNo
+          hashes <- getSlotHash (envDbEnv env) slotNo
           let valid = find (\(_, dbHash) -> getHeaderHash hsh == dbHash) hashes
           case valid of
             Just (dbSlotNo, _) | slotNo == dbSlotNo -> pure $ Just (pnt, True)

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-sync/src/Cardano/DbSync/Default.hs

@@ -51,7 +51,7 @@ insertListBlocks ::
   [CardanoBlock] ->
   IO (Either SyncNodeError ())
 insertListBlocks synEnv blocks = do
-  DB.runDbIohkLogging (envBackend synEnv) tracer
+  DB.runDbIohkLogging (envDbEnv synEnv) tracer
     . runExceptT
     $ traverse_ (applyAndInsertBlockMaybe synEnv tracer) blocks
   where

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

@@ -335,7 +335,7 @@ insertCommitteeHash cred = do
 insertDrep :: (MonadBaseControl IO m, MonadIO m) => DRep -> ReaderT SqlBackend m DB.DrepHashId
 insertDrep = \case
   DRepCredential cred -> insertCredDrepHash cred
-  DRepAlwaysAbstain -> DB.insertAlwaysAbstainDrep
+  DRepAlwaysAbstain -> DB.insertDrepHashAlwaysAbstain
   DRepAlwaysNoConfidence -> DB.insertAlwaysNoConfidence
 
 insertCredDrepHash :: (MonadBaseControl IO m, MonadIO m) => Ledger.Credential 'DRepRole -> ReaderT SqlBackend m DB.DrepHashId

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

@@ -42,7 +42,7 @@ data SyncInvariant
 
 data SyncNodeError
   = SNErrDefault !Text
-  | SNErrDbTransaction !DB.DbError
+  | SNErrDatabase !DB.DbError
   | SNErrInvariant !Text !SyncInvariant
   | SNEErrBlockMismatch !Word64 !ByteString !ByteString
   | SNErrIgnoreShelleyInitiation
@@ -67,7 +67,7 @@ instance Show SyncNodeError where
   show =
     \case
       SNErrDefault t -> "Error SNErrDefault: " <> show t
-      SNErrDbTransaction err -> "Error SNErrDbTransaction: " <> show err
+      SNErrDatabase err -> "Error SNErrDatabase: " <> show err
       SNErrInvariant loc i -> "Error SNErrInvariant: " <> Show.show loc <> ": " <> show (renderSyncInvariant i)
       SNEErrBlockMismatch blkNo hashDb hashBlk ->
         mconcat

cardano-db/cardano-db.cabal

@@ -30,8 +30,7 @@ library
                         -Wunused-packages
 
   exposed-modules:      Cardano.Db
-                        Cardano.Db.Schema.Core.TxOut
-                        Cardano.Db.Schema.Variant.TxOut
+                        Cardano.Db.Schema.Variants
 
   other-modules:        Cardano.Db.Error
                         Cardano.Db.Git.RevFromGit
@@ -64,6 +63,10 @@ library
                         Cardano.Db.Schema.Ids
                         Cardano.Db.Schema.Orphans
                         Cardano.Db.Schema.Types
+                        Cardano.Db.Schema.Variants.TxOutAddress
+                        Cardano.Db.Schema.Variants.TxOutCore
+                        Cardano.Db.Schema.Variants.TxOutUtxoHd
+                        Cardano.Db.Schema.Variants.TxOutUtxoHdAddress
                         Cardano.Db.Statement
                         Cardano.Db.Statement.Function.Core
                         Cardano.Db.Statement.Function.Query
@@ -93,20 +96,17 @@ library
                       , contravariant-extras
                       , cryptonite
                       , directory
-                      , esqueleto
                       , extra
                       , fast-logger
                       , filepath
                       , file-embed
                       , hasql
-                      , hasql-transaction
                       , iohk-monitoring
                       , lifted-base
                       , memory
                       , monad-control
                       , monad-logger
                       , persistent
-                      , persistent-documentation
                       , persistent-postgresql
                       , postgresql-simple
                       , process