Implement MigrationInterface for on file DB.

cardano-foundation · Jun 4, 2023 · 5c7df39 · 5c7df39
1 parent 20ec1e5
commit 5c7df39
Showing 1 changed file with 34 additions and 3 deletions.
diff --git a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/MigrationNew.hs b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/MigrationNew.hs
@@ -10,12 +10,15 @@ module Cardano.Wallet.DB.Sqlite.MigrationNew
     , runMigrations
     , ErrWrongVersion (..)
 
-    -- * interfaces
+      -- * interfaces
     , newMigrationInterfaceInMemory
+    , newMigrationInterfaceFile
     ) where
 
 import Prelude
 
+import Cardano.DB.Sqlite
+    ( DBLog, withConnectionPool )
 import Cardano.Wallet.DB.Migration
     ( ErrWrongVersion (..)
     , Migration
@@ -27,6 +30,12 @@ import Cardano.Wallet.DB.Migration
     )
 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
@@ -38,12 +47,34 @@ newMigrationInterfaceInMemory conn =
     MigrationInterface
         { backupDatabaseFile = \_ _ -> pure ()
         , withDatabaseFile = \_ f -> f conn
-        , getVersion = fmap oldToNewSchemaVersion . getSchemaVersion
-        , setVersion = \conn' -> putSchemaVersion conn' . newToOldSchemaVersion
+        , getVersion = getVersionNew
+        , setVersion = setVersionNew
+        }
+
+newMigrationInterfaceFile
+    :: Tracer IO DBLog
+    -> MigrationInterface IO FilePath Sqlite.Connection
+newMigrationInterfaceFile 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