14 files changed, 136 insertions, 94 deletions

diff --git a/OnionRouter.hs b/OnionRouter.hs
index ddccb531..96381e7f 100644
--- a/OnionRouter.hs
+++ b/OnionRouter.hs
@@ -113,13 +113,13 @@ data RouteRecord = RouteRecord
 -- they are deemed non working. This is because, due to network conditions,
 -- there may be a large number of newly created paths that do not work and so
 -- trying them a lot would make finding a working path take much longer. The
--- timeout for a confirmed path (from which a response was received) is 10
+-- timeout for a confirmed path (from which a response was received) is 12
 -- seconds with 4 tries without a response. A confirmed path has a maximum
 -- lifetime of 1200 seconds to make possible deanonimization attacks more
 -- difficult.
 timeoutForRoute :: RouteRecord -> Int
 timeoutForRoute RouteRecord{ responseCount = 0 } = 4000000
-timeoutForRoute RouteRecord{ responseCount = _ } = 10000000
+timeoutForRoute RouteRecord{ responseCount = _ } = 12000000
 
 freshRoute :: POSIXTime -> OnionRoute -> Maybe RouteRecord -> Maybe RouteRecord
 freshRoute birthday r mrec = Just $ RouteRecord
@@ -157,18 +157,31 @@ newOnionRouter :: TransportCrypto
                                                      (MVar (OnionMessage Identity)))))
 newOnionRouter crypto perror = do
     drg0 <- drgNew
-    (rlog,pq) <- atomically $ (,) <$> newTChan <*> newTVar W64.empty
+    (rlog,pq,rm) <- atomically $ do
+        rlog <- newTChan
+        pq <- newTVar W64.empty
+        rm <- newArray (0,11) Nothing
+        return (rlog,pq,rm)
     ((tbl,tcptbl),tcp) <- do
         (tcptbl, client) <- TCP.newClient crypto Left $ \case
             Left v  -> void . tryPutMVar v
             Right v -> \case
                 TCP.OnionPacketResponse x@(OnionAnnounceResponse n8 n24 _) -> do
                     mod <- lookupSender' pq rlog localhost4 n8
+                    perror $ "TCP announce response from " ++ show mod
                     forM_ mod $ \od -> do
                         Onion.decrypt crypto x od >>= \case
-                            Right (y,_) -> void $ tryPutMVar v y
+                            Right (y,_) -> do perror $ "decrypted announce response, sending " ++ show y
+                                              let
+                                                RouteId rid = fromMaybe (routeId (nodeId (onionNodeInfo od)))
+                                                                $ onionRouteSpec od
+                                                Nonce8 w8 = n8
+                                              atomically $ do
+                                                modifyTVar' pq (W64.delete w8)
+                                                modifyArray rm (fmap gotResponse) rid
+                                              void $ tryPutMVar v y
                             _           -> return ()
-                _ -> return ()
+                x -> perror $ "Unexpected TCP query result: " ++ show x
 
         let addr = SockAddrInet 0 0
             tentative_udp = NodeInfo
@@ -185,13 +198,15 @@ newOnionRouter crypto perror = do
         return $ (,) (tbl,tcptbl) TCP.TCPClient
             { tcpCrypto     = crypto
             , tcpClient     = client
-            , tcpGetGateway = selectGateway tbl
+            , tcpGetGateway = \ni -> do
+                gw <- selectGateway tbl ni
+                writeTChan rlog $ unwords ["Selected TCP Gateway:",show ni,"via",show gw]
+                return gw
             }
     or <- atomically $ do
         -- chan <- newTChan
         drg <- newTVar drg0
         -- forM_ [0..11] $ \n -> writeTChan chan $ BuildRoute (RouteId n)
-        rm <- newArray (0,11) Nothing
         tn <- newTVar IntMap.empty
         ti <- newTVar HashMap.empty
         tc <- newTVar 0
@@ -204,7 +219,7 @@ newOnionRouter crypto perror = do
                             tbl
                             (TCP.nodeSearch prober tcp)
                             (fmap (maybe False $ const True) . TCP.tcpPing (TCP.tcpClient tcp))
-        tcpmode <- newTVar False
+        tcpmode <- newTVar True
         let o = OnionRouter
                 { pendingRoutes  = pr
                 , onionDRG       = drg
@@ -360,9 +375,9 @@ selectTrampolines or = do
                 ( "ONION Discarding insecure trampolines:" : (either (map show) (map show) ns))
             myThreadId >>= flip labelThread ("OnionRouter.selectTrampolines.sleep")
             case ns of
-                Left  [_,_,_] -> threadDelay 1000000 -- wait 1 second if we failed the distinct3by predicate.
-                Right [_,_,_] -> threadDelay 1000000 -- wait 1 second if we failed the distinct3by predicate.
-                _       -> threadDelay 5000000 -- wait 5 seconds if insufficient nodes.
+                Left  [_,_,_] -> threadDelay 1000000 -- (tcp) wait 1 second if we failed the distinct3by predicate.
+                Right [_,_,_] -> threadDelay 1000000 -- (udp) wait 1 second if we failed the distinct3by predicate.
+                _             -> threadDelay 5000000 -- wait 5 seconds if insufficient nodes.
             myThreadId >>= flip labelThread ("OnionRouter.selectTrampolines")
             selectTrampolines or
         Right ns -> do
@@ -443,11 +458,14 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                 let asel = sel .&. 0x3
                     bsel = shiftR sel 2 .&. 0x3
                     csel = shiftR sel 4 .&. 0x3
+                    cycle' [] = []
+                    cycle' ns = cycle ns
+                    sendq :: Word8 -> NodeId -> Int -> IO (Maybe NodeInfo)
                     sendq s q ni
-                        | Right ts <- mts = fmap (listToMaybe . drop (fromIntegral s)) <$> getnodes q (ts !! ni)
+                        | Right ts <- mts = (>>= (listToMaybe . drop (fromIntegral s) . cycle')) <$> getnodes q (ts !! ni)
                         | Left  ts <- mts = case ni of
-                            0 -> return $ Just $ Just $ TCP.udpNodeInfo (ts !! 0)
-                            n -> fmap (listToMaybe . drop (fromIntegral s) . (\(ns,_,_)->ns))
+                            0 -> return $ Just $ TCP.udpNodeInfo (ts !! 0)
+                            n -> (>>= (listToMaybe . drop (fromIntegral s) . (\(ns,_,_)->cycle' ns)))
                                    <$> TCP.getUDPNodes (tcpKademliaClient or) q (TCP.udpNodeInfo $ ts !! n)
                     sendqs = do
                         forkIO $ sendq asel aq 0 >>= atomically . writeTVar av . Just
@@ -458,7 +476,7 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                         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
+                                                    return $ catMaybes $ rs
                                                     -- self <- IntMap.lookup (-1) <$> readTVar (trampolineNodes or)
                                                     -- return $ maybe (catMaybes rs) (\x -> [x,x,x]) self
                                        _       -> retry
@@ -629,7 +647,7 @@ hookBucketList :: Show ni =>
                         -> RoutingTransition ni
                         -> STM ()
 hookBucketList kademlia bkts0 or TrampolineSet{..} (RoutingTransition ni Accepted) = do
-    s <- do
+    (s,antibias) <- do
         drg0 <- readTVar (onionDRG or)
         bkts <- readTVar bkts0
         let antibias = 2 ^ bucketNumber kademlia (kademliaLocation kademlia ni) bkts
@@ -641,7 +659,7 @@ hookBucketList kademlia bkts0 or TrampolineSet{..} (RoutingTransition ni Accepte
            let self = (thisNode bkts) { nodeIP = read "127.0.0.1" }
            modifyTVar' setNodes (IntMap.insert (-1) self)
         -}
-        return s
+        return (s::Int,antibias)
     -- debias via stochastic filter
     when (s == 0) $ do
     ns <- readTVar setIDs -- (trampolineIds or)
@@ -649,7 +667,7 @@ hookBucketList kademlia bkts0 or TrampolineSet{..} (RoutingTransition ni Accepte
         Just _ -> return ()
         Nothing -> do
             cnt <- readTVar setCount
-            writeTChan (routeLog or) $ "ONION trampoline Accepted " ++ unwords [show cnt, show ni]
+            writeTChan (routeLog or) $ "ONION trampoline Accepted " ++ unwords ["s="++show (s,antibias),show cnt, show ni]
             modifyTVar' setIDs (HashMap.insert (kademliaLocation kademlia ni) cnt)
             modifyTVar' setNodes (IntMap.insert cnt ni)
             writeTVar setCount (succ cnt)
@@ -679,7 +697,7 @@ ipkey :: IPClass -> Int
 ipkey (IPClass k) = fromIntegral k
 
 nodeClass :: NodeInfo -> IPClass
-nodeClass = ipClass. nodeAddr
+nodeClass = ipClass . nodeAddr
 
 ipClass :: SockAddr -> IPClass
 ipClass= either ipClass' ipClass' . either4or6
diff --git a/Presence/Chat.hs b/Presence/Chat.hs
index b7343b5a..883f40ea 100644
--- a/Presence/Chat.hs
+++ b/Presence/Chat.hs
@@ -46,6 +46,8 @@ data MembershipEffect = MembershipEffect { fromMembership :: Membership
                       | InvalidMembershipEffect
  deriving (Eq,Ord,Read,Show)
 
+instance Semigroup MembershipEffect
+
 instance Monoid MembershipEffect where
     mempty = NoMembershipEffect
     MembershipEffect a x `mappend` MembershipEffect y b
diff --git a/TCPProber.hs b/TCPProber.hs
index 8059fea7..db6d0217 100644
--- a/TCPProber.hs
+++ b/TCPProber.hs
@@ -167,4 +167,6 @@ nodeSearch prober tcp = Search
     { searchSpace       = TCP.tcpSpace
     , searchNodeAddress = TCP.nodeIP &&& TCP.tcpPort
     , searchQuery       = getNodes prober tcp
+    , searchAlpha       = 8
+    , searchK           = 16
     }
diff --git a/ToxManager.hs b/ToxManager.hs
index 01403d9d..dceb9210 100644
--- a/ToxManager.hs
+++ b/ToxManager.hs
@@ -115,8 +115,8 @@ toxman ssvar announcer toxbkts tox presence = ToxManager
             if not (Map.null rs)
                 then return (acnt,Nothing)
                 else return (acnt,Just $ \nid -> foldr interweave []
-                                                 . map (R.kclosest (searchSpace (toxQSearch tox))
-                                                                   searchK
+                                                 . map (R.kclosest (searchSpace $ toxQSearch tox)
+                                                                   (searchK $ toxQSearch tox)
                                                                    nid)
                                                  <$> mapM (readTVar . snd) toxbkts)
 
@@ -575,7 +575,7 @@ nearNodes tox nid = do
   bkts6 <- readTVar $ routing6 $ toxRouting tox
   let nss =
         map
-          (R.kclosest (searchSpace (toxQSearch tox)) searchK nid)
+          (R.kclosest (searchSpace $ toxQSearch tox) (searchK $ toxQSearch tox) nid)
           [bkts4, bkts6]
   return $ foldr interweave [] nss
 
@@ -591,7 +591,7 @@ startConnecting0 tx them contact reason = do
         let nearNodes nid = do
                 bkts4 <- readTVar $ routing4 $ toxRouting tox
                 bkts6 <- readTVar $ routing6 $ toxRouting tox
-                let nss = map (R.kclosest (searchSpace (toxQSearch tox)) searchK nid)
+                let nss = map (R.kclosest (searchSpace $ toxQSearch tox) (searchK $ toxQSearch tox) nid)
                               [bkts4,bkts6]
                 return $ foldr interweave [] nss
         wanted <- atomically $ (==Just TryingToConnect) <$> readTVar (contactPolicy contact)
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index d014a611..96cfbe0e 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -264,7 +264,7 @@ forkSearch ::
     -> TVar (Maybe (IO ()))
     -> STM ()
 forkSearch method nid DHTQuery{qsearch,qshowTok,qshowR} dhtSearches dhtBuckets  tid kvar = do
-    ns <- R.kclosest (searchSpace qsearch) searchK nid <$> readTVar dhtBuckets
+    ns <- R.kclosest (searchSpace qsearch) (searchK qsearch) nid <$> readTVar dhtBuckets
     st <- newSearch qsearch nid ns
     results <- newTVar Set.empty
     let storeResult r = modifyTVar' results (Set.insert (qshowR r))
@@ -674,7 +674,8 @@ clientSession s@Session{..} sock cnum h = do
                 hPutClient h $ "Showing " ++ show tag ++ " messages."
 
 
-        ("onion", s) -> cmd0 $ do
+        ("onion", s) | "" <- strp $ map toLower s
+                      -> cmd0 $ do
             now <- getPOSIXTime
             join $ atomically $ do
             rm <- IntMap.fromList . catMaybes . map (\(i,m) -> fmap (i,) m) <$> getAssocs (routeMap onionRouter)
@@ -690,10 +691,14 @@ clientSession s@Session{..} sock cnum h = do
             tcp_spill <- readTVar (TCP.probeSpill $ tcpProber onionRouter)
             tcp_cache <- readTVar (TCP.probeCache $ tcpProber onionRouter)
             tcp_queue <- readTVar (TCP.probeQueue $ tcpProber onionRouter)
+            tcpmode <- readTVar (tcpMode onionRouter)
             let showRecord :: Int -> Int -> [String]
                 showRecord n wanted_ver
-                    | Just RouteRecord{responseCount,timeoutCount,routeVersion,routeBirthTime} <- IntMap.lookup n rm
-                                = [ show n, show responseCount, show timeoutCount, show (now-routeBirthTime)
+                    | Just RouteRecord{responseCount,timeoutCount,routeVersion,routeBirthTime
+                                      ,storedRoute=Tox.OnionRoute{routeRelayPort}} <- IntMap.lookup n rm
+                                = [ show n, show responseCount, show timeoutCount
+                                  , maybe "" show routeRelayPort
+                                  , show (now - routeBirthTime)
                                   , if routeVersion >= wanted_ver
                                      then show routeVersion
                                      else show routeVersion ++ "(pending)" ]
@@ -701,11 +706,23 @@ clientSession s@Session{..} sock cnum h = do
                 r = map (uncurry showRecord) rs
             return $ do
                 hPutClientChunk h $ unlines [ "trampolines(UDP): " ++ show (IntMap.size ts,tcnt,icnt)
+                                                                   ++ if tcpmode then "" else " *"
                                             , "trampolines(TCP): " ++ show (IntMap.size tts,ttcnt,ticnt)
+                                                                   ++ if tcpmode then " *" else ""
                                             , "pending: " ++ show (W64.size pqs)
                                             , "TCP spill,cache,queue: "
                                                 ++ show (PSQ.size tcp_spill, PSQ.size tcp_cache, PSQ.size tcp_queue)]
-                hPutClient h $ showColumns $ ["","responses","timeouts", "age", "version"]:r
+                hPutClient h $ showColumns $ ["","responses","timeouts", "tcp", "age", "version"]:r
+
+        ("onion", s) | "udp" <- strp $ map toLower s
+                     -> cmd0 $ do
+            atomically $ writeTVar (tcpMode onionRouter) False
+            hPutClient h "Onion routes: UDP."
+
+        ("onion", s) | "tcp" <- strp $ map toLower s
+                     -> cmd0 $ do
+            atomically $ writeTVar (tcpMode onionRouter) True
+            hPutClient h "Onion routes: TCP."
 
         ("g", s) | Just DHT{..} <- Map.lookup netname dhts
                     -> cmd0 $ do
@@ -884,7 +901,7 @@ clientSession s@Session{..} sock cnum h = do
                                             akey
                                             (AnnounceMethod qsearch asend
                                                             (\nid -> R.kclosest (searchSpace qsearch)
-                                                                                searchK
+                                                                                (searchK qsearch)
                                                                                 nid
                                                                      <$> readTVar dhtBuckets)
                                                             (announceTarget dta)
@@ -910,7 +927,7 @@ clientSession s@Session{..} sock cnum h = do
                                             akey
                                             (SearchMethod qsearch (asend pub)
                                                             (\nid -> R.kclosest (searchSpace qsearch)
-                                                                                searchK
+                                                                                (searchK qsearch)
                                                                                 nid
                                                                      <$> readTVar dhtBuckets)
                                                             (announceTarget dta)
@@ -1514,7 +1531,9 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
                     , dhtQuery = Map.singleton "node" DHTQuery
                                     { qsearch = TCP.nodeSearch tcpprober tcpclient
                                     , qhandler = \ni nid -> do
-                                        ns <- R.kclosest (searchSpace $ TCP.nodeSearch tcpprober tcpclient) searchK nid
+                                        ns <- R.kclosest (searchSpace $ TCP.nodeSearch tcpprober tcpclient)
+                                                         (searchK $ TCP.nodeSearch tcpprober tcpclient)
+                                                         nid
                                                 <$> atomically (readTVar $ refreshBuckets tcpRefresher)
                                         return (ns,ns,Just ())
                                     , qshowR = show -- TCP.NodeInfo
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index 69461488..32c709be 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -42,7 +42,7 @@ module Data.Torrent
        , FileOffset
        , FileSize
        , FileInfo (..)
-#ifdef VERSION_lens
+#ifdef USE_lens
        , fileLength
        , filePath
        , fileMD5Sum
@@ -50,7 +50,7 @@ module Data.Torrent
 
          -- ** Layout info
        , LayoutInfo (..)
-#ifdef VERSION_lens
+#ifdef USE_lens
        , singleFile
        , multiFile
        , rootDirName
@@ -90,7 +90,7 @@ module Data.Torrent
          -- ** Piece control
        , HashList (..)
        , PieceInfo (..)
-#ifdef VERSION_lens
+#ifdef USE_lens
        , pieceLength
        , pieceHashes
 #endif
@@ -102,7 +102,7 @@ module Data.Torrent
 
          -- * Info dictionary
        , InfoDict (..)
-#ifdef VERSION_lens
+#ifdef USE_lens
        , infohash
        , layoutInfo
        , pieceInfo
@@ -115,7 +115,7 @@ module Data.Torrent
          -- * Torrent file
        , Torrent(..)
 
-#ifdef VERSION_lens
+#ifdef USE_lens
          -- ** Lenses
        , announce
        , announceList
@@ -378,7 +378,7 @@ data FileInfo a = FileInfo {
                , Functor, Foldable
                )
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 makeLensesFor
   [ ("fiLength", "fileLength")
   , ("fiMD5Sum", "fileMD5Sum")
@@ -467,7 +467,7 @@ data LayoutInfo
     , liDirName  :: !BS.ByteString
     } deriving (Show, Read, Eq, Typeable)
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 makeLensesFor
   [ ("liFile"   , "singleFile" )
   , ("liFiles"  , "multiFile"  )
@@ -695,7 +695,7 @@ data PieceInfo = PieceInfo
     -- ^ Concatenation of all 20-byte SHA1 hash values.
   } deriving (Show, Read, Eq, Typeable)
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 -- | Number of bytes in each piece.
 makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo
 
@@ -902,7 +902,7 @@ data Torrent = Torrent
     --   encrypted SHA-1 hash of the info dictionary).
     } deriving (Show, Eq, Typeable)
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 makeLensesFor
   [ ("tAnnounce"    , "announce"    )
   , ("tAnnounceList", "announceList")
diff --git a/src/Data/Tox/Onion.hs b/src/Data/Tox/Onion.hs
index 85a9d21e..bd802c75 100644
--- a/src/Data/Tox/Onion.hs
+++ b/src/Data/Tox/Onion.hs
@@ -704,6 +704,7 @@ data DataToRoute = DataToRoute
     { dataFromKey :: PublicKey -- Real public key of sender
     , dataToRoute :: Encrypted OnionData -- (Word8,ByteString) -- DHTPK 0x9c
     }
+ deriving Show
 
 instance Sized DataToRoute where
     size = ConstSize 32 <> contramap dataToRoute size
diff --git a/src/Network/BitTorrent/MainlineDHT.hs b/src/Network/BitTorrent/MainlineDHT.hs
index a29657af..6f47e38f 100644
--- a/src/Network/BitTorrent/MainlineDHT.hs
+++ b/src/Network/BitTorrent/MainlineDHT.hs
@@ -1076,6 +1076,8 @@ mainlineSearch qry = Search
     { searchSpace       = mainlineSpace
     , searchNodeAddress = nodeIP &&& nodePort
     , searchQuery       = qry
+    , searchAlpha       = 8
+    , searchK           = 16
     }
 
 nodeSearch :: MainlineClient -> Search NodeId (IP, PortNumber) () NodeInfo NodeInfo
diff --git a/src/Network/Kademlia/Search.hs b/src/Network/Kademlia/Search.hs
index d3aaae28..e87a8618 100644
--- a/src/Network/Kademlia/Search.hs
+++ b/src/Network/Kademlia/Search.hs
@@ -32,36 +32,38 @@ data Search nid addr tok ni r = Search
     { searchSpace        :: KademliaSpace nid ni
     , searchNodeAddress  :: ni -> addr
     , 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
+      -- 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 -- K = 16
     }
 
 data SearchState nid addr tok ni r = SearchState
-    {-
-    { searchParams :: Search nid addr ni r
-
-    , searchTarget       :: nid
-      -- | This action will be performed at least once on each search result.
-      -- It may be invoked multiple times since different nodes may report the
-      -- same result.  If the action returns 'False', the search will be
-      -- aborted, otherwise it will continue until it is decided that we've
-      -- asked the closest K nodes to the target.
-    , searchResult      :: r -> STM Bool
-
-    -}
-
     { -- | The number of pending queries.  Incremented before any query is sent
       -- and decremented when we get a reply.
       searchPendingCount :: TVar Int
-      -- | Nodes scheduled to be queried.
+      -- | Nodes scheduled to be queried (roughly at most K).
     , searchQueued       :: TVar (MinMaxPSQ ni nid)
       -- | The nearest (K - α) nodes that issued a reply.
+      --
+      -- α is the maximum number of simultaneous queries.
     , 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
       -- set.  It also can be a bounded 'MinMaxPSQ', although searchAlpha
       -- should limit the number of outstanding queries.
     , searchVisited      :: TVar (Set addr)
+    , searchSpec         :: Search nid addr tok ni r
     }
 
+
 newSearch :: ( Ord addr
              , PSQKey nid
              , PSQKey ni
@@ -77,7 +79,7 @@ newSearch :: ( Ord addr
              -> nid
              -> [ni]                   -- Initial nodes to query.
              -> STM (SearchState nid addr tok ni r)
-newSearch (Search space nAddr qry) target ns = do
+newSearch s@(Search space nAddr qry _ _) target ns = do
     c <- newTVar 0
     q <- newTVar $ MM.fromList
                  $ map (\n -> n :-> kademliaXor space target (kademliaLocation space n))
@@ -85,7 +87,7 @@ newSearch (Search space nAddr qry) target ns = do
     i <- newTVar MM.empty
     v <- newTVar Set.empty
     return -- (Search space nAddr qry) , r , target
-           ( SearchState c q i v )
+           ( SearchState c q i v s )
 
 -- | Discard a value from a key-priority-value tuple. This is useful for
 -- swaping items from a "MinMaxPSQ'" to a "MinMaxPSQ".
@@ -110,21 +112,6 @@ reset nearestNodes qsearch target st = do
     writeTVar (searchPendingCount st) 0
     return st
 
-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 = 16
-
 sendQuery :: forall addr nid tok ni r.
             ( Ord addr
             , PSQKey nid
@@ -159,8 +146,11 @@ sendQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> d) =
              | otherwise = MM.insertTake k n ( kademliaXor searchSpace searchTarget
                                                $ kademliaLocation searchSpace n )
                                                    q
+
         qsize0 <- MM.size <$> readTVar searchQueued
-        let qsize = if qsize0 < searchK then searchK else qsize0
+        let qsize = if qsize0 < searchK then searchK else qsize0 -- Allow searchQueued to grow
+                                                                 -- only when there's fewer than
+                                                                 -- K elements.
         modifyTVar searchQueued    $ \q -> foldr (insertFoundNode qsize) q ns
         modifyTVar searchInformant $ MM.insertTake' (searchK - searchAlpha) ni tok d
         flip fix rs $ \loop -> \case
@@ -174,13 +164,13 @@ sendQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> d) =
 searchIsFinished :: ( PSQKey nid
                     , PSQKey ni
                     ) => SearchState nid addr tok ni r -> STM Bool
-searchIsFinished SearchState{ ..} = do
+searchIsFinished SearchState{..} = do
     q <- readTVar searchQueued
     cnt <- readTVar searchPendingCount
     informants <- readTVar searchInformant
     return $ cnt == 0
              && ( MM.null q
-                  || ( MM.size informants >= (searchK - searchAlpha)
+                  || ( MM.size informants >= (searchK searchSpec - searchAlpha searchSpec)
                        && ( PSQ.prio (fromJust $ MM.findMax informants)
                             <= PSQ.prio (fromJust $ MM.findMin q))))
 
@@ -197,7 +187,7 @@ search ::
     , Show nid
     ) => Search nid addr tok ni r -> R.BucketList ni -> nid -> (r -> STM Bool) -> IO (SearchState nid addr tok ni r)
 search sch buckets target result = do
-    let ns = R.kclosest (searchSpace sch) searchK target buckets
+    let ns = R.kclosest (searchSpace sch) (searchK sch) target buckets
     st <- atomically $ newSearch sch target ns
     forkIO $ searchLoop sch target result st
     return st
@@ -218,7 +208,7 @@ searchLoop sch@Search{..} target result s@SearchState{..} = do
             found <- MM.minView <$> readTVar searchQueued
             case found of
                 Just (ni :-> d, q)
-                  | -- If there's fewer than /k/ informants and there's any
+                  | -- If there's fewer than /k - α/ informants and there's any
                     -- node we haven't yet got a response from.
                     (MM.size informants < searchK - searchAlpha) && (cnt > 0 || not (MM.null q))
                     -- Or there's no informants yet at all.
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index 2c13e168..a18b550d 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -44,7 +44,7 @@ module Network.Tox.Crypto.Transport
     , HasMessage(..)
     , HasMessageType(..)
     -- lenses
-#ifdef VERSION_lens
+#ifdef USE_lens
     , groupNumber, groupNumberToJoin, peerNumber, messageNumber
     , messageName, messageData, name, title, message, messageType
 #endif
@@ -288,7 +288,7 @@ putCryptoMessage seqno (Pkt t :=> Identity x) = do
     putPacket seqno x
 
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 erCompat :: String -> a
 erCompat lens = error $ "Use of '" ++ lens ++ "'  lens on incompatible CryptoMessage type"
 #endif
@@ -336,7 +336,7 @@ instance HasGroupChatID CryptoMessage where
     setGroupChatID _ _= error "setGroupChatID on non-groupchat message."
 -}
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 groupChatID :: (Functor f, HasGroupChatID x) => (GroupChatId -> f GroupChatId) -> (x -> f x)
 groupChatID = lens getGroupChatID setGroupChatID
 #endif
@@ -370,7 +370,7 @@ instance HasGroupNumber CryptoMessage where
     setGroupNumber _ _ = error "setGroupNumber on CryptoMessage without group number field."
 -}
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 groupNumber :: (Functor f, HasGroupNumber x) => (Word16 -> f Word16) -> (x -> f x)
 groupNumber = lens getGroupNumber setGroupNumber
 #endif
@@ -394,7 +394,7 @@ instance HasGroupNumberToJoin CryptoMessage where
     setGroupNumberToJoin _ _ = error "setGroupNumberToJoin on CryptoMessage without group number (to join) field."
 -}
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 groupNumberToJoin :: (Functor f, HasGroupNumberToJoin x) => (GroupNumber -> f GroupNumber) -> (x -> f x)
 groupNumberToJoin = lens getGroupNumberToJoin setGroupNumberToJoin
 #endif
@@ -418,7 +418,7 @@ instance HasPeerNumber CryptoMessage where
     setPeerNumber _ _ = error "setPeerNumber on CryptoMessage without peer number field."
 -}
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 peerNumber :: (Functor f, HasPeerNumber x) => (Word16 -> f Word16) -> (x -> f x)
 peerNumber = lens getPeerNumber setPeerNumber
 #endif
@@ -442,7 +442,7 @@ instance HasMessageNumber CryptoMessage where
     setMessageNumber _ _ = error "setMessageNumber on CryptoMessage without message number field."
 -}
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 messageNumber :: (Functor f, HasMessageNumber x) => (Word32 -> f Word32) -> (x -> f x)
 messageNumber = lens getMessageNumber setMessageNumber
 #endif
@@ -468,7 +468,7 @@ instance HasMessageName CryptoMessage where
     setMessageName _ _ = error "setMessageName on CryptoMessage without message name field."
 -}
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 messageName :: (Functor f, HasMessageName x) => (MessageName -> f MessageName) -> (x -> f x)
 messageName = lens getMessageName setMessageName
 #endif
@@ -514,7 +514,7 @@ instance AsWord64 MessageType where
     fromWord64 x | x < 1024, x .|. 0x0200 == 0x0200 = GrpMsg (toEnum8 ((x - 512) `div` 256)) (toEnum8 x)
     fromWord64 x = error "Not clear how to convert Word64 to MessageType"
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 word16 :: (Functor f, AsWord16 x) => (Word16 -> f Word16) -> (x -> f x)
 word16  = lens toWord16 (\_ x -> fromWord16 x)
 #endif
@@ -559,7 +559,7 @@ instance HasMessageType CryptoData where
     setMessageType cd@(CryptoData { bufferData=bd }) typ = cd { bufferData=setMessageType bd typ }
 -}
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 -- | This lens should always succeed on CryptoMessage
 messageType :: (Functor f, HasMessageType x) => (MessageType -> f MessageType) -> (x -> f x)
 messageType = lens getMessageType setMessageType
@@ -589,7 +589,7 @@ instance HasMessageData CryptoMessage where
     setMessageData _ _ = error "setMessageData on CryptoMessage without message data field."
 -}
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 messageData :: (Functor f, HasMessageData x) => (MessageData -> f MessageData) -> (x -> f x)
 messageData = lens getMessageData setMessageData
 #endif
@@ -621,7 +621,7 @@ instance HasTitle CryptoMessage where
     setTitle _ _ = error "setTitle on CryptoMessage without title field."
 -}
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 title :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x)
 title = lens getTitle setTitle
 #endif
@@ -653,7 +653,7 @@ instance HasMessage CryptoMessage where
     setMessage _ _ = error "setMessage on CryptoMessage without message field."
 -}
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 message :: (Functor f, HasMessage x) => (Text -> f Text) -> (x -> f x)
 message = lens getMessage setMessage
 #endif
@@ -675,7 +675,7 @@ instance HasName CryptoMessage where
     setName _ _ = error "setName on CryptoMessage without name field."
 -}
 
-#ifdef VERSION_lens
+#ifdef USE_lens
 name :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x)
 name = lens getTitle setTitle
 #endif
diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs
index 2fbac5d3..afdf2cc3 100644
--- a/src/Network/Tox/DHT/Handlers.hs
+++ b/src/Network/Tox/DHT/Handlers.hs
@@ -195,6 +195,8 @@ newRouting addr crypto update4 update6 = do
                 { searchSpace       = toxSpace
                 , searchNodeAddress = nodeIP &&& nodePort
                 , searchQuery       = \_ _ -> return Nothing
+                , searchAlpha       = 1
+                , searchK           = 2
                 }
         tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info4 R.defaultBucketCount
         tbl6 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info6 R.defaultBucketCount
@@ -524,4 +526,7 @@ nodeSearch client cbvar = Search
     { searchSpace       = toxSpace
     , searchNodeAddress = nodeIP &&& nodePort
     , searchQuery       = getNodes client cbvar
+    , searchAlpha       = 8
+    , searchK           = 16
+
     }
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index a16508cd..52cc298d 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -219,6 +219,8 @@ toxidSearch getTimeout crypto client = Search
     { searchSpace       = toxSpace
     , searchNodeAddress = nodeIP &&& nodePort
     , searchQuery       = getRendezvous getTimeout crypto client
+    , searchAlpha = 3
+    , searchK     = 6
     }
 
 announceSerializer :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
diff --git a/src/Network/Tox/TCP.hs b/src/Network/Tox/TCP.hs
index 1111d3b8..a7881c24 100644
--- a/src/Network/Tox/TCP.hs
+++ b/src/Network/Tox/TCP.hs
@@ -191,15 +191,15 @@ getUDPNodes' tcp seeking dst0 = do
             n24 <- transportNewNonce (tcpCrypto tcp)
             return (b,c,n24)
         let (dst,gateway') = if UDP.nodeId dst0 == nodeId gateway
-                                then ( dst0 { UDP.nodeIP = fromJust $ fromSockAddr localhost4 }
+                                then ( dst0 { UDP.nodeIP = fromJust $ Network.Address.fromSockAddr localhost4 }
                                      , gateway { udpNodeInfo = (udpNodeInfo gateway)
-                                                    { UDP.nodeIP = fromJust $ fromSockAddr localhost4 }})
+                                                    { UDP.nodeIP = fromJust $ Network.Address.fromSockAddr localhost4 }})
                                 else (dst0,gateway)
         wrap2 <- lookupNonceFunction (tcpCrypto tcp) b (UDP.id2key $ UDP.nodeId dst)
         wrap1 <- lookupNonceFunction (tcpCrypto tcp) c (UDP.id2key $ nodeId gateway)
         wrap0 <- lookupNonceFunction (tcpCrypto tcp) (transportSecret $ tcpCrypto tcp) (UDP.id2key $ UDP.nodeId dst)
         let meth = MethodSerializer -- MethodSerializer Nonce8 NodeInfo RelayPacket meth AnnounceRequest (Either String AnnounceResponse)
-                    { methodTimeout = \tid addr -> return (addr,8000000) -- 8 second timeout
+                    { methodTimeout = \tid addr -> return (addr,12000000) -- 12 second timeout
                     , method = () -- meth
                     , wrapQuery = \n8 src gateway x ->
                         OnionPacket n24 $ Addressed (UDP.nodeAddr dst)
@@ -274,7 +274,7 @@ newClient crypto store load = do
             , tableMethods = transactionMethods' store load (contramap (\(Nonce8 w64) -> w64) w64MapMethods)
                                 $ first (either error Nonce8 . decode) . randomBytesGenerate 8
             }
-        , clientErrorReporter = logErrors
+        , clientErrorReporter = logErrors { reportTimeout = reportTimeout ignoreErrors }
         , clientPending = map_var
         , clientAddress = \_ -> return $ NodeInfo
             { udpNodeInfo = either error id $ UDP.nodeInfo (UDP.key2id $ transportPublic crypto) (SockAddrInet 0 0)
diff --git a/stack.ghc-8.6.yaml b/stack.ghc-8.6.yaml
index 1aa127cb..65555e0a 100644
--- a/stack.ghc-8.6.yaml
+++ b/stack.ghc-8.6.yaml
@@ -9,6 +9,7 @@ packages:
 flags: {}
 extra-package-dbs: []
 extra-deps:
+- rank2classes-1.1.0.1
 - cryptonite-0.23
 - reference-0.1
 - git: https://github.com/afcady/hs-avahi.git