1 files changed, 45 insertions, 4 deletions

diff --git a/dht/src/Network/Tox/Onion/Handlers.hs b/dht/src/Network/Tox/Onion/Handlers.hs
index 015c758c..45795312 100644
--- a/dht/src/Network/Tox/Onion/Handlers.hs
+++ b/dht/src/Network/Tox/Onion/Handlers.hs
@@ -218,13 +218,14 @@ handlers net _ _ keydb _ = Just $ NoReply Right $ dataToRouteH keydb net
 toxidSearch :: (OnionDestination r -> STM (OnionDestination r, Int))
                -> TransportCrypto
                -> Client r
-               -> Search NodeId (IP, PortNumber) Nonce32 NodeInfo Rendezvous
+               -> Search NodeId (IP, PortNumber) Nonce32 NodeInfo Rendezvous TransactionId
 toxidSearch getTimeout crypto client = Search
     { searchSpace       = toxSpace
     , searchNodeAddress = nodeIP &&& nodePort
-    , searchQuery       = getRendezvous getTimeout crypto client
-    , searchAlpha = 3
-    , searchK     = 6
+    , searchQuery       = asyncGetRendezvous getTimeout crypto client
+    , searchQueryCancel = cancelQuery client
+    , searchAlpha       = 3
+    , searchK           = 6
     }
 
 announceSerializer :: (OnionDestination r -> STM (OnionDestination r, Int))
@@ -289,6 +290,25 @@ sendOnion getTimeout client req oaddr unwrap =
             Canceled  -> return Canceled
             TimedOut  -> re
 
+asyncOnion :: (OnionDestination r -> STM (OnionDestination r, Int))
+            -> Client r
+            -> AnnounceRequest
+            -> OnionDestination r
+            -> (NodeInfo -> AnnounceResponse -> t)
+            -> (TransactionId -> QR.Result t -> IO ())
+            -> IO TransactionId
+asyncOnion getTimeout client req oaddr unwrap withResult = do
+    -- TODO: Restore "Four tries and then we tap out" behavior.
+    qid <- QR.asyncQuery client (announceSerializer getTimeout) req oaddr $ \k mb -> do
+            forM_ mb $ \r -> dput XAnnounce $ show (onionNodeInfo oaddr) ++ " async sent response: " ++ show r
+            withResult k $ case mb of
+                Success x -> maybe (TimedOut)
+                                   (Success . unwrap (onionNodeInfo oaddr))
+                                   (x :: Maybe AnnounceResponse)
+                Canceled  -> Canceled
+                TimedOut  -> TimedOut
+    return qid
+
 
 -- | Lookup the secret counterpart for a given alias key.
 getRendezvous :: (OnionDestination r -> STM (OnionDestination r, Int))
@@ -308,6 +328,27 @@ getRendezvous getTimeout crypto client nid ni = do
         oaddr
         (unwrapAnnounceResponse rkey)
 
+asyncGetRendezvous ::
+            (OnionDestination r -> STM (OnionDestination r, Int))
+            -> TransportCrypto
+            -> Client r
+            -> NodeId
+            -> NodeInfo
+            -> (TransactionId -> Result ([NodeInfo],[Rendezvous],Maybe Nonce32) -> IO ())
+            -> IO TransactionId
+asyncGetRendezvous getTimeout crypto client nid ni withResult = do
+    asel <- atomically $ selectAlias crypto nid
+    let oaddr = OnionDestination asel ni Nothing
+        rkey  = case asel of
+                    SearchingAlias -> Nothing
+                    _              -> Just $ key2id $ rendezvousPublic crypto
+    asyncOnion getTimeout client
+        (AnnounceRequest zeros32 nid $ fromMaybe zeroID rkey)
+        oaddr
+        (unwrapAnnounceResponse rkey)
+        withResult
+
+
 putRendezvous :: (OnionDestination r -> STM (OnionDestination r, Int))
                -> TransportCrypto
                -> Client r