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, 10 insertions, 6 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 67507634..369650f9 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -622,14 +622,17 @@ clientSession s@Session{..} sock cnum h = do
622 -> cmd0 $ do 622 -> cmd0 $ do
623 sessions <- concat . Map.elems <$> (atomically $ readTVar (Tox.netCryptoSessionsByKey cryptosessions)) 623 sessions <- concat . Map.elems <$> (atomically $ readTVar (Tox.netCryptoSessionsByKey cryptosessions))
624 let sessionsReport = mapM showPerSession sessions 624 let sessionsReport = mapM showPerSession sessions
625 headers = ["SessionID", "YourKey", "TheirKey", "NextMsg", "Dropped","Handled","Unhandled"] 625 headers = ["SessionID", "YourKey", "TheirKey", "NextMsg", "Dropped" {-,"Handled","Unhandled" -}
626 ,"Progress" ]
626 showPerSession (Tox.NCrypto 627 showPerSession (Tox.NCrypto
627 { ncSessionId = id 628 { ncState = progressVar
629 , ncSessionId = id
628 , ncMyPublicKey = yourkey 630 , ncMyPublicKey = yourkey
629 , ncTheirPublicKey = theirkey 631 , ncTheirPublicKey = theirkey
630 , ncLastNMsgs = lastN 632 , ncLastNMsgs = lastN
631 , ncSockAddr = sockAddr 633 , ncSockAddr = sockAddr
632 }) = do 634 }) = do
635 progress <- atomically $ readTVar progressVar
633 (num,dropped) <- atomically $ liftA2 (,) (CB.getTotal lastN) (CB.getDropped lastN) 636 (num,dropped) <- atomically $ liftA2 (,) (CB.getTotal lastN) (CB.getDropped lastN)
634 as <- atomically (CB.cyclicBufferViewList lastN) 637 as <- atomically (CB.cyclicBufferViewList lastN)
635 let (h,u) = partition (fst . snd) as 638 let (h,u) = partition (fst . snd) as
@@ -640,8 +643,9 @@ clientSession s@Session{..} sock cnum h = do
640 , show (Tox.key2id theirkey)-- "TheirKey" 643 , show (Tox.key2id theirkey)-- "TheirKey"
641 , show num -- "NextMsg" 644 , show num -- "NextMsg"
642 , show dropped -- "Dropped" 645 , show dropped -- "Dropped"
643 , show countHandled -- "Handled" 646 -- , show countHandled -- "Handled"
644 , show countUnhandled -- "Unhandled" 647 -- , show countUnhandled -- "Unhandled"
648 , show progress
645 ] 649 ]
646 if null sessions 650 if null sessions
647 then hPutClient h "No sessions." 651 then hPutClient h "No sessions."
@@ -1161,7 +1165,7 @@ clientSession s@Session{..} sock cnum h = do
1161 keydb <- atomically $ readTVar toxkeys 1165 keydb <- atomically $ readTVar toxkeys
1162 now <- getPOSIXTime 1166 now <- getPOSIXTime
1163 let entries = map mkentry $ PSQ.toList (Tox.keyByAge keydb) 1167 let entries = map mkentry $ PSQ.toList (Tox.keyByAge keydb)
1164 mkentry (k :-> Down tm) = [ show cnt, show k, show (now - tm) ] 1168 mkentry (k :-> tm) = [ show cnt, show k, show (now - tm) ]
1165 where Just (_,(cnt,_)) = MM.lookup' k (Tox.keyAssoc keydb) 1169 where Just (_,(cnt,_)) = MM.lookup' k (Tox.keyAssoc keydb)
1166 hPutClient h $ showColumns entries 1170 hPutClient h $ showColumns entries
1167 1171
@@ -1415,7 +1419,7 @@ announceToxJabberPeer them echan laddr saddr pingflag tsrc tsnk
1415 , Tcp.Connection pingflag xsrc xsnk ) 1419 , Tcp.Connection pingflag xsrc xsnk )
1416 return Nothing 1420 return Nothing
1417 where 1421 where
1418 xsrc = tsrc =$= toxToXmpp (T.pack $ show them ++ ".tox") 1422 xsrc = tsrc =$= toxToXmpp (T.pack $ show (Tox.key2id them) ++ ".tox")
1419 xsnk = flushPassThrough xmppToTox =$= tsnk 1423 xsnk = flushPassThrough xmppToTox =$= tsnk
1420 1424
1421vShowMe :: Tox.ViewSnapshot -> Int -> B.ByteString 1425vShowMe :: Tox.ViewSnapshot -> Int -> B.ByteString