From b930b03a18dec3eb1e9eefd6c07a0c454b4128f4 Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Mon, 13 Nov 2023 18:06:31 +0100 Subject: [PATCH 1/8] Change `*DBLayerFromSqliteContext` to throw exceptions --- lib/wallet/src/Cardano/Wallet/DB/Layer.hs | 91 ++++++++++++----------- 1 file changed, 46 insertions(+), 45 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs b/lib/wallet/src/Cardano/Wallet/DB/Layer.hs index 375c09ea519..8d6fc852c72 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Layer.hs @@ -65,6 +65,7 @@ import Cardano.DB.Sqlite.Delete ) import Cardano.DB.Sqlite.Migration.Old ( ManualMigration (..) + , MigrationError , noManualMigration ) import Cardano.Slotting.Slot @@ -186,6 +187,7 @@ import Control.DeepSeq ) import Control.Exception ( evaluate + , onException , throw ) import Control.Monad @@ -215,7 +217,7 @@ import Data.Generics.Internal.VL.Lens import Data.Maybe ( catMaybes , fromMaybe - , isJust + , isNothing ) import Data.Store ( Store (..) @@ -481,6 +483,12 @@ readWalletId = do Right w -> Just w _ -> Nothing +{------------------------------------------------------------------------------- + DB migration and creation +-------------------------------------------------------------------------------} +throwMigrationError :: Either MigrationError a -> IO a +throwMigrationError = either throwIO pure + {------------------------------------------------------------------------------- DBLayer -------------------------------------------------------------------------------} @@ -524,10 +532,8 @@ withLoadDBLayerFromFile wF tr ti wid defaultFieldValues dbFile action = autoMigrations runNewStyleMigrations $ \ctx -> do - e <- loadDBLayerFromSqliteContext wF ti wid ctx - case e of - Left err -> throw err - Right dblayer -> action dblayer + dblayer <- loadDBLayerFromSqliteContext wF ti wid ctx + action dblayer either throwIO pure res -- | Create a 'DBLayer' in a file. @@ -559,19 +565,16 @@ withBootDBLayerFromFile wF tr ti wid _defaultFieldValues params dbFile action = do let trDB = contramap MsgDB tr noNewStyleMigrations _ _ = pure () - res <- - withSqliteContextFile - trDB - dbFile - createSchemaVersionTableIfMissing' - migrateAll - noNewStyleMigrations - $ \ctx -> do - e <- bootDBLayerFromSqliteContext wF ti wid params ctx - case e of - Left err -> throw err - Right dblayer -> action dblayer - either throwIO pure res + res <- withSqliteContextFile + trDB + dbFile + createSchemaVersionTableIfMissing' + migrateAll + noNewStyleMigrations + $ \ctx -> do + dblayer <- bootDBLayerFromSqliteContext wF ti wid params ctx + action dblayer + throwMigrationError res -- | Create a 'DBLayer' in memory. -- @@ -600,13 +603,9 @@ newBootDBLayerInMemory wF tr ti wid params = do migrateAll ForeignKeysEnabled - e <- bootDBLayerFromSqliteContext wF ti wid params ctx - case e of - Left err -> do - destroy - throw err - Right dblayer -> - pure (destroy, dblayer) + db <- bootDBLayerFromSqliteContext wF ti wid params ctx + `onException` destroy + pure (destroy, db) -- | Create a 'DBLayer' in memory. -- @@ -640,7 +639,7 @@ bootDBLayerFromSqliteContext -> W.WalletId -> DBLayerParams s -> SqliteContext - -> IO (Either ErrWalletAlreadyInitialized (DBLayer IO s)) + -> IO (DBLayer IO s) bootDBLayerFromSqliteContext wF ti wid params SqliteContext{runQuery} = do let cp = dBLayerParamsState params case fromGenesis cp @@ -653,16 +652,14 @@ bootDBLayerFromSqliteContext wF ti wid params SqliteContext{runQuery} = do $ ErrNotGenesisBlockHeader $ cp ^. #currentTip Just wallet -> do - present <- atomically_ hasWalletId - if present - then pure $ Left ErrWalletAlreadyInitialized - else do - r@DBLayer{transactionsStore, atomically} - <- atomically_ $ mkDBLayer <$> initDBVar store wallet - atomically $ updateS transactionsStore Nothing - $ ExpandTxWalletsHistory wid - $ dBLayerParamsHistory params - pure $ Right r + atomically_ $ guardWalletDoesNotExist wid + dblayer@DBLayer{transactionsStore, atomically} + <- atomically_ $ mkDBLayer <$> initDBVar store wallet + atomically + $ updateS transactionsStore Nothing + $ ExpandTxWalletsHistory wid + $ dBLayerParamsHistory params + pure dblayer where store = mkStoreWallet wF wid @@ -681,15 +678,12 @@ loadDBLayerFromSqliteContext -> TimeInterpreter IO -> W.WalletId -> SqliteContext - -> IO (Either ErrWalletNotInitialized (DBLayer IO s)) + -> IO (DBLayer IO s) loadDBLayerFromSqliteContext wF ti wid SqliteContext{runQuery} = atomically_ $ do - present <- hasWalletId - if present - then do - walletState <- loadDBVar store - pure $ Right $ mkDBLayer walletState - else pure $ Left ErrWalletNotInitialized + guardWalletExists wid + walletState <- loadDBVar store + pure $ mkDBLayer walletState where store = mkStoreWallet wF wid @@ -700,8 +694,15 @@ loadDBLayerFromSqliteContext wF ti wid SqliteContext{runQuery} = mkDBLayerFromParts ti wid $ mkDBLayerCollection ti wid atomically_ walletState -hasWalletId :: SqlPersistT IO Bool -hasWalletId = isJust <$> readWalletId +guardWalletExists :: W.WalletId -> SqlPersistT IO () +guardWalletExists wid = do + mwid <- readWalletId + unless (mwid == Just wid) $ liftIO $ throwIO ErrWalletNotInitialized + +guardWalletDoesNotExist :: W.WalletId -> SqlPersistT IO () +guardWalletDoesNotExist _wid = do + mwid <- readWalletId + unless (isNothing mwid) $ liftIO $ throwIO ErrWalletAlreadyInitialized {------------------------------------------------------------------------------- DBLayerCollection From a190e3aef13345cc21b5400e337062992265d8fa Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Tue, 14 Nov 2023 13:36:26 +0100 Subject: [PATCH 2/8] Add and use `migrateDBFile` --- lib/wallet/src/Cardano/DB/Sqlite.hs | 4 ++ lib/wallet/src/Cardano/Wallet/DB/Layer.hs | 72 ++++++++++++++++------- 2 files changed, 56 insertions(+), 20 deletions(-) diff --git a/lib/wallet/src/Cardano/DB/Sqlite.hs b/lib/wallet/src/Cardano/DB/Sqlite.hs index bdf58cd38bb..6627fb40eae 100644 --- a/lib/wallet/src/Cardano/DB/Sqlite.hs +++ b/lib/wallet/src/Cardano/DB/Sqlite.hs @@ -36,6 +36,10 @@ module Cardano.DB.Sqlite , dbFile , dbBackend + -- * Migrations + , runManualOldMigrations + , matchWrongVersionError + -- * Helpers , chunkSize , dbChunked diff --git a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs b/lib/wallet/src/Cardano/Wallet/DB/Layer.hs index 8d6fc852c72..9a6c6b2273a 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Layer.hs @@ -53,7 +53,10 @@ import Cardano.DB.Sqlite ( DBLog (..) , ForeignKeysSetting (ForeignKeysEnabled) , SqliteContext (..) + , matchWrongVersionError , newInMemorySqliteContext + , runManualOldMigrations + , withDBHandle , withSqliteContextFile ) import Cardano.DB.Sqlite.Delete @@ -197,6 +200,10 @@ import Control.Monad import Control.Monad.IO.Class ( MonadIO (..) ) +import Control.Monad.Trans.Except + ( ExceptT (..) + , runExceptT + ) import Control.Tracer ( Tracer , contramap @@ -261,6 +268,7 @@ import UnliftIO.Exception ( Exception , bracket , throwIO + , tryJust ) import UnliftIO.MVar ( modifyMVar @@ -486,6 +494,37 @@ readWalletId = do {------------------------------------------------------------------------------- DB migration and creation -------------------------------------------------------------------------------} +-- | Run migrations on a database file. +-- This will modify the file and may create backup files. +migrateDBFile + :: Tracer IO DBLog + -- ^ Tracer for logging + -> WalletFlavorS s + -- ^ Flavor of the wallet contained in the database file. + -> Maybe DefaultFieldValues + -- ^ Default database field values, used during old migration. + -> FilePath + -- ^ Path of the @.sqlite@ file to migrate. + -> IO (Either MigrationError ()) +migrateDBFile tr walletF defaultFieldValues fp = runExceptT $ do + ExceptT $ withDBHandle tr fp $ runManualOldMigrations tr oldMigrations + ExceptT + $ tryJust matchWrongVersionError + $ runNewStyleMigrations tr fp + where + trMigrations = contramap MsgMigrationOld tr + oldMigrations = + maybe + noManualMigration + (migrateManually trMigrations $ keyOfWallet walletF) + defaultFieldValues + +noAutoMigrations :: Sqlite.Migration +noAutoMigrations = pure () + +noNewStyleMigrations :: Tracer IO DBLog -> FilePath -> IO () +noNewStyleMigrations _ _ = pure () + throwMigrationError :: Either MigrationError a -> IO a throwMigrationError = either throwIO pure @@ -514,27 +553,20 @@ withLoadDBLayerFromFile -> (DBLayer IO s -> IO a) -- ^ Action to run. -> IO a -withLoadDBLayerFromFile wF tr ti wid defaultFieldValues dbFile action = - do +withLoadDBLayerFromFile wF tr ti wid defaultFieldValues dbFile action = do let trDB = contramap MsgDB tr - trManualMigrations = contramap MsgMigrationOld trDB - let manualMigrations = - maybe - createSchemaVersionTableIfMissing' - (migrateManually trManualMigrations $ keyOfWallet wF) - defaultFieldValues - let autoMigrations = migrateAll - res <- - withSqliteContextFile - trDB - dbFile - manualMigrations - autoMigrations - runNewStyleMigrations - $ \ctx -> do - dblayer <- loadDBLayerFromSqliteContext wF ti wid ctx - action dblayer - either throwIO pure res + migrateDBFile trDB wF defaultFieldValues dbFile + >>= throwMigrationError + res <- withSqliteContextFile + trDB + dbFile + noManualMigration + noAutoMigrations + noNewStyleMigrations + $ \ctx -> do + dblayer <- loadDBLayerFromSqliteContext wF ti wid ctx + action dblayer + throwMigrationError res -- | Create a 'DBLayer' in a file. -- From 93a5742ccb49ea26992c2f8573659199d376968b Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Tue, 14 Nov 2023 13:48:33 +0100 Subject: [PATCH 3/8] Remove `newStyleMigrations` from `withSqliteContextFile` The responsibility for these migrations now rests with `withLoadDBLayerFromFile` --- lib/wallet/src/Cardano/DB/Sqlite.hs | 63 +++++++------------ lib/wallet/src/Cardano/Pool/DB/Layer.hs | 2 - lib/wallet/src/Cardano/Wallet/DB/Layer.hs | 8 --- .../test/unit/Cardano/Wallet/DB/Fixtures.hs | 2 - 4 files changed, 21 insertions(+), 54 deletions(-) diff --git a/lib/wallet/src/Cardano/DB/Sqlite.hs b/lib/wallet/src/Cardano/DB/Sqlite.hs index 6627fb40eae..77e42ee6bcf 100644 --- a/lib/wallet/src/Cardano/DB/Sqlite.hs +++ b/lib/wallet/src/Cardano/DB/Sqlite.hs @@ -90,6 +90,9 @@ import Control.Monad.Logger import Control.Monad.Reader ( ReaderT ) +import Control.Monad.Trans.Class + ( lift + ) import Control.Monad.Trans.Except ( ExceptT (..) , runExceptT @@ -251,29 +254,26 @@ withSqliteContextFile -- ^ Manual migrations -> Migration -- ^ Auto migration - -> (Tracer IO DBLog -> FilePath -> IO ()) - -- ^ New style migrations -> (SqliteContext -> IO a) -> IO (Either MigrationError a) -withSqliteContextFile tr fp old auto new action = do - migrationResult <- runAllMigrations tr fp old auto new - case migrationResult of - Left e -> pure $ Left e - Right{} -> do - lock <- newMVar () - withDBHandle tr fp $ \DBHandle{dbBackend} -> - let - -- Run a query on the open database, - -- but retry on busy. - runQuery :: SqlPersistT IO a -> IO a - runQuery cmd = - observe - . retryOnBusy tr retryOnBusyTimeout - $ withMVar lock - $ const - $ runSqlConn cmd dbBackend - in - Right <$> action (SqliteContext{runQuery}) +withSqliteContextFile tr fp old auto action = runExceptT $ do + ExceptT $ withDBHandle tr fp $ runManualOldMigrations tr old + ExceptT $ withDBHandle tr fp $ runAutoMigration tr auto + lift $ do + lock <- newMVar () + withDBHandle tr fp $ \DBHandle{dbBackend} -> + let + -- Run a query on the open database, + -- but retry on busy. + runQuery :: SqlPersistT IO a -> IO a + runQuery cmd = + observe + . retryOnBusy tr retryOnBusyTimeout + $ withMVar lock + $ const + $ runSqlConn cmd dbBackend + in + action (SqliteContext{runQuery}) where observe :: IO a -> IO a observe = bracketTracer (contramap MsgRun tr) @@ -460,15 +460,6 @@ runManualOldMigrations tr manualMigration DBHandle{dbConn} = do $ Right <$> (`executeManualMigration` dbConn) manualMigration -runManualNewMigrations - :: Tracer IO DBLog - -> FilePath - -> (Tracer IO DBLog -> FilePath -> IO ()) - -> IO (Either MigrationError ()) -runManualNewMigrations tr fp newMigrations = - newMigrations tr fp - & tryJust matchWrongVersionError - matchWrongVersionError :: ErrWrongVersion -> Maybe MigrationError matchWrongVersionError = Just @@ -477,18 +468,6 @@ matchWrongVersionError = . toLazyText . build -runAllMigrations - :: Tracer IO DBLog - -> FilePath - -> ManualMigration - -> Migration - -> (Tracer IO DBLog -> FilePath -> IO ()) - -> IO (Either MigrationError ()) -runAllMigrations tr fp old auto new = runExceptT $ do - ExceptT $ withDBHandle tr fp $ runManualOldMigrations tr old - ExceptT $ withDBHandle tr fp $ runAutoMigration tr auto - ExceptT $ runManualNewMigrations tr fp new - {------------------------------------------------------------------------------- Logging -------------------------------------------------------------------------------} diff --git a/lib/wallet/src/Cardano/Pool/DB/Layer.hs b/lib/wallet/src/Cardano/Pool/DB/Layer.hs index f987837d49d..77b186b50b3 100644 --- a/lib/wallet/src/Cardano/Pool/DB/Layer.hs +++ b/lib/wallet/src/Cardano/Pool/DB/Layer.hs @@ -282,12 +282,10 @@ withDecoratedDBLayer dbDecorator tr mDatabaseDir ti action = do fp createViews migrateAll - newMigrations $ action . decorateDBLayer dbDecorator . newDBLayer tr ti either throwIO pure res where tr' = contramap MsgGeneric tr - newMigrations _ _ = pure () -- | Sets up a connection to the SQLite database. -- diff --git a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs b/lib/wallet/src/Cardano/Wallet/DB/Layer.hs index 9a6c6b2273a..08d592d0ff7 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Layer.hs @@ -522,9 +522,6 @@ migrateDBFile tr walletF defaultFieldValues fp = runExceptT $ do noAutoMigrations :: Sqlite.Migration noAutoMigrations = pure () -noNewStyleMigrations :: Tracer IO DBLog -> FilePath -> IO () -noNewStyleMigrations _ _ = pure () - throwMigrationError :: Either MigrationError a -> IO a throwMigrationError = either throwIO pure @@ -562,7 +559,6 @@ withLoadDBLayerFromFile wF tr ti wid defaultFieldValues dbFile action = do dbFile noManualMigration noAutoMigrations - noNewStyleMigrations $ \ctx -> do dblayer <- loadDBLayerFromSqliteContext wF ti wid ctx action dblayer @@ -596,13 +592,11 @@ withBootDBLayerFromFile withBootDBLayerFromFile wF tr ti wid _defaultFieldValues params dbFile action = do let trDB = contramap MsgDB tr - noNewStyleMigrations _ _ = pure () res <- withSqliteContextFile trDB dbFile createSchemaVersionTableIfMissing' migrateAll - noNewStyleMigrations $ \ctx -> do dblayer <- bootDBLayerFromSqliteContext wF ti wid params ctx action dblayer @@ -875,7 +869,6 @@ withTestLoadDBLayerFromFile tr ti dbFile action = do dbFile noManualMigration noMigration - noNewStyleMigrations (`runQuery` readWalletId) case mwid of Nothing -> fail "No wallet id found in database" @@ -890,7 +883,6 @@ withTestLoadDBLayerFromFile tr ti dbFile action = do action where noMigration = pure () - noNewStyleMigrations _ _ = pure () -- | Default field values used when testing, -- in the context of 'withLoadDBLayerFromFile'. diff --git a/lib/wallet/test/unit/Cardano/Wallet/DB/Fixtures.hs b/lib/wallet/test/unit/Cardano/Wallet/DB/Fixtures.hs index ee77489b777..83c7ba9ae67 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/DB/Fixtures.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/DB/Fixtures.hs @@ -140,11 +140,9 @@ withDBFromFile dbFile action = dbFile noManualMigration noMigration - noNewStyleMigrations action where noMigration = pure () - noNewStyleMigrations _ _ = pure () initializeWalletTable :: WalletId -> SqlPersistT IO () initializeWalletTable wid = do From feb656b5714ae7cc7904dc3d0bae450ab126f7c5 Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Thu, 16 Nov 2023 14:15:58 +0100 Subject: [PATCH 4/8] Old migration: Move `addColumn` and `renameColumnField` to top-level --- .../Cardano/Wallet/DB/Sqlite/Migration/Old.hs | 145 +++++++++--------- 1 file changed, 75 insertions(+), 70 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs index 3a329baf2a6..15af9df466e 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs @@ -329,11 +329,13 @@ migrateManually tr key defaultFieldValues = runSql conn qry >>= \case [[PersistText genesisHash, PersistText genesisStart]] -> do addColumn_ + tr conn True (DBField WalGenesisHash) (quotes genesisHash) addColumn_ + tr conn True (DBField WalGenesisStart) @@ -503,7 +505,7 @@ migrateManually tr key defaultFieldValues = -- addDesiredPoolNumberIfMissing :: Sqlite.Connection -> IO () addDesiredPoolNumberIfMissing conn = do - addColumn_ conn True (DBField ProtocolParametersDesiredNumberOfPools) value + addColumn_ tr conn True (DBField ProtocolParametersDesiredNumberOfPools) value where value = T.pack $ show $ defaultDesiredNumberOfPool defaultFieldValues @@ -512,7 +514,7 @@ migrateManually tr key defaultFieldValues = -- addMinimumUTxOValueIfMissing :: Sqlite.Connection -> IO () addMinimumUTxOValueIfMissing conn = do - addColumn_ conn True (DBField ProtocolParametersMinimumUtxoValue) value + addColumn_ tr conn True (DBField ProtocolParametersMinimumUtxoValue) value where value = T.pack $ show $ W.unCoin $ defaultMinimumUTxOValue defaultFieldValues @@ -521,7 +523,7 @@ migrateManually tr key defaultFieldValues = -- addHardforkEpochIfMissing :: Sqlite.Connection -> IO () addHardforkEpochIfMissing conn = do - addColumn_ conn False (DBField ProtocolParametersHardforkEpoch) value + addColumn_ tr conn False (DBField ProtocolParametersHardforkEpoch) value where value = case defaultHardforkEpoch defaultFieldValues of Nothing -> "NULL" @@ -532,7 +534,7 @@ migrateManually tr key defaultFieldValues = -- addKeyDepositIfMissing :: Sqlite.Connection -> Text -> IO () addKeyDepositIfMissing conn = - addColumn_ conn True (DBField ProtocolParametersKeyDeposit) + addColumn_ tr conn True (DBField ProtocolParametersKeyDeposit) -- | This table became @protocol_parameters@. removeOldTxParametersTable :: Sqlite.Connection -> IO () @@ -546,8 +548,8 @@ migrateManually tr key defaultFieldValues = -- discovered. Existing databases don't have that pre-computed field. addAddressStateIfMissing :: Sqlite.Connection -> IO () addAddressStateIfMissing conn = do - _ <- addColumn conn False (DBField SeqStateAddressStatus) (toText W.Unused) - st <- addColumn conn False (DBField RndStateAddressStatus) (toText W.Unused) + _ <- addColumn tr conn False (DBField SeqStateAddressStatus) (toText W.Unused) + st <- addColumn tr conn False (DBField RndStateAddressStatus) (toText W.Unused) when (st == ColumnMissing) $ do markAddressesAsUsed (DBField SeqStateAddressStatus) markAddressesAsUsed (DBField RndStateAddressStatus) @@ -564,9 +566,9 @@ migrateManually tr key defaultFieldValues = addSeqStateDerivationPrefixIfMissing :: Sqlite.Connection -> IO () addSeqStateDerivationPrefixIfMissing conn = case key of - IcarusKeyS -> addColumn_ conn True (DBField SeqStateDerivationPrefix) + IcarusKeyS -> addColumn_ tr conn True (DBField SeqStateDerivationPrefix) $ prefix Seq.purposeBIP44 - ShelleyKeyS -> addColumn_ conn True (DBField SeqStateDerivationPrefix) + ShelleyKeyS -> addColumn_ tr conn True (DBField SeqStateDerivationPrefix) $ prefix Seq.purposeCIP1852 _ -> pure () where @@ -587,9 +589,9 @@ migrateManually tr key defaultFieldValues = -- pirouette here. renameRoleFields :: Sqlite.Connection -> IO () renameRoleFields conn = do - renameColumnField conn (DBField SeqStateAddressRole) + renameColumnField tr conn (DBField SeqStateAddressRole) "u_tx_o_internal" "utxo_internal" - renameColumnField conn (DBField SeqStateAddressRole) + renameColumnField tr conn (DBField SeqStateAddressRole) "u_tx_o_external" "utxo_external" -- | Rename column table of SeqStateAddress from 'accounting_style' to `role` @@ -788,69 +790,10 @@ migrateManually tr key defaultFieldValues = -- addPolicyXPubIfMissing :: Sqlite.Connection -> IO () addPolicyXPubIfMissing conn = do - addColumn_ conn False (DBField SeqStatePolicyXPub) value + addColumn_ tr conn False (DBField SeqStatePolicyXPub) value where value = "NULL" - addColumn_ - :: Sqlite.Connection - -> Bool - -> DBField - -> Text - -> IO () - addColumn_ a b c = - void . addColumn a b c - - -- | A migration for adding a non-existing column to a table. Factor out as - -- it's a common use-case. - addColumn - :: Sqlite.Connection - -> Bool - -> DBField - -> Text - -> IO SqlColumnStatus - addColumn conn notNull field value = do - isFieldPresent conn field >>= \st -> st <$ case st of - TableMissing -> - traceWith tr $ MsgManualMigrationNotNeeded field - ColumnMissing -> do - traceWith tr $ MsgManualMigrationNeeded field value - query <- Sqlite.prepare conn $ T.unwords - [ "ALTER TABLE", tableName field - , "ADD COLUMN", fieldName field - , fieldType field, if notNull then "NOT NULL" else "" - , "DEFAULT", value - , ";" - ] - _ <- Sqlite.step query - Sqlite.finalize query - ColumnPresent -> - traceWith tr $ MsgManualMigrationNotNeeded field - - renameColumnField - :: Sqlite.Connection - -> DBField - -> Text -- Old Value - -> Text -- New Value - -> IO () - renameColumnField conn field old new = do - isFieldPresent conn field >>= \case - TableMissing -> - traceWith tr $ MsgManualMigrationNotNeeded field - ColumnMissing -> do - traceWith tr $ MsgManualMigrationNotNeeded field - ColumnPresent -> do - query <- Sqlite.prepare conn $ T.unwords - [ "UPDATE", tableName field - , "SET", fieldName field, "=", quotes new - , "WHERE", fieldName field, "=", quotes old - ] - _ <- Sqlite.step query - changes <- Sqlite.changes conn - traceWith tr $ if changes > 0 - then MsgManualMigrationNeeded field old - else MsgManualMigrationNotNeeded field - Sqlite.finalize query -- | This table is replaced by Submissions talbles. removeOldSubmissions :: Sqlite.Connection -> IO () @@ -1013,3 +956,65 @@ isTablePresentByName conn table = do pure $ case mrow of Sqlite.Done -> False Sqlite.Row -> True + +-- | A migration for adding a non-existing column to a table. +addColumn + :: Tracer IO DBMigrationOldLog + -> Sqlite.Connection + -> Bool + -> DBField + -> Text + -> IO SqlColumnStatus +addColumn tr conn notNull field value = do + isFieldPresent conn field >>= \st -> st <$ case st of + TableMissing -> + traceWith tr $ MsgManualMigrationNotNeeded field + ColumnMissing -> do + traceWith tr $ MsgManualMigrationNeeded field value + query <- Sqlite.prepare conn $ T.unwords + [ "ALTER TABLE", tableName field + , "ADD COLUMN", fieldName field + , fieldType field, if notNull then "NOT NULL" else "" + , "DEFAULT", value + , ";" + ] + _ <- Sqlite.step query + Sqlite.finalize query + ColumnPresent -> + traceWith tr $ MsgManualMigrationNotNeeded field + +addColumn_ + :: Tracer IO DBMigrationOldLog + -> Sqlite.Connection + -> Bool + -> DBField + -> Text + -> IO () +addColumn_ tr a b c = void . addColumn tr a b c + +-- | Rename a column. +renameColumnField + :: Tracer IO DBMigrationOldLog + -> Sqlite.Connection + -> DBField + -> Text -- Old Value + -> Text -- New Value + -> IO () +renameColumnField tr conn field old new = do + isFieldPresent conn field >>= \case + TableMissing -> + traceWith tr $ MsgManualMigrationNotNeeded field + ColumnMissing -> do + traceWith tr $ MsgManualMigrationNotNeeded field + ColumnPresent -> do + query <- Sqlite.prepare conn $ T.unwords + [ "UPDATE", tableName field + , "SET", fieldName field, "=", quotes new + , "WHERE", fieldName field, "=", quotes old + ] + _ <- Sqlite.step query + changes <- Sqlite.changes conn + traceWith tr $ if changes > 0 + then MsgManualMigrationNeeded field old + else MsgManualMigrationNotNeeded field + Sqlite.finalize query From bb4badfa5e411e22e4dc3aa55e92c3323932c7c2 Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Wed, 15 Nov 2023 17:39:34 +0100 Subject: [PATCH 5/8] Old migration: Explicitly create tables for SchemaVersion 1 --- lib/wallet/cardano-wallet.cabal | 1 + .../Cardano/Wallet/DB/Sqlite/Migration/Old.hs | 8 + .../DB/Sqlite/Migration/SchemaVersion1.hs | 394 ++++++++++++++++++ 3 files changed, 403 insertions(+) create mode 100644 lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/SchemaVersion1.hs diff --git a/lib/wallet/cardano-wallet.cabal b/lib/wallet/cardano-wallet.cabal index 942b4480bff..fa8b23802b8 100644 --- a/lib/wallet/cardano-wallet.cabal +++ b/lib/wallet/cardano-wallet.cabal @@ -257,6 +257,7 @@ library Cardano.Wallet.DB.Pure.Layer Cardano.Wallet.DB.Sqlite.Migration.New Cardano.Wallet.DB.Sqlite.Migration.Old + Cardano.Wallet.DB.Sqlite.Migration.SchemaVersion1 Cardano.Wallet.DB.Sqlite.Schema Cardano.Wallet.DB.Sqlite.Types Cardano.Wallet.DB.Store.Checkpoints.Store diff --git a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs index 15af9df466e..14d002925fa 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs @@ -44,6 +44,9 @@ import Cardano.DB.Sqlite.Migration.Old , foldMigrations , tableName ) +import Cardano.Wallet.DB.Sqlite.Migration.SchemaVersion1 + ( sqlCreateSchemaVersion1TablesIfMissing + ) import Cardano.Wallet.DB.Sqlite.Schema ( EntityField (..) ) @@ -199,6 +202,7 @@ migrateManually tr key defaultFieldValues = , moveRndUnusedAddresses , cleanupSeqStateTable , addPolicyXPubIfMissing + , createSchemaVersion1TablesIfMissing , removeOldSubmissions , removeMetasOfSubmissions , createAndPopulateSubmissionsSlotTable @@ -794,6 +798,10 @@ migrateManually tr key defaultFieldValues = where value = "NULL" + -- | Create any table of SchemaVersion 1 that is still missing. + createSchemaVersion1TablesIfMissing :: Sqlite.Connection -> IO () + createSchemaVersion1TablesIfMissing = + forM_ sqlCreateSchemaVersion1TablesIfMissing . runSql -- | This table is replaced by Submissions talbles. removeOldSubmissions :: Sqlite.Connection -> IO () diff --git a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/SchemaVersion1.hs b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/SchemaVersion1.hs new file mode 100644 index 00000000000..86be87299cb --- /dev/null +++ b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/SchemaVersion1.hs @@ -0,0 +1,394 @@ +{-# LANGUAGE QuasiQuotes #-} + +-- | +-- Copyright: © 2023 Cardano Foundation +-- License: Apache-2.0 +-- +-- Historical record of SchemaVersion 1. +-- Necessary for migrations. + +module Cardano.Wallet.DB.Sqlite.Migration.SchemaVersion1 + ( sqlCreateSchemaVersion1TablesIfMissing + ) where + +import Prelude + +import Data.String.Interpolate + ( i + ) +import Data.Text + ( Text + , split + ) + +-- | List of raw SQL queries that +-- create any missing tables from SchemaVersion 1. +sqlCreateSchemaVersion1TablesIfMissing :: [Text] +sqlCreateSchemaVersion1TablesIfMissing = + split (== ';') + [i| +CREATE TABLE IF NOT EXISTS database_schema_version + ( + name TEXT PRIMARY KEY, + version INTEGER NOT NULL + ); + +CREATE TABLE IF NOT EXISTS "wallet" + ( + "wallet_id" VARCHAR NOT NULL, + "creation_time" TIMESTAMP NOT NULL, + "name" VARCHAR NOT NULL, + "passphrase_last_updated_at" TIMESTAMP NULL, + "passphrase_scheme" VARCHAR NULL, + "genesis_hash" VARCHAR NOT NULL, + "genesis_start" TIMESTAMP NOT NULL, + PRIMARY KEY ("wallet_id") + ); + +CREATE TABLE IF NOT EXISTS "private_key" + ( + "wallet_id" VARCHAR NOT NULL, + "root" BLOB NOT NULL, + "hash" BLOB NOT NULL, + PRIMARY KEY ("wallet_id"), + CONSTRAINT "private_keyfk_wallet_private_key" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "tx_meta" + ( + "tx_id" VARCHAR NOT NULL, + "wallet_id" VARCHAR NOT NULL, + "status" VARCHAR NOT NULL, + "direction" BOOLEAN NOT NULL, + "slot" INTEGER NOT NULL, + "block_height" INTEGER NOT NULL, + "amount" INTEGER NOT NULL, + "data" VARCHAR NULL, + "slot_expires" INTEGER NULL, + "fee" INTEGER NULL, + "script_validity" BOOLEAN NULL, + PRIMARY KEY ("tx_id", "wallet_id"), + CONSTRAINT "tx_metafk_wallet_tx_meta" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "tx_in" +( + "tx_id" VARCHAR NOT NULL, + "order" INTEGER NOT NULL, + "source_tx_id" VARCHAR NOT NULL, + "source_index" INTEGER NOT NULL, + "source_amount" INTEGER NOT NULL, + PRIMARY KEY ("tx_id", "source_tx_id", "source_index") +); + +CREATE TABLE IF NOT EXISTS "tx_collateral" +( + "tx_id" VARCHAR NOT NULL, + "order" INTEGER NOT NULL, + "source_tx_id" VARCHAR NOT NULL, + "source_index" INTEGER NOT NULL, + "source_amount" INTEGER NOT NULL, + PRIMARY KEY ("tx_id", "source_tx_id", "source_index") +); + +CREATE TABLE IF NOT EXISTS "tx_out" +( + "tx_id" VARCHAR NOT NULL, + "index" INTEGER NOT NULL, + "address" VARCHAR NOT NULL, + "amount" INTEGER NOT NULL, + PRIMARY KEY ("tx_id", "index") +); + +CREATE TABLE IF NOT EXISTS "tx_out_token" +( + "tx_id" VARCHAR NOT NULL, + "tx_index" INTEGER NOT NULL, + "token_policy_id" VARCHAR NOT NULL, + "token_name" VARCHAR NOT NULL, + "token_quantity" VARCHAR NOT NULL, + PRIMARY KEY ("tx_id", "tx_index", "token_policy_id", "token_name"), + CONSTRAINT "tx_out_tokentx_out" + FOREIGN KEY("tx_id", "tx_index") + REFERENCES "tx_out"("tx_id", "index") + ON DELETE CASCADE +); + +CREATE TABLE IF NOT EXISTS "tx_collateral_out" +( + "tx_id" VARCHAR NOT NULL, + "address" VARCHAR NOT NULL, + "amount" INTEGER NOT NULL, + PRIMARY KEY ("tx_id") +); + +CREATE TABLE IF NOT EXISTS "tx_collateral_out_token" +( + "tx_id" VARCHAR NOT NULL, + "token_policy_id" VARCHAR NOT NULL, + "token_name" VARCHAR NOT NULL, + "token_quantity" VARCHAR NOT NULL, + PRIMARY KEY ("tx_id", "token_policy_id", "token_name"), + CONSTRAINT "tx_collateral_out_tokentx_collateral_out" + FOREIGN KEY("tx_id") + REFERENCES "tx_collateral_out"("tx_id") + ON DELETE CASCADE +); + +CREATE TABLE IF NOT EXISTS "tx_withdrawal" + ( + "tx_id" VARCHAR NOT NULL, + "amount" INTEGER NOT NULL, + "account" VARCHAR NOT NULL, + PRIMARY KEY ("tx_id", "account") + ); + +CREATE TABLE IF NOT EXISTS "local_tx_submission" + ( + "tx_id" VARCHAR NOT NULL, + "wallet_id" VARCHAR NOT NULL, + "last_slot" INTEGER NOT NULL, + "tx" BLOB NOT NULL, + PRIMARY KEY ("tx_id", "wallet_id"), + CONSTRAINT "unique_local_tx_submission" + UNIQUE ("tx_id", "wallet_id"), + CONSTRAINT "local_tx_submissionfk_tx_meta" + FOREIGN KEY("tx_id", "wallet_id") + REFERENCES "tx_meta"("tx_id", "wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "checkpoint" + ( + "wallet_id" VARCHAR NOT NULL, + "slot" INTEGER NOT NULL, + "header_hash" VARCHAR NOT NULL, + "parent_header_hash" VARCHAR NOT NULL, + "block_height" INTEGER NOT NULL, + PRIMARY KEY ("wallet_id", "slot"), + CONSTRAINT "checkpointcheckpoint" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "protocol_parameters" + ( + "wallet_id" VARCHAR NOT NULL, + "fee_policy" VARCHAR NOT NULL, + "tx_max_size" INTEGER NOT NULL, + "decentralization_level" NUMERIC(32, 20) NOT NULL, + "desired_pool_number" INTEGER NOT NULL, + "minimum_utxo_value" INTEGER NOT NULL, + "hardfork_epoch" INTEGER NULL, + "key_deposit" INTEGER NOT NULL, + PRIMARY KEY ("wallet_id"), + CONSTRAINT "protocol_parametersfk_wallet_protocol_parameters" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "stake_key_certificate" + ( + "wallet_id" VARCHAR NOT NULL, + "slot" INTEGER NOT NULL, + "type" VARCHAR NOT NULL, + PRIMARY KEY ("wallet_id", "slot"), + CONSTRAINT "stake_key_certificatestake_key_registration" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "delegation_certificate" + ( + "wallet_id" VARCHAR NOT NULL, + "slot" INTEGER NOT NULL, + "delegation" VARCHAR NULL, + PRIMARY KEY ("wallet_id", "slot"), + CONSTRAINT "delegation_certificatedelegation_certificate" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "delegation_reward" + ( + "wallet_id" VARCHAR NOT NULL, + "account_balance" INTEGER NOT NULL, + PRIMARY KEY ("wallet_id"), + CONSTRAINT "delegation_rewarddelegation_reward" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "utxo" + ( + "wallet_id" VARCHAR NOT NULL, + "slot" INTEGER NOT NULL, + "input_tx_id" VARCHAR NOT NULL, + "input_index" INTEGER NOT NULL, + "output_address" VARCHAR NOT NULL, + "output_coin" INTEGER NOT NULL, + PRIMARY KEY ("wallet_id", "slot", "input_tx_id", "input_index"), + CONSTRAINT "u_tx_outxo" + FOREIGN KEY("wallet_id", "slot") + REFERENCES "checkpoint"("wallet_id", "slot") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "utxo_token" + ( + "id" INTEGER PRIMARY KEY, + "wallet_id" VARCHAR NOT NULL, + "slot" INTEGER NOT NULL, + "tx_id" VARCHAR NOT NULL, + "tx_index" INTEGER NOT NULL, + "token_policy_id" VARCHAR NOT NULL, + "token_name" VARCHAR NOT NULL, + "token_quantity" VARCHAR NOT NULL, + CONSTRAINT "u_tx_o_tokenutxot" + FOREIGN KEY("wallet_id", "slot") REFERENCES + "checkpoint"("wallet_id", "slot") ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "seq_state" + ( + "wallet_id" VARCHAR NOT NULL, + "external_gap" INTEGER NOT NULL, + "internal_gap" INTEGER NOT NULL, + "account_xpub" BLOB NOT NULL, + "policy_xpub" BLOB NULL, + "reward_xpub" BLOB NOT NULL, + "derivation_prefix" VARCHAR NOT NULL, + PRIMARY KEY ("wallet_id"), + CONSTRAINT "seq_stateseq_state" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "seq_state_address" + ( + "id" INTEGER PRIMARY KEY, + "wallet_id" VARCHAR NOT NULL, + "slot" INTEGER NOT NULL, + "address" VARCHAR NOT NULL, + "address_ix" INTEGER NOT NULL, + "role" VARCHAR NOT NULL, + "status" VARCHAR NOT NULL, + CONSTRAINT "seq_state_addressseq_state_address" + FOREIGN KEY("wallet_id", "slot") + REFERENCES "checkpoint"("wallet_id", "slot") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "seq_state_pending" + ( + "wallet_id" VARCHAR NOT NULL, + "pending_ix" INTEGER NOT NULL, + PRIMARY KEY ("wallet_id", "pending_ix"), + CONSTRAINT "seq_state_pending_ixseq_state_address_pending" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "rnd_state" + ( + "wallet_id" VARCHAR NOT NULL, + "account_ix" INTEGER NOT NULL, + "gen" VARCHAR NOT NULL, + "hd_passphrase" BLOB NOT NULL, + PRIMARY KEY ("wallet_id"), + CONSTRAINT "rnd_staternd_state" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "rnd_state_address" + ( + "id" INTEGER PRIMARY KEY, + "wallet_id" VARCHAR NOT NULL, + "slot" INTEGER NOT NULL, + "account_ix" INTEGER NOT NULL, + "address_ix" INTEGER NOT NULL, + "address" VARCHAR NOT NULL, + "status" VARCHAR NOT NULL, + CONSTRAINT "rnd_state_addressrnd_state_address" + FOREIGN KEY("wallet_id", "slot") + REFERENCES "checkpoint"("wallet_id", "slot") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "rnd_state_pending_address" + ( + "id" INTEGER PRIMARY KEY, + "wallet_id" VARCHAR NOT NULL, + "account_ix" INTEGER NOT NULL, + "address_ix" INTEGER NOT NULL, + "address" VARCHAR NOT NULL, + CONSTRAINT "rnd_state_pending_addressrnd_state_pending_address" + FOREIGN KEY ("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "shared_state" + ( + "wallet_id" VARCHAR NOT NULL, + "account_xpub" BLOB NOT NULL, + "pool_gap" INTEGER NOT NULL, + "payment_script" VARCHAR NOT NULL, + "delegation_script" VARCHAR NULL, + "derivation_prefix" VARCHAR NOT NULL, + PRIMARY KEY ("wallet_id"), + CONSTRAINT "shared_stateshared_state" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "shared_state_pending" + ( + "wallet_id" VARCHAR NOT NULL, + "pending_ix" INTEGER NOT NULL, + PRIMARY KEY ("wallet_id", "pending_ix"), + CONSTRAINT "shared_state_pending_ixshared_state_address_pending" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "cosigner_key" + ( + "id" INTEGER PRIMARY KEY, + "wallet_id" VARCHAR NOT NULL, + "credential" VARCHAR NOT NULL, + "account_xpub" BLOB NOT NULL, + "cosigner_index" INTEGER NOT NULL, + CONSTRAINT "cosigner_keycosigner_key" + FOREIGN KEY("wallet_id") + REFERENCES "wallet"("wallet_id") + ON DELETE CASCADE + ); + +CREATE TABLE IF NOT EXISTS "c_b_o_r" + ( + "tx_id" VARCHAR NOT NULL, + "tx_cbor" BLOB NOT NULL, + "tx_era" INTEGER NOT NULL, + PRIMARY KEY ("tx_id") + ) +|] +-- Don't put a semicolon ';' after the last "CREATE" statement, +-- or the list created by 'split' will contain an empty statement. From caadbaa399b0c7936a49d96c2607f1b21e26d46d Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Thu, 16 Nov 2023 14:26:10 +0100 Subject: [PATCH 6/8] Old migration: Explicitly add columns to `tx_meta` table --- .../Cardano/Wallet/DB/Sqlite/Migration/Old.hs | 45 +++++++++++++++++-- 1 file changed, 42 insertions(+), 3 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs index 14d002925fa..77576ebf3a6 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs @@ -183,6 +183,8 @@ migrateManually tr key defaultFieldValues = [ initializeSchemaVersionTable , cleanupCheckpointTable , assignDefaultPassphraseScheme + , addTxMetaDataColumn + , addTxMetaSlotExpiresColumn , addDesiredPoolNumberIfMissing , addMinimumUTxOValueIfMissing , addHardforkEpochIfMissing @@ -198,7 +200,8 @@ migrateManually tr key defaultFieldValues = , renameRoleColumn , renameRoleFields , updateFeeValueAndAddKeyDeposit - , addFeeToTransaction + , addTxMetaFeeToTransaction + , addTxMetaScriptValidityColumn , moveRndUnusedAddresses , cleanupSeqStateTable , addPolicyXPubIfMissing @@ -371,6 +374,42 @@ migrateManually tr key defaultFieldValues = , " ORDER BY slot ASC LIMIT 1;" ] + addTxMetaDataColumn :: Sqlite.Connection -> IO () + addTxMetaDataColumn conn = + isFieldPresentByName conn "tx_meta" "data" >>= \case + ColumnMissing -> do + traceWith tr $ MsgManualMigrationNeeded + (DBField TxMetadata) "NULL" + void $ runSql conn + [i| ALTER TABLE tx_meta + ADD COLUMN "data" VARCHAR NULL DEFAULT NULL + |] + _ -> pure () + + addTxMetaSlotExpiresColumn :: Sqlite.Connection -> IO () + addTxMetaSlotExpiresColumn conn = + isFieldPresentByName conn "tx_meta" "slot_expires" >>= \case + ColumnMissing -> do + traceWith tr $ MsgManualMigrationNeeded + (DBField TxMetaSlotExpires) "NULL" + void $ runSql conn + [i| ALTER TABLE tx_meta + ADD COLUMN "slot_expires" INTEGER NULL DEFAULT NULL + |] + _ -> pure () + + addTxMetaScriptValidityColumn :: Sqlite.Connection -> IO () + addTxMetaScriptValidityColumn conn = + isFieldPresentByName conn "tx_meta" "script_validity" >>= \case + ColumnMissing -> do + traceWith tr $ MsgManualMigrationNeeded + (DBField TxMetaScriptValidity) "NULL" + void $ runSql conn + [i| ALTER TABLE tx_meta + ADD COLUMN "script_validity" INTEGER NULL DEFAULT NULL + |] + _ -> pure () + -- NOTE -- Wallets created before the 'PassphraseScheme' was introduced have no -- passphrase scheme set in the database. Yet, their passphrase is known @@ -649,8 +688,8 @@ migrateManually tr key defaultFieldValues = -- instead, we query all transactions which require an update in memory, -- and update them one by one. This may be quite long on some database but -- it is in the end a one-time cost paid on start-up. - addFeeToTransaction :: Sqlite.Connection -> IO () - addFeeToTransaction conn = do + addTxMetaFeeToTransaction :: Sqlite.Connection -> IO () + addTxMetaFeeToTransaction conn = do isFieldPresent conn fieldFee >>= \case TableMissing -> traceWith tr $ MsgManualMigrationNotNeeded fieldFee From c1fe3eaeae9dff9a0bd021cc85009e78554e2a1d Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Thu, 16 Nov 2023 13:58:21 +0100 Subject: [PATCH 7/8] Old migration: Explicitly create `submissions` table for SchemaVersion 2 --- .../Cardano/Wallet/DB/Sqlite/Migration/Old.hs | 24 +++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs index 77576ebf3a6..bc16f86c6d4 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Sqlite/Migration/Old.hs @@ -208,6 +208,7 @@ migrateManually tr key defaultFieldValues = , createSchemaVersion1TablesIfMissing , removeOldSubmissions , removeMetasOfSubmissions + , createSubmissionsTable , createAndPopulateSubmissionsSlotTable ] where @@ -873,13 +874,32 @@ migrateManually tr key defaultFieldValues = [ "DELETE FROM " <> tableName t , "WHERE tx_id = '" <> txId <> "';" ] + + createSubmissionsTable :: Sqlite.Connection -> IO () + createSubmissionsTable conn = void $ runSql conn + [i| + CREATE TABLE IF NOT EXISTS "submissions" + ( "tx_id" VARCHAR NOT NULL + , "tx" BLOB NOT NULL + , "expiration" INTEGER NOT NULL + , "acceptance" INTEGER NULL + , "wallet_id" VARCHAR NOT NULL + , "status" INTEGER NOT NULL + , "slot" INTEGER NOT NULL + , "block_height" INTEGER NOT NULL + , "amount" INTEGER NOT NULL + , "direction" BOOLEAN NOT NULL + , "resubmitted" INTEGER NOT NULL + , PRIMARY KEY ("tx_id") + ) + |] + createAndPopulateSubmissionsSlotTable :: Sqlite.Connection -> IO () createAndPopulateSubmissionsSlotTable conn = do - let action = do void $ runSql conn [i| - CREATE TABLE "submissions_slots" + CREATE TABLE IF NOT EXISTS "submissions_slots" ( "finality" INTEGER NOT NULL , "tip" INTEGER NOT NULL , "wallet_id" VARCHAR NOT NULL From 9346e5153374f71c6d555e9cf4d5f5c2d939f94b Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Thu, 16 Nov 2023 14:56:51 +0100 Subject: [PATCH 8/8] New Migration: Fail migrateDelegations on missing table or column --- .../Cardano/Wallet/DB/Store/Delegations/Migration.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lib/wallet/src/Cardano/Wallet/DB/Store/Delegations/Migration.hs b/lib/wallet/src/Cardano/Wallet/DB/Store/Delegations/Migration.hs index 457d3332bc7..35962418aac 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Store/Delegations/Migration.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Store/Delegations/Migration.hs @@ -125,8 +125,16 @@ migration store = do conn <- asks dbConn r <- liftIO $ isFieldPresent conn $ DBField StakeKeyCertSlot case r of - TableMissing -> return () - ColumnMissing -> return () + TableMissing -> fail $ unwords + [ "Database migration from version 2 to version 3 failed:" + , "Expected TABLE stake_key_certificate" + , "to exist in database_schema_version 2" + ] + ColumnMissing -> fail $ unwords + [ "Database migration from version 2 to version 3 failed:" + , "Expected COLUMN slot of TABLE stake_key_certificate" + , "to exist in database_schema_version 2" + ] ColumnPresent -> withReaderT dbBackend $ do old <- readOldEncoding writeS store old