Reclassifying debug prints.

6 files changed, 31 insertions, 48 deletions

diff --git a/dht/ToxManager.hs b/dht/ToxManager.hs
index 4c67e853..7d164b9d 100644
--- a/dht/ToxManager.hs
+++ b/dht/ToxManager.hs
@@ -26,6 +26,7 @@ import Data.Ord
 import qualified Data.Set                    as Set
 import qualified Data.Text                   as T
          ;import Data.Text                   (Text)
+import Data.Text.Encoding                    (decodeUtf8)
 import Data.Time.Clock.POSIX
 import qualified Data.Tox.DHT.Multi          as Multi
 import Data.Word
@@ -304,9 +305,9 @@ connectViaRelay tx theirKey theirDhtKey ann tkey now = do
             Just cookie -> do
                 cookieCreationStamp <- getPOSIXTime
                 let their_nid = key2id $ dhtpk theirDhtKey
-                dput XNetCrypto $ show their_nid ++ " --> cookie (TCP)"
+                dput XMan $ show their_nid ++ " --> cookie (TCP)"
                 hs <- cacheHandshake (toxHandshakeCache $ txTox tx) (userSecret (txAccount tx)) theirKey ni cookie
-                dput XNetCrypto $  show their_nid ++ "<-- handshake " ++ show (key2id theirKey) ++ " (TCP)"
+                dput XMan $  show their_nid ++ "<-- handshake " ++ show (key2id theirKey) ++ " (TCP)"
                 sendMessage (toxHandshakes $ txTox tx) (Multi.sessionAddr ni) hs
         atomically $ do
             -- Try again in 5 seconds.
@@ -315,7 +316,7 @@ connectViaRelay tx theirKey theirDhtKey ann tkey now = do
 
 gotDhtPubkey :: Tox.DHTPublicKey -> ToxToXMPP -> PublicKey -> IO ()
 gotDhtPubkey theirDhtKey tx theirKey = do
-  dput XNetCrypto $ unlines $
+  dput XMan $ unlines $
     [ "Recieved DHTKey from " ++ show (Tox.key2id theirKey)
     , "  DHT: " ++ show target
     ] ++ let Tox.SendNodes ns = Tox.dhtpkNodes theirDhtKey
@@ -365,13 +366,15 @@ gotDhtPubkey theirDhtKey tx theirKey = do
     showak k = unpackAnnounceKey (txAnnouncer tx) k
 
     assume :: Show infosource => AnnounceKey -> POSIXTime -> infosource -> NodeInfo -> STM ()
-    assume akey time addr ni =
-      tput XNodeinfoSearch $ show ("rumor", showak akey, time, addr, ni)
+    assume akey time addr ni = do
+      runAction (txAnnouncer tx) "rumor" $ do
+          dput XMan $ show ("rumor", showak akey, time, addr, ni)
 
     observe :: AnnounceKey -> POSIXTime -> NodeInfo -> STM ()
     observe akey time ni@(nodeAddr -> addr) = do
-      tput XNodeinfoSearch $ show ("observation", showak akey, time, addr)
       setContactAddr time theirKey ni (txAccount tx)
+      runAction (txAnnouncer tx) "observe" $ do
+          dput XMan $ show ("observation", showak akey, time, addr)
 
 gotAddr :: NodeInfo -> ToxToXMPP -> PublicKey -> IO ()
 gotAddr ni@(nodeAddr -> addr) tx theirKey = do
@@ -435,7 +438,8 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain
     addr = nodeAddr ni
     hscache = toxHandshakeCache $ txTox tx
     getCookieAgain = do
-          tput XNodeinfoSearch $ show ("getCookieAgain", unpackAnnounceKey ann akey)
+          runAction (txAnnouncer tx) "getCookieAgain" $ do
+              dput XMan $ show ("getCookieAgain", unpackAnnounceKey ann akey)
           mbContact  <- getC
           case mbContact of
             Nothing      -> return $ return ()
@@ -446,7 +450,7 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain
     callRealShakeHands cookie = do
             forM_ (nodeInfo (key2id $ dhtpk theirDhtKey) (nodeAddr ni)) $ \ni' -> do
             hs <- cacheHandshake hscache (userSecret (txAccount tx)) theirKey (Multi.UDP ==> ni') cookie
-            dput XNetCrypto $  show addr ++ "<-- handshake " ++ show (key2id theirKey)
+            dput XMan $  show addr ++ "<-- handshake " ++ show (key2id theirKey)
             sendMessage (toxHandshakes $ txTox tx) (Multi.SessionUDP ==> nodeAddr ni) hs
 
     reschedule n f = scheduleRel ann akey f n
@@ -454,7 +458,7 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain
 
     getCookieIO :: IO ()
     getCookieIO = do
-          dput XNetCrypto $ show addr ++ " <-- request cookie"
+          dput XMan $ show addr ++ " <-- request cookie"
           let pending flag = setPendingCookie hscache myPublicKey theirKey flag
           atomically $ pending True
           cookieRequest (toxCryptoKeys $ txTox tx) (toxDHT $ txTox tx) myPublicKey (Multi.UDP ==> ni) >>= \case
@@ -462,7 +466,7 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain
                         pending False
                         reschedule' 5 (const getCookieAgain)
             Just cookie -> do
-              dput XNetCrypto $ show addr ++ "--> cookie"
+              dput XMan $ show addr ++ "--> cookie"
               atomically $ pending False
               void $ callRealShakeHands cookie
               cookieCreationStamp <- getPOSIXTime
@@ -473,7 +477,7 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain
                       then return $ return ()
                       else if (now > cookieCreationStamp + cookieMaxAge)
                              then return $
-                                  dput XNetCrypto "getCookieIO/shaker - cookie expired" >>
+                                  dput XMan "getCookieIO/shaker - cookie expired" >>
                                   getCookieIO
                              else do
                                reschedule' 5 shaker
@@ -481,30 +485,6 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain
               atomically $ reschedule' 5 shaker
 
 
-{-
-realShakeHands :: SecretKey -> PublicKey -> PublicKey -> Tox.NetCryptoSessions -> SockAddr -> Tox.Cookie Encrypted -> IO Bool
-realShakeHands myseckey theirpubkey theirDhtKey allsessions saddr cookie = do
-  dput XUnused "realShakeHands"
-  let hp =
-        HParam
-        { hpOtherCookie = cookie
-        , hpMySecretKey = myseckey
-        , hpCookieRemotePubkey = theirpubkey
-        , hpCookieRemoteDhtkey = theirDhtKey
-        , hpTheirBaseNonce = Nothing
-        , hpTheirSessionKeyPublic = Nothing
-        }
-  newsession <- generateSecretKey
-  timestamp <- getPOSIXTime
-  (myhandshake, ioAction) <-
-    atomically $
-    Tox.freshCryptoSession allsessions saddr newsession timestamp hp
-  ioAction
-  -- send handshake
-  isJust <$> forM myhandshake (Tox.sendHandshake allsessions saddr)
--}
-
-
 
 dispatch :: ToxToXMPP -> ContactEvent -> IO ()
 dispatch tx (SessionEstablished theirKey                   ) = do stopConnecting tx theirKey "established"
@@ -515,6 +495,11 @@ dispatch tx (PolicyChange theirkey TryingToConnect         ) = startConnecting t
 dispatch tx (PolicyChange theirkey policy                  ) = stopConnecting tx theirkey "policy"
 dispatch tx (OnionRouted  theirKey (OnionDHTPublicKey pkey)) = gotDhtPubkey pkey tx theirKey
 dispatch tx (OnionRouted  theirkey (OnionFriendRequest fr) ) = do
+    dput XMan $ unlines $
+      [ "Recieved FriendRequest from " ++ show (Tox.key2id theirkey)
+      , "  NoSpam: " ++ nospam16 (NoSpam (friendNoSpam fr) Nothing)
+      , "  Text:   " ++ T.unpack (decodeUtf8 $ friendRequestText fr)
+      ]
     let ToxToXMPP { txAnnouncer = acr
                   , txAccount   = acnt
                   , txPresence  = st } = tx
@@ -686,8 +671,10 @@ stopConnecting ToxToXMPP{txAnnouncer=announcer,txAccount=acnt} them reason = do
     let pub  = toPublic $ userSecret acnt
         me   = key2id pub
         akeyC = akeyConnect     announcer me them
+        akeyT = akeyConnectTCP  announcer me them
         akeyD = akeyDHTKeyShare announcer me them
     cancel announcer akeyC
+    cancel announcer akeyT
     cancel announcer akeyD
 
 closeSessions :: NodeId{-me-} -> NodeId{-them-} -> TVar (Map.Map Uniq24 AggregateSession) -> IO ()
diff --git a/dht/src/Data/Tox/Onion.hs b/dht/src/Data/Tox/Onion.hs
index 86fc71f4..faff3cdf 100644
--- a/dht/src/Data/Tox/Onion.hs
+++ b/dht/src/Data/Tox/Onion.hs
@@ -831,8 +831,8 @@ decrypt crypto msg addr = do
             Right (msg, addr)
     case msg of
         OnionToRouteResponse {} -> case result of
-            Left e  -> dput XOnion $ "Error decrypting data-to-route response: " ++ e
-            Right m -> dput XOnion $ "Decrypted data-to-route response: " ++ show (fst m)
+            Left e  -> dput XMan $ "Error decrypting data-to-route response: " ++ e
+            Right m -> dput XMan $ "Decrypted data-to-route response: " ++ show (fst m)
         _ -> return ()
     return result
 
diff --git a/dht/src/DebugTag.hs b/dht/src/DebugTag.hs
index 83f9b1f8..75d07ef8 100644
--- a/dht/src/DebugTag.hs
+++ b/dht/src/DebugTag.hs
@@ -7,20 +7,16 @@ data DebugTag
   = XAnnounce
   | XAnnounceResponse
   | XBitTorrent
-  | XDHT
   | XLan
   | XMan
   | XNetCrypto
-  | XNetCryptoOut
   | XOnion
   | XRelay
   | XRoutes
   | XPing
-  | XRefresh
   | XJabber
   | XTCP
   | XMisc
-  | XNodeinfoSearch
   | XUnexpected -- Used only for special anomalous errors that we didn't expect to happen.
   | XUnused     -- Never commit code that uses XUnused.
   deriving (Eq, Ord, Show, Read, Enum, Bounded,Typeable)
diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs
index 1a3bee79..a7e5d2c2 100644
--- a/dht/src/Network/Tox.hs
+++ b/dht/src/Network/Tox.hs
@@ -266,11 +266,11 @@ newTox :: TVar Onion.AnnouncedKeys   -- ^ Store of announced keys we are a rende
 newTox keydb bindspecs onsess crypto usetcp = do
   msock <- Bind.udpTransport' True bindspecs
   let failedBind = do
-            dput XDHT $ "tox udp bind error: " ++ show bindspecs
+            dput XMisc $ "tox udp bind error: " ++ show bindspecs
             throwIO $ userError "Tox UDP listen port?"
   fromMaybe failedBind $ msock <&> \(udp,sock) -> do
     addr <- getSocketName sock
-    dput XOnion $ "UDP bind address: " ++ show addr
+    dput XMisc $ "UDP bind address: " ++ show addr
     (relay,sendTCP) <-
         if usetcp then do
             fmap (Just *** Just) $ tcpRelay (fst crypto) addr $ \a x -> do
diff --git a/dht/src/Network/Tox/Onion/Handlers.hs b/dht/src/Network/Tox/Onion/Handlers.hs
index 8db1c534..ca7d47db 100644
--- a/dht/src/Network/Tox/Onion/Handlers.hs
+++ b/dht/src/Network/Tox/Onion/Handlers.hs
@@ -121,18 +121,18 @@ dataToRouteH ::
           -> IO ()
 dataToRouteH keydb udp _ (OnionToRoute pub asymm) = do
     let k = key2id pub
-    dput XOnion $ "dataToRouteH "++ show k
+    dput XAnnounce $ "dataToRouteH "++ show k
     mb <- atomically $ do
         ks <- readTVar keydb
         forM (MinMaxPSQ.lookup' k (keyAssoc ks)) $ \(p,(cnt,rpath)) -> do
             writeTVar keydb $ ks { keyAssoc = MinMaxPSQ.insert' k (cnt + 1, rpath) p (keyAssoc ks) }
             return rpath
-    dput XOnion $ "dataToRouteH "++ show (fmap (const ()) mb)
+    dput XAnnounce $ "dataToRouteH "++ show (fmap (const ()) mb)
     forM_ mb $ \rpath -> do
         -- forward
-        dput XOnion $ "dataToRouteH sendMessage"
+        dput XAnnounce $ "dataToRouteH sendMessage"
         sendMessage udp (toOnionDestination rpath) $ OnionToRouteResponse asymm
-        dput XOnion $ "Forwarding data-to-route -->"++show k
+        dput XAnnounce $ "Forwarding data-to-route -->"++show k
 
 type NodeDistance = NodeId
 
diff --git a/dht/src/Network/Tox/Relay.hs b/dht/src/Network/Tox/Relay.hs
index 66ab4b71..b315648a 100644
--- a/dht/src/Network/Tox/Relay.hs
+++ b/dht/src/Network/Tox/Relay.hs
@@ -272,7 +272,7 @@ tcpRelay crypto udp_addr sendOnion = do
     b33445 <- getBindAddress "33445" True
     bany   <- getBindAddress ""      True
     h <- forkStreamServer ServerConfig
-                        { serverWarn    = dput XOnion
+                        { serverWarn    = dput XMisc
                         , serverSession = relaySession crypto clients cons sendOnion
                         }
                       [b443,b80,b3389,udp_addr,b33445,bany]