Aeson-based pretty-printing of server requests.

1 files changed, 11 insertions, 4 deletions

diff --git a/src/Network/KRPC/Manager.hs b/src/Network/KRPC/Manager.hs
index 9477d23c..c90c92f9 100644
--- a/src/Network/KRPC/Manager.hs
+++ b/src/Network/KRPC/Manager.hs
@@ -52,6 +52,7 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Control
 import Data.BEncode as BE
 import Data.BEncode.Internal as BE
+import Data.BEncode.Pretty (showBEncode)
 import Data.ByteString as BS
 import Data.ByteString.Char8 as BC
 import Data.ByteString.Lazy as BL
@@ -428,11 +429,17 @@ dispatchHandler q @ KQuery {..} addr = do
 -- peer B fork too many threads
 -- ... space leak
 --
-handleQuery :: MonadKRPC h m => KQuery -> SockAddr -> m ()
-handleQuery q addr = void $ fork $ do
+handleQuery :: MonadKRPC h m => BValue -> KQuery -> SockAddr -> m ()
+handleQuery raw q addr = void $ fork $ do
   Manager {..} <- getManager
   res <- dispatchHandler q addr
-  sendMessage sock addr $ either toBEncode toBEncode res
+  let resbe = either toBEncode toBEncode res
+  $(logOther "q") $ T.unlines
+    [ either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode raw)
+    , "==>"
+    , either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode resbe)
+    ]
+  sendMessage sock addr resbe
 
 handleResponse :: MonadKRPC h m => BValue -> KResult -> SockAddr -> m ()
 handleResponse raw result addr = do
@@ -445,7 +452,7 @@ handleResponse raw result addr = do
       Just ares -> putMVar ares (raw,result)
 
 handleMessage :: MonadKRPC h m => BValue -> KMessage -> SockAddr -> m ()
-handleMessage _   (Q q) = handleQuery    q
+handleMessage raw (Q q) = handleQuery    raw q
 handleMessage raw (R r) = handleResponse raw (Right r)
 handleMessage raw (E e) = handleResponse raw (Left  e)