1 files changed, 45 insertions, 1 deletions

diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index edbbbb49..f44dd79c 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -218,7 +218,7 @@ toxidSearch :: (TransactionId -> OnionDestination r -> STM (OnionDestination r,
 toxidSearch getTimeout crypto client = Search
     { searchSpace       = toxSpace
     , searchNodeAddress = nodeIP &&& nodePort
-    , searchQuery       = Left $ getRendezvous getTimeout crypto client
+    , searchQuery       = Right $ asyncGetRendezvous getTimeout crypto client
     , searchAlpha = 3
     , searchK     = 6
     }
@@ -290,6 +290,30 @@ sendOnion getTimeout client req oaddr unwrap =
           (return . Just . unwrap (onionNodeInfo oaddr))
           $ join mb
 
+asyncOnion :: (TransactionId
+                     -> OnionDestination r -> STM (OnionDestination r, Int))
+                    -> QR.Client
+                         err
+                         PacketKind
+                         TransactionId
+                         (OnionDestination r)
+                         (OnionMessage Identity)
+                    -> AnnounceRequest
+                    -> OnionDestination r
+                    -> (NodeInfo -> AnnounceResponse -> a)
+                    -> (Maybe a -> IO ())
+                    -> IO ()
+asyncOnion getTimeout client req oaddr unwrap go =
+    -- Four tries and then we tap out.
+    flip fix 4 $ \loop n -> do
+    QR.asyncQuery client (announceSerializer getTimeout) req oaddr
+        $ \mb -> do
+            forM_ mb $ \r -> dput XAnnounce $ show (onionNodeInfo oaddr) ++ " sent response: " ++ show r
+            maybe (if n>0 then loop $! n - 1 else go Nothing)
+                  (go . Just . unwrap (onionNodeInfo oaddr))
+                  $ join mb
+
+
 -- | Lookup the secret counterpart for a given alias key.
 getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
             -> TransportCrypto
@@ -308,6 +332,26 @@ getRendezvous getTimeout crypto client nid ni = do
         oaddr
         (unwrapAnnounceResponse rkey)
 
+asyncGetRendezvous
+    :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
+       -> TransportCrypto
+       -> Client r
+       -> NodeId
+       -> NodeInfo
+       -> (Maybe ([NodeInfo], [Rendezvous], Maybe Nonce32) -> IO ())
+       -> IO ()
+asyncGetRendezvous getTimeout crypto client nid ni go = 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)
+        go
+
 putRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
                -> TransportCrypto
                -> Client r