Improved debug prints.

1 files changed, 13 insertions, 2 deletions

diff --git a/dht/src/Network/Tox/Onion/Handlers.hs b/dht/src/Network/Tox/Onion/Handlers.hs
index 45795312..8db1c534 100644
--- a/dht/src/Network/Tox/Onion/Handlers.hs
+++ b/dht/src/Network/Tox/Onion/Handlers.hs
@@ -272,6 +272,15 @@ announceSerializer getTimeout = MethodSerializer
 -- aggressively reannounce itself and search for friends as if it was just
 -- started.
 
+showResponse :: Bool -> NodeInfo -> AnnounceRequest -> AnnounceResponse -> String
+showResponse is_async them req r = unlines $ map (mappend $ show them ++ " --> ") $
+    [ "AnnounceResponse" ++ if is_async then " -- async" else ""
+    , "  { announceSeeking = " ++ show (announceSeeking req)
+    , "  , is_stored     = " ++ show (is_stored r)
+    , "  , announceNodes = "
+    ] ++ case announceNodes r of
+        SendNodes ns -> map (mappend "      " . show) ns
+    ++ [ "  }" ]
 
 sendOnion :: (OnionDestination r -> STM (OnionDestination r, Int))
             -> Client r
@@ -283,7 +292,8 @@ sendOnion getTimeout client req oaddr unwrap =
     -- Four tries and then we tap out.
     flip fix 4 $ \loop n -> do
         mb <- QR.sendQuery client (announceSerializer getTimeout) req oaddr
-        forM_ mb $ \r -> dput XAnnounce $ show (onionNodeInfo oaddr) ++ " sent response: " ++ show r
+        forM_ mb $ \mr -> forM_ mr $ \r ->
+            dput XAnnounceResponse $ showResponse False (onionNodeInfo oaddr) req r
         let re = if n>0 then loop $! n - 1 else return Canceled
         case mb of
             Success x -> maybe re (return . Success . unwrap (onionNodeInfo oaddr)) x
@@ -300,7 +310,8 @@ asyncOnion :: (OnionDestination r -> STM (OnionDestination r, Int))
 asyncOnion getTimeout client req oaddr unwrap withResult = do
     -- TODO: Restore "Four tries and then we tap out" behavior.
     qid <- QR.asyncQuery client (announceSerializer getTimeout) req oaddr $ \k mb -> do
-            forM_ mb $ \r -> dput XAnnounce $ show (onionNodeInfo oaddr) ++ " async sent response: " ++ show r
+            forM_ mb $ \mr -> forM_ mr $ \r ->
+                dput XAnnounceResponse $ showResponse True (onionNodeInfo oaddr) req r
             withResult k $ case mb of
                 Success x -> maybe (TimedOut)
                                    (Success . unwrap (onionNodeInfo oaddr))