PSQ instead of list for peer set. Also: dhtd "swarms" command.

1 files changed, 9 insertions, 3 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 6bf48595..96c31dfe 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -111,7 +111,8 @@ hPutClient h s = hPutStr h (marshalForClient s)
 clientSession :: Node IPv4 -> MVar () -> RestrictedSocket -> Int -> Handle -> IO ()
 clientSession st signalQuit sock n h = do
     line <- map toLower . dropWhile isSpace <$> hGetLine h
-    let cmd action = action >> clientSession st signalQuit sock n h
+    let cmd0 action = action >> clientSession st signalQuit sock n h
+        cmd  action = cmd0 $ join $ runDHT st action
     case line of
 
         "quit" -> hPutClient h "goodbye." >> hClose h
@@ -120,7 +121,7 @@ clientSession st signalQuit sock n h = do
                      hClose h
                      putMVar signalQuit ()
 
-        "ls" -> cmd $ join $ runDHT st $ do
+        "ls" -> cmd $ do
                     tbl <- getTable
                     t <- showTable
                     me <- myNodeIdAccordingTo (read "8.8.8.8:6881")
@@ -133,8 +134,13 @@ clientSession st signalQuit sock n h = do
                             , ("internet address", show ip)
                             , ("buckets", show $ R.shape tbl)]
                         ]
+        "swarms" -> cmd $ do
+                    ss <- getSwarms
+                    let r = map (\(h,c,n) -> (unwords [show h,show c], maybe "" show n)) ss
+                    return $ do
+                    hPutClient h $ showReport r
 
-        _    -> cmd $ hPutClient h "error."
+        _    -> cmd0 $ hPutClient h "error."
 
 main :: IO ()
 main = do