Integrated cli interface to TCP Kademlia table.

1 files changed, 31 insertions, 1 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 04b8c064..959383dc 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -73,6 +73,7 @@ import Network.UPNP as UPNP
 import Network.Address hiding (NodeId, NodeInfo(..))
 import Network.QueryResponse
 import Network.StreamServer
+import Network.Kademlia.Bootstrap (refreshBuckets,bootstrap)
 import Network.Kademlia.CommonAPI
 import Network.Kademlia.Persistence
 import Network.Kademlia.Routing as R
@@ -95,6 +96,7 @@ import qualified Network.Tox.DHT.Handlers as Tox
 import qualified Network.Tox.Onion.Transport as Tox
 import qualified Network.Tox.Onion.Handlers as Tox
 import qualified Network.Tox.Crypto.Transport as Tox
+import qualified Network.Tox.TCP as TCP
 import Data.Typeable
 import Network.Tox.ContactInfo as Tox
 import OnionRouter
@@ -1316,6 +1318,8 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
 
             toxSearches <- atomically $ newTVar Map.empty
 
+            tcpSearches <- atomically $ newTVar Map.empty
+
             let toxDHT bkts wantip = DHT
                     { dhtBuckets = bkts (Tox.toxRouting tox)
                     , dhtPing    = Map.fromList
@@ -1486,11 +1490,36 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
                                         Want_IP4 -> toxStrap4
                                         Want_IP6 -> toxStrap6
                     }
+                tcpclient = tcpKademliaClient $ Tox.toxOnionRoutes tox
+                tcpRefresher = tcpBucketRefresher $ Tox.toxOnionRoutes tox
+                tcpDHT = DHT
+                    { dhtBuckets = refreshBuckets tcpRefresher
+                    , dhtSecretKey = return $ Just $ transportSecret (Tox.toxCryptoKeys tox)
+                    , dhtPing = Map.singleton "ping" DHTPing
+                                    { pingQuery = noArgPing $ TCP.tcpPing (TCP.tcpClient tcpclient)
+                                    , pingShowResult = show
+                                    }
+                    , dhtQuery = Map.singleton "node" DHTQuery
+                                    { qsearch = TCP.nodeSearch tcpclient
+                                    , qhandler = \ni nid -> do
+                                        ns <- R.kclosest (searchSpace $ TCP.nodeSearch tcpclient) searchK nid
+                                                <$> atomically (readTVar $ refreshBuckets tcpRefresher)
+                                        return (ns,ns,Just ())
+                                    , qshowR = show -- TCP.NodeInfo
+                                    , qshowTok = (const Nothing)
+                                    }
+                    , dhtAnnouncables = Map.empty
+                    , dhtParseId = readEither :: String -> Either String Tox.NodeId
+                    , dhtSearches = tcpSearches
+                    , dhtFallbackNodes = return []
+                    , dhtBootstrap = bootstrap tcpRefresher
+                    }
                 dhts = Map.fromList $
                         ("tox4", toxDHT Tox.routing4 Want_IP4)
                         : if ip6tox opts
                             then [ ("tox6", toxDHT Tox.routing6 Want_IP6) ]
                             else []
+                        ++ [("toxtcp", tcpDHT)]
                 ips :: IO [SockAddr]
                 ips = readExternals Tox.nodeAddr [ Tox.routing4 $ Tox.toxRouting tox
                                                  , Tox.routing6 $ Tox.toxRouting tox ]
@@ -1668,7 +1697,8 @@ main = do
         installHandler sigINT (CatchOnce (atomically $ writeTVar signalQuit True)) Nothing
         let defaultToxData = do
                 rster <- Tox.newContactInfo
-                orouter <- newOnionRouter (dput XMisc)
+                crypto <- newCrypto
+                orouter <- newOnionRouter crypto (dput XMisc)
                 return (rster, orouter)
         (rstr,orouter) <- fromMaybe defaultToxData $ do
             tox <- mbtox