database version is stored in the metadata table

cardano-foundation · Feb 4, 2022 · 187839e · 187839e
1 parent 9871125
commit 187839e
Show file tree

Hide file tree

Showing 3 changed files with 76 additions and 27 deletions.
diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/Migration.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/Migration.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeApplications #-}
 
 -- |
@@ -28,6 +30,8 @@ import Cardano.DB.Sqlite
     )
 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
@@ -52,6 +56,8 @@ import Database.Persist.Class
     ( toPersistValue )
 import Database.Persist.Types
     ( PersistValue (..), fromPersistValueText )
+import UnliftIO.Exception
+    ( throwString )
 
 import qualified Cardano.Wallet.Primitive.AddressDerivation as W
 import qualified Cardano.Wallet.Primitive.AddressDiscovery.Sequential as Seq
@@ -83,6 +89,13 @@ data SqlColumnStatus
     | ColumnPresent
     deriving Eq
 
+data TableCreationResult
+    = TableCreated
+    | TableExisted
+
+newtype DatabaseMetadata
+    = DatabaseMetadata { fileFormatVersion :: DatabaseFileFormatVersion }
+
 -- | Executes any manual database migration steps that may be required on
 -- startup.
 migrateManually
@@ -93,7 +106,8 @@ migrateManually
     -> [ManualMigration]
 migrateManually tr proxy defaultFieldValues =
     ManualMigration <$>
-    [ cleanupCheckpointTable
+    [ initializeDatabaseMetadataTable
+    , cleanupCheckpointTable
     , assignDefaultPassphraseScheme
     , addDesiredPoolNumberIfMissing
     , addMinimumUTxOValueIfMissing
@@ -116,6 +130,60 @@ migrateManually tr proxy defaultFieldValues =
     , cleanupSeqStateTable
     ]
   where
+    currentFileFormat :: DatabaseFileFormatVersion
+    currentFileFormat = DatabaseFileFormatVersion 1
+
+    initializeDatabaseMetadataTable :: Sqlite.Connection -> IO ()
+    initializeDatabaseMetadataTable conn =
+        createMetadataTableIfMissing conn >>= \case
+            TableCreated ->
+                putMetadata conn DatabaseMetadata
+                    { fileFormatVersion = currentFileFormat }
+            TableExisted -> do
+                DatabaseMetadata {..} <- getMetadata conn
+                when (fileFormatVersion > currentFileFormat) do
+                  let showVer = show . naturalDatabaseFileFormat
+                  throwString $ unlines
+                    [ "Unexpected database file format version:"
+                    , "- Expected version <= " <> showVer currentFileFormat
+                    , "- Actual version == " <> showVer fileFormatVersion
+                    ]
+                putMetadata conn DatabaseMetadata {..}
+
+    createMetadataTableIfMissing :: Sqlite.Connection -> IO TableCreationResult
+    createMetadataTableIfMissing conn = do
+        res <- runSql conn
+            "SELECT name FROM sqlite_master \
+            \WHERE type='table' AND name='database_metadata'"
+        case res of
+           [] -> TableCreated <$ runSql conn
+            "CREATE TABLE database_metadata\
+            \( name TEXT PRIMARY KEY \
+            \, version INTEGER NOT NULL \
+            \)"
+           _ -> pure TableExisted
+
+    putMetadata :: Sqlite.Connection -> DatabaseMetadata -> IO ()
+    putMetadata conn DatabaseMetadata {..} =
+        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 }
+            _ -> throwString "Database metadata table is corrupt"
+
     -- NOTE
     -- We originally stored script pool gap inside sequential state in the 'SeqState' table,
     -- represented by 'seqStateScriptGap' field. We introduce separate shared wallet state

diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs
@@ -32,7 +32,7 @@ import Cardano.Address.Script
 import Cardano.Slotting.Slot
     ( SlotNo )
 import Cardano.Wallet.DB.Sqlite.Types
-    ( BlockId, DatabaseFormatMigration, HDPassphrase, TxId, sqlSettings' )
+    ( BlockId, HDPassphrase, TxId, sqlSettings' )
 import Cardano.Wallet.Primitive.AddressDiscovery.Shared
     ( CredentialType )
 import Data.Quantity
@@ -432,8 +432,4 @@ CosignerKey
         cosignerKeyIndex
     Foreign Wallet OnDeleteCascade cosigner_key cosignerKeyWalletId
     deriving Show Generic
-
-FileFormat
-    fileFormatVersion   Text    sql=version
-    fileFormatMigrate   DatabaseFormatMigration    sql=migrate
 |]
diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -127,6 +128,8 @@ import GHC.Generics
     ( Generic )
 import Network.URI
     ( parseAbsoluteURI )
+import Numeric.Natural
+    ( Natural )
 import System.Random.Internal
     ( StdGen (..) )
 import System.Random.SplitMix
@@ -859,25 +862,7 @@ newtype EitherText a = EitherText { getEitherText :: Either Text a }
 instance MonadFail EitherText where
     fail = EitherText . Left . T.pack
 
--- | Database migration strategy
-data DatabaseFormatMigration
-    = DatabaseMigrationAuto
-    -- ^ Default migration strategy
-    | DatabaseMigrationKill
-    -- ^ Indicates that the wallet database may be in an inconsistent state
-    -- and the wallet software should attempt to salvage all user data
-    -- (private keys, cosigner public keys, passphrases, …)
-    -- and rebuild a new wallet state from genesis.
-    deriving Eq
-
-instance PersistField DatabaseFormatMigration where
-    toPersistValue = \case
-        DatabaseMigrationAuto -> PersistText "auto"
-        DatabaseMigrationKill -> PersistText "kill_me"
-    fromPersistValue = \case
-        PersistText "auto" -> Right DatabaseMigrationAuto
-        PersistText "kill_me" -> Right DatabaseMigrationKill
-        _ -> Left "Unknown database format migration"
+newtype DatabaseFileFormatVersion = DatabaseFileFormatVersion
+    { naturalDatabaseFileFormat :: Natural }
+    deriving newtype (Eq, Ord, Enum, Num, Real, Integral)
 
-instance PersistFieldSql DatabaseFormatMigration where
-    sqlType _ = sqlType (Proxy @Text)