messagepack-rpc 0.1.0.0 → 0.1.0.1
raw patch · 4 files changed
+33/−24 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG +4/−0
- Network/MessagePack.hs +25/−22
- README.md +2/−0
- messagepack-rpc.cabal +2/−2
CHANGELOG view
@@ -1,3 +1,7 @@+2014-07-30 Rodrigo Setti <rodrigosetti@gmail.com>++ * Parse request on demand (instead of waiting for the entire data)+ 2014-07-25 Rodrigo Setti <rodrigosetti@gmail.com> * Initial version.
Network/MessagePack.hs view
@@ -14,9 +14,10 @@ import Control.Applicative import Control.Monad import Data.MessagePack+import Data.Maybe+import Data.Serialize.Get import Network.Simple.TCP import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as LBS import qualified Data.Map as M import qualified Data.Serialize as S import qualified Data.Text as T@@ -44,21 +45,24 @@ serve host service rpcServer where rpcServer (socket, _) =- do bs <- LBS.fromChunks <$> fetchData- send socket =<< LBS.toStrict <$> executeRPC methods bs+ do reqMsg <- getRequestMessage+ respMsg <- either (return . errorResponse errorMsgId) (executeRPC methods) reqMsg+ send socket $ S.encode respMsg where- chunkSize = 1024- fetchData = do maybeData <- recv socket chunkSize- case maybeData of- Nothing -> return []- Just s -> do let len = BS.length s- if len < chunkSize- then return [s]- else do rest <- fetchData- return $ s : rest+ getRequestMessage =+ do result <- go $ runGetPartial S.get+ return $ case result of+ Fail err _ -> Left err+ Done r _ -> Right r+ Partial _ -> Left "unexpected end of RPC message"+ where+ go partial = do bs <- fromMaybe BS.empty <$> recv socket 1024+ case partial bs of+ Partial partial' -> go partial'+ x -> return x -executeRPC :: M.Map T.Text Method -> LBS.ByteString -> IO LBS.ByteString-executeRPC methods input = +executeRPC :: M.Map T.Text Method -> Object -> IO Object+executeRPC methods obj = case getRPCData of Left err -> return $ errorResponse errorMsgId err Right (method, msgid, params) -> do result <- method params@@ -67,7 +71,6 @@ getRPCData = do let m .: k = maybe (Left $ "missing key: " ++ show k) Right $ M.lookup (ObjectString k) m getMethod ms name = maybe (Left $ "unsupported method: " ++ show name) Right $ M.lookup name ms- obj <- S.decodeLazy input case obj of (ObjectMap m) -> do ObjectInt type_ <- m .: "type" when (type_ /= reqMessage) $ Left $ "invalid RPC type: " ++ show type_@@ -80,16 +83,16 @@ return (method, msgid, params) _ -> Left "invalid msgpack RPC request" -errorResponse :: MsgId -> String -> LBS.ByteString+errorResponse :: MsgId -> String -> Object errorResponse msgid err = response msgid (ObjectString $ T.pack err) ObjectNil -resultResponse :: MsgId -> Object -> LBS.ByteString+resultResponse :: MsgId -> Object -> Object resultResponse msgid = response msgid ObjectNil -response :: MsgId -> Object -> Object -> LBS.ByteString+response :: MsgId -> Object -> Object -> Object response msgid errObj resObj =- S.encodeLazy $ ObjectMap $ M.fromList [ (ObjectString "type" , ObjectInt resMessage)- , (ObjectString "msgid" , ObjectInt msgid)- , (ObjectString "error" , errObj)- , (ObjectString "result", resObj) ]+ ObjectMap $ M.fromList [ (ObjectString "type" , ObjectInt resMessage)+ , (ObjectString "msgid" , ObjectInt msgid)+ , (ObjectString "error" , errObj)+ , (ObjectString "result", resObj) ]
README.md view
@@ -1,4 +1,6 @@ # messagepack-rpc +[](https://travis-ci.org/rodrigosetti/messagepack-rpc)+ [Message Pack](http://msgpack.org) RPC over TCP.
messagepack-rpc.cabal view
@@ -1,5 +1,5 @@ name : messagepack-rpc-version : 0.1.0.0+version : 0.1.0.1 synopsis : Message Pack RPC over TCP description : Message Pack RPC over TCP homepage : http://github.com/rodrigosetti/messagepack-rpc@@ -18,7 +18,7 @@ source-repository head type : git- location : git@github.com:rodrigosetti/messagepack.git+ location : git@github.com:rodrigosetti/messagepack-rpc.git library exposed-modules : Network.MessagePack