1 files changed, 34 insertions, 16 deletions

diff --git a/Announcer.hs b/Announcer.hs
index 1f539d5d..f19f8d46 100644
--- a/Announcer.hs
+++ b/Announcer.hs
@@ -15,9 +15,11 @@ module Announcer
     , cancel
     ) where
 
-import Data.Wrapper.PSQ as PSQ
-import Network.Kademlia.Search
+import qualified Data.MinMaxPSQ as MM
+import Data.Wrapper.PSQ         as PSQ
 import InterruptibleDelay
+import Network.Kademlia.Routing as R
+import Network.Kademlia.Search
 
 import Control.Concurrent.Lifted.Instrument
 import Control.Concurrent.STM
@@ -42,9 +44,9 @@ data ScheduledItem
     = forall r. ScheduledItem (AnnounceMethod r)
     | StopAnnouncer
     | NewAnnouncement (IO ()) (IO ()) POSIXTime
+    | SearchFinished (IO ()) (IO ()) POSIXTime
     | Announce (IO ()) POSIXTime
     | DeleteAnnouncement
-    | SearchFinished
 
 data Announcer = Announcer
     { scheduled       :: TVar (PSQ' AnnounceKey POSIXTime ScheduledItem)
@@ -62,22 +64,39 @@ stopAnnouncer announcer = do
     interruptDelay (interrutible announcer)
     atomically $ readTVar (announcerActive announcer) >>= check . not
 
-data AnnounceMethod r = forall nid ni addr r tok a. AnnounceMethod
+data AnnounceMethod r = forall nid ni addr tok a.
+                        ( Show nid
+                        , Hashable nid
+                        , Hashable ni
+                        , Ord addr
+                        , Ord nid
+                        , Ord ni
+                        ) => AnnounceMethod
     { aSearch  :: Search nid addr tok ni r
     , aPublish :: r -> tok -> Maybe ni -> IO (Maybe a)
+    , aBuckets :: TVar (R.BucketList ni)
+    , aTarget  :: nid
+    , aInterval :: POSIXTime
     }
 
 schedule :: Announcer -> AnnounceKey -> AnnounceMethod r -> r -> IO ()
-schedule announcer k AnnounceMethod{aSearch,aPublish} r = do
-    let announce = _todo :: IO ()     -- publish to current search results
-        onResult _ = return True
-        search   = _todo :: IO ()     -- thread to fork
-            -- ns <- R.kclosest (searchSpace qsearch) searchK nid <$> readTVar dhtBuckets
-            -- st <- newSearch qsearch nid ns
-            -- searchLoop :: Search nid addr tok ni r -> nid -> (r -> STM Bool) -> SearchState nid addr tok ni r -> IO ()
-            -- searchLoop aSearch nid onResult st
-        interval = _todo :: POSIXTime -- publish interval
-    atomically $ scheduleImmediately announcer k $ NewAnnouncement search announce interval
+schedule announcer k AnnounceMethod{aSearch,aPublish,aBuckets,aTarget,aInterval} r = do
+    st <- atomically $ newSearch aSearch aTarget []
+    let announce = do -- publish to current search results
+            is <- atomically $ do
+                bs <- readTVar (searchInformant st {- :: TVar (MinMaxPSQ' ni nid tok -})
+                return $ MM.toList bs
+            forM_ is $ \(Binding ni tok _) -> do
+            aPublish r tok (Just ni)
+            return ()
+        onResult _ = return True -- action for each search-hit (True = keep searching)
+        search  = do -- thread to fork
+            atomically $ reset aBuckets aSearch aTarget st
+            searchLoop aSearch aTarget onResult st
+            atomically $ scheduleImmediately announcer k
+                         $ SearchFinished {- st -} search announce aInterval
+            interruptDelay (interrutible announcer)
+    atomically $ scheduleImmediately announcer k $ NewAnnouncement search announce aInterval
     interruptDelay (interrutible announcer)
 
 cancel :: Announcer -> AnnounceKey -> AnnounceMethod r -> r -> IO ()
@@ -129,7 +148,6 @@ performScheduledItem announcer now = \case
         modifyTVar (scheduled announcer)
                    (PSQ.insert' k (Announce announce interval) (now + interval))
         return $ Just $ do
-            interruptDelay (interrutible announcer)
             fork search
             return ()
 
@@ -147,7 +165,7 @@ performScheduledItem announcer now = \case
     -- search finished:
     --   if any of the current storing-nodes set have not been
     --   announced to, announce to them.
-    (Binding _ SearchFinished _) -> return $ Just $ return ()
+    (Binding _ (SearchFinished {- st -} search announce interval) _) -> return $ Just $ return ()