diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Data/PacketQueue.hs | 16 | ||||
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 12 |
2 files changed, 18 insertions, 10 deletions
diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs index 57845ae5..f1be1375 100644 --- a/src/Data/PacketQueue.hs +++ b/src/Data/PacketQueue.hs | |||
@@ -10,6 +10,7 @@ module Data.PacketQueue | |||
10 | , new | 10 | , new |
11 | , newOverwrite | 11 | , newOverwrite |
12 | , dequeue | 12 | , dequeue |
13 | , getMissing | ||
13 | , dequeueOrGetMissing | 14 | , dequeueOrGetMissing |
14 | , markButNotDequeue | 15 | , markButNotDequeue |
15 | , enqueue | 16 | , enqueue |
@@ -99,14 +100,27 @@ observeOutOfBand PacketQueue { seqno, qsize, buffend } numberOfNextLosslessPacke | |||
99 | 100 | ||
100 | -- | If seqno < buffend then return expected packet numbers for all | 101 | -- | If seqno < buffend then return expected packet numbers for all |
101 | -- the Nothings in the array between them. | 102 | -- the Nothings in the array between them. |
103 | -- Otherwise, return empty list. | ||
104 | getMissing :: PacketQueue a -> STM [Word32] | ||
105 | getMissing PacketQueue { pktq, seqno, qsize, buffend } = do | ||
106 | seqno0 <- readTVar seqno | ||
107 | buffend0 <- readTVar buffend | ||
108 | -- note relying on fact that [ b .. a ] is null when a < b | ||
109 | maybes <- mapM (readArray pktq) (take (fromIntegral qsize) $ map (`mod` qsize) [ seqno0 .. buffend0 ]) | ||
110 | let nums = map fst . filter (isNothing . snd) $ zip [buffend0 ..] maybes | ||
111 | return nums | ||
112 | |||
113 | -- | If seqno < buffend then return expected packet numbers for all | ||
114 | -- the Nothings in the array between them. | ||
102 | -- Otherwise, behave as 'dequeue' would. | 115 | -- Otherwise, behave as 'dequeue' would. |
116 | -- TODO: Do we need this function? Delete it if not. | ||
103 | dequeueOrGetMissing :: PacketQueue a -> STM (Either [Word32] a) | 117 | dequeueOrGetMissing :: PacketQueue a -> STM (Either [Word32] a) |
104 | dequeueOrGetMissing PacketQueue { pktq, seqno, qsize, buffend } = do | 118 | dequeueOrGetMissing PacketQueue { pktq, seqno, qsize, buffend } = do |
105 | seqno0 <- readTVar seqno | 119 | seqno0 <- readTVar seqno |
106 | buffend0 <- readTVar buffend | 120 | buffend0 <- readTVar buffend |
107 | if seqno0 < buffend0 | 121 | if seqno0 < buffend0 |
108 | then do | 122 | then do |
109 | maybes <- mapM (readArray pktq) (take (fromIntegral qsize) $ map (`mod` qsize) [ buffend0 .. seqno0 ]) | 123 | maybes <- mapM (readArray pktq) (take (fromIntegral qsize) $ map (`mod` qsize) [ seqno0 .. buffend0 ]) |
110 | let nums = map fst . filter (isNothing . snd) $ zip [buffend0 ..] maybes | 124 | let nums = map fst . filter (isNothing . snd) $ zip [buffend0 ..] maybes |
111 | return (Left nums) | 125 | return (Left nums) |
112 | else do | 126 | else do |
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index ea5c0f98..356ddf24 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs | |||
@@ -753,15 +753,9 @@ runUponHandshake netCryptoSession0 addr pktoq = do | |||
753 | labelThread tid ("NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr) | 753 | labelThread tid ("NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr) |
754 | fix $ \loop -> do | 754 | fix $ \loop -> do |
755 | atomically (readTVar (ncRequestInterval netCryptoSession0)) >>= threadDelay | 755 | atomically (readTVar (ncRequestInterval netCryptoSession0)) >>= threadDelay |
756 | result <- atomically $ PQ.dequeueOrGetMissing pktq | 756 | nums <- atomically $ PQ.getMissing pktq |
757 | case result of | 757 | dput XNetCrypto $ "(Request Thread) Missing Packets detected:" ++ show nums |
758 | Right cd -> do | 758 | dput XNetCrypto $ "TODO: compose PacketRequest message and send it." |
759 | dput XNetCrypto $ "Dequeued(Request Thread)::" ++ show (bufferData cd) ++ " now running hook..." | ||
760 | _ <- runCryptoHook netCryptoSession0 (bufferData cd) | ||
761 | return () | ||
762 | Left nums -> do | ||
763 | dput XNetCrypto $ "(Request Thread) Missing Packets detected:" ++ show nums | ||
764 | dput XNetCrypto $ "TODO: compose PacketRequest message and send it." | ||
765 | loop | 759 | loop |
766 | dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr | 760 | dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr |
767 | -- launch dequeueOutgoing thread | 761 | -- launch dequeueOutgoing thread |