peer search.

1 files changed, 33 insertions, 32 deletions

diff --git a/Mainline.hs b/Mainline.hs
index 30e18a09..7c54a096 100644
--- a/Mainline.hs
+++ b/Mainline.hs
@@ -945,30 +945,38 @@ announceH (SwarmsDatabase peers toks _) naddr announcement = do
 
 isReadonlyClient client = False -- TODO
 
-ping :: MainlineClient -> NodeInfo -> IO Bool
-ping client addr = fromMaybe False <$> sendQuery client serializer Ping addr
+mainlineSend meth unwrap msg client nid addr = do
+    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
  where
     serializer = MethodSerializer
         { methodTimeout  = 5
-        , method         = Method "ping"
-        , wrapQuery      = encodeQueryPayload (Method "ping") (isReadonlyClient client)
-        , unwrapResponse = const True
+        , method         = meth
+        , wrapQuery      = encodeQueryPayload meth (isReadonlyClient client)
+        , unwrapResponse = (>>= either (Left . Error GenericError . Char8.pack)
+                                       (Right . unwrap)
+                                       . BE.fromBEncode)
+                           . rspPayload
         }
 
--- searchQuery        :: ni -> IO ([ni], [r])
-getNodes :: MainlineClient -> NodeId -> NodeInfo -> IO ([NodeInfo],[NodeInfo])
-getNodes client nid addr =
-    fromMaybe ([],[]) <$> sendQuery client serializer (FindNode nid (Just Want_Both)) addr
+ping :: MainlineClient -> NodeInfo -> IO Bool
+ping client addr =
+    fromMaybe False
+    <$> mainlineSend (Method "ping") (\Ping -> True) (const Ping) client () addr
+
+-- searchQuery        :: ni -> IO (Maybe [ni], [r], tok))
+getNodes :: MainlineClient -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],()))
+getNodes = mainlineSend (Method "find_node") unwrap $ flip FindNode (Just Want_Both)
  where
-    serializer = MethodSerializer
-        { methodTimeout  = 5
-        , method         = Method "find_node"
-        , wrapQuery      = encodeQueryPayload (Method "find_node") (isReadonlyClient client)
-        , unwrapResponse = \case
-            R { rspPayload = Right bval } | Right (NodeFound ns4 ns6) <- BE.fromBEncode bval
-              -> (ns4++ns6, ns4++ns6)
-            _ -> ([],[])
-        }
+    unwrap (NodeFound ns4 ns6) = (ns4++ns6, ns4++ns6,())
+
+getPeers :: MainlineClient -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[PeerAddr],Token))
+getPeers = mainlineSend (Method "get_peers") unwrap $ flip GetPeers (Just Want_Both) . coerce
+ where
+    unwrap (GotPeers ps (NodeFound ns4 ns6) tok) = (ns4++ns6, ps, tok)
 
 data TriadSlot = SlotA | SlotB | SlotC
  deriving (Eq,Ord,Enum,Show,Read)
@@ -1048,23 +1056,16 @@ delVote triad voter = do
         writeTVar (triadSlot slot triad) Nothing
         triadCountVotes prior triad
 
-nodeSearch client = Search
-    { searchSpace = mainlineSpace
+mainlineSearch qry = Search
+    { searchSpace       = mainlineSpace
     , searchNodeAddress = nodeIP &&& nodePort
-    , searchQuery = \nid ni -> do
-        hPutStrLn stderr $ "findNodes "++show nid++" --> "++show ni
-        handle (\(SomeException e) -> do
-                    hPutStrLn stderr $ "got "++show e
-                    -- threadDelay 1000000
-                    return ([],[]))
-            $ do
-                (xs,y) <- getNodes client nid ni
-                forM_ xs $ \x -> do
-                    hPutStrLn stderr $ "got "++show x
-                -- threadDelay 1000000
-                return (xs,y)
+    , searchQuery       = qry
     }
 
+nodeSearch client = mainlineSearch (getNodes client)
+
+peerSearch client = mainlineSearch (getPeers client)
+
 -- | List of bootstrap nodes maintained by different bittorrent
 -- software authors.
 bootstrapNodes :: WantIP -> IO [NodeInfo]