From fd7327e8974aa6a79a6be07005223233d107dfb0 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Fri, 3 Nov 2017 23:23:47 -0400
Subject: Improved search parameters for tox onion routed queries.

---
 OnionRouter.hs                 |  8 +++++++-
 src/Network/Kademlia/Search.hs | 22 ++++++++++++++++------
 todo.txt                       |  4 ----
 3 files changed, 23 insertions(+), 11 deletions(-)

diff --git a/OnionRouter.hs b/OnionRouter.hs
index eb79b70b..757214cd 100644
--- a/OnionRouter.hs
+++ b/OnionRouter.hs
@@ -32,6 +32,7 @@ import qualified Data.Word64Map      as W64
 import Network.Socket
 import System.Endian
 import System.IO
+import System.Timeout
 
 -- Toxcore saves a maximum of 12 paths: 6 paths are reserved for announcing
 -- ourselves and 6 others are used to search for friends.
@@ -269,13 +270,18 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                         forkIO $ sendq asel aq (ts !! 0) >>= atomically . writeTVar av . Just
                         forkIO $ sendq bsel bq (ts !! 1) >>= atomically . writeTVar bv . Just
                         forkIO $ sendq csel cq (ts !! 2) >>= atomically . writeTVar cv . Just
-                        atomically $ do -- Wait for all 3 results.
+                        -- This timeout should be unnecessary... But I'm paranoid.
+                        -- Note: 10 seconds should be sufficient for typical get-nodes queries.
+                        tm <- timeout 20000000 $ atomically $ do -- Wait for all 3 results.
                             rs <- catMaybes <$> sequence [readTVar av,readTVar bv,readTVar cv]
                             case rs of [_,_,_] -> do
                                                     return $ catMaybes $ catMaybes rs
                                                     -- self <- IntMap.lookup (-1) <$> readTVar (trampolineNodes or)
                                                     -- return $ maybe (catMaybes rs) (\x -> [x,x,x]) self
                                        _       -> retry
+                        maybe (hPutStrLn stderr "ONION: Unexpected sendq timeout!" >> return [])
+                              return
+                              tm
                 return $ do
                     myThreadId >>= flip labelThread ("OnionRouter.sendqs")
                     nodes <- case ts of
diff --git a/src/Network/Kademlia/Search.hs b/src/Network/Kademlia/Search.hs
index 58c8fad8..593470c3 100644
--- a/src/Network/Kademlia/Search.hs
+++ b/src/Network/Kademlia/Search.hs
@@ -60,7 +60,7 @@ data SearchState nid addr tok ni r = SearchState
       searchPendingCount :: TVar Int
       -- | Nodes scheduled to be queried.
     , searchQueued       :: TVar (MinMaxPSQ ni nid)
-      -- | The nearest K nodes that issued a reply.
+      -- | The nearest (K - α) nodes that issued a reply.
     , searchInformant    :: TVar (MinMaxPSQ' ni nid (Maybe tok))
       -- | This tracks already-queried addresses so we avoid bothering them
       -- again. XXX: We could probably keep only the pending queries in this
@@ -121,8 +121,17 @@ reset bkts qsearch target st = do
 searchAlpha :: Int
 searchAlpha = 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
+-- need to ensure that closer non-responding queries don't completely push out
+-- farther away queries.
+--
+-- For BitTorrent, setting them both 8 was not an issue, but that is no longer
+-- supported because now the number of remembered informants is now the
+-- difference between these two numbers.  So, if searchK = 16 and searchAlpha =
+-- 4, then the number of remembered query responses is 12.
 searchK :: Int
-searchK = 8
+searchK = 16
 
 sendQuery :: forall addr nid tok ni r.
             ( Ord addr
@@ -158,9 +167,10 @@ sendQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> d) =
              | otherwise = MM.insertTake k n ( kademliaXor searchSpace searchTarget
                                                $ kademliaLocation searchSpace n )
                                                    q
-        qsize <- MM.size <$> readTVar searchQueued
+        qsize0 <- MM.size <$> readTVar searchQueued
+        let qsize = if qsize0 < searchK then searchK else qsize0
         modifyTVar searchQueued    $ \q -> foldr (insertFoundNode qsize) q ns
-        modifyTVar searchInformant $ MM.insertTake' searchK ni tok d
+        modifyTVar searchInformant $ MM.insertTake' (searchK - searchAlpha) ni tok d
         flip fix rs $ \loop -> \case
             r:rs' -> do
                 wanting <- searchResult r
@@ -178,7 +188,7 @@ searchIsFinished SearchState{ ..} = do
     informants <- readTVar searchInformant
     return $ cnt == 0
              && ( MM.null q
-                  || ( MM.size informants >= searchK
+                  || ( MM.size informants >= (searchK - searchAlpha)
                        && ( PSQ.prio (fromJust $ MM.findMax informants)
                             <= PSQ.prio (fromJust $ MM.findMin q))))
 
@@ -217,7 +227,7 @@ searchLoop sch@Search{..} target result s@SearchState{..} = do
                 Just (ni :-> d, q)
                   | -- If there's fewer than /k/ informants and there's any
                     -- node we haven't yet got a response from.
-                    (MM.size informants < searchK) && (cnt > 0 || not (MM.null q))
+                    (MM.size informants < searchK - searchAlpha) && (cnt > 0 || not (MM.null q))
                     -- Or there's no informants yet at all.
                     || MM.null informants
                     -- Or if the closest scheduled node is nearer than the
diff --git a/todo.txt b/todo.txt
index 4ec76376..6019b08a 100644
--- a/todo.txt
+++ b/todo.txt
@@ -1,7 +1,3 @@
-kademlia: Search is not working as well as expected.  Fast informants are
-          probably pushing out closer but slow informants for longer-timeout
-          queries like tox onion-routed queries.
-
 ui: Online help.
 
 ui: Explicit routing table node deletion. "forget" command.
-- 
cgit v1.2.3