diff options
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r-- | examples/dhtd.hs | 16 |
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 | ||
1421 | vShowMe :: Tox.ViewSnapshot -> Int -> B.ByteString | 1425 | vShowMe :: Tox.ViewSnapshot -> Int -> B.ByteString |