diff options
Diffstat (limited to 'src/Data/PacketBuffer.hs')
-rw-r--r-- | src/Data/PacketBuffer.hs | 29 |
1 files changed, 19 insertions, 10 deletions
diff --git a/src/Data/PacketBuffer.hs b/src/Data/PacketBuffer.hs index c5ede50d..f01abb28 100644 --- a/src/Data/PacketBuffer.hs +++ b/src/Data/PacketBuffer.hs | |||
@@ -1,9 +1,12 @@ | |||
1 | {-# LANGUAGE TupleSections #-} | 1 | {-# LANGUAGE TupleSections #-} |
2 | {-# LANGUAGE DeriveFunctor #-} | ||
2 | module Data.PacketBuffer | 3 | module Data.PacketBuffer |
3 | ( PacketBuffer | 4 | ( PacketBuffer |
4 | , newPacketBuffer | 5 | , newPacketBuffer |
5 | , PacketEvent(..) | 6 | , PacketOutboundEvent(..) |
6 | , grokPacket | 7 | , PacketInboundEvent(..) |
8 | , grokOutboundPacket | ||
9 | , grokInboundPacket | ||
7 | , awaitReadyPacket | 10 | , awaitReadyPacket |
8 | , packetNumbersToRequest | 11 | , packetNumbersToRequest |
9 | , expectingSequenceNumber | 12 | , expectingSequenceNumber |
@@ -32,17 +35,21 @@ newPacketBuffer = PacketBuffer <$> Q.new 200 0 | |||
32 | <*> Q.new 400 0 | 35 | <*> Q.new 400 0 |
33 | 36 | ||
34 | -- | Input for 'grokPacket'. | 37 | -- | Input for 'grokPacket'. |
35 | data PacketEvent a b | 38 | data PacketOutboundEvent b |
36 | = PacketSent { peSeqNum :: Word32 -- ^ Sequence number for payload. | 39 | = PacketSent { poSeqNum :: Word32 -- ^ Sequence number for payload. |
37 | , peSentPayload :: b -- ^ Payload packet we sent to them. | 40 | , poSentPayload :: b -- ^ Payload packet we sent to them. |
38 | } | 41 | } |
39 | | PacketReceived { peSeqNum :: Word32 -- ^ Sequence number for payload. | 42 | deriving Functor |
43 | |||
44 | data PacketInboundEvent a | ||
45 | = PacketReceived { peSeqNum :: Word32 -- ^ Sequence number for payload. | ||
40 | , peReceivedPayload :: a -- ^ Payload packet they sent to us. | 46 | , peReceivedPayload :: a -- ^ Payload packet they sent to us. |
41 | , peAcknowledgedNum :: Word32 -- ^ Earliest sequence number they've seen from us. | 47 | , peAcknowledgedNum :: Word32 -- ^ Earliest sequence number they've seen from us. |
42 | } | 48 | } |
43 | | PacketReceivedLossy { peSeqNum :: Word32 -- ^ Sequence number for lossy packet. | 49 | | PacketReceivedLossy { peSeqNum :: Word32 -- ^ Sequence number for lossy packet. |
44 | , peAcknowledgedNum :: Word32 -- ^ Earliest sequence number they've seen from us. | 50 | , peAcknowledgedNum :: Word32 -- ^ Earliest sequence number they've seen from us. |
45 | } | 51 | } |
52 | deriving Functor | ||
46 | 53 | ||
47 | -- | Whenever a packet is received or sent (but not resent) from the network, | 54 | -- | Whenever a packet is received or sent (but not resent) from the network, |
48 | -- this function should be called to update the relevant buffers. | 55 | -- this function should be called to update the relevant buffers. |
@@ -50,14 +57,16 @@ data PacketEvent a b | |||
50 | -- On outgoing packets, if the outbound buffer is full, this will block | 57 | -- On outgoing packets, if the outbound buffer is full, this will block |
51 | -- indefinitely until it is called in another thread with an inbound | 58 | -- indefinitely until it is called in another thread with an inbound |
52 | -- acknowledgement. | 59 | -- acknowledgement. |
53 | grokPacket :: PacketBuffer a b -> PacketEvent a b -> STM () | 60 | grokOutboundPacket :: PacketBuffer a b -> PacketOutboundEvent b -> STM () |
54 | grokPacket (PacketBuffer _ outb) (PacketSent seqno a) | 61 | grokOutboundPacket (PacketBuffer _ outb) (PacketSent seqno a) |
55 | = do (n,_) <- Q.enqueue outb seqno a | 62 | = do (n,_) <- Q.enqueue outb seqno a |
56 | when (n/=0) retry | 63 | when (n/=0) retry |
57 | grokPacket (PacketBuffer inb outb) (PacketReceived seqno a ack) | 64 | |
65 | grokInboundPacket :: PacketBuffer a b -> PacketInboundEvent a -> STM () | ||
66 | grokInboundPacket (PacketBuffer inb outb) (PacketReceived seqno a ack) | ||
58 | = do Q.enqueue inb seqno a | 67 | = do Q.enqueue inb seqno a |
59 | Q.dropPacketsBefore outb ack | 68 | Q.dropPacketsBefore outb ack |
60 | grokPacket (PacketBuffer inb outb) (PacketReceivedLossy seqno ack) | 69 | grokInboundPacket (PacketBuffer inb outb) (PacketReceivedLossy seqno ack) |
61 | = do Q.observeOutOfBand inb seqno | 70 | = do Q.observeOutOfBand inb seqno |
62 | Q.dropPacketsBefore outb ack | 71 | Q.dropPacketsBefore outb ack |
63 | 72 | ||