[ADP-3058] Implement MigrationInterface for SQLite

lib/wallet/api/http/Cardano/Wallet/Shelley.hs

@@ -58,7 +58,7 @@ import Cardano.Wallet.Api.Http.Shelley.Server
     )
 import Cardano.Wallet.DB.Layer
     ( PersistAddressBook )
-import Cardano.Wallet.DB.Sqlite.Migration
+import Cardano.Wallet.DB.Sqlite.MigrationOld
     ( DefaultFieldValues (..) )
 import Cardano.Wallet.Flavor
     ( CredFromOf, KeyFlavorS (..), KeyOf, WalletFlavor (..) )

lib/wallet/bench/restore-bench.hs

@@ -242,7 +242,7 @@ import qualified Cardano.Wallet as W
 import qualified Cardano.Wallet.Address.Derivation.Byron as Byron
 import qualified Cardano.Wallet.Address.Derivation.Shelley as Shelley
 import qualified Cardano.Wallet.Checkpoints.Policy as CP
-import qualified Cardano.Wallet.DB.Sqlite.Migration as Sqlite
+import qualified Cardano.Wallet.DB.Sqlite.MigrationOld as Sqlite
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO
 import qualified Cardano.Wallet.Primitive.Types.UTxOStatistics as UTxOStatistics

lib/wallet/cardano-wallet.cabal

@@ -262,7 +262,8 @@ library
     Cardano.Wallet.DB.Migration
     Cardano.Wallet.DB.Pure.Implementation
     Cardano.Wallet.DB.Pure.Layer
-    Cardano.Wallet.DB.Sqlite.Migration
+    Cardano.Wallet.DB.Sqlite.MigrationNew
+    Cardano.Wallet.DB.Sqlite.MigrationOld
     Cardano.Wallet.DB.Sqlite.Schema
     Cardano.Wallet.DB.Sqlite.Types
     Cardano.Wallet.DB.Store.Checkpoints.Store

lib/wallet/src/Cardano/Wallet/DB/Layer.hs

@@ -82,7 +82,7 @@ import Cardano.Wallet.DB
     , mkDBLayerFromParts
     , transactionsStore
     )
-import Cardano.Wallet.DB.Sqlite.Migration
+import Cardano.Wallet.DB.Sqlite.MigrationOld
     ( DefaultFieldValues (..), migrateManually )
 import Cardano.Wallet.DB.Sqlite.Schema
     ( CBOR (..)

lib/wallet/src/Cardano/Wallet/DB/Sqlite/MigrationNew.hs

@@ -0,0 +1,47 @@
+module Cardano.Wallet.DB.Sqlite.MigrationNew (newMigrationInterface) where
+
+import Prelude
+
+import Cardano.DB.Sqlite
+    ( DBLog, withConnectionPool )
+import Cardano.Wallet.DB.Migration
+    ( MigrationInterface (..), Version )
+import Cardano.Wallet.DB.Sqlite.MigrationOld
+    ( getSchemaVersion, putSchemaVersion )
+import Control.Tracer
+    ( Tracer )
+import Data.Pool
+    ( withResource )
+import System.Directory
+    ( copyFile )
+
+import qualified Cardano.Wallet.DB.Sqlite.MigrationOld as MigrateOld
+import qualified Database.Sqlite as Sqlite
+
+newMigrationInterface
+    :: Tracer IO DBLog
+    -> MigrationInterface IO Sqlite.Connection
+newMigrationInterface tr =
+    MigrationInterface
+        { backupDatabaseFile = \fp v -> do
+            let backupFile = fp <> ".v" <> show v <> ".bak"
+            copyFile fp backupFile
+        , withDatabaseFile = \fp f -> do
+            withConnectionPool tr fp $ \pool ->
+                withResource pool $ \(_, conn) -> do
+                    f conn
+        , getVersion = getVersionNew
+        , setVersion = setVersionNew
+        }
+
+oldToNewSchemaVersion :: MigrateOld.SchemaVersion -> Version
+oldToNewSchemaVersion (MigrateOld.SchemaVersion v) = v
+
+newToOldSchemaVersion :: Version -> MigrateOld.SchemaVersion
+newToOldSchemaVersion = MigrateOld.SchemaVersion
+
+getVersionNew :: Sqlite.Connection -> IO Version
+getVersionNew = fmap oldToNewSchemaVersion . getSchemaVersion
+
+setVersionNew :: Sqlite.Connection -> Version -> IO ()
+setVersionNew conn = putSchemaVersion conn . newToOldSchemaVersion

lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration.hs → lib/wallet/src/Cardano/Wallet/DB/Sqlite/MigrationOld.hs

@@ -15,12 +15,14 @@
 -- These migrations are soon to be removed in favor of
 -- a file format with version number.
 
-module Cardano.Wallet.DB.Sqlite.Migration
+module Cardano.Wallet.DB.Sqlite.MigrationOld
     ( DefaultFieldValues (..)
     , migrateManually
     , SchemaVersion (..)
     , currentSchemaVersion
     , InvalidDatabaseSchemaVersion (..)
+    , putSchemaVersion
+    , getSchemaVersion
     )
     where
 
@@ -182,23 +184,7 @@ migrateManually tr key defaultFieldValues =
             \)"
            _ -> pure TableExisted
 
-    putSchemaVersion :: Sqlite.Connection -> SchemaVersion -> IO ()
-    putSchemaVersion conn schemaVersion = void $ runSql conn $ T.unwords
-        [ "INSERT INTO database_schema_version (name, version)"
-        , "VALUES ('schema',"
-        , version
-        , ") ON CONFLICT (name) DO UPDATE SET version ="
-        , version
-        ]
-      where
-        version = T.pack $ show schemaVersion
 
-    getSchemaVersion :: Sqlite.Connection -> IO SchemaVersion
-    getSchemaVersion conn =
-        runSql conn "SELECT version FROM database_schema_version" >>= \case
-            [[PersistInt64 int]] | int >= 0 -> pure $ SchemaVersion
-                $ fromIntegral int
-            _ -> throwString "Database metadata table is corrupt"
 
     -- NOTE
     -- We originally stored script pool gap inside sequential state in the 'SeqState' table,
@@ -942,3 +928,21 @@ runSql conn raw = do
                 collect query (result : acc)
             Sqlite.Done -> do
                 return (reverse acc)
+
+putSchemaVersion :: Sqlite.Connection -> SchemaVersion -> IO ()
+putSchemaVersion conn schemaVersion = void $ runSql conn $ T.unwords
+    [ "INSERT INTO database_schema_version (name, version)"
+    , "VALUES ('schema',"
+    , version
+    , ") ON CONFLICT (name) DO UPDATE SET version ="
+    , version
+    ]
+    where
+    version = T.pack $ show schemaVersion
+
+getSchemaVersion :: Sqlite.Connection -> IO SchemaVersion
+getSchemaVersion conn =
+    runSql conn "SELECT version FROM database_schema_version" >>= \case
+        [[PersistInt64 int]] | int >= 0 -> pure $ SchemaVersion
+            $ fromIntegral int
+        _ -> throwString "Database metadata table is corrupt"

lib/wallet/test/unit/Cardano/Wallet/DB/LayerSpec.hs

@@ -95,7 +95,7 @@ import Cardano.Wallet.DB.Layer
     )
 import Cardano.Wallet.DB.Properties
     ( properties )
-import Cardano.Wallet.DB.Sqlite.Migration
+import Cardano.Wallet.DB.Sqlite.MigrationOld
     ( InvalidDatabaseSchemaVersion (..)
     , SchemaVersion (..)
     , currentSchemaVersion