Async search.

1 files changed, 16 insertions, 12 deletions

diff --git a/dht/Announcer/Tox.hs b/dht/Announcer/Tox.hs
index e2459e0e..00eb219b 100644
--- a/dht/Announcer/Tox.hs
+++ b/dht/Announcer/Tox.hs
@@ -27,22 +27,23 @@ import Data.Time.Clock.POSIX
 announceK :: Int
 announceK = 8
 
-data AnnounceState = forall nid addr tok ni r. AnnounceState
-    { aState        :: SearchState nid addr tok ni r
+data AnnounceState = forall nid addr tok ni r qk. AnnounceState
+    { aState        :: SearchState nid addr tok ni r qk
     , aStoringNodes :: TVar (MM.MinMaxPSQ ni (Down POSIXTime))
     }
 
 -- | This type specifies an item that can be announced on appropriate nodes in
 -- a Kademlia network.
-data AnnounceMethod r = forall nid ni sr addr tok a.
+data AnnounceMethod r = forall nid ni sr addr tok a qk.
                         ( Show nid
                         , Hashable nid
                         , Hashable ni
                         , Ord addr
                         , Ord nid
                         , Ord ni
+                        , Ord qk
                         ) => AnnounceMethod
-    { aSearch   :: Search nid addr tok ni sr
+    { aSearch   :: Search nid addr tok ni sr qk
                 -- ^ This is the Kademlia search to run repeatedly to find the
                 -- nearby nodes.  A new search is started whenever one is not
                 -- already in progress at announce time.  Repeated searches are
@@ -72,15 +73,16 @@ data AnnounceMethod r = forall nid ni sr addr tok a.
     }
 
 -- | This type specifies a Kademlia search and an action to perform upon the result.
-data SearchMethod r = forall nid ni sr addr tok a.
+data SearchMethod r = forall nid ni sr addr tok a qk.
                         ( Show nid
                         , Hashable nid
                         , Hashable ni
                         , Ord addr
                         , Ord nid
                         , Ord ni
+                        , Ord qk
                         ) => SearchMethod
-    { sSearch   :: Search nid addr tok ni sr
+    { sSearch   :: Search nid addr tok ni sr qk
                 -- ^ This is the Kademlia search to run repeatedly to find the
                 -- nearby nodes.  A new search is started whenever one is not
                 -- already in progress at announce time.  Repeated searches are
@@ -155,8 +157,6 @@ scheduleAnnounce  announcer k AnnounceMethod{aSearch,aPublish,aNearestNodes,aTar
             publishToNodes is
         onResult sr = return True
         searchAgain = do
-            -- Canceling a pending search here seems to make announcements more reliable.
-            searchCancel st
             return $ void $ do
                 t <- fork search
                 labelThread t ("scheduleAnnounce.sch." ++ show aTarget)
@@ -164,7 +164,10 @@ scheduleAnnounce  announcer k AnnounceMethod{aSearch,aPublish,aNearestNodes,aTar
             got <- tryTakeMVar mutex
             case got of
               Just () -> do
-                atomically $ reset aNearestNodes aSearch aTarget st
+                me <- myThreadId
+                labelThread me "scheduleAnnounce.reset"
+                reset aNearestNodes aSearch aTarget st
+                labelThread me "scheduleAnnounce.searchLoop"
                 searchLoop aSearch aTarget onResult st
                 -- Announce to any nodes we haven't already announced to.
                 is <- atomically $ do
@@ -202,8 +205,6 @@ scheduleSearch announcer k SearchMethod{sSearch,sWithResult,sNearestNodes,sTarge
                     return ()
                 return True -- True to keep searching.
         searchAgain = do
-            -- Canceling a pending search here seems to make announcements more reliable.
-            searchCancel st
             return $ void $ do
                 t <- fork search
                 labelThread t ("scheduleSearch.sch." ++ show sTarget)
@@ -211,7 +212,10 @@ scheduleSearch announcer k SearchMethod{sSearch,sWithResult,sNearestNodes,sTarge
             got <- tryTakeMVar mutex
             case got of
               Just () -> do
-                    atomically $ reset sNearestNodes sSearch sTarget st
+                    me <- myThreadId
+                    labelThread me "scheduleSearch.reset"
+                    reset sNearestNodes sSearch sTarget st
+                    labelThread me "scheduleSearch.searchLoop"
                     searchLoop sSearch sTarget onResult st
                     putMVar mutex ()
               Nothing -> do