fix thread cleanup bug

1 files changed, 11 insertions, 3 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 03207e06..bd421ea3 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -779,12 +779,14 @@ runUponHandshake netCryptoSession0 addr pktoq = do
                 dput XNetCrypto $ "Dequeued::" ++ show (bufferData cd) ++ " now running hook..."
                 void $ runCryptoHook netCryptoSession0 (bufferData cd)
             loop
+    atomically $ writeTVar (ncDequeueThread netCryptoSession0) (Just threadid)
     dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoDequeue." ++ show (key2id remotePublicKey) ++ sidStr
+
     -- launch request thread
     -- (In terms of data dependency, this thread could be launched prior to handshake)
-    threadid <- forkIO $ do
+    reqthreadId <- forkIO $ do
         tid <- myThreadId
-        atomically $ writeTVar (ncDequeueThread netCryptoSession0) (Just tid)
+        atomically $ writeTVar (ncRequestThread netCryptoSession0) (Just tid)
         labelThread tid ("NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr)
         fix $ \loop -> do
             atomically (readTVar (ncRequestInterval netCryptoSession0)) >>= threadDelay . (* 1000)
@@ -798,7 +800,9 @@ runUponHandshake netCryptoSession0 addr pktoq = do
                     PQ.OGSuccess -> return ()
                     _ -> retry
             loop
+    atomically $ writeTVar (ncRequestThread netCryptoSession0) (Just reqthreadId)
     dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr
+
     -- launch dequeueOutgoing thread
     threadidOutgoing <- forkIO $ do
         tid <- myThreadId
@@ -809,10 +813,13 @@ runUponHandshake netCryptoSession0 addr pktoq = do
             dput XNetCrypto "NetCryptoDequeueOutgoing thread... Sending encrypted Packet"
             sendSessionPacket sessions addr pkt
             loop
+    atomically $ writeTVar (ncDequeueOutGoingThread netCryptoSession0) (Just threadidOutgoing)
     dput XNetCrypto $ "runUponHandshake: " ++ show threadidOutgoing ++ " = NetCryptoDequeueOutgoing." ++ show (key2id remotePublicKey) ++ sidStr
+
     -- launch ping Machine thread
     pingMachine <- forkPingMachineDynamic ("NetCrypto." ++ show (key2id remotePublicKey) ++ sidStr) (ncIdleEvent netCryptoSession0) (ncTimeOut netCryptoSession0)
     atomically $ writeTVar (ncPingMachine netCryptoSession0) (Just pingMachine)
+
     -- launch ping thread
     pingThreadId <- forkIO $ do
         tid <- myThreadId
@@ -827,10 +834,11 @@ runUponHandshake netCryptoSession0 addr pktoq = do
                 Right _ -> return ()
             loop
     atomically $ writeTVar (ncPingThread netCryptoSession0) (Just pingThreadId)
+
     -- launch IdleEvent thread
     idleThreadId <- forkIO $ do
         tid <- myThreadId
-        atomically $ writeTVar (ncPingThread netCryptoSession0) (Just tid)
+        atomically $ writeTVar (ncIdleEventThread netCryptoSession0) (Just tid)
         labelThread tid ("NetCryptoIdleEvent." ++ show (key2id remotePublicKey) ++ sidStr)
         event <- atomically $ pingWait pingMachine
         case event of