diff options
-rw-r--r-- | src/Data/PacketQueue.hs | 4 | ||||
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 8 | ||||
-rw-r--r-- | src/Network/Tox/Crypto/Transport.hs | 14 |
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 @@ | |||
7 | module Data.PacketQueue | 7 | module Data.PacketQueue |
8 | ( PacketQueue | 8 | ( PacketQueue |
9 | , getCapacity | 9 | , getCapacity |
10 | , getLastDequeuedPlus1 | ||
10 | , new | 11 | , new |
11 | , dequeue | 12 | , dequeue |
12 | , getMissing | 13 | , getMissing |
@@ -48,6 +49,9 @@ packetQueueViewList p = do | |||
48 | f (n,Just x) = Just (n,x) | 49 | f (n,Just x) = Just (n,x) |
49 | catMaybes . map f <$> getAssocs (pktq p) | 50 | catMaybes . map f <$> getAssocs (pktq p) |
50 | 51 | ||
52 | getLastDequeuedPlus1 :: PacketQueue a -> STM Word32 | ||
53 | getLastDequeuedPlus1 PacketQueue {seqno} = readTVar seqno | ||
54 | |||
51 | getCapacity :: Applicative m => PacketQueue t -> m Word32 | 55 | getCapacity :: Applicative m => PacketQueue t -> m Word32 |
52 | getCapacity (PacketQueue { qsize }) = pure qsize | 56 | getCapacity (PacketQueue { qsize }) = pure qsize |
53 | 57 | ||
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 | |||
755 | atomically (readTVar (ncRequestInterval netCryptoSession0)) >>= threadDelay | 755 | atomically (readTVar (ncRequestInterval netCryptoSession0)) >>= threadDelay |
756 | nums <- atomically $ PQ.getMissing pktq | 756 | nums <- atomically $ PQ.getMissing pktq |
757 | dput XNetCrypto $ "(Request Thread) Missing Packets detected:" ++ show nums | 757 | dput XNetCrypto $ "(Request Thread) Missing Packets detected:" ++ show nums |
758 | dput XNetCrypto $ "TODO: compose PacketRequest message and send it." | 758 | getOutGoingParam <- PQ.readyOutGoing pktoq |
759 | atomically $ do | ||
760 | seqno <- PQ.getLastDequeuedPlus1 pktq | ||
761 | ogresult <- PQ.tryAppendQueueOutgoing getOutGoingParam pktoq (createRequestPacket seqno nums) | ||
762 | case ogresult of | ||
763 | PQ.OGSuccess -> return () | ||
764 | _ -> retry | ||
759 | loop | 765 | loop |
760 | dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr | 766 | dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr |
761 | -- launch dequeueOutgoing thread | 767 | -- 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 | |||
8 | ( parseCrypto | 8 | ( parseCrypto |
9 | , encodeCrypto | 9 | , encodeCrypto |
10 | , unpadCryptoMsg | 10 | , unpadCryptoMsg |
11 | , createRequestPacket | ||
11 | , parseHandshakes | 12 | , parseHandshakes |
12 | , encodeHandshakes | 13 | , encodeHandshakes |
13 | , CryptoData(..) | 14 | , CryptoData(..) |
@@ -93,6 +94,19 @@ parseHandshakes bs _ = Left $ "parseHandshakes_: | |||
93 | encodeHandshakes :: Handshake Encrypted -> SockAddr -> (ByteString, SockAddr) | 94 | encodeHandshakes :: Handshake Encrypted -> SockAddr -> (ByteString, SockAddr) |
94 | encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr) | 95 | encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr) |
95 | 96 | ||
97 | createRequestPacket :: Word32 -> [Word32] -> CryptoMessage | ||
98 | createRequestPacket seqno xs = UpToN PacketRequest (B.pack ns) | ||
99 | where | ||
100 | ys = Prelude.map (subtract seqno) xs | ||
101 | reduceToSums [] = [] | ||
102 | reduceToSums (x:xs) = x:(reduceToSums $ Prelude.map (subtract x) xs) | ||
103 | makeZeroes :: Word32 -> [Word32] | ||
104 | makeZeroes x | ||
105 | = let (d,m)= x `divMod` 255 | ||
106 | zeros= Prelude.replicate (fromIntegral d) 0 | ||
107 | in zeros ++ [m] | ||
108 | ns :: [Word8] | ||
109 | ns = Prelude.map fromIntegral (reduceToSums ys >>= makeZeroes) | ||
96 | 110 | ||
97 | data Handshake (f :: * -> *) = Handshake | 111 | data Handshake (f :: * -> *) = Handshake |
98 | { -- The cookie is a cookie obtained by | 112 | { -- The cookie is a cookie obtained by |