summaryrefslogtreecommitdiff
path: root/src/Network/QueryResponse.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/QueryResponse.hs')
-rw-r--r--src/Network/QueryResponse.hs15
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
29import Data.Typeable 29import Data.Typeable
30import Network.Socket 30import Network.Socket
31import Network.Socket.ByteString as B 31import Network.Socket.ByteString as B
32import System.IO
32import System.IO.Error 33import System.IO.Error
33import System.Timeout 34import 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
331printErrors :: ( Show addr
332 , Show meth
333 ) => Handle -> ErrorReporter addr x meth tid String
334printErrors 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'.
331contramapE f (ErrorReporter pe mh unk tim) 342contramapE f (ErrorReporter pe mh unk tim)
332 = ErrorReporter (\e -> pe (f e)) 343 = ErrorReporter (\e -> pe (f e))