From fd10ed050a3155197b0b5a196b2ea8212350677c Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 25 Jul 2017 06:15:35 -0400 Subject: Timeout is microseconds. Pattern fail. --- src/Network/QueryResponse.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) (limited to 'src/Network/QueryResponse.hs') 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 import Data.Typeable import Network.Socket import Network.Socket.ByteString as B +import System.IO import System.IO.Error import System.Timeout @@ -73,7 +74,7 @@ sendQuery (Client net d err pending whoami _) meth q addr = do return tid self <- whoami (Just addr) sendMessage net addr (wrapQuery meth tid self addr q) - mres <- timeout (methodTimeout meth) $ takeMVar mvar + mres <- timeout (1000000 * methodTimeout meth) $ takeMVar mvar case mres of Just x -> return $ Just $ unwrapResponse meth x Nothing -> do @@ -198,7 +199,7 @@ onInbound f tr = tr m <- awaitMessage tr case m of Just (Right (x, addr)) -> f addr x - Nothing -> return () + _ -> return () return m } @@ -327,6 +328,16 @@ ignoreErrors = ErrorReporter , reportTimeout = \_ _ _ -> return () } +printErrors :: ( Show addr + , Show meth + ) => Handle -> ErrorReporter addr x meth tid String +printErrors h = ErrorReporter + { reportParseError = \err -> hPutStrLn h err + , reportMissingHandler = \meth addr x -> hPutStrLn h $ show addr ++ " --> Missing handler ("++show meth++")" + , reportUnknown = \addr x err -> hPutStrLn h $ show addr ++ " --> " ++ err + , reportTimeout = \meth tid addr -> hPutStrLn h $ show addr ++ " --> Timeout ("++show meth++")" + } + -- Change the /err/ type for an 'ErrorReporter'. contramapE f (ErrorReporter pe mh unk tim) = ErrorReporter (\e -> pe (f e)) -- cgit v1.2.3