Debug prints.

2 files changed, 6 insertions, 3 deletions

diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index 01981cc8..c4ff50e3 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -231,7 +231,7 @@ asyncQuery_ (Client net d err pending whoami _) meth q addr0 withResponse = do
              `catchIOError` (\e -> return Nothing)
     return (tid,now,expiry)
 
-asyncQuery :: Client err meth tid addr x
+asyncQuery :: Show meth => Client err meth tid addr x
               -> MethodSerializer tid addr x meth a b
               -> a
               -> addr
@@ -240,9 +240,11 @@ asyncQuery :: Client err meth tid addr x
 asyncQuery client meth q addr withResponse0 = do
     tm <- getSystemTimerManager
     tidvar <- newEmptyMVar
-    timedout <- registerTimeout tm 300000000 $ do
+    timedout <- registerTimeout tm 1000000 $ do
+            dput XMisc $ "async TIMEDOUT " ++ show (method meth)
             withResponse0 Nothing
             tid <- takeMVar tidvar
+            dput XMisc $ "async TIMEDOUT mvar " ++ show (method meth)
             case client of
                 Client { clientDispatcher = d, clientPending = pending } -> do
                     atomically $ readTVar pending >>= dispatchCancel (tableMethods d) tid >>= writeTVar pending
@@ -251,6 +253,7 @@ asyncQuery client meth q addr withResponse0 = do
         withResponse0 x
     putMVar tidvar tid
     updateTimeout tm timedout expiry
+    dput XMisc $ "FIN asyncQuery "++show (method meth)++" TIMEOUT="++show expiry
 
 -- | Send a query to a remote peer.  Note that this function will always time
 -- out if 'forkListener' was never invoked to spawn a thread to receive and
diff --git a/src/Network/Tox/TCP.hs b/src/Network/Tox/TCP.hs
index 9c1ffe48..13da804f 100644
--- a/src/Network/Tox/TCP.hs
+++ b/src/Network/Tox/TCP.hs
@@ -110,7 +110,7 @@ tcpStream crypto = StreamHandshake
             , streamDecode =
                 let go h = decode <$> hGet h 2 >>= \case
                         Left e    -> do
-                            dput XTCP $ "TCP: Failed to get length: " ++ e
+                            dput XTCP $ "TCP: (" ++ show addr ++ ") Failed to get length: " ++ e
                             return Nothing
                         Right len -> do
                             decode <$> hGet h (fromIntegral (len :: Word16)) >>= \case