handlePacketRequest function

1 files changed, 29 insertions, 2 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 1cb9c48e..66de618d 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -741,8 +741,13 @@ runUponHandshake netCryptoSession0 addr pktoq = do
         labelThread tid ("NetCryptoDequeue." ++ show (key2id remotePublicKey) ++ sidStr)
         fix $ \loop -> do
             cd <- atomically $ PQ.dequeue pktq
-            dput XNetCrypto $ "Dequeued::" ++ show (bufferData cd) ++ " now running hook..."
-            _ <- runCryptoHook netCryptoSession0 (bufferData cd)
+            if msgID (bufferData cd) == PacketRequest
+              then do
+                dput XNetCrypto $ "Dequeued::PacketRequest seqno=" ++ show (bufferStart cd) ++ " " ++ show (bufferData cd)
+                handlePacketRequest netCryptoSession0 cd
+              else do
+                dput XNetCrypto $ "Dequeued::" ++ show (bufferData cd) ++ " now running hook..."
+                void $ runCryptoHook netCryptoSession0 (bufferData cd)
             loop
     dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoDequeue." ++ show (key2id remotePublicKey) ++ sidStr
     -- launch request thread
@@ -1327,6 +1332,28 @@ defaultCryptoDataHooks
             , (Msg KillPacket, [defaultKillHook])
             ]
 
+handlePacketRequest :: NetCryptoSession -> CryptoData -> IO ()
+handlePacketRequest session (CryptoData { bufferStart=buffstart
+                                        , bufferData=cm@(msgID -> PacketRequest)
+                                        }) | let getbytes (OneByte _) = []
+                                                 getbytes (TwoByte _ b) = [b]
+                                                 getbytes (UpToN _ bs) = B.unpack bs
+                                           , bs <- getbytes cm
+                                           , not (null bs)
+                                           , HaveDHTKey addr <- ncSockAddr session
+                                           = do
+    mbOutQ <- atomically $ readTVar (ncOutgoingQueue session)
+    case mbOutQ of
+        HaveHandshake pktoq -> do
+            getOutGoingParam <-PQ.readyOutGoing pktoq
+            ps <- atomically $ PQ.getRequested getOutGoingParam pktoq buffstart bs
+            let resend (Just (pkt,n)) = sendSessionPacket (ncAllSessions session) addr pkt
+                resend _ = return ()
+            mapM_ resend ps
+        _ -> return ()
+
+handlePacketRequest session cd = return ()
+
 defaultKillHook :: NetCryptoSession -> CryptoMessage -> IO (Maybe (CryptoMessage -> CryptoMessage))
 defaultKillHook session cm@(msgID -> KillPacket) = do
     dput XNetCrypto $ "Recieved kill packet (sessionid: " ++ show (ncSessionId session) ++ ") destroying session"