diff options
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r-- | examples/dhtd.hs | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 4de735bc..ebc8b69e 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs | |||
@@ -145,6 +145,7 @@ data DHT = forall nid ni. ( Show ni | |||
145 | ) => | 145 | ) => |
146 | DHT | 146 | DHT |
147 | { dhtBuckets :: TVar (BucketList ni) | 147 | { dhtBuckets :: TVar (BucketList ni) |
148 | , dhtSecretKey :: STM (Maybe SecretKey) | ||
148 | , dhtPing :: Map.Map String (DHTPing ni) | 149 | , dhtPing :: Map.Map String (DHTPing ni) |
149 | , dhtQuery :: Map.Map String (DHTQuery nid ni) | 150 | , dhtQuery :: Map.Map String (DHTQuery nid ni) |
150 | , dhtAnnouncables :: Map.Map String DHTAnnouncable | 151 | , dhtAnnouncables :: Map.Map String DHTAnnouncable |
@@ -435,7 +436,11 @@ clientSession s@Session{..} sock cnum h = do | |||
435 | ++ [mappend " *" . show . Tox.key2id $ pubkey] | 436 | ++ [mappend " *" . show . Tox.key2id $ pubkey] |
436 | | "secrets" <- strp s -> cmd0 $ do | 437 | | "secrets" <- strp s -> cmd0 $ do |
437 | ks <- atomically $ readTVar userkeys | 438 | ks <- atomically $ readTVar userkeys |
438 | hPutClient h . showReport $ map mkrow ks | 439 | skey <- maybe (return Nothing) (atomically . dhtSecretKey) |
440 | $ Map.lookup netname dhts | ||
441 | hPutClient h . showReport $ map mkrow ks ++ case skey >>= encodeSecret of | ||
442 | Just x -> [("",""),("dht-key:",B.unpack x)] | ||
443 | Nothing -> [] | ||
439 | | ("add":secs) <- words s | 444 | | ("add":secs) <- words s |
440 | , mbSecs <- map (decodeSecret . B.pack) secs | 445 | , mbSecs <- map (decodeSecret . B.pack) secs |
441 | , all isJust mbSecs -> cmd0 $ do | 446 | , all isJust mbSecs -> cmd0 $ do |
@@ -713,6 +718,7 @@ main = do | |||
713 | Just _ -> return Nothing | 718 | Just _ -> return Nothing |
714 | })] | 719 | })] |
715 | 720 | ||
721 | , dhtSecretKey = return Nothing | ||
716 | } | 722 | } |
717 | dhts = Map.fromList $ | 723 | dhts = Map.fromList $ |
718 | ("bt4", mainlineDHT Mainline.routing4 Want_IP4) | 724 | ("bt4", mainlineDHT Mainline.routing4 Want_IP4) |
@@ -836,6 +842,7 @@ main = do | |||
836 | Right (pubkey :: PublicKey, nospam) | 842 | Right (pubkey :: PublicKey, nospam) |
837 | return r | 843 | return r |
838 | })] | 844 | })] |
845 | , dhtSecretKey = return $ Just $ transportSecret (Tox.toxCryptoKeys tox) | ||
839 | } | 846 | } |
840 | dhts = Map.fromList $ | 847 | dhts = Map.fromList $ |
841 | ("tox4", toxDHT Tox.routing4) | 848 | ("tox4", toxDHT Tox.routing4) |
@@ -873,9 +880,9 @@ main = do | |||
873 | 880 | ||
874 | forM_ (Map.toList dhts) | 881 | forM_ (Map.toList dhts) |
875 | $ \(netname, dht@DHT { dhtBuckets = bkts | 882 | $ \(netname, dht@DHT { dhtBuckets = bkts |
876 | , dhtQuery = qrys | 883 | , dhtQuery = qrys |
877 | , dhtPing = pings | 884 | , dhtPing = pings |
878 | , dhtFallbackNodes = getBootstrapNodes }) -> do | 885 | , dhtFallbackNodes = getBootstrapNodes }) -> do |
879 | btSaved <- loadNodes netname -- :: IO [Mainline.NodeInfo] | 886 | btSaved <- loadNodes netname -- :: IO [Mainline.NodeInfo] |
880 | putStrLn $ "Loaded "++show (length btSaved)++" nodes for "++netname++"." | 887 | putStrLn $ "Loaded "++show (length btSaved)++" nodes for "++netname++"." |
881 | fallbackNodes <- getBootstrapNodes | 888 | fallbackNodes <- getBootstrapNodes |