1 files changed, 19 insertions, 1 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 3336052b..5192e180 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -768,9 +768,21 @@ runUponHandshake netCryptoSession0 addr pktoq = do
             sendSessionPacket sessions addr pkt
             loop
     dput XNetCrypto $ "runUponHandshake: " ++ show threadidOutgoing ++ " = NetCryptoDequeueOutgoing." ++ show (key2id remotePublicKey)
-    -- launch ping thread
+    -- launch ping Machine thread
     fuzz <- randomRIO (0,2000)
     pingMachine <- forkPingMachine ("NetCrypto." ++ show (key2id remotePublicKey)) (15000 + fuzz) 2000
+    pingThreadId <- forkIO $ do
+        tid <- myThreadId
+        event <- atomically $ pingWait pingMachine
+        labelThread tid ("NetCryptoPingSender." ++ show (key2id remotePublicKey) ++ "." ++ show (ncSessionId netCryptoSession0))
+        case event of
+            PingIdle -> do
+                dput XNetCrypto $ "pingThread (session: " ++ show (ncSessionId netCryptoSession0) ++ ") PingIdle"
+                lr <- sendPing crypto netCryptoSession0
+                case lr of
+                    Left s -> dput XNetCrypto $ "(pingThread session: " ++ show (ncSessionId netCryptoSession0) ++ ") " ++ s
+                    Right _ -> return ()
+            PingTimeOut -> dput XNetCrypto $ "(pingThread session: " ++ show (ncSessionId netCryptoSession0) ++ ") PingTimeOut TODO"
     -- update session with thread ids
     let netCryptoSession = netCryptoSession0 {ncDequeueThread=Just threadid, ncPingMachine=Just pingMachine}
     -- add this session to the lookup maps
@@ -1173,6 +1185,12 @@ sendCrypto crypto session updateLocal cm = do
             PQ.OGFull       -> return (Left "Outgoing packet buffer is full")
             PQ.OGEncodeFail -> return (Left "Failed to encode outgoing packet")
 
+sendPing :: TransportCrypto -> NetCryptoSession -> IO (Either String ())
+sendPing crypto session = do
+    let cm=OneByte PING
+    addMsgToLastN False (cm ^. messageType) session (Out cm)
+    sendCrypto crypto session (return ()) (OneByte PING)
+
 sendOnline :: TransportCrypto -> NetCryptoSession -> IO (Either String ())
 sendOnline crypto session = do
     let cm=OneByte ONLINE