PacketBuffer: compressSequenceNumbers utility (for tox PacketRequest).

1 files changed, 45 insertions, 10 deletions

diff --git a/src/Data/PacketBuffer.hs b/src/Data/PacketBuffer.hs
index d2e96d11..343cb04e 100644
--- a/src/Data/PacketBuffer.hs
+++ b/src/Data/PacketBuffer.hs
@@ -13,9 +13,12 @@ module Data.PacketBuffer
     , nextToSendSequenceNumber
     , retrieveForResend
     , decompressSequenceNumbers
+    , compressSequenceNumbers
+    , pbReport
     ) where
 
 import Data.PacketQueue as Q
+import DPut
 
 import Control.Concurrent.STM
 import Control.Monad
@@ -24,8 +27,7 @@ import Data.Word
 
 data PacketBuffer a b = PacketBuffer
     { inQueue   :: PacketQueue a
-    , outBuffer :: PacketQueue b
-    }
+    , outBuffer :: PacketQueue b }
 
 -- | Initialize the packet buffers.  Note, the capacity of the inbound packet
 -- queue is currently hardcoded to 200 packets and the capacity of the outbound
@@ -55,13 +57,13 @@ data PacketInboundEvent a
 -- | Whenever a packet is received or sent (but not resent) from the network,
 -- this function should be called to update the relevant buffers.
 --
--- On outgoing packets, if the outbound buffer is full, this will block
--- indefinitely until it is called in another thread with an inbound
--- acknowledgement.
-grokOutboundPacket :: PacketBuffer a b -> PacketOutboundEvent b -> STM ()
+-- On outgoing packets, if the outbound buffer is full, this will return
+-- True.  In this case, the caller may retry to enable blocking until
+-- 'grokInboundPacket' is called in another thread.
+grokOutboundPacket :: PacketBuffer a b -> PacketOutboundEvent b -> STM (Bool,(Word32,Word32))
 grokOutboundPacket (PacketBuffer _   outb) (PacketSent seqno a)
-    = do (n,_) <- Q.enqueue outb seqno a
-         when (n/=0) retry
+    = do (n,r) <- Q.enqueue outb seqno a
+         return (n/=0,(n,r))
 
 grokInboundPacket :: PacketBuffer a b -> PacketInboundEvent a -> STM ()
 grokInboundPacket (PacketBuffer inb outb) (PacketReceived seqno a ack)
@@ -100,13 +102,46 @@ retrieveForResend :: PacketBuffer a b -> [Word32] -> STM [(Word32,b)]
 retrieveForResend (PacketBuffer _ outb) seqnos =
     catMaybes <$> forM seqnos (\no -> fmap (no,) <$> Q.lookup outb no)
 
--- | Expand a compressed set of sequence numbers.  The first squence number is
+-- | Expand a compressed set of sequence numbers.  The first sequence number is
 -- given directly and the rest are computed using 8-bit offsets.  This is
 -- normally used to obtain input for 'retrieveForResend'.
 decompressSequenceNumbers :: Word32 -> [Word8] -> [Word32]
 decompressSequenceNumbers baseno ns = foldr doOne (const []) ns (baseno-1)
     where
         doOne :: Word8 -> (Word32 -> [Word32]) -> Word32 -> [Word32]
-        doOne 0 f addend = f (addend+255)
+        doOne 0 f addend = f (addend + 255)
         doOne x f addend = let y = fromIntegral x + addend
                            in y : f y
+
+compressSequenceNumbers :: Word32 -> [Word32] -> [Word8]
+compressSequenceNumbers baseno xs = foldr doOne (const []) xs (baseno-1)
+    where
+        doOne :: Word32 -> (Word32 -> [Word8]) -> Word32 -> [Word8]
+        doOne y f addend = case y - addend of
+            x | x < 255   -> fromIntegral x : f y
+              | otherwise -> 0 : doOne y f (addend + 255)
+
+{-
+compressSequenceNumbers :: Word32 -> [Word32] -> [Word8]
+compressSequenceNumbers seqno xs = let r = map fromIntegral (reduceToSums ys >>= makeZeroes)
+                                   in dtrace XNetCrypto ("compressSequenceNumbers " ++ show seqno ++ show xs ++ " --> "++show r) r
+    where
+        ys = Prelude.map (subtract (seqno - 1)) xs
+        reduceToSums [] = []
+        reduceToSums (x:xs) = x:(reduceToSums $ Prelude.map (subtract x) xs)
+        makeZeroes :: Word32 -> [Word32]
+    --  makeZeroes 0 = []
+        makeZeroes x
+            = let (d,m)= x `divMod` 255
+                  zeros= Prelude.replicate (fromIntegral d) 0
+                  in zeros ++ [m]
+-}
+
+pbReport :: String -> PacketBuffer a b -> STM String
+pbReport what (PacketBuffer inb outb) = do
+    inb_seqno <- getLastDequeuedPlus1 inb
+    inb_buffend <- getLastEnqueuedPlus1 inb
+    outb_seqno <- getLastDequeuedPlus1 outb
+    outb_bufend <- getLastEnqueuedPlus1 outb
+    return $ "PacketBuffer<"++what++"> Inbound" ++ show (inb_seqno, inb_buffend)
+                                  ++" Outbound" ++ show (outb_seqno, outb_bufend)