summaryrefslogtreecommitdiff
path: root/examples/dhtd.hs
diff options
context:
space:
mode:
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r--examples/dhtd.hs91
1 files changed, 1 insertions, 90 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index d9b02c41..15db79ea 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -61,6 +61,7 @@ import Control.Concurrent.STM
61import System.Environment 61import System.Environment
62import Data.BEncode (BValue) 62import Data.BEncode (BValue)
63import Network.DHT.Types 63import Network.DHT.Types
64import Network.DHT.Tox
64import Network.DatagramServer.Types 65import Network.DatagramServer.Types
65import Data.Bits 66import Data.Bits
66import Data.Serialize 67import Data.Serialize
@@ -227,96 +228,6 @@ nodeAddrType _ = return ()
227ipType :: f dht ip -> DHT raw dht u ip () 228ipType :: f dht ip -> DHT raw dht u ip ()
228ipType _ = return () 229ipType _ = return ()
229 230
230instance Kademlia Tox.Message where
231 data DHTData Tox.Message ip = ToxData
232 namePing _ = Tox.Ping
233 nameFindNodes _ = Tox.GetNodes
234 initializeDHTData = return ToxData
235
236instance Pretty (NodeId Tox.Message) where
237 pPrint (Tox.NodeId nid) = encodeHexDoc nid
238
239getToxPing isPong c n = do
240 q'r <- get :: Get Word8
241 when (bool 0 1 isPong /= q'r) $
242 fail "Tox ping/pong parse fail."
243 n8 <- get :: Get Tox.Nonce8
244 return $ c (n n8) Ping
245
246putToxPing isPong n8 = do
247 put (bool 0 1 isPong :: Word8)
248 put n8
249
250instance Serialize (Query Tox.Message (Ping Tox.Message)) where
251 get = getToxPing False Network.DHT.Types.Query Tox.QueryNonce
252 put (Network.DHT.Types.Query extra Ping) = putToxPing False (Tox.qryNonce extra)
253instance Serialize (Response Tox.Message (Ping Tox.Message)) where
254 get = getToxPing True Network.DHT.Types.Response Tox.ResponseNonce
255 put (Network.DHT.Types.Response extra Ping) = putToxPing True (Tox.rspNonce extra)
256
257nodeFormatToNodeInfo nf = NodeInfo nid addr u
258 where
259 u = Tox.nodeIsTCP nf
260 addr = NodeAddr (Tox.nodeIP nf) (Tox.nodePort nf)
261 nid = Tox.nodePublicKey nf
262
263instance Serialize (Query Tox.Message (FindNode Tox.Message ip)) where
264 get = do
265 nid <- get
266 n8 <- get
267 return $ Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)
268 put (Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)) = do
269 put nid
270 put n8
271instance Serialize (Response Tox.Message (NodeFound Tox.Message IPv4)) where
272 get = do
273 num <- get :: Get Word8
274 when (num > 4) $ fail "Too many nodes in Tox get-nodes reply"
275 ns0 <- sequence $ replicate (fromIntegral num) (nodeFormatToNodeInfo <$> get)
276 -- TODO: Allow tcp and ipv6. For now filtering to udp ip4...
277 let ns = flip mapMaybe ns0 $ \(NodeInfo nid addr u) -> do
278 guard $ not u
279 ip4 <- fromAddr addr
280 return $ NodeInfo nid ip4 ()
281 n8 <- get
282 return $ Network.DHT.Types.Response (Tox.ResponseNonce n8) $ NodeFound ns
283 put (Network.DHT.Types.Response (Tox.ResponseNonce n8) (NodeFound ns)) = do
284 put ( fromIntegral (length ns) :: Word8 )
285 forM_ ns $ \(NodeInfo nid ip4 ()) -> do
286 put Tox.NodeFormat { nodePublicKey = nid
287 , nodeIsTCP = False
288 , nodeIP = IPv4 (nodeHost ip4)
289 , nodePort = nodePort ip4
290 }
291 put n8
292
293validateToxExchange q r = qnonce == rnonce
294 where
295 qnonce = Tox.qryNonce . queryExtra . Tox.msgPayload $ q
296 rnonce = Tox.rspNonce . responseExtra . Tox.msgPayload $ r
297
298instance KRPC Tox.Message (Query Tox.Message (FindNode Tox.Message IPv4))
299 (Response Tox.Message (NodeFound Tox.Message IPv4)) where
300 method = Method Tox.GetNodes
301 validateExchange = validateToxExchange
302 makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
303 makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
304 messageSender q _ = Tox.msgClient q
305 messageResponder _ r = Tox.msgClient r
306
307instance KRPC Tox.Message (Query Tox.Message (Ping Tox.Message))
308 (Response Tox.Message (Ping Tox.Message)) where
309 method = Method Tox.Ping
310 validateExchange = validateToxExchange
311 makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
312 makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
313 messageSender q _ = Tox.msgClient q
314 messageResponder _ r = Tox.msgClient r
315
316instance DataHandlers ByteString Tox.Message
317
318instance Default Bool where def = False
319
320clientSession :: Node BValue KMessageOf () IPv4 -> Node B.ByteString Tox.Message Bool IPv4 -> MVar () -> Bool -> RestrictedSocket -> Int -> Handle -> IO () 231clientSession :: Node BValue KMessageOf () IPv4 -> Node B.ByteString Tox.Message Bool IPv4 -> MVar () -> Bool -> RestrictedSocket -> Int -> Handle -> IO ()
321clientSession bt tox signalQuit isBt sock n h = do 232clientSession bt tox signalQuit isBt sock n h = do
322 line <- map toLower . dropWhile isSpace <$> hGetLine h 233 line <- map toLower . dropWhile isSpace <$> hGetLine h