1 files changed, 11 insertions, 5 deletions

diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index 6b057af9..3078831d 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -811,8 +811,14 @@ clientSession s@Session{..} sock cnum h = do
                               where
                                 go | null destination = fmap Right . qhandler self
                                    | otherwise        = case readEither destination of
-                                        Right ni -> fmap (maybe (Left "Timeout.") Right . resultToMaybe)
-                                                    . flip (searchQuery qsearch) ni -- TODO report canceled
+                                        Right ni -> \nid -> do
+                                            v <- newEmptyMVar
+                                            _ <- searchQuery qsearch nid ni $ \_ r -> putMVar v r
+                                            r <- takeMVar v
+                                            return $ case r of
+                                                Success x -> Right x
+                                                Canceled  -> Left "Canceled."
+                                                TimedOut  -> Left "Timeout."
                                         Left  e  -> const $ return $ Left ("Bad destination: "++e)
                         maybe (hPutClient h ("Unsupported method: "++method))
                               goQuery
@@ -938,14 +944,14 @@ clientSession s@Session{..} sock cnum h = do
                                 , Typeable ptok
                                 , Typeable sni
                                 , Typeable pni )
-                                            => Search nid addr stok sni sr
+                                            => Search nid addr stok sni sr qk
                                             -> (pr -> ptok -> Maybe pni -> IO (Maybe pubr))
                                             -> Maybe (stok :~: ptok, sni :~: pni)
                             matchingResult _ _ = liftA2 (,) eqT eqT
                             matchingResult2 ::
                                 ( Typeable sr
                                 , Typeable pr )
-                                            => Search nid addr stok sni sr
+                                            => Search nid addr stok sni sr qk
                                             -> (PublicKey -> pdta -> pr -> IO ())
                                             -> (pdta -> nid)
                                             -> Maybe (pr :~: sr)
@@ -1913,7 +1919,7 @@ main = do
         btSaved <- loadNodes netname --  :: IO [Mainline.NodeInfo]
         putStrLn $ "Loaded "++show (length btSaved)++" nodes for "++netname++"."
         fallbackNodes <- getBootstrapNodes
-        let isNodesSearch :: ni :~: r -> Search nid addr tok ni r -> Search nid addr tok ni ni
+        let isNodesSearch :: ni :~: r -> Search nid addr tok ni r qk -> Search nid addr tok ni ni qk
             isNodesSearch Refl sch = sch
             ping = maybe (const $ return False)
                          (\DHTPing{pingQuery} -> fmap (maybe False (const True)) . pingQuery [])