Debug prints putRendezvous related debug prints.

4 files changed, 16 insertions, 1 deletions

diff --git a/dht/Announcer/Tox.hs b/dht/Announcer/Tox.hs
index 38e5bbfa..58b6621b 100644
--- a/dht/Announcer/Tox.hs
+++ b/dht/Announcer/Tox.hs
@@ -13,6 +13,8 @@ module Announcer.Tox where
 import Announcer
 import qualified Data.MinMaxPSQ as MM
 import Data.Wrapper.PSQ         as PSQ
+import DebugTag
+import DPut
 import Network.Kademlia.Search
 
 import Control.Concurrent.Lifted.Instrument
@@ -36,6 +38,7 @@ data AnnounceState = forall nid addr tok ni r qk. AnnounceState
 -- a Kademlia network.
 data AnnounceMethod r = forall nid ni sr addr tok a qk.
                         ( Show nid
+                        , Show ni
                         , Hashable nid
                         , Hashable ni
                         , Ord addr
@@ -175,11 +178,21 @@ scheduleAnnounce  announcer k AnnounceMethod{aSearch,aPublish,aNearestNodes,aTar
                         nq <- readTVar ns
                         return $ filter (\(Binding ni _ _) -> not $ isJust $ MM.lookup' ni nq)
                                $ MM.toList bs
+                let ns = map (\(Binding ni mtok _) -> ni) is
+                dput XPublish $ unlines $ "Announcing to nodes of finished search."
+                                    : map (mappend "  " . show) ns
                 publishToNodes is
                 putMVar mutex ()
               Nothing -> do
                 -- Previous search did not finish.  Instead of starting a new search,
                 -- we will re-announce only.
+                do
+                    is <- atomically $ do
+                        bs <- readTVar (searchInformant st {- :: TVar (MinMaxPSQ' ni nid tok -})
+                        return $ MM.toList bs
+                    let ns = map (\(Binding ni mtok _) -> ni) is
+                    dput XPublish $ unlines $ "Announcing to nodes of in-progress search."
+                                    : map (mappend "  " . show) ns
                 announce
                 -- Cancel search so that a new one can start in the nest period.
                 atomically $ searchCancel st
diff --git a/dht/src/DebugTag.hs b/dht/src/DebugTag.hs
index b5f862dc..8c1a7e3a 100644
--- a/dht/src/DebugTag.hs
+++ b/dht/src/DebugTag.hs
@@ -5,6 +5,7 @@ import Data.Typeable
 -- | Debug Tags, add more as needed, but ensure XAnnounce is always first, XMisc last
 data DebugTag
   = XAnnounce
+  | XPublish
   | XAnnounceResponse
   | XBitTorrent
   | XDBus
diff --git a/dht/src/Network/Tox/Crypto/Transport.hs b/dht/src/Network/Tox/Crypto/Transport.hs
index 127b2dac..cff4fd88 100644
--- a/dht/src/Network/Tox/Crypto/Transport.hs
+++ b/dht/src/Network/Tox/Crypto/Transport.hs
@@ -103,7 +103,7 @@ encodeCrypto (x,saddr) = Just (B.cons 0x1b (runPut $ put x),saddr)
 
 parseHandshakes :: ByteString -> addr -> Either String (Handshake Encrypted, addr)
 parseHandshakes (B.uncons -> Just (0x1a,pkt)) saddr = left ("parseHandshakes: "++) $ (,saddr) <$> runGet get pkt
-parseHandshakes bs                            _     = Left $ "parseHandshakes_: " ++ show (B.unpack $ B.take 1 bs)
+parseHandshakes bs                            _     = Left $ "Unhandled packet: " ++ show (B.unpack $ B.take 1 bs)
 
 encodeHandshakes :: Handshake Encrypted -> addr -> (ByteString, addr)
 encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr)
diff --git a/dht/src/Network/Tox/Onion/Handlers.hs b/dht/src/Network/Tox/Onion/Handlers.hs
index ca7d47db..bd441f06 100644
--- a/dht/src/Network/Tox/Onion/Handlers.hs
+++ b/dht/src/Network/Tox/Onion/Handlers.hs
@@ -373,6 +373,7 @@ putRendezvous getTimeout crypto client pubkey nonce32 ni = do
         rendezvousKey = key2id rkey
     asel <- atomically $ selectAlias crypto longTermKey
     let oaddr = OnionDestination asel ni Nothing
+    dput XPublish $ "putRendezvous at " ++ show ni
     fmap resultToMaybe
         $ sendOnion getTimeout client (AnnounceRequest nonce32 longTermKey rendezvousKey) oaddr
         $ \ni resp -> (Rendezvous rkey ni, resp)