Multi Transports: TCP for DHT/Cookies/Handshakes.

2 files changed, 15 insertions, 10 deletions

diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index 0f95f562..bd12821a 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -35,6 +35,7 @@ import Data.Bits (xor)
 import Data.Char
 import Data.Conduit as C
 import qualified Data.Conduit.List as C
+import Data.Dependent.Sum
 import Data.Function
 import Data.Functor.Identity
 import Data.Hashable
@@ -66,6 +67,7 @@ import Announcer.Tox
 import ToxManager
 import Codec.AsciiKey256
 import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys)
+import qualified Data.Tox.DHT.Multi as Multi
 import DebugUtil
 import Network.UPNP as UPNP
 import Network.Address hiding (NodeId, NodeInfo(..))
@@ -1417,7 +1419,7 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
                     { dhtBuckets = bkts (Tox.toxRouting tox)
                     , dhtPing    = Map.fromList
                                     [ ("ping", DHTPing
-                                            { pingQuery = noArgPing $ fmap (bool Nothing (Just ())) . Tox.ping (Tox.toxDHT tox)
+                                            { pingQuery = noArgPing $ fmap (bool Nothing (Just ())) . Tox.pingUDP (Tox.toxDHT tox)
                                             , pingShowResult = show
                                             })
                                     , ("cookie", DHTPing
@@ -1426,6 +1428,7 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
                                                          -> Tox.cookieRequest (Tox.toxCryptoKeys tox)
                                                                               (Tox.toxDHT tox)
                                                                               (Tox.id2key mykey)
+                                                                              . (Multi.UDP ==>)
                                                 _        -> const $ return Nothing
                                             , pingShowResult = show
                                             })]
@@ -1434,7 +1437,7 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
                                         { qsearch = Tox.nodeSearch (Tox.toxDHT tox)
                                                                    (Tox.nodesOfInterest $ Tox.toxRouting tox)
                                         , qhandler = (\ni -> fmap Tox.unwrapNodes
-                                                                . Tox.getNodesH (Tox.toxRouting tox) ni
+                                                                . Tox.getNodesH (Tox.toxRouting tox) (Multi.UDP ==> ni)
                                                                 . Tox.GetNodes)
                                         , qshowR = show -- NodeInfo
                                         , qshowTok = (const Nothing)
@@ -1444,7 +1447,8 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
                                         , qhandler = -- qhandler :: ni -> nid -> IO ([ni], [r], tok)
                                                          (\ni nid ->
                                                             Tox.unwrapAnnounceResponse Nothing
-                                                                <$> clientAddress (Tox.toxDHT tox) Nothing
+                                                                <$> fmap (fromJust . Multi.udpNode)
+                                                                         (clientAddress (Tox.toxDHT tox) Nothing)
                                                                 <*> Tox.announceH (Tox.toxRouting tox)
                                                                                   (Tox.toxTokens tox)
                                                                                   (Tox.toxAnnouncedKeys tox)
@@ -1800,7 +1804,7 @@ main = do
         let defaultToxData = do
                 rster <- Tox.newContactInfo
                 crypto <- newCrypto
-                (orouter,_) <- newOnionRouter crypto (dput XMisc) (enableTCPDHT opts)
+                (orouter,_,_) <- newOnionRouter crypto (dput XMisc) False -- (enableTCPDHT opts)
                 return (rster, orouter)
         (rstr,orouter) <- fromMaybe defaultToxData $ do
             tox <- mbtox
diff --git a/dht/examples/testTox.hs b/dht/examples/testTox.hs
index 6db977be..36162163 100644
--- a/dht/examples/testTox.hs
+++ b/dht/examples/testTox.hs
@@ -13,8 +13,11 @@ import Control.Concurrent.STM.TVar
 import Control.Monad
 import Control.Monad.STM
 import Crypto.Tox
+import Data.Dependent.Sum
 import qualified Data.IntMap.Strict          as IntMap
 import Data.Function
+import Data.Tox.Msg
+import qualified Data.Tox.DHT.Multi          as Multi
 import DebugUtil
 import DPut
 import DebugTag
@@ -34,8 +37,6 @@ import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Map.Strict as Map
 import Data.Time.Clock.POSIX
 import System.Exit
-import Data.Dependent.Sum
-import Data.Tox.Msg
 
 makeToxNode :: UDPTransport -> Maybe SecretKey
         -> ( ContactInfo extra -> SockAddr -> Session -> IO () )
@@ -74,11 +75,11 @@ sessionChan remotes tchan acnt saddr s = do
 
 netCrypto :: Tox extra -> SecretKey -> NodeInfo -> PublicKey -> IO ()
 netCrypto tox me ni them = do
-    mcookie <- cookieRequest (toxCryptoKeys tox) (toxDHT tox) (toPublic me) ni
+    mcookie <- cookieRequest (toxCryptoKeys tox) (toxDHT tox) (toPublic me) (Multi.UDP ==> ni)
     case mcookie of
         Just cookie -> do
-            hs <- cacheHandshake (toxHandshakeCache tox) me them ni cookie
-            sendMessage (toxHandshakes tox) (nodeAddr ni) hs
+            hs <- cacheHandshake (toxHandshakeCache tox) me them (Multi.UDP ==> ni) cookie
+            sendMessage (toxHandshakes tox) (Multi.SessionUDP ==> nodeAddr ni) hs
         Nothing -> do
             dput XUnused "Timeout requesting cookie."
 
@@ -145,7 +146,7 @@ main = do
                         }
                       )
 
-    DHT.ping (toxDHT a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) b
+    DHT.pingUDP (toxDHT a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) b
 
     -- sendMessage (toxHandshakes a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) (nodeAddr b) hs