Schedule TCP chat-link session attempts.

1 files changed, 27 insertions, 8 deletions

diff --git a/dht/ToxManager.hs b/dht/ToxManager.hs
index 00e7146b..c4440409 100644
--- a/dht/ToxManager.hs
+++ b/dht/ToxManager.hs
@@ -277,6 +277,11 @@ nodeinfoStaleTime = 600 -- consider DHT node address stale after 10 minutes
 nodeinfoSearchInterval :: POSIXTime
 nodeinfoSearchInterval = 15 -- when no address, search DHT node every 15 seconds
 
+
+cycled :: [x] -> [x]
+cycled []     = []
+cycled (x:xs) = xs ++ [x]
+
 connectViaRelay :: ToxToXMPP -> PublicKey -> Tox.DHTPublicKey
                    -> Announcer -> AnnounceKey -> POSIXTime -> STM (IO ())
 connectViaRelay tx theirKey theirDhtKey ann tkey now = do
@@ -287,15 +292,28 @@ connectViaRelay tx theirKey theirDhtKey ann tkey now = do
             established <- activeSesh tx theirKey
             return $ when (not established) go
  where
+    myPublicKey = toPublic $ userSecret (txAccount tx)
+    me = key2id myPublicKey
+    tkey = akeyConnectTCP (txAnnouncer tx) me theirKey
     go = do
         let Tox.SendNodes ns = Tox.dhtpkNodes theirDhtKey
         mcon <- foldr (\action next -> action >>= maybe next (return . Just))
                       (return Nothing)
-                    $ map (\ni -> fmap ((,) ni) <$> TCP.tcpConnectionRequest (txTCP tx) theirKey ni) ns
-        forM_ mcon $ \(con,ni) -> do
-            return ()
-            -- TODO: try connect tcp relays
-            -- TODO: cookie;handshake
+                    $ map (Multi.tcpConnectionRequest (txTCP tx) theirKey) ns
+        forM_ mcon $ \ni -> do
+          cookieRequest (toxCryptoKeys $ txTox tx) (toxDHT $ txTox tx) myPublicKey ni >>= \case
+            Nothing -> return ()
+            Just cookie -> do
+                cookieCreationStamp <- getPOSIXTime
+                let their_nid = key2id $ dhtpk theirDhtKey
+                dput XNetCrypto $ 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)"
+                sendMessage (toxHandshakes $ txTox tx) (Multi.sessionAddr ni) hs
+        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
@@ -318,7 +336,7 @@ gotDhtPubkey theirDhtKey tx theirKey = do
           tkey = akeyConnectTCP (txAnnouncer tx) me theirKey
       atomically $ registerNodeCallback (toxRouting tox) (nic akey)
       scheduleSearch (txAnnouncer tx) akey meth theirDhtKey
-      -- TODO atomically $ scheduleImmediately (txAnnouncer tx) tkey $ ScheduledItem $ connectViaRelay tx theirKey theirDhtKey
+      atomically $ scheduleImmediately (txAnnouncer tx) tkey $ ScheduledItem $ connectViaRelay tx theirKey theirDhtKey
 
     target :: NodeId
     target = key2id $ dhtpk theirDhtKey
@@ -394,6 +412,9 @@ activeSesh tx theirKey = do
                         Just False -> return False
                         _          -> (== Established) <$> aggregateStatus c
 
+cookieMaxAge :: POSIXTime
+cookieMaxAge = 60 * 5
+
 getCookie
       :: ToxToXMPP
       -> PublicKey
@@ -428,8 +449,6 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain
     reschedule n f = scheduleRel ann akey f n
     reschedule' n f = reschedule n (ScheduledItem $ \_ _ now -> f now)
 
-    cookieMaxAge = 60 * 5
-
     getCookieIO :: IO ()
     getCookieIO = do
           dput XNetCrypto $ show addr ++ " <-- request cookie"