diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/BitTorrent/MainlineDHT.hs | 5 | ||||
-rw-r--r-- | src/Network/QueryResponse.hs | 8 | ||||
-rw-r--r-- | src/Network/Tox.hs | 4 |
3 files changed, 10 insertions, 7 deletions
diff --git a/src/Network/BitTorrent/MainlineDHT.hs b/src/Network/BitTorrent/MainlineDHT.hs index c0413322..c9abf003 100644 --- a/src/Network/BitTorrent/MainlineDHT.hs +++ b/src/Network/BitTorrent/MainlineDHT.hs | |||
@@ -583,8 +583,11 @@ newClient swarms addr = do | |||
583 | gen :: Word16 -> (TransactionId, Word16) | 583 | gen :: Word16 -> (TransactionId, Word16) |
584 | gen cnt = (TransactionId $ S.encode cnt, cnt+1) | 584 | gen cnt = (TransactionId $ S.encode cnt, cnt+1) |
585 | 585 | ||
586 | ignoreParseError :: String -> IO () | ||
587 | ignoreParseError _ = return () | ||
588 | |||
586 | client = Client | 589 | client = Client |
587 | { clientNet = addHandler ignoreErrors (handleMessage client) net | 590 | { clientNet = addHandler ignoreParseError (handleMessage client) net |
588 | , clientDispatcher = dispatch | 591 | , clientDispatcher = dispatch |
589 | , clientErrorReporter = ignoreErrors -- printErrors stderr | 592 | , clientErrorReporter = ignoreErrors -- printErrors stderr |
590 | , clientPending = map_var | 593 | , clientPending = map_var |
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs index 492b7bb4..f15a0855 100644 --- a/src/Network/QueryResponse.hs +++ b/src/Network/QueryResponse.hs | |||
@@ -135,18 +135,18 @@ partitionTransportM parse encodex tr = do | |||
135 | -- * f add x --> Nothing, consume x | 135 | -- * f add x --> Nothing, consume x |
136 | -- --> Just id, leave x to a different handler | 136 | -- --> Just id, leave x to a different handler |
137 | -- --> Just g, apply g to x and leave that to a different handler | 137 | -- --> Just g, apply g to x and leave that to a different handler |
138 | addHandler :: ErrorReporter addr x meth tid err -> (addr -> x -> IO (Maybe (x -> x))) -> Transport err addr x -> Transport err addr x | 138 | addHandler :: (err -> IO ()) -> (addr -> x -> IO (Maybe (x -> x))) -> Transport err addr x -> Transport err addr x |
139 | addHandler err f tr = tr | 139 | addHandler onParseError f tr = tr |
140 | { awaitMessage = \kont -> fix $ \eat -> awaitMessage tr $ \m -> do | 140 | { awaitMessage = \kont -> fix $ \eat -> awaitMessage tr $ \m -> do |
141 | case m of | 141 | case m of |
142 | Just (Right (x, addr)) -> f addr x >>= maybe eat (kont . Just . Right . (, addr) . ($ x)) | 142 | Just (Right (x, addr)) -> f addr x >>= maybe eat (kont . Just . Right . (, addr) . ($ x)) |
143 | Just (Left e ) -> reportParseError err e >> kont (Just $ Left e) | 143 | Just (Left e ) -> onParseError e >> kont (Just $ Left e) |
144 | Nothing -> kont $ Nothing | 144 | Nothing -> kont $ Nothing |
145 | } | 145 | } |
146 | 146 | ||
147 | -- | Modify a 'Transport' to invoke an action upon every received packet. | 147 | -- | Modify a 'Transport' to invoke an action upon every received packet. |
148 | onInbound :: (addr -> x -> IO ()) -> Transport err addr x -> Transport err addr x | 148 | onInbound :: (addr -> x -> IO ()) -> Transport err addr x -> Transport err addr x |
149 | onInbound f tr = addHandler ignoreErrors (\addr x -> f addr x >> return (Just id)) tr | 149 | onInbound f tr = addHandler (const $ return ()) (\addr x -> f addr x >> return (Just id)) tr |
150 | 150 | ||
151 | -- * Using a query\/response client. | 151 | -- * Using a query\/response client. |
152 | 152 | ||
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index 4cc762c4..79bd68ac 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs | |||
@@ -204,7 +204,7 @@ newClient drg net classify selfAddr handlers modifytbl modifynet = do | |||
204 | eprinter = printErrors stderr | 204 | eprinter = printErrors stderr |
205 | mkclient (tbl,var) handlers = | 205 | mkclient (tbl,var) handlers = |
206 | let client = Client | 206 | let client = Client |
207 | { clientNet = addHandler eprinter (handleMessage client) $ modifynet client net | 207 | { clientNet = addHandler (reportParseError eprinter) (handleMessage client) $ modifynet client net |
208 | , clientDispatcher = dispatch tbl var handlers client | 208 | , clientDispatcher = dispatch tbl var handlers client |
209 | , clientErrorReporter = eprinter { reportTimeout = reportTimeout ignoreErrors } | 209 | , clientErrorReporter = eprinter { reportTimeout = reportTimeout ignoreErrors } |
210 | , clientPending = var | 210 | , clientPending = var |
@@ -314,7 +314,7 @@ newTox keydb addr = do | |||
314 | { toxDHT = dhtclient | 314 | { toxDHT = dhtclient |
315 | , toxOnion = onionclient | 315 | , toxOnion = onionclient |
316 | , toxToRoute = onInbound (updateRoster roster) dtacrypt | 316 | , toxToRoute = onInbound (updateRoster roster) dtacrypt |
317 | , toxCrypto = addHandler (error "printErrors stderr") (cryptoNetHandler sessionsState) cryptonet | 317 | , toxCrypto = addHandler (reportParseError $ printErrors stderr) (cryptoNetHandler sessionsState) cryptonet |
318 | , toxCryptoKeys = crypto | 318 | , toxCryptoKeys = crypto |
319 | , toxRouting = routing | 319 | , toxRouting = routing |
320 | , toxTokens = toks | 320 | , toxTokens = toks |