summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rw-r--r--examples/dhtd.hs66
1 files changed, 55 insertions, 11 deletions
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
68import Data.Typeable 68import Data.Typeable
69import GHC.Generics 69import GHC.Generics
70import Data.Bool 70import Data.Bool
71import System.Random
71 72
72mkNodeAddr :: SockAddr -> NodeAddr IPv4 73mkNodeAddr :: SockAddr -> NodeAddr IPv4
73mkNodeAddr addr = NodeAddr (fromJust $ fromSockAddr addr) 74mkNodeAddr addr = NodeAddr (fromJust $ fromSockAddr addr)
@@ -252,23 +253,66 @@ instance Serialize (Response Tox.Message (Ping Tox.Message)) where
252 get = getToxPing True Network.DHT.Types.Response Tox.ResponseNonce 253 get = getToxPing True Network.DHT.Types.Response Tox.ResponseNonce
253 put (Network.DHT.Types.Response extra Ping) = putToxPing True (Tox.rspNonce extra) 254 put (Network.DHT.Types.Response extra Ping) = putToxPing True (Tox.rspNonce extra)
254 255
255instance Serialize (Query Tox.Message (FindNode Tox.Message IPv4)) where 256nodeFormatToNodeInfo nf = NodeInfo nid addr u
256 get = error "TODO get 7" 257 where
257 put = error "TODO put 8" 258 u = Tox.nodeIsTCP nf
259 addr = NodeAddr (Tox.nodeIP nf) (Tox.nodePort nf)
260 nid = Tox.nodePublicKey nf
261
262instance Serialize (Query Tox.Message (FindNode Tox.Message ip)) where
263 get = do
264 nid <- get
265 n8 <- get
266 return $ Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)
267 put (Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)) = do
268 put nid
269 put n8
258instance Serialize (Response Tox.Message (NodeFound Tox.Message IPv4)) where 270instance Serialize (Response Tox.Message (NodeFound Tox.Message IPv4)) where
259 get = error "TODO get 11" 271 get = do
260 put = error "TODO put 12" 272 num <- get :: Get Word8
273 when (num > 4) $ fail "Too many nodes in Tox get-nodes reply"
274 ns0 <- sequence $ replicate (fromIntegral num) (nodeFormatToNodeInfo <$> get)
275 -- TODO: Allow tcp and ipv6. For now filtering to udp ip4...
276 let ns = flip mapMaybe ns0 $ \(NodeInfo nid addr u) -> do
277 guard $ not u
278 ip4 <- fromAddr addr
279 return $ NodeInfo nid ip4 ()
280 n8 <- get
281 return $ Network.DHT.Types.Response (Tox.ResponseNonce n8) $ NodeFound ns
282 put (Network.DHT.Types.Response (Tox.ResponseNonce n8) (NodeFound ns)) = do
283 put ( fromIntegral (length ns) :: Word8 )
284 forM_ ns $ \(NodeInfo nid ip4 ()) -> do
285 put Tox.NodeFormat { nodePublicKey = nid
286 , nodeIsTCP = False
287 , nodeIP = IPv4 (nodeHost ip4)
288 , nodePort = nodePort ip4
289 }
290 put n8
291
292validateToxExchange q r = qnonce == rnonce
293 where
294 qnonce = Tox.qryNonce . queryExtra . Tox.msgPayload $ q
295 rnonce = Tox.rspNonce . responseExtra . Tox.msgPayload $ r
261 296
262instance KRPC Tox.Message (Query Tox.Message (FindNode Tox.Message IPv4)) 297instance KRPC Tox.Message (Query Tox.Message (FindNode Tox.Message IPv4))
263 (Response Tox.Message (NodeFound Tox.Message IPv4)) where 298 (Response Tox.Message (NodeFound Tox.Message IPv4)) where
264 method = error "TODO method 15" 299 method = Method Tox.GetNodes
300 validateExchange = validateToxExchange
301 makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
302 makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
303 messageSender q _ = Tox.msgClient q
304 messageResponder _ r = Tox.msgClient r
305
265instance KRPC Tox.Message (Query Tox.Message (Ping Tox.Message)) 306instance KRPC Tox.Message (Query Tox.Message (Ping Tox.Message))
266 (Response Tox.Message (Ping Tox.Message)) where 307 (Response Tox.Message (Ping Tox.Message)) where
267 method = error "TODO method 16" 308 method = Method Tox.Ping
268instance DataHandlers ByteString Tox.Message where 309 validateExchange = validateToxExchange
269 310 makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
270 311 makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
271-- instance Generic (Response Tox.Message (NodeFound Tox.Message IPv4)) where -- TODO 312 messageSender q _ = Tox.msgClient q
313 messageResponder _ r = Tox.msgClient r
314
315instance DataHandlers ByteString Tox.Message
272 316
273instance Default Bool where def = False 317instance Default Bool where def = False
274 318