summaryrefslogtreecommitdiff
path: root/src/Data
diff options
context:
space:
mode:
authorjim@bo <jim@bo>2018-06-22 15:46:43 -0400
committerjim@bo <jim@bo>2018-06-22 15:46:43 -0400
commit54af27be179f998b17ecff9b5499214df09fb0b2 (patch)
treef5f3be08a5a488ad782d811067664f190d7b19af /src/Data
parentd96aa110fcc32d9a8afb14564f45f296dd1624e4 (diff)
OutGoingResult now offers packet for convenience
Also, don't send anohter Online, just send duplicate packet.
Diffstat (limited to 'src/Data')
-rw-r--r--src/Data/PacketQueue.hs17
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
211data OutGoingResult = OGSuccess | OGFull | OGEncodeFail 211data OutGoingResult a = OGSuccess a | OGFull | OGEncodeFail
212 deriving (Eq,Show) 212 deriving (Show)
213
214instance 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
215readyOutGoing :: PacketOutQueue extra msg wire fromwire -> IO (STM extra) 222readyOutGoing :: 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.)
268tryAppendQueueOutgoing :: STM extra -> PacketOutQueue extra msg wire fromwire -> msg -> STM OutGoingResult 275tryAppendQueueOutgoing :: STM extra -> PacketOutQueue extra msg wire fromwire -> msg -> STM (OutGoingResult wire)
269tryAppendQueueOutgoing getExtra q@(PacketOutQueue { pktoInPQ, pktoOutPQ, pktoPacketNo, pktoToWireIO, pktoToWire }) msg 276tryAppendQueueOutgoing 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