Improved TCP-mediated handshake protocol.

2 files changed, 16 insertions, 17 deletions

diff --git a/dht/ToxManager.hs b/dht/ToxManager.hs
index 126efa36..63cb3967 100644
--- a/dht/ToxManager.hs
+++ b/dht/ToxManager.hs
@@ -297,25 +297,24 @@ connectViaRelay tx theirKey theirDhtKey ann tkey now = do
             established <- activeSesh tx theirKey
             runAction ann "connectViaRelay-print" $ do
                 dput XMan $ "connectViaRelay("++unpackAnnounceKey ann tkey++") established=" ++ show established
-            return $ when (not established) go
+            let Tox.SendNodes ns = Tox.dhtpkNodes theirDhtKey
+            do
+                -- Schedule a retry in 5 seconds.
+                let theirDhtKey' = theirDhtKey { Tox.dhtpkNodes = Tox.SendNodes (cycled ns) }
+                scheduleRel ann tkey (ScheduledItem $ connectViaRelay tx theirKey theirDhtKey') 5
+            return $ when (not established) (go ns)
             -- $ scheduleImmediately ann tkey $ ScheduledItem go
             -- return $ return ()
  where
     myPublicKey = toPublic $ userSecret (txAccount tx)
     me = key2id myPublicKey
     tkey = akeyConnectTCP (txAnnouncer tx) me theirKey
-    go = do
-        let Tox.SendNodes ns = Tox.dhtpkNodes theirDhtKey
-        mcons <- forM (filter (\n -> TCP.tcpPort n /= 0) ns) $ \ni -> do
-            mcon <- Multi.tcpConnectionRequest (txTCP tx) (Tox.dhtpk theirDhtKey) ni
-            return mcon
+    go ns = do
+        mapM_ (TCP.sendConnectionRequest (txTCP tx) $ Tox.dhtpk theirDhtKey)
+              (filter ((/= 0) . TCP.tcpPort) ns)
         let oobs = [ Multi.TCP ==> TCP.ViaRelay Nothing (Tox.key2id $ Tox.dhtpk theirDhtKey) ni | ni <- ns ]
-            addrs = catMaybes mcons ++ oobs
-        -- wait a sec to give connection requests a chance to be processed.
-        -- probably we should be handling ConnectNotification/DisconnectNotification
-        (\kont -> atomically $ scheduleRel ann tkey (ScheduledItem $ \_ _ _ -> return kont) 1) $ do
-            dput XMan $ "connectViaRelay: address count is " ++ show (length addrs)
-            forM_ addrs $ \ni -> do
+        dput XMan $ "connectViaRelay: address count is " ++ show (length oobs)
+        forM_ oobs $ \ni -> do
               cookieRequest (toxCryptoKeys $ txTox tx) (toxDHT $ txTox tx) myPublicKey ni >>= \case
                 Nothing -> dput XMan $ "connectViaRelay: no cookie from " ++ show ni
                 Just cookie -> do
@@ -325,11 +324,6 @@ connectViaRelay tx theirKey theirDhtKey ann tkey now = do
                     hs <- cacheHandshake (toxHandshakeCache $ txTox tx) (userSecret (txAccount tx)) theirKey ni cookie
                     dput XMan $  show their_nid ++ "<-- handshake " ++ show (key2id theirKey) ++ " (TCP)"
                     sendMessage (toxHandshakes $ txTox tx) (Multi.sessionAddr ni) hs
-            dput XMan $ "connectViaRelay trying again in 5 seconds ... "
-            atomically $ do
-                -- Try again in 5 seconds.
-                let theirDhtKey' = theirDhtKey { Tox.dhtpkNodes = Tox.SendNodes (cycled ns) }
-                scheduleRel ann tkey (ScheduledItem $ connectViaRelay tx theirKey theirDhtKey') 5
 
 gotDhtPubkey :: Tox.DHTPublicKey -> ToxToXMPP -> PublicKey -> IO ()
 gotDhtPubkey theirDhtKey tx theirKey = do
diff --git a/dht/src/Network/Tox/TCP.hs b/dht/src/Network/Tox/TCP.hs
index ebb15e3b..27a0f3d6 100644
--- a/dht/src/Network/Tox/TCP.hs
+++ b/dht/src/Network/Tox/TCP.hs
@@ -333,6 +333,11 @@ tcpPing client dst = do
                 , method         = PingPacket
                 }
 
+sendConnectionRequest :: Client err PacketNumber tid addr (Bool, RelayPacket)
+                            -> PublicKey -> addr -> IO ()
+sendConnectionRequest client pubkey ni =
+    sendMessage (clientNet client) ni (True,RoutingRequest pubkey)
+
 tcpConnectionRequest_ :: Client err PacketNumber tid addr (Bool, RelayPacket)
                         -> PublicKey -> addr -> IO (Maybe ConId)
 tcpConnectionRequest_ client pubkey ni = do