diff options
Diffstat (limited to 'src/Network/QueryResponse.hs')
-rw-r--r-- | src/Network/QueryResponse.hs | 15 |
1 files changed, 13 insertions, 2 deletions
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs index dc25faf8..5803e756 100644 --- a/src/Network/QueryResponse.hs +++ b/src/Network/QueryResponse.hs | |||
@@ -29,6 +29,7 @@ import Data.Maybe | |||
29 | import Data.Typeable | 29 | import Data.Typeable |
30 | import Network.Socket | 30 | import Network.Socket |
31 | import Network.Socket.ByteString as B | 31 | import Network.Socket.ByteString as B |
32 | import System.IO | ||
32 | import System.IO.Error | 33 | import System.IO.Error |
33 | import System.Timeout | 34 | import System.Timeout |
34 | 35 | ||
@@ -73,7 +74,7 @@ sendQuery (Client net d err pending whoami _) meth q addr = do | |||
73 | return tid | 74 | return tid |
74 | self <- whoami (Just addr) | 75 | self <- whoami (Just addr) |
75 | sendMessage net addr (wrapQuery meth tid self addr q) | 76 | sendMessage net addr (wrapQuery meth tid self addr q) |
76 | mres <- timeout (methodTimeout meth) $ takeMVar mvar | 77 | mres <- timeout (1000000 * methodTimeout meth) $ takeMVar mvar |
77 | case mres of | 78 | case mres of |
78 | Just x -> return $ Just $ unwrapResponse meth x | 79 | Just x -> return $ Just $ unwrapResponse meth x |
79 | Nothing -> do | 80 | Nothing -> do |
@@ -198,7 +199,7 @@ onInbound f tr = tr | |||
198 | m <- awaitMessage tr | 199 | m <- awaitMessage tr |
199 | case m of | 200 | case m of |
200 | Just (Right (x, addr)) -> f addr x | 201 | Just (Right (x, addr)) -> f addr x |
201 | Nothing -> return () | 202 | _ -> return () |
202 | return m | 203 | return m |
203 | } | 204 | } |
204 | 205 | ||
@@ -327,6 +328,16 @@ ignoreErrors = ErrorReporter | |||
327 | , reportTimeout = \_ _ _ -> return () | 328 | , reportTimeout = \_ _ _ -> return () |
328 | } | 329 | } |
329 | 330 | ||
331 | printErrors :: ( Show addr | ||
332 | , Show meth | ||
333 | ) => Handle -> ErrorReporter addr x meth tid String | ||
334 | printErrors h = ErrorReporter | ||
335 | { reportParseError = \err -> hPutStrLn h err | ||
336 | , reportMissingHandler = \meth addr x -> hPutStrLn h $ show addr ++ " --> Missing handler ("++show meth++")" | ||
337 | , reportUnknown = \addr x err -> hPutStrLn h $ show addr ++ " --> " ++ err | ||
338 | , reportTimeout = \meth tid addr -> hPutStrLn h $ show addr ++ " --> Timeout ("++show meth++")" | ||
339 | } | ||
340 | |||
330 | -- Change the /err/ type for an 'ErrorReporter'. | 341 | -- Change the /err/ type for an 'ErrorReporter'. |
331 | contramapE f (ErrorReporter pe mh unk tim) | 342 | contramapE f (ErrorReporter pe mh unk tim) |
332 | = ErrorReporter (\e -> pe (f e)) | 343 | = ErrorReporter (\e -> pe (f e)) |