jsonrpc-conduit 0.3.13 → 0.4.0
raw patch · 3 files changed
+78/−11 lines, 3 filesdep +attoparsec-aesondep ~aesondep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: attoparsec-aeson
Dependency ranges changed: aeson, bytestring
API changes (from Hackage documentation)
Files
- jsonrpc-conduit.cabal +8/−5
- src/Data/Conduit/JsonRpc/Server.hs +2/−1
- test/Data/Conduit/JsonRpc/ServerSpec.hs +68/−5
jsonrpc-conduit.cabal view
@@ -1,5 +1,5 @@ name: jsonrpc-conduit-version: 0.3.13+version: 0.4.0 synopsis: JSON-RPC 2.0 server over a Conduit. description: @jsonrpc-conduit@ implements the basic building block of a JSON-RPC 2.0 server.@@ -32,9 +32,10 @@ Data.Conduit.JsonRpc.Methods, Data.Conduit.JsonRpc.Server build-depends: base >=4 && <5,- aeson >=0.7 && <2.2,+ aeson >=2.2.0.0 && <2.3, attoparsec >=0.11 && <0.15,- bytestring >=0.10 && <0.12,+ attoparsec-aeson >=2.2.0.0 && <2.3,+ bytestring >=0.10 && <0.13, conduit >=1.2.8 && <1.4, conduit-extra >=1.1 && <1.4, mtl >=2.1 && <2.4,@@ -50,8 +51,10 @@ main-is: Spec.hs other-modules: Data.Conduit.JsonRpc.ServerSpec build-depends: base >=4 && <5,- aeson >=0.7 && <2.2,- bytestring >=0.10 && <0.12,+ aeson >=2.2.0.0 && <2.3,+ attoparsec >=0.11 && <0.15,+ attoparsec-aeson >=2.2.0.0 && <2.3,+ bytestring >=0.10 && <0.13, conduit >=1.2.8 && <1.4, conduit-extra >=1.1 && <1.4, hspec >=2.1 && <2.12,
src/Data/Conduit/JsonRpc/Server.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Data.Conduit.JsonRpc.Server--- Copyright : (c) 2012-2021 Gabriele Sales <gbrsales@gmail.com>+-- Copyright : (c) 2012-2023 Gabriele Sales <gbrsales@gmail.com> -- -- JSON-RPC 2.0 server 'Conduit'. @@ -16,6 +16,7 @@ import Control.Monad.Trans (lift) import Control.Monad.Trans.State import Data.Aeson hiding (Error)+import Data.Aeson.Parser (json') import Data.Aeson.Types (parseMaybe) import Data.Attoparsec.ByteString import Data.ByteString (ByteString)
test/Data/Conduit/JsonRpc/ServerSpec.hs view
@@ -1,23 +1,32 @@ {- | Module : Data.Conduit.JsonRpc.ServerSpec Description : Tests for the server.-Copyright : (c) 2015-2021 Gabriele Sales+Copyright : (c) 2015-2023 Gabriele Sales -} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ParallelListComp #-} module Data.Conduit.JsonRpc.ServerSpec ( spec ) where +import Control.Monad import Data.Aeson hiding (Error)-import Data.ByteString (ByteString)+import Data.Aeson.Parser (json')+import Data.Aeson.Types (parseEither)+import Data.Attoparsec.Combinator (many')+import Data.Bifunctor+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L import Data.Conduit+import qualified Data.Conduit.Attoparsec as A import qualified Data.Conduit.Binary as B import Data.Conduit.JsonRpc.Internal.Types import Data.Conduit.JsonRpc.Methods import Data.Conduit.JsonRpc.Server+import Data.Int import Data.Text (Text) import Test.Hspec @@ -43,18 +52,72 @@ oneshot "unknown" () `shouldReturn` (Left "Method not found" :: Either Text ()) + describe "truncated request" $+ it "is rejected" $+ let req = truncatedRequest "sum" ([]::[Text])+ in oneshot' req `shouldReturn`+ (Left "Parse error" :: Either Text ()) + describe "arbitrary JSON value" $+ it "is rejected" $+ let req = encode (toJSON ["a"::Text])+ in oneshot' req `shouldReturn`+ (Left "Invalid request" :: Either Text ())++ describe "multiple requests" $+ it "are processed in order" $+ let reqs = [ ("sum", toJSON [1::Int, 2])+ , ("cat", toJSON ["a"::Text, "c"])+ ]+ in multishot reqs `shouldReturn`+ (Right [toJSON (3::Int), toJSON ("ac"::Text)])++ oneshot :: (ToJSON a, FromJSON b) => Text -> a -> IO (Either Text b)-oneshot method params = do+oneshot method params = let reqId = toJSON (1::Int)- req = encode (Request method params reqId)+ in oneshot' (encode $ Request method params reqId)++oneshot' :: FromJSON a => L.ByteString -> IO (Either Text a)+oneshot' req = do bs <- runConduit (B.sourceLbs req .| server .| B.sinkLbs) return $ case decode bs of Nothing -> Left "invalid response" Just Error{errMsg} -> Left errMsg Just Result{result} -> Right result -server :: ConduitT ByteString ByteString IO ()+truncatedRequest :: ToJSON a => Text -> a -> L.ByteString+truncatedRequest method params =+ let reqId = toJSON (2::Int)+ req = encode (Request method params reqId)+ len = L.length req+ in L.take (len - 2) req++multishot :: [(Text, Value)] -> IO (Either String [Value])+multishot reqs = do+ let reqs' = [ encode (Request method params (toJSON i))+ | i <- [1::Int ..]+ | (method, params) <- reqs+ ]+ merged = rechunk 10 (L.concat reqs')+ vs <- runConduit+ $ B.sourceLbs merged+ .| server+ .| A.sinkParserEither (many' json')+ return . join . fmap sequence . bimap A.errorMessage (map resultOf) $ vs++rechunk :: Int64 -> L.ByteString -> L.ByteString+rechunk n = L.concat . split+ where+ split bs =+ let (p, s) = L.splitAt n bs+ in if L.null s then [p] else p : split s++resultOf :: Value -> Either String Value+resultOf = parseEither (withObject "message" (.: "result"))+++server :: ConduitT S.ByteString S.ByteString IO () server = serve (fromList [ method "sum" sum' , method "cat" cat ])