Reverted 6ebe91b6: abandoning the async search design for now.

6 files changed, 19 insertions, 35 deletions

diff --git a/dht/TCPProber.hs b/dht/TCPProber.hs
index d58b8b60..faf8b35c 100644
--- a/dht/TCPProber.hs
+++ b/dht/TCPProber.hs
@@ -177,7 +177,7 @@ nodeSearch :: TCPProber -> TCP.TCPClient err Nonce8 -> Search NodeId (IP, PortNu
 nodeSearch prober tcp = Search
     { searchSpace       = TCP.tcpSpace
     , searchNodeAddress = TCP.nodeIP &&& TCP.tcpPort
-    , searchQuery       = Left $ getNodes prober tcp
+    , searchQuery       = getNodes prober tcp
     , searchAlpha       = 8
     , searchK           = 16
     }
diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index 71be24eb..ef3f6bd4 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -355,13 +355,6 @@ showPolicy TryingToConnect   = "*"
 showPolicy OpenToConnect     = "o"
 showPolicy RefusingToConnect = "x"
 
-waitOn :: (nid -> ni -> (result -> IO ()) -> IO ())
-             -> nid -> ni -> IO result
-waitOn bg nid ni = do
-    mvar <- newEmptyMVar
-    bg nid ni $ putMVar mvar
-    takeMVar mvar
-
 getSessions :: TVar (Map.Map Uniq24 AggregateSession) -> Uniq24 -> STM [Tox.Session]
 getSessions ssvar u24 = do
     agmap <- readTVar ssvar
@@ -788,7 +781,7 @@ clientSession s@Session{..} sock cnum h = do
                                 go | null destination = fmap Right . qhandler self
                                    | otherwise        = case readEither destination of
                                         Right ni -> fmap (maybe (Left "Timeout.") Right)
-                                                    . flip (either id waitOn $ searchQuery qsearch) ni
+                                                    . flip (searchQuery qsearch) ni
                                         Left  e  -> const $ return $ Left ("Bad destination: "++e)
                         maybe (hPutClient h ("Unsupported method: "++method))
                               goQuery
diff --git a/dht/src/Network/BitTorrent/MainlineDHT.hs b/dht/src/Network/BitTorrent/MainlineDHT.hs
index 0269268f..bb556bc6 100644
--- a/dht/src/Network/BitTorrent/MainlineDHT.hs
+++ b/dht/src/Network/BitTorrent/MainlineDHT.hs
@@ -1082,7 +1082,7 @@ mainlineSearch :: (NodeId -> NodeInfo -> IO (Maybe ([NodeInfo], [r], Maybe tok))
 mainlineSearch qry = Search
     { searchSpace       = mainlineSpace
     , searchNodeAddress = nodeIP &&& nodePort
-    , searchQuery       = Left qry
+    , searchQuery       = qry
     , searchAlpha       = 8
     , searchK           = 16
     }
diff --git a/dht/src/Network/Tox/DHT/Handlers.hs b/dht/src/Network/Tox/DHT/Handlers.hs
index 73bc2229..7806da78 100644
--- a/dht/src/Network/Tox/DHT/Handlers.hs
+++ b/dht/src/Network/Tox/DHT/Handlers.hs
@@ -198,7 +198,7 @@ newRouting addr crypto update4 update6 = do
             nullSearch = Search
                 { searchSpace       = toxSpace
                 , searchNodeAddress = nodeIP &&& nodePort
-                , searchQuery       = Left $ \_ _ -> return Nothing
+                , searchQuery       = \_ _ -> return Nothing
                 , searchAlpha       = 1
                 , searchK           = 2
                 }
@@ -541,9 +541,7 @@ nodeSearch :: Client -> TVar (HashMap NodeId [NodeInfoCallback]) -> Search NodeI
 nodeSearch client cbvar = Search
     { searchSpace       = toxSpace
     , searchNodeAddress = nodeIP &&& nodePort
-    -- searchQuery :: Either (nid -> ni -> IO (Maybe ([ni], [r], Maybe tok)))
-    --                       (nid -> ni -> (Maybe ([ni],[r],Maybe tok) -> IO ()) -> IO ())
-    , searchQuery       = Left $ getNodesUDP client cbvar
+    , searchQuery       = getNodesUDP client cbvar
     , searchAlpha       = 8
     , searchK           = 16
     }
diff --git a/dht/src/Network/Tox/Onion/Handlers.hs b/dht/src/Network/Tox/Onion/Handlers.hs
index 7951e707..65ec846c 100644
--- a/dht/src/Network/Tox/Onion/Handlers.hs
+++ b/dht/src/Network/Tox/Onion/Handlers.hs
@@ -222,7 +222,7 @@ toxidSearch :: (OnionDestination r -> STM (OnionDestination r, Int))
 toxidSearch getTimeout crypto client = Search
     { searchSpace       = toxSpace
     , searchNodeAddress = nodeIP &&& nodePort
-    , searchQuery       = Left $ getRendezvous getTimeout crypto client
+    , searchQuery       = getRendezvous getTimeout crypto client
     , searchAlpha = 3
     , searchK     = 6
     }
diff --git a/kad/src/Network/Kademlia/Search.hs b/kad/src/Network/Kademlia/Search.hs
index 16786d1c..5b60c303 100644
--- a/kad/src/Network/Kademlia/Search.hs
+++ b/kad/src/Network/Kademlia/Search.hs
@@ -40,8 +40,7 @@ import GHC.Conc                  (labelThread)
 data Search nid addr tok ni r = Search
     { searchSpace        :: KademliaSpace nid ni
     , searchNodeAddress  :: ni -> addr
-    , searchQuery        :: Either (nid -> ni -> IO (Maybe ([ni], [r], Maybe tok)))
-                                   (nid -> ni -> (Maybe ([ni],[r],Maybe tok) -> IO ()) -> IO ())
+    , searchQuery        :: nid -> ni -> IO (Maybe ([ni], [r], Maybe tok))
     , searchAlpha        :: Int -- α = 8
       -- | 'searchK' should be larger than 'searchAlpha'.  How much larger depends on
       -- how fast the queries are.  For Tox's much slower onion-routed queries, we
@@ -122,7 +121,7 @@ reset nearestNodes qsearch target st = do
     writeTVar (searchPendingCount st) 0
     return st
 
-sendAsyncQuery :: forall addr nid tok ni r.
+sendQuery :: forall addr nid tok ni r.
             ( Ord addr
             , PSQKey nid
             , PSQKey ni
@@ -133,23 +132,15 @@ sendAsyncQuery :: forall addr nid tok ni r.
             -> (r -> STM Bool) -- ^ return False to terminate the search.
             -> SearchState nid addr tok ni r
             -> Binding ni nid
-            -> TaskGroup
             -> IO ()
-sendAsyncQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> d) g =
-    case searchQuery of
-        Left blockingQuery ->
-          forkTask g "searchQuery" $ do
-            -- forkTask will label the thread.
-            -- -- myThreadId >>= flip labelThread ("searchQuery." ++ show searchTarget)
-            reply <- blockingQuery searchTarget ni `catchIOError` const (return Nothing)
-            atomically $ do
-                modifyTVar searchPendingCount pred
-                maybe (return ()) go reply
-        Right nonblockingQuery -> do
-            nonblockingQuery searchTarget ni $ \reply ->
-                atomically $ do
-                    modifyTVar searchPendingCount pred
-                    maybe (return ()) go reply
+sendQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> d) = do
+    myThreadId >>= flip labelThread ("searchQuery." ++ show searchTarget)
+    reply <- searchQuery searchTarget ni `catchIOError` const (return Nothing)
+    -- (ns,rs)
+    let tok = error "TODO: token"
+    atomically $ do
+        modifyTVar searchPendingCount pred
+        maybe (return ()) go reply
  where
     go (ns,rs,tok) = do
         vs <- readTVar searchVisited
@@ -239,7 +230,9 @@ searchLoop sch@Search{..} target result s@SearchState{..} = do
                         modifyTVar searchVisited $ Set.insert (searchNodeAddress ni)
                         modifyTVar searchPendingCount succ
                         return $ do
-                            sendAsyncQuery sch target result s (ni :-> d) g
+                            forkTask g
+                                     "searchQuery"
+                                     $ sendQuery sch target result s (ni :-> d)
                             again
                 _ -> -- Otherwise, we are finished.
                      do check (cnt == 0)