Merge #2263

2263: Accounting Style Renaming: proper manual migration r=KtorZ a=KtorZ

# Issue Number

<!-- Put here a reference to the issue this PR relates to and which requirements it tackles -->

ADP-523

# Overview

<!-- Detail in a few bullet points the work accomplished in this PR -->

- 016f60c
  📍 **reproduce deserialization issue with regards to account style change**
    I originally added a 'backward-compatible' function step to the deserialization function of value of type 'AccountingStyle'. The problem is that it only concerns objects that are being deserialized. Any 'AccountingStyle' value that is queried will inevitably fail because columns in an existing database would still be using the old serialization format. As a consequence, fetching all addresses of an existing sequential wallet returns an empty set, regardless of what is in the database.

- 0a6c36c
  📍 **use a proper manual database migration for renaming AccountingStyle   instead of the hacky in-place adjustment in the deserializer.**

# Comments

<!-- Additional comments or screenshots to attach if any -->

Whoops...

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


Co-authored-by: KtorZ <matthias.benkort@gmail.com>

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

@@ -370,6 +370,8 @@ migrateManually tr proxy defaultFieldValues =
         addAddressStateIfMissing conn
 
         addSeqStateDerivationPrefixIfMissing conn
+
+        renameAccountingStyle conn
   where
     -- NOTE
     -- Wallets created before the 'PassphraseScheme' was introduced have no
@@ -546,6 +548,26 @@ migrateManually tr proxy defaultFieldValues =
         jormungandrPrefix =
             shelleyPrefix
 
+    -- The 'AccountingStyle' constructors used to be respectively:
+    --
+    --   - UTxOInternal
+    --   - UTxOExternal
+    --
+    -- (notice the mixed case here) and were serialized to text as:
+    --
+    --   - u_tx_o_internal
+    --   - u_tx_o_external
+    --
+    -- which is pretty lame. This was changed later on, but already
+    -- serialized data may subsist on for quite a while. Hence this little
+    -- pirouette here.
+    renameAccountingStyle :: Sqlite.Connection -> IO ()
+    renameAccountingStyle conn = do
+        renameColumn conn (DBField SeqStateAddressAccountingStyle)
+            "u_tx_o_internal" "utxo_internal"
+        renameColumn conn (DBField SeqStateAddressAccountingStyle)
+            "u_tx_o_external" "utxo_external"
+
     -- | Determines whether a field is present in its parent table.
     isFieldPresent :: Sqlite.Connection -> DBField -> IO SqlColumnStatus
     isFieldPresent conn field = do
@@ -598,6 +620,33 @@ migrateManually tr proxy defaultFieldValues =
             ColumnPresent ->
                 traceWith tr $ MsgManualMigrationNotNeeded field
 
+    renameColumn
+        :: Sqlite.Connection
+        -> DBField
+        -> Text -- Old Value
+        -> Text -- New Value
+        -> IO ()
+    renameColumn 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
+      where
+        quotes x = "\"" <> x <> "\""
+
 -- | A set of default field values that can be consulted when performing a
 --   database migration.
 --

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

@@ -431,28 +431,7 @@ instance PersistFieldSql AddressPoolGap where
 
 instance PersistField AccountingStyle where
     toPersistValue = toPersistValue . toText
-    fromPersistValue value =
-        backwardCompatible . fromPersistValueFromText $ value
-      where
-        -- The 'AccountingStyle' constructors used to be respectively:
-        --
-        --   - UTxOInternal
-        --   - UTxOExternal
-        --
-        -- (notice the mixed case here) and were serialized to text as:
-        --
-        --   - u_tx_o_internal
-        --   - u_tx_o_external
-        --
-        -- which is pretty lame. This was changed later on, but already
-        -- serialized data may subsist on for quite a while. Hence this little
-        -- pirouette here.
-        backwardCompatible = \case
-            success@Right{} -> success
-            failure@Left{}  -> fromPersistValue @Text value >>= \case
-                t | t == "u_tx_o_internal" -> pure UtxoInternal
-                t | t == "u_tx_o_external" -> pure UtxoExternal
-                _ -> failure
+    fromPersistValue = fromPersistValueFromText
 
 instance PersistFieldSql AccountingStyle where
     sqlType _ = sqlType (Proxy @Text)

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

@@ -84,6 +84,7 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , Index
     , NetworkDiscriminant (..)
     , Passphrase (..)
+    , PaymentAddress (..)
     , PersistPrivateKey
     , WalletKey
     , encryptPassphrase
@@ -262,6 +263,10 @@ spec = do
                 , minBound
                 )
 
+        it "'migrate' db with old text serialization for 'AccountingStyle'" $
+            testMigrationAccountingStyle @ShelleyKey
+                "shelleyAccountingStyle-v2020-10-13.sqlite"
+
 sqliteSpecSeq :: Spec
 sqliteSpecSeq = withDB newMemoryDBLayer $ do
     describe "Sqlite" properties
@@ -275,6 +280,41 @@ sqliteSpecRnd = withDB newMemoryDBLayer $ do
         it "Sequential state machine tests"
             (prop_sequential :: TestDBRnd -> Property)
 
+testMigrationAccountingStyle
+    :: forall k s.
+        ( s ~ SeqState 'Mainnet k
+        , WalletKey k
+        , PersistState s
+        , PersistPrivateKey (k 'RootK)
+        , PaymentAddress 'Mainnet k
+        )
+    => String
+    -> IO ()
+testMigrationAccountingStyle dbName = 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` 2
+        length (knownAddresses $ getState cp) `shouldBe` 69
+  where
+    isMsgManualMigration :: DBLog -> Bool
+    isMsgManualMigration = \case
+        MsgManualMigrationNeeded field _ ->
+            fieldName field == unDBName fieldInDb
+        _ ->
+            False
+      where
+        fieldInDb = fieldDB $ persistFieldDef DB.SeqStateAddressAccountingStyle
+
 testMigrationSeqStateDerivationPrefix
     :: forall k s.
         ( s ~ SeqState 'Mainnet k