summaryrefslogtreecommitdiff
path: root/examples/dhtd.hs
diff options
context:
space:
mode:
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r--examples/dhtd.hs32
1 files changed, 25 insertions, 7 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index ef225f0c..a1b8d665 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -49,6 +49,7 @@ import Network.QueryResponse
49import Network.StreamServer 49import Network.StreamServer
50import Kademlia 50import Kademlia
51import qualified Mainline 51import qualified Mainline
52import qualified Tox
52import Network.DHT.Routing as R 53import Network.DHT.Routing as R
53import Data.Aeson as J (ToJSON, FromJSON) 54import Data.Aeson as J (ToJSON, FromJSON)
54import qualified Data.Aeson as J 55import qualified Data.Aeson as J
@@ -280,7 +281,7 @@ clientSession s@Session{..} sock cnum h = do
280 pid <- getProcessID 281 pid <- getProcessID
281 hPutClient h (show pid) 282 hPutClient h (show pid)
282 ("external-ip", _) -> cmd0 $ do 283 ("external-ip", _) -> cmd0 $ do
283 unlines . map (either show show . Mainline.either4or6) <$> externalAddresses 284 unlines . map (either show show . either4or6) <$> externalAddresses
284 >>= hPutClient h 285 >>= hPutClient h
285#ifdef THREAD_DEBUG 286#ifdef THREAD_DEBUG
286 ("threads", _) -> cmd0 $ do 287 ("threads", _) -> cmd0 $ do
@@ -470,10 +471,16 @@ main = do
470 471
471 quitBt <- forkListener bt 472 quitBt <- forkListener bt
472 473
473 tox <- return $ error "TODO: Tox.newClient" 474 let toxport = succ $ fromMaybe 33445 (fromIntegral <$> sockAddrPort addr)
474 quitTox <- return $ return () -- TODO: forkListener tox 475 addrTox <- getBindAddress (show toxport) True
476 (tox,toxR) <- Tox.newClient addrTox
477
478 -- TODO: load saved tox nodes.
479
480 quitTox <- forkListener tox
475 481
476 mainlineSearches <- atomically $ newTVar Map.empty 482 mainlineSearches <- atomically $ newTVar Map.empty
483 toxSearches <- atomically $ newTVar Map.empty
477 484
478 let mainlineDHT bkts = DHT 485 let mainlineDHT bkts = DHT
479 { dhtBuckets = bkts btR 486 { dhtBuckets = bkts btR
@@ -482,13 +489,13 @@ main = do
482 [ ("node", DHTQuery (Mainline.nodeSearch bt) 489 [ ("node", DHTQuery (Mainline.nodeSearch bt)
483 (\ni -> fmap Mainline.unwrapNodes 490 (\ni -> fmap Mainline.unwrapNodes
484 . Mainline.findNodeH btR ni 491 . Mainline.findNodeH btR ni
485 . flip Mainline.FindNode (Just Mainline.Want_Both)) 492 . flip Mainline.FindNode (Just Want_Both))
486 show 493 show
487 (const Nothing)) 494 (const Nothing))
488 , ("peer", DHTQuery (Mainline.peerSearch bt) 495 , ("peer", DHTQuery (Mainline.peerSearch bt)
489 (\ni -> fmap Mainline.unwrapPeers 496 (\ni -> fmap Mainline.unwrapPeers
490 . Mainline.getPeersH btR swarms ni 497 . Mainline.getPeersH btR swarms ni
491 . flip Mainline.GetPeers (Just Mainline.Want_Both) 498 . flip Mainline.GetPeers (Just Want_Both)
492 . (read . show)) -- TODO: InfoHash -> NodeId 499 . (read . show)) -- TODO: InfoHash -> NodeId
493 (show . pPrint) 500 (show . pPrint)
494 (Just . show)) 501 (Just . show))
@@ -496,9 +503,20 @@ main = do
496 , dhtParseId = readEither :: String -> Either String Mainline.NodeId 503 , dhtParseId = readEither :: String -> Either String Mainline.NodeId
497 , dhtSearches = mainlineSearches 504 , dhtSearches = mainlineSearches
498 } 505 }
506 toxDHT bkts = DHT
507 { dhtBuckets = bkts toxR
508 , dhtPing = Tox.ping tox
509 , dhtQuery = Map.fromList
510 [ -- "node"
511 ]
512 , dhtParseId = readEither :: String -> Either String Tox.NodeId
513 , dhtSearches = toxSearches
514 }
499 dhts = Map.fromList 515 dhts = Map.fromList
500 [ ("bt4", mainlineDHT Mainline.routing4) 516 [ ("bt4", mainlineDHT Mainline.routing4)
501 , ("bt6", mainlineDHT Mainline.routing6) 517 , ("bt6", mainlineDHT Mainline.routing6)
518 , ("tox4", toxDHT Tox.routing4)
519 , ("tox6", toxDHT Tox.routing6)
502 ] 520 ]
503 521
504 waitForSignal <- do 522 waitForSignal <- do
@@ -521,7 +539,7 @@ main = do
521 let bkts4 = Mainline.routing4 btR 539 let bkts4 = Mainline.routing4 btR
522 btSaved4 <- loadNodes "bt4" :: IO [Mainline.NodeInfo] 540 btSaved4 <- loadNodes "bt4" :: IO [Mainline.NodeInfo]
523 putStrLn $ "Loaded "++show (length btSaved4)++" nodes for bt4." 541 putStrLn $ "Loaded "++show (length btSaved4)++" nodes for bt4."
524 fallbackNodes4 <- Mainline.bootstrapNodes Mainline.Want_IP4 542 fallbackNodes4 <- Mainline.bootstrapNodes Want_IP4
525 fork $ do 543 fork $ do
526 myThreadId >>= flip labelThread "bootstrap.Mainline4" 544 myThreadId >>= flip labelThread "bootstrap.Mainline4"
527 bootstrap (Mainline.nodeSearch bt) bkts4 (Mainline.ping bt) btSaved4 fallbackNodes4 545 bootstrap (Mainline.nodeSearch bt) bkts4 (Mainline.ping bt) btSaved4 fallbackNodes4
@@ -530,7 +548,7 @@ main = do
530 btSaved6 <- loadNodes "bt6" 548 btSaved6 <- loadNodes "bt6"
531 putStrLn $ "Loaded "++show (length btSaved6)++" nodes for bt6." 549 putStrLn $ "Loaded "++show (length btSaved6)++" nodes for bt6."
532 let bkts6 = Mainline.routing6 btR 550 let bkts6 = Mainline.routing6 btR
533 fallbackNodes6 <- Mainline.bootstrapNodes Mainline.Want_IP6 551 fallbackNodes6 <- Mainline.bootstrapNodes Want_IP6
534 fork $ do 552 fork $ do
535 myThreadId >>= flip labelThread "bootstrap.Mainline6" 553 myThreadId >>= flip labelThread "bootstrap.Mainline6"
536 bootstrap (Mainline.nodeSearch bt) bkts6 (Mainline.ping bt) btSaved6 fallbackNodes6 554 bootstrap (Mainline.nodeSearch bt) bkts6 (Mainline.ping bt) btSaved6 fallbackNodes6