Skip to content

Commit a67562c

Browse files
CmdvCmdv
committed
Clean up to hasql conversion PR
1 parent f951e20 commit a67562c

File tree

37 files changed

+587
-956
lines changed

37 files changed

+587
-956
lines changed

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

Lines changed: 27 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -62,20 +62,13 @@ module Test.Cardano.Db.Mock.Config (
6262
txOutVariantTypeFromConfig,
6363
) where
6464

65-
import Cardano.Api (NetworkMagic (..))
66-
import qualified Cardano.Db as DB
67-
import Cardano.DbSync
68-
import Cardano.DbSync.Config
69-
import Cardano.DbSync.Config.Cardano
70-
import Cardano.DbSync.Config.Types
71-
import Cardano.DbSync.Error (runOrThrowIO)
72-
import Cardano.DbSync.Types (CardanoBlock, MetricSetters (..))
73-
import Cardano.Mock.ChainSync.Server
74-
import Cardano.Mock.Forging.Interpreter
75-
import Cardano.Node.Protocol.Shelley (readLeaderCredentials)
76-
import Cardano.Node.Types (ProtocolFilepaths (..))
77-
import Cardano.Prelude (NonEmpty ((:|)), panic, stderr, textShow, throwIO)
78-
import Cardano.SMASH.Server.PoolDataLayer
65+
import Control.Exception (SomeException, bracket)
66+
import Control.Monad (void)
67+
import Control.Monad.Extra (eitherM)
68+
import Control.Monad.Logger (NoLoggingT)
69+
import Control.Monad.Trans.Except.Extra (runExceptT)
70+
import Control.Tracer (nullTracer)
71+
import Data.Text (Text)
7972
import Control.Concurrent.Async (Async, async, cancel, poll)
8073
import Control.Concurrent.STM (atomically)
8174
import Control.Concurrent.STM.TMVar (
@@ -85,13 +78,10 @@ import Control.Concurrent.STM.TMVar (
8578
tryPutTMVar,
8679
tryReadTMVar,
8780
)
88-
import Control.Exception (SomeException, bracket)
89-
import Control.Monad (void)
90-
import Control.Monad.Extra (eitherM)
91-
import Control.Monad.Logger (NoLoggingT)
92-
import Control.Monad.Trans.Except.Extra (runExceptT)
93-
import Control.Tracer (nullTracer)
94-
import Data.Text (Text)
81+
import System.Directory (createDirectoryIfMissing, removePathForcibly)
82+
import System.FilePath.Posix (takeDirectory, (</>))
83+
import System.IO.Silently (hSilence)
84+
9585
import Ouroboros.Consensus.Block.Forging
9686
import Ouroboros.Consensus.Byron.Ledger.Mempool ()
9787
import Ouroboros.Consensus.Config (TopLevelConfig)
@@ -100,9 +90,21 @@ import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus
10090
import Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
10191
import Ouroboros.Consensus.Shelley.Ledger.Mempool ()
10292
import Ouroboros.Consensus.Shelley.Node (ShelleyLeaderCredentials)
103-
import System.Directory (createDirectoryIfMissing, removePathForcibly)
104-
import System.FilePath.Posix (takeDirectory, (</>))
105-
import System.IO.Silently (hSilence)
93+
import Cardano.Api (NetworkMagic (..))
94+
95+
import qualified Cardano.Db as DB
96+
import Cardano.DbSync
97+
import Cardano.DbSync.Config
98+
import Cardano.DbSync.Config.Cardano
99+
import Cardano.DbSync.Config.Types
100+
import Cardano.DbSync.Error (runOrThrowIO)
101+
import Cardano.DbSync.Types (CardanoBlock, MetricSetters (..))
102+
import Cardano.Mock.ChainSync.Server
103+
import Cardano.Mock.Forging.Interpreter
104+
import Cardano.Node.Protocol.Shelley (readLeaderCredentials)
105+
import Cardano.Node.Types (ProtocolFilepaths (..))
106+
import Cardano.Prelude (NonEmpty ((:|)), panic, stderr, textShow, throwIO)
107+
import Cardano.SMASH.Server.PoolDataLayer
106108

107109
data Config = Config
108110
{ topLevelConfig :: TopLevelConfig CardanoBlock
@@ -239,7 +241,7 @@ getPoolLayer env = do
239241
Left err -> throwIO $ userError err
240242
Right setting -> pure setting
241243

242-
-- Create the Hasql connection pool (using port as pool identifier, similar to your server)
244+
-- Create the Hasql connection pool, using port as pool identifier
243245
pool <- DB.createHasqlConnectionPool [connSetting] 1 -- Pool size of 1 for tests
244246
pure $
245247
postgresqlPoolDataLayer

‎cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Plutus.hs

Lines changed: 12 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -28,17 +28,24 @@ module Test.Cardano.Db.Mock.Unit.Alonzo.Plutus (
2828
swapMultiAssets,
2929
) where
3030

31+
import Test.Tasty.HUnit (Assertion)
32+
import Control.Monad (void)
33+
import qualified Data.Map as Map
34+
import Data.Text (Text)
35+
3136
import qualified Cardano.Crypto.Hash as Crypto
32-
import Cardano.Db (TxOutVariantType (..))
33-
import qualified Cardano.Db as DB
34-
import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA
35-
import qualified Cardano.Db.Schema.Variants.TxOutCore as VC
36-
import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress)
3737
import Cardano.Ledger.Coin
3838
import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..), PolicyID (..))
3939
import Cardano.Ledger.Plutus.Data (hashData)
4040
import Cardano.Ledger.SafeHash (extractHash)
4141
import Cardano.Ledger.Shelley.TxCert
42+
import Ouroboros.Consensus.Cardano.Block (StandardAlonzo)
43+
44+
import Cardano.Db (TxOutVariantType (..))
45+
import qualified Cardano.Db as DB
46+
import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA
47+
import qualified Cardano.Db.Schema.Variants.TxOutCore as VC
48+
import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress)
4249
import Cardano.Mock.ChainSync.Server (IOManager)
4350
import Cardano.Mock.Forging.Interpreter (withAlonzoLedgerState)
4451
import qualified Cardano.Mock.Forging.Tx.Alonzo as Alonzo
@@ -57,10 +64,6 @@ import Cardano.Mock.Forging.Types (
5764
TxEra (..),
5865
UTxOIndex (..),
5966
)
60-
import Control.Monad (void)
61-
import qualified Data.Map as Map
62-
import Data.Text (Text)
63-
import Ouroboros.Consensus.Cardano.Block (StandardAlonzo)
6467
import Test.Cardano.Db.Mock.Config (alonzoConfigDir, startDBSync, withFullConfig, withFullConfigDropDb)
6568
import Test.Cardano.Db.Mock.UnifiedApi (
6669
fillUntilNextEpoch,
@@ -75,7 +78,6 @@ import Test.Cardano.Db.Mock.Validate (
7578
assertEqQuery,
7679
assertScriptCert,
7780
)
78-
import Test.Tasty.HUnit (Assertion)
7981

8082
----------------------------------------------------------------------------------------------------------
8183
-- Plutus Spend Scripts

‎cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Simple.hs

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -5,18 +5,20 @@ module Test.Cardano.Db.Mock.Unit.Alonzo.Simple (
55
restartDBSync,
66
) where
77

8+
import Data.Text (Text)
9+
import Control.Monad (void)
10+
import Control.Concurrent.Class.MonadSTM.Strict (MonadSTM (atomically))
11+
import Test.Tasty.HUnit (Assertion, assertBool)
12+
813
import Cardano.Ledger.BaseTypes (BlockNo (BlockNo))
14+
import Ouroboros.Network.Block (blockNo)
15+
916
import Cardano.Mock.ChainSync.Server (IOManager, addBlock)
1017
import Cardano.Mock.Forging.Interpreter (forgeNext)
11-
import Control.Concurrent.Class.MonadSTM.Strict (MonadSTM (atomically))
12-
import Control.Monad (void)
13-
import Data.Text (Text)
14-
import Ouroboros.Network.Block (blockNo)
1518
import Test.Cardano.Db.Mock.Config (alonzoConfigDir, startDBSync, stopDBSync, withFullConfig, withFullConfigDropDb)
1619
import Test.Cardano.Db.Mock.Examples (mockBlock0, mockBlock1, mockBlock2)
1720
import Test.Cardano.Db.Mock.UnifiedApi (forgeNextAndSubmit)
1821
import Test.Cardano.Db.Mock.Validate (assertBlockNoBackoff)
19-
import Test.Tasty.HUnit (Assertion, assertBool)
2022

2123
forgeBlocks :: IOManager -> [(Text, Text)] -> Assertion
2224
forgeBlocks = do

‎cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Plutus.hs

Lines changed: 12 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -30,11 +30,12 @@ module Test.Cardano.Db.Mock.Unit.Babbage.Plutus (
3030
swapMultiAssets,
3131
) where
3232

33+
import Test.Tasty.HUnit (Assertion)
34+
import Control.Monad (void)
35+
import qualified Data.Map as Map
36+
import Data.Text (Text)
37+
3338
import qualified Cardano.Crypto.Hash as Crypto
34-
import qualified Cardano.Db as DB
35-
import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA
36-
import qualified Cardano.Db.Schema.Variants.TxOutCore as VC
37-
import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress)
3839
import Cardano.Ledger.Coin
3940
import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..), PolicyID (..))
4041
import Cardano.Ledger.Plutus.Data (hashData)
@@ -50,6 +51,9 @@ import Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples (
5051
assetNames,
5152
plutusDataList,
5253
)
54+
import Ouroboros.Consensus.Cardano.Block (StandardBabbage)
55+
import Ouroboros.Network.Block (genesisPoint)
56+
5357
import qualified Cardano.Mock.Forging.Tx.Babbage as Babbage
5458
import Cardano.Mock.Forging.Types (
5559
MockBlock (..),
@@ -58,11 +62,6 @@ import Cardano.Mock.Forging.Types (
5862
TxEra (..),
5963
UTxOIndex (..),
6064
)
61-
import Control.Monad (void)
62-
import qualified Data.Map as Map
63-
import Data.Text (Text)
64-
import Ouroboros.Consensus.Cardano.Block (StandardBabbage)
65-
import Ouroboros.Network.Block (genesisPoint)
6665
import Test.Cardano.Db.Mock.Config (babbageConfigDir, startDBSync, txOutVariantTypeFromConfig, withFullConfig, withFullConfigDropDb)
6766
import Test.Cardano.Db.Mock.UnifiedApi (
6867
fillUntilNextEpoch,
@@ -80,7 +79,10 @@ import Test.Cardano.Db.Mock.Validate (
8079
assertNonZeroFeesContract,
8180
assertScriptCert,
8281
)
83-
import Test.Tasty.HUnit (Assertion)
82+
import qualified Cardano.Db as DB
83+
import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA
84+
import qualified Cardano.Db.Schema.Variants.TxOutCore as VC
85+
import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress)
8486

8587
----------------------------------------------------------------------------------------------------------
8688
-- Plutus Spend Scripts

‎cardano-db-sync/app/test-http-get-json-metadata.hs

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -53,14 +53,12 @@ main = do
5353

5454
-------------------------------------------------------------------------------------------------
5555

56-
-- Keep all the data types the same
5756
data TestOffChain = TestOffChain
5857
{ toTicker :: !Text
5958
, toUrl :: !DB.PoolUrl
6059
, toHash :: !DB.PoolMetaHash
6160
}
6261

63-
-- Keep all the error handling types and functions the same
6462
data TestFailure = TestFailure
6563
{ tfHashMismatch :: !Word
6664
, tfDataTooLong :: !Word
@@ -129,6 +127,3 @@ reportTestFailures tf = do
129127
, " Timeout : " ++ show (tfTimeout tf)
130128
, " ConnectionFailure : " ++ show (tfConnectionFailure tf)
131129
]
132-
133-
-- reportTestOffChain :: TestOffChain -> IO ()
134-
-- reportTestOffChain tof = Text.putStrLn $ mconcat [ toTicker tof, " ", unPoolUrl (toUrl tof) ]

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

Lines changed: 23 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ module Cardano.DbSync (
1515
LedgerStateDir (..),
1616
NetworkName (..),
1717
SocketPath (..),
18-
Db.MigrationDir (..),
18+
DB.MigrationDir (..),
1919
runDbSyncNode,
2020
runMigrationsOnly,
2121
runDbSync,
@@ -40,8 +40,10 @@ import Prelude (id)
4040

4141
import Cardano.BM.Trace (Trace, logError, logInfo, logWarning)
4242
import qualified Cardano.Crypto as Crypto
43+
import Cardano.Prelude hiding (Nat, (%))
44+
import Cardano.Slotting.Slot (EpochNo (..))
45+
4346
import qualified Cardano.Db as DB
44-
import qualified Cardano.Db as Db
4547
import Cardano.DbSync.Api
4648
import Cardano.DbSync.Api.Types (InsertOptions (..), RunMigration, SyncEnv (..), SyncOptions (..), envLedgerEnv)
4749
import Cardano.DbSync.Config (configureLogging)
@@ -57,8 +59,6 @@ import Cardano.DbSync.Rollback (unsafeRollback)
5759
import Cardano.DbSync.Sync (runSyncNodeClient)
5860
import Cardano.DbSync.Tracing.ToObjectOrphans ()
5961
import Cardano.DbSync.Types
60-
import Cardano.Prelude hiding (Nat, (%))
61-
import Cardano.Slotting.Slot (EpochNo (..))
6262

6363
runDbSyncNode :: MetricSetters -> [(Text, Text)] -> SyncNodeParams -> SyncNodeConfig -> IO ()
6464
runDbSyncNode metricsSetters knownMigrations params syncNodeConfigFromFile =
@@ -84,25 +84,24 @@ runMigrationsOnly knownMigrations trce params syncNodeConfigFromFile = do
8484
logInfo trce $ textShow syncOpts
8585

8686
-- Read the PG connection info
87-
pgConfig <- runOrThrowIO (Db.readPGPass $ enpPGPassSource params)
87+
pgConfig <- runOrThrowIO (DB.readPGPass $ enpPGPassSource params)
8888

89-
mErrors <- liftIO $ Db.validateMigrations dbMigrationDir knownMigrations
89+
mErrors <- liftIO $ DB.validateMigrations dbMigrationDir knownMigrations
9090
whenJust mErrors $ \(unknown, stage4orNewStage3) ->
9191
if stage4orNewStage3
92-
then logWarning trce $ Db.renderMigrationValidateError unknown
93-
else logError trce $ Db.renderMigrationValidateError unknown
92+
then logWarning trce $ DB.renderMigrationValidateError unknown
93+
else logError trce $ DB.renderMigrationValidateError unknown
9494

9595
logInfo trce "Schema migration files validated"
9696

9797
let runMigration mode = do
98-
msg <- Db.getMaintenancePsqlConf pgConfig
98+
msg <- DB.getMaintenancePsqlConf pgConfig
9999
logInfo trce $ "Running database migrations in mode " <> textShow mode
100100
logInfo trce msg
101-
-- No index warning here - runMigrationsOnly never runs indexes
102-
Db.runMigrations pgConfig True dbMigrationDir (Just $ Db.LogFileDir "/tmp") mode (txOutConfigToTableType txOutConfig)
101+
DB.runMigrations pgConfig True dbMigrationDir (Just $ DB.LogFileDir "/tmp") mode (txOutConfigToTableType txOutConfig)
103102

104103
-- Always run Initial mode only - never indexes
105-
(ranMigrations, unofficial) <- runMigration Db.Initial
104+
(ranMigrations, unofficial) <- runMigration DB.Initial
106105
unless (null unofficial) $
107106
logWarning trce $
108107
"Unofficial migration scripts found: "
@@ -114,7 +113,7 @@ runMigrationsOnly knownMigrations trce params syncNodeConfigFromFile = do
114113

115114
logInfo trce "New user indexes were not created. They may be created later if necessary."
116115
where
117-
dbMigrationDir :: Db.MigrationDir
116+
dbMigrationDir :: DB.MigrationDir
118117
dbMigrationDir = enpMigrationDir params
119118
syncOpts = extractSyncOptions params False syncNodeConfigFromFile
120119
txOutConfig = sioTxOut $ dncInsertOptions syncNodeConfigFromFile
@@ -132,9 +131,9 @@ runDbSync metricsSetters iomgr trce params syncNodeConfigFromFile abortOnPanic =
132131
logInfo trce $ textShow syncOpts
133132

134133
-- Read the PG connection info
135-
pgConfig <- runOrThrowIO (Db.readPGPass $ enpPGPassSource params)
134+
pgConfig <- runOrThrowIO (DB.readPGPass $ enpPGPassSource params)
136135

137-
dbConnectionSetting <- case Db.toConnectionSetting pgConfig of
136+
dbConnectionSetting <- case DB.toConnectionSetting pgConfig of
138137
Left err -> do
139138
let syncNodeErr = SNErrPGConfig ("Invalid database connection setting: " <> err)
140139
logError trce $ show syncNodeErr
@@ -147,11 +146,11 @@ runDbSync metricsSetters iomgr trce params syncNodeConfigFromFile abortOnPanic =
147146

148147
-- This runMigration is ONLY for delayed migrations during sync (like indexes)
149148
let runDelayedMigration mode = do
150-
msg <- Db.getMaintenancePsqlConf pgConfig
149+
msg <- DB.getMaintenancePsqlConf pgConfig
151150
logInfo trce $ "Running database migrations in mode " <> textShow mode
152151
logInfo trce msg
153-
when (mode `elem` [Db.Indexes, Db.Full]) $ logWarning trce indexesMsg
154-
Db.runMigrations pgConfig True dbMigrationDir (Just $ Db.LogFileDir "/tmp") mode (txOutConfigToTableType txOutConfig)
152+
when (mode `elem` [DB.Indexes, DB.Full]) $ logWarning trce indexesMsg
153+
DB.runMigrations pgConfig True dbMigrationDir (Just $ DB.LogFileDir "/tmp") mode (txOutConfigToTableType txOutConfig)
155154

156155
runSyncNode
157156
metricsSetters
@@ -163,7 +162,7 @@ runDbSync metricsSetters iomgr trce params syncNodeConfigFromFile abortOnPanic =
163162
params
164163
syncOpts
165164
where
166-
dbMigrationDir :: Db.MigrationDir
165+
dbMigrationDir :: DB.MigrationDir
167166
dbMigrationDir = enpMigrationDir params
168167
syncOpts = extractSyncOptions params abortOnPanic syncNodeConfigFromFile
169168
txOutConfig = sioTxOut $ dncInsertOptions syncNodeConfigFromFile
@@ -198,7 +197,7 @@ runSyncNode metricsSetters trce iomgr dbConnSetting runDelayedMigrationFnc syncN
198197
logInfo trce $ "Using alonzo genesis file from: " <> (show . unGenesisFile $ dncAlonzoGenesisFile syncNodeConfigFromFile)
199198

200199
let useLedger = shouldUseLedger (sioLedger $ dncInsertOptions syncNodeConfigFromFile)
201-
-- Our main thread
200+
-- The main thread
202201
bracket
203202
(acquireDbConnection [dbConnSetting])
204203
HsqlC.release
@@ -207,8 +206,8 @@ runSyncNode metricsSetters trce iomgr dbConnSetting runDelayedMigrationFnc syncN
207206
let isLogingEnabled = dncEnableDbLogging syncNodeConfigFromFile
208207
dbEnv =
209208
if isLogingEnabled
210-
then Db.DbEnv dbConn isLogingEnabled (Just trce)
211-
else Db.DbEnv dbConn isLogingEnabled Nothing
209+
then DB.DbEnv dbConn isLogingEnabled (Just trce)
210+
else DB.DbEnv dbConn isLogingEnabled Nothing
212211
genCfg <- readCardanoGenesisConfig syncNodeConfigFromFile
213212
isJsonbInSchema <- liftDbError $ DB.queryJsonbInSchemaExists dbConn
214213
logProtocolMagicId trce $ genesisProtocolMagicId genCfg
@@ -235,7 +234,7 @@ runSyncNode metricsSetters trce iomgr dbConnSetting runDelayedMigrationFnc syncN
235234
liftIO $ runConsumedTxOutMigrationsMaybe syncEnv
236235
unless useLedger $ liftIO $ do
237236
logInfo trce "Migrating to a no ledger schema"
238-
Db.noLedgerMigrations dbEnv trce
237+
DB.noLedgerMigrations dbEnv trce
239238
insertValidateGenesisDist syncEnv (dncNetworkName syncNodeConfigFromFile) genCfg (useShelleyInit syncNodeConfigFromFile)
240239

241240
-- communication channel between datalayer thread and chainsync-client thread
@@ -335,7 +334,7 @@ extractSyncOptions snp aop snc =
335334
startupReport :: Trace IO Text -> Bool -> SyncNodeParams -> IO ()
336335
startupReport trce aop params = do
337336
logInfo trce $ mconcat ["Version number: ", Text.pack (showVersion version)]
338-
logInfo trce $ mconcat ["Git hash: ", Db.gitRev]
337+
logInfo trce $ mconcat ["Git hash: ", DB.gitRev]
339338
logInfo trce $ mconcat ["Enviroment variable DbSyncAbortOnPanic: ", textShow aop]
340339
logInfo trce $ textShow params
341340

0 commit comments

Comments
 (0)