Timeout is microseconds. Pattern fail.

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
 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))