1 files changed, 15 insertions, 1 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 8e8d47a2..3f6dcaf4 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE NondecreasingIndentation  #-}
 {-# LANGUAGE OverloadedStrings         #-}
 {-# LANGUAGE PartialTypeSignatures     #-}
+{-# LANGUAGE PatternSynonyms           #-}
 {-# LANGUAGE RankNTypes                #-}
 {-# LANGUAGE RecordWildCards           #-}
 {-# LANGUAGE ScopedTypeVariables       #-}
@@ -59,6 +60,10 @@ import System.IO.Error
 import qualified Data.Serialize as S
 import Network.BitTorrent.DHT.ContactInfo as Peers
 import qualified Data.MinMaxPSQ as MM
+import Data.Wrapper.PSQ as PSQ (pattern (:->))
+import qualified Data.Wrapper.PSQ as PSQ
+import Data.Ord
+import Data.Time.Clock.POSIX
 
 showReport :: [(String,String)] -> String
 showReport kvs = showColumns $ map (\(x,y)->[x,y]) kvs
@@ -260,6 +265,7 @@ data Session = Session
     , dhts              :: Map.Map String DHT
     , externalAddresses :: IO [SockAddr]
     , swarms            :: Mainline.SwarmsDatabase
+    , toxkeys           :: TVar Tox.AnnouncedKeys
     , signalQuit        :: MVar ()
     }
 
@@ -436,6 +442,13 @@ clientSession s@Session{..} sock cnum h = do
                             ps <- atomically $ Peers.lookup ih <$> readTVar (Mainline.contactInfo swarms)
                             hPutClient h $ showReport $ map (((,) "") . show . pPrint) ps
                         Left er -> hPutClient h er
+        ("keys", s) -> cmd0 $ do
+                        keydb <- atomically $ readTVar toxkeys
+                        now <- getPOSIXTime
+                        let entries = map mkentry $ PSQ.toList (Tox.keyByAge keydb)
+                            mkentry (k :-> Down tm) = [ show cnt, show k, show (now - tm) ]
+                                where Just (_,(cnt,_)) = MM.lookup' k (Tox.keyAssoc keydb)
+                        hPutClient h $ showColumns entries
 
         (n, _) | n `elem` Map.keys dhts -> switchNetwork n
 
@@ -473,7 +486,7 @@ main = do
 
     let toxport = succ $ fromMaybe 33445 (fromIntegral <$> sockAddrPort addr)
     addrTox <- getBindAddress (show toxport) True
-    (tox,toxR) <- Tox.newClient addrTox
+    (tox,toxR,toxkeys) <- Tox.newClient addrTox
 
     quitTox <- forkListener (clientNet tox)
 
@@ -529,6 +542,7 @@ main = do
                 , dhts              = dhts  -- all DHTs
                 , signalQuit        = signalQuit
                 , swarms            = swarms
+                , toxkeys           = toxkeys
                 , externalAddresses = readExternals
                                         [ Mainline.routing4 btR
                                         , Mainline.routing6 btR