From c2937cc29fed0b09fbbdb7fe58fe49adc46b5d37 Mon Sep 17 00:00:00 2001
From: James Crayne <jim.crayne@gmail.com>
Date: Thu, 23 Nov 2017 03:03:51 +0000
Subject: dequeueOutgoing thread

---
 src/Network/Tox/Crypto/Handlers.hs | 11 +++++++++++
 1 file changed, 11 insertions(+)

(limited to 'src/Network/Tox/Crypto/Handlers.hs')

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 50dd8c67..ef7afe98 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE TypeOperators #-}
 module Network.Tox.Crypto.Handlers where
 
+import Network.QueryResponse
 import Network.Tox.NodeId
 import Network.Tox.Crypto.Transport
 import Network.Tox.DHT.Transport (Cookie(..),CookieData(..), CookieRequest(..), NoSpam(..))
@@ -127,6 +128,7 @@ data NetCryptoSessions = NCSessions
     , outboundQueueCapacity   :: Word32
     , nextSessionId           :: TVar SessionID
     , announceNewSessionHooks :: TVar [IOHook (Maybe NoSpam) NetCryptoSession]
+    , sessionTransport        :: Transport String SockAddr NetCrypto
     }
 
 type NewSessionHook = IOHook (Maybe NoSpam) NetCryptoSession
@@ -190,6 +192,7 @@ newSessionsState crypto unrechook hooks = do
                       , outboundQueueCapacity   = 400
                       , nextSessionId           = nextSessionId0
                       , announceNewSessionHooks = announceNewSessionHooks0
+                      , sessionTransport = error "Need to set sessionTransport field of NetCryptoSessions!"
                       }
 
 data HandshakeParams
@@ -376,6 +379,14 @@ freshCryptoSession  sessions
             cd <- atomically $ PQ.dequeue pktq
             _ <- runCryptoHook (netCryptoSession0 {ncDequeueThread=Just tid}) cd
             loop
+    -- launch dequeueOutgoing thread
+    threadidOutgoing <- forkIO $ do
+        tid <- myThreadId
+        labelThread tid ("NetCryptoDequeueOutgoing." ++ show (key2id remotePublicKey))
+        fix $ \loop -> do
+            (_,pkt) <- atomically $ PQ.dequeueOutgoing pktoq
+            sendMessage (sessionTransport sessions) addr (NetCrypto pkt)
+            loop
     -- launch ping thread
     fuzz <- randomRIO (0,2000)
     pingMachine <- forkPingMachine ("NetCrypto." ++ show (key2id remotePublicKey)) (15000 + fuzz) 2000
-- 
cgit v1.2.3