diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/dhtd.hs | 12 |
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) | |||
111 | clientSession :: Node IPv4 -> MVar () -> RestrictedSocket -> Int -> Handle -> IO () | 111 | clientSession :: Node IPv4 -> MVar () -> RestrictedSocket -> Int -> Handle -> IO () |
112 | clientSession st signalQuit sock n h = do | 112 | clientSession st signalQuit sock n h = do |
113 | line <- map toLower . dropWhile isSpace <$> hGetLine h | 113 | line <- map toLower . dropWhile isSpace <$> hGetLine h |
114 | let cmd action = action >> clientSession st signalQuit sock n h | 114 | let cmd0 action = action >> clientSession st signalQuit sock n h |
115 | cmd action = cmd0 $ join $ runDHT st action | ||
115 | case line of | 116 | case line of |
116 | 117 | ||
117 | "quit" -> hPutClient h "goodbye." >> hClose h | 118 | "quit" -> hPutClient h "goodbye." >> hClose h |
@@ -120,7 +121,7 @@ clientSession st signalQuit sock n h = do | |||
120 | hClose h | 121 | hClose h |
121 | putMVar signalQuit () | 122 | putMVar signalQuit () |
122 | 123 | ||
123 | "ls" -> cmd $ join $ runDHT st $ do | 124 | "ls" -> cmd $ do |
124 | tbl <- getTable | 125 | tbl <- getTable |
125 | t <- showTable | 126 | t <- showTable |
126 | me <- myNodeIdAccordingTo (read "8.8.8.8:6881") | 127 | me <- myNodeIdAccordingTo (read "8.8.8.8:6881") |
@@ -133,8 +134,13 @@ clientSession st signalQuit sock n h = do | |||
133 | , ("internet address", show ip) | 134 | , ("internet address", show ip) |
134 | , ("buckets", show $ R.shape tbl)] | 135 | , ("buckets", show $ R.shape tbl)] |
135 | ] | 136 | ] |
137 | "swarms" -> cmd $ do | ||
138 | ss <- getSwarms | ||
139 | let r = map (\(h,c,n) -> (unwords [show h,show c], maybe "" show n)) ss | ||
140 | return $ do | ||
141 | hPutClient h $ showReport r | ||
136 | 142 | ||
137 | _ -> cmd $ hPutClient h "error." | 143 | _ -> cmd0 $ hPutClient h "error." |
138 | 144 | ||
139 | main :: IO () | 145 | main :: IO () |
140 | main = do | 146 | main = do |