diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/dhtd.hs | 32 |
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 | |||
73 | import Network.Address hiding (NodeId, NodeInfo(..)) | 73 | import Network.Address hiding (NodeId, NodeInfo(..)) |
74 | import Network.QueryResponse | 74 | import Network.QueryResponse |
75 | import Network.StreamServer | 75 | import Network.StreamServer |
76 | import Network.Kademlia.Bootstrap (refreshBuckets,bootstrap) | ||
76 | import Network.Kademlia.CommonAPI | 77 | import Network.Kademlia.CommonAPI |
77 | import Network.Kademlia.Persistence | 78 | import Network.Kademlia.Persistence |
78 | import Network.Kademlia.Routing as R | 79 | import Network.Kademlia.Routing as R |
@@ -95,6 +96,7 @@ import qualified Network.Tox.DHT.Handlers as Tox | |||
95 | import qualified Network.Tox.Onion.Transport as Tox | 96 | import qualified Network.Tox.Onion.Transport as Tox |
96 | import qualified Network.Tox.Onion.Handlers as Tox | 97 | import qualified Network.Tox.Onion.Handlers as Tox |
97 | import qualified Network.Tox.Crypto.Transport as Tox | 98 | import qualified Network.Tox.Crypto.Transport as Tox |
99 | import qualified Network.Tox.TCP as TCP | ||
98 | import Data.Typeable | 100 | import Data.Typeable |
99 | import Network.Tox.ContactInfo as Tox | 101 | import Network.Tox.ContactInfo as Tox |
100 | import OnionRouter | 102 | import OnionRouter |
@@ -1316,6 +1318,8 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of | |||
1316 | 1318 | ||
1317 | toxSearches <- atomically $ newTVar Map.empty | 1319 | toxSearches <- atomically $ newTVar Map.empty |
1318 | 1320 | ||
1321 | tcpSearches <- atomically $ newTVar Map.empty | ||
1322 | |||
1319 | let toxDHT bkts wantip = DHT | 1323 | let toxDHT bkts wantip = DHT |
1320 | { dhtBuckets = bkts (Tox.toxRouting tox) | 1324 | { dhtBuckets = bkts (Tox.toxRouting tox) |
1321 | , dhtPing = Map.fromList | 1325 | , dhtPing = Map.fromList |
@@ -1486,11 +1490,36 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of | |||
1486 | Want_IP4 -> toxStrap4 | 1490 | Want_IP4 -> toxStrap4 |
1487 | Want_IP6 -> toxStrap6 | 1491 | Want_IP6 -> toxStrap6 |
1488 | } | 1492 | } |
1493 | tcpclient = tcpKademliaClient $ Tox.toxOnionRoutes tox | ||
1494 | tcpRefresher = tcpBucketRefresher $ Tox.toxOnionRoutes tox | ||
1495 | tcpDHT = DHT | ||
1496 | { dhtBuckets = refreshBuckets tcpRefresher | ||
1497 | , dhtSecretKey = return $ Just $ transportSecret (Tox.toxCryptoKeys tox) | ||
1498 | , dhtPing = Map.singleton "ping" DHTPing | ||
1499 | { pingQuery = noArgPing $ TCP.tcpPing (TCP.tcpClient tcpclient) | ||
1500 | , pingShowResult = show | ||
1501 | } | ||
1502 | , dhtQuery = Map.singleton "node" DHTQuery | ||
1503 | { qsearch = TCP.nodeSearch tcpclient | ||
1504 | , qhandler = \ni nid -> do | ||
1505 | ns <- R.kclosest (searchSpace $ TCP.nodeSearch tcpclient) searchK nid | ||
1506 | <$> atomically (readTVar $ refreshBuckets tcpRefresher) | ||
1507 | return (ns,ns,Just ()) | ||
1508 | , qshowR = show -- TCP.NodeInfo | ||
1509 | , qshowTok = (const Nothing) | ||
1510 | } | ||
1511 | , dhtAnnouncables = Map.empty | ||
1512 | , dhtParseId = readEither :: String -> Either String Tox.NodeId | ||
1513 | , dhtSearches = tcpSearches | ||
1514 | , dhtFallbackNodes = return [] | ||
1515 | , dhtBootstrap = bootstrap tcpRefresher | ||
1516 | } | ||
1489 | dhts = Map.fromList $ | 1517 | dhts = Map.fromList $ |
1490 | ("tox4", toxDHT Tox.routing4 Want_IP4) | 1518 | ("tox4", toxDHT Tox.routing4 Want_IP4) |
1491 | : if ip6tox opts | 1519 | : if ip6tox opts |
1492 | then [ ("tox6", toxDHT Tox.routing6 Want_IP6) ] | 1520 | then [ ("tox6", toxDHT Tox.routing6 Want_IP6) ] |
1493 | else [] | 1521 | else [] |
1522 | ++ [("toxtcp", tcpDHT)] | ||
1494 | ips :: IO [SockAddr] | 1523 | ips :: IO [SockAddr] |
1495 | ips = readExternals Tox.nodeAddr [ Tox.routing4 $ Tox.toxRouting tox | 1524 | ips = readExternals Tox.nodeAddr [ Tox.routing4 $ Tox.toxRouting tox |
1496 | , Tox.routing6 $ Tox.toxRouting tox ] | 1525 | , Tox.routing6 $ Tox.toxRouting tox ] |
@@ -1668,7 +1697,8 @@ main = do | |||
1668 | installHandler sigINT (CatchOnce (atomically $ writeTVar signalQuit True)) Nothing | 1697 | installHandler sigINT (CatchOnce (atomically $ writeTVar signalQuit True)) Nothing |
1669 | let defaultToxData = do | 1698 | let defaultToxData = do |
1670 | rster <- Tox.newContactInfo | 1699 | rster <- Tox.newContactInfo |
1671 | orouter <- newOnionRouter (dput XMisc) | 1700 | crypto <- newCrypto |
1701 | orouter <- newOnionRouter crypto (dput XMisc) | ||
1672 | return (rster, orouter) | 1702 | return (rster, orouter) |
1673 | (rstr,orouter) <- fromMaybe defaultToxData $ do | 1703 | (rstr,orouter) <- fromMaybe defaultToxData $ do |
1674 | tox <- mbtox | 1704 | tox <- mbtox |