Moved parse-error printing from addHandler to forkListener.

7 files changed, 16 insertions, 19 deletions

diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index de315e35..0dcb4237 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -1803,7 +1803,7 @@ main = do
            fromMaybe bail $ msock <&> \(udp,sock) -> do
             addr <- getSocketName sock
             (bt,btR,btBootstrap4, btBootstrap6,quitBtClient) <- Mainline.newClient swarms addr udp
-            quitBt <- forkListener "bt" (clientNet bt)
+            quitBt <- forkListener "bt" (dput XBitTorrent . mappend "bt-parse: ") (clientNet bt)
             mainlineSearches <- atomically $ newTVar Map.empty
             peerPort <- atomically $ newTVar 6881 -- BitTorrent client TCP port.
             let mainlineDHT bkts wantip = DHT
diff --git a/dht/examples/tcpclient.hs b/dht/examples/tcpclient.hs
index d168b1fb..858a617d 100644
--- a/dht/examples/tcpclient.hs
+++ b/dht/examples/tcpclient.hs
@@ -16,7 +16,7 @@ main = do
     setVerbose XUnexpected
     crypto <- newCrypto
     (_,client) <- newClient crypto id (\cb p -> cb (Just (False,p)))
-    quitTCP <- forkListener "TCP-recv" (addHandler print (handleMessage client) $ clientNet client)
+    quitTCP <- forkListener "TCP-recv" (dput XTCP . (++) "tcp-parse: ") (addHandler print (handleMessage client) $ clientNet client)
     args <- getArgs
     let addr = read $ args !! 0
 
diff --git a/dht/src/DebugTag.hs b/dht/src/DebugTag.hs
index 37593e63..b5f862dc 100644
--- a/dht/src/DebugTag.hs
+++ b/dht/src/DebugTag.hs
@@ -8,6 +8,7 @@ data DebugTag
   | XAnnounceResponse
   | XBitTorrent
   | XDBus
+  | XDHT
   | XLan
   | XMan
   | XNetCrypto
diff --git a/dht/src/Network/BitTorrent/MainlineDHT.hs b/dht/src/Network/BitTorrent/MainlineDHT.hs
index a83cf740..705d7291 100644
--- a/dht/src/Network/BitTorrent/MainlineDHT.hs
+++ b/dht/src/Network/BitTorrent/MainlineDHT.hs
@@ -623,11 +623,8 @@ newClient swarms addr udp = do
         gen :: Word16 -> (TransactionId, Word16)
         gen cnt = (TransactionId $ S.encode cnt, cnt+1)
 
-        ignoreParseError :: String -> IO ()
-        ignoreParseError _ = return ()
-
         client = Client
-            { clientNet           = addHandler ignoreParseError (handleMessage client) net
+            { clientNet           = addHandler (handleMessage client) net
             , clientDispatcher    = dispatch
             , clientErrorReporter = ignoreErrors -- printErrors stderr
             , clientPending       = map_var
diff --git a/dht/src/Network/BitTorrent/Tracker/Transport.hs b/dht/src/Network/BitTorrent/Tracker/Transport.hs
index 5d225a7e..eacf7946 100644
--- a/dht/src/Network/BitTorrent/Tracker/Transport.hs
+++ b/dht/src/Network/BitTorrent/Tracker/Transport.hs
@@ -94,4 +94,4 @@ implementTracker err net c = do
                     , clientAddress       = const $ return localhost4
                     , clientResponseId    = return
                     }
-    return $ addHandler (\err -> return ()) (handleMessage client) net
+    return $ addHandler (handleMessage client) net
diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs
index 6adfb9a9..084a9978 100644
--- a/dht/src/Network/Tox.hs
+++ b/dht/src/Network/Tox.hs
@@ -174,7 +174,6 @@ newClient drg net classify selfAddr handlers modifytbl modifynet = do
                 , lookupHandler   = handlers -- var
                 , tableMethods    = modifytbl tbl
                 }
-        eprinter = logErrors -- printErrors stderr
         mkclient :: (TransactionMethods
                          (g, pending) DHT.TransactionId addr x,
                        TVar (g, pending))
@@ -184,9 +183,9 @@ newClient drg net classify selfAddr handlers modifytbl modifynet = do
                       -> ClientA String meth DHT.TransactionId addr x x
         mkclient (tbl,var) handlers =
             let client = Client
-                    { clientNet           = addHandler (reportParseError eprinter) (handleMessage client) $ modifynet client net
+                    { clientNet           = addHandler (handleMessage client) $ modifynet client net
                     , clientDispatcher    = dispatch tbl var (handlers client) client
-                    , clientErrorReporter = eprinter
+                    , clientErrorReporter = logErrors
                     , clientPending       = var
                     , clientAddress       = selfAddr
                     , clientResponseId    = genNonce24 var
@@ -412,8 +411,8 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do
         { toxDHT            = dhtclient
         , toxOnion          = onionclient
         , toxToRoute        = onInbound (updateContactInfo roster) dtacrypt
-        , toxCrypto         = addHandler (dput XMisc) (sessionHandler sessions) cryptonet
-        , toxHandshakes     = addHandler (dput XMisc) (handshakeH sparams) handshakes
+        , toxCrypto         = addHandler (sessionHandler sessions) cryptonet
+        , toxHandshakes     = addHandler (handshakeH sparams) handshakes
         , toxHandshakeCache = hscache
         , toxCryptoKeys     = crypto
         , toxRouting        = mkrouting dhtclient
@@ -467,13 +466,13 @@ forkTox :: Tox extra
             -> Bool -- tcp
             -> IO (IO (), [NodeInfo] -> [NodeInfo] -> IO (), [NodeInfo] -> [NodeInfo] -> IO ())
 forkTox tox with_avahi with_tcp = do
-    quitHs      <- forkListener "toxHandshakes" (toxHandshakes tox)
-    quitToRoute <- forkListener "toxToRoute" (toxToRoute tox)
-    quitOnion   <- forkListener "toxOnion" (clientNet $ toxOnion tox)
-    quitDHT     <- forkListener "toxDHT" (clientNet $ toxDHT tox)
-    quitNC      <- forkListener "toxCrypto" (toxCrypto tox)
+    quitHs      <- forkListener "toxHandshakes" (dput XMan . mappend "hs-parse: ") (toxHandshakes tox)
+    quitToRoute <- forkListener "toxToRoute" (dput XOnion . mappend "dta-parse: ") (toxToRoute tox)
+    quitOnion   <- forkListener "toxOnion" (dput XOnion . mappend "onion-parse: ") (clientNet $ toxOnion tox)
+    quitDHT     <- forkListener "toxDHT" (dput XDHT . mappend "dht-parse: ") (clientNet $ toxDHT tox)
+    quitNC      <- forkListener "toxCrypto" (dput XNetCrypto . mappend "nc-parse: ") (toxCrypto tox)
     quitTCP     <- if with_tcp
-                    then forkListener "relay-client" (clientNet $ tcpClient $ tcpKademliaClient $ toxOnionRoutes tox)
+                    then forkListener "relay-client" (dput XTCP . mappend "tcp-parse: ") (clientNet $ tcpClient $ tcpKademliaClient $ toxOnionRoutes tox)
                     else return $ return ()
     refresher4 <- forkPollForRefresh (DHT.refresher4 $ toxRouting tox)
     refresher6 <- forkPollForRefresh (DHT.refresher6 $ toxRouting tox)
diff --git a/dht/src/Network/Tox/Onion/Routes.hs b/dht/src/Network/Tox/Onion/Routes.hs
index 374b9648..46ded48d 100644
--- a/dht/src/Network/Tox/Onion/Routes.hs
+++ b/dht/src/Network/Tox/Onion/Routes.hs
@@ -249,7 +249,7 @@ newOnionRouter crypto perror tcp_enabled = do
                  , tcpKademliaClient = tcp
                     { TCP.tcpClient =
                         let c = TCP.tcpClient tcp
-                        in c { clientNet = addHandler perror (handleMessage c)
+                        in c { clientNet = addHandler (handleMessage c)
                                             $ onInbound (updateTCP or)
                                             $ clientNet c }
                     }