packet request off by 1 serializatoin fix & getMissing fix

2 files changed, 34 insertions, 30 deletions

diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs
index b5d8a756..59b41d91 100644
--- a/src/Data/PacketQueue.hs
+++ b/src/Data/PacketQueue.hs
@@ -19,6 +19,7 @@ module Data.PacketQueue
     , packetQueueViewList
     , newOutGoing
     , readyOutGoing
+    , toPNums
     , getRequested
     , peekPacket
     , tryAppendQueueOutgoing
@@ -86,13 +87,18 @@ observeOutOfBand PacketQueue { seqno, qsize, buffend } numberOfNextLosslessPacke
 -- | If seqno < buffend then return expected packet numbers for all
 --   the Nothings in the array between them.
 --   Otherwise, return empty list.
-getMissing :: PacketQueue a -> STM [Word32]
+getMissing :: Show a => PacketQueue a -> STM [Word32]
 getMissing PacketQueue { pktq, seqno, qsize, buffend } = do
     seqno0 <- readTVar seqno
     buffend0 <- readTVar buffend
+    -- tput XNetCrypto $ "getMissing: seqno = " ++ show seqno0
+    -- tput XNetCrypto $ "getMissing: buffend0 = " ++ show buffend0
     -- note relying on fact that [ b .. a ] is null when a < b
-    maybes <- mapM (readArray pktq) (take (fromIntegral qsize) $ map (`mod` qsize) [ seqno0 .. buffend0 ])
-    let nums = map fst . filter (isNothing . snd) $ zip [buffend0 ..]  maybes
+    let indices = take (fromIntegral qsize) $ map (`mod` qsize) [ seqno0 .. buffend0 - 1]
+    -- tput XNetCrypto $ "indices: " ++ show indices
+    maybes <- mapM (\i -> do {x <- readArray pktq i; return (i,x)}) indices
+    -- tput XNetCrypto $ "getMissing: maybers = " ++ show maybes
+    let nums = map fst . filter (isNothing . snd) $ maybes
     return nums
 
 -- | If seqno < buffend then return expected packet numbers for all
@@ -209,23 +215,28 @@ data OutGoingResult = OGSuccess | OGFull | OGEncodeFail
 readyOutGoing :: PacketOutQueue extra msg wire fromwire -> IO (STM extra)
 readyOutGoing (PacketOutQueue {pktoToWireIO }) = pktoToWireIO
 
-getRequested :: STM extra -> PacketOutQueue extra msg wire fromwire -> Word32 -> [Word8] -> STM [Maybe (Word32,wire)]
+getRequested :: Show wire => STM extra -> PacketOutQueue extra msg wire fromwire -> Word32 -> [Word8] -> STM [Maybe (Word32,wire)]
 getRequested _        _     _    [] = return []
 getRequested getExtra pktoq snum ns = do
     let pnums = toPNums snum ns
         indices = map toIndex pnums
+    tput XNetCrypto $ "getRequested: snum = " ++ show snum
+    tput XNetCrypto $ "getRequested: pnums = " ++ show pnums ++ " indices = " ++ show indices
+    xs <- packetQueueViewList (pktoOutPQ pktoq)
+    tput XNetCrypto $ "getRequested viewList -> "
+    mapM_ (tput XNetCrypto . show) xs
     forM indices $ \i -> readArray (pktq $ pktoOutPQ pktoq) i
   where
     toIndex :: Word32 -> Word32
     toIndex = (`mod` qsize (pktoOutPQ pktoq))
 
-    toPNums :: Word32 -> [Word8] -> [Word32]
-    toPNums snum ns = reverse . snd $ foldl doOne (snum,[]) ns
-        where
-            doOne :: (Word32,[Word32]) -> Word8 -> (Word32,[Word32])
-            doOne (addend,as) 0 = (addend+255,as)
-            doOne (addend,as) x = let y = fromIntegral x + addend
-                                      in (y,y:as)
+toPNums :: Word32 -> [Word8] -> [Word32]
+toPNums snum ns = reverse . snd $ foldl doOne (snum-1,[]) ns
+    where
+        doOne :: (Word32,[Word32]) -> Word8 -> (Word32,[Word32])
+        doOne (addend,as) 0 = (addend+255,as)
+        doOne (addend,as) x = let y = fromIntegral x + addend
+                                  in (y,y:as)
 
 peekPacket :: STM extra -> PacketOutQueue extra msg wire fromwire -> msg -> STM (Maybe (wire,Word32))
 peekPacket getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoToWireIO, pktoToWire }) msg
@@ -256,40 +267,30 @@ peekPacket getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoT
 --   index in this implementation.)
 tryAppendQueueOutgoing :: STM extra -> PacketOutQueue extra msg wire fromwire -> msg -> STM OutGoingResult
 tryAppendQueueOutgoing getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoToWireIO, pktoToWire }) msg
-  = dtrace XNetCrypto "(tryAppendQueueOutgoing)" $ do
+  = do
     be <- readTVar (buffend pktoOutPQ)
     let i = be `mod` (qsize pktoOutPQ)
     let arrayEmpty :: MArray a e m => a Word32 e -> m Bool
         arrayEmpty ar = do (lowB,highB) <- getBounds ar
-                           let result= lowB > highB
-                           tput XNetCrypto
-                                        ("arrayEmpty result=" ++ show result
-                                        ++ " lowB="    ++ show lowB
-                                        ++ " highB = " ++ show highB
-                                        ++ " i = " ++ show i)
-                           return result
+                           return $ lowB > highB
     mbPkt <- do emp <- arrayEmpty (pktq pktoOutPQ)
-                if emp then tput XNetCrypto "(tryAppendQueueOutgoing empty)" >> return Nothing
-                       else do  tput XNetCrypto "(tryAppendQueueOutgoing nonempty)"
-                                result <- readArray (pktq pktoOutPQ) i
-                                tput XNetCrypto ("readArray (isJust result)=="  ++ show (isJust result))
-                                return result
+                if emp then return Nothing
+                       else do  readArray (pktq pktoOutPQ) i
     pktno <- readTVar pktoPacketNo
     nextno <- readTVar (seqno pktoInPQ)
     mbWire <- pktoToWire getExtra nextno be pktno msg
     -- TODO all the above lines ^^ can be replaced with call to peekPacket
-    case dtrace XNetCrypto "(tryAppendQueueOutgoing mbWire)" mbWire of
+    case mbWire of
         Just (pkt,pktno')
-            -> dtrace XNetCrypto "(tryAppendQueueOutgoing A)"
-             $ case mbPkt of
+            -> case mbPkt of
                     -- slot is free, insert element
-                    Nothing -> dtrace XNetCrypto "(tryAppendQueueOutgoing Nothing case)" $ do
+                    Nothing -> do
                         modifyTVar' (buffend pktoOutPQ) (+1)
                         writeTVar pktoPacketNo $! pktno'
                         writeArray (pktq pktoOutPQ) i (Just (pktno,pkt))
                         return OGSuccess
                     -- queue is full
-                    Just (n,_) -> dtrace XNetCrypto "tryAppendQueueOutgoing Just case)" $ do
+                    Just (n,_) -> do
                         nn <- getHighestHandledPacketPlus1 q
                         if (n < nn)
                           -- but we can overwrite an old packet
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index 678bb16d..ea8565b2 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE StandaloneDeriving #-}
 module Network.Tox.Crypto.Transport
     ( parseCrypto
     , encodeCrypto
@@ -97,7 +98,7 @@ 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
+        ys = Prelude.map (subtract (seqno - 1)) xs
         reduceToSums [] = []
         reduceToSums (x:xs) = x:(reduceToSums $ Prelude.map (subtract x) xs)
         makeZeroes :: Word32 -> [Word32]
@@ -168,6 +169,8 @@ data CryptoPacket (f :: * -> *) = CryptoPacket
     , pktData :: f CryptoData
     }
 
+deriving instance Show (CryptoPacket Encrypted)
+
 instance Sized CryptoData where
     size = contramap bufferStart size
             <> contramap bufferEnd size