define manual migrations for seq-state with regards to the derivation…

… prefix

  I've generated databases for Icarus and Shelley wallets from the latest master and, in a test now trying to open these database and observe that a) it is possible, b) there's a log line indicating that a migration has happened, c) the resulting prefix in each database is exactly what we expect it to be.

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

@@ -102,6 +102,12 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , SoftDerivation (..)
     , WalletKey (..)
     )
+import Cardano.Wallet.Primitive.AddressDerivation.Icarus
+    ( IcarusKey )
+import Cardano.Wallet.Primitive.AddressDerivation.Jormungandr
+    ( JormungandrKey )
+import Cardano.Wallet.Primitive.AddressDerivation.Shelley
+    ( ShelleyKey )
 import Cardano.Wallet.Primitive.Slotting
     ( TimeInterpreter, epochOf, firstSlotInEpoch, startTime )
 import Control.Concurrent.MVar
@@ -211,6 +217,7 @@ withDBLayer
     :: forall s k a.
         ( PersistState s
         , PersistPrivateKey (k 'RootK)
+        , WalletKey k
         )
     => Tracer IO DBLog
        -- ^ Logging object
@@ -336,10 +343,12 @@ data SqlColumnStatus
 --   startup.
 --
 migrateManually
-    :: Tracer IO DBLog
+    :: WalletKey k
+    => Tracer IO DBLog
+    -> Proxy k
     -> DefaultFieldValues
     -> ManualMigration
-migrateManually tr defaultFieldValues =
+migrateManually tr proxy defaultFieldValues =
     ManualMigration $ \conn -> do
         assignDefaultPassphraseScheme conn
 
@@ -360,6 +369,8 @@ migrateManually tr defaultFieldValues =
         removeOldTxParametersTable conn
 
         addAddressStateIfMissing conn
+
+        addSeqStateDerivationPrefixIfMissing conn
   where
     -- NOTE
     -- Wallets created before the 'PassphraseScheme' was introduced have no
@@ -507,6 +518,35 @@ migrateManually tr defaultFieldValues =
             _ <- Sqlite.step query
             Sqlite.finalize query
 
+    addSeqStateDerivationPrefixIfMissing :: Sqlite.Connection -> IO ()
+    addSeqStateDerivationPrefixIfMissing conn
+        | isIcarusDatabase = do
+            addColumn_ conn True (DBField SeqStateDerivationPrefix) icarusPrefix
+
+        | isShelleyDatabase = do
+            addColumn_ conn True (DBField SeqStateDerivationPrefix) shelleyPrefix
+
+        | isJormungandrDatabase = do
+            addColumn_ conn True (DBField SeqStateDerivationPrefix) jormungandrPrefix
+
+        | otherwise =
+            return ()
+      where
+        isIcarusDatabase =
+            keyTypeDescriptor proxy == keyTypeDescriptor (Proxy @IcarusKey)
+        icarusPrefix = T.pack $ show $ toText
+            $ Seq.DerivationPrefix (Seq.purposeBIP44, Seq.coinTypeAda, minBound)
+
+        isShelleyDatabase =
+            keyTypeDescriptor proxy == keyTypeDescriptor (Proxy @ShelleyKey)
+        shelleyPrefix = T.pack $ show $ toText
+            $ Seq.DerivationPrefix (Seq.purposeCIP1852, Seq.coinTypeAda, minBound)
+
+        isJormungandrDatabase =
+            keyTypeDescriptor proxy == keyTypeDescriptor (Proxy @JormungandrKey)
+        jormungandrPrefix =
+            shelleyPrefix
+
     -- | Determines whether a field is present in its parent table.
     isFieldPresent :: Sqlite.Connection -> DBField -> IO SqlColumnStatus
     isFieldPresent conn field = do
@@ -583,6 +623,7 @@ newDBLayer
     :: forall s k.
         ( PersistState s
         , PersistPrivateKey (k 'RootK)
+        , WalletKey k
         )
     => Tracer IO DBLog
        -- ^ Logging object
@@ -596,7 +637,7 @@ newDBLayer trace defaultFieldValues mDatabaseFile timeInterpreter = do
     ctx@SqliteContext{runQuery} <-
         either throwIO pure =<<
         startSqliteBackend
-            (migrateManually trace defaultFieldValues)
+            (migrateManually trace (Proxy @k) defaultFieldValues)
             migrateAll
             trace
             mDatabaseFile

lib/core/test/bench/db/Main.hs

@@ -577,6 +577,7 @@ withDB
     :: forall s k.
         ( PersistState s
         , PersistPrivateKey (k 'RootK)
+        , WalletKey k
         )
     => Tracer IO DBLog
     -> (DBLayer IO s k -> Benchmark)
@@ -587,6 +588,7 @@ setupDB
     :: forall s k.
         ( PersistState s
         , PersistPrivateKey (k 'RootK)
+        , WalletKey k
         )
     => Tracer IO DBLog
     -> IO (FilePath, SqliteContext, DBLayer IO s k)

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -79,13 +80,18 @@ import Cardano.Wallet.Logging
     ( trMessageText )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Depth (..)
+    , DerivationType (..)
+    , Index
     , NetworkDiscriminant (..)
     , Passphrase (..)
     , PersistPrivateKey
+    , WalletKey
     , encryptPassphrase
     )
 import Cardano.Wallet.Primitive.AddressDerivation.Byron
     ( ByronKey (..) )
+import Cardano.Wallet.Primitive.AddressDerivation.Icarus
+    ( IcarusKey )
 import Cardano.Wallet.Primitive.AddressDerivation.Jormungandr
     ( JormungandrKey (..), generateKeyFromSeed )
 import Cardano.Wallet.Primitive.AddressDerivation.Shelley
@@ -95,9 +101,12 @@ import Cardano.Wallet.Primitive.AddressDiscovery
 import Cardano.Wallet.Primitive.AddressDiscovery.Random
     ( RndState (..) )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
-    ( SeqState (..)
+    ( DerivationPrefix (..)
+    , SeqState (..)
+    , coinTypeAda
     , defaultAddressPoolGap
     , mkSeqStateFromRootXPrv
+    , purposeBIP44
     , purposeCIP1852
     )
 import Cardano.Wallet.Primitive.Model
@@ -237,6 +246,22 @@ spec = do
         it "'migrate' db with no passphrase scheme set."
             testMigrationPassphraseScheme
 
+        it "'migrate' db with no 'derivation_prefix' for seq state (Icarus)" $
+            testMigrationSeqStateDerivationPrefix @IcarusKey
+                "icarusDerivationPrefix-v2020-10-07.sqlite"
+                ( purposeBIP44
+                , coinTypeAda
+                , minBound
+                )
+
+        it "'migrate' db with no 'derivation_prefix' for seq state (Shelley)" $
+            testMigrationSeqStateDerivationPrefix @ShelleyKey
+                "shelleyDerivationPrefix-v2020-10-07.sqlite"
+                ( purposeCIP1852
+                , coinTypeAda
+                , minBound
+                )
+
 sqliteSpecSeq :: Spec
 sqliteSpecSeq = withDB newMemoryDBLayer $ do
     describe "Sqlite" properties
@@ -250,6 +275,43 @@ sqliteSpecRnd = withDB newMemoryDBLayer $ do
         it "Sequential state machine tests"
             (prop_sequential :: TestDBRnd -> Property)
 
+testMigrationSeqStateDerivationPrefix
+    :: forall k s.
+        ( s ~ SeqState 'Mainnet k
+        , WalletKey k
+        , PersistState s
+        , PersistPrivateKey (k 'RootK)
+        )
+    => String
+    -> ( Index 'Hardened 'PurposeK
+       , Index 'Hardened 'CoinTypeK
+       , Index 'Hardened 'AccountK
+       )
+    -> IO ()
+testMigrationSeqStateDerivationPrefix dbName prefix = do
+    let orig = $(getTestData) </> dbName
+    withSystemTempDirectory "migration-db" $ \dir -> do
+        let path = dir </> "db.sqlite"
+        let ti = dummyTimeInterpreter
+        copyFile orig path
+        (logs, Just cp) <- captureLogging $ \tr -> do
+            withDBLayer @s @k tr defaultFieldValues (Just path) ti
+                $ \(_ctx, db) -> db & \DBLayer{..} -> atomically
+                $ do
+                    [wid] <- listWallets
+                    readCheckpoint wid
+        let migrationMsg = filter isMsgManualMigration logs
+        length migrationMsg `shouldBe` 1
+        derivationPrefix (getState cp) `shouldBe` DerivationPrefix prefix
+  where
+    isMsgManualMigration :: DBLog -> Bool
+    isMsgManualMigration = \case
+        MsgManualMigrationNeeded field _ ->
+            fieldName field ==
+                unDBName (fieldDB $ persistFieldDef DB.SeqStateDerivationPrefix)
+        _ ->
+            False
+
 testMigrationPassphraseScheme
     :: forall s k. (k ~ ShelleyKey, s ~ SeqState 'Mainnet k)
     => IO ()
@@ -346,13 +408,15 @@ loggingSpec = withLoggingDB @(SeqState 'Mainnet JormungandrKey) @JormungandrKey
 newMemoryDBLayer
     ::  ( PersistState s
         , PersistPrivateKey (k 'RootK)
+        , WalletKey k
         )
     => IO (DBLayer IO s k)
 newMemoryDBLayer = snd . snd <$> newMemoryDBLayer'
 
 newMemoryDBLayer'
     ::  ( PersistState s
         , PersistPrivateKey (k 'RootK)
+        , WalletKey k
         )
     => IO (TVar [DBLog], (SqliteContext, DBLayer IO s k))
 newMemoryDBLayer' = do
@@ -365,6 +429,7 @@ newMemoryDBLayer' = do
 withLoggingDB
     ::  ( PersistState s
         , PersistPrivateKey (k 'RootK)
+        , WalletKey k
         )
     => SpecWith (IO [DBLog], DBLayer IO s k)
     -> Spec

lib/shelley/bench/Restore.hs

@@ -617,6 +617,7 @@ withBenchDBLayer
         , IsOurs s ChimericAccount
         , IsOurs s Address
         , PersistPrivateKey (k 'RootK)
+        , WalletKey k
         )
     => TimeInterpreter IO
     -> (DBLayer IO s k -> IO a)