summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent/MainlineDHT.hs5
-rw-r--r--src/Network/QueryResponse.hs8
-rw-r--r--src/Network/Tox.hs4
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
138addHandler :: ErrorReporter addr x meth tid err -> (addr -> x -> IO (Maybe (x -> x))) -> Transport err addr x -> Transport err addr x 138addHandler :: (err -> IO ()) -> (addr -> x -> IO (Maybe (x -> x))) -> Transport err addr x -> Transport err addr x
139addHandler err f tr = tr 139addHandler 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.
148onInbound :: (addr -> x -> IO ()) -> Transport err addr x -> Transport err addr x 148onInbound :: (addr -> x -> IO ()) -> Transport err addr x -> Transport err addr x
149onInbound f tr = addHandler ignoreErrors (\addr x -> f addr x >> return (Just id)) tr 149onInbound 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