From ba190f7130e947dd0aaf3c36a3b2d5d704b3512c Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Tue, 24 Jan 2017 14:56:18 -0500
Subject: find-nodes command.

---
 examples/dhtd.hs | 23 +++++++++++++++++++++--
 1 file changed, 21 insertions(+), 2 deletions(-)

(limited to 'examples/dhtd.hs')

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index f8ca8575..cb507f71 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -31,6 +31,7 @@ import Data.Torrent (InfoHash)
 import Network.BitTorrent.Address
 import Network.BitTorrent.DHT
 import Network.BitTorrent.DHT.Query
+import Network.BitTorrent.DHT.Message (FindNode(..),NodeFound(..))
 import Network.KRPC.Manager (QueryFailure(..))
 import Network.KRPC.Message (ReflectedIP(..))
 import qualified Network.BitTorrent.DHT.Routing as R
@@ -212,6 +213,21 @@ clientSession st signalQuit sock n h = do
                                          hPutClient h $ unlines rs
                         Left er -> return $ hPutClient h er
 
+        ("find-nodes", s) -> cmd $ do
+                    let (hs,as) = second (dropWhile isSpace) $ break isSpace s
+                        parse = do ih <- readEither hs
+                                   a <- readEither as
+                                   -- XXX: using 'InfoHash' only because 'NodeId' currently
+                                   -- has no 'Read' instance.
+                                   return (ih :: InfoHash, a :: NodeAddr IPv4)
+                    case parse of
+                        Right (ih,a) -> do
+                            result <- try $ queryNode' (a ::NodeAddr IPv4) $ FindNode (R.toNodeId ih)
+                            let rs = either (pure . showQueryFail) reportNodes result
+                            return $ do
+                            hPutClient h $ unlines rs
+                        Left er -> return $ hPutClient h er
+
         _    -> cmd0 $ hPutClient h "error."
 
 defaultPort = error "TODO defaultPort"
@@ -219,9 +235,12 @@ defaultPort = error "TODO defaultPort"
 showQueryFail :: QueryFailure -> String
 showQueryFail e = show e
 
+consip (ReflectedIP ip) xs = ("(external-ip " ++ show ip ++ ")") : xs
+
 reportPong (info,myip) = maybe id consip myip [show $ pPrint info]
- where
-    consip (ReflectedIP ip) xs = ("(external-ip " ++ show ip ++ ")") : xs
+
+reportNodes :: (NodeId, NodeFound IPv4, Maybe ReflectedIP) -> [String]
+reportNodes (nid,NodeFound ns,myip) = maybe id consip myip $ show (pPrint nid) : map (show . pPrint) ns
 
 main :: IO ()
 main = do
-- 
cgit v1.2.3