diff options
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r-- | examples/dhtd.hs | 16 |
1 files changed, 15 insertions, 1 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 8e8d47a2..3f6dcaf4 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs | |||
@@ -8,6 +8,7 @@ | |||
8 | {-# LANGUAGE NondecreasingIndentation #-} | 8 | {-# LANGUAGE NondecreasingIndentation #-} |
9 | {-# LANGUAGE OverloadedStrings #-} | 9 | {-# LANGUAGE OverloadedStrings #-} |
10 | {-# LANGUAGE PartialTypeSignatures #-} | 10 | {-# LANGUAGE PartialTypeSignatures #-} |
11 | {-# LANGUAGE PatternSynonyms #-} | ||
11 | {-# LANGUAGE RankNTypes #-} | 12 | {-# LANGUAGE RankNTypes #-} |
12 | {-# LANGUAGE RecordWildCards #-} | 13 | {-# LANGUAGE RecordWildCards #-} |
13 | {-# LANGUAGE ScopedTypeVariables #-} | 14 | {-# LANGUAGE ScopedTypeVariables #-} |
@@ -59,6 +60,10 @@ import System.IO.Error | |||
59 | import qualified Data.Serialize as S | 60 | import qualified Data.Serialize as S |
60 | import Network.BitTorrent.DHT.ContactInfo as Peers | 61 | import Network.BitTorrent.DHT.ContactInfo as Peers |
61 | import qualified Data.MinMaxPSQ as MM | 62 | import qualified Data.MinMaxPSQ as MM |
63 | import Data.Wrapper.PSQ as PSQ (pattern (:->)) | ||
64 | import qualified Data.Wrapper.PSQ as PSQ | ||
65 | import Data.Ord | ||
66 | import Data.Time.Clock.POSIX | ||
62 | 67 | ||
63 | showReport :: [(String,String)] -> String | 68 | showReport :: [(String,String)] -> String |
64 | showReport kvs = showColumns $ map (\(x,y)->[x,y]) kvs | 69 | showReport kvs = showColumns $ map (\(x,y)->[x,y]) kvs |
@@ -260,6 +265,7 @@ data Session = Session | |||
260 | , dhts :: Map.Map String DHT | 265 | , dhts :: Map.Map String DHT |
261 | , externalAddresses :: IO [SockAddr] | 266 | , externalAddresses :: IO [SockAddr] |
262 | , swarms :: Mainline.SwarmsDatabase | 267 | , swarms :: Mainline.SwarmsDatabase |
268 | , toxkeys :: TVar Tox.AnnouncedKeys | ||
263 | , signalQuit :: MVar () | 269 | , signalQuit :: MVar () |
264 | } | 270 | } |
265 | 271 | ||
@@ -436,6 +442,13 @@ clientSession s@Session{..} sock cnum h = do | |||
436 | ps <- atomically $ Peers.lookup ih <$> readTVar (Mainline.contactInfo swarms) | 442 | ps <- atomically $ Peers.lookup ih <$> readTVar (Mainline.contactInfo swarms) |
437 | hPutClient h $ showReport $ map (((,) "") . show . pPrint) ps | 443 | hPutClient h $ showReport $ map (((,) "") . show . pPrint) ps |
438 | Left er -> hPutClient h er | 444 | Left er -> hPutClient h er |
445 | ("keys", s) -> cmd0 $ do | ||
446 | keydb <- atomically $ readTVar toxkeys | ||
447 | now <- getPOSIXTime | ||
448 | let entries = map mkentry $ PSQ.toList (Tox.keyByAge keydb) | ||
449 | mkentry (k :-> Down tm) = [ show cnt, show k, show (now - tm) ] | ||
450 | where Just (_,(cnt,_)) = MM.lookup' k (Tox.keyAssoc keydb) | ||
451 | hPutClient h $ showColumns entries | ||
439 | 452 | ||
440 | (n, _) | n `elem` Map.keys dhts -> switchNetwork n | 453 | (n, _) | n `elem` Map.keys dhts -> switchNetwork n |
441 | 454 | ||
@@ -473,7 +486,7 @@ main = do | |||
473 | 486 | ||
474 | let toxport = succ $ fromMaybe 33445 (fromIntegral <$> sockAddrPort addr) | 487 | let toxport = succ $ fromMaybe 33445 (fromIntegral <$> sockAddrPort addr) |
475 | addrTox <- getBindAddress (show toxport) True | 488 | addrTox <- getBindAddress (show toxport) True |
476 | (tox,toxR) <- Tox.newClient addrTox | 489 | (tox,toxR,toxkeys) <- Tox.newClient addrTox |
477 | 490 | ||
478 | quitTox <- forkListener (clientNet tox) | 491 | quitTox <- forkListener (clientNet tox) |
479 | 492 | ||
@@ -529,6 +542,7 @@ main = do | |||
529 | , dhts = dhts -- all DHTs | 542 | , dhts = dhts -- all DHTs |
530 | , signalQuit = signalQuit | 543 | , signalQuit = signalQuit |
531 | , swarms = swarms | 544 | , swarms = swarms |
545 | , toxkeys = toxkeys | ||
532 | , externalAddresses = readExternals | 546 | , externalAddresses = readExternals |
533 | [ Mainline.routing4 btR | 547 | [ Mainline.routing4 btR |
534 | , Mainline.routing6 btR | 548 | , Mainline.routing6 btR |