diff options
-rw-r--r-- | src/Data/PacketQueue.hs | 16 | ||||
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 6 |
2 files changed, 17 insertions, 5 deletions
diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs index 93256474..e0221f5a 100644 --- a/src/Data/PacketQueue.hs +++ b/src/Data/PacketQueue.hs | |||
@@ -209,10 +209,22 @@ data OutGoingResult = OGSuccess | OGFull | OGEncodeFail | |||
209 | readyOutGoing :: PacketOutQueue extra msg wire fromwire -> IO (STM extra) | 209 | readyOutGoing :: PacketOutQueue extra msg wire fromwire -> IO (STM extra) |
210 | readyOutGoing (PacketOutQueue {pktoToWireIO }) = pktoToWireIO | 210 | readyOutGoing (PacketOutQueue {pktoToWireIO }) = pktoToWireIO |
211 | 211 | ||
212 | getRequested :: STM extra -> PacketOutQueue extra msg wire fromwire -> Word32 -> [Word8] -> STM [Maybe (wire,Word32)] | 212 | getRequested :: STM extra -> PacketOutQueue extra msg wire fromwire -> Word32 -> [Word8] -> STM [Maybe (Word32,wire)] |
213 | getRequested _ _ _ [] = return [] | 213 | getRequested _ _ _ [] = return [] |
214 | getRequested getExtra pktoq snum ns = do | 214 | getRequested getExtra pktoq snum ns = do |
215 | error "todo getRequested" | 215 | let pnums = toPNums snum ns |
216 | indices = map toIndex pnums | ||
217 | forM indices $ \i -> readArray (pktq $ pktoOutPQ pktoq) i | ||
218 | where | ||
219 | toIndex :: Word32 -> Word32 | ||
220 | toIndex = (`mod` qsize (pktoOutPQ pktoq)) | ||
221 | |||
222 | toPNums :: Word32 -> [Word8] -> [Word32] | ||
223 | toPNums snum ns = reverse . snd $ foldl doOne ((snum - 1),[]) ns | ||
224 | where | ||
225 | doOne :: (Word32,[Word32]) -> Word8 -> (Word32,[Word32]) | ||
226 | doOne (addend,as) 0 = (addend+255,as) | ||
227 | doOne (addend,as) x = (addend,(fromIntegral x + addend):as) | ||
216 | 228 | ||
217 | peekPacket :: STM extra -> PacketOutQueue extra msg wire fromwire -> msg -> STM (Maybe (wire,Word32)) | 229 | peekPacket :: STM extra -> PacketOutQueue extra msg wire fromwire -> msg -> STM (Maybe (wire,Word32)) |
218 | peekPacket getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoToWireIO, pktoToWire }) msg | 230 | peekPacket getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoToWireIO, pktoToWire }) msg |
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index 66de618d..457171a9 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs | |||
@@ -1333,7 +1333,7 @@ defaultCryptoDataHooks | |||
1333 | ] | 1333 | ] |
1334 | 1334 | ||
1335 | handlePacketRequest :: NetCryptoSession -> CryptoData -> IO () | 1335 | handlePacketRequest :: NetCryptoSession -> CryptoData -> IO () |
1336 | handlePacketRequest session (CryptoData { bufferStart=buffstart | 1336 | handlePacketRequest session (CryptoData { bufferStart=num |
1337 | , bufferData=cm@(msgID -> PacketRequest) | 1337 | , bufferData=cm@(msgID -> PacketRequest) |
1338 | }) | let getbytes (OneByte _) = [] | 1338 | }) | let getbytes (OneByte _) = [] |
1339 | getbytes (TwoByte _ b) = [b] | 1339 | getbytes (TwoByte _ b) = [b] |
@@ -1346,8 +1346,8 @@ handlePacketRequest session (CryptoData { bufferStart=buffstart | |||
1346 | case mbOutQ of | 1346 | case mbOutQ of |
1347 | HaveHandshake pktoq -> do | 1347 | HaveHandshake pktoq -> do |
1348 | getOutGoingParam <-PQ.readyOutGoing pktoq | 1348 | getOutGoingParam <-PQ.readyOutGoing pktoq |
1349 | ps <- atomically $ PQ.getRequested getOutGoingParam pktoq buffstart bs | 1349 | ps <- atomically $ PQ.getRequested getOutGoingParam pktoq num bs |
1350 | let resend (Just (pkt,n)) = sendSessionPacket (ncAllSessions session) addr pkt | 1350 | let resend (Just (n,pkt)) = sendSessionPacket (ncAllSessions session) addr pkt |
1351 | resend _ = return () | 1351 | resend _ = return () |
1352 | mapM_ resend ps | 1352 | mapM_ resend ps |
1353 | _ -> return () | 1353 | _ -> return () |