3 files changed, 23 insertions, 144 deletions

diff --git a/dht/src/Network/BitTorrent/MainlineDHT.hs b/dht/src/Network/BitTorrent/MainlineDHT.hs
index 7589f538..ed97ee31 100644
--- a/dht/src/Network/BitTorrent/MainlineDHT.hs
+++ b/dht/src/Network/BitTorrent/MainlineDHT.hs
@@ -564,7 +564,7 @@ newClient swarms addr = do
         -- We defer initializing the refreshSearch and refreshPing until we
         -- have a client to send queries with.
         let nullPing = const $ return False
-            nullSearch = mainlineSearch $ Left $ \_ _ -> return Nothing
+            nullSearch = mainlineSearch $ \_ _ -> return Nothing
         tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info R.defaultBucketCount
         refresher4 <- newBucketRefresher tbl4 nullSearch nullPing
         tbl6 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info6 R.defaultBucketCount
@@ -1042,36 +1042,13 @@ mainlineSend :: ( BEncode a
                   -> NodeInfo
                   -> IO (Maybe b)
 mainlineSend meth unwrap msg client nid addr = do
-    reply <- sendQuery client (mainlineSerializeer meth unwrap client) (msg nid) addr
+    reply <- sendQuery client serializer (msg nid) addr
     -- sendQuery will return (Just (Left _)) on a parse error.  We're going to
     -- blow it away with the join-either sequence.
     -- TODO: Do something with parse errors.
     return $ join $ either (const Nothing) Just <$> reply
-
-mainlineAsync :: (BEncode a1, BEncode a2) =>
-                       Method
-                       -> (a2 -> a3)
-                       -> (t -> a1)
-                       -> Client String Method TransactionId NodeInfo (Message BValue)
-                       -> t
-                       -> NodeInfo
-                       -> (Maybe a3 -> IO ())
-                       -> IO ()
-mainlineAsync meth unwrap msg client nid addr onresult = do
-    asyncQuery client (mainlineSerializeer meth unwrap client) (msg nid) addr
-        $ \reply ->
-            -- sendQuery will return (Just (Left _)) on a parse error.  We're going to
-            -- blow it away with the join-either sequence.
-            -- TODO: Do something with parse errors.
-            onresult $ join $ either (const Nothing) Just <$> reply
-
-mainlineSerializeer :: (BEncode a2, BEncode a1) =>
-                        Method
-                        -> (a2 -> b)
-                        -> MainlineClient
-                        -> MethodSerializer
-                             TransactionId NodeInfo (Message BValue) Method a1 (Either Error b)
-mainlineSerializeer meth unwrap client = MethodSerializer
+ where
+    serializer = MethodSerializer
         { methodTimeout  = \ni -> return (ni, 5000000)
         , method         = meth
         , wrapQuery      = encodeQueryPayload meth (isReadonlyClient client)
@@ -1090,45 +1067,30 @@ ping client addr =
 getNodes :: MainlineClient -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],Maybe ()))
 getNodes = mainlineSend (Method "find_node") unwrapNodes $ flip FindNode (Just Want_Both)
 
-asyncGetNodes :: Client String Method TransactionId NodeInfo (Message BValue)
-                   -> NodeId
-                   -> NodeInfo
-                   -> (Maybe ([NodeInfo], [NodeInfo], Maybe ()) -> IO ())
-                   -> IO ()
-asyncGetNodes = mainlineAsync (Method "find_node") unwrapNodes $ flip FindNode (Just Want_Both)
-
 unwrapNodes :: NodeFound -> ([NodeInfo], [NodeInfo], Maybe ())
 unwrapNodes (NodeFound ns4 ns6) = (ns4++ns6, ns4++ns6, Just ())
 
 getPeers :: MainlineClient -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[PeerAddr],Maybe Token))
 getPeers = mainlineSend (Method "get_peers") unwrapPeers $ flip GetPeers (Just Want_Both) . coerce
 
-asyncGetPeers :: Client String Method TransactionId NodeInfo (Message BValue)
-                 -> NodeId
-                 -> NodeInfo
-                 -> (Maybe ([NodeInfo], [PeerAddr], Maybe Token) -> IO ())
-                 -> IO ()
-asyncGetPeers = mainlineAsync (Method "get_peers") unwrapPeers $ flip GetPeers (Just Want_Both) . coerce
-
 unwrapPeers :: GotPeers -> ([NodeInfo], [PeerAddr], Maybe Token)
 unwrapPeers (GotPeers ps (NodeFound ns4 ns6) tok) = (ns4++ns6, ps, Just tok)
 
-mainlineSearch :: Either (NodeId -> NodeInfo -> IO (Maybe ([NodeInfo], [r], Maybe tok)))
-                         (NodeId -> NodeInfo -> (Maybe ([NodeInfo], [r], Maybe tok) -> IO ()) -> IO ())
+mainlineSearch :: (NodeId -> NodeInfo -> IO (Maybe ([NodeInfo], [r], Maybe tok)))
                   -> Search NodeId (IP, PortNumber) tok NodeInfo r
 mainlineSearch qry = Search
     { searchSpace       = mainlineSpace
     , searchNodeAddress = nodeIP &&& nodePort
-    , searchQuery       = qry
+    , searchQuery       = Left qry
     , searchAlpha       = 8
     , searchK           = 16
     }
 
 nodeSearch :: MainlineClient -> Search NodeId (IP, PortNumber) () NodeInfo NodeInfo
-nodeSearch client = mainlineSearch (Right $ asyncGetNodes client)
+nodeSearch client = mainlineSearch (getNodes client)
 
 peerSearch :: MainlineClient -> Search NodeId (IP, PortNumber) Token NodeInfo PeerAddr
-peerSearch client = mainlineSearch (Right $ asyncGetPeers client)
+peerSearch client = mainlineSearch (getPeers client)
 
 -- | List of bootstrap nodes maintained by different bittorrent
 -- software authors.
diff --git a/dht/src/Network/Tox/DHT/Handlers.hs b/dht/src/Network/Tox/DHT/Handlers.hs
index e97cab96..e93f565b 100644
--- a/dht/src/Network/Tox/DHT/Handlers.hs
+++ b/dht/src/Network/Tox/DHT/Handlers.hs
@@ -400,61 +400,20 @@ unsendNodes _                    = Nothing
 unwrapNodes :: SendNodes -> ( [NodeInfo], [NodeInfo], Maybe () )
 unwrapNodes (SendNodes ns) = (ns,ns,Just ())
 
-data SendableQuery x a b = SendableQuery
-    { sendableSerializer :: MethodSerializer TransactionId NodeInfo Message PacketKind a (Maybe x)
-    , sendableQuery      :: NodeId -> a
-    , sendableResult     :: Maybe (Maybe x) -> IO b
-    }
-
-sendQ :: SendableQuery x a b
-               -> QR.Client err PacketKind TransactionId NodeInfo Message
-               -> NodeId
-               -> NodeInfo
-               -> IO b
-sendQ s client nid addr = do
-    reply <- QR.sendQuery client (sendableSerializer s) (sendableQuery s nid) addr
-    sendableResult s reply
-
-asyncQ :: SendableQuery x a b
-            -> QR.Client err PacketKind TransactionId NodeInfo Message
-            -> NodeId
-            -> NodeInfo
-            -> (b -> IO ())
-            -> IO ()
-asyncQ s client nid addr go = do
-    QR.asyncQuery client (sendableSerializer s) (sendableQuery s nid) addr
-        $ sendableResult s >=> go
-
-getNodesSendable :: TVar (HashMap NodeId [NodeInfoCallback])
-                    -> NodeInfo
-                    -> SendableQuery SendNodes GetNodes (Maybe ([NodeInfo], [NodeInfo], Maybe ()))
-getNodesSendable cbvar addr = SendableQuery (serializer GetNodesType DHTGetNodes unsendNodes)
-                                            GetNodes
-                                            go
-  where
-    go reply = do
-        forM_ (join reply) $ \(SendNodes ns) ->
-            forM_ ns $ \n -> do
-                now <- getPOSIXTime
-                atomically $ do
-                    mcbs <- HashMap.lookup (nodeId n) <$> readTVar cbvar
-                    forM_ mcbs $ \cbs -> do
-                        forM_ cbs $ \cb -> do
-                            rumoredAddress cb now (nodeAddr addr) n
-        return $ fmap unwrapNodes $ join reply
-
 getNodes :: Client -> TVar (HashMap NodeId [NodeInfoCallback]) -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],Maybe ()))
-getNodes client cbvar nid addr =
-    sendQ (getNodesSendable cbvar addr) client nid addr
-
-asyncGetNodes :: QR.Client err PacketKind TransactionId NodeInfo Message
-                 -> TVar (HashMap NodeId [NodeInfoCallback])
-                 -> NodeId
-                 -> NodeInfo
-                 -> (Maybe ([NodeInfo], [NodeInfo], Maybe ()) -> IO ())
-                 -> IO ()
-asyncGetNodes client cbvar nid addr go =
-    asyncQ (getNodesSendable cbvar addr) client nid addr go
+getNodes client cbvar nid addr = do
+    -- dput XMisc $ show addr ++ " <-- getnodes " ++ show nid
+    reply <- QR.sendQuery client (serializer GetNodesType DHTGetNodes unsendNodes) (GetNodes nid) addr
+    -- dput XMisc $ show addr ++ " -sendnodes-> " ++ show reply
+    forM_ (join reply) $ \(SendNodes ns) -> 
+        forM_ ns $ \n -> do
+            now <- getPOSIXTime
+            atomically $ do
+                mcbs <- HashMap.lookup (nodeId n) <$> readTVar cbvar
+                forM_ mcbs $ \cbs -> do
+                    forM_ cbs $ \cb -> do
+                        rumoredAddress cb now (nodeAddr addr) n
+    return $ fmap unwrapNodes $ join reply
 
 updateRouting :: Client -> Routing
                         -> (TVar (R.BucketList NodeInfo) -> RoutingTransition NodeInfo -> STM ())
@@ -566,7 +525,7 @@ nodeSearch :: Client -> TVar (HashMap NodeId [NodeInfoCallback]) -> Search NodeI
 nodeSearch client cbvar = Search
     { searchSpace       = toxSpace
     , searchNodeAddress = nodeIP &&& nodePort
-    , searchQuery       = Right $ asyncGetNodes client cbvar
+    , searchQuery       = Left $ getNodes client cbvar
     , searchAlpha       = 8
     , searchK           = 16
 
diff --git a/dht/src/Network/Tox/Onion/Handlers.hs b/dht/src/Network/Tox/Onion/Handlers.hs
index 3ea7395f..b35631a3 100644
--- a/dht/src/Network/Tox/Onion/Handlers.hs
+++ b/dht/src/Network/Tox/Onion/Handlers.hs
@@ -219,7 +219,7 @@ toxidSearch :: (OnionDestination r -> STM (OnionDestination r, Int))
 toxidSearch getTimeout crypto client = Search
     { searchSpace       = toxSpace
     , searchNodeAddress = nodeIP &&& nodePort
-    , searchQuery       = Right $ asyncGetRendezvous getTimeout crypto client
+    , searchQuery       = Left $ getRendezvous getTimeout crypto client
     , searchAlpha = 3
     , searchK     = 6
     }
@@ -291,28 +291,6 @@ sendOnion getTimeout client req oaddr unwrap =
           (return . Just . unwrap (onionNodeInfo oaddr))
           $ join mb
 
-asyncOnion :: (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 :: (OnionDestination r -> STM (OnionDestination r, Int))
@@ -332,26 +310,6 @@ getRendezvous getTimeout crypto client nid ni = do
         oaddr
         (unwrapAnnounceResponse rkey)
 
-asyncGetRendezvous
-    :: (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 :: (OnionDestination r -> STM (OnionDestination r, Int))
                -> TransportCrypto
                -> Client r