From 00e2ea3e4e96d913263e22910b1ec4bece493fa6 Mon Sep 17 00:00:00 2001 From: paolino Date: Sun, 4 Jun 2023 08:36:41 +0000 Subject: [PATCH] Integrate new migrations into the db layer inmemory operations. --- lib/wallet/src/Cardano/DB/Sqlite.hs | 9 +++-- lib/wallet/src/Cardano/Pool/DB/Sqlite.hs | 7 +++- lib/wallet/src/Cardano/Wallet/DB/Layer.hs | 5 ++- .../Cardano/Wallet/DB/Sqlite/MigrationNew.hs | 40 +++++++++---------- .../test/unit/Cardano/Wallet/DB/Fixtures.hs | 4 +- 5 files changed, 37 insertions(+), 28 deletions(-) diff --git a/lib/wallet/src/Cardano/DB/Sqlite.hs b/lib/wallet/src/Cardano/DB/Sqlite.hs index 287c7c33b68..e74eec43e01 100644 --- a/lib/wallet/src/Cardano/DB/Sqlite.hs +++ b/lib/wallet/src/Cardano/DB/Sqlite.hs @@ -119,7 +119,7 @@ import Database.Persist.Sql import Database.Persist.Sqlite ( SqlBackend, wrapConnection ) import Database.Sqlite - ( Error (ErrorConstraint), SqliteException (SqliteException) ) + ( Connection, Error (ErrorConstraint), SqliteException (SqliteException) ) import Fmt ( fmt, ordinalF, (+|), (+||), (|+), (||+) ) import GHC.Generics @@ -171,14 +171,17 @@ newInMemorySqliteContext :: Tracer IO DBLog -> [ManualMigration] -> Migration + -> (Connection -> IO ()) -- ^ New style migrations -> ForeignKeysSetting -> IO (IO (), SqliteContext) -newInMemorySqliteContext tr manualMigrations autoMigration disableFK = do +newInMemorySqliteContext tr manualMigrations autoMigration newMigrations + disableFK = do conn <- Sqlite.open ":memory:" mapM_ (`executeManualMigration` conn) manualMigrations unsafeBackend <- wrapConnection conn (queryLogFunc tr) void $ runSqlConn (runMigrationUnsafeQuiet autoMigration) unsafeBackend - + newMigrations conn + -- runMigrations (newMigrationInterfaceInMemory let observe :: forall a. IO a -> IO a observe = bracketTracer (contramap MsgRun tr) diff --git a/lib/wallet/src/Cardano/Pool/DB/Sqlite.hs b/lib/wallet/src/Cardano/Pool/DB/Sqlite.hs index f713e9ae70d..bc7d1207e4e 100644 --- a/lib/wallet/src/Cardano/Pool/DB/Sqlite.hs +++ b/lib/wallet/src/Cardano/Pool/DB/Sqlite.hs @@ -59,6 +59,8 @@ import Cardano.Pool.Metadata.Types ( StakePoolMetadata (..), StakePoolMetadataHash ) import Cardano.Pool.Types ( PoolId (..) ) +import Cardano.Wallet.DB.Sqlite.MigrationNew + ( runInMemoryNewStyleMigrations ) import Cardano.Wallet.DB.Sqlite.Types ( BlockId (..), fromMaybeHash, toMaybeHash ) import Cardano.Wallet.Logging @@ -209,7 +211,10 @@ withDecoratedDBLayer dbDecorator tr mDatabaseDir ti action = do case mDatabaseDir of Nothing -> bracket (newInMemorySqliteContext tr' - createViews migrateAll ForeignKeysEnabled) + createViews migrateAll + runInMemoryNewStyleMigrations + ForeignKeysEnabled + ) fst (action . decorateDBLayer dbDecorator . newDBLayer tr ti . snd) diff --git a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs b/lib/wallet/src/Cardano/Wallet/DB/Layer.hs index b817c501635..b72f4c2cc6a 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Layer.hs @@ -82,6 +82,7 @@ import Cardano.Wallet.DB , mkDBLayerFromParts , transactionsStore ) +import Cardano.Wallet.DB.Sqlite.MigrationNew import Cardano.Wallet.DB.Sqlite.MigrationOld ( DefaultFieldValues (..), migrateManually ) import Cardano.Wallet.DB.Sqlite.Schema @@ -413,7 +414,9 @@ newDBOpenInMemory newDBOpenInMemory tr = do let tr' = contramap MsgDB tr (destroy, sqliteContext) <- - newInMemorySqliteContext tr' [] migrateAll ForeignKeysEnabled + newInMemorySqliteContext tr' [] migrateAll + runInMemoryNewStyleMigrations + ForeignKeysEnabled db <- newQueryLock sqliteContext pure (destroy, db) diff --git a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/MigrationNew.hs b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/MigrationNew.hs index e10defb472f..49d2601d4db 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/MigrationNew.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/MigrationNew.hs @@ -1,35 +1,21 @@ -module Cardano.Wallet.DB.Sqlite.MigrationNew - ( -- * Build migrations - Migration - , mkMigration - , VersionT - - -- * Run migrations - , Version - , MigrationInterface (..) - , runMigrations - , ErrWrongVersion (..) +{-# LANGUAGE DataKinds #-} - -- * interfaces - , newMigrationInterfaceInMemory +module Cardano.Wallet.DB.Sqlite.MigrationNew + ( runInMemoryNewStyleMigrations , newMigrationInterfaceFile ) where -import Prelude +import Prelude hiding + ( id ) import Cardano.DB.Sqlite ( DBLog, withConnectionPool ) import Cardano.Wallet.DB.Migration - ( ErrWrongVersion (..) - , Migration - , MigrationInterface (..) - , Version - , VersionT - , mkMigration - , runMigrations - ) + ( Migration, MigrationInterface (..), Version, runMigrations ) import Cardano.Wallet.DB.Sqlite.MigrationOld ( getSchemaVersion, putSchemaVersion ) +import Control.Category + ( id ) import Control.Tracer ( Tracer ) import Data.Pool @@ -78,3 +64,13 @@ getVersionNew = fmap oldToNewSchemaVersion . getSchemaVersion setVersionNew :: Sqlite.Connection -> Version -> IO () setVersionNew conn = putSchemaVersion conn . newToOldSchemaVersion + +noMigrations :: Migration m 2 2 +noMigrations = id + +runInMemoryNewStyleMigrations :: Sqlite.Connection -> IO () +runInMemoryNewStyleMigrations conn = + runMigrations + (newMigrationInterfaceInMemory conn) + () + noMigrations diff --git a/lib/wallet/test/unit/Cardano/Wallet/DB/Fixtures.hs b/lib/wallet/test/unit/Cardano/Wallet/DB/Fixtures.hs index 8e2a0dfc649..b06dce799a9 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/DB/Fixtures.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/DB/Fixtures.hs @@ -29,6 +29,8 @@ import Prelude import Cardano.DB.Sqlite ( ForeignKeysSetting, SqliteContext, newInMemorySqliteContext, runQuery ) +import Cardano.Wallet.DB.Sqlite.MigrationNew + ( runInMemoryNewStyleMigrations ) import Cardano.Wallet.DB.Sqlite.Schema ( Wallet (..), migrateAll ) import Cardano.Wallet.DB.Sqlite.Types @@ -75,7 +77,6 @@ import Test.QuickCheck.Monadic import UnliftIO.Exception ( bracket ) - import qualified Cardano.Wallet.DB.Sqlite.Schema as TH @@ -87,6 +88,7 @@ withDBInMemory disableFK action = bracket (newDBInMemory disableFK) fst (action newDBInMemory :: ForeignKeysSetting -> IO (IO (), SqliteContext) newDBInMemory = newInMemorySqliteContext nullTracer [] migrateAll + runInMemoryNewStyleMigrations initializeWallet :: WalletId -> SqlPersistT IO () initializeWallet wid = do