diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/dhtd.hs | 66 |
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 | |||
68 | import Data.Typeable | 68 | import Data.Typeable |
69 | import GHC.Generics | 69 | import GHC.Generics |
70 | import Data.Bool | 70 | import Data.Bool |
71 | import System.Random | ||
71 | 72 | ||
72 | mkNodeAddr :: SockAddr -> NodeAddr IPv4 | 73 | mkNodeAddr :: SockAddr -> NodeAddr IPv4 |
73 | mkNodeAddr addr = NodeAddr (fromJust $ fromSockAddr addr) | 74 | mkNodeAddr 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 | ||
255 | instance Serialize (Query Tox.Message (FindNode Tox.Message IPv4)) where | 256 | nodeFormatToNodeInfo 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 | |||
262 | instance 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 | ||
258 | instance Serialize (Response Tox.Message (NodeFound Tox.Message IPv4)) where | 270 | instance 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 | |||
292 | validateToxExchange q r = qnonce == rnonce | ||
293 | where | ||
294 | qnonce = Tox.qryNonce . queryExtra . Tox.msgPayload $ q | ||
295 | rnonce = Tox.rspNonce . responseExtra . Tox.msgPayload $ r | ||
261 | 296 | ||
262 | instance KRPC Tox.Message (Query Tox.Message (FindNode Tox.Message IPv4)) | 297 | instance 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 | |||
265 | instance KRPC Tox.Message (Query Tox.Message (Ping Tox.Message)) | 306 | instance 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 |
268 | instance 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 | |||
315 | instance DataHandlers ByteString Tox.Message | ||
272 | 316 | ||
273 | instance Default Bool where def = False | 317 | instance Default Bool where def = False |
274 | 318 | ||