json-rpc-server 0.1.3.0 → 0.1.4.0

raw patch · 6 files changed

+85/−79 lines, 6 filesdep −happstack-serverPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: happstack-server

API changes (from Hackage documentation)

Files

• README.md +1/−1
• demo/Demo.hs +18/−21
• json-rpc-server.cabal +7/−7
• src/Network/JsonRpc/Server.hs +39/−39
• src/Network/JsonRpc/Types.hs +19/−10
• tests/TestSuite.hs +1/−1

@@ -2,4 +2,4 @@ =============== [![Build Status](https://travis-ci.org/grayjay/json-rpc-server.svg?branch=master)](https://travis-ci.org/grayjay/json-rpc-server) -An implementation of the server side of JSON RPC 2.0. See <http://www.jsonrpc.org/specification>. This library uses ByteString for input and output, leaving the choice of transport up to the user. The documentation is on Hackage: <http://hackage.haskell.org/package/json-rpc-server>.+An implementation of the server side of JSON-RPC 2.0. See <http://www.jsonrpc.org/specification>. This library uses ByteString for input and output, leaving the choice of transport up to the user. The documentation is on Hackage: <http://hackage.haskell.org/package/json-rpc-server>.

@@ -3,34 +3,35 @@ module Main (main) where  import Network.JsonRpc.Server-import Happstack.Server.SimpleHTTP( ServerPartT, simpleHTTP, nullConf-                                  , askRq, rqBody, unBody, toResponse)+import qualified Data.ByteString.Lazy.Char8 as B import Data.List (intercalate) import Data.Maybe (fromMaybe)-import Control.Monad (when)+import Control.Monad (forM_, when) import Control.Monad.Trans (liftIO) import Control.Monad.Error (throwError) import Control.Monad.Reader (ReaderT, ask, runReaderT)-import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar)+import Control.Concurrent.MVar (MVar, newMVar, modifyMVar)  main :: IO ()-main = newMVar 0 >>= \count ->-       simpleHTTP nullConf $ do-         request <- askRq-         body <- liftIO $ getBody request-         result <- runReaderT (call methods body) count-         let resultStr = fromMaybe "" result-         return $ toResponse resultStr-    where getBody r = unBody `fmap` readMVar (rqBody r)+main = do+  contents <- B.getContents+  count <- newMVar 0+  forM_ (B.lines contents) $ \request -> do+         response <- runReaderT (call methods request) count+         B.putStrLn $ fromMaybe "" response -type Server = ReaderT (MVar Integer) (ServerPartT IO)+type Server = ReaderT (MVar Integer) IO  methods :: Methods Server-methods = toMethods [printSequence, getCount, add]+methods = toMethods [add, printSequence, increment] -printSequence, getCount, add :: Method Server+add, printSequence, increment :: Method Server -printSequence = toMethod "print" f params+add = toMethod "add" f (Required "x" :+: Required "y" :+: ())+    where f :: Double -> Double -> RpcResult Server Double+          f x y = liftIO $ return (x + y)++printSequence = toMethod "print_sequence" f params     where params = Required "string" :+:                    Optional "count" 1 :+:                    Optional "separator" ',' :+: ()@@ -40,11 +41,7 @@               liftIO $ print $ intercalate [sep] $ replicate count str           negativeCount = rpcError (-32000) "negative count" -getCount = toMethod "get_count" f ()+increment = toMethod "increment_and_get_count" f ()     where f :: RpcResult Server Integer           f = ask >>= \count -> liftIO $ modifyMVar count inc               where inc x = return (x + 1, x + 1)--add = toMethod "add" f (Required "x" :+: Required "y" :+: ())-    where f :: Double -> Double -> RpcResult Server Double-          f x y = liftIO $ return (x + y)

@@ -2,28 +2,28 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                json-rpc-server-version:             0.1.3.0+version:             0.1.4.0 license:             MIT license-file:        LICENSE category:            Network, JSON maintainer:          Kristen Kozak <grayjay@wordroute.com>-synopsis:            JSON RPC 2.0 on the server side.+synopsis:            JSON-RPC 2.0 on the server side. build-type:          Simple extra-source-files:  README.md cabal-version:       >=1.8 tested-with:         GHC == 7.0.1, GHC == 7.4.1, GHC == 7.6.2, GHC == 7.6.3, GHC == 7.8.3-description:         An implementation of the server side of JSON RPC 2.0.+description:         An implementation of the server side of JSON-RPC 2.0.                      See <http://www.jsonrpc.org/specification>. This                      library uses 'ByteString' for input and output,                      leaving the choice of transport up to the user.-                     See the 'Network.JsonRpc.Server' module for an example.+                     See the "Network.JsonRpc.Server" module for an example.  source-repository head   type:              git   location:          https://github.com/grayjay/json-rpc-server  flag demo-  description:       Builds the demo Happstack JSON RPC server.+  description:       Builds the JSON-RPC demo.   default:           False   manual:            True @@ -46,8 +46,8 @@   if flag (demo)     build-depends:     base >=4.3 && <4.8,                        json-rpc-server,-                       mtl >=1.1.1 && <2.3,-                       happstack-server >=6.2.4 && <7.4+                       bytestring >=0.9 && <0.11,+                       mtl >=1.1.1 && <2.3     ghc-options:       -Wall   else     buildable:         False

@@ -8,14 +8,14 @@ {-# OPTIONS_GHC -fno-warn-deprecations #-} #endif --- | Functions for implementing the server side of JSON RPC 2.0.+-- | Functions for implementing the server side of JSON-RPC 2.0. --   See <http://www.jsonrpc.org/specification>. module Network.JsonRpc.Server (                           -- ** Instructions                           -- $instructions -                          -- ** Unnamed and Optional Arguments-                          -- $arguments+                          -- ** Requests+                          -- $requests                            -- ** Example                           -- $example@@ -32,7 +32,7 @@                            , (:+:) (..)                            , MethodParams                           -- ** Errors-                           , RpcError+                           , RpcError (..)                            , rpcError                            , rpcErrorWithData) where @@ -57,51 +57,55 @@ -- * Process a request by calling 'call' or 'callWithBatchStrategy' --   on the 'Methods' and input 'B.ByteString'. --- $arguments--- RPC methods can have any mix of required and optional parameters.--- When a request uses unnamed arguments, the function is applied to--- the arguments in order.  The function will be called as long as--- all required arguments are specified, and the number of arguments--- provided is not greater than the total number of required and--- optional parameters.+-- $requests+-- This library handles by-name and by-position arguments, batch and+-- single requests, and notifications.  It also allows each+-- parameter of a method to be either optional (with a default value)+-- or required.  The function is called as long as all required+-- arguments are present.  A request providing more positional+-- arguments than the total number of optional and required+-- parameters to a function results in an error.  However, additional+-- by-name arguments are ignored.  -- $example--- Here is an example of a simple Happstack server with three methods.--- Compile it with the build flag @demo@.+-- Here is an example with three JSON-RPC methods. It reads requests+-- from stdin and writes responses to stdout.  Compile it with the+-- build flag @demo@. --    -- > {-# LANGUAGE OverloadedStrings #-} -- >  -- > module Main (main) where -- >  -- > import Network.JsonRpc.Server--- > import Happstack.Server.SimpleHTTP( ServerPartT, simpleHTTP, nullConf--- >                                   , askRq, rqBody, unBody, toResponse)+-- > import qualified Data.ByteString.Lazy.Char8 as B -- > import Data.List (intercalate) -- > import Data.Maybe (fromMaybe)--- > import Control.Monad (when)+-- > import Control.Monad (forM_, when) -- > import Control.Monad.Trans (liftIO) -- > import Control.Monad.Error (throwError) -- > import Control.Monad.Reader (ReaderT, ask, runReaderT)--- > import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar)+-- > import Control.Concurrent.MVar (MVar, newMVar, modifyMVar) -- >  -- > main :: IO ()--- > main = newMVar 0 >>= \count ->--- >        simpleHTTP nullConf $ do--- >          request <- askRq--- >          body <- liftIO $ getBody request--- >          result <- runReaderT (call methods body) count--- >          let resultStr = fromMaybe "" result--- >          return $ toResponse resultStr--- >     where getBody r = unBody `fmap` readMVar (rqBody r)+-- > main = do+-- >   contents <- B.getContents+-- >   count <- newMVar 0+-- >   forM_ (B.lines contents) $ \request -> do+-- >          response <- runReaderT (call methods request) count+-- >          B.putStrLn $ fromMaybe "" response -- > --- > type Server = ReaderT (MVar Integer) (ServerPartT IO)+-- > type Server = ReaderT (MVar Integer) IO -- >  -- > methods :: Methods Server--- > methods = toMethods [printSequence, getCount, add]+-- > methods = toMethods [add, printSequence, increment] -- > --- > printSequence, getCount, add :: Method Server+-- > add, printSequence, increment :: Method Server -- > --- > printSequence = toMethod "print" f params+-- > add = toMethod "add" f (Required "x" :+: Required "y" :+: ())+-- >     where f :: Double -> Double -> RpcResult Server Double+-- >           f x y = liftIO $ return (x + y)+-- > +-- > printSequence = toMethod "print_sequence" f params -- >     where params = Required "string" :+: -- >                    Optional "count" 1 :+: -- >                    Optional "separator" ',' :+: ()@@ -111,14 +115,10 @@ -- >               liftIO $ print $ intercalate [sep] $ replicate count str -- >           negativeCount = rpcError (-32000) "negative count" -- > --- > getCount = toMethod "get_count" f ()+-- > increment = toMethod "increment_and_get_count" f () -- >     where f :: RpcResult Server Integer -- >           f = ask >>= \count -> liftIO $ modifyMVar count inc -- >               where inc x = return (x + 1, x + 1)--- > --- > add = toMethod "add" f (Required "x" :+: Required "y" :+: ())--- >     where f :: Double -> Double -> RpcResult Server Double--- >           f x y = liftIO $ return (x + y) --     -- | Creates a method from a name, function, and parameter descriptions.@@ -132,21 +132,21 @@ toMethods fs = Methods $ H.fromList $ map pair fs     where pair mth@(Method name _) = (name, mth) --- | Handles one JSON RPC request. It is the same as+-- | Handles one JSON-RPC request. It is the same as --   @callWithBatchStrategy sequence@. call :: Monad m => Methods m   -- ^ Choice of methods to call.-     -> B.ByteString           -- ^ JSON RPC request.+     -> B.ByteString           -- ^ JSON-RPC request.      -> m (Maybe B.ByteString) -- ^ The response wrapped in 'Just', or                                --   'Nothing' in the case of a notification,                                --   all wrapped in the given monad. call = callWithBatchStrategy sequence --- | Handles one JSON RPC request.+-- | Handles one JSON-RPC request. callWithBatchStrategy :: Monad m =>                          (forall a . [m a] -> m [a]) -- ^ Function specifying the                                                      --   evaluation strategy.                       -> Methods m                   -- ^ Choice of methods to call.-                      -> B.ByteString                -- ^ JSON RPC request.+                      -> B.ByteString                -- ^ JSON-RPC request.                       -> m (Maybe B.ByteString)      -- ^ The response wrapped in 'Just', or                                                      --   'Nothing' in the case of a notification,                                                      --   all wrapped in the given monad.@@ -188,7 +188,7 @@     where notFound = throwError $ rpcError (-32601) $ "Method not found: " `append` name  throwInvalidRpc :: Monad m => Text -> RpcResult m a-throwInvalidRpc = throwError . rpcErrorWithData (-32600) "Invalid JSON RPC 2.0 request"+throwInvalidRpc = throwError . rpcErrorWithData (-32600) "Invalid JSON-RPC 2.0 request"  batchCall :: Monad m => (forall a. [m a] -> m [a])           -> Methods m

@@ -20,7 +20,7 @@                              , Request (..)                              , Response (..)                              , Id (..)-                             , RpcError+                             , RpcError (..)                              , rpcError                              , rpcErrorWithData) where @@ -56,7 +56,7 @@ --   monad ('m'), and return type ('r'). 'p' has one 'Parameter' for --   every argument of 'f' and is terminated by @()@. The return type --   of 'f' is @RpcResult m r@. This class is treated as closed.-class (Monad m, Functor m, A.ToJSON r) => MethodParams f p m r | f -> p m r where+class (Monad m, Functor m, A.ToJSON r) => MethodParams f p m r | f -> p m r, p m r -> f where     apply :: f -> p -> Args -> RpcResult m r  instance (Monad m, Functor m, A.ToJSON r) => MethodParams (RpcResult m r) () m r where@@ -113,15 +113,15 @@  instance A.FromJSON Request where     parseJSON (A.Object x) = (checkVersion =<< x .:? versionKey .!= jsonRpcVersion) *>-                           (Request <$>-                           x .: "method" <*>-                           (parseParams =<< x .:? "params" .!= emptyObject) <*>-                           parseId)+                             (Request <$>+                              x .: "method" <*>+                              (parseParams =<< x .:? "params" .!= emptyObject) <*>+                              parseId)         where parseParams (A.Object obj) = return $ Left obj               parseParams (A.Array ar) = return $ Right ar               parseParams _ = empty               checkVersion ver = when (ver /= jsonRpcVersion) $-                            fail $ "Wrong JSON RPC version: " ++ unpack ver+                            fail $ "Wrong JSON-RPC version: " ++ unpack ver                -- (.:?) parses Null value as Nothing so parseId needs                -- to use both (.:?) and (.:) to handle all cases               parseId = x .:? idKey >>= \optional ->@@ -153,9 +153,11 @@     toJSON (IdNumber x) = x     toJSON IdNull = A.Null --- | Error to be returned to the client.-data RpcError = RpcError Int Text (Maybe A.Value)-              deriving Show+-- | JSON-RPC error.+data RpcError = RpcError { errCode :: Int+                         , errMsg :: Text+                         , errData :: Maybe A.Value }+                           deriving (Show, Eq)  instance Error RpcError where     noMsg = strMsg "unknown error"@@ -166,6 +168,13 @@         where pairs = catMaybes [ Just $ "code" .= code                                 , Just $ "message" .= msg                                 , ("data" .=) <$> data' ]++instance A.FromJSON RpcError where+    parseJSON (A.Object v) = RpcError <$>+                             v .: "code" <*>+                             v .: "message" <*>+                             v .:? "data"+    parseJSON _ = empty  -- | Creates an 'RpcError' with the given error code and message. --   According to the specification, server error codes should be

@@ -32,7 +32,7 @@ errorHandlingTests = [ testCase "invalid JSON" $                            assertSubtractResponse (A.String "5") $ nullIdErrRsp (-32700) -                     , testCase "invalid JSON RPC" $+                     , testCase "invalid JSON-RPC" $                            assertSubtractResponse (A.object ["id" .= A.Number 10]) $ nullIdErrRsp (-32600)                       , testCase "empty batch call" $