msgpack-rpc 0.5.0.0 → 0.6.0.0
raw patch · 3 files changed
+36/−17 lines, 3 filesdep +attoparsec-enumeratordep +bytestringdep +enumeratordep −iterateedep ~msgpackdep ~randomPVP ok
version bump matches the API change (PVP)
Dependencies added: attoparsec-enumerator, bytestring, enumerator
Dependencies removed: iteratee
Dependency ranges changed: msgpack, random
API changes (from Hackage documentation)
Files
- msgpack-rpc.cabal +7/−5
- src/Network/MessagePackRpc/Client.hs +11/−3
- src/Network/MessagePackRpc/Server.hs +18/−9
msgpack-rpc.cabal view
@@ -1,5 +1,5 @@ Name: msgpack-rpc-Version: 0.5.0.0+Version: 0.6.0.0 Synopsis: A MessagePack-RPC Implementation Description: A MessagePack-RPC Implementation <http://msgpack.org/>@@ -20,12 +20,14 @@ test/Cli.hs Library- Build-depends: base >= 4 && <5,+ Build-depends: base >= 4 && < 5,+ bytestring >= 0.9 && < 0.10, network >= 2.3 && < 2.4,- msgpack >= 0.5 && < 0.6,- random >= 1.0.0.2 && < 1.1,+ random >= 1.0 && < 1.1,+ enumerator >= 0.4 && < 0.5,+ attoparsec-enumerator >= 0.2 && < 0.3,+ msgpack >= 0.6 && < 0.7, transformers >= 0.2 && < 0.3,- iteratee >= 0.8 && < 0.9, deepseq >= 1.1 && < 1.2 Ghc-options: -Wall
src/Network/MessagePackRpc/Client.hs view
@@ -43,6 +43,10 @@ import Control.Exception import Control.Monad+import Data.Attoparsec.Enumerator+import qualified Data.ByteString.Lazy as BL+import Data.Enumerator+import Data.Enumerator.Binary import Data.Functor import Data.MessagePack import Data.Typeable@@ -50,6 +54,9 @@ import System.IO import System.Random +bufferSize :: Integer+bufferSize = 4096+ -- | RPC connection type data Connection = Connection@@ -105,9 +112,10 @@ rpcCall :: Connection -> String -> [Object] -> IO Object rpcCall Connection{ connHandle = h } m args = do msgid <- (`mod`2^(30::Int)) <$> randomIO :: IO Int- packToHandle' h $ put (0 ::Int, msgid, m, args)- unpackFromHandleI h $ do- (rtype, rmsgid, rerror, rresult) <- getI+ BL.hPutStr h $ pack (0 ::Int, msgid, m, args)+ hFlush h+ run_ $ enumHandle bufferSize h $$ do+ (rtype, rmsgid, rerror, rresult) <- iterParser get when (rtype /= (1 :: Int)) $ throw $ ProtocolError $ "response type is not 1 (got " ++ show rtype ++ ")" when (rmsgid /= msgid) $
src/Network/MessagePackRpc/Server.hs view
@@ -37,9 +37,12 @@ import Control.Concurrent import Control.DeepSeq import Control.Exception as E+import Data.Enumerator+import Data.Enumerator.Binary import Control.Monad import Control.Monad.IO.Class-import Data.Iteratee.Exception as I+import Data.Attoparsec.Enumerator+import qualified Data.ByteString.Lazy as BL import Data.Maybe import Data.MessagePack import Network@@ -47,6 +50,9 @@ import Prelude hiding (catch) +bufferSize :: Integer+bufferSize = 4096+ type RpcMethod = [Object] -> IO Object class RpcMethodType f where@@ -80,24 +86,27 @@ (h, host, hostport) <- accept sock forkIO $ (processRequests h `finally` hClose h) `catches`- [ Handler $ \e -> let _ = (e :: I.EofException) in return ()- , Handler $ \e -> hPutStrLn stderr $ host ++ ":" ++ show hostport ++ ": "++ show (e :: SomeException)]+ [ Handler $ \e ->+ case e of+ ParseError ["demandInput"] _ -> return ()+ _ -> hPutStrLn stderr $ host ++ ":" ++ show hostport ++ ": " ++ show e+ , Handler $ \e ->+ hPutStrLn stderr $ host ++ ":" ++ show hostport ++ ": " ++ show (e :: SomeException)] where processRequests h =- unpackFromHandleI h $ forever $ processRequest h+ run_ $ enumHandle bufferSize h $$ forever $ processRequest h processRequest h = do- (rtype, msgid, method, args) <- getI+ (rtype, msgid, method, args) <- iterParser get liftIO $ do resp <- try $ getResponse rtype method args case resp of Left err ->- packToHandle' h $- put (1 :: Int, msgid :: Int, show (err :: SomeException), ())+ BL.hPutStr h $ pack (1 :: Int, msgid :: Int, show (err :: SomeException), ()) Right ret ->- packToHandle' h $- put (1 :: Int, msgid :: Int, (), ret)+ BL.hPutStr h $ pack (1 :: Int, msgid :: Int, (), ret)+ hFlush h getResponse rtype method args = do when (rtype /= (0 :: Int)) $