getContactInfo: Send optional TCP connection requests.

4 files changed, 32 insertions, 13 deletions

diff --git a/dht/ToxManager.hs b/dht/ToxManager.hs
index c1112a05..19db77ec 100644
--- a/dht/ToxManager.hs
+++ b/dht/ToxManager.hs
@@ -646,7 +646,9 @@ startConnecting0 tx them contact reason = do
             let meth = SearchMethod (toxQSearch tox) onResult (nearNodes tox) (key2id them) 30
                  where
                   onResult theirkey rendezvous = do
-                    dkey <- Tox.getContactInfo tox
+                    mTheirDHTKey <- atomically $ fmap ((,) (txTCP tx)) <$> contactDHTKey contact
+                    dkey <- Tox.getContactInfo mTheirDHTKey tox
+
                     let tr    = Tox.toxToRoute tox
                         route = Tox.AnnouncedRendezvous theirkey rendezvous
                     dput XMan $ unwords [ take 8 (show $ key2id theirkey)
diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index 0dcb4237..eb31543a 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -1596,7 +1596,11 @@ initTox runio opts ssvar keysdb mbxmpp invc = case porttox opts of
                                     --
                                     -- > a +dhtkey KWoEx1XQHrluIoW.3nK6BFb6XCebKWr3nDDt3V7CcoJ
                                     , ("dhtkey", DHTAnnouncable { announceSendData = Left ("toxid", readEither, \me them addr -> do
-                                                                        dkey <- Tox.getContactInfo tox
+                                                                        -- let mthem = Just ( TCP.tcpClient
+                                                                        --                    $ tcpKademliaClient
+                                                                        --                    $ toxOnionRoutes tox
+                                                                        --                  , them )
+                                                                        dkey <- Tox.getContactInfo Nothing tox
                                                                         sendMessage
                                                                             (Tox.toxToRoute tox)
                                                                             (Tox.AnnouncedRendezvous them addr)
diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs
index 0a6cccaa..6b39d57a 100644
--- a/dht/src/Network/Tox.hs
+++ b/dht/src/Network/Tox.hs
@@ -73,7 +73,7 @@ import qualified Network.Tox.Onion.Transport as Onion
 import Network.Tox.RelayPinger
 import System.Global6
 import Network.Tox.Transport
-import Network.Tox.TCP (tcpClient, ViaRelay(..))
+import Network.Tox.TCP (tcpClient, ViaRelay(..), RelayClient)
 import Network.Tox.Onion.Routes
 import Network.Tox.ContactInfo
 import Text.XXD
@@ -214,8 +214,8 @@ data Tox extra  = Tox
 
 
 -- | Create a DHTPublicKey packet to send to a remote contact.
-getContactInfo :: Tox extra -> IO DHT.DHTPublicKey
-getContactInfo Tox{toxCryptoKeys,toxRouting,toxOnionRoutes} = join $ atomically $ do
+getContactInfo :: Maybe (RelayClient,PublicKey) -> Tox extra -> IO DHT.DHTPublicKey
+getContactInfo mthem Tox{toxCryptoKeys,toxRouting,toxOnionRoutes} = join $ atomically $ do
     (rcnt,relays) <- currentRelays (tcpRelayPinger toxOnionRoutes)
     r4 <- readTVar $ DHT.routing4 toxRouting
     r6 <- readTVar $ DHT.routing6 toxRouting
@@ -227,12 +227,16 @@ getContactInfo Tox{toxCryptoKeys,toxRouting,toxOnionRoutes} = join $ atomically
         n6s = R.kclosest DHT.toxSpace 4 self r6
         ns = filter (DHT.isGlobal . nodeIP) [n4,n6]
               ++ concat (zipWith (\a b -> [a,b]) n4s n6s)
+        sending_ns = take 4 $ relays ++ map TCP.fromUDPNode ns
     return $ do
+        forM_ mthem $ \(tcp,theirDHTKey) ->
+            forM_ (filter (\n -> TCP.tcpPort n /= 0) sending_ns) $ \ni -> do
+                Multi.tcpConnectionRequest tcp theirDHTKey ni
         timestamp <- round . (* 1000000) <$> getPOSIXTime
         return DHT.DHTPublicKey
             { dhtpkNonce = timestamp
             , dhtpk      = id2key self
-            , dhtpkNodes = DHT.SendNodes $ take 4 $ relays ++ map TCP.fromUDPNode ns
+            , dhtpkNodes = DHT.SendNodes sending_ns
             }
 
 isLocalHost :: SockAddr -> Bool
diff --git a/dht/src/Network/Tox/ContactInfo.hs b/dht/src/Network/Tox/ContactInfo.hs
index d5640ce8..3cf5bb2b 100644
--- a/dht/src/Network/Tox/ContactInfo.hs
+++ b/dht/src/Network/Tox/ContactInfo.hs
@@ -2,20 +2,23 @@
 {-# LANGUAGE LambdaCase #-}
 module Network.Tox.ContactInfo where
 
-import Connection
-
-import Data.Time.Clock.POSIX
+import Control.Arrow
 import Control.Concurrent.STM
 import Control.Monad
 import Crypto.PubKey.Curve25519
 import qualified Data.HashMap.Strict as HashMap
          ;import Data.HashMap.Strict (HashMap)
+import Data.List
 import Data.Maybe
-import Network.Tox.DHT.Transport     as DHT
-import Network.Tox.NodeId            (id2key)
-import Network.Tox.Onion.Transport   as Onion
-import DPut
+import Data.Ord
+import Data.Time.Clock.POSIX
+
+import Connection
 import DebugTag
+import DPut
+import Network.Tox.DHT.Transport   as DHT
+import Network.Tox.NodeId          (id2key)
+import Network.Tox.Onion.Transport as Onion
 
 newtype ContactInfo extra = ContactInfo
     {
@@ -43,6 +46,12 @@ data Contact = Contact
     , contactPolicy        :: TVar (Maybe Connection.Policy)
     }
 
+contactDHTKey :: Contact -> STM (Maybe PublicKey)
+contactDHTKey c = do
+    mkeypkt <- fmap (second dhtpk) <$> readTVar (contactKeyPacket c)
+    mseen <- fmap (second $ id2key . nodeId) <$> readTVar (contactLastSeenAddr c)
+    return $ fmap snd $ listToMaybe $ sortOn (Down . fst) $ catMaybes [mkeypkt,mseen]
+
 newContactInfo :: IO (ContactInfo extra)
 newContactInfo = atomically $ ContactInfo <$> newTVar HashMap.empty