More information in "roster" output.

1 files changed, 21 insertions, 9 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index d0d8678d..355450a2 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -606,16 +606,28 @@ clientSession s@Session{..} sock cnum h = do
                             Just k
 
         ("roster", s) -> cmd0 $ join $ atomically $ do
-            dns <- dnsPresentation roster
-            fs <- HashMap.toList <$> friendRequests roster
-            let showFriend (remotekey,fr) =
-                    ("  " ++ show remotekey, T.unpack $ T.decodeUtf8 $ Tox.friendRequestText fr)
-                showAccount (me,cs) =
-                    [(show me,"")] ++ map showFriend cs
-                frs = fs >>= showAccount
+            let ContactInfo{accounts} = roster
+            as <- readTVar accounts
+            css <- forM as $ \acnt -> do
+                    cs <- readTVar (contacts acnt)
+                    forM cs $ \c -> do
+                        ck <- readTVar $ contactKeyPacket c
+                        ca <- readTVar $ contactLastSeenAddr c
+                        cf <- readTVar $ contactFriendRequest c
+                        cp <- readTVar $ contactPolicy c
+                        return $ [ maybe "none" show cp
+                                 , maybe "" (show . Tox.key2id . Tox.dhtpk . snd) ck
+                                 , maybe "" (show . snd) ca
+                                 , maybe "" (T.unpack . T.decodeUtf8 . Tox.friendRequestText . snd) cf
+                                 ]
             return $ do
-                hPutClientChunk h $ unlines [ dns, "", "Friend Requests" ]
-                hPutClient h $ showReport frs
+                forM_ (HashMap.toList css) $ \(me,xss) -> do
+                    let cs = map (\(toxid,xs) -> show toxid : xs)
+                                 $ HashMap.toList xss
+                    hPutClientChunk h $ unlines [ show me, map (const '-') (show me) ]
+                    hPutClientChunk h $ showColumns $ ["ToxID","Policy","NodeID","Address","FR text"]
+                                                      : cs
+                hPutClient h ""
 
         ("quiet",s) | s' <- strp s
                     , Just (tag::DebugTag) <- readMaybe ('X':map toUpper (take 1 s') ++ drop 1 s')