json-rpc 0.2.0.0 → 0.2.0.1

raw patch · 3 files changed

+40/−4 lines, 3 filesdep ~stm-conduitPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: stm-conduit

API changes (from Hackage documentation)

Files

• Network/JsonRpc/Data.hs +3/−1
• json-rpc.cabal +2/−2
• test/Network/JsonRpc/Tests.hs +35/−1

@@ -265,7 +265,9 @@                                           <*> b .:? "data" .!= Null                                           <*> return i                 _ -> fail "JSON-RPC 2.0 error must be a JSON object"-            V1 -> o .: "error" >>= \e -> return $ ErrorObj V1 e 0 Null i+            V1 -> (o .: "error"  >>= \e -> return $ ErrorObj V1 e 0 Null i) <|>+                  (o .: "result" >>= \e -> return $ ErrorObj V1 e 0 Null i)+                      -- Buggy servers sometimes put errors in result field  instance ToJSON ErrorObj where     toJSON (ErrorObj V2 m c d i) = object [jr2, "id" .= i, "error" .= o] where

@@ -1,5 +1,5 @@ name:                   json-rpc-version:                0.2.0.0+version:                0.2.0.1 synopsis:               Fully-featured JSON-RPC 2.0 library description:   This JSON-RPC library is fully-compatible with JSON-RPC 2.0 and@@ -54,7 +54,7 @@                         json-rpc                    >= 0.2      && < 0.3,                         mtl                         >= 2.1      && < 2.3,                         stm                         >= 2.4      && < 2.5,-                        stm-conduit                 >= 2.4      && < 2.5,+                        stm-conduit                 >= 2.4      && < 2.6,                         text                        >= 1.1      && < 1.2,                         unordered-containers        >= 0.2      && < 0.3,                         QuickCheck                  >= 2.6      && < 2.8,

@@ -6,11 +6,13 @@ import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM+import Control.Exception hiding (assert) import Control.Monad-import Data.Aeson.Types hiding (Error)+import Data.Aeson.Types import Data.Conduit import qualified Data.Conduit.List as CL import Data.List+import Data.Conduit.Network import Data.Conduit.TMChan import qualified Data.HashMap.Strict as M import Data.Maybe@@ -57,6 +59,7 @@             (decodeErrConduit :: ([ReqRes Value Value], Ver) -> Property)         , testProperty "Sending messages" sendMsgNet         , testProperty "Two-way communication" twoWayNet+        , testProperty "Real network communication" realNet         ]     ] @@ -390,3 +393,34 @@         (IncomingMsg (MsgError e) Nothing) =         getErrMsg e == "Id not recognized"     match _ _ = False++realNet :: ([Request Value], Ver) -> Property+realNet (rr, ver) = monadicIO $ do+    rs <- run $ do+        withAsync (tcpServer ver ss srvApp) $ \_ -> cli+    assert $ length rs == length rr+    assert $+        map (getReqParams . fromJust . matchingReq) rs == map getReqParams rr+  where+    ss = serverSettings 58493 "127.0.0.1"+    cs = clientSettings 58493 "127.0.0.1"++    cli = do+        cE <- try $ tcpClient ver True cs cliApp+        either (const cli) return+            (cE :: Either SomeException [IncomingMsg Value () () Value])++    srvApp :: AppConduits () () Value Value () () IO -> IO ()+    srvApp (src, snk) = src $= CL.map respond $$ snk++    cliApp :: AppConduits Value () () () () Value IO+           -> IO [IncomingMsg Value () () Value]+    cliApp (src, snk) = do+        CL.sourceList (map f rr) $$ snk+        src $$ CL.consume+      where+        f rq = MsgRequest (rq { getReqId = IdNull })++    respond (IncomingMsg (MsgRequest (Request ver' _ p i)) _) =+        MsgResponse (Response ver' p i)+    respond _ = undefined