Merge #2219

2219: Return derivation path when answering `isOurs` r=KtorZ a=KtorZ

# Issue Number

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

#2176 

# Overview

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

- 6c3aaea
  📍 **change derivation path JSON serialization to be less verbose**
    And also aligned with other interfaces like cardano-addresses.

- 1bba794
  📍 **change 'isOurs' to return a derivation path instead of a boolean**
    This can then be used to figure out what are the derivation path of
  a bunch of addresses when returning raw coin-selections.
  Note that this commit builds but is so-to-speak unsound. We need to
  find a way to feed the purpose, coin type and account index down to
  the 'isOurs' function. The most logical place to do this is as part of
  the state. We can't use arbitrary constant here because both Icarus
  and Shelley use a SeqState, but have different purpose indexes.

- 4b116de
  📍 **store seq-state derivation prefix in the database.**
    That prefixes tells us which account corresponds to which state and also, which purpose so can distinguish between Icarus and Shelley wallets. This will require a database migration
  which I'll add in a later commit.

- 185d8fb
  📍 **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.


# Comments

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

<!-- 
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 <[email protected]>

lib/core/src/Cardano/Wallet.hs

@@ -248,6 +248,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     , defaultAddressPoolGap
     , mkSeqStateFromRootXPrv
     , mkUnboundedAddressPoolGap
+    , purposeBIP44
     , shrinkPool
     )
 import Cardano.Wallet.Primitive.CoinSelection
@@ -604,7 +605,7 @@ createIcarusWallet
     -> (k 'RootK XPrv, Passphrase "encryption")
     -> ExceptT ErrWalletAlreadyExists IO WalletId
 createIcarusWallet ctx wid wname credentials = db & \DBLayer{..} -> do
-    let s = mkSeqStateFromRootXPrv @n credentials $
+    let s = mkSeqStateFromRootXPrv @n credentials purposeBIP44 $
             mkUnboundedAddressPoolGap 10000
     let (hist, cp) = initWallet block0 gp s
     let addrs = map address . concatMap (view #outputs . fst) $ hist
@@ -614,6 +615,7 @@ createIcarusWallet ctx wid wname credentials = db & \DBLayer{..} -> do
             (shrinkPool @n (liftPaymentAddress @n) addrs g (Seq.externalPool s))
             (Seq.pendingChangeIxs s)
             (Seq.rewardAccountKey s)
+            (Seq.derivationPrefix s)
     now <- lift getCurrentTime
     let meta = WalletMetadata
             { name = wname
@@ -1801,15 +1803,15 @@ mkTxMeta interpretTime blockHeader wState tx cs =
 
     ourCoins :: TxOut -> Maybe Natural
     ourCoins (TxOut addr (Coin val)) =
-        if fst (isOurs addr wState)
-        then Just (fromIntegral val)
-        else Nothing
+        case fst (isOurs addr wState) of
+            Just{}  -> Just (fromIntegral val)
+            Nothing -> Nothing
 
     ourWithdrawal :: (ChimericAccount, Coin) -> Maybe Natural
     ourWithdrawal (acct, (Coin val)) =
-        if fst (isOurs acct wState)
-        then Just (fromIntegral val)
-        else Nothing
+        case fst (isOurs acct wState) of
+            Just{}  -> Just (fromIntegral val)
+            Nothing -> Nothing
 
 -- | Broadcast a (signed) transaction to the network.
 submitTx

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -257,6 +257,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     , defaultAddressPoolGap
     , mkSeqStateFromAccountXPub
     , mkSeqStateFromRootXPrv
+    , purposeCIP1852
     )
 import Cardano.Wallet.Primitive.CoinSelection
     ( CoinSelection (..), changeBalance, inputBalance )
@@ -598,7 +599,7 @@ postShelleyWallet
     -> WalletPostData
     -> Handler ApiWallet
 postShelleyWallet ctx generateKey body = do
-    let state = mkSeqStateFromRootXPrv (rootXPrv, pwd) g
+    let state = mkSeqStateFromRootXPrv (rootXPrv, pwd) purposeCIP1852 g
     void $ liftHandler $ initWorker @_ @s @k ctx wid
         (\wrk -> W.createWallet  @(WorkerCtx ctx) @s @k wrk wid wName state)
         (\wrk -> W.restoreWallet @(WorkerCtx ctx) @s @t @k wrk wid)
@@ -634,7 +635,7 @@ postAccountWallet
     -> AccountPostData
     -> Handler w
 postAccountWallet ctx mkWallet liftKey coworker body = do
-    let state = mkSeqStateFromAccountXPub (liftKey accXPub) g
+    let state = mkSeqStateFromAccountXPub (liftKey accXPub) purposeCIP1852 g
     void $ liftHandler $ initWorker @_ @s @k ctx wid
         (\wrk -> W.createWallet  @(WorkerCtx ctx) @s @k wrk wid wName state)
         (\wrk -> W.restoreWallet @(WorkerCtx ctx) @s @t @k wrk wid)

lib/core/src/Cardano/Wallet/Api/Types.hs

@@ -233,6 +233,8 @@ import Data.ByteString
     ( ByteString )
 import Data.Either.Extra
     ( maybeToEither )
+import Data.Foldable
+    ( asum )
 import Data.Function
     ( (&) )
 import Data.Generics.Internal.VL.Lens
@@ -247,6 +249,8 @@ import Data.Proxy
     ( Proxy (..) )
 import Data.Quantity
     ( Percentage, Quantity (..) )
+import Data.Scientific
+    ( Scientific, toBoundedInteger )
 import Data.String
     ( IsString )
 import Data.Text
@@ -275,6 +279,8 @@ import GHC.TypeLits
     ( Nat, Symbol )
 import Numeric.Natural
     ( Natural )
+import Safe
+    ( readMay )
 import Servant.API
     ( MimeRender (..), MimeUnrender (..), OctetStream )
 import Web.HttpApiData
@@ -961,9 +967,40 @@ instance FromJSON ApiAddressDerivationPath where
     parseJSON = fmap ApiAddressDerivationPath . parseJSON
 
 instance ToJSON ApiAddressDerivationSegment where
-    toJSON = genericToJSON defaultRecordTypeOptions
+    toJSON (ApiAddressDerivationSegment (ApiRelativeAddressIndex ix) typ)
+        | typ == Hardened = toJSON (show ix <> "H")
+        | otherwise = toJSON (show ix)
 instance FromJSON ApiAddressDerivationSegment where
-    parseJSON = genericParseJSON defaultRecordTypeOptions
+    parseJSON value = asum
+        [ parseJSON value >>= parseAsScientific
+        , parseJSON value >>= parseAsText
+        ]
+      where
+        parseAsText :: Text -> Aeson.Parser ApiAddressDerivationSegment
+        parseAsText txt =
+            if "H" `T.isSuffixOf` txt then do
+                path <- castNumber (T.init txt) >>= parseAsScientific
+                pure $ path { derivationType = Hardened }
+            else
+                castNumber txt >>= parseAsScientific
+
+        parseAsScientific :: Scientific -> Aeson.Parser ApiAddressDerivationSegment
+        parseAsScientific x =
+            case toBoundedInteger x of
+                Nothing -> fail "expected an unsigned int31"
+                Just ix -> pure ApiAddressDerivationSegment
+                    { derivationIndex = ApiRelativeAddressIndex ix
+                    , derivationType = Soft
+                    }
+
+        castNumber :: Text -> Aeson.Parser Scientific
+        castNumber txt =
+            case readMay (T.unpack txt) of
+                Nothing ->
+                    fail "expected a number as string with an optional 'H' \
+                         \suffix (e.g. \"1815H\" or \"44\""
+                Just s ->
+                    pure s
 
 instance ToJSON (ApiAddressDerivationType) where
     toJSON = genericToJSON defaultSumTypeOptions

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
@@ -1577,6 +1618,7 @@ instance
             , seqStateInternalGap = iGap
             , seqStateAccountXPub = serializeXPub accountXPub
             , seqStateRewardXPub = serializeXPub (Seq.rewardAccountKey st)
+            , seqStateDerivationPrefix = Seq.derivationPrefix st
             }
         insertAddressPool @n wid sl intPool
         insertAddressPool @n wid sl extPool
@@ -1587,13 +1629,13 @@ instance
 
     selectState (wid, sl) = runMaybeT $ do
         st <- MaybeT $ selectFirst [SeqStateWalletId ==. wid] []
-        let SeqState _ eGap iGap accountBytes rewardBytes = entityVal st
+        let SeqState _ eGap iGap accountBytes rewardBytes prefix = entityVal st
         let accountXPub = unsafeDeserializeXPub accountBytes
         let rewardXPub = unsafeDeserializeXPub rewardBytes
         intPool <- lift $ selectAddressPool @n wid sl iGap accountXPub
         extPool <- lift $ selectAddressPool @n wid sl eGap accountXPub
         pendingChangeIxs <- lift $ selectSeqStatePendingIxs wid
-        pure $ Seq.SeqState intPool extPool pendingChangeIxs rewardXPub
+        pure $ Seq.SeqState intPool extPool pendingChangeIxs rewardXPub prefix
 
 insertAddressPool
     :: forall n k c. (PaymentAddress n k, Typeable c)

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

@@ -227,11 +227,12 @@ UTxO                                sql=utxo
 -- Sequential scheme address discovery state
 -- which does not belong to a particular checkpoint.
 SeqState
-    seqStateWalletId        W.WalletId        sql=wallet_id
-    seqStateExternalGap     W.AddressPoolGap  sql=external_gap
-    seqStateInternalGap     W.AddressPoolGap  sql=internal_gap
-    seqStateAccountXPub     B8.ByteString     sql=account_xpub
-    seqStateRewardXPub      B8.ByteString     sql=reward_xpub
+    seqStateWalletId          W.WalletId         sql=wallet_id
+    seqStateExternalGap       W.AddressPoolGap   sql=external_gap
+    seqStateInternalGap       W.AddressPoolGap   sql=internal_gap
+    seqStateAccountXPub       B8.ByteString      sql=account_xpub
+    seqStateRewardXPub        B8.ByteString      sql=reward_xpub
+    seqStateDerivationPrefix  W.DerivationPrefix sql=derivation_prefix
 
     Primary seqStateWalletId
     Foreign Wallet seq_state seqStateWalletId ! ON DELETE CASCADE

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

@@ -29,7 +29,11 @@ import Cardano.Slotting.Slot
 import Cardano.Wallet.Primitive.AddressDerivation
     ( AccountingStyle (..), Passphrase (..), PassphraseScheme (..) )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
-    ( AddressPoolGap (..), getAddressPoolGap, mkAddressPoolGap )
+    ( AddressPoolGap (..)
+    , DerivationPrefix
+    , getAddressPoolGap
+    , mkAddressPoolGap
+    )
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
     , AddressState (..)
@@ -633,9 +637,8 @@ instance PersistField AddressState where
 instance PersistFieldSql AddressState where
     sqlType _ = sqlType (Proxy @Text)
 
-
 ----------------------------------------------------------------------------
--- Settings
+-- PoolMetadataSource
 
 
 instance PersistField PoolMetadataSource where
@@ -644,3 +647,13 @@ instance PersistField PoolMetadataSource where
 
 instance PersistFieldSql PoolMetadataSource where
     sqlType _ = sqlType (Proxy @Text)
+
+----------------------------------------------------------------------------
+-- DerivationPrefix
+
+instance PersistField DerivationPrefix where
+    toPersistValue = toPersistValue . toText
+    fromPersistValue = fromPersistValueFromText
+
+instance PersistFieldSql DerivationPrefix where
+    sqlType _ = sqlType (Proxy @Text)

lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs

@@ -35,6 +35,9 @@ module Cardano.Wallet.Primitive.AddressDerivation
       Depth (..)
     , Index (..)
     , AccountingStyle (..)
+    , utxoExternal
+    , utxoInternal
+    , mutableAccount
     , DerivationType (..)
     , HardDerivation (..)
     , SoftDerivation (..)
@@ -142,13 +145,10 @@ import qualified Data.Text.Encoding as T
                                 HD Hierarchy
 -------------------------------------------------------------------------------}
 
--- | Key Depth in the derivation path, according to BIP-0039 / BIP-0044
+-- | Key Depth in the derivation path, according to BIP-0044 / CIP-1852
 --
--- @m | purpose' | cointype' | account' | change | address@
---
--- We do not manipulate purpose, cointype and change paths directly, so they are
--- left out of the sum type.
-data Depth = RootK | AccountK | AddressK
+-- @m | purpose' | cointype' | account' | role | address@
+data Depth = RootK | PurposeK | CoinTypeK | AccountK | RoleK | AddressK
 
 -- | Marker for addresses type engaged. We want to handle three cases here.
 -- The first two are pertinent to UTxO accounting
@@ -158,6 +158,8 @@ data Depth = RootK | AccountK | AddressK
 -- (b) internal change is for addresses used to handle the change of a
 --     the transaction within a given wallet
 -- (c) the addresses for a reward (chimeric) account
+--
+-- FIXME: rename this to 'Role' or 'HDRole'
 data AccountingStyle
     = UTxOExternal
     | UTxOInternal
@@ -186,6 +188,21 @@ instance ToText AccountingStyle where
 instance FromText AccountingStyle where
     fromText = fromTextToBoundedEnum SnakeLowerCase
 
+-- | smart-constructor for getting a derivation index that refers to external
+-- utxo.
+utxoExternal :: Index 'Soft 'RoleK
+utxoExternal = toEnum $ fromEnum UTxOExternal
+
+-- | smart-constructor for getting a derivation index that refers to internal
+-- utxo.
+utxoInternal :: Index 'Soft 'RoleK
+utxoInternal = toEnum $ fromEnum UTxOInternal
+
+-- | smart-constructor for getting a derivation index that refers to stake
+-- key level (a.k.a mutable account)
+mutableAccount :: Index 'Soft 'RoleK
+mutableAccount = toEnum $ fromEnum MutableAccount
+
 -- | A derivation index, with phantom-types to disambiguate derivation type.
 --
 -- @