5 files changed, 57 insertions, 16 deletions

diff --git a/bench/Main.hs b/bench/Main.hs
index 13727ff9..8466f4a3 100644
--- a/bench/Main.hs
+++ b/bench/Main.hs
@@ -22,7 +22,7 @@ addr :: SockAddr
 addr = SockAddrInet 6000 (256 * 256 * 256 + 127)
 
 main :: IO ()
-main = withManager addr [echo] $ \ m -> (`runReaderT` m) $ do
+main = withManager def addr [echo] $ \ m -> (`runReaderT` m) $ do
     listen
     liftIO $ defaultMain (benchmarks m)
   where
diff --git a/krpc.cabal b/krpc.cabal
index b5004026..be19775f 100644
--- a/krpc.cabal
+++ b/krpc.cabal
@@ -46,6 +46,7 @@ library
   build-depends:       base          == 4.*
                      , bytestring    >= 0.10
                      , text          >= 0.11
+                     , data-default-class
                      , lifted-base   >= 0.1.1
                      , transformers  >= 0.2
                      , mtl
diff --git a/src/Network/KRPC.hs b/src/Network/KRPC.hs
index a1767161..7c02702c 100644
--- a/src/Network/KRPC.hs
+++ b/src/Network/KRPC.hs
@@ -62,6 +62,8 @@ module Network.KRPC
 
          -- * Manager
        , MonadKRPC (..)
+       , Options (..)
+       , def
        , Manager
        , newManager
        , closeManager
@@ -76,6 +78,7 @@ module Network.KRPC
        , SockAddr (..)
        ) where
 
+import Data.Default.Class
 import Network.KRPC.Message
 import Network.KRPC.Method
 import Network.KRPC.Manager
diff --git a/src/Network/KRPC/Manager.hs b/src/Network/KRPC/Manager.hs
index 4d1cfb69..7edcf72d 100644
--- a/src/Network/KRPC/Manager.hs
+++ b/src/Network/KRPC/Manager.hs
@@ -18,6 +18,7 @@
 module Network.KRPC.Manager
        ( -- * Manager
          MonadKRPC (..)
+       , Options (..)
        , Manager
        , newManager
        , closeManager
@@ -43,6 +44,7 @@ import Data.BEncode as BE
 import Data.ByteString as BS
 import Data.ByteString.Char8 as BC
 import Data.ByteString.Lazy as BL
+import Data.Default.Class
 import Data.IORef
 import Data.List as L
 import Data.Map as M
@@ -58,6 +60,41 @@ import System.IO.Error
 import System.Timeout
 
 
+{-----------------------------------------------------------------------
+--  Options
+-----------------------------------------------------------------------}
+
+-- | RPC manager options.
+data Options = Options
+  { -- | Initial 'TransactionId' incremented with each 'query';
+    optSeedTransaction :: Int
+
+    -- | Time to wait for response from remote node, in seconds.
+  , optQueryTimeout    :: Int
+  } deriving (Show, Eq)
+
+defaultSeedTransaction :: Int
+defaultSeedTransaction = 0
+
+defaultQueryTimeout :: Int
+defaultQueryTimeout = 120
+
+-- | Permissive defaults.
+instance Default Options where
+  def = Options
+    { optSeedTransaction = defaultSeedTransaction
+    , optQueryTimeout    = defaultQueryTimeout
+    }
+
+validateOptions :: Options -> IO ()
+validateOptions Options {..}
+  | optQueryTimeout < 1 = throwIO (userError "non-positive query timeout")
+  |       otherwise     = return ()
+
+{-----------------------------------------------------------------------
+--  Options
+-----------------------------------------------------------------------}
+
 type KResult = Either KError KResponse
 
 type TransactionCounter = IORef Int
@@ -108,23 +145,19 @@ sockAddrFamily (SockAddrInet  _ _    ) = AF_INET
 sockAddrFamily (SockAddrInet6 _ _ _ _) = AF_INET6
 sockAddrFamily (SockAddrUnix  _      ) = AF_UNIX
 
-seedTransaction :: Int
-seedTransaction = 0
-
-defaultQueryTimeout :: Int
-defaultQueryTimeout = 120
-
 -- | Bind socket to the specified address. To enable query handling
 -- run 'listen'.
-newManager :: SockAddr       -- ^ address to listen on;
+newManager :: Options        -- ^ various protocol options;
+           -> SockAddr       -- ^ address to listen on;
            -> [Handler h]    -- ^ handlers to run on incoming queries.
-           -> IO (Manager h) -- ^ new manager.
-newManager servAddr handlers = do
+           -> IO (Manager h) -- ^ new rpc manager.
+newManager opts @ Options {..} servAddr handlers = do
+    validateOptions opts
     sock  <- bindServ
     tref  <- newEmptyMVar
-    tran  <- newIORef seedTransaction
+    tran  <- newIORef optSeedTransaction
     calls <- newIORef M.empty
-    return $ Manager sock defaultQueryTimeout tref tran calls handlers
+    return $ Manager sock optQueryTimeout tref tran calls handlers
   where
     bindServ = do
       let family = sockAddrFamily servAddr
@@ -143,8 +176,9 @@ closeManager Manager {..} = do
 
 -- | Normally you should use Control.Monad.Trans.Resource.allocate
 -- function.
-withManager :: SockAddr -> [Handler h] -> (Manager h -> IO a) -> IO a
-withManager addr hs = bracket (newManager addr hs) closeManager
+withManager :: Options -> SockAddr -> [Handler h]
+            -> (Manager h -> IO a) -> IO a
+withManager opts addr hs = bracket (newManager opts addr hs) closeManager
 
 {-----------------------------------------------------------------------
 --  Logging
diff --git a/tests/Network/KRPCSpec.hs b/tests/Network/KRPCSpec.hs
index 7f5b2794..e73b1ec0 100644
--- a/tests/Network/KRPCSpec.hs
+++ b/tests/Network/KRPCSpec.hs
@@ -20,18 +20,21 @@ handlers =
 instance MonadLogger IO where
   monadLoggerLog _ _ _ _ = return ()
 
+opts :: Options
+opts = def { optQueryTimeout = 1 }
+
 spec :: Spec
 spec = do
   describe "query" $ do
     it "run handlers" $ do
       let int = 0xabcd :: Int
-      (withManager servAddr handlers $ runReaderT $ do
+      (withManager opts servAddr handlers $ runReaderT $ do
          listen
          query servAddr (Echo int))
        `shouldReturn` Echo int
 
     it "throw timeout exception" $ do
-      (withManager servAddr handlers $ runReaderT $ do
+      (withManager opts servAddr handlers $ runReaderT $ do
          query servAddr (Echo (0xabcd :: Int))
        )
         `shouldThrow` (== KError GenericError "timeout expired" "0")