summaryrefslogtreecommitdiff
path: root/src/Network/QueryResponse.hs
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2018-08-22 22:04:33 -0400
committerJoe Crayne <joe@jerkface.net>2018-09-07 13:18:56 -0400
commitb597d554c2b970c775b2954709b397b0ddf6870d (patch)
treefbc8890026180a2d2c44d73f70f6e2145c3595b3 /src/Network/QueryResponse.hs
parent270f3e22e38938bfe4129c3a87b1b107265d0199 (diff)
Allow Transport inbound/outbout types to vary.
Diffstat (limited to 'src/Network/QueryResponse.hs')
-rw-r--r--src/Network/QueryResponse.hs20
1 files changed, 11 insertions, 9 deletions
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index 6df9ac5a..fdfbdbae 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -40,18 +40,20 @@ import System.Timeout
40import DPut 40import DPut
41 41
42-- | Three methods are required to implement a datagram based query\/response protocol. 42-- | Three methods are required to implement a datagram based query\/response protocol.
43data Transport err addr x = Transport 43data TransportA err addr x y = Transport
44 { -- | Blocks until an inbound packet is available. Returns 'Nothing' when 44 { -- | Blocks until an inbound packet is available. Returns 'Nothing' when
45 -- no more packets are expected due to a shutdown or close event. 45 -- no more packets are expected due to a shutdown or close event.
46 -- Otherwise, the packet will be parsed as type /x/ and an origin address 46 -- Otherwise, the packet will be parsed as type /x/ and an origin address
47 -- /addr/. Parse failure is indicated by the type 'err'. 47 -- /addr/. Parse failure is indicated by the type 'err'.
48 awaitMessage :: forall a. (Maybe (Either err (x, addr)) -> IO a) -> IO a 48 awaitMessage :: forall a. (Maybe (Either err (x, addr)) -> IO a) -> IO a
49 -- | Send an /x/ packet to the given destination /addr/. 49 -- | Send an /y/ packet to the given destination /addr/.
50 , sendMessage :: addr -> x -> IO () 50 , sendMessage :: addr -> y -> IO ()
51 -- | Shutdown and clean up any state related to this 'Transport'. 51 -- | Shutdown and clean up any state related to this 'Transport'.
52 , closeTransport :: IO () 52 , closeTransport :: IO ()
53 } 53 }
54 54
55type Transport err addr x = TransportA err addr x x
56
55-- | This function modifies a 'Transport' to use higher-level addresses and 57-- | This function modifies a 'Transport' to use higher-level addresses and
56-- packet representations. It could be used to change UDP 'ByteString's into 58-- packet representations. It could be used to change UDP 'ByteString's into
57-- bencoded syntax trees or to add an encryption layer in which addresses have 59-- bencoded syntax trees or to add an encryption layer in which addresses have
@@ -60,12 +62,12 @@ layerTransportM ::
60 (x -> addr -> IO (Either err (x', addr'))) 62 (x -> addr -> IO (Either err (x', addr')))
61 -- ^ Function that attempts to transform a low-level address/packet 63 -- ^ Function that attempts to transform a low-level address/packet
62 -- pair into a higher level representation. 64 -- pair into a higher level representation.
63 -> (x' -> addr' -> IO (x, addr)) 65 -> (y' -> addr' -> IO (y, addr))
64 -- ^ Function to encode a high-level address/packet into a lower level 66 -- ^ Function to encode a high-level address/packet into a lower level
65 -- representation. 67 -- representation.
66 -> Transport err addr x 68 -> TransportA err addr x y
67 -- ^ The low-level transport to be transformed. 69 -- ^ The low-level transport to be transformed.
68 -> Transport err addr' x' 70 -> TransportA err addr' x' y'
69layerTransportM parse encode tr = 71layerTransportM parse encode tr =
70 tr { awaitMessage = \kont -> 72 tr { awaitMessage = \kont ->
71 awaitMessage tr $ \m -> mapM (mapM $ uncurry parse) m >>= kont . fmap join 73 awaitMessage tr $ \m -> mapM (mapM $ uncurry parse) m >>= kont . fmap join
@@ -83,12 +85,12 @@ layerTransport ::
83 (x -> addr -> Either err (x', addr')) 85 (x -> addr -> Either err (x', addr'))
84 -- ^ Function that attempts to transform a low-level address/packet 86 -- ^ Function that attempts to transform a low-level address/packet
85 -- pair into a higher level representation. 87 -- pair into a higher level representation.
86 -> (x' -> addr' -> (x, addr)) 88 -> (y' -> addr' -> (y, addr))
87 -- ^ Function to encode a high-level address/packet into a lower level 89 -- ^ Function to encode a high-level address/packet into a lower level
88 -- representation. 90 -- representation.
89 -> Transport err addr x 91 -> TransportA err addr x y
90 -- ^ The low-level transport to be transformed. 92 -- ^ The low-level transport to be transformed.
91 -> Transport err addr' x' 93 -> TransportA err addr' x' y'
92layerTransport parse encode tr = 94layerTransport parse encode tr =
93 layerTransportM (\x addr -> return $ parse x addr) 95 layerTransportM (\x addr -> return $ parse x addr)
94 (\x' addr' -> return $ encode x' addr') 96 (\x' addr' -> return $ encode x' addr')