summaryrefslogtreecommitdiff
path: root/DHTHandlers.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-09-15 03:01:48 -0400
committerjoe <joe@jerkface.net>2017-09-15 03:01:48 -0400
commitde0296e5c8563ea2dc7216142e474eb4e4cb46d6 (patch)
treea5f665a9cbcf68ba8f9d92d63bc0d2aad3a55ee5 /DHTHandlers.hs
parentf9ca5de790ea7d430b70471f476ad7b1823b8c0a (diff)
Removed Obsolete ToxMessage module.
Diffstat (limited to 'DHTHandlers.hs')
-rw-r--r--DHTHandlers.hs57
1 files changed, 53 insertions, 4 deletions
diff --git a/DHTHandlers.hs b/DHTHandlers.hs
index 2857abf3..e2b4ec05 100644
--- a/DHTHandlers.hs
+++ b/DHTHandlers.hs
@@ -1,12 +1,12 @@
1{-# LANGUAGE PatternSynonyms #-} 1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2{-# LANGUAGE TupleSections #-} 2{-# LANGUAGE PatternSynonyms #-}
3{-# LANGUAGE TupleSections #-}
3module DHTHandlers where 4module DHTHandlers where
4 5
5import DHTTransport 6import DHTTransport
6import Network.QueryResponse as QR hiding (Client) 7import Network.QueryResponse as QR hiding (Client)
7import qualified Network.QueryResponse as QR (Client) 8import qualified Network.QueryResponse as QR (Client)
8import ToxCrypto 9import ToxCrypto
9import ToxMessage as Tox (PacketKind(..), pattern PingType, pattern PongType, pattern GetNodesType, pattern SendNodesType, pattern DHTRequestType)
10import Network.BitTorrent.DHT.Search 10import Network.BitTorrent.DHT.Search
11import qualified Data.Wrapper.PSQInt as Int 11import qualified Data.Wrapper.PSQInt as Int
12import Kademlia 12import Kademlia
@@ -28,6 +28,8 @@ import Data.IP
28import Data.Ord 28import Data.Ord
29import Data.Maybe 29import Data.Maybe
30import Data.Bits 30import Data.Bits
31import Data.Serialize (Serialize)
32import Data.Word
31import System.IO 33import System.IO
32 34
33data TransactionId = TransactionId 35data TransactionId = TransactionId
@@ -36,6 +38,53 @@ data TransactionId = TransactionId
36 } 38 }
37 deriving (Eq,Ord,Show) 39 deriving (Eq,Ord,Show)
38 40
41newtype PacketKind = PacketKind Word8
42 deriving (Eq, Ord, Serialize)
43
44pattern OnionRequest0Type = PacketKind 128 -- 0x80 Onion Request 0
45pattern OnionRequest1Type = PacketKind 129 -- 0x81 Onion Request 1
46pattern OnionRequest2Type = PacketKind 130 -- 0x82 Onion Request 2
47pattern AnnounceType = PacketKind 131 -- 0x83 Announce Request
48pattern AnnounceResponseType = PacketKind 132 -- 0x84 Announce Response
49
50pattern DataRequestType = PacketKind 133 -- 0x85 Onion Data Request (data to route request packet)
51pattern DataResponseType = PacketKind 134 -- 0x86 Onion Data Response (data to route response packet)
52-- 0x8c Onion Response 3
53-- 0x8d Onion Response 2
54pattern OnionResponse3Type = PacketKind 140 -- 0x8c Onion Response 3
55pattern OnionResponse2Type = PacketKind 141 -- 0x8d Onion Response 2
56pattern OnionResponse1Type = PacketKind 142 -- 0x8e Onion Response 1
57-- 0xf0 Bootstrap Info
58
59pattern DHTRequestType = PacketKind 32 -- 0x20 DHT Request
60
61pattern CookieRequestType = PacketKind 0x18
62pattern CookieResponseType = PacketKind 0x19
63
64pattern PingType = PacketKind 0 -- 0x00 Ping Request
65pattern PongType = PacketKind 1 -- 0x01 Ping Response
66pattern GetNodesType = PacketKind 2 -- 0x02 Nodes Request
67pattern SendNodesType = PacketKind 4 -- 0x04 Nodes Response
68
69
70instance Show PacketKind where
71 showsPrec d PingType = mappend "PingType"
72 showsPrec d PongType = mappend "PongType"
73 showsPrec d GetNodesType = mappend "GetNodesType"
74 showsPrec d SendNodesType = mappend "SendNodesType"
75 showsPrec d DHTRequestType = mappend "DHTRequestType"
76 showsPrec d OnionRequest0Type = mappend "OnionRequest0Type"
77 showsPrec d OnionResponse1Type = mappend "OnionResponse1Type"
78 showsPrec d OnionResponse3Type = mappend "OnionResponse3Type"
79 showsPrec d AnnounceType = mappend "AnnounceType"
80 showsPrec d AnnounceResponseType = mappend "AnnounceResponseType"
81 showsPrec d DataRequestType = mappend "DataRequestType"
82 showsPrec d DataResponseType = mappend "DataResponseType"
83 showsPrec d CookieRequestType = mappend "CookieRequestType"
84 showsPrec d CookieResponseType = mappend "CookieResponseType"
85 showsPrec d (PacketKind x) = mappend "PacketKind " . showsPrec (d+1) x
86
87
39classify :: Message -> MessageClass String PacketKind TransactionId 88classify :: Message -> MessageClass String PacketKind TransactionId
40classify msg = mapMessage (\nonce24 (nonce8,_) -> go msg (TransactionId nonce8 nonce24)) msg 89classify msg = mapMessage (\nonce24 (nonce8,_) -> go msg (TransactionId nonce8 nonce24)) msg
41 where 90 where
@@ -245,7 +294,7 @@ isGetNodes _ _ = Left "Bad GetNodes"
245mkSendNodes :: TransactionId -> NodeInfo -> NodeInfo -> SendNodes -> DHTMessage ((,) Nonce8) 294mkSendNodes :: TransactionId -> NodeInfo -> NodeInfo -> SendNodes -> DHTMessage ((,) Nonce8)
246mkSendNodes tid src dst sendnodes = DHTSendNodes $ wrapAssym tid src dst (, sendnodes) 295mkSendNodes tid src dst sendnodes = DHTSendNodes $ wrapAssym tid src dst (, sendnodes)
247 296
248handlers :: Routing -> Tox.PacketKind -> Maybe Handler 297handlers :: Routing -> PacketKind -> Maybe Handler
249handlers routing PingType = Just $ MethodHandler (isPing snd) mkPong pingH 298handlers routing PingType = Just $ MethodHandler (isPing snd) mkPong pingH
250handlers routing GetNodesType = Just $ MethodHandler (isGetNodes snd) mkSendNodes $ getNodesH routing 299handlers routing GetNodesType = Just $ MethodHandler (isGetNodes snd) mkSendNodes $ getNodesH routing
251 300