More flexible Connection interface.

1 files changed, 16 insertions, 9 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index d6049c13..45a2a682 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -351,6 +351,10 @@ clientSession0 s sock cnum h = do
 parseDebugTag :: String -> Maybe DebugTag
 parseDebugTag s' = readMaybe ('X':map toUpper (take 1 s') ++ drop 1 s')
 
+showPolicy TryingToConnect   = "*"
+showPolicy OpenToConnect     = "o"
+showPolicy RefusingToConnect = "x"
+
 clientSession :: Session -> t1 -> t -> ClientHandle -> IO ()
 clientSession s@Session{..} sock cnum h = do
     line <- dropWhile isSpace <$> hGetClientLine h
@@ -640,10 +644,7 @@ clientSession s@Session{..} sock cnum h = do
                         ca <- readTVar $ contactLastSeenAddr c
                         cf <- readTVar $ contactFriendRequest c
                         cp <- readTVar $ contactPolicy c
-                        let showPolicy TryingToConnect   = "*"
-                            showPolicy OpenToConnect     = "o"
-                            showPolicy RefusingToConnect = "x"
-                            summarizeNodeId | nosummary = id
+                        let summarizeNodeId | nosummary = id
                                             | otherwise = take 6
                             summarizeAddr | nosummary = id
                                           | otherwise = reverse . take 20 . reverse
@@ -1275,12 +1276,18 @@ clientSession s@Session{..} sock cnum h = do
         ("c", s) | Just (ConnectionManager mgr) <- connectionManager
                  , "" <- strp s
                  -> cmd0 $ join $ atomically $ do
-            cmap <- connections mgr
-            cs <- Map.toList <$> mapM connStatus cmap
-            let mkrow = Connection.showKey mgr *** Connection.showStatus mgr
-                rs    = map mkrow cs
+            cs <- do
+                ks <- connections mgr
+                forM ks $ \k -> do
+                    stat <- Connection.status mgr k
+                    return (k,stat)
+            let mkrow (k,st) = [ Connection.showKey mgr k
+                               , Connection.showStatus mgr (connStatus st)
+                               , showPolicy (connPolicy st)
+                               ]
+                rs = map mkrow cs
             return $ do
-            hPutClient h $ showReport rs
+            hPutClient h $ showColumns rs
 
         ("help", s) | Just DHT{..} <- Map.lookup netname dhts
                     -> cmd0 $ do