Implemented command to list scheduled announcements.

3 files changed, 31 insertions, 8 deletions

diff --git a/Announcer.hs b/Announcer.hs
index a2c8bde9..da1adcee 100644
--- a/Announcer.hs
+++ b/Announcer.hs
@@ -1,10 +1,12 @@
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE ExistentialQuantification  #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE NamedFieldPuns             #-}
 {-# LANGUAGE NondecreasingIndentation   #-}
 module Announcer
-    ( Announcer
+    ( Announcer(scheduled)
     , AnnounceKey
     , packAnnounceKey
     , unpackAnnounceKey
@@ -13,6 +15,7 @@ module Announcer
     , stopAnnouncer
     , schedule
     , cancel
+    , itemStatusNum
     ) where
 
 import qualified Data.MinMaxPSQ as MM
@@ -31,6 +34,8 @@ import Data.Hashable
 import Data.Maybe
 import Data.Ord
 import Data.Time.Clock.POSIX
+import qualified GHC.Generics as Generics
+import Generic.Data.Internal.Meta as Lyxia
 
 newtype AnnounceKey = AnnounceKey ByteString
  deriving (Hashable,Ord,Eq)
@@ -38,16 +43,24 @@ newtype AnnounceKey = AnnounceKey ByteString
 packAnnounceKey :: Announcer -> String -> STM AnnounceKey
 packAnnounceKey _ = return . AnnounceKey . Char8.pack
 
-unpackAnnounceKey :: AnnounceKey -> AnnounceKey -> STM String
+unpackAnnounceKey :: Announcer -> AnnounceKey -> STM String
 unpackAnnounceKey _ (AnnounceKey bs) = return $ Char8.unpack bs
 
 data ScheduledItem
-    = StopAnnouncer
+    = DeleteAnnouncement
     | NewAnnouncement (STM (IO ())) (IO ()) (IO ()) POSIXTime
     | SearchFinished (IO ()) (IO ()) POSIXTime
     | Announce (STM (IO ())) (IO ()) POSIXTime
     | SearchResult (STM (IO ()))
-    | DeleteAnnouncement
+    | StopAnnouncer
+ -- Can't use Data because STM and IO. :(
+ -- deriving Data {- itemStatusNum sch = constrIndex $ toConstr sch -}
+ -- Using Generic to accomplish the job.
+ deriving Generics.Generic
+
+
+itemStatusNum :: ScheduledItem -> Int
+itemStatusNum sch = Lyxia.conIdToInt $ Lyxia.conId sch
 
 data Announcer = Announcer
     { scheduled       :: TVar (PSQ' AnnounceKey POSIXTime ScheduledItem)
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 3e48e4bb..0439ed7e 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -769,6 +769,17 @@ clientSession s@Session{..} sock cnum h = do
         --
         --         a +friend <jid> <text>
         --         a +dhtkey <key>
+        ("a", "") -> cmd0 $ do
+                        now <- getPOSIXTime
+                        rs <- atomically $ do
+                            as <- readTVar (scheduled $ announcer)
+                            forM (PSQ.toList as) $ \(k,ptm,item) -> do
+                                kstr <- unpackAnnounceKey announcer k
+                                return [ show (ptm - now)
+                                       , show (itemStatusNum item)
+                                       , kstr
+                                       ]
+                        hPutClient h $ showColumns rs
         ("a", s) | Just DHT{..} <- Map.lookup netname dhts
                  , not (null s)
                     -> cmd0 $ do
@@ -805,6 +816,7 @@ clientSession s@Session{..} sock cnum h = do
                             reportit target = case op of
                                         '+' -> hPutClient h $ "Announcing at " ++ target ++ "."
                                         '-' -> hPutClient h $ "Canceling " ++ target ++ "."
+                            -- mameth is for typical kademlia announce.
                             mameth = do
                                 DHTAnnouncable { announceSendData
                                                , announceParseData
@@ -824,6 +836,8 @@ clientSession s@Session{..} sock cnum h = do
                                                             announceInterval)
                                             dta
                                     reportit $ show $ announceTarget dta
+                            -- lmeth is for atypical announce messages such as
+                            --   Tox dht-key and friend-request messages.
                             lmeth :: Maybe (IO ())
                             lmeth = do
                                 DHTAnnouncable { announceSendData
diff --git a/todo.txt b/todo.txt
index 70af1142..10dc26cf 100644
--- a/todo.txt
+++ b/todo.txt
@@ -1,15 +1,11 @@
 xmpp: handle tox-friends in roster.
 
-xmpp: load tox user key from ~/.presence/<pubkey>.tox/secret
-
 tox: Add fallback trials to cookie response in case response is from another address than request.
 
 ui: Online help.
 
 ui: Explicit routing table node deletion. "forget" command.
 
-ui: a -  with no arguments would list the currently active recuring publications.
-
 kademlia: Change refresh algorithm to refresh farther away buckets before closer ones.
 
 kademlia: Remove (without replacement) stale routing nodes at some point.