Packet request Thread, ready for testing

3 files changed, 25 insertions, 1 deletions

diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs
index 23db0ee0..560e7382 100644
--- a/src/Data/PacketQueue.hs
+++ b/src/Data/PacketQueue.hs
@@ -7,6 +7,7 @@
 module Data.PacketQueue
     ( PacketQueue
     , getCapacity
+    , getLastDequeuedPlus1
     , new
     , dequeue
     , getMissing
@@ -48,6 +49,9 @@ packetQueueViewList p = do
         f (n,Just x)  = Just (n,x)
     catMaybes . map f <$> getAssocs (pktq p)
 
+getLastDequeuedPlus1 :: PacketQueue a -> STM Word32
+getLastDequeuedPlus1 PacketQueue {seqno} = readTVar seqno
+
 getCapacity :: Applicative m => PacketQueue t -> m Word32
 getCapacity (PacketQueue { qsize }) = pure qsize
 
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 356ddf24..1cb9c48e 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -755,7 +755,13 @@ runUponHandshake netCryptoSession0 addr pktoq = do
             atomically (readTVar (ncRequestInterval netCryptoSession0)) >>= threadDelay
             nums <- atomically $ PQ.getMissing pktq
             dput XNetCrypto $ "(Request Thread) Missing Packets detected:" ++ show nums
-            dput XNetCrypto $ "TODO: compose PacketRequest message and send it."
+            getOutGoingParam <- PQ.readyOutGoing pktoq
+            atomically $ do 
+                seqno <- PQ.getLastDequeuedPlus1 pktq
+                ogresult <- PQ.tryAppendQueueOutgoing getOutGoingParam pktoq (createRequestPacket seqno nums)
+                case ogresult of
+                    PQ.OGSuccess -> return ()
+                    _ -> retry
             loop
     dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr
     -- launch dequeueOutgoing thread
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index fab0f3e2..67950854 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -8,6 +8,7 @@ module Network.Tox.Crypto.Transport
     ( parseCrypto
     , encodeCrypto
     , unpadCryptoMsg
+    , createRequestPacket
     , parseHandshakes
     , encodeHandshakes
     , CryptoData(..)
@@ -93,6 +94,19 @@ parseHandshakes bs                            _     = Left $ "parseHandshakes_:
 encodeHandshakes :: Handshake Encrypted -> SockAddr -> (ByteString, SockAddr)
 encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr)
 
+createRequestPacket :: Word32 -> [Word32] -> CryptoMessage
+createRequestPacket seqno xs = UpToN PacketRequest (B.pack ns)
+    where
+        ys = Prelude.map (subtract seqno) xs
+        reduceToSums [] = []
+        reduceToSums (x:xs) = x:(reduceToSums $ Prelude.map (subtract x) xs)
+        makeZeroes :: Word32 -> [Word32]
+        makeZeroes x
+            = let (d,m)= x `divMod` 255
+                  zeros= Prelude.replicate (fromIntegral d) 0
+                  in zeros ++ [m]
+        ns :: [Word8]
+        ns = Prelude.map fromIntegral (reduceToSums ys >>= makeZeroes)
 
 data Handshake (f :: * -> *) = Handshake
     { -- The cookie is a cookie obtained by