summaryrefslogtreecommitdiff
path: root/examples/dhtd.hs
diff options
context:
space:
mode:
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r--examples/dhtd.hs16
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