diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Data/PacketQueue.hs | 18 |
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 | |||
12 | , observeOutOfBand | 12 | , observeOutOfBand |
13 | , PacketOutQueue | 13 | , PacketOutQueue |
14 | , newOutGoing | 14 | , newOutGoing |
15 | , readyOutGoing | ||
15 | , tryAppendQueueOutgoing | 16 | , tryAppendQueueOutgoing |
16 | , dequeueOutgoing | 17 | , dequeueOutgoing |
18 | , getHighestHandledPacketPlus1 | ||
17 | , mapOutGoing | 19 | , mapOutGoing |
18 | , OutGoingResult(..) | 20 | , OutGoingResult(..) |
19 | ) where | 21 | ) where |
@@ -158,8 +160,18 @@ tryAppendQueueOutgoing getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPac | |||
158 | writeTVar pktoPacketNo $! pktno' | 160 | writeTVar pktoPacketNo $! pktno' |
159 | writeArray (pktq pktoOutPQ) i (Just (pktno,pkt)) | 161 | writeArray (pktq pktoOutPQ) i (Just (pktno,pkt)) |
160 | return OGSuccess | 162 | return OGSuccess |
161 | -- queue is full, block until its not | 163 | -- queue is full |
162 | _ -> return OGFull | 164 | Just (n,_) -> do |
165 | nn <- getHighestHandledPacketPlus1 q | ||
166 | if (n < nn) | ||
167 | -- but we can overwrite an old packet | ||
168 | then do | ||
169 | modifyTVar' (buffend pktoOutPQ) (+1) | ||
170 | writeTVar pktoPacketNo $! pktno' | ||
171 | writeArray (pktq pktoOutPQ) i (Just (pktno,pkt)) | ||
172 | return OGSuccess | ||
173 | -- uh oh this packet is still needed... | ||
174 | else return OGFull | ||
163 | -- don't know how to send this message | 175 | -- don't know how to send this message |
164 | Nothing -> return OGEncodeFail | 176 | Nothing -> return OGEncodeFail |
165 | 177 | ||
@@ -172,3 +184,5 @@ dequeueOutgoing (PacketOutQueue {pktoOutPQ=PacketQueue { pktq, seqno, qsize }}) | |||
172 | modifyTVar' seqno succ | 184 | modifyTVar' seqno succ |
173 | return x | 185 | return x |
174 | 186 | ||
187 | getHighestHandledPacketPlus1 :: PacketOutQueue extra msg wire fromwire -> STM Word32 | ||
188 | getHighestHandledPacketPlus1 (PacketOutQueue { pktoInPQ }) = readTVar (buffend pktoInPQ) | ||