json-rpc 0.2.1.5 → 0.2.1.6
raw patch · 4 files changed
+36/−29 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Network/JsonRpc/Conduit.hs +19/−11
- Network/JsonRpc/Data.hs +5/−5
- json-rpc.cabal +1/−1
- test/Network/JsonRpc/Tests.hs +11/−12
Network/JsonRpc/Conduit.hs view
@@ -42,7 +42,7 @@ import Data.Text (Text) import Network.JsonRpc.Data --- | Conduits of sending and receiving JSON-RPC messages.+-- | Conduits for sending and receiving JSON-RPC messages. type AppConduits qo no ro qi ni ri m = (Source m (IncomingMsg qo qi ni ri), Sink (Message qo no ro) m ()) @@ -93,7 +93,7 @@ -> Session qo -> Conduit (Message qo no ro) m (Message qo no ro) msgConduit c qs = await >>= \nqM -> case nqM of- Nothing -> do+ Nothing -> when c . liftIO . atomically $ writeTQueue (isLast qs) True Just (MsgRequest rq) -> do msg <- MsgRequest <$> liftIO (atomically $ addId rq)@@ -132,7 +132,7 @@ f re = if c && re then do l <- liftIO . atomically $ readTQueue (isLast qs)- if l then return () else loop+ unless l loop else loop loop = lift await >>= maybe flush process@@ -236,7 +236,7 @@ -- Will create JSON-RPC conduits around 'ByteString' conduits from a transport -- layer.-runConduits :: ( FromRequest qi, FromNotif ni, FromResponse ri +runConduits :: ( FromRequest qi, FromNotif ni, FromResponse ri , ToJSON qo, ToJSON no, ToJSON ro ) => Ver -- ^ JSON-RPC version -> Bool -- ^ Disconnect on last response@@ -246,7 +246,8 @@ -- ^ JSON-RPC action -> IO a -- ^ Output of action runConduits ver d rpcSnk rpcSrc f = do- (reqChan, msgChan) <- atomically $ (,) <$> newTBMChan 128 <*> newTBMChan 128+ (reqChan, msgChan) <- atomically $ (,) <$> newTBMChan 128+ <*> newTBMChan 128 let inbSrc = sourceTBMChan msgChan inbSnk = sinkTBMChan msgChan True outSrc = sourceTBMChan reqChan@@ -275,11 +276,19 @@ -> (AppConduits qo no ro qi ni ri IO -> IO a) -- ^ JSON-RPC action -> IO a -- ^ Output of action-tcpClient ver d cs f = runTCPClient cs $ \ad -> do+tcpClient ver d cs f = runTCPClient cs $ \ad -> runConduits ver d (cr =$ appSink ad) (appSource ad $= ln) f where- cr = CL.map (flip B8.snoc '\n')- ln = CL.mapFoldable B8.lines+ cr = CL.map (`B8.snoc` '\n')+ ln = await >>= \bsM -> case bsM of+ Nothing -> return ()+ Just bs -> let (l, ls) = B8.break (=='\n') bs in case ls of+ "" -> await >>= \bsM' -> case bsM' of+ Nothing -> if B8.null l then return () else yield l+ Just bs' -> leftover (bs `B8.append` bs') >> ln+ _ -> case l of+ "" -> leftover (B8.tail ls) >> ln+ _ -> leftover (B8.tail ls) >> yield l >> ln -- JSON-RPC-over-TCP server. tcpServer :: ( FromRequest qi, FromNotif ni, FromResponse ri@@ -289,8 +298,7 @@ -> (AppConduits qo no ro qi ni ri IO -> IO ()) -- ^ JSON-RPC action to perform on connecting client thread -> IO ()-tcpServer ver ss f = runTCPServer ss $ \cl -> do+tcpServer ver ss f = runTCPServer ss $ \cl -> runConduits ver False (cr =$ appSink cl) (appSource cl) f where- cr = CL.map (flip B8.snoc '\n')-+ cr = CL.map (`B8.snoc` '\n')
Network/JsonRpc/Data.hs view
@@ -287,11 +287,11 @@ -- | Invalid params. errorParams :: Ver -> Value -> Id -> ErrorObj-errorParams ver v i = ErrorObj ver "Invalid params" (-32602) v i+errorParams ver v = ErrorObj ver "Invalid params" (-32602) v -- | Method not found. errorMethod :: Ver -> Method -> Id -> ErrorObj-errorMethod ver m i = ErrorObj ver "Method not found" (-32601) (toJSON m) i+errorMethod ver m = ErrorObj ver "Method not found" (-32601) (toJSON m) -- | Id not recognized. errorId :: Ver -> Id -> ErrorObj@@ -344,14 +344,14 @@ rnf _ = () instance Enum Id where- toEnum i = IdInt i+ toEnum = IdInt fromEnum (IdInt i) = i- fromEnum _ = error $ "Can't enumerate non-integral ids"+ fromEnum _ = error "Can't enumerate non-integral ids" instance FromJSON Id where parseJSON s@(String _) = IdTxt <$> parseJSON s parseJSON n@(Number _) = IdInt <$> parseJSON n- parseJSON Null = return $ IdNull+ parseJSON Null = return IdNull parseJSON _ = mzero instance ToJSON Id where
json-rpc.cabal view
@@ -1,5 +1,5 @@ name: json-rpc-version: 0.2.1.5+version: 0.2.1.6 synopsis: Fully-featured JSON-RPC 2.0 library description: This JSON-RPC library is fully-compatible with JSON-RPC 2.0 and
test/Network/JsonRpc/Tests.hs view
@@ -53,9 +53,9 @@ (newMsgConduit :: [Message Value Value Value] -> Property) , testProperty "Decode requests" (decodeReqConduit :: ([Request Value], Ver) -> Property)- , testProperty "Decode responses" + , testProperty "Decode responses" (decodeResConduit :: ([ReqRes Value Value], Ver) -> Property)- , testProperty "Bad responses" + , testProperty "Bad responses" (decodeErrConduit :: ([ReqRes Value Value], Ver) -> Property) , testProperty "Sending messages" sendMsgNet , testProperty "Two-way communication" twoWayNet@@ -79,13 +79,13 @@ vals m p i = fromMaybe False $ parseMaybe (f m p i) o f m p i _ = do j <- o .:? "jsonrpc"- guard $ fromMaybe True $ fmap (== ("2.0" :: Text)) j+ guard $ maybe True (== ("2.0" :: Text)) j i' <- o .: "id" guard $ i == i' m' <- o .: "method" guard $ m == m' p' <- o .:? "params" .!= Null- guard $ (toJSON p) == p'+ guard $ toJSON p == p' return True reqDecode :: (Eq a, ToRequest a, ToJSON a, FromRequest a) => Request a -> Bool@@ -111,11 +111,11 @@ i <- o .:? "id" .!= Null guard $ i == Null j <- o .:? "jsonrpc"- guard $ fromMaybe True $ fmap (== ("2.0" :: Text)) j+ guard $ maybe True (== ("2.0" :: Text)) j m' <- o .: "method" guard $ m == m' p' <- o .:? "params" .!= Null- guard $ (toJSON p) == p'+ guard $ toJSON p == p' return True notifDecode :: (Eq a, ToNotif a, ToJSON a, FromNotif a)@@ -141,7 +141,7 @@ i' <- o .: "id" guard $ i == i' j <- o .:? "jsonrpc"- guard $ fromMaybe True $ fmap (== ("2.0" :: Text)) j+ guard $ maybe True (== ("2.0" :: Text)) j s' <- o .: "result" guard $ s == s' e <- o .:? "error" .!= Null@@ -209,7 +209,7 @@ $= encodeConduit $= decodeConduit ver False qs' $$ CL.consume- assert $ null $ filter unexpected inmsgs+ assert $ not (any unexpected inmsgs) assert $ all (uncurry match) (zip vs inmsgs) where unexpected :: IncomingMsg () q () () -> Bool@@ -237,7 +237,7 @@ $= encodeConduit $= decodeConduit ver False qs $$ CL.consume- assert $ null $ filter unexpected inmsgs+ assert $ not (any unexpected inmsgs) assert $ all (uncurry match) (zip vs inmsgs) where unexpected :: IncomingMsg q () () r -> Bool@@ -277,7 +277,7 @@ $= encodeConduit $= decodeConduit ver False qs $$ CL.consume- assert $ null $ filter unexpected inmsgs+ assert $ not (any unexpected inmsgs) assert $ all (uncurry match) (zip vs inmsgs) where unexpected :: IncomingMsg q () () r -> Bool@@ -396,8 +396,7 @@ realNet :: ([Request Value], Ver) -> Property realNet (rr, ver) = monadicIO $ do- rs <- run $ do- withAsync (tcpServer ver ss srvApp) $ \_ -> cli+ rs <- run $ withAsync (tcpServer ver ss srvApp) $ const cli assert $ length rs == length rr assert $ map (getReqParams . fromJust . matchingReq) rs == map getReqParams rr