diff options
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r-- | examples/dhtd.hs | 16 |
1 files changed, 12 insertions, 4 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 3d6b5f7b..c03df3cc 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs | |||
@@ -651,6 +651,7 @@ clientSession s@Session{..} sock cnum h = do | |||
651 | 651 | ||
652 | ("roster", s) -> cmd0 $ join $ atomically $ do | 652 | ("roster", s) -> cmd0 $ join $ atomically $ do |
653 | let ContactInfo{accounts} = roster | 653 | let ContactInfo{accounts} = roster |
654 | nosummary = not (null s) | ||
654 | as <- readTVar accounts | 655 | as <- readTVar accounts |
655 | css <- forM as $ \acnt -> do | 656 | css <- forM as $ \acnt -> do |
656 | cs <- readTVar (contacts acnt) | 657 | cs <- readTVar (contacts acnt) |
@@ -659,9 +660,16 @@ clientSession s@Session{..} sock cnum h = do | |||
659 | ca <- readTVar $ contactLastSeenAddr c | 660 | ca <- readTVar $ contactLastSeenAddr c |
660 | cf <- readTVar $ contactFriendRequest c | 661 | cf <- readTVar $ contactFriendRequest c |
661 | cp <- readTVar $ contactPolicy c | 662 | cp <- readTVar $ contactPolicy c |
662 | return $ [ maybe "none" show cp | 663 | let showPolicy TryingToConnect = "*" |
663 | , maybe "" (show . Tox.key2id . Tox.dhtpk . snd) ck | 664 | showPolicy OpenToConnect = "o" |
664 | , maybe "" (show . snd) ca | 665 | showPolicy RefusingToConnect = "x" |
666 | summarizeNodeId | nosummary = id | ||
667 | | otherwise = take 6 | ||
668 | summarizeAddr | nosummary = id | ||
669 | | otherwise = reverse . take 20 . reverse | ||
670 | return $ [ maybe "/" showPolicy cp | ||
671 | , maybe "" (summarizeNodeId . show . Tox.key2id . Tox.dhtpk . snd) ck | ||
672 | , maybe "" (summarizeAddr . show . snd) ca | ||
665 | , maybe "" (show . T.decodeUtf8 . Tox.friendRequestText . snd) cf | 673 | , maybe "" (show . T.decodeUtf8 . Tox.friendRequestText . snd) cf |
666 | ] | 674 | ] |
667 | return $ do | 675 | return $ do |
@@ -669,7 +677,7 @@ clientSession s@Session{..} sock cnum h = do | |||
669 | let cs = map (\(toxid,xs) -> show toxid : xs) | 677 | let cs = map (\(toxid,xs) -> show toxid : xs) |
670 | $ HashMap.toList xss | 678 | $ HashMap.toList xss |
671 | hPutClientChunk h $ unlines [ show me, map (const '-') (show me) ] | 679 | hPutClientChunk h $ unlines [ show me, map (const '-') (show me) ] |
672 | hPutClientChunk h $ showColumns $ ["ToxID","Policy","NodeID","Address","FR text"] | 680 | hPutClientChunk h $ showColumns $ ["ToxID","","NodeID","Address","FR text"] |
673 | : cs | 681 | : cs |
674 | hPutClient h "" | 682 | hPutClient h "" |
675 | 683 | ||