add sensible timeout to sendLossless

(also call this function from dispatchMessage)

1 files changed, 1 insertions, 20 deletions

diff --git a/src/Network/Tox/AggregateSession.hs b/src/Network/Tox/AggregateSession.hs
index 26e7153a..27258a6f 100644
--- a/src/Network/Tox/AggregateSession.hs
+++ b/src/Network/Tox/AggregateSession.hs
@@ -242,26 +242,7 @@ dispatchMessage c msid msg = join $ atomically $ do
     imap <- readTVar (contactSession c)
     let go = case msid of Nothing  -> forM_ imap
                           Just sid -> forM_ (IntMap.lookup sid imap)
-    return $ go $ \con -> do
-        outq <- atomically $ do
-            mbOutq <- readTVar (ncOutgoingQueue $ singleSession con)
-            case mbOutq of
-                HaveHandshake outq -> return outq
-                NeedHandshake -> retry
-        extra <- nqToWireIO outq
-        r <- atomically $ do
-                    rTry <- tryAppendQueueOutgoing extra outq msg
-                    case rTry of
-                        OGFull -> retry
-                        OGSuccess x -> return (OGSuccess x)
-                        OGEncodeFail -> return OGEncodeFail
-        case r of
-            OGSuccess x  -> case ncSockAddr (singleSession con) of
-                HaveDHTKey saddr -> sendSessionPacket (ncAllSessions $ singleSession con) saddr x
-                _                    -> return ()
-            OGEncodeFail -> dput XMisc ("FAILURE to Encode Outgoing: " ++ show msg)
-            _                -> return ()
-
+    return $ go $ \con -> sendLossless (transportCrypto (ncAllSessions (singleSession con))) (singleSession con) msg
 
 -- | Retry until:
 --