Added DHT name to listener thread label.

2 files changed, 6 insertions, 2 deletions

diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs
index b130e727..1a67c7c4 100644
--- a/src/Network/BitTorrent/DHT.hs
+++ b/src/Network/BitTorrent/DHT.hs
@@ -124,6 +124,7 @@ dht ::
     , WireFormat raw dht
     , Show u
     , Default u
+    , Typeable dht
     )
     => Options     -- ^ normally you need to use 'Data.Default.def';
     -> NodeAddr ip -- ^ address to bind this node;
diff --git a/src/Network/DatagramServer.hs b/src/Network/DatagramServer.hs
index 55a26e58..891417d4 100644
--- a/src/Network/DatagramServer.hs
+++ b/src/Network/DatagramServer.hs
@@ -375,6 +375,7 @@ queryK mgr@Manager{..} dest params kont = do
       Method meth = method :: Method msg a b
       signature = querySignature meth tid addr
   logMsg 'D' "query.sending" signature
+  -- [Debug#query.sending] &MessageType 0 #312020202020202020202020202020202020202020202020 @77.37.142.179:33445
 
   mres <- liftIO $ do
     ares <- registerQuery (tid, addr) pendingCalls
@@ -591,15 +592,17 @@ listener mgr@Manager{..} hs p = do
 
 -- | Should be run before any 'query', otherwise they will never
 -- succeed.
-listen :: ( WireFormat raw msg
+listen :: forall raw msg.
+          ( WireFormat raw msg
           , Ord (TransactionID msg)
           , Eq (QueryMethod msg)
           , Show (QueryMethod msg)
           , Serialize (TransactionID msg)
+          , Typeable msg
           ) => Manager raw msg -> [Handler IO msg raw] ->  Protocol raw msg -> IO ()
 listen mgr@Manager{..} hs p = do
   tid <- fork $ do
-    myThreadId >>= liftIO . flip labelThread "KRPC.listen"
+    myThreadId >>= liftIO . flip labelThread ("KRPC.listen." ++ (L.last $ L.words $ show $ typeOf (Proxy :: Proxy msg)))
     listener mgr hs p `Lifted.finally`
       liftIO (takeMVar listenerThread)
   liftIO $ putMVar listenerThread tid