DB stores its schema version it a table

lib/core/src/Cardano/DB/Sqlite.hs

@@ -49,7 +49,6 @@ module Cardano.DB.Sqlite
 
     -- * Logging
     , DBLog (..)
-    , DatabaseMetadataLog (..)
     ) where
 
 import Prelude
@@ -58,8 +57,6 @@ import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Data.Tracer
     ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
-import Cardano.Wallet.DB.Sqlite.Types
-    ( DatabaseFileFormatVersion, naturalDatabaseFileFormat )
 import Cardano.Wallet.Logging
     ( BracketLog, bracketTracer )
 import Control.Monad
@@ -529,7 +526,6 @@ data DBLog
     | MsgManualMigrationNotNeeded DBField
     | MsgUpdatingForeignKeysSetting ForeignKeysSetting
     | MsgRetryOnBusy Int RetryLog
-    | MsgMetadata DatabaseMetadataLog
     deriving (Generic, Show, Eq, ToJSON)
 
 data RetryLog = MsgRetry | MsgRetryGaveUp | MsgRetryDone
@@ -557,7 +553,6 @@ instance HasSeverityAnnotation DBLog where
             | n <= 1 -> Debug
             | n <= 3 -> Notice
             | otherwise -> Warning
-        MsgMetadata dml -> getSeverityAnnotation dml
 
 instance ToText DBLog where
     toText = \case
@@ -616,30 +611,6 @@ instance ToText DBLog where
             MsgRetryDone
                 | n > 3 -> "DB query succeeded after " +| n |+ " attempts."
                 | otherwise -> ""
-        MsgMetadata msg -> toText msg
-
-data DatabaseMetadataLog
-    = DatabaseMetadataCreated
-    | DatabaseVersionSet DatabaseFileFormatVersion
-    | DatabaseVersionMatched DatabaseFileFormatVersion
-    deriving (Generic, Show, Eq, ToJSON)
-
-instance HasSeverityAnnotation DatabaseMetadataLog where
-    getSeverityAnnotation = \case
-        DatabaseMetadataCreated -> Notice
-        DatabaseVersionSet _version -> Notice
-        DatabaseVersionMatched _version -> Notice
-
-instance ToText DatabaseMetadataLog where
-    toText = \case
-        DatabaseMetadataCreated ->
-            "Database metadata table created"
-        DatabaseVersionSet ver ->
-            "Database file format version set to " <> showVersion ver
-        DatabaseVersionMatched ver ->
-            "Database file format version matches expected: " <> showVersion ver
-      where
-        showVersion = T.pack . show . naturalDatabaseFileFormat
 
 -- | Produce a persistent 'LogFunc' backed by 'Tracer IO DBLog'
 queryLogFunc :: Tracer IO DBLog -> LogFunc

lib/core/src/Cardano/Wallet/DB/Sqlite/Migration.hs

@@ -1,8 +1,9 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeApplications #-}
 
 -- |
@@ -16,6 +17,8 @@
 module Cardano.Wallet.DB.Sqlite.Migration
     ( DefaultFieldValues (..)
     , migrateManually
+    , SchemaVersion (..)
+    , currentSchemaVersion
     , InvalidDatabaseSchemaVersion (..)
     )
     where
@@ -25,16 +28,13 @@ import Prelude
 import Cardano.DB.Sqlite
     ( DBField (..)
     , DBLog (..)
-    , DatabaseMetadataLog (..)
     , ManualMigration (..)
     , fieldName
     , fieldType
     , tableName
     )
 import Cardano.Wallet.DB.Sqlite.TH
     ( EntityField (..) )
-import Cardano.Wallet.DB.Sqlite.Types
-    ( DatabaseFileFormatVersion (..) )
 import Cardano.Wallet.Primitive.AddressDerivation.Icarus
     ( IcarusKey )
 import Cardano.Wallet.Primitive.AddressDerivation.Shelley
@@ -59,6 +59,8 @@ import Database.Persist.Class
     ( toPersistValue )
 import Database.Persist.Types
     ( PersistValue (..), fromPersistValueText )
+import Numeric.Natural
+    ( Natural )
 import UnliftIO.Exception
     ( Exception, throwIO, throwString )
 
@@ -96,18 +98,18 @@ data TableCreationResult
     = TableCreated
     | TableExisted
 
-newtype DatabaseMetadata
-    = DatabaseMetadata { fileFormatVersion :: DatabaseFileFormatVersion }
+newtype SchemaVersion = SchemaVersion Natural
+  deriving newtype (Eq, Ord, Read, Show )
 
 data InvalidDatabaseSchemaVersion
     = InvalidDatabaseSchemaVersion
-    { expectedVersion :: DatabaseFileFormatVersion
-    , actualVersion :: DatabaseFileFormatVersion
+    { expectedVersion :: SchemaVersion
+    , actualVersion :: SchemaVersion
     }
     deriving (Show, Eq, Exception)
 
-currentFileFormat :: DatabaseFileFormatVersion
-currentFileFormat = DatabaseFileFormatVersion 1
+currentSchemaVersion :: SchemaVersion
+currentSchemaVersion = SchemaVersion 1
 
 -- | Executes any manual database migration steps that may be required on
 -- startup.
@@ -119,7 +121,7 @@ migrateManually
     -> [ManualMigration]
 migrateManually tr proxy defaultFieldValues =
     ManualMigration <$>
-    [ initializeDatabaseMetadataTable
+    [ initializeSchemaVersionTable
     , cleanupCheckpointTable
     , assignDefaultPassphraseScheme
     , addDesiredPoolNumberIfMissing
@@ -143,58 +145,49 @@ migrateManually tr proxy defaultFieldValues =
     , cleanupSeqStateTable
     ]
   where
-    initializeDatabaseMetadataTable :: Sqlite.Connection -> IO ()
-    initializeDatabaseMetadataTable conn =
-        createMetadataTableIfMissing conn >>= \case
-            TableCreated -> do
-                trace DatabaseMetadataCreated
-                putMetadata conn DatabaseMetadata
-                    { fileFormatVersion = currentFileFormat }
+    initializeSchemaVersionTable :: Sqlite.Connection -> IO ()
+    initializeSchemaVersionTable conn =
+        createSchemaVersionTableIfMissing conn >>= \case
+            TableCreated -> putSchemaVersion conn currentSchemaVersion
             TableExisted -> do
-                DatabaseMetadata {..} <- getMetadata conn
-                when (fileFormatVersion > currentFileFormat) do
-                    throwIO InvalidDatabaseSchemaVersion
-                        { expectedVersion = currentFileFormat
-                        , actualVersion = fileFormatVersion
+                schemaVersion <- getSchemaVersion conn
+                case compare schemaVersion currentSchemaVersion of
+                    GT -> throwIO InvalidDatabaseSchemaVersion
+                        { expectedVersion = currentSchemaVersion
+                        , actualVersion = schemaVersion
                         }
-                trace $ DatabaseVersionMatched fileFormatVersion
-                putMetadata conn DatabaseMetadata{..}
-      where
-        trace = traceWith tr . MsgMetadata
+                    LT -> putSchemaVersion conn currentSchemaVersion
+                    EQ -> pure ()
 
-    createMetadataTableIfMissing :: Sqlite.Connection -> IO TableCreationResult
-    createMetadataTableIfMissing conn = do
+    createSchemaVersionTableIfMissing ::
+        Sqlite.Connection -> IO TableCreationResult
+    createSchemaVersionTableIfMissing conn = do
         res <- runSql conn
             "SELECT name FROM sqlite_master \
-            \WHERE type='table' AND name='database_metadata'"
+            \WHERE type='table' AND name='database_schema_version'"
         case res of
            [] -> TableCreated <$ runSql conn
-            "CREATE TABLE database_metadata\
+            "CREATE TABLE database_schema_version\
             \( name TEXT PRIMARY KEY \
             \, version INTEGER NOT NULL \
             \)"
            _ -> pure TableExisted
 
-    putMetadata :: Sqlite.Connection -> DatabaseMetadata -> IO ()
-    putMetadata conn DatabaseMetadata {..} = do
-        traceWith tr $ MsgMetadata $ DatabaseVersionSet fileFormatVersion
-        void $ runSql conn $ mconcat
-            [ "INSERT INTO database_metadata (name, version) "
-            , "VALUES "
-            , "('metadata', "
-            , version
-            , ") ON CONFLICT (name) DO UPDATE SET version = "
-            , version
-            ]
-        where
-            version = T.pack . show $
-                naturalDatabaseFileFormat fileFormatVersion
-
-    getMetadata :: Sqlite.Connection -> IO DatabaseMetadata
-    getMetadata conn =
-        runSql conn "SELECT version FROM database_metadata" >>= \case
-            [[PersistInt64 i]] | i >= 0 ->
-                pure DatabaseMetadata { fileFormatVersion = fromIntegral i }
+    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 i]] | i >= 0 -> pure $ SchemaVersion $ fromIntegral i
             _ -> throwString "Database metadata table is corrupt"
 
     -- NOTE

lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -128,10 +127,6 @@ import GHC.Generics
     ( Generic )
 import Network.URI
     ( parseAbsoluteURI )
-import Numeric.Natural
-    ( Natural )
-import Quiet
-    ( Quiet (..) )
 import System.Random.Internal
     ( StdGen (..) )
 import System.Random.SplitMix
@@ -863,10 +858,3 @@ newtype EitherText a = EitherText { getEitherText :: Either Text a }
 
 instance MonadFail EitherText where
     fail = EitherText . Left . T.pack
-
-newtype DatabaseFileFormatVersion = DatabaseFileFormatVersion
-    { naturalDatabaseFileFormat :: Natural }
-    deriving stock Generic
-    deriving newtype (Eq, Ord, Enum, Num, Real, Integral, ToJSON)
-    deriving Show via (Quiet DatabaseFileFormatVersion)
-

lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs

@@ -48,13 +48,7 @@ import Cardano.BM.Trace
 import Cardano.Crypto.Wallet
     ( XPrv )
 import Cardano.DB.Sqlite
-    ( DBField
-    , DBLog (..)
-    , DatabaseMetadataLog (..)
-    , SqliteContext
-    , fieldName
-    , newInMemorySqliteContext
-    )
+    ( DBField, DBLog (..), SqliteContext, fieldName, newInMemorySqliteContext )
 import Cardano.Mnemonic
     ( SomeMnemonic (..) )
 import Cardano.Wallet.DB
@@ -73,9 +67,10 @@ import Cardano.Wallet.DB.Sqlite
     , withDBLayerInMemory
     )
 import Cardano.Wallet.DB.Sqlite.Migration
-    ( InvalidDatabaseSchemaVersion (..) )
-import Cardano.Wallet.DB.Sqlite.Types
-    ( DatabaseFileFormatVersion (..) )
+    ( InvalidDatabaseSchemaVersion (..)
+    , SchemaVersion (..)
+    , currentSchemaVersion
+    )
 import Cardano.Wallet.DB.StateMachine
     ( TestConstraints, prop_parallel, prop_sequential, validateGenerators )
 import Cardano.Wallet.DummyTarget.Primitive.Types
@@ -1264,25 +1259,28 @@ testMigrationPassphraseScheme = do
 
 testCreateMetadataTable ::
     forall s k. (k ~ ShelleyKey, s ~ SeqState 'Mainnet k) => IO ()
-testCreateMetadataTable = do
-    (logs, _) <- captureLogging $ \tr ->
-        withDBLayer @s @k tr defaultFieldValues ":memory:" dummyTimeInterpreter
-            (const $ pure ())
-    [ l | MsgDB (MsgMetadata l) <- logs ] `shouldBe`
-        [ DatabaseMetadataCreated
-        , DatabaseVersionSet (DatabaseFileFormatVersion 1)
-        ]
+testCreateMetadataTable = withSystemTempFile "db.sql" $ \path _ -> do
+    let noop _ = pure ()
+        tr = nullTracer
+    withDBLayer @s @k tr defaultFieldValues path dummyTimeInterpreter noop
+    actualVersion <- Sqlite.runSqlite (T.pack path) $ do
+        [Sqlite.Single (version :: Int)] <- Sqlite.rawSql
+            "SELECT version FROM database_schema_version \
+            \WHERE name = 'schema'" []
+        pure $ SchemaVersion $ fromIntegral version
+    actualVersion `shouldBe` currentSchemaVersion
 
 testNewerDatabaseIsNeverModified ::
     forall s k. (k ~ ShelleyKey, s ~ SeqState 'Mainnet k) => IO ()
 testNewerDatabaseIsNeverModified = withSystemTempFile "db.sql" $ \path _ -> do
-    let newerVersion = DatabaseFileFormatVersion 100
-        currentVersion = DatabaseFileFormatVersion 1
+    let newerVersion = SchemaVersion 100
+        currentVersion = SchemaVersion 1
     _ <- Sqlite.runSqlite (T.pack path) $ do
-        Sqlite.rawExecute "CREATE TABLE database_metadata (name, version)" []
+        Sqlite.rawExecute
+            "CREATE TABLE database_schema_version (name, version)" []
         Sqlite.rawExecute (
-            let v = T.pack . show $ naturalDatabaseFileFormat newerVersion
-            in "INSERT INTO database_metadata VALUES ('metadata', " <> v <> ")"
+            "INSERT INTO database_schema_version \
+            \VALUES ('schema', " <> T.pack (show newerVersion) <> ")"
             ) []
     let noop _ = pure ()
         tr = nullTracer