1 files changed, 22 insertions, 35 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 ()