diff options
author | jim@bo <jim@bo> | 2018-06-22 15:46:43 -0400 |
---|---|---|
committer | jim@bo <jim@bo> | 2018-06-22 15:46:43 -0400 |
commit | 54af27be179f998b17ecff9b5499214df09fb0b2 (patch) | |
tree | f5f3be08a5a488ad782d811067664f190d7b19af /src/Data/PacketQueue.hs | |
parent | d96aa110fcc32d9a8afb14564f45f296dd1624e4 (diff) |
OutGoingResult now offers packet for convenience
Also, don't send anohter Online, just send duplicate packet.
Diffstat (limited to 'src/Data/PacketQueue.hs')
-rw-r--r-- | src/Data/PacketQueue.hs | 17 |
1 files changed, 12 insertions, 5 deletions
diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs index 59b41d91..82b6f8f0 100644 --- a/src/Data/PacketQueue.hs +++ b/src/Data/PacketQueue.hs | |||
@@ -208,8 +208,15 @@ newOutGoing inq towire toWireIO num capacity seqstart = do | |||
208 | , pktoToWire = towire | 208 | , pktoToWire = towire |
209 | } | 209 | } |
210 | 210 | ||
211 | data OutGoingResult = OGSuccess | OGFull | OGEncodeFail | 211 | data OutGoingResult a = OGSuccess a | OGFull | OGEncodeFail |
212 | deriving (Eq,Show) | 212 | deriving (Show) |
213 | |||
214 | instance Eq (OutGoingResult a) where | ||
215 | OGSuccess _ == OGSuccess _ = True | ||
216 | OGFull == OGFull = True | ||
217 | OGEncodeFail == OGEncodeFail = True | ||
218 | _ == _ = False | ||
219 | |||
213 | 220 | ||
214 | -- | do something in IO before appending to the queue | 221 | -- | do something in IO before appending to the queue |
215 | readyOutGoing :: PacketOutQueue extra msg wire fromwire -> IO (STM extra) | 222 | readyOutGoing :: PacketOutQueue extra msg wire fromwire -> IO (STM extra) |
@@ -265,7 +272,7 @@ peekPacket getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoT | |||
265 | -- | Convert a message to packet format and append it to the front of a queue | 272 | -- | Convert a message to packet format and append it to the front of a queue |
266 | -- used for outgoing messages. (Note that ‘front‛ usually means the higher | 273 | -- used for outgoing messages. (Note that ‘front‛ usually means the higher |
267 | -- index in this implementation.) | 274 | -- index in this implementation.) |
268 | tryAppendQueueOutgoing :: STM extra -> PacketOutQueue extra msg wire fromwire -> msg -> STM OutGoingResult | 275 | tryAppendQueueOutgoing :: STM extra -> PacketOutQueue extra msg wire fromwire -> msg -> STM (OutGoingResult wire) |
269 | tryAppendQueueOutgoing getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoToWireIO, pktoToWire }) msg | 276 | tryAppendQueueOutgoing getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoToWireIO, pktoToWire }) msg |
270 | = do | 277 | = do |
271 | be <- readTVar (buffend pktoOutPQ) | 278 | be <- readTVar (buffend pktoOutPQ) |
@@ -288,7 +295,7 @@ tryAppendQueueOutgoing getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPac | |||
288 | modifyTVar' (buffend pktoOutPQ) (+1) | 295 | modifyTVar' (buffend pktoOutPQ) (+1) |
289 | writeTVar pktoPacketNo $! pktno' | 296 | writeTVar pktoPacketNo $! pktno' |
290 | writeArray (pktq pktoOutPQ) i (Just (pktno,pkt)) | 297 | writeArray (pktq pktoOutPQ) i (Just (pktno,pkt)) |
291 | return OGSuccess | 298 | return (OGSuccess pkt) |
292 | -- queue is full | 299 | -- queue is full |
293 | Just (n,_) -> do | 300 | Just (n,_) -> do |
294 | nn <- getHighestHandledPacketPlus1 q | 301 | nn <- getHighestHandledPacketPlus1 q |
@@ -298,7 +305,7 @@ tryAppendQueueOutgoing getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPac | |||
298 | modifyTVar' (buffend pktoOutPQ) (+1) | 305 | modifyTVar' (buffend pktoOutPQ) (+1) |
299 | writeTVar pktoPacketNo $! pktno' | 306 | writeTVar pktoPacketNo $! pktno' |
300 | writeArray (pktq pktoOutPQ) i (Just (pktno,pkt)) | 307 | writeArray (pktq pktoOutPQ) i (Just (pktno,pkt)) |
301 | return OGSuccess | 308 | return (OGSuccess pkt) |
302 | -- uh oh this packet is still needed... | 309 | -- uh oh this packet is still needed... |
303 | else return OGFull | 310 | else return OGFull |
304 | -- don't know how to send this message | 311 | -- don't know how to send this message |