diff options
Diffstat (limited to 'src/Network/BitTorrent/DHT/Message.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT/Message.hs | 100 |
1 files changed, 98 insertions, 2 deletions
diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs index 1f835fa6..44dc9b2f 100644 --- a/src/Network/BitTorrent/DHT/Message.hs +++ b/src/Network/BitTorrent/DHT/Message.hs | |||
@@ -55,6 +55,7 @@ | |||
55 | -- For Kamelia messages see original Kademlia paper: | 55 | -- For Kamelia messages see original Kademlia paper: |
56 | -- <http://pdos.csail.mit.edu/~petar/papers/maymounkov-kademlia-lncs.pdf> | 56 | -- <http://pdos.csail.mit.edu/~petar/papers/maymounkov-kademlia-lncs.pdf> |
57 | -- | 57 | -- |
58 | {-# LANGUAGE CPP #-} | ||
58 | {-# LANGUAGE DeriveDataTypeable #-} | 59 | {-# LANGUAGE DeriveDataTypeable #-} |
59 | {-# LANGUAGE FlexibleInstances #-} | 60 | {-# LANGUAGE FlexibleInstances #-} |
60 | {-# LANGUAGE MultiParamTypeClasses #-} | 61 | {-# LANGUAGE MultiParamTypeClasses #-} |
@@ -73,6 +74,8 @@ module Network.BitTorrent.DHT.Message | |||
73 | , FindNode (..) | 74 | , FindNode (..) |
74 | , NodeFound (..) | 75 | , NodeFound (..) |
75 | 76 | ||
77 | |||
78 | #ifdef VERSION_bencoding | ||
76 | -- ** get_peers | 79 | -- ** get_peers |
77 | , PeerList | 80 | , PeerList |
78 | , GetPeers (..) | 81 | , GetPeers (..) |
@@ -81,12 +84,23 @@ module Network.BitTorrent.DHT.Message | |||
81 | -- ** announce_peer | 84 | -- ** announce_peer |
82 | , Announce (..) | 85 | , Announce (..) |
83 | , Announced (..) | 86 | , Announced (..) |
87 | #endif | ||
84 | ) where | 88 | ) where |
85 | 89 | ||
86 | import Control.Applicative | 90 | import Control.Applicative |
87 | import Data.Bool | 91 | import Data.Bool |
92 | #ifdef VERSION_bencoding | ||
88 | import Data.BEncode as BE | 93 | import Data.BEncode as BE |
89 | import Data.BEncode.BDict as BDict | 94 | import Data.BEncode.BDict as BDict |
95 | import Network.BitTorrent.Address | ||
96 | #else | ||
97 | import qualified Data.Tox as Tox | ||
98 | import Data.Tox (NodeId) | ||
99 | import Data.Word | ||
100 | import Control.Monad | ||
101 | import Network.KRPC.Method | ||
102 | import Network.BitTorrent.Address hiding (NodeId) | ||
103 | #endif | ||
90 | import Data.ByteString (ByteString) | 104 | import Data.ByteString (ByteString) |
91 | import Data.List as L | 105 | import Data.List as L |
92 | import Data.Monoid | 106 | import Data.Monoid |
@@ -97,7 +111,6 @@ import Network.KRPC | |||
97 | import Data.Maybe | 111 | import Data.Maybe |
98 | 112 | ||
99 | import Data.Torrent (InfoHash) | 113 | import Data.Torrent (InfoHash) |
100 | import Network.BitTorrent.Address | ||
101 | import Network.BitTorrent.DHT.Token | 114 | import Network.BitTorrent.DHT.Token |
102 | import Network.KRPC () | 115 | import Network.KRPC () |
103 | 116 | ||
@@ -105,6 +118,10 @@ import Network.KRPC () | |||
105 | -- envelopes | 118 | -- envelopes |
106 | -----------------------------------------------------------------------} | 119 | -----------------------------------------------------------------------} |
107 | 120 | ||
121 | #ifndef VERSION_bencoding | ||
122 | type BKey = ByteString | ||
123 | #endif | ||
124 | |||
108 | node_id_key :: BKey | 125 | node_id_key :: BKey |
109 | node_id_key = "id" | 126 | node_id_key = "id" |
110 | 127 | ||
@@ -112,6 +129,7 @@ read_only_key :: BKey | |||
112 | read_only_key = "ro" | 129 | read_only_key = "ro" |
113 | 130 | ||
114 | 131 | ||
132 | #ifdef VERSION_bencoding | ||
115 | -- | All queries have an \"id\" key and value containing the node ID | 133 | -- | All queries have an \"id\" key and value containing the node ID |
116 | -- of the querying node. | 134 | -- of the querying node. |
117 | data Query a = Query | 135 | data Query a = Query |
@@ -134,7 +152,11 @@ instance BEncode a => BEncode (Query a) where | |||
134 | Query <$> fromDict (field (req node_id_key)) v | 152 | Query <$> fromDict (field (req node_id_key)) v |
135 | <*> fromDict (fromMaybe False <$>? read_only_key) v | 153 | <*> fromDict (fromMaybe False <$>? read_only_key) v |
136 | <*> fromBEncode v | 154 | <*> fromBEncode v |
155 | #else | ||
156 | data Query a = Query a | ||
157 | #endif | ||
137 | 158 | ||
159 | #ifdef VERSION_bencoding | ||
138 | -- | All responses have an \"id\" key and value containing the node ID | 160 | -- | All responses have an \"id\" key and value containing the node ID |
139 | -- of the responding node. | 161 | -- of the responding node. |
140 | data Response a = Response | 162 | data Response a = Response |
@@ -150,7 +172,9 @@ instance BEncode a => BEncode (Response a) where | |||
150 | fromBEncode b = fromQuery <$> fromBEncode b | 172 | fromBEncode b = fromQuery <$> fromBEncode b |
151 | where | 173 | where |
152 | fromQuery (Query nid _ a) = Response nid a | 174 | fromQuery (Query nid _ a) = Response nid a |
153 | 175 | #else | |
176 | data Response a = Response a | ||
177 | #endif | ||
154 | 178 | ||
155 | {----------------------------------------------------------------------- | 179 | {----------------------------------------------------------------------- |
156 | -- ping method | 180 | -- ping method |
@@ -158,16 +182,45 @@ instance BEncode a => BEncode (Response a) where | |||
158 | 182 | ||
159 | -- | The most basic query is a ping. Ping query is used to check if a | 183 | -- | The most basic query is a ping. Ping query is used to check if a |
160 | -- quered node is still alive. | 184 | -- quered node is still alive. |
185 | #ifdef VERSION_bencoding | ||
161 | data Ping = Ping | 186 | data Ping = Ping |
187 | #else | ||
188 | data Ping = Ping Tox.Nonce8 | ||
189 | #endif | ||
162 | deriving (Show, Eq, Typeable) | 190 | deriving (Show, Eq, Typeable) |
163 | 191 | ||
192 | #ifdef VERSION_bencoding | ||
164 | instance BEncode Ping where | 193 | instance BEncode Ping where |
165 | toBEncode Ping = toDict endDict | 194 | toBEncode Ping = toDict endDict |
166 | fromBEncode _ = pure Ping | 195 | fromBEncode _ = pure Ping |
196 | #else | ||
197 | instance Serialize (Query Ping) where | ||
198 | get = do | ||
199 | b <- get | ||
200 | when ( (b::Word8) /= 0) $ fail "Bad ping request" | ||
201 | nonce <- get | ||
202 | return $ Query (Ping nonce) | ||
203 | put (Query (Ping nonce)) = do | ||
204 | put (0 :: Word8) | ||
205 | put nonce | ||
206 | instance Serialize (Response Ping) where | ||
207 | get = do | ||
208 | b <- get | ||
209 | when ( (b::Word8) /= 1) $ fail "Bad ping response" | ||
210 | nonce <- get | ||
211 | return $ Response (Ping nonce) | ||
212 | put (Response (Ping nonce)) = do | ||
213 | put (1 :: Word8) | ||
214 | put nonce | ||
215 | #endif | ||
167 | 216 | ||
168 | -- | \"q\" = \"ping\" | 217 | -- | \"q\" = \"ping\" |
169 | instance KRPC (Query Ping) (Response Ping) where | 218 | instance KRPC (Query Ping) (Response Ping) where |
219 | #ifdef VERSION_bencoding | ||
170 | method = "ping" | 220 | method = "ping" |
221 | #else | ||
222 | method = Method Tox.Ping -- response: Tox.Pong | ||
223 | #endif | ||
171 | 224 | ||
172 | {----------------------------------------------------------------------- | 225 | {----------------------------------------------------------------------- |
173 | -- find_node method | 226 | -- find_node method |
@@ -175,21 +228,41 @@ instance KRPC (Query Ping) (Response Ping) where | |||
175 | 228 | ||
176 | -- | Find node is used to find the contact information for a node | 229 | -- | Find node is used to find the contact information for a node |
177 | -- given its ID. | 230 | -- given its ID. |
231 | #ifdef VERSION_bencoding | ||
178 | newtype FindNode = FindNode NodeId | 232 | newtype FindNode = FindNode NodeId |
233 | #else | ||
234 | data FindNode = FindNode NodeId Tox.Nonce8 -- Tox: Get Nodes | ||
235 | #endif | ||
179 | deriving (Show, Eq, Typeable) | 236 | deriving (Show, Eq, Typeable) |
180 | 237 | ||
181 | target_key :: BKey | 238 | target_key :: BKey |
182 | target_key = "target" | 239 | target_key = "target" |
183 | 240 | ||
241 | #ifdef VERSION_bencoding | ||
184 | instance BEncode FindNode where | 242 | instance BEncode FindNode where |
185 | toBEncode (FindNode nid) = toDict $ target_key .=! nid .: endDict | 243 | toBEncode (FindNode nid) = toDict $ target_key .=! nid .: endDict |
186 | fromBEncode = fromDict $ FindNode <$>! target_key | 244 | fromBEncode = fromDict $ FindNode <$>! target_key |
245 | #else | ||
246 | instance Serialize (Query FindNode) where | ||
247 | get = do | ||
248 | nid <- get | ||
249 | nonce <- get | ||
250 | return $ Query (FindNode nid nonce) | ||
251 | put (Query (FindNode nid nonce)) = do | ||
252 | put nid | ||
253 | put nonce | ||
254 | #endif | ||
187 | 255 | ||
188 | -- | When a node receives a 'FindNode' query, it should respond with a | 256 | -- | When a node receives a 'FindNode' query, it should respond with a |
189 | -- the compact node info for the target node or the K (8) closest good | 257 | -- the compact node info for the target node or the K (8) closest good |
190 | -- nodes in its own routing table. | 258 | -- nodes in its own routing table. |
191 | -- | 259 | -- |
260 | #ifdef VERSION_bencoding | ||
192 | newtype NodeFound ip = NodeFound [NodeInfo ip] | 261 | newtype NodeFound ip = NodeFound [NodeInfo ip] |
262 | #else | ||
263 | data NodeFound ip = NodeFound [Tox.NodeFormat] Tox.Nonce8 | ||
264 | #endif | ||
265 | -- Tox: send_nodes | ||
193 | deriving (Show, Eq, Typeable) | 266 | deriving (Show, Eq, Typeable) |
194 | 267 | ||
195 | nodes_key :: BKey | 268 | nodes_key :: BKey |
@@ -200,6 +273,7 @@ from4 :: forall s. Address s => NodeInfo IPv4 -> Either String (NodeInfo s) | |||
200 | from4 n = maybe (Left "Error converting IPv4") Right | 273 | from4 n = maybe (Left "Error converting IPv4") Right |
201 | $ traverse (fromAddr :: IPv4 -> Maybe s) n | 274 | $ traverse (fromAddr :: IPv4 -> Maybe s) n |
202 | 275 | ||
276 | #ifdef VERSION_bencoding | ||
203 | binary :: Serialize a => BKey -> BE.Get [a] | 277 | binary :: Serialize a => BKey -> BE.Get [a] |
204 | binary k = field (req k) >>= either (fail . format) return . | 278 | binary k = field (req k) >>= either (fail . format) return . |
205 | runGet (many get) | 279 | runGet (many get) |
@@ -213,12 +287,31 @@ instance Address ip => BEncode (NodeFound ip) where | |||
213 | 287 | ||
214 | -- TODO: handle IPv6 by reading the "nodes6" key (see bep 32) | 288 | -- TODO: handle IPv6 by reading the "nodes6" key (see bep 32) |
215 | fromBEncode bval = NodeFound <$> (traverse from4 =<< fromDict (binary nodes_key) bval) | 289 | fromBEncode bval = NodeFound <$> (traverse from4 =<< fromDict (binary nodes_key) bval) |
290 | #else | ||
291 | instance Serialize (Response (NodeFound ip)) where | ||
292 | get = do | ||
293 | count <- get :: Get Word8 | ||
294 | nodes <- sequence $ replicate (fromIntegral count) get | ||
295 | nonce <- get :: Get Tox.Nonce8 | ||
296 | return $ Response $ NodeFound nodes nonce | ||
297 | |||
298 | put (Response (NodeFound nodes nonce)) = do | ||
299 | put (fromIntegral (length nodes) :: Word8) | ||
300 | mapM_ put nodes | ||
301 | put nonce | ||
302 | |||
303 | #endif | ||
216 | 304 | ||
217 | -- | \"q\" == \"find_node\" | 305 | -- | \"q\" == \"find_node\" |
218 | instance (Address ip, Typeable ip) | 306 | instance (Address ip, Typeable ip) |
219 | => KRPC (Query FindNode) (Response (NodeFound ip)) where | 307 | => KRPC (Query FindNode) (Response (NodeFound ip)) where |
308 | #ifdef VERSION_bencoding | ||
220 | method = "find_node" | 309 | method = "find_node" |
310 | #else | ||
311 | method = Method Tox.GetNodes -- response: Tox.SendNodes | ||
312 | #endif | ||
221 | 313 | ||
314 | #ifdef VERSION_bencoding | ||
222 | {----------------------------------------------------------------------- | 315 | {----------------------------------------------------------------------- |
223 | -- get_peers method | 316 | -- get_peers method |
224 | -----------------------------------------------------------------------} | 317 | -----------------------------------------------------------------------} |
@@ -354,3 +447,6 @@ instance BEncode Announced where | |||
354 | -- | \"q" = \"announce\" | 447 | -- | \"q" = \"announce\" |
355 | instance KRPC (Query Announce) (Response Announced) where | 448 | instance KRPC (Query Announce) (Response Announced) where |
356 | method = "announce_peer" | 449 | method = "announce_peer" |
450 | |||
451 | -- endif VERSION_bencoding | ||
452 | #endif | ||