AggregateSession: Debug print on send exception.

1 files changed, 9 insertions, 1 deletions

diff --git a/src/Network/Tox/AggregateSession.hs b/src/Network/Tox/AggregateSession.hs
index 1dd10eef..2323673a 100644
--- a/src/Network/Tox/AggregateSession.hs
+++ b/src/Network/Tox/AggregateSession.hs
@@ -28,6 +28,7 @@ import qualified Data.IntMap.Strict  as IntMap
          ;import Data.IntMap.Strict  (IntMap)
 import Data.List
 import Data.Time.Clock.POSIX
+import System.IO.Error
 
 #ifdef THREAD_DEBUG
 import Control.Concurrent.Lifted.Instrument
@@ -120,7 +121,8 @@ keepAlive s q = do
                          , take 8 $ show $ key2id $ sTheirUserKey s
                          , show $ sSessionID s])
 
-    let outPrint e = dput XNetCrypto $ shows (sSessionID s,sTheirAddr s) $ " <-- " ++ e
+    let outPrint e   = dput XNetCrypto  $ shows (sSessionID s,sTheirAddr s) $ " <-- " ++ e
+        unexpected e = dput XUnexpected $ shows (sSessionID s,sTheirAddr s) $ " <-- " ++ e
 
         doAlive = do
             -- outPrint $ "Beacon"
@@ -130,6 +132,12 @@ keepAlive s q = do
             (ns,nmin) <- sMissingInbound s
             -- outPrint $ "PacketRequest " ++ show (nmin,ns)
             sendMessage (sTransport s) () (RequestResend PacketRequest ns)
+                `catchIOError` \e -> do
+                    unexpected $ "PacketRequest " ++ take 200 (show (nmin,length ns,ns))
+                    unexpected $ "PacketRequest: " ++ show e
+                    -- Quit thread by scheduling a timeout event.
+                    now <- getPOSIXTime
+                    atomically $ modifyTVar' q $ PSQ.insert (fromEnum DoTimeout) now
 
         re tm again e io = do
             io