Add LogSource to logging calls

commit 0044eec098a25bb1f585555376b3a124f1cbede6
Author: Jean-Pierre Rupp <[email protected]>
Date:   Fri Jun 19 14:36:07 2020 +0100

    Prepare release

commit e695e00
Author: Javran Cheng <[email protected]>
Date:   Mon Jun 15 22:39:51 2020 -0700

    Add LogSource to library's logging calls.

    This patch replaces many `logXXX`s with `logXXXS "json-rpc"`s so that
    user can filter logs based on LogSource.

    Fixes #9.

Author: jprupp

CHANGELOG.md

@@ -4,7 +4,12 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
 and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html).
 
-## 1.0.2 - 2019-06-12
+## 1.0.3 - 2020-06-19
+
+### Changed
+- `LogSource` (defined in `monad-logger`) for this library is set to `"json-rpc"` so that logs can be filtered base on it.
+
+## 1.0.2 - 2020-06-12
 ### Changed
 - Change license to MIT.
 

json-rpc.cabal

@@ -4,12 +4,12 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: fa906567c9820e7b3dd72def851fbe59bf79196757efa257ad6d5a97280a3ec2
+-- hash: 77cd2980380a86ce6731e9afcae7c2ecc42257843e71231bcebaba6929bee5c8
 
 name:           json-rpc
-version:        1.0.2
+version:        1.0.3
 synopsis:       Fully-featured JSON-RPC 2.0 library
-description:    Library compatible with JSON-RPC 2.0 and 1.0
+description:    Please see the README on GitHub at <https://github.com/jprupp/json-rpc#readme>
 category:       Network
 homepage:       https://github.com/jprupp/json-rpc.git#readme
 bug-reports:    https://github.com/jprupp/json-rpc.git/issues

package.yaml

@@ -1,5 +1,5 @@
 name: json-rpc
-version: 1.0.2
+version: 1.0.3
 synopsis: Fully-featured JSON-RPC 2.0 library
 description: Please see the README on GitHub at <https://github.com/jprupp/json-rpc#readme>
 category: Network

src/Network/JSONRPC/Interface.hs

@@ -98,9 +98,9 @@ decodeConduit ver = evalStateT loop Nothing where
     runParser ck = maybe (parse json ck) ($ ck) <$> get <* put Nothing
 
     handl True (Fail "" _ _) =
-        $(logDebug) "ignoring null string at end of incoming data"
+        $logDebugS "json-rpc" "ignoring null string at end of incoming data"
     handl b (Fail i _ _) = do
-        $(logError) "error parsing incoming message"
+        $logErrorS "json-rpc" "error parsing incoming message"
         lift . yield . Left $ OrphanError ver (errorParse i)
         unless b loop
     handl _ (Partial k) = put (Just k) >> loop
@@ -123,7 +123,7 @@ processIncoming =
                     Right v@Object {} -> do
                         single qs v
                         return $ do
-                            $(logDebug) "received message"
+                            $logDebugS "json-rpc" "received message"
                             processIncoming
                     Right v@(Array a) -> do
                         if V.null a
@@ -132,18 +132,18 @@ processIncoming =
                                 writeTBMChan (outCh qs) $ MsgResponse e
                             else batch qs (V.toList a)
                         return $ do
-                            $(logDebug) "received batch"
+                            $logDebugS "json-rpc" "received batch"
                             processIncoming
                     Right v -> do
                         let e = OrphanError (rpcVer qs) (errorInvalid v)
                         writeTBMChan (outCh qs) $ MsgResponse e
                         return $ do
-                            $(logWarn) "got invalid message"
+                            $logWarnS "json-rpc" "got invalid message"
                             processIncoming
                     Left e -> do
                         writeTBMChan (outCh qs) $ MsgResponse e
                         return $ do
-                            $(logWarn) "error parsing JSON"
+                            $logWarnS "json-rpc" "error parsing JSON"
                             processIncoming
   where
     flush qs = do
@@ -153,8 +153,8 @@ processIncoming =
         writeTVar (dead qs) True
         mapM_ ((`putTMVar` Nothing) . snd) $ M.toList m
         return $ do
-            $(logDebug) "session is now dead"
-            unless (M.null m) $ $(logError) "requests remained unfulfilled"
+            $logDebugS "json-rpc" "session is now dead"
+            unless (M.null m) $ $logErrorS "json-rpc" "requests remained unfulfilled"
     batch qs vs = do
         ts <- catMaybes <$> forM vs (process qs)
         unless (null ts) $
@@ -247,8 +247,8 @@ sendBatchRequest qs = do
             as  -> unless d $ writeTBMChan o $ MsgBatch $ map MsgRequest as
         return aps
     if null aps
-        then $(logDebug) "no responses pending"
-        else $(logDebug) "listening for responses if pending"
+        then $logDebugS "json-rpc" "no responses pending"
+        else $logDebugS "json-rpc" "listening for responses if pending"
     liftIO . atomically $ forM aps $ \(a, pM) ->
         case pM of
             Nothing -> return Nothing
@@ -284,10 +284,10 @@ receiveBatchRequest = do
     chM <- reader reqCh
     case chM of
         Just ch -> do
-            $(logDebug) "listening for a new request"
+            $logDebugS "json-rpc" "listening for a new request"
             liftIO . atomically $ readTBMChan ch
         Nothing -> do
-            $(logError) "ignoring requests from remote endpoint"
+            $logErrorS "json-rpc" "ignoring requests from remote endpoint"
             return Nothing
 
 -- | Send response message. Do not use to respond to a batch of requests.