Add debugging.

cardano-foundation · Oct 20, 2020 · c72b045 · c72b045
1 parent f04190b
commit c72b045
Show file tree

Hide file tree

Showing 2 changed files with 61 additions and 7 deletions.
diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
@@ -180,6 +180,8 @@ module Cardano.Wallet
 import Prelude hiding
     ( log )
 
+import Debug.Trace
+    ( trace )
 import Cardano.Address.Derivation
     ( XPrv )
 import Cardano.BM.Data.Severity
@@ -1576,7 +1578,17 @@ assignChangeAddresses
     :: forall s m. (GenChange s, Monad m)
     => ArgGenChange s -> [Coin] -> StateT s m [TxOut]
 assignChangeAddresses argGenChange =
-    mapM $ \coin -> flip TxOut coin <$> state (genChange argGenChange)
+    mapM $ \coin -> do
+        addr <- state (genChange argGenChange)
+        let traceMessage = mconcat
+                [ "########\n"
+                , "genChange returned "
+                , show (toText addr)
+                , " for "
+                , show coin
+                ]
+        trace traceMessage $
+            pure $ TxOut addr coin
 
 -- | Produce witnesses and construct a transaction from a given
 -- selection. Requires the encryption passphrase in order to decrypt
@@ -1726,17 +1738,30 @@ selectCoinsExternal ctx wid argGenChange selectCoins = do
 
     fullyQualifiedInputs
         :: Monad m => s -> [(TxIn, TxOut)] -> e -> ExceptT e m (NonEmpty input)
-    fullyQualifiedInputs s inputs e = flip ensureNonEmpty e .
+    fullyQualifiedInputs s inputs e =
+        trace traceMessage $
+        flip ensureNonEmpty e .
         fmap mkInput =<< qualifyAddresses s e (view #address . snd) inputs
       where
         mkInput ((txin, txout), path) = (txin, txout, path)
+        traceMessage = mconcat
+            [ "########\n"
+            , "fullyQualifiedInputs called with "
+            , show (toText . view #address . snd <$> inputs)
+            ]
 
     fullyQualifiedChange
         :: Monad m => s -> [TxOut] -> e -> ExceptT e m [change]
     fullyQualifiedChange s txouts e =
-        fmap mkChange <$> qualifyAddresses s e (view #address) txouts
+        trace traceMessage $
+            fmap mkChange <$> qualifyAddresses s e (view #address) txouts
       where
         mkChange (TxOut address amount, derivationPath) = TxChange {..}
+        traceMessage = mconcat
+            [ "########\n"
+            , "fullyQualifiedChange called with "
+            , show (toText . view #address <$> txouts)
+            ]
 
 data ErrSelectCoinsExternal e
     = ErrSelectCoinsExternalNoSuchWallet ErrNoSuchWallet

diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs
@@ -138,6 +138,8 @@ import GHC.Stack
     ( HasCallStack )
 import GHC.TypeLits
     ( KnownNat, Nat, natVal )
+import Debug.Trace
+    ( trace )
 
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
@@ -398,21 +400,29 @@ lookupAddress
 lookupAddress alterSt !target !pool =
     case paymentKeyFingerprint @k target of
         Left _ ->
+            trace (traceMessage <> " no paymentKeyFingerprint") $
             (Nothing, pool)
         Right fingerprint ->
             case Map.alterF lookupF fingerprint (indexedKeys pool) of
                 (Just ix, keys') ->
+                    trace (traceMessage <> " Just") $
                     ( Just ix
                     , extendAddressPool @n ix (pool { indexedKeys = keys'})
                     )
                 (Nothing, _) ->
+                    trace (traceMessage <> " Nothing") $
                     ( Nothing
                     , pool
                     )
   where
     lookupF = \case
         Nothing -> (Nothing, Nothing)
         Just (ix, st) -> (Just ix, Just (ix, alterSt st))
+    traceMessage = mconcat
+        [ "########\n"
+        , "lookupAddress called with"
+        , "addr:", show (toText target), " "
+        ]
 
 -- | If an address is discovered near the edge, we extend the address sequence,
 -- otherwise we return the pool untouched.
@@ -693,7 +703,7 @@ instance
     , MkKeyFingerprint k Address
     ) => IsOurs (SeqState n k) Address
   where
-    isOurs addr (SeqState !s1 !s2 !ixs !rpk !prefix) =
+    isOurs addr (SeqState !s1 !s2 !ixs !rpk !prefix) = trace traceMessage $
         let
             DerivationPrefix (purpose, coinType, accountIx) = prefix
             (internal, !s1') = lookupAddress @n (const Used) addr s1
@@ -704,25 +714,34 @@ instance
                 Just ix -> updatePendingIxs ix ixs
 
             ours = case (external, internal) of
-                (Just addrIx, _) -> Just $ NE.fromList
+                (Just addrIx, _) -> trace (traceMessage <> "Just external") $
+                    Just $ NE.fromList
                     [ DerivationIndex $ getIndex purpose
                     , DerivationIndex $ getIndex coinType
                     , DerivationIndex $ getIndex accountIx
                     , DerivationIndex $ getIndex utxoExternal
                     , DerivationIndex $ getIndex addrIx
                     ]
 
-                (_, Just addrIx) -> Just $ NE.fromList
+                (_, Just addrIx) -> trace (traceMessage <> "Just internal") $
+                    Just $ NE.fromList
                     [ DerivationIndex $ getIndex purpose
                     , DerivationIndex $ getIndex coinType
                     , DerivationIndex $ getIndex accountIx
                     , DerivationIndex $ getIndex utxoInternal
                     , DerivationIndex $ getIndex addrIx
                     ]
 
-                _ -> Nothing
+                _ -> trace (traceMessage <> " Nothing") Nothing
         in
             (ixs' `deepseq` ours `deepseq` ours, SeqState s1' s2' ixs' rpk prefix)
+      where
+        traceMessage = mconcat
+            [ "########\n"
+            , "isOurs called with"
+            , "addr:", show (toText addr), " "
+            , "ixs:", show ixs, " "
+            ]
 
 instance
     ( SoftDerivation k
@@ -742,8 +761,18 @@ instance
             accountXPub = accountPubKey intPool
             addressXPub = deriveAddressPublicKey accountXPub UTxOInternal ix
             addr = mkAddress addressXPub rpk
+            traceMessage = mconcat
+                [ "########\n"
+                , "genChange called: "
+                , "addr: ", show (toText addr)
+                , "pending: ", show pending
+                , "pending': ", show pending'
+                ]
         in
+            trace traceMessage $
             (addr, SeqState intPool extPool pending' rpk path)
+      where
+
 
 instance
     ( IsOurs (SeqState n k) Address