Merge pull request #3737 from input-output-hk/optimise/cbr-379-prefiltering

[CBR-379] When prefiltering a block for multiple wallets, traverse the block on…

Author: KtorZ

src/Cardano/Wallet/Kernel/BListener.hs

@@ -70,7 +70,7 @@ prefilterBlock' pw b = do
     aux :: [(WalletId, EncryptedSecretKey)]
         -> ((BlockContext, Map HdAccountId PrefilteredBlock), [TxMeta])
     aux ws =
-      let (conMap, conMeta) = mconcat $ map (uncurry (prefilterBlock b)) ws
+      let (conMap, conMeta) = prefilterBlock b ws
       in ((b ^. rbContext, conMap), conMeta)
 
 data BackfillFailed

src/Cardano/Wallet/Kernel/PrefilterTx.hs

@@ -159,10 +159,23 @@ prefilterTx wKey tx = ((prefInps',prefOuts'),metas)
             (nothingToZero acc prefOutCoins)
             (onlyOurInps && onlyOurOuts) acc) allAccounts
 
+-- | Prefilter the transaction with each wallet key respectively and
+--   combine the results.
+--
+-- NOTE: we can rely on a Monoidal fold here to combine the maps
+-- 'Map HdAccountId a' since the accounts will be unique accross wallet keys.
+prefilterTxForWallets :: [WalletKey]
+                      -> ResolvedTx
+                      -> ((Map HdAccountId (Set TxIn)
+                         , Map HdAccountId UtxoSummaryRaw)
+                         , [TxMeta])
+prefilterTxForWallets wKeys tx =
+    mconcat $ map ((flip prefilterTx) tx) wKeys
+
 -- | Prefilter inputs of a transaction
 prefilterInputs :: WalletKey
-          -> [(TxIn, ResolvedInput)]
-          -> (Bool, Map HdAccountId (Set (TxIn,Coin)))
+                -> [(TxIn, ResolvedInput)]
+                -> (Bool, Map HdAccountId (Set (TxIn,Coin)))
 prefilterInputs wKey inps
     = prefilterResolvedTxPairs wKey mergeF inps
     where
@@ -265,26 +278,24 @@ extendWithSummary (onlyOurInps,onlyOurOuts) utxoWithAddrId
  and Transaction metadata.
 -------------------------------------------------------------------------------}
 
--- | Prefilter the transactions of a resolved block for the given wallet.
+-- | Prefilter the transactions of a resolved block for the given wallets.
 --
 --   Returns prefiltered blocks indexed by HdAccountId.
 prefilterBlock :: ResolvedBlock
-               -> WalletId
-               -> EncryptedSecretKey
+               -> [(WalletId, EncryptedSecretKey)]
                -> (Map HdAccountId PrefilteredBlock, [TxMeta])
-prefilterBlock block wid esk =
+prefilterBlock block rawKeys =
       (Map.fromList
     $ map (mkPrefBlock (block ^. rbContext) inpAll outAll)
     $ Set.toList accountIds
     , metas)
   where
-    wdc :: WalletDecrCredentials
-    wdc  = keyToWalletDecrCredentials $ KeyForRegular esk
-    wKey = (wid, wdc)
+    wKeys :: [WalletKey]
+    wKeys = map toWalletKey rawKeys
 
     inps :: [Map HdAccountId (Set TxIn)]
     outs :: [Map HdAccountId UtxoSummaryRaw]
-    (ios, conMetas) = unzip $ map (prefilterTx wKey) (block ^. rbTxs)
+    (ios, conMetas) = unzip $ map (prefilterTxForWallets wKeys) (block ^. rbTxs)
     (inps, outs) = unzip ios
     metas = concat conMetas
 
@@ -295,6 +306,9 @@ prefilterBlock block wid esk =
 
     accountIds = Map.keysSet inpAll `Set.union` Map.keysSet outAll
 
+    toWalletKey :: (WalletId, EncryptedSecretKey) -> WalletKey
+    toWalletKey (wid, esk) = (wid, keyToWalletDecrCredentials $ KeyForRegular esk)
+
 mkPrefBlock :: BlockContext
             -> Map HdAccountId (Set TxIn)
             -> Map HdAccountId (Map TxIn (TxOutAux, AddressSummary))

src/Cardano/Wallet/Kernel/Restore.hs

@@ -163,7 +163,7 @@ mkPrefilter :: Kernel.PassiveWallet
             -> IO (Map HD.HdAccountId PrefilteredBlock, [TxMeta])
 mkPrefilter pw wId esk blund = blundToResolvedBlock (pw ^. walletNode) blund <&> \case
     Nothing -> (M.empty, [])
-    Just rb -> prefilterBlock rb wId esk
+    Just rb -> prefilterBlock rb [(wId,esk)]
 
 -- | Begin a restoration for a wallet that is already known. This is used
 -- to put an existing wallet back into a restoration state when something has

src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs

@@ -161,7 +161,7 @@ prefilter :: EncryptedSecretKey
 prefilter esk wallet wId blund =
     blundToResolvedBlock (wallet ^. Kernel.walletNode) blund <&> \case
         Nothing -> (Map.empty, [])
-        Just rb -> prefilterBlock rb wId esk
+        Just rb -> prefilterBlock rb [(wId,esk)]
 
 -- | Updates the 'SpendingPassword' for this wallet.
 updateWallet :: MonadIO m