Fleshed out KRPC instances for Mainline DHT.

1 files changed, 29 insertions, 15 deletions

diff --git a/src/Network/DHT/Mainline.hs b/src/Network/DHT/Mainline.hs
index d68755a7..9af42a6d 100644
--- a/src/Network/DHT/Mainline.hs
+++ b/src/Network/DHT/Mainline.hs
@@ -218,11 +218,13 @@ instance Serialize (Response Ping) where
 
 -- | \"q\" = \"ping\"
 instance KRPC KMessageOf (Query KMessageOf (Ping KMessageOf)) (Response KMessageOf (Ping KMessageOf)) where
-#ifdef VERSION_bencoding
-  method = "ping"
-#else
-  method = Method Tox.Ping -- response: Tox.Pong
-#endif
+    method = "ping"
+    makeQueryExtra _ nid _ _ = return $ MainlineQuery nid False -- TODO: check for NAT issues. (BEP 43)
+    makeResponseExtra _ nid _ _ = return $ MainlineResponse nid
+
+    -- TODO KError Sender/Responder
+    messageSender (Q q) _ = queringNodeId $ queryExtra $ queryArgs q
+    messageResponder _ (R r) = queredNodeId $ responseExtra $ respVals r
 
 {-----------------------------------------------------------------------
 -- find_node method
@@ -302,13 +304,14 @@ instance Serialize (Response KMessageOf (NodeFound KMessageOf ip)) where
 -- | \"q\" == \"find_node\"
 instance (Address ip, Typeable ip)
       => KRPC KMessageOf (Query KMessageOf (FindNode KMessageOf ip)) (Response KMessageOf (NodeFound KMessageOf ip)) where
-#ifdef VERSION_bencoding
-  method = "find_node"
-#else
-  method = Method Tox.GetNodes -- response: Tox.SendNodes
-#endif
+    method = "find_node"
+    makeQueryExtra _ nid _ _ = return $ MainlineQuery nid False -- TODO: check for NAT issues. (BEP 43)
+    makeResponseExtra _ nid _ _ = return $ MainlineResponse nid
+
+    -- TODO KError Sender/Responder
+    messageSender (Q q) _ = queringNodeId $ queryExtra $ queryArgs q
+    messageResponder _ (R r) = queredNodeId $ responseExtra $ respVals r
 
-#ifdef VERSION_bencoding
 {-----------------------------------------------------------------------
 -- get_peers method
 -----------------------------------------------------------------------}
@@ -371,7 +374,14 @@ instance (Typeable ip, Serialize ip) => BEncode (GotPeers ip) where
 -- | \"q" = \"get_peers\"
 instance (Typeable ip, Serialize ip) =>
          KRPC KMessageOf (Query KMessageOf (GetPeers ip)) (Response KMessageOf (GotPeers ip)) where
-  method = "get_peers"
+    method = "get_peers"
+    makeQueryExtra _ nid _ _ = return $ MainlineQuery nid False -- TODO: check for NAT issues. (BEP 43)
+    makeResponseExtra _ nid _ _ = return $ MainlineResponse nid
+
+    -- TODO KError Sender/Responder
+    messageSender (Q q) _ = queringNodeId $ queryExtra $ queryArgs q
+    messageResponder _ (R r) = queredNodeId $ responseExtra $ respVals r
+
 
 {-----------------------------------------------------------------------
 -- announce method
@@ -443,10 +453,14 @@ instance BEncode Announced where
 
 -- | \"q" = \"announce\"
 instance KRPC KMessageOf (Query KMessageOf Announce) (Response KMessageOf Announced) where
-  method = "announce_peer"
+    method = "announce_peer"
+    makeQueryExtra _ nid _ _ = return $ MainlineQuery nid False -- TODO: check for NAT issues. (BEP 43)
+    makeResponseExtra _ nid _ _ = return $ MainlineResponse nid
+
+    -- TODO KError Sender/Responder
+    messageSender (Q q) _ = queringNodeId $ queryExtra $ queryArgs q
+    messageResponder _ (R r) = queredNodeId $ responseExtra $ respVals r
 
--- endif VERSION_bencoding
-#endif
 
 -- | Yields all 8 DHT neighborhoods available to you given a particular ip
 -- address.