Integrate new migrations into the db layer inmemory operations.

cardano-foundation · Jun 5, 2023 · 00e2ea3 · 00e2ea3
1 parent 5c7df39
commit 00e2ea3
Show file tree

Hide file tree

Showing 5 changed files with 37 additions and 28 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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