From 78b05bf38b83b5d46468e1f938bb8c2d9dd0804f Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Mon, 3 Jul 2017 20:35:07 -0400
Subject: Fleshed out Tox TODO stubs.

---
 examples/dhtd.hs | 66 ++++++++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 55 insertions(+), 11 deletions(-)

(limited to 'examples/dhtd.hs')

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 3fca5482..4c8cefb5 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -68,6 +68,7 @@ import Network.KRPC.Method
 import Data.Typeable
 import GHC.Generics
 import Data.Bool
+import System.Random
 
 mkNodeAddr :: SockAddr -> NodeAddr IPv4
 mkNodeAddr addr = NodeAddr (fromJust $ fromSockAddr addr)
@@ -252,23 +253,66 @@ instance Serialize (Response Tox.Message (Ping Tox.Message)) where
     get = getToxPing True Network.DHT.Types.Response Tox.ResponseNonce
     put (Network.DHT.Types.Response extra Ping) = putToxPing True (Tox.rspNonce extra)
 
-instance Serialize (Query Tox.Message (FindNode Tox.Message IPv4)) where
-    get = error "TODO get 7"
-    put = error "TODO put 8"
+nodeFormatToNodeInfo nf = NodeInfo nid addr u
+ where
+    u    = Tox.nodeIsTCP nf
+    addr = NodeAddr (Tox.nodeIP nf) (Tox.nodePort nf)
+    nid  = Tox.nodePublicKey nf
+
+instance Serialize (Query Tox.Message (FindNode Tox.Message ip)) where
+    get = do
+        nid <- get
+        n8 <- get
+        return $ Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)
+    put (Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)) = do
+        put nid
+        put n8
 instance Serialize (Response Tox.Message (NodeFound Tox.Message IPv4)) where
-    get = error "TODO get 11"
-    put = error "TODO put 12"
+    get = do
+        num <- get :: Get Word8
+        when (num > 4) $ fail "Too many nodes in Tox get-nodes reply"
+        ns0 <- sequence $ replicate (fromIntegral num) (nodeFormatToNodeInfo <$> get)
+        -- TODO: Allow tcp and ipv6. For now filtering to udp ip4...
+        let ns = flip mapMaybe ns0 $ \(NodeInfo nid addr u) -> do
+                    guard $ not u
+                    ip4 <- fromAddr addr
+                    return $ NodeInfo nid ip4 ()
+        n8 <- get
+        return $ Network.DHT.Types.Response (Tox.ResponseNonce n8) $ NodeFound ns
+    put (Network.DHT.Types.Response (Tox.ResponseNonce n8) (NodeFound ns)) = do
+        put ( fromIntegral (length ns) :: Word8 )
+        forM_ ns $ \(NodeInfo nid ip4 ()) -> do
+            put Tox.NodeFormat { nodePublicKey = nid
+                               , nodeIsTCP     = False
+                               , nodeIP        = IPv4 (nodeHost ip4)
+                               , nodePort      = nodePort ip4
+                               }
+        put n8
+
+validateToxExchange q r = qnonce == rnonce
+      where
+        qnonce = Tox.qryNonce . queryExtra    . Tox.msgPayload $ q
+        rnonce = Tox.rspNonce . responseExtra . Tox.msgPayload $ r
 
 instance KRPC Tox.Message (Query    Tox.Message (FindNode  Tox.Message IPv4))
                           (Response Tox.Message (NodeFound Tox.Message IPv4)) where
-    method = error "TODO method 15"
+    method = Method Tox.GetNodes
+    validateExchange = validateToxExchange
+    makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
+    makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
+    messageSender q _ = Tox.msgClient q
+    messageResponder _ r = Tox.msgClient r
+
 instance KRPC Tox.Message (Query    Tox.Message (Ping Tox.Message))
                           (Response Tox.Message (Ping Tox.Message)) where
-    method = error "TODO method 16"
-instance DataHandlers ByteString Tox.Message where
-
-
--- instance Generic (Response Tox.Message (NodeFound Tox.Message IPv4)) where -- TODO
+    method = Method Tox.Ping
+    validateExchange = validateToxExchange
+    makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
+    makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
+    messageSender q _ = Tox.msgClient q
+    messageResponder _ r = Tox.msgClient r
+
+instance DataHandlers ByteString Tox.Message
 
 instance Default Bool where def = False
 
-- 
cgit v1.2.3