Outgoing Sink & overwrite old packets in PacketOutQueue

1 files changed, 16 insertions, 2 deletions

diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs
index cde26fb7..b7737656 100644
--- a/src/Data/PacketQueue.hs
+++ b/src/Data/PacketQueue.hs
@@ -12,8 +12,10 @@ module Data.PacketQueue
     , observeOutOfBand
     , PacketOutQueue
     , newOutGoing
+    , readyOutGoing
     , tryAppendQueueOutgoing
     , dequeueOutgoing
+    , getHighestHandledPacketPlus1
     , mapOutGoing
     , OutGoingResult(..)
     ) where
@@ -158,8 +160,18 @@ tryAppendQueueOutgoing getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPac
                         writeTVar pktoPacketNo $! pktno'
                         writeArray (pktq pktoOutPQ) i (Just (pktno,pkt))
                         return OGSuccess
-                    -- queue is full, block until its not
-                    _       -> return OGFull
+                    -- queue is full
+                    Just (n,_) -> do
+                        nn <- getHighestHandledPacketPlus1 q
+                        if (n < nn)
+                          -- but we can overwrite an old packet
+                          then do
+                            modifyTVar' (buffend pktoOutPQ) (+1)
+                            writeTVar pktoPacketNo $! pktno'
+                            writeArray (pktq pktoOutPQ) i (Just (pktno,pkt))
+                            return OGSuccess
+                          --  uh oh this packet is still needed...
+                          else return OGFull
         -- don't know how to send this message
         Nothing -> return OGEncodeFail
 
@@ -172,3 +184,5 @@ dequeueOutgoing (PacketOutQueue {pktoOutPQ=PacketQueue { pktq, seqno, qsize }})
     modifyTVar' seqno   succ
     return x
 
+getHighestHandledPacketPlus1 :: PacketOutQueue extra msg wire fromwire -> STM Word32
+getHighestHandledPacketPlus1 (PacketOutQueue { pktoInPQ }) = readTVar (buffend pktoInPQ)