diff options
Diffstat (limited to 'src')
27 files changed, 1195 insertions, 1297 deletions
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs index 7c56edf7..cfc26453 100644 --- a/src/Data/Torrent.hs +++ b/src/Data/Torrent.hs | |||
@@ -187,7 +187,7 @@ import Text.PrettyPrint.Class | |||
187 | import System.FilePath | 187 | import System.FilePath |
188 | import System.Posix.Types | 188 | import System.Posix.Types |
189 | 189 | ||
190 | import Network.BitTorrent.Core.NodeInfo | 190 | import Network.BitTorrent.Address |
191 | 191 | ||
192 | 192 | ||
193 | {----------------------------------------------------------------------- | 193 | {----------------------------------------------------------------------- |
@@ -836,7 +836,7 @@ data Torrent = Torrent | |||
836 | , tNodes :: !(Maybe [NodeAddr HostName]) | 836 | , tNodes :: !(Maybe [NodeAddr HostName]) |
837 | -- ^ This key should be set to the /K closest/ nodes in the | 837 | -- ^ This key should be set to the /K closest/ nodes in the |
838 | -- torrent generating client's routing table. Alternatively, the | 838 | -- torrent generating client's routing table. Alternatively, the |
839 | -- key could be set to a known good 'Network.BitTorrent.Core.Node' | 839 | -- key could be set to a known good 'Network.BitTorrent.Address.Node' |
840 | -- such as one operated by the person generating the torrent. | 840 | -- such as one operated by the person generating the torrent. |
841 | -- | 841 | -- |
842 | -- Please do not automatically add \"router.bittorrent.com\" to | 842 | -- Please do not automatically add \"router.bittorrent.com\" to |
diff --git a/src/Network/BitTorrent/Address.hs b/src/Network/BitTorrent/Address.hs new file mode 100644 index 00000000..8723433d --- /dev/null +++ b/src/Network/BitTorrent/Address.hs | |||
@@ -0,0 +1,1172 @@ | |||
1 | -- | | ||
2 | -- Module : Network.BitTorrent.Address | ||
3 | -- Copyright : (c) Sam Truzjan 2013 | ||
4 | -- (c) Daniel Gröber 2013 | ||
5 | -- License : BSD3 | ||
6 | -- Maintainer : pxqr.sta@gmail.com | ||
7 | -- Stability : provisional | ||
8 | -- Portability : portable | ||
9 | -- | ||
10 | -- Peer and Node addresses. | ||
11 | -- | ||
12 | {-# LANGUAGE FlexibleInstances #-} | ||
13 | {-# LANGUAGE RecordWildCards #-} | ||
14 | {-# LANGUAGE StandaloneDeriving #-} | ||
15 | {-# LANGUAGE ViewPatterns #-} | ||
16 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
17 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
18 | {-# LANGUAGE DeriveDataTypeable #-} | ||
19 | {-# LANGUAGE DeriveFunctor #-} | ||
20 | {-# LANGUAGE TemplateHaskell #-} | ||
21 | {-# OPTIONS -fno-warn-orphans #-} | ||
22 | module Network.BitTorrent.Address | ||
23 | ( -- * Address | ||
24 | Address (..) | ||
25 | , fromAddr | ||
26 | |||
27 | -- ** IP | ||
28 | , IPv4 | ||
29 | , IPv6 | ||
30 | , IP (..) | ||
31 | |||
32 | -- * PeerId | ||
33 | -- $peer-id | ||
34 | , PeerId | ||
35 | |||
36 | -- ** Generation | ||
37 | , genPeerId | ||
38 | , timestamp | ||
39 | , entropy | ||
40 | |||
41 | -- ** Encoding | ||
42 | , azureusStyle | ||
43 | , shadowStyle | ||
44 | , defaultClientId | ||
45 | , defaultVersionNumber | ||
46 | |||
47 | -- * PeerAddr | ||
48 | -- $peer-addr | ||
49 | , PeerAddr(..) | ||
50 | , defaultPorts | ||
51 | , peerSockAddr | ||
52 | , peerSocket | ||
53 | |||
54 | -- * Node | ||
55 | -- ** Id | ||
56 | , NodeId | ||
57 | , testIdBit | ||
58 | , genNodeId | ||
59 | , NodeDistance | ||
60 | , distance | ||
61 | |||
62 | -- ** Info | ||
63 | , NodeAddr (..) | ||
64 | , NodeInfo (..) | ||
65 | , rank | ||
66 | |||
67 | -- * Fingerprint | ||
68 | -- $fingerprint | ||
69 | , ClientImpl (..) | ||
70 | , Fingerprint (..) | ||
71 | , libFingerprint | ||
72 | , fingerprint | ||
73 | |||
74 | -- * Utils | ||
75 | , libUserAgent | ||
76 | ) where | ||
77 | |||
78 | import Control.Applicative | ||
79 | import Control.Monad | ||
80 | import Data.BEncode as BE | ||
81 | import Data.BEncode as BS | ||
82 | import Data.BEncode.BDict (BKey) | ||
83 | import Data.Bits | ||
84 | import Data.ByteString as BS | ||
85 | import Data.ByteString.Internal as BS | ||
86 | import Data.ByteString.Base16 as Base16 | ||
87 | import Data.ByteString.Char8 as BC | ||
88 | import Data.ByteString.Char8 as BS8 | ||
89 | import qualified Data.ByteString.Lazy as BL | ||
90 | import qualified Data.ByteString.Lazy.Builder as BS | ||
91 | import Data.Char | ||
92 | import Data.Convertible | ||
93 | import Data.Default | ||
94 | import Data.Foldable | ||
95 | import Data.IP | ||
96 | import Data.List as L | ||
97 | import Data.List.Split as L | ||
98 | import Data.Maybe (fromMaybe, catMaybes) | ||
99 | import Data.Monoid | ||
100 | import Data.Hashable | ||
101 | import Data.Ord | ||
102 | import Data.Serialize as S | ||
103 | import Data.String | ||
104 | import Data.Time | ||
105 | import Data.Typeable | ||
106 | import Data.Version | ||
107 | import Data.Word | ||
108 | import qualified Text.ParserCombinators.ReadP as RP | ||
109 | import Text.Read (readMaybe) | ||
110 | import Network.HTTP.Types.QueryLike | ||
111 | import Network.Socket | ||
112 | import Text.PrettyPrint as PP hiding ((<>)) | ||
113 | import Text.PrettyPrint.Class | ||
114 | import System.Locale (defaultTimeLocale) | ||
115 | import System.Entropy | ||
116 | |||
117 | -- import Paths_bittorrent (version) | ||
118 | |||
119 | {----------------------------------------------------------------------- | ||
120 | -- Address | ||
121 | -----------------------------------------------------------------------} | ||
122 | |||
123 | instance Pretty UTCTime where | ||
124 | pretty = PP.text . show | ||
125 | |||
126 | class (Eq a, Serialize a, Typeable a, Hashable a, Pretty a) | ||
127 | => Address a where | ||
128 | toSockAddr :: a -> SockAddr | ||
129 | fromSockAddr :: SockAddr -> Maybe a | ||
130 | |||
131 | fromAddr :: (Address a, Address b) => a -> Maybe b | ||
132 | fromAddr = fromSockAddr . toSockAddr | ||
133 | |||
134 | -- | Note that port is zeroed. | ||
135 | instance Address IPv4 where | ||
136 | toSockAddr = SockAddrInet 0 . toHostAddress | ||
137 | fromSockAddr (SockAddrInet _ h) = Just (fromHostAddress h) | ||
138 | fromSockAddr _ = Nothing | ||
139 | |||
140 | -- | Note that port is zeroed. | ||
141 | instance Address IPv6 where | ||
142 | toSockAddr h = SockAddrInet6 0 0 (toHostAddress6 h) 0 | ||
143 | fromSockAddr (SockAddrInet6 _ _ h _) = Just (fromHostAddress6 h) | ||
144 | fromSockAddr _ = Nothing | ||
145 | |||
146 | -- | Note that port is zeroed. | ||
147 | instance Address IP where | ||
148 | toSockAddr (IPv4 h) = toSockAddr h | ||
149 | toSockAddr (IPv6 h) = toSockAddr h | ||
150 | fromSockAddr sa = | ||
151 | IPv4 <$> fromSockAddr sa | ||
152 | <|> IPv6 <$> fromSockAddr sa | ||
153 | |||
154 | setPort :: PortNumber -> SockAddr -> SockAddr | ||
155 | setPort port (SockAddrInet _ h ) = SockAddrInet port h | ||
156 | setPort port (SockAddrInet6 _ f h s) = SockAddrInet6 port f h s | ||
157 | setPort _ (SockAddrUnix s ) = SockAddrUnix s | ||
158 | {-# INLINE setPort #-} | ||
159 | |||
160 | getPort :: SockAddr -> Maybe PortNumber | ||
161 | getPort (SockAddrInet p _ ) = Just p | ||
162 | getPort (SockAddrInet6 p _ _ _) = Just p | ||
163 | getPort (SockAddrUnix _ ) = Nothing | ||
164 | {-# INLINE getPort #-} | ||
165 | |||
166 | instance Address a => Address (NodeAddr a) where | ||
167 | toSockAddr NodeAddr {..} = setPort nodePort $ toSockAddr nodeHost | ||
168 | fromSockAddr sa = NodeAddr <$> fromSockAddr sa <*> getPort sa | ||
169 | |||
170 | instance Address a => Address (PeerAddr a) where | ||
171 | toSockAddr PeerAddr {..} = setPort peerPort $ toSockAddr peerHost | ||
172 | fromSockAddr sa = PeerAddr Nothing <$> fromSockAddr sa <*> getPort sa | ||
173 | |||
174 | {----------------------------------------------------------------------- | ||
175 | -- Peer id | ||
176 | -----------------------------------------------------------------------} | ||
177 | -- $peer-id | ||
178 | -- | ||
179 | -- 'PeerID' represent self assigned peer identificator. Ideally each | ||
180 | -- host in the network should have unique peer id to avoid | ||
181 | -- collisions, therefore for peer ID generation we use good entropy | ||
182 | -- source. Peer ID is sent in /tracker request/, sent and received in | ||
183 | -- /peer handshakes/ and used in DHT queries. | ||
184 | -- | ||
185 | |||
186 | -- TODO use unpacked Word160 form (length is known statically) | ||
187 | |||
188 | -- | Peer identifier is exactly 20 bytes long bytestring. | ||
189 | newtype PeerId = PeerId { getPeerId :: ByteString } | ||
190 | deriving (Show, Eq, Ord, BEncode, Typeable) | ||
191 | |||
192 | peerIdLen :: Int | ||
193 | peerIdLen = 20 | ||
194 | |||
195 | -- | For testing purposes only. | ||
196 | instance Default PeerId where | ||
197 | def = azureusStyle defaultClientId defaultVersionNumber "" | ||
198 | |||
199 | instance Hashable PeerId where | ||
200 | hashWithSalt = hashUsing getPeerId | ||
201 | {-# INLINE hashWithSalt #-} | ||
202 | |||
203 | instance Serialize PeerId where | ||
204 | put = putByteString . getPeerId | ||
205 | get = PeerId <$> getBytes peerIdLen | ||
206 | |||
207 | instance QueryValueLike PeerId where | ||
208 | toQueryValue (PeerId pid) = Just pid | ||
209 | {-# INLINE toQueryValue #-} | ||
210 | |||
211 | instance IsString PeerId where | ||
212 | fromString str | ||
213 | | BS.length bs == peerIdLen = PeerId bs | ||
214 | | otherwise = error $ "Peer id should be 20 bytes long: " ++ show str | ||
215 | where | ||
216 | bs = fromString str | ||
217 | |||
218 | instance Pretty PeerId where | ||
219 | pretty = text . BC.unpack . getPeerId | ||
220 | |||
221 | instance Convertible BS.ByteString PeerId where | ||
222 | safeConvert bs | ||
223 | | BS.length bs == peerIdLen = pure (PeerId bs) | ||
224 | | otherwise = convError "invalid length" bs | ||
225 | |||
226 | ------------------------------------------------------------------------ | ||
227 | |||
228 | -- | Pad bytestring so it's becomes exactly request length. Conversion | ||
229 | -- is done like so: | ||
230 | -- | ||
231 | -- * length < size: Complete bytestring by given charaters. | ||
232 | -- | ||
233 | -- * length = size: Output bytestring as is. | ||
234 | -- | ||
235 | -- * length > size: Drop last (length - size) charaters from a | ||
236 | -- given bytestring. | ||
237 | -- | ||
238 | byteStringPadded :: ByteString -- ^ bytestring to be padded. | ||
239 | -> Int -- ^ size of result builder. | ||
240 | -> Char -- ^ character used for padding. | ||
241 | -> BS.Builder | ||
242 | byteStringPadded bs s c = | ||
243 | BS.byteString (BS.take s bs) <> | ||
244 | BS.byteString (BC.replicate padLen c) | ||
245 | where | ||
246 | padLen = s - min (BS.length bs) s | ||
247 | |||
248 | -- | Azureus-style encoding have the following layout: | ||
249 | -- | ||
250 | -- * 1 byte : '-' | ||
251 | -- | ||
252 | -- * 2 bytes: client id | ||
253 | -- | ||
254 | -- * 4 bytes: version number | ||
255 | -- | ||
256 | -- * 1 byte : '-' | ||
257 | -- | ||
258 | -- * 12 bytes: random number | ||
259 | -- | ||
260 | azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'. | ||
261 | -> ByteString -- ^ Version number, padded with 'X'. | ||
262 | -> ByteString -- ^ Random number, padded with '0'. | ||
263 | -> PeerId -- ^ Azureus-style encoded peer ID. | ||
264 | azureusStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $ | ||
265 | BS.char8 '-' <> | ||
266 | byteStringPadded cid 2 'H' <> | ||
267 | byteStringPadded ver 4 'X' <> | ||
268 | BS.char8 '-' <> | ||
269 | byteStringPadded rnd 12 '0' | ||
270 | |||
271 | -- | Shadow-style encoding have the following layout: | ||
272 | -- | ||
273 | -- * 1 byte : client id. | ||
274 | -- | ||
275 | -- * 0-4 bytes: version number. If less than 4 then padded with | ||
276 | -- '-' char. | ||
277 | -- | ||
278 | -- * 15 bytes : random number. If length is less than 15 then | ||
279 | -- padded with '0' char. | ||
280 | -- | ||
281 | shadowStyle :: Char -- ^ Client ID. | ||
282 | -> ByteString -- ^ Version number. | ||
283 | -> ByteString -- ^ Random number. | ||
284 | -> PeerId -- ^ Shadow style encoded peer ID. | ||
285 | shadowStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $ | ||
286 | BS.char8 cid <> | ||
287 | byteStringPadded ver 4 '-' <> | ||
288 | byteStringPadded rnd 15 '0' | ||
289 | |||
290 | |||
291 | -- | 'HS'- 2 bytes long client identifier. | ||
292 | defaultClientId :: ByteString | ||
293 | defaultClientId = "HS" | ||
294 | |||
295 | -- | Gives exactly 4 bytes long version number for any version of the | ||
296 | -- package. Version is taken from .cabal file. | ||
297 | defaultVersionNumber :: ByteString | ||
298 | defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $ | ||
299 | versionBranch $ ciVersion libFingerprint | ||
300 | |||
301 | ------------------------------------------------------------------------ | ||
302 | |||
303 | -- | Gives 15 characters long decimal timestamp such that: | ||
304 | -- | ||
305 | -- * 6 bytes : first 6 characters from picoseconds obtained with %q. | ||
306 | -- | ||
307 | -- * 1 byte : character \'.\' for readability. | ||
308 | -- | ||
309 | -- * 9..* bytes: number of whole seconds since the Unix epoch | ||
310 | -- (!)REVERSED. | ||
311 | -- | ||
312 | -- Can be used both with shadow and azureus style encoding. This | ||
313 | -- format is used to make the ID's readable for debugging purposes. | ||
314 | -- | ||
315 | timestamp :: IO ByteString | ||
316 | timestamp = (BC.pack . format) <$> getCurrentTime | ||
317 | where | ||
318 | format t = L.take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++ | ||
319 | L.take 9 (L.reverse (formatTime defaultTimeLocale "%s" t)) | ||
320 | |||
321 | -- | Gives 15 character long random bytestring. This is more robust | ||
322 | -- method for generation of random part of peer ID than 'timestamp'. | ||
323 | entropy :: IO ByteString | ||
324 | entropy = getEntropy 15 | ||
325 | |||
326 | -- NOTE: entropy generates incorrrect peer id | ||
327 | |||
328 | -- | Here we use 'azureusStyle' encoding with the following args: | ||
329 | -- | ||
330 | -- * 'HS' for the client id; ('defaultClientId') | ||
331 | -- | ||
332 | -- * Version of the package for the version number; | ||
333 | -- ('defaultVersionNumber') | ||
334 | -- | ||
335 | -- * UTC time day ++ day time for the random number. ('timestamp') | ||
336 | -- | ||
337 | genPeerId :: IO PeerId | ||
338 | genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp | ||
339 | |||
340 | {----------------------------------------------------------------------- | ||
341 | -- Peer Addr | ||
342 | -----------------------------------------------------------------------} | ||
343 | -- $peer-addr | ||
344 | -- | ||
345 | -- 'PeerAddr' is used to represent peer address. Currently it's | ||
346 | -- just peer IP and peer port but this might change in future. | ||
347 | -- | ||
348 | |||
349 | {----------------------------------------------------------------------- | ||
350 | -- Port number | ||
351 | -----------------------------------------------------------------------} | ||
352 | |||
353 | instance BEncode PortNumber where | ||
354 | toBEncode = toBEncode . fromEnum | ||
355 | fromBEncode = fromBEncode >=> portNumber | ||
356 | where | ||
357 | portNumber :: Integer -> BS.Result PortNumber | ||
358 | portNumber n | ||
359 | | 0 <= n && n <= fromIntegral (maxBound :: Word16) | ||
360 | = pure $ fromIntegral n | ||
361 | | otherwise = decodingError $ "PortNumber: " ++ show n | ||
362 | |||
363 | instance Serialize PortNumber where | ||
364 | get = fromIntegral <$> getWord16be | ||
365 | {-# INLINE get #-} | ||
366 | put = putWord16be . fromIntegral | ||
367 | {-# INLINE put #-} | ||
368 | |||
369 | instance Hashable PortNumber where | ||
370 | hashWithSalt s = hashWithSalt s . fromEnum | ||
371 | {-# INLINE hashWithSalt #-} | ||
372 | |||
373 | instance Pretty PortNumber where | ||
374 | pretty = PP.int . fromEnum | ||
375 | {-# INLINE pretty #-} | ||
376 | |||
377 | {----------------------------------------------------------------------- | ||
378 | -- IP addr | ||
379 | -----------------------------------------------------------------------} | ||
380 | |||
381 | class IPAddress i where | ||
382 | toHostAddr :: i -> Either HostAddress HostAddress6 | ||
383 | |||
384 | instance IPAddress IPv4 where | ||
385 | toHostAddr = Left . toHostAddress | ||
386 | {-# INLINE toHostAddr #-} | ||
387 | |||
388 | instance IPAddress IPv6 where | ||
389 | toHostAddr = Right . toHostAddress6 | ||
390 | {-# INLINE toHostAddr #-} | ||
391 | |||
392 | instance IPAddress IP where | ||
393 | toHostAddr (IPv4 ip) = toHostAddr ip | ||
394 | toHostAddr (IPv6 ip) = toHostAddr ip | ||
395 | {-# INLINE toHostAddr #-} | ||
396 | |||
397 | deriving instance Typeable IP | ||
398 | deriving instance Typeable IPv4 | ||
399 | deriving instance Typeable IPv6 | ||
400 | |||
401 | ipToBEncode :: Show i => i -> BValue | ||
402 | ipToBEncode ip = BString $ BS8.pack $ show ip | ||
403 | {-# INLINE ipToBEncode #-} | ||
404 | |||
405 | ipFromBEncode :: Read a => BValue -> BS.Result a | ||
406 | ipFromBEncode (BString (BS8.unpack -> ipStr)) | ||
407 | | Just ip <- readMaybe (ipStr) = pure ip | ||
408 | | otherwise = decodingError $ "IP: " ++ ipStr | ||
409 | ipFromBEncode _ = decodingError $ "IP: addr should be a bstring" | ||
410 | |||
411 | instance BEncode IP where | ||
412 | toBEncode = ipToBEncode | ||
413 | {-# INLINE toBEncode #-} | ||
414 | fromBEncode = ipFromBEncode | ||
415 | {-# INLINE fromBEncode #-} | ||
416 | |||
417 | instance BEncode IPv4 where | ||
418 | toBEncode = ipToBEncode | ||
419 | {-# INLINE toBEncode #-} | ||
420 | fromBEncode = ipFromBEncode | ||
421 | {-# INLINE fromBEncode #-} | ||
422 | |||
423 | instance BEncode IPv6 where | ||
424 | toBEncode = ipToBEncode | ||
425 | {-# INLINE toBEncode #-} | ||
426 | fromBEncode = ipFromBEncode | ||
427 | {-# INLINE fromBEncode #-} | ||
428 | |||
429 | -- | When 'get'ing an IP it must be 'isolate'd to the appropriate | ||
430 | -- number of bytes since we have no other way of telling which | ||
431 | -- address type we are trying to parse | ||
432 | instance Serialize IP where | ||
433 | put (IPv4 ip) = put ip | ||
434 | put (IPv6 ip) = put ip | ||
435 | |||
436 | get = do | ||
437 | n <- remaining | ||
438 | case n of | ||
439 | 4 -> IPv4 <$> get | ||
440 | 16 -> IPv6 <$> get | ||
441 | _ -> fail "Wrong number of bytes remaining to parse IP" | ||
442 | |||
443 | instance Serialize IPv4 where | ||
444 | put = putWord32host . toHostAddress | ||
445 | get = fromHostAddress <$> getWord32host | ||
446 | |||
447 | instance Serialize IPv6 where | ||
448 | put ip = put $ toHostAddress6 ip | ||
449 | get = fromHostAddress6 <$> get | ||
450 | |||
451 | instance Pretty IPv4 where | ||
452 | pretty = PP.text . show | ||
453 | {-# INLINE pretty #-} | ||
454 | |||
455 | instance Pretty IPv6 where | ||
456 | pretty = PP.text . show | ||
457 | {-# INLINE pretty #-} | ||
458 | |||
459 | instance Pretty IP where | ||
460 | pretty = PP.text . show | ||
461 | {-# INLINE pretty #-} | ||
462 | |||
463 | instance Hashable IPv4 where | ||
464 | hashWithSalt = hashUsing toHostAddress | ||
465 | {-# INLINE hashWithSalt #-} | ||
466 | |||
467 | instance Hashable IPv6 where | ||
468 | hashWithSalt s a = hashWithSalt s (toHostAddress6 a) | ||
469 | |||
470 | instance Hashable IP where | ||
471 | hashWithSalt s (IPv4 h) = hashWithSalt s h | ||
472 | hashWithSalt s (IPv6 h) = hashWithSalt s h | ||
473 | |||
474 | {----------------------------------------------------------------------- | ||
475 | -- Peer addr | ||
476 | -----------------------------------------------------------------------} | ||
477 | -- TODO check semantic of ord and eq instances | ||
478 | |||
479 | -- | Peer address info normally extracted from peer list or peer | ||
480 | -- compact list encoding. | ||
481 | data PeerAddr a = PeerAddr | ||
482 | { peerId :: !(Maybe PeerId) | ||
483 | |||
484 | -- | This is usually 'IPv4', 'IPv6', 'IP' or unresolved | ||
485 | -- 'HostName'. | ||
486 | , peerHost :: !a | ||
487 | |||
488 | -- | The port the peer listenning for incoming P2P sessions. | ||
489 | , peerPort :: {-# UNPACK #-} !PortNumber | ||
490 | } deriving (Show, Eq, Ord, Typeable, Functor) | ||
491 | |||
492 | peer_ip_key, peer_id_key, peer_port_key :: BKey | ||
493 | peer_ip_key = "ip" | ||
494 | peer_id_key = "peer id" | ||
495 | peer_port_key = "port" | ||
496 | |||
497 | -- | The tracker's 'announce response' compatible encoding. | ||
498 | instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where | ||
499 | toBEncode PeerAddr {..} = toDict $ | ||
500 | peer_ip_key .=! peerHost | ||
501 | .: peer_id_key .=? peerId | ||
502 | .: peer_port_key .=! peerPort | ||
503 | .: endDict | ||
504 | |||
505 | fromBEncode = fromDict $ do | ||
506 | peerAddr <$>! peer_ip_key | ||
507 | <*>? peer_id_key | ||
508 | <*>! peer_port_key | ||
509 | where | ||
510 | peerAddr = flip PeerAddr | ||
511 | |||
512 | -- | The tracker's 'compact peer list' compatible encoding. The | ||
513 | -- 'peerId' is always 'Nothing'. | ||
514 | -- | ||
515 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | ||
516 | -- | ||
517 | -- TODO: test byte order | ||
518 | instance (Serialize a) => Serialize (PeerAddr a) where | ||
519 | put PeerAddr {..} = put peerHost >> put peerPort | ||
520 | get = PeerAddr Nothing <$> get <*> get | ||
521 | |||
522 | -- | @127.0.0.1:6881@ | ||
523 | instance Default (PeerAddr IPv4) where | ||
524 | def = "127.0.0.1:6881" | ||
525 | |||
526 | -- | @127.0.0.1:6881@ | ||
527 | instance Default (PeerAddr IP) where | ||
528 | def = IPv4 <$> def | ||
529 | |||
530 | -- | Example: | ||
531 | -- | ||
532 | -- @peerPort \"127.0.0.1:6881\" == 6881@ | ||
533 | -- | ||
534 | instance IsString (PeerAddr IPv4) where | ||
535 | fromString str | ||
536 | | [hostAddrStr, portStr] <- splitWhen (== ':') str | ||
537 | , Just hostAddr <- readMaybe hostAddrStr | ||
538 | , Just portNum <- toEnum <$> readMaybe portStr | ||
539 | = PeerAddr Nothing hostAddr portNum | ||
540 | | otherwise = error $ "fromString: unable to parse (PeerAddr IPv4): " ++ str | ||
541 | |||
542 | instance Read (PeerAddr IPv4) where | ||
543 | readsPrec i = RP.readP_to_S $ do | ||
544 | ipv4 <- RP.readS_to_P (readsPrec i) | ||
545 | _ <- RP.char ':' | ||
546 | port <- toEnum <$> RP.readS_to_P (readsPrec i) | ||
547 | return $ PeerAddr Nothing ipv4 port | ||
548 | |||
549 | readsIPv6_port :: String -> [((IPv6, PortNumber), String)] | ||
550 | readsIPv6_port = RP.readP_to_S $ do | ||
551 | ip <- RP.char '[' *> (RP.readS_to_P reads) <* RP.char ']' | ||
552 | _ <- RP.char ':' | ||
553 | port <- toEnum <$> read <$> (RP.many1 $ RP.satisfy isDigit) <* RP.eof | ||
554 | return (ip,port) | ||
555 | |||
556 | instance IsString (PeerAddr IPv6) where | ||
557 | fromString str | ||
558 | | [((ip,port),"")] <- readsIPv6_port str = | ||
559 | PeerAddr Nothing ip port | ||
560 | | otherwise = error $ "fromString: unable to parse (PeerAddr IPv6): " ++ str | ||
561 | |||
562 | instance IsString (PeerAddr IP) where | ||
563 | fromString str | ||
564 | | '[' `L.elem` str = IPv6 <$> fromString str | ||
565 | | otherwise = IPv4 <$> fromString str | ||
566 | |||
567 | -- | fingerprint + "at" + dotted.host.inet.addr:port | ||
568 | -- TODO: instances for IPv6, HostName | ||
569 | instance Pretty a => Pretty (PeerAddr a) where | ||
570 | pretty PeerAddr {..} | ||
571 | | Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr | ||
572 | | otherwise = paddr | ||
573 | where | ||
574 | paddr = pretty peerHost <> ":" <> text (show peerPort) | ||
575 | |||
576 | instance Hashable a => Hashable (PeerAddr a) where | ||
577 | hashWithSalt s PeerAddr {..} = | ||
578 | s `hashWithSalt` peerId `hashWithSalt` peerHost `hashWithSalt` peerPort | ||
579 | |||
580 | -- | Ports typically reserved for bittorrent P2P listener. | ||
581 | defaultPorts :: [PortNumber] | ||
582 | defaultPorts = [6881..6889] | ||
583 | |||
584 | _resolvePeerAddr :: (IPAddress i) => PeerAddr HostName -> PeerAddr i | ||
585 | _resolvePeerAddr = undefined | ||
586 | |||
587 | _peerSockAddr :: PeerAddr IP -> (Family, SockAddr) | ||
588 | _peerSockAddr PeerAddr {..} = | ||
589 | case peerHost of | ||
590 | IPv4 ipv4 -> | ||
591 | (AF_INET, SockAddrInet peerPort (toHostAddress ipv4)) | ||
592 | IPv6 ipv6 -> | ||
593 | (AF_INET6, SockAddrInet6 peerPort 0 (toHostAddress6 ipv6) 0) | ||
594 | |||
595 | peerSockAddr :: PeerAddr IP -> SockAddr | ||
596 | peerSockAddr = snd . _peerSockAddr | ||
597 | |||
598 | -- | Create a socket connected to the address specified in a peerAddr | ||
599 | peerSocket :: SocketType -> PeerAddr IP -> IO Socket | ||
600 | peerSocket socketType pa = do | ||
601 | let (family, addr) = _peerSockAddr pa | ||
602 | sock <- socket family socketType defaultProtocol | ||
603 | connect sock addr | ||
604 | return sock | ||
605 | |||
606 | {----------------------------------------------------------------------- | ||
607 | -- Node info | ||
608 | -----------------------------------------------------------------------} | ||
609 | -- $node-info | ||
610 | -- | ||
611 | -- A \"node\" is a client\/server listening on a UDP port | ||
612 | -- implementing the distributed hash table protocol. The DHT is | ||
613 | -- composed of nodes and stores the location of peers. BitTorrent | ||
614 | -- clients include a DHT node, which is used to contact other nodes | ||
615 | -- in the DHT to get the location of peers to download from using | ||
616 | -- the BitTorrent protocol. | ||
617 | |||
618 | -- TODO more compact representation ('ShortByteString's?) | ||
619 | |||
620 | -- | Each node has a globally unique identifier known as the \"node | ||
621 | -- ID.\" | ||
622 | -- | ||
623 | -- Normally, /this/ node id should be saved between invocations | ||
624 | -- of the client software. | ||
625 | newtype NodeId = NodeId ByteString | ||
626 | deriving (Show, Eq, Ord, BEncode, Typeable) | ||
627 | |||
628 | nodeIdSize :: Int | ||
629 | nodeIdSize = 20 | ||
630 | |||
631 | -- | Meaningless node id, for testing purposes only. | ||
632 | instance Default NodeId where | ||
633 | def = NodeId (BS.replicate nodeIdSize 0) | ||
634 | |||
635 | instance Serialize NodeId where | ||
636 | get = NodeId <$> getByteString nodeIdSize | ||
637 | {-# INLINE get #-} | ||
638 | put (NodeId bs) = putByteString bs | ||
639 | {-# INLINE put #-} | ||
640 | |||
641 | -- | ASCII encoded. | ||
642 | instance IsString NodeId where | ||
643 | fromString str | ||
644 | | L.length str == nodeIdSize = NodeId (fromString str) | ||
645 | | otherwise = error "fromString: invalid NodeId length" | ||
646 | {-# INLINE fromString #-} | ||
647 | |||
648 | -- | base16 encoded. | ||
649 | instance Pretty NodeId where | ||
650 | pretty (NodeId nid) = PP.text $ BC.unpack $ Base16.encode nid | ||
651 | |||
652 | -- | Test if the nth bit is set. | ||
653 | testIdBit :: NodeId -> Word -> Bool | ||
654 | testIdBit (NodeId bs) i | ||
655 | | fromIntegral i < nodeIdSize * 8 | ||
656 | , (q, r) <- quotRem (fromIntegral i) 8 | ||
657 | = testBit (BS.index bs q) r | ||
658 | | otherwise = False | ||
659 | {-# INLINE testIdBit #-} | ||
660 | |||
661 | -- TODO WARN is the 'system' random suitable for this? | ||
662 | -- | Generate random NodeID used for the entire session. | ||
663 | -- Distribution of ID's should be as uniform as possible. | ||
664 | -- | ||
665 | genNodeId :: IO NodeId | ||
666 | genNodeId = NodeId <$> getEntropy nodeIdSize | ||
667 | |||
668 | ------------------------------------------------------------------------ | ||
669 | |||
670 | -- | In Kademlia, the distance metric is XOR and the result is | ||
671 | -- interpreted as an unsigned integer. | ||
672 | newtype NodeDistance = NodeDistance BS.ByteString | ||
673 | deriving (Eq, Ord) | ||
674 | |||
675 | instance Pretty NodeDistance where | ||
676 | pretty (NodeDistance bs) = foldMap bitseq $ BS.unpack bs | ||
677 | where | ||
678 | listBits w = L.map (testBit w) (L.reverse [0..bitSize w - 1]) | ||
679 | bitseq = foldMap (int . fromEnum) . listBits | ||
680 | |||
681 | -- | distance(A,B) = |A xor B| Smaller values are closer. | ||
682 | distance :: NodeId -> NodeId -> NodeDistance | ||
683 | distance (NodeId a) (NodeId b) = NodeDistance (BS.pack (BS.zipWith xor a b)) | ||
684 | |||
685 | ------------------------------------------------------------------------ | ||
686 | |||
687 | data NodeAddr a = NodeAddr | ||
688 | { nodeHost :: !a | ||
689 | , nodePort :: {-# UNPACK #-} !PortNumber | ||
690 | } deriving (Eq, Typeable, Functor) | ||
691 | |||
692 | instance Show a => Show (NodeAddr a) where | ||
693 | showsPrec i NodeAddr {..} | ||
694 | = showsPrec i nodeHost <> showString ":" <> showsPrec i nodePort | ||
695 | |||
696 | instance Read (NodeAddr IPv4) where | ||
697 | readsPrec i x = [ (fromPeerAddr a, s) | (a, s) <- readsPrec i x ] | ||
698 | |||
699 | -- | @127.0.0.1:6882@ | ||
700 | instance Default (NodeAddr IPv4) where | ||
701 | def = "127.0.0.1:6882" | ||
702 | |||
703 | -- | KRPC compatible encoding. | ||
704 | instance Serialize a => Serialize (NodeAddr a) where | ||
705 | get = NodeAddr <$> get <*> get | ||
706 | {-# INLINE get #-} | ||
707 | put NodeAddr {..} = put nodeHost >> put nodePort | ||
708 | {-# INLINE put #-} | ||
709 | |||
710 | -- | Torrent file compatible encoding. | ||
711 | instance BEncode a => BEncode (NodeAddr a) where | ||
712 | toBEncode NodeAddr {..} = toBEncode (nodeHost, nodePort) | ||
713 | {-# INLINE toBEncode #-} | ||
714 | fromBEncode b = uncurry NodeAddr <$> fromBEncode b | ||
715 | {-# INLINE fromBEncode #-} | ||
716 | |||
717 | instance Hashable a => Hashable (NodeAddr a) where | ||
718 | hashWithSalt s NodeAddr {..} = hashWithSalt s (nodeHost, nodePort) | ||
719 | {-# INLINE hashWithSalt #-} | ||
720 | |||
721 | instance Pretty ip => Pretty (NodeAddr ip) where | ||
722 | pretty NodeAddr {..} = pretty nodeHost <> ":" <> pretty nodePort | ||
723 | |||
724 | -- | Example: | ||
725 | -- | ||
726 | -- @nodePort \"127.0.0.1:6881\" == 6881@ | ||
727 | -- | ||
728 | instance IsString (NodeAddr IPv4) where | ||
729 | fromString = fromPeerAddr . fromString | ||
730 | |||
731 | fromPeerAddr :: PeerAddr a -> NodeAddr a | ||
732 | fromPeerAddr PeerAddr {..} = NodeAddr | ||
733 | { nodeHost = peerHost | ||
734 | , nodePort = peerPort | ||
735 | } | ||
736 | |||
737 | ------------------------------------------------------------------------ | ||
738 | |||
739 | data NodeInfo a = NodeInfo | ||
740 | { nodeId :: !NodeId | ||
741 | , nodeAddr :: !(NodeAddr a) | ||
742 | } deriving (Show, Eq, Functor) | ||
743 | |||
744 | instance Eq a => Ord (NodeInfo a) where | ||
745 | compare = comparing nodeId | ||
746 | |||
747 | -- | KRPC 'compact list' compatible encoding: contact information for | ||
748 | -- nodes is encoded as a 26-byte string. Also known as "Compact node | ||
749 | -- info" the 20-byte Node ID in network byte order has the compact | ||
750 | -- IP-address/port info concatenated to the end. | ||
751 | instance Serialize a => Serialize (NodeInfo a) where | ||
752 | get = NodeInfo <$> get <*> get | ||
753 | put NodeInfo {..} = put nodeId >> put nodeAddr | ||
754 | |||
755 | instance Pretty ip => Pretty (NodeInfo ip) where | ||
756 | pretty NodeInfo {..} = pretty nodeId <> "@(" <> pretty nodeAddr <> ")" | ||
757 | |||
758 | instance Pretty ip => Pretty [NodeInfo ip] where | ||
759 | pretty = PP.vcat . PP.punctuate "," . L.map pretty | ||
760 | |||
761 | -- | Order by closeness: nearest nodes first. | ||
762 | rank :: Eq ip => NodeId -> [NodeInfo ip] -> [NodeInfo ip] | ||
763 | rank nid = L.sortBy (comparing (distance nid . nodeId)) | ||
764 | |||
765 | {----------------------------------------------------------------------- | ||
766 | -- Fingerprint | ||
767 | -----------------------------------------------------------------------} | ||
768 | -- $fingerprint | ||
769 | -- | ||
770 | -- 'Fingerprint' is used to identify the client implementation and | ||
771 | -- version which also contained in 'Peer'. For exsample first 6 | ||
772 | -- bytes of peer id of this this library are @-HS0100-@ while for | ||
773 | -- mainline we have @M4-3-6--@. We could extract this info and | ||
774 | -- print in human-friendly form: this is useful for debugging and | ||
775 | -- logging. | ||
776 | -- | ||
777 | -- For more information see: | ||
778 | -- <http://bittorrent.org/beps/bep_0020.html> | ||
779 | -- | ||
780 | -- | ||
781 | -- NOTE: Do /not/ use this information to control client | ||
782 | -- capabilities (such as supported enchancements), this should be | ||
783 | -- done using 'Network.BitTorrent.Extension'! | ||
784 | -- | ||
785 | |||
786 | -- TODO FIXME | ||
787 | version :: Version | ||
788 | version = Version [0, 0, 0, 3] [] | ||
789 | |||
790 | -- | List of registered client versions + 'IlibHSbittorrent' (this | ||
791 | -- package) + 'IUnknown' (for not recognized software). All names are | ||
792 | -- prefixed by \"I\" because some of them starts from lowercase letter | ||
793 | -- but that is not a valid Haskell constructor name. | ||
794 | -- | ||
795 | data ClientImpl = | ||
796 | IUnknown | ||
797 | |||
798 | | IMainline | ||
799 | |||
800 | | IABC | ||
801 | | IOspreyPermaseed | ||
802 | | IBTQueue | ||
803 | | ITribler | ||
804 | | IShadow | ||
805 | | IBitTornado | ||
806 | |||
807 | -- UPnP(!) Bit Torrent !??? | ||
808 | -- 'U' - UPnP NAT Bit Torrent | ||
809 | | IBitLord | ||
810 | | IOpera | ||
811 | | IMLdonkey | ||
812 | |||
813 | | IAres | ||
814 | | IArctic | ||
815 | | IAvicora | ||
816 | | IBitPump | ||
817 | | IAzureus | ||
818 | | IBitBuddy | ||
819 | | IBitComet | ||
820 | | IBitflu | ||
821 | | IBTG | ||
822 | | IBitRocket | ||
823 | | IBTSlave | ||
824 | | IBittorrentX | ||
825 | | IEnhancedCTorrent | ||
826 | | ICTorrent | ||
827 | | IDelugeTorrent | ||
828 | | IPropagateDataClient | ||
829 | | IEBit | ||
830 | | IElectricSheep | ||
831 | | IFoxTorrent | ||
832 | | IGSTorrent | ||
833 | | IHalite | ||
834 | | IlibHSbittorrent | ||
835 | | IHydranode | ||
836 | | IKGet | ||
837 | | IKTorrent | ||
838 | | ILH_ABC | ||
839 | | ILphant | ||
840 | | ILibtorrent | ||
841 | | ILibTorrent | ||
842 | | ILimeWire | ||
843 | | IMonoTorrent | ||
844 | | IMooPolice | ||
845 | | IMiro | ||
846 | | IMoonlightTorrent | ||
847 | | INetTransport | ||
848 | | IPando | ||
849 | | IqBittorrent | ||
850 | | IQQDownload | ||
851 | | IQt4TorrentExample | ||
852 | | IRetriever | ||
853 | | IShareaza | ||
854 | | ISwiftbit | ||
855 | | ISwarmScope | ||
856 | | ISymTorrent | ||
857 | | Isharktorrent | ||
858 | | ITorrentDotNET | ||
859 | | ITransmission | ||
860 | | ITorrentstorm | ||
861 | | ITuoTu | ||
862 | | IuLeecher | ||
863 | | IuTorrent | ||
864 | | IVagaa | ||
865 | | IBitLet | ||
866 | | IFireTorrent | ||
867 | | IXunlei | ||
868 | | IXanTorrent | ||
869 | | IXtorrent | ||
870 | | IZipTorrent | ||
871 | deriving (Show, Eq, Ord, Enum, Bounded) | ||
872 | |||
873 | parseImpl :: ByteString -> ClientImpl | ||
874 | parseImpl = f . BC.unpack | ||
875 | where | ||
876 | f "AG" = IAres | ||
877 | f "A~" = IAres | ||
878 | f "AR" = IArctic | ||
879 | f "AV" = IAvicora | ||
880 | f "AX" = IBitPump | ||
881 | f "AZ" = IAzureus | ||
882 | f "BB" = IBitBuddy | ||
883 | f "BC" = IBitComet | ||
884 | f "BF" = IBitflu | ||
885 | f "BG" = IBTG | ||
886 | f "BR" = IBitRocket | ||
887 | f "BS" = IBTSlave | ||
888 | f "BX" = IBittorrentX | ||
889 | f "CD" = IEnhancedCTorrent | ||
890 | f "CT" = ICTorrent | ||
891 | f "DE" = IDelugeTorrent | ||
892 | f "DP" = IPropagateDataClient | ||
893 | f "EB" = IEBit | ||
894 | f "ES" = IElectricSheep | ||
895 | f "FT" = IFoxTorrent | ||
896 | f "GS" = IGSTorrent | ||
897 | f "HL" = IHalite | ||
898 | f "HS" = IlibHSbittorrent | ||
899 | f "HN" = IHydranode | ||
900 | f "KG" = IKGet | ||
901 | f "KT" = IKTorrent | ||
902 | f "LH" = ILH_ABC | ||
903 | f "LP" = ILphant | ||
904 | f "LT" = ILibtorrent | ||
905 | f "lt" = ILibTorrent | ||
906 | f "LW" = ILimeWire | ||
907 | f "MO" = IMonoTorrent | ||
908 | f "MP" = IMooPolice | ||
909 | f "MR" = IMiro | ||
910 | f "ML" = IMLdonkey | ||
911 | f "MT" = IMoonlightTorrent | ||
912 | f "NX" = INetTransport | ||
913 | f "PD" = IPando | ||
914 | f "qB" = IqBittorrent | ||
915 | f "QD" = IQQDownload | ||
916 | f "QT" = IQt4TorrentExample | ||
917 | f "RT" = IRetriever | ||
918 | f "S~" = IShareaza | ||
919 | f "SB" = ISwiftbit | ||
920 | f "SS" = ISwarmScope | ||
921 | f "ST" = ISymTorrent | ||
922 | f "st" = Isharktorrent | ||
923 | f "SZ" = IShareaza | ||
924 | f "TN" = ITorrentDotNET | ||
925 | f "TR" = ITransmission | ||
926 | f "TS" = ITorrentstorm | ||
927 | f "TT" = ITuoTu | ||
928 | f "UL" = IuLeecher | ||
929 | f "UT" = IuTorrent | ||
930 | f "VG" = IVagaa | ||
931 | f "WT" = IBitLet | ||
932 | f "WY" = IFireTorrent | ||
933 | f "XL" = IXunlei | ||
934 | f "XT" = IXanTorrent | ||
935 | f "XX" = IXtorrent | ||
936 | f "ZT" = IZipTorrent | ||
937 | f _ = IUnknown | ||
938 | |||
939 | -- | Used to represent a not recognized implementation | ||
940 | instance Default ClientImpl where | ||
941 | def = IUnknown | ||
942 | {-# INLINE def #-} | ||
943 | |||
944 | -- | Example: @\"BitLet\" == 'IBitLet'@ | ||
945 | instance IsString ClientImpl where | ||
946 | fromString str | ||
947 | | Just impl <- L.lookup str alist = impl | ||
948 | | otherwise = error $ "fromString: not recognized " ++ str | ||
949 | where | ||
950 | alist = L.map mk [minBound..maxBound] | ||
951 | mk x = (L.tail $ show x, x) | ||
952 | |||
953 | -- | Example: @pretty 'IBitLet' == \"IBitLet\"@ | ||
954 | instance Pretty ClientImpl where | ||
955 | pretty = text . L.tail . show | ||
956 | |||
957 | -- | Just the '0' version. | ||
958 | instance Default Version where | ||
959 | def = Version [0] [] | ||
960 | {-# INLINE def #-} | ||
961 | |||
962 | -- | For dot delimited version strings. | ||
963 | -- Example: @fromString \"0.1.0.2\" == Version [0, 1, 0, 2]@ | ||
964 | -- | ||
965 | instance IsString Version where | ||
966 | fromString str | ||
967 | | Just nums <- chunkNums str = Version nums [] | ||
968 | | otherwise = error $ "fromString: invalid version string " ++ str | ||
969 | where | ||
970 | chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==) | ||
971 | |||
972 | instance Pretty Version where | ||
973 | pretty = text . showVersion | ||
974 | |||
975 | -- | The all sensible infomation that can be obtained from a peer | ||
976 | -- identifier or torrent /createdBy/ field. | ||
977 | data Fingerprint = Fingerprint | ||
978 | { ciImpl :: ClientImpl | ||
979 | , ciVersion :: Version | ||
980 | } deriving (Show, Eq, Ord) | ||
981 | |||
982 | -- | Unrecognized client implementation. | ||
983 | instance Default Fingerprint where | ||
984 | def = Fingerprint def def | ||
985 | {-# INLINE def #-} | ||
986 | |||
987 | -- | Example: @\"BitComet-1.2\" == ClientInfo IBitComet (Version [1, 2] [])@ | ||
988 | instance IsString Fingerprint where | ||
989 | fromString str | ||
990 | | _ : ver <- _ver = Fingerprint (fromString impl) (fromString ver) | ||
991 | | otherwise = error $ "fromString: invalid client info string" ++ str | ||
992 | where | ||
993 | (impl, _ver) = L.span ((/=) '-') str | ||
994 | |||
995 | instance Pretty Fingerprint where | ||
996 | pretty Fingerprint {..} = pretty ciImpl <+> "version" <+> pretty ciVersion | ||
997 | |||
998 | -- | Fingerprint of this (the bittorrent library) package. Normally, | ||
999 | -- applications should introduce its own fingerprints, otherwise they | ||
1000 | -- can use 'libFingerprint' value. | ||
1001 | -- | ||
1002 | libFingerprint :: Fingerprint | ||
1003 | libFingerprint = Fingerprint IlibHSbittorrent version | ||
1004 | |||
1005 | -- | HTTP user agent of this (the bittorrent library) package. Can be | ||
1006 | -- used in HTTP tracker requests. | ||
1007 | libUserAgent :: String | ||
1008 | libUserAgent = render (pretty IlibHSbittorrent <> "/" <> pretty version) | ||
1009 | |||
1010 | {----------------------------------------------------------------------- | ||
1011 | -- For torrent file | ||
1012 | -----------------------------------------------------------------------} | ||
1013 | -- TODO collect information about createdBy torrent field | ||
1014 | {- | ||
1015 | renderImpl :: ClientImpl -> Text | ||
1016 | renderImpl = T.pack . L.tail . show | ||
1017 | |||
1018 | renderVersion :: Version -> Text | ||
1019 | renderVersion = undefined | ||
1020 | |||
1021 | renderClientInfo :: ClientInfo -> Text | ||
1022 | renderClientInfo ClientInfo {..} = renderImpl ciImpl <> "/" <> renderVersion ciVersion | ||
1023 | |||
1024 | parseClientInfo :: Text -> ClientImpl | ||
1025 | parseClientInfo t = undefined | ||
1026 | -} | ||
1027 | {- | ||
1028 | -- code used for generation; remove it later on | ||
1029 | |||
1030 | mkEnumTyDef :: NM -> String | ||
1031 | mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd | ||
1032 | |||
1033 | mkPars :: NM -> String | ||
1034 | mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl) | ||
1035 | |||
1036 | type NM = [(String, String)] | ||
1037 | nameMap :: NM | ||
1038 | nameMap = | ||
1039 | [ ("AG", "Ares") | ||
1040 | , ("A~", "Ares") | ||
1041 | , ("AR", "Arctic") | ||
1042 | , ("AV", "Avicora") | ||
1043 | , ("AX", "BitPump") | ||
1044 | , ("AZ", "Azureus") | ||
1045 | , ("BB", "BitBuddy") | ||
1046 | , ("BC", "BitComet") | ||
1047 | , ("BF", "Bitflu") | ||
1048 | , ("BG", "BTG") | ||
1049 | , ("BR", "BitRocket") | ||
1050 | , ("BS", "BTSlave") | ||
1051 | , ("BX", "BittorrentX") | ||
1052 | , ("CD", "EnhancedCTorrent") | ||
1053 | , ("CT", "CTorrent") | ||
1054 | , ("DE", "DelugeTorrent") | ||
1055 | , ("DP", "PropagateDataClient") | ||
1056 | , ("EB", "EBit") | ||
1057 | , ("ES", "ElectricSheep") | ||
1058 | , ("FT", "FoxTorrent") | ||
1059 | , ("GS", "GSTorrent") | ||
1060 | , ("HL", "Halite") | ||
1061 | , ("HS", "libHSnetwork_bittorrent") | ||
1062 | , ("HN", "Hydranode") | ||
1063 | , ("KG", "KGet") | ||
1064 | , ("KT", "KTorrent") | ||
1065 | , ("LH", "LH_ABC") | ||
1066 | , ("LP", "Lphant") | ||
1067 | , ("LT", "Libtorrent") | ||
1068 | , ("lt", "LibTorrent") | ||
1069 | , ("LW", "LimeWire") | ||
1070 | , ("MO", "MonoTorrent") | ||
1071 | , ("MP", "MooPolice") | ||
1072 | , ("MR", "Miro") | ||
1073 | , ("MT", "MoonlightTorrent") | ||
1074 | , ("NX", "NetTransport") | ||
1075 | , ("PD", "Pando") | ||
1076 | , ("qB", "qBittorrent") | ||
1077 | , ("QD", "QQDownload") | ||
1078 | , ("QT", "Qt4TorrentExample") | ||
1079 | , ("RT", "Retriever") | ||
1080 | , ("S~", "Shareaza") | ||
1081 | , ("SB", "Swiftbit") | ||
1082 | , ("SS", "SwarmScope") | ||
1083 | , ("ST", "SymTorrent") | ||
1084 | , ("st", "sharktorrent") | ||
1085 | , ("SZ", "Shareaza") | ||
1086 | , ("TN", "TorrentDotNET") | ||
1087 | , ("TR", "Transmission") | ||
1088 | , ("TS", "Torrentstorm") | ||
1089 | , ("TT", "TuoTu") | ||
1090 | , ("UL", "uLeecher") | ||
1091 | , ("UT", "uTorrent") | ||
1092 | , ("VG", "Vagaa") | ||
1093 | , ("WT", "BitLet") | ||
1094 | , ("WY", "FireTorrent") | ||
1095 | , ("XL", "Xunlei") | ||
1096 | , ("XT", "XanTorrent") | ||
1097 | , ("XX", "Xtorrent") | ||
1098 | , ("ZT", "ZipTorrent") | ||
1099 | ] | ||
1100 | -} | ||
1101 | |||
1102 | -- TODO use regexps | ||
1103 | |||
1104 | -- | Tries to extract meaningful information from peer ID bytes. If | ||
1105 | -- peer id uses unknown coding style then client info returned is | ||
1106 | -- 'def'. | ||
1107 | -- | ||
1108 | fingerprint :: PeerId -> Fingerprint | ||
1109 | fingerprint pid = either (const def) id $ runGet getCI (getPeerId pid) | ||
1110 | where | ||
1111 | getCI = do | ||
1112 | leading <- BS.w2c <$> getWord8 | ||
1113 | case leading of | ||
1114 | '-' -> Fingerprint <$> getAzureusImpl <*> getAzureusVersion | ||
1115 | 'M' -> Fingerprint <$> pure IMainline <*> getMainlineVersion | ||
1116 | 'e' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion | ||
1117 | 'F' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion | ||
1118 | c -> do | ||
1119 | c1 <- w2c <$> S.lookAhead getWord8 | ||
1120 | if c1 == 'P' | ||
1121 | then do | ||
1122 | _ <- getWord8 | ||
1123 | Fingerprint <$> pure IOpera <*> getOperaVersion | ||
1124 | else Fingerprint <$> pure (getShadowImpl c) <*> getShadowVersion | ||
1125 | |||
1126 | getMainlineVersion = do | ||
1127 | str <- BC.unpack <$> getByteString 7 | ||
1128 | let mnums = L.filter (not . L.null) $ L.linesBy ('-' ==) str | ||
1129 | return $ Version (fromMaybe [] $ sequence $ L.map readMaybe mnums) [] | ||
1130 | |||
1131 | getAzureusImpl = parseImpl <$> getByteString 2 | ||
1132 | getAzureusVersion = mkVer <$> getByteString 4 | ||
1133 | where | ||
1134 | mkVer bs = Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] [] | ||
1135 | |||
1136 | getBitCometImpl = do | ||
1137 | bs <- getByteString 3 | ||
1138 | S.lookAhead $ do | ||
1139 | _ <- getByteString 2 | ||
1140 | lr <- getByteString 4 | ||
1141 | return $ | ||
1142 | if lr == "LORD" then IBitLord else | ||
1143 | if bs == "UTB" then IBitComet else | ||
1144 | if bs == "xbc" then IBitComet else def | ||
1145 | |||
1146 | getBitCometVersion = do | ||
1147 | x <- getWord8 | ||
1148 | y <- getWord8 | ||
1149 | return $ Version [fromIntegral x, fromIntegral y] [] | ||
1150 | |||
1151 | getOperaVersion = do | ||
1152 | str <- BC.unpack <$> getByteString 4 | ||
1153 | return $ Version [fromMaybe 0 $ readMaybe str] [] | ||
1154 | |||
1155 | getShadowImpl 'A' = IABC | ||
1156 | getShadowImpl 'O' = IOspreyPermaseed | ||
1157 | getShadowImpl 'Q' = IBTQueue | ||
1158 | getShadowImpl 'R' = ITribler | ||
1159 | getShadowImpl 'S' = IShadow | ||
1160 | getShadowImpl 'T' = IBitTornado | ||
1161 | getShadowImpl _ = IUnknown | ||
1162 | |||
1163 | decodeShadowVerNr :: Char -> Maybe Int | ||
1164 | decodeShadowVerNr c | ||
1165 | | '0' < c && c <= '9' = Just (fromEnum c - fromEnum '0') | ||
1166 | | 'A' < c && c <= 'Z' = Just ((fromEnum c - fromEnum 'A') + 10) | ||
1167 | | 'a' < c && c <= 'z' = Just ((fromEnum c - fromEnum 'a') + 36) | ||
1168 | | otherwise = Nothing | ||
1169 | |||
1170 | getShadowVersion = do | ||
1171 | str <- BC.unpack <$> getByteString 5 | ||
1172 | return $ Version (catMaybes $ L.map decodeShadowVerNr str) [] | ||
diff --git a/src/Network/BitTorrent/Client.hs b/src/Network/BitTorrent/Client.hs index 700289d2..d21b4d1e 100644 --- a/src/Network/BitTorrent/Client.hs +++ b/src/Network/BitTorrent/Client.hs | |||
@@ -61,9 +61,9 @@ import Data.Text | |||
61 | import Network | 61 | import Network |
62 | 62 | ||
63 | import Data.Torrent | 63 | import Data.Torrent |
64 | import Network.BitTorrent.Address | ||
64 | import Network.BitTorrent.Client.Types | 65 | import Network.BitTorrent.Client.Types |
65 | import Network.BitTorrent.Client.Handle | 66 | import Network.BitTorrent.Client.Handle |
66 | import Network.BitTorrent.Core | ||
67 | import Network.BitTorrent.DHT as DHT hiding (Options) | 67 | import Network.BitTorrent.DHT as DHT hiding (Options) |
68 | import Network.BitTorrent.Tracker as Tracker hiding (Options) | 68 | import Network.BitTorrent.Tracker as Tracker hiding (Options) |
69 | import Network.BitTorrent.Exchange as Exchange hiding (Options) | 69 | import Network.BitTorrent.Exchange as Exchange hiding (Options) |
diff --git a/src/Network/BitTorrent/Client/Types.hs b/src/Network/BitTorrent/Client/Types.hs index 3c1e9c9c..a5bf0cce 100644 --- a/src/Network/BitTorrent/Client/Types.hs +++ b/src/Network/BitTorrent/Client/Types.hs | |||
@@ -35,8 +35,8 @@ import Network | |||
35 | import System.Log.FastLogger | 35 | import System.Log.FastLogger |
36 | 36 | ||
37 | import Data.Torrent | 37 | import Data.Torrent |
38 | import Network.BitTorrent.Address | ||
38 | import Network.BitTorrent.Internal.Types as Types | 39 | import Network.BitTorrent.Internal.Types as Types |
39 | import Network.BitTorrent.Core | ||
40 | import Network.BitTorrent.DHT as DHT | 40 | import Network.BitTorrent.DHT as DHT |
41 | import Network.BitTorrent.Exchange as Exchange | 41 | import Network.BitTorrent.Exchange as Exchange |
42 | import Network.BitTorrent.Tracker as Tracker hiding (Event) | 42 | import Network.BitTorrent.Tracker as Tracker hiding (Event) |
diff --git a/src/Network/BitTorrent/Core.hs b/src/Network/BitTorrent/Core.hs deleted file mode 100644 index b9b3c065..00000000 --- a/src/Network/BitTorrent/Core.hs +++ /dev/null | |||
@@ -1,88 +0,0 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- Re-export every @Network.BitTorrent.Core.*@ module. | ||
9 | -- | ||
10 | module Network.BitTorrent.Core | ||
11 | ( module Core | ||
12 | |||
13 | -- * Address class | ||
14 | , Address (..) | ||
15 | , fromAddr | ||
16 | |||
17 | -- * Re-exports from Data.IP | ||
18 | , IPv4 | ||
19 | , IPv6 | ||
20 | , IP (..) | ||
21 | ) where | ||
22 | |||
23 | import Control.Applicative | ||
24 | import Data.IP | ||
25 | import Data.Hashable | ||
26 | import Data.Serialize | ||
27 | import Data.Time | ||
28 | import Data.Typeable | ||
29 | import Network.Socket (SockAddr (..), PortNumber) | ||
30 | import Text.PrettyPrint as PP hiding ((<>)) | ||
31 | import Text.PrettyPrint.Class | ||
32 | |||
33 | import Network.BitTorrent.Core.Fingerprint as Core | ||
34 | import Network.BitTorrent.Core.NodeInfo as Core | ||
35 | import Network.BitTorrent.Core.PeerId as Core | ||
36 | import Network.BitTorrent.Core.PeerAddr as Core | ||
37 | |||
38 | |||
39 | instance Pretty UTCTime where | ||
40 | pretty = PP.text . show | ||
41 | |||
42 | class (Eq a, Serialize a, Typeable a, Hashable a, Pretty a) | ||
43 | => Address a where | ||
44 | toSockAddr :: a -> SockAddr | ||
45 | fromSockAddr :: SockAddr -> Maybe a | ||
46 | |||
47 | fromAddr :: (Address a, Address b) => a -> Maybe b | ||
48 | fromAddr = fromSockAddr . toSockAddr | ||
49 | |||
50 | -- | Note that port is zeroed. | ||
51 | instance Address IPv4 where | ||
52 | toSockAddr = SockAddrInet 0 . toHostAddress | ||
53 | fromSockAddr (SockAddrInet _ h) = Just (fromHostAddress h) | ||
54 | fromSockAddr _ = Nothing | ||
55 | |||
56 | -- | Note that port is zeroed. | ||
57 | instance Address IPv6 where | ||
58 | toSockAddr h = SockAddrInet6 0 0 (toHostAddress6 h) 0 | ||
59 | fromSockAddr (SockAddrInet6 _ _ h _) = Just (fromHostAddress6 h) | ||
60 | fromSockAddr _ = Nothing | ||
61 | |||
62 | -- | Note that port is zeroed. | ||
63 | instance Address IP where | ||
64 | toSockAddr (IPv4 h) = toSockAddr h | ||
65 | toSockAddr (IPv6 h) = toSockAddr h | ||
66 | fromSockAddr sa = | ||
67 | IPv4 <$> fromSockAddr sa | ||
68 | <|> IPv6 <$> fromSockAddr sa | ||
69 | |||
70 | setPort :: PortNumber -> SockAddr -> SockAddr | ||
71 | setPort port (SockAddrInet _ h ) = SockAddrInet port h | ||
72 | setPort port (SockAddrInet6 _ f h s) = SockAddrInet6 port f h s | ||
73 | setPort _ (SockAddrUnix s ) = SockAddrUnix s | ||
74 | {-# INLINE setPort #-} | ||
75 | |||
76 | getPort :: SockAddr -> Maybe PortNumber | ||
77 | getPort (SockAddrInet p _ ) = Just p | ||
78 | getPort (SockAddrInet6 p _ _ _) = Just p | ||
79 | getPort (SockAddrUnix _ ) = Nothing | ||
80 | {-# INLINE getPort #-} | ||
81 | |||
82 | instance Address a => Address (NodeAddr a) where | ||
83 | toSockAddr NodeAddr {..} = setPort nodePort $ toSockAddr nodeHost | ||
84 | fromSockAddr sa = NodeAddr <$> fromSockAddr sa <*> getPort sa | ||
85 | |||
86 | instance Address a => Address (PeerAddr a) where | ||
87 | toSockAddr PeerAddr {..} = setPort peerPort $ toSockAddr peerHost | ||
88 | fromSockAddr sa = PeerAddr Nothing <$> fromSockAddr sa <*> getPort sa | ||
diff --git a/src/Network/BitTorrent/Core/Fingerprint.hs b/src/Network/BitTorrent/Core/Fingerprint.hs deleted file mode 100644 index d743acd0..00000000 --- a/src/Network/BitTorrent/Core/Fingerprint.hs +++ /dev/null | |||
@@ -1,290 +0,0 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- 'Fingerprint' is used to identify the client implementation and | ||
9 | -- version which also contained in 'Peer'. For exsample first 6 | ||
10 | -- bytes of peer id of this this library are @-HS0100-@ while for | ||
11 | -- mainline we have @M4-3-6--@. We could extract this info and | ||
12 | -- print in human-friendly form: this is useful for debugging and | ||
13 | -- logging. | ||
14 | -- | ||
15 | -- For more information see: | ||
16 | -- <http://bittorrent.org/beps/bep_0020.html> | ||
17 | -- | ||
18 | -- | ||
19 | -- NOTE: Do /not/ use this information to control client | ||
20 | -- capabilities (such as supported enchancements), this should be | ||
21 | -- done using 'Network.BitTorrent.Extension'! | ||
22 | -- | ||
23 | {-# OPTIONS -fno-warn-orphans #-} | ||
24 | module Network.BitTorrent.Core.Fingerprint | ||
25 | ( ClientImpl (..) | ||
26 | , Fingerprint (..) | ||
27 | , libFingerprint | ||
28 | , libUserAgent | ||
29 | ) where | ||
30 | |||
31 | import Data.Default | ||
32 | import Data.List as L | ||
33 | import Data.List.Split as L | ||
34 | import Data.Monoid | ||
35 | import Data.String | ||
36 | import Data.Version | ||
37 | import Text.PrettyPrint hiding ((<>)) | ||
38 | import Text.PrettyPrint.Class | ||
39 | import Text.Read (readMaybe) | ||
40 | -- import Paths_bittorrent (version) | ||
41 | |||
42 | -- TODO FIXME | ||
43 | version :: Version | ||
44 | version = Version [0, 0, 0, 3] [] | ||
45 | |||
46 | -- | List of registered client versions + 'IlibHSbittorrent' (this | ||
47 | -- package) + 'IUnknown' (for not recognized software). All names are | ||
48 | -- prefixed by \"I\" because some of them starts from lowercase letter | ||
49 | -- but that is not a valid Haskell constructor name. | ||
50 | -- | ||
51 | data ClientImpl = | ||
52 | IUnknown | ||
53 | |||
54 | | IMainline | ||
55 | |||
56 | | IABC | ||
57 | | IOspreyPermaseed | ||
58 | | IBTQueue | ||
59 | | ITribler | ||
60 | | IShadow | ||
61 | | IBitTornado | ||
62 | |||
63 | -- UPnP(!) Bit Torrent !??? | ||
64 | -- 'U' - UPnP NAT Bit Torrent | ||
65 | | IBitLord | ||
66 | | IOpera | ||
67 | | IMLdonkey | ||
68 | |||
69 | | IAres | ||
70 | | IArctic | ||
71 | | IAvicora | ||
72 | | IBitPump | ||
73 | | IAzureus | ||
74 | | IBitBuddy | ||
75 | | IBitComet | ||
76 | | IBitflu | ||
77 | | IBTG | ||
78 | | IBitRocket | ||
79 | | IBTSlave | ||
80 | | IBittorrentX | ||
81 | | IEnhancedCTorrent | ||
82 | | ICTorrent | ||
83 | | IDelugeTorrent | ||
84 | | IPropagateDataClient | ||
85 | | IEBit | ||
86 | | IElectricSheep | ||
87 | | IFoxTorrent | ||
88 | | IGSTorrent | ||
89 | | IHalite | ||
90 | | IlibHSbittorrent | ||
91 | | IHydranode | ||
92 | | IKGet | ||
93 | | IKTorrent | ||
94 | | ILH_ABC | ||
95 | | ILphant | ||
96 | | ILibtorrent | ||
97 | | ILibTorrent | ||
98 | | ILimeWire | ||
99 | | IMonoTorrent | ||
100 | | IMooPolice | ||
101 | | IMiro | ||
102 | | IMoonlightTorrent | ||
103 | | INetTransport | ||
104 | | IPando | ||
105 | | IqBittorrent | ||
106 | | IQQDownload | ||
107 | | IQt4TorrentExample | ||
108 | | IRetriever | ||
109 | | IShareaza | ||
110 | | ISwiftbit | ||
111 | | ISwarmScope | ||
112 | | ISymTorrent | ||
113 | | Isharktorrent | ||
114 | | ITorrentDotNET | ||
115 | | ITransmission | ||
116 | | ITorrentstorm | ||
117 | | ITuoTu | ||
118 | | IuLeecher | ||
119 | | IuTorrent | ||
120 | | IVagaa | ||
121 | | IBitLet | ||
122 | | IFireTorrent | ||
123 | | IXunlei | ||
124 | | IXanTorrent | ||
125 | | IXtorrent | ||
126 | | IZipTorrent | ||
127 | deriving (Show, Eq, Ord, Enum, Bounded) | ||
128 | |||
129 | -- | Used to represent a not recognized implementation | ||
130 | instance Default ClientImpl where | ||
131 | def = IUnknown | ||
132 | {-# INLINE def #-} | ||
133 | |||
134 | -- | Example: @\"BitLet\" == 'IBitLet'@ | ||
135 | instance IsString ClientImpl where | ||
136 | fromString str | ||
137 | | Just impl <- L.lookup str alist = impl | ||
138 | | otherwise = error $ "fromString: not recognized " ++ str | ||
139 | where | ||
140 | alist = L.map mk [minBound..maxBound] | ||
141 | mk x = (L.tail $ show x, x) | ||
142 | |||
143 | -- | Example: @pretty 'IBitLet' == \"IBitLet\"@ | ||
144 | instance Pretty ClientImpl where | ||
145 | pretty = text . L.tail . show | ||
146 | |||
147 | -- | Just the '0' version. | ||
148 | instance Default Version where | ||
149 | def = Version [0] [] | ||
150 | {-# INLINE def #-} | ||
151 | |||
152 | -- | For dot delimited version strings. | ||
153 | -- Example: @fromString \"0.1.0.2\" == Version [0, 1, 0, 2]@ | ||
154 | -- | ||
155 | instance IsString Version where | ||
156 | fromString str | ||
157 | | Just nums <- chunkNums str = Version nums [] | ||
158 | | otherwise = error $ "fromString: invalid version string " ++ str | ||
159 | where | ||
160 | chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==) | ||
161 | |||
162 | instance Pretty Version where | ||
163 | pretty = text . showVersion | ||
164 | |||
165 | -- | The all sensible infomation that can be obtained from a peer | ||
166 | -- identifier or torrent /createdBy/ field. | ||
167 | data Fingerprint = Fingerprint | ||
168 | { ciImpl :: ClientImpl | ||
169 | , ciVersion :: Version | ||
170 | } deriving (Show, Eq, Ord) | ||
171 | |||
172 | -- | Unrecognized client implementation. | ||
173 | instance Default Fingerprint where | ||
174 | def = Fingerprint def def | ||
175 | {-# INLINE def #-} | ||
176 | |||
177 | -- | Example: @\"BitComet-1.2\" == ClientInfo IBitComet (Version [1, 2] [])@ | ||
178 | instance IsString Fingerprint where | ||
179 | fromString str | ||
180 | | _ : ver <- _ver = Fingerprint (fromString impl) (fromString ver) | ||
181 | | otherwise = error $ "fromString: invalid client info string" ++ str | ||
182 | where | ||
183 | (impl, _ver) = L.span ((/=) '-') str | ||
184 | |||
185 | instance Pretty Fingerprint where | ||
186 | pretty Fingerprint {..} = pretty ciImpl <+> "version" <+> pretty ciVersion | ||
187 | |||
188 | -- | Fingerprint of this (the bittorrent library) package. Normally, | ||
189 | -- applications should introduce its own fingerprints, otherwise they | ||
190 | -- can use 'libFingerprint' value. | ||
191 | -- | ||
192 | libFingerprint :: Fingerprint | ||
193 | libFingerprint = Fingerprint IlibHSbittorrent version | ||
194 | |||
195 | -- | HTTP user agent of this (the bittorrent library) package. Can be | ||
196 | -- used in HTTP tracker requests. | ||
197 | libUserAgent :: String | ||
198 | libUserAgent = render (pretty IlibHSbittorrent <> "/" <> pretty version) | ||
199 | |||
200 | {----------------------------------------------------------------------- | ||
201 | -- For torrent file | ||
202 | -----------------------------------------------------------------------} | ||
203 | -- TODO collect information about createdBy torrent field | ||
204 | {- | ||
205 | renderImpl :: ClientImpl -> Text | ||
206 | renderImpl = T.pack . L.tail . show | ||
207 | |||
208 | renderVersion :: Version -> Text | ||
209 | renderVersion = undefined | ||
210 | |||
211 | renderClientInfo :: ClientInfo -> Text | ||
212 | renderClientInfo ClientInfo {..} = renderImpl ciImpl <> "/" <> renderVersion ciVersion | ||
213 | |||
214 | parseClientInfo :: Text -> ClientImpl | ||
215 | parseClientInfo t = undefined | ||
216 | -} | ||
217 | {- | ||
218 | -- code used for generation; remove it later on | ||
219 | |||
220 | mkEnumTyDef :: NM -> String | ||
221 | mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd | ||
222 | |||
223 | mkPars :: NM -> String | ||
224 | mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl) | ||
225 | |||
226 | type NM = [(String, String)] | ||
227 | nameMap :: NM | ||
228 | nameMap = | ||
229 | [ ("AG", "Ares") | ||
230 | , ("A~", "Ares") | ||
231 | , ("AR", "Arctic") | ||
232 | , ("AV", "Avicora") | ||
233 | , ("AX", "BitPump") | ||
234 | , ("AZ", "Azureus") | ||
235 | , ("BB", "BitBuddy") | ||
236 | , ("BC", "BitComet") | ||
237 | , ("BF", "Bitflu") | ||
238 | , ("BG", "BTG") | ||
239 | , ("BR", "BitRocket") | ||
240 | , ("BS", "BTSlave") | ||
241 | , ("BX", "BittorrentX") | ||
242 | , ("CD", "EnhancedCTorrent") | ||
243 | , ("CT", "CTorrent") | ||
244 | , ("DE", "DelugeTorrent") | ||
245 | , ("DP", "PropagateDataClient") | ||
246 | , ("EB", "EBit") | ||
247 | , ("ES", "ElectricSheep") | ||
248 | , ("FT", "FoxTorrent") | ||
249 | , ("GS", "GSTorrent") | ||
250 | , ("HL", "Halite") | ||
251 | , ("HS", "libHSnetwork_bittorrent") | ||
252 | , ("HN", "Hydranode") | ||
253 | , ("KG", "KGet") | ||
254 | , ("KT", "KTorrent") | ||
255 | , ("LH", "LH_ABC") | ||
256 | , ("LP", "Lphant") | ||
257 | , ("LT", "Libtorrent") | ||
258 | , ("lt", "LibTorrent") | ||
259 | , ("LW", "LimeWire") | ||
260 | , ("MO", "MonoTorrent") | ||
261 | , ("MP", "MooPolice") | ||
262 | , ("MR", "Miro") | ||
263 | , ("MT", "MoonlightTorrent") | ||
264 | , ("NX", "NetTransport") | ||
265 | , ("PD", "Pando") | ||
266 | , ("qB", "qBittorrent") | ||
267 | , ("QD", "QQDownload") | ||
268 | , ("QT", "Qt4TorrentExample") | ||
269 | , ("RT", "Retriever") | ||
270 | , ("S~", "Shareaza") | ||
271 | , ("SB", "Swiftbit") | ||
272 | , ("SS", "SwarmScope") | ||
273 | , ("ST", "SymTorrent") | ||
274 | , ("st", "sharktorrent") | ||
275 | , ("SZ", "Shareaza") | ||
276 | , ("TN", "TorrentDotNET") | ||
277 | , ("TR", "Transmission") | ||
278 | , ("TS", "Torrentstorm") | ||
279 | , ("TT", "TuoTu") | ||
280 | , ("UL", "uLeecher") | ||
281 | , ("UT", "uTorrent") | ||
282 | , ("VG", "Vagaa") | ||
283 | , ("WT", "BitLet") | ||
284 | , ("WY", "FireTorrent") | ||
285 | , ("XL", "Xunlei") | ||
286 | , ("XT", "XanTorrent") | ||
287 | , ("XX", "Xtorrent") | ||
288 | , ("ZT", "ZipTorrent") | ||
289 | ] | ||
290 | -} | ||
diff --git a/src/Network/BitTorrent/Core/NodeInfo.hs b/src/Network/BitTorrent/Core/NodeInfo.hs deleted file mode 100644 index fe17c097..00000000 --- a/src/Network/BitTorrent/Core/NodeInfo.hs +++ /dev/null | |||
@@ -1,219 +0,0 @@ | |||
1 | -- | | ||
2 | -- Module : Network.BitTorrent.Core.Node | ||
3 | -- Copyright : (c) Sam Truzjan 2013 | ||
4 | -- (c) Daniel Gröber 2013 | ||
5 | -- License : BSD3 | ||
6 | -- Maintainer : pxqr.sta@gmail.com | ||
7 | -- Stability : experimental | ||
8 | -- Portability : portable | ||
9 | -- | ||
10 | -- A \"node\" is a client\/server listening on a UDP port | ||
11 | -- implementing the distributed hash table protocol. The DHT is | ||
12 | -- composed of nodes and stores the location of peers. BitTorrent | ||
13 | -- clients include a DHT node, which is used to contact other nodes | ||
14 | -- in the DHT to get the location of peers to download from using | ||
15 | -- the BitTorrent protocol. | ||
16 | -- | ||
17 | {-# LANGUAGE RecordWildCards #-} | ||
18 | {-# LANGUAGE FlexibleInstances #-} | ||
19 | {-# LANGUAGE TemplateHaskell #-} | ||
20 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
21 | {-# LANGUAGE DeriveDataTypeable #-} | ||
22 | {-# LANGUAGE DeriveFunctor #-} | ||
23 | module Network.BitTorrent.Core.NodeInfo | ||
24 | ( -- * Node ID | ||
25 | NodeId | ||
26 | , testIdBit | ||
27 | , genNodeId | ||
28 | |||
29 | -- ** Node distance | ||
30 | , NodeDistance | ||
31 | , distance | ||
32 | |||
33 | -- * Node address | ||
34 | , NodeAddr (..) | ||
35 | |||
36 | -- * Node info | ||
37 | , NodeInfo (..) | ||
38 | , rank | ||
39 | ) where | ||
40 | |||
41 | import Control.Applicative | ||
42 | import Data.Bits | ||
43 | import Data.ByteString as BS | ||
44 | import Data.ByteString.Char8 as BC | ||
45 | import Data.ByteString.Base16 as Base16 | ||
46 | import Data.BEncode as BE | ||
47 | import Data.Default | ||
48 | import Data.Hashable | ||
49 | import Data.Foldable | ||
50 | import Data.IP | ||
51 | import Data.List as L | ||
52 | import Data.Monoid | ||
53 | import Data.Ord | ||
54 | import Data.Serialize as S | ||
55 | import Data.String | ||
56 | import Data.Typeable | ||
57 | import Data.Word | ||
58 | import Network | ||
59 | import System.Entropy | ||
60 | import Text.PrettyPrint as PP hiding ((<>)) | ||
61 | import Text.PrettyPrint.Class | ||
62 | |||
63 | import Network.BitTorrent.Core.PeerAddr (PeerAddr (..)) | ||
64 | |||
65 | {----------------------------------------------------------------------- | ||
66 | -- Node id | ||
67 | -----------------------------------------------------------------------} | ||
68 | -- TODO more compact representation ('ShortByteString's?) | ||
69 | |||
70 | -- | Each node has a globally unique identifier known as the \"node | ||
71 | -- ID.\" | ||
72 | -- | ||
73 | -- Normally, /this/ node id should be saved between invocations | ||
74 | -- of the client software. | ||
75 | newtype NodeId = NodeId ByteString | ||
76 | deriving (Show, Eq, Ord, BEncode, Typeable) | ||
77 | |||
78 | nodeIdSize :: Int | ||
79 | nodeIdSize = 20 | ||
80 | |||
81 | -- | Meaningless node id, for testing purposes only. | ||
82 | instance Default NodeId where | ||
83 | def = NodeId (BS.replicate nodeIdSize 0) | ||
84 | |||
85 | instance Serialize NodeId where | ||
86 | get = NodeId <$> getByteString nodeIdSize | ||
87 | {-# INLINE get #-} | ||
88 | put (NodeId bs) = putByteString bs | ||
89 | {-# INLINE put #-} | ||
90 | |||
91 | -- | ASCII encoded. | ||
92 | instance IsString NodeId where | ||
93 | fromString str | ||
94 | | L.length str == nodeIdSize = NodeId (fromString str) | ||
95 | | otherwise = error "fromString: invalid NodeId length" | ||
96 | {-# INLINE fromString #-} | ||
97 | |||
98 | -- | base16 encoded. | ||
99 | instance Pretty NodeId where | ||
100 | pretty (NodeId nid) = PP.text $ BC.unpack $ Base16.encode nid | ||
101 | |||
102 | -- | Test if the nth bit is set. | ||
103 | testIdBit :: NodeId -> Word -> Bool | ||
104 | testIdBit (NodeId bs) i | ||
105 | | fromIntegral i < nodeIdSize * 8 | ||
106 | , (q, r) <- quotRem (fromIntegral i) 8 | ||
107 | = testBit (BS.index bs q) r | ||
108 | | otherwise = False | ||
109 | {-# INLINE testIdBit #-} | ||
110 | |||
111 | -- TODO WARN is the 'system' random suitable for this? | ||
112 | -- | Generate random NodeID used for the entire session. | ||
113 | -- Distribution of ID's should be as uniform as possible. | ||
114 | -- | ||
115 | genNodeId :: IO NodeId | ||
116 | genNodeId = NodeId <$> getEntropy nodeIdSize | ||
117 | |||
118 | {----------------------------------------------------------------------- | ||
119 | -- Node distance | ||
120 | -----------------------------------------------------------------------} | ||
121 | |||
122 | -- | In Kademlia, the distance metric is XOR and the result is | ||
123 | -- interpreted as an unsigned integer. | ||
124 | newtype NodeDistance = NodeDistance BS.ByteString | ||
125 | deriving (Eq, Ord) | ||
126 | |||
127 | instance Pretty NodeDistance where | ||
128 | pretty (NodeDistance bs) = foldMap bitseq $ BS.unpack bs | ||
129 | where | ||
130 | listBits w = L.map (testBit w) (L.reverse [0..bitSize w - 1]) | ||
131 | bitseq = foldMap (int . fromEnum) . listBits | ||
132 | |||
133 | -- | distance(A,B) = |A xor B| Smaller values are closer. | ||
134 | distance :: NodeId -> NodeId -> NodeDistance | ||
135 | distance (NodeId a) (NodeId b) = NodeDistance (BS.pack (BS.zipWith xor a b)) | ||
136 | |||
137 | {----------------------------------------------------------------------- | ||
138 | -- Node address | ||
139 | -----------------------------------------------------------------------} | ||
140 | |||
141 | data NodeAddr a = NodeAddr | ||
142 | { nodeHost :: !a | ||
143 | , nodePort :: {-# UNPACK #-} !PortNumber | ||
144 | } deriving (Eq, Typeable, Functor) | ||
145 | |||
146 | instance Show a => Show (NodeAddr a) where | ||
147 | showsPrec i NodeAddr {..} | ||
148 | = showsPrec i nodeHost <> showString ":" <> showsPrec i nodePort | ||
149 | |||
150 | instance Read (NodeAddr IPv4) where | ||
151 | readsPrec i x = [ (fromPeerAddr a, s) | (a, s) <- readsPrec i x ] | ||
152 | |||
153 | -- | @127.0.0.1:6882@ | ||
154 | instance Default (NodeAddr IPv4) where | ||
155 | def = "127.0.0.1:6882" | ||
156 | |||
157 | -- | KRPC compatible encoding. | ||
158 | instance Serialize a => Serialize (NodeAddr a) where | ||
159 | get = NodeAddr <$> get <*> get | ||
160 | {-# INLINE get #-} | ||
161 | put NodeAddr {..} = put nodeHost >> put nodePort | ||
162 | {-# INLINE put #-} | ||
163 | |||
164 | -- | Torrent file compatible encoding. | ||
165 | instance BEncode a => BEncode (NodeAddr a) where | ||
166 | toBEncode NodeAddr {..} = toBEncode (nodeHost, nodePort) | ||
167 | {-# INLINE toBEncode #-} | ||
168 | fromBEncode b = uncurry NodeAddr <$> fromBEncode b | ||
169 | {-# INLINE fromBEncode #-} | ||
170 | |||
171 | instance Hashable a => Hashable (NodeAddr a) where | ||
172 | hashWithSalt s NodeAddr {..} = hashWithSalt s (nodeHost, nodePort) | ||
173 | {-# INLINE hashWithSalt #-} | ||
174 | |||
175 | instance Pretty ip => Pretty (NodeAddr ip) where | ||
176 | pretty NodeAddr {..} = pretty nodeHost <> ":" <> pretty nodePort | ||
177 | |||
178 | -- | Example: | ||
179 | -- | ||
180 | -- @nodePort \"127.0.0.1:6881\" == 6881@ | ||
181 | -- | ||
182 | instance IsString (NodeAddr IPv4) where | ||
183 | fromString = fromPeerAddr . fromString | ||
184 | |||
185 | fromPeerAddr :: PeerAddr a -> NodeAddr a | ||
186 | fromPeerAddr PeerAddr {..} = NodeAddr | ||
187 | { nodeHost = peerHost | ||
188 | , nodePort = peerPort | ||
189 | } | ||
190 | |||
191 | {----------------------------------------------------------------------- | ||
192 | -- Node info | ||
193 | -----------------------------------------------------------------------} | ||
194 | |||
195 | data NodeInfo a = NodeInfo | ||
196 | { nodeId :: !NodeId | ||
197 | , nodeAddr :: !(NodeAddr a) | ||
198 | } deriving (Show, Eq, Functor) | ||
199 | |||
200 | instance Eq a => Ord (NodeInfo a) where | ||
201 | compare = comparing nodeId | ||
202 | |||
203 | -- | KRPC 'compact list' compatible encoding: contact information for | ||
204 | -- nodes is encoded as a 26-byte string. Also known as "Compact node | ||
205 | -- info" the 20-byte Node ID in network byte order has the compact | ||
206 | -- IP-address/port info concatenated to the end. | ||
207 | instance Serialize a => Serialize (NodeInfo a) where | ||
208 | get = NodeInfo <$> get <*> get | ||
209 | put NodeInfo {..} = put nodeId >> put nodeAddr | ||
210 | |||
211 | instance Pretty ip => Pretty (NodeInfo ip) where | ||
212 | pretty NodeInfo {..} = pretty nodeId <> "@(" <> pretty nodeAddr <> ")" | ||
213 | |||
214 | instance Pretty ip => Pretty [NodeInfo ip] where | ||
215 | pretty = PP.vcat . PP.punctuate "," . L.map pretty | ||
216 | |||
217 | -- | Order by closeness: nearest nodes first. | ||
218 | rank :: Eq ip => NodeId -> [NodeInfo ip] -> [NodeInfo ip] | ||
219 | rank nid = L.sortBy (comparing (distance nid . nodeId)) | ||
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs deleted file mode 100644 index e9ad7c96..00000000 --- a/src/Network/BitTorrent/Core/PeerAddr.hs +++ /dev/null | |||
@@ -1,312 +0,0 @@ | |||
1 | -- | | ||
2 | -- Module : Network.BitTorrent.Core.PeerAddr | ||
3 | -- Copyright : (c) Sam Truzjan 2013 | ||
4 | -- (c) Daniel Gröber 2013 | ||
5 | -- License : BSD3 | ||
6 | -- Maintainer : pxqr.sta@gmail.com | ||
7 | -- Stability : provisional | ||
8 | -- Portability : portable | ||
9 | -- | ||
10 | -- 'PeerAddr' is used to represent peer address. Currently it's | ||
11 | -- just peer IP and peer port but this might change in future. | ||
12 | -- | ||
13 | {-# LANGUAGE TemplateHaskell #-} | ||
14 | {-# LANGUAGE StandaloneDeriving #-} | ||
15 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
16 | {-# LANGUAGE DeriveDataTypeable #-} | ||
17 | {-# LANGUAGE FlexibleInstances #-} | ||
18 | {-# LANGUAGE DeriveFunctor #-} | ||
19 | {-# LANGUAGE ViewPatterns #-} | ||
20 | {-# OPTIONS -fno-warn-orphans #-} -- for PortNumber instances | ||
21 | module Network.BitTorrent.Core.PeerAddr | ||
22 | ( -- * Peer address | ||
23 | PeerAddr(..) | ||
24 | , defaultPorts | ||
25 | , peerSockAddr | ||
26 | , peerSocket | ||
27 | |||
28 | -- * Peer storage | ||
29 | ) where | ||
30 | |||
31 | import Control.Applicative | ||
32 | import Control.Monad | ||
33 | import Data.BEncode as BS | ||
34 | import Data.BEncode.BDict (BKey) | ||
35 | import Data.ByteString.Char8 as BS8 | ||
36 | import Data.Char | ||
37 | import Data.Default | ||
38 | import Data.Hashable | ||
39 | import Data.IP | ||
40 | import Data.List as L | ||
41 | import Data.List.Split | ||
42 | import Data.Monoid | ||
43 | import Data.Serialize as S | ||
44 | import Data.String | ||
45 | import Data.Typeable | ||
46 | import Data.Word | ||
47 | import Network.Socket | ||
48 | import Text.PrettyPrint as PP hiding ((<>)) | ||
49 | import Text.PrettyPrint.Class | ||
50 | import Text.Read (readMaybe) | ||
51 | import qualified Text.ParserCombinators.ReadP as RP | ||
52 | |||
53 | --import Data.Torrent | ||
54 | import Network.BitTorrent.Core.PeerId | ||
55 | |||
56 | |||
57 | {----------------------------------------------------------------------- | ||
58 | -- Port number | ||
59 | -----------------------------------------------------------------------} | ||
60 | |||
61 | instance BEncode PortNumber where | ||
62 | toBEncode = toBEncode . fromEnum | ||
63 | fromBEncode = fromBEncode >=> portNumber | ||
64 | where | ||
65 | portNumber :: Integer -> BS.Result PortNumber | ||
66 | portNumber n | ||
67 | | 0 <= n && n <= fromIntegral (maxBound :: Word16) | ||
68 | = pure $ fromIntegral n | ||
69 | | otherwise = decodingError $ "PortNumber: " ++ show n | ||
70 | |||
71 | instance Serialize PortNumber where | ||
72 | get = fromIntegral <$> getWord16be | ||
73 | {-# INLINE get #-} | ||
74 | put = putWord16be . fromIntegral | ||
75 | {-# INLINE put #-} | ||
76 | |||
77 | instance Hashable PortNumber where | ||
78 | hashWithSalt s = hashWithSalt s . fromEnum | ||
79 | {-# INLINE hashWithSalt #-} | ||
80 | |||
81 | instance Pretty PortNumber where | ||
82 | pretty = PP.int . fromEnum | ||
83 | {-# INLINE pretty #-} | ||
84 | |||
85 | {----------------------------------------------------------------------- | ||
86 | -- IP addr | ||
87 | -----------------------------------------------------------------------} | ||
88 | |||
89 | class IPAddress i where | ||
90 | toHostAddr :: i -> Either HostAddress HostAddress6 | ||
91 | |||
92 | instance IPAddress IPv4 where | ||
93 | toHostAddr = Left . toHostAddress | ||
94 | {-# INLINE toHostAddr #-} | ||
95 | |||
96 | instance IPAddress IPv6 where | ||
97 | toHostAddr = Right . toHostAddress6 | ||
98 | {-# INLINE toHostAddr #-} | ||
99 | |||
100 | instance IPAddress IP where | ||
101 | toHostAddr (IPv4 ip) = toHostAddr ip | ||
102 | toHostAddr (IPv6 ip) = toHostAddr ip | ||
103 | {-# INLINE toHostAddr #-} | ||
104 | |||
105 | deriving instance Typeable IP | ||
106 | deriving instance Typeable IPv4 | ||
107 | deriving instance Typeable IPv6 | ||
108 | |||
109 | ipToBEncode :: Show i => i -> BValue | ||
110 | ipToBEncode ip = BString $ BS8.pack $ show ip | ||
111 | {-# INLINE ipToBEncode #-} | ||
112 | |||
113 | ipFromBEncode :: Read a => BValue -> BS.Result a | ||
114 | ipFromBEncode (BString (BS8.unpack -> ipStr)) | ||
115 | | Just ip <- readMaybe (ipStr) = pure ip | ||
116 | | otherwise = decodingError $ "IP: " ++ ipStr | ||
117 | ipFromBEncode _ = decodingError $ "IP: addr should be a bstring" | ||
118 | |||
119 | instance BEncode IP where | ||
120 | toBEncode = ipToBEncode | ||
121 | {-# INLINE toBEncode #-} | ||
122 | fromBEncode = ipFromBEncode | ||
123 | {-# INLINE fromBEncode #-} | ||
124 | |||
125 | instance BEncode IPv4 where | ||
126 | toBEncode = ipToBEncode | ||
127 | {-# INLINE toBEncode #-} | ||
128 | fromBEncode = ipFromBEncode | ||
129 | {-# INLINE fromBEncode #-} | ||
130 | |||
131 | instance BEncode IPv6 where | ||
132 | toBEncode = ipToBEncode | ||
133 | {-# INLINE toBEncode #-} | ||
134 | fromBEncode = ipFromBEncode | ||
135 | {-# INLINE fromBEncode #-} | ||
136 | |||
137 | -- | When 'get'ing an IP it must be 'isolate'd to the appropriate | ||
138 | -- number of bytes since we have no other way of telling which | ||
139 | -- address type we are trying to parse | ||
140 | instance Serialize IP where | ||
141 | put (IPv4 ip) = put ip | ||
142 | put (IPv6 ip) = put ip | ||
143 | |||
144 | get = do | ||
145 | n <- remaining | ||
146 | case n of | ||
147 | 4 -> IPv4 <$> get | ||
148 | 16 -> IPv6 <$> get | ||
149 | _ -> fail "Wrong number of bytes remaining to parse IP" | ||
150 | |||
151 | instance Serialize IPv4 where | ||
152 | put = putWord32host . toHostAddress | ||
153 | get = fromHostAddress <$> getWord32host | ||
154 | |||
155 | instance Serialize IPv6 where | ||
156 | put ip = put $ toHostAddress6 ip | ||
157 | get = fromHostAddress6 <$> get | ||
158 | |||
159 | instance Pretty IPv4 where | ||
160 | pretty = PP.text . show | ||
161 | {-# INLINE pretty #-} | ||
162 | |||
163 | instance Pretty IPv6 where | ||
164 | pretty = PP.text . show | ||
165 | {-# INLINE pretty #-} | ||
166 | |||
167 | instance Pretty IP where | ||
168 | pretty = PP.text . show | ||
169 | {-# INLINE pretty #-} | ||
170 | |||
171 | instance Hashable IPv4 where | ||
172 | hashWithSalt = hashUsing toHostAddress | ||
173 | {-# INLINE hashWithSalt #-} | ||
174 | |||
175 | instance Hashable IPv6 where | ||
176 | hashWithSalt s a = hashWithSalt s (toHostAddress6 a) | ||
177 | |||
178 | instance Hashable IP where | ||
179 | hashWithSalt s (IPv4 h) = hashWithSalt s h | ||
180 | hashWithSalt s (IPv6 h) = hashWithSalt s h | ||
181 | |||
182 | {----------------------------------------------------------------------- | ||
183 | -- Peer addr | ||
184 | -----------------------------------------------------------------------} | ||
185 | -- TODO check semantic of ord and eq instances | ||
186 | |||
187 | -- | Peer address info normally extracted from peer list or peer | ||
188 | -- compact list encoding. | ||
189 | data PeerAddr a = PeerAddr | ||
190 | { peerId :: !(Maybe PeerId) | ||
191 | |||
192 | -- | This is usually 'IPv4', 'IPv6', 'IP' or unresolved | ||
193 | -- 'HostName'. | ||
194 | , peerHost :: !a | ||
195 | |||
196 | -- | The port the peer listenning for incoming P2P sessions. | ||
197 | , peerPort :: {-# UNPACK #-} !PortNumber | ||
198 | } deriving (Show, Eq, Ord, Typeable, Functor) | ||
199 | |||
200 | peer_ip_key, peer_id_key, peer_port_key :: BKey | ||
201 | peer_ip_key = "ip" | ||
202 | peer_id_key = "peer id" | ||
203 | peer_port_key = "port" | ||
204 | |||
205 | -- | The tracker's 'announce response' compatible encoding. | ||
206 | instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where | ||
207 | toBEncode PeerAddr {..} = toDict $ | ||
208 | peer_ip_key .=! peerHost | ||
209 | .: peer_id_key .=? peerId | ||
210 | .: peer_port_key .=! peerPort | ||
211 | .: endDict | ||
212 | |||
213 | fromBEncode = fromDict $ do | ||
214 | peerAddr <$>! peer_ip_key | ||
215 | <*>? peer_id_key | ||
216 | <*>! peer_port_key | ||
217 | where | ||
218 | peerAddr = flip PeerAddr | ||
219 | |||
220 | -- | The tracker's 'compact peer list' compatible encoding. The | ||
221 | -- 'peerId' is always 'Nothing'. | ||
222 | -- | ||
223 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | ||
224 | -- | ||
225 | -- TODO: test byte order | ||
226 | instance (Serialize a) => Serialize (PeerAddr a) where | ||
227 | put PeerAddr {..} = put peerHost >> put peerPort | ||
228 | get = PeerAddr Nothing <$> get <*> get | ||
229 | |||
230 | -- | @127.0.0.1:6881@ | ||
231 | instance Default (PeerAddr IPv4) where | ||
232 | def = "127.0.0.1:6881" | ||
233 | |||
234 | -- | @127.0.0.1:6881@ | ||
235 | instance Default (PeerAddr IP) where | ||
236 | def = IPv4 <$> def | ||
237 | |||
238 | -- | Example: | ||
239 | -- | ||
240 | -- @peerPort \"127.0.0.1:6881\" == 6881@ | ||
241 | -- | ||
242 | instance IsString (PeerAddr IPv4) where | ||
243 | fromString str | ||
244 | | [hostAddrStr, portStr] <- splitWhen (== ':') str | ||
245 | , Just hostAddr <- readMaybe hostAddrStr | ||
246 | , Just portNum <- toEnum <$> readMaybe portStr | ||
247 | = PeerAddr Nothing hostAddr portNum | ||
248 | | otherwise = error $ "fromString: unable to parse (PeerAddr IPv4): " ++ str | ||
249 | |||
250 | instance Read (PeerAddr IPv4) where | ||
251 | readsPrec i = RP.readP_to_S $ do | ||
252 | ipv4 <- RP.readS_to_P (readsPrec i) | ||
253 | _ <- RP.char ':' | ||
254 | port <- toEnum <$> RP.readS_to_P (readsPrec i) | ||
255 | return $ PeerAddr Nothing ipv4 port | ||
256 | |||
257 | readsIPv6_port :: String -> [((IPv6, PortNumber), String)] | ||
258 | readsIPv6_port = RP.readP_to_S $ do | ||
259 | ip <- RP.char '[' *> (RP.readS_to_P reads) <* RP.char ']' | ||
260 | _ <- RP.char ':' | ||
261 | port <- toEnum <$> read <$> (RP.many1 $ RP.satisfy isDigit) <* RP.eof | ||
262 | return (ip,port) | ||
263 | |||
264 | instance IsString (PeerAddr IPv6) where | ||
265 | fromString str | ||
266 | | [((ip,port),"")] <- readsIPv6_port str = | ||
267 | PeerAddr Nothing ip port | ||
268 | | otherwise = error $ "fromString: unable to parse (PeerAddr IPv6): " ++ str | ||
269 | |||
270 | instance IsString (PeerAddr IP) where | ||
271 | fromString str | ||
272 | | '[' `L.elem` str = IPv6 <$> fromString str | ||
273 | | otherwise = IPv4 <$> fromString str | ||
274 | |||
275 | -- | fingerprint + "at" + dotted.host.inet.addr:port | ||
276 | -- TODO: instances for IPv6, HostName | ||
277 | instance Pretty a => Pretty (PeerAddr a) where | ||
278 | pretty PeerAddr {..} | ||
279 | | Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr | ||
280 | | otherwise = paddr | ||
281 | where | ||
282 | paddr = pretty peerHost <> ":" <> text (show peerPort) | ||
283 | |||
284 | instance Hashable a => Hashable (PeerAddr a) where | ||
285 | hashWithSalt s PeerAddr {..} = | ||
286 | s `hashWithSalt` peerId `hashWithSalt` peerHost `hashWithSalt` peerPort | ||
287 | |||
288 | -- | Ports typically reserved for bittorrent P2P listener. | ||
289 | defaultPorts :: [PortNumber] | ||
290 | defaultPorts = [6881..6889] | ||
291 | |||
292 | _resolvePeerAddr :: (IPAddress i) => PeerAddr HostName -> PeerAddr i | ||
293 | _resolvePeerAddr = undefined | ||
294 | |||
295 | _peerSockAddr :: PeerAddr IP -> (Family, SockAddr) | ||
296 | _peerSockAddr PeerAddr {..} = | ||
297 | case peerHost of | ||
298 | IPv4 ipv4 -> | ||
299 | (AF_INET, SockAddrInet peerPort (toHostAddress ipv4)) | ||
300 | IPv6 ipv6 -> | ||
301 | (AF_INET6, SockAddrInet6 peerPort 0 (toHostAddress6 ipv6) 0) | ||
302 | |||
303 | peerSockAddr :: PeerAddr IP -> SockAddr | ||
304 | peerSockAddr = snd . _peerSockAddr | ||
305 | |||
306 | -- | Create a socket connected to the address specified in a peerAddr | ||
307 | peerSocket :: SocketType -> PeerAddr IP -> IO Socket | ||
308 | peerSocket socketType pa = do | ||
309 | let (family, addr) = _peerSockAddr pa | ||
310 | sock <- socket family socketType defaultProtocol | ||
311 | connect sock addr | ||
312 | return sock | ||
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs deleted file mode 100644 index a180ff30..00000000 --- a/src/Network/BitTorrent/Core/PeerId.hs +++ /dev/null | |||
@@ -1,364 +0,0 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- 'PeerID' represent self assigned peer identificator. Ideally each | ||
9 | -- host in the network should have unique peer id to avoid | ||
10 | -- collisions, therefore for peer ID generation we use good entropy | ||
11 | -- source. Peer ID is sent in /tracker request/, sent and received in | ||
12 | -- /peer handshakes/ and used in DHT queries. | ||
13 | -- | ||
14 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
15 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
16 | {-# LANGUAGE DeriveDataTypeable #-} | ||
17 | module Network.BitTorrent.Core.PeerId | ||
18 | ( -- * PeerId | ||
19 | PeerId | ||
20 | |||
21 | -- * Generation | ||
22 | , genPeerId | ||
23 | , timestamp | ||
24 | , entropy | ||
25 | |||
26 | -- * Encoding | ||
27 | , azureusStyle | ||
28 | , shadowStyle | ||
29 | , defaultClientId | ||
30 | , defaultVersionNumber | ||
31 | |||
32 | -- * Decoding | ||
33 | , fingerprint | ||
34 | ) where | ||
35 | |||
36 | import Control.Applicative | ||
37 | import Data.BEncode as BE | ||
38 | import Data.ByteString as BS | ||
39 | import Data.ByteString.Internal as BS | ||
40 | import Data.ByteString.Char8 as BC | ||
41 | import qualified Data.ByteString.Lazy as BL | ||
42 | import qualified Data.ByteString.Lazy.Builder as BS | ||
43 | import Data.Convertible | ||
44 | import Data.Default | ||
45 | import Data.Foldable (foldMap) | ||
46 | import Data.List as L | ||
47 | import Data.List.Split as L | ||
48 | import Data.Maybe (fromMaybe, catMaybes) | ||
49 | import Data.Monoid | ||
50 | import Data.Hashable | ||
51 | import Data.Serialize as S | ||
52 | import Data.String | ||
53 | import Data.Time.Clock (getCurrentTime) | ||
54 | import Data.Time.Format (formatTime) | ||
55 | import Data.Typeable | ||
56 | import Data.Version (Version(Version), versionBranch) | ||
57 | import Network.HTTP.Types.QueryLike | ||
58 | import System.Entropy (getEntropy) | ||
59 | import System.Locale (defaultTimeLocale) | ||
60 | import Text.PrettyPrint hiding ((<>)) | ||
61 | import Text.PrettyPrint.Class | ||
62 | import Text.Read (readMaybe) | ||
63 | |||
64 | import Network.BitTorrent.Core.Fingerprint | ||
65 | |||
66 | -- TODO use unpacked Word160 form (length is known statically) | ||
67 | |||
68 | -- | Peer identifier is exactly 20 bytes long bytestring. | ||
69 | newtype PeerId = PeerId { getPeerId :: ByteString } | ||
70 | deriving (Show, Eq, Ord, BEncode, Typeable) | ||
71 | |||
72 | peerIdLen :: Int | ||
73 | peerIdLen = 20 | ||
74 | |||
75 | -- | For testing purposes only. | ||
76 | instance Default PeerId where | ||
77 | def = azureusStyle defaultClientId defaultVersionNumber "" | ||
78 | |||
79 | instance Hashable PeerId where | ||
80 | hashWithSalt = hashUsing getPeerId | ||
81 | {-# INLINE hashWithSalt #-} | ||
82 | |||
83 | instance Serialize PeerId where | ||
84 | put = putByteString . getPeerId | ||
85 | get = PeerId <$> getBytes peerIdLen | ||
86 | |||
87 | instance QueryValueLike PeerId where | ||
88 | toQueryValue (PeerId pid) = Just pid | ||
89 | {-# INLINE toQueryValue #-} | ||
90 | |||
91 | instance IsString PeerId where | ||
92 | fromString str | ||
93 | | BS.length bs == peerIdLen = PeerId bs | ||
94 | | otherwise = error $ "Peer id should be 20 bytes long: " ++ show str | ||
95 | where | ||
96 | bs = fromString str | ||
97 | |||
98 | instance Pretty PeerId where | ||
99 | pretty = text . BC.unpack . getPeerId | ||
100 | |||
101 | instance Convertible BS.ByteString PeerId where | ||
102 | safeConvert bs | ||
103 | | BS.length bs == peerIdLen = pure (PeerId bs) | ||
104 | | otherwise = convError "invalid length" bs | ||
105 | |||
106 | {----------------------------------------------------------------------- | ||
107 | -- Encoding | ||
108 | -----------------------------------------------------------------------} | ||
109 | |||
110 | -- | Pad bytestring so it's becomes exactly request length. Conversion | ||
111 | -- is done like so: | ||
112 | -- | ||
113 | -- * length < size: Complete bytestring by given charaters. | ||
114 | -- | ||
115 | -- * length = size: Output bytestring as is. | ||
116 | -- | ||
117 | -- * length > size: Drop last (length - size) charaters from a | ||
118 | -- given bytestring. | ||
119 | -- | ||
120 | byteStringPadded :: ByteString -- ^ bytestring to be padded. | ||
121 | -> Int -- ^ size of result builder. | ||
122 | -> Char -- ^ character used for padding. | ||
123 | -> BS.Builder | ||
124 | byteStringPadded bs s c = | ||
125 | BS.byteString (BS.take s bs) <> | ||
126 | BS.byteString (BC.replicate padLen c) | ||
127 | where | ||
128 | padLen = s - min (BS.length bs) s | ||
129 | |||
130 | -- | Azureus-style encoding have the following layout: | ||
131 | -- | ||
132 | -- * 1 byte : '-' | ||
133 | -- | ||
134 | -- * 2 bytes: client id | ||
135 | -- | ||
136 | -- * 4 bytes: version number | ||
137 | -- | ||
138 | -- * 1 byte : '-' | ||
139 | -- | ||
140 | -- * 12 bytes: random number | ||
141 | -- | ||
142 | azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'. | ||
143 | -> ByteString -- ^ Version number, padded with 'X'. | ||
144 | -> ByteString -- ^ Random number, padded with '0'. | ||
145 | -> PeerId -- ^ Azureus-style encoded peer ID. | ||
146 | azureusStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $ | ||
147 | BS.char8 '-' <> | ||
148 | byteStringPadded cid 2 'H' <> | ||
149 | byteStringPadded ver 4 'X' <> | ||
150 | BS.char8 '-' <> | ||
151 | byteStringPadded rnd 12 '0' | ||
152 | |||
153 | -- | Shadow-style encoding have the following layout: | ||
154 | -- | ||
155 | -- * 1 byte : client id. | ||
156 | -- | ||
157 | -- * 0-4 bytes: version number. If less than 4 then padded with | ||
158 | -- '-' char. | ||
159 | -- | ||
160 | -- * 15 bytes : random number. If length is less than 15 then | ||
161 | -- padded with '0' char. | ||
162 | -- | ||
163 | shadowStyle :: Char -- ^ Client ID. | ||
164 | -> ByteString -- ^ Version number. | ||
165 | -> ByteString -- ^ Random number. | ||
166 | -> PeerId -- ^ Shadow style encoded peer ID. | ||
167 | shadowStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $ | ||
168 | BS.char8 cid <> | ||
169 | byteStringPadded ver 4 '-' <> | ||
170 | byteStringPadded rnd 15 '0' | ||
171 | |||
172 | |||
173 | -- | 'HS'- 2 bytes long client identifier. | ||
174 | defaultClientId :: ByteString | ||
175 | defaultClientId = "HS" | ||
176 | |||
177 | -- | Gives exactly 4 bytes long version number for any version of the | ||
178 | -- package. Version is taken from .cabal file. | ||
179 | defaultVersionNumber :: ByteString | ||
180 | defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $ | ||
181 | versionBranch $ ciVersion libFingerprint | ||
182 | |||
183 | {----------------------------------------------------------------------- | ||
184 | -- Generation | ||
185 | -----------------------------------------------------------------------} | ||
186 | |||
187 | -- | Gives 15 characters long decimal timestamp such that: | ||
188 | -- | ||
189 | -- * 6 bytes : first 6 characters from picoseconds obtained with %q. | ||
190 | -- | ||
191 | -- * 1 byte : character \'.\' for readability. | ||
192 | -- | ||
193 | -- * 9..* bytes: number of whole seconds since the Unix epoch | ||
194 | -- (!)REVERSED. | ||
195 | -- | ||
196 | -- Can be used both with shadow and azureus style encoding. This | ||
197 | -- format is used to make the ID's readable for debugging purposes. | ||
198 | -- | ||
199 | timestamp :: IO ByteString | ||
200 | timestamp = (BC.pack . format) <$> getCurrentTime | ||
201 | where | ||
202 | format t = L.take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++ | ||
203 | L.take 9 (L.reverse (formatTime defaultTimeLocale "%s" t)) | ||
204 | |||
205 | -- | Gives 15 character long random bytestring. This is more robust | ||
206 | -- method for generation of random part of peer ID than 'timestamp'. | ||
207 | entropy :: IO ByteString | ||
208 | entropy = getEntropy 15 | ||
209 | |||
210 | -- NOTE: entropy generates incorrrect peer id | ||
211 | |||
212 | -- | Here we use 'azureusStyle' encoding with the following args: | ||
213 | -- | ||
214 | -- * 'HS' for the client id; ('defaultClientId') | ||
215 | -- | ||
216 | -- * Version of the package for the version number; | ||
217 | -- ('defaultVersionNumber') | ||
218 | -- | ||
219 | -- * UTC time day ++ day time for the random number. ('timestamp') | ||
220 | -- | ||
221 | genPeerId :: IO PeerId | ||
222 | genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp | ||
223 | |||
224 | {----------------------------------------------------------------------- | ||
225 | -- Decoding | ||
226 | -----------------------------------------------------------------------} | ||
227 | |||
228 | parseImpl :: ByteString -> ClientImpl | ||
229 | parseImpl = f . BC.unpack | ||
230 | where | ||
231 | f "AG" = IAres | ||
232 | f "A~" = IAres | ||
233 | f "AR" = IArctic | ||
234 | f "AV" = IAvicora | ||
235 | f "AX" = IBitPump | ||
236 | f "AZ" = IAzureus | ||
237 | f "BB" = IBitBuddy | ||
238 | f "BC" = IBitComet | ||
239 | f "BF" = IBitflu | ||
240 | f "BG" = IBTG | ||
241 | f "BR" = IBitRocket | ||
242 | f "BS" = IBTSlave | ||
243 | f "BX" = IBittorrentX | ||
244 | f "CD" = IEnhancedCTorrent | ||
245 | f "CT" = ICTorrent | ||
246 | f "DE" = IDelugeTorrent | ||
247 | f "DP" = IPropagateDataClient | ||
248 | f "EB" = IEBit | ||
249 | f "ES" = IElectricSheep | ||
250 | f "FT" = IFoxTorrent | ||
251 | f "GS" = IGSTorrent | ||
252 | f "HL" = IHalite | ||
253 | f "HS" = IlibHSbittorrent | ||
254 | f "HN" = IHydranode | ||
255 | f "KG" = IKGet | ||
256 | f "KT" = IKTorrent | ||
257 | f "LH" = ILH_ABC | ||
258 | f "LP" = ILphant | ||
259 | f "LT" = ILibtorrent | ||
260 | f "lt" = ILibTorrent | ||
261 | f "LW" = ILimeWire | ||
262 | f "MO" = IMonoTorrent | ||
263 | f "MP" = IMooPolice | ||
264 | f "MR" = IMiro | ||
265 | f "ML" = IMLdonkey | ||
266 | f "MT" = IMoonlightTorrent | ||
267 | f "NX" = INetTransport | ||
268 | f "PD" = IPando | ||
269 | f "qB" = IqBittorrent | ||
270 | f "QD" = IQQDownload | ||
271 | f "QT" = IQt4TorrentExample | ||
272 | f "RT" = IRetriever | ||
273 | f "S~" = IShareaza | ||
274 | f "SB" = ISwiftbit | ||
275 | f "SS" = ISwarmScope | ||
276 | f "ST" = ISymTorrent | ||
277 | f "st" = Isharktorrent | ||
278 | f "SZ" = IShareaza | ||
279 | f "TN" = ITorrentDotNET | ||
280 | f "TR" = ITransmission | ||
281 | f "TS" = ITorrentstorm | ||
282 | f "TT" = ITuoTu | ||
283 | f "UL" = IuLeecher | ||
284 | f "UT" = IuTorrent | ||
285 | f "VG" = IVagaa | ||
286 | f "WT" = IBitLet | ||
287 | f "WY" = IFireTorrent | ||
288 | f "XL" = IXunlei | ||
289 | f "XT" = IXanTorrent | ||
290 | f "XX" = IXtorrent | ||
291 | f "ZT" = IZipTorrent | ||
292 | f _ = IUnknown | ||
293 | |||
294 | -- TODO use regexps | ||
295 | |||
296 | -- | Tries to extract meaningful information from peer ID bytes. If | ||
297 | -- peer id uses unknown coding style then client info returned is | ||
298 | -- 'def'. | ||
299 | -- | ||
300 | fingerprint :: PeerId -> Fingerprint | ||
301 | fingerprint pid = either (const def) id $ runGet getCI (getPeerId pid) | ||
302 | where | ||
303 | getCI = do | ||
304 | leading <- BS.w2c <$> getWord8 | ||
305 | case leading of | ||
306 | '-' -> Fingerprint <$> getAzureusImpl <*> getAzureusVersion | ||
307 | 'M' -> Fingerprint <$> pure IMainline <*> getMainlineVersion | ||
308 | 'e' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion | ||
309 | 'F' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion | ||
310 | c -> do | ||
311 | c1 <- w2c <$> S.lookAhead getWord8 | ||
312 | if c1 == 'P' | ||
313 | then do | ||
314 | _ <- getWord8 | ||
315 | Fingerprint <$> pure IOpera <*> getOperaVersion | ||
316 | else Fingerprint <$> pure (getShadowImpl c) <*> getShadowVersion | ||
317 | |||
318 | getMainlineVersion = do | ||
319 | str <- BC.unpack <$> getByteString 7 | ||
320 | let mnums = L.filter (not . L.null) $ L.linesBy ('-' ==) str | ||
321 | return $ Version (fromMaybe [] $ sequence $ L.map readMaybe mnums) [] | ||
322 | |||
323 | getAzureusImpl = parseImpl <$> getByteString 2 | ||
324 | getAzureusVersion = mkVer <$> getByteString 4 | ||
325 | where | ||
326 | mkVer bs = Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] [] | ||
327 | |||
328 | getBitCometImpl = do | ||
329 | bs <- getByteString 3 | ||
330 | S.lookAhead $ do | ||
331 | _ <- getByteString 2 | ||
332 | lr <- getByteString 4 | ||
333 | return $ | ||
334 | if lr == "LORD" then IBitLord else | ||
335 | if bs == "UTB" then IBitComet else | ||
336 | if bs == "xbc" then IBitComet else def | ||
337 | |||
338 | getBitCometVersion = do | ||
339 | x <- getWord8 | ||
340 | y <- getWord8 | ||
341 | return $ Version [fromIntegral x, fromIntegral y] [] | ||
342 | |||
343 | getOperaVersion = do | ||
344 | str <- BC.unpack <$> getByteString 4 | ||
345 | return $ Version [fromMaybe 0 $ readMaybe str] [] | ||
346 | |||
347 | getShadowImpl 'A' = IABC | ||
348 | getShadowImpl 'O' = IOspreyPermaseed | ||
349 | getShadowImpl 'Q' = IBTQueue | ||
350 | getShadowImpl 'R' = ITribler | ||
351 | getShadowImpl 'S' = IShadow | ||
352 | getShadowImpl 'T' = IBitTornado | ||
353 | getShadowImpl _ = IUnknown | ||
354 | |||
355 | decodeShadowVerNr :: Char -> Maybe Int | ||
356 | decodeShadowVerNr c | ||
357 | | '0' < c && c <= '9' = Just (fromEnum c - fromEnum '0') | ||
358 | | 'A' < c && c <= 'Z' = Just ((fromEnum c - fromEnum 'A') + 10) | ||
359 | | 'a' < c && c <= 'z' = Just ((fromEnum c - fromEnum 'a') + 36) | ||
360 | | otherwise = Nothing | ||
361 | |||
362 | getShadowVersion = do | ||
363 | str <- BC.unpack <$> getByteString 5 | ||
364 | return $ Version (catMaybes $ L.map decodeShadowVerNr str) [] | ||
diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs index b6067456..39b33478 100644 --- a/src/Network/BitTorrent/DHT.hs +++ b/src/Network/BitTorrent/DHT.hs | |||
@@ -63,7 +63,7 @@ import Data.Conduit.List as C | |||
63 | import Network.Socket | 63 | import Network.Socket |
64 | 64 | ||
65 | import Data.Torrent | 65 | import Data.Torrent |
66 | import Network.BitTorrent.Core | 66 | import Network.BitTorrent.Address |
67 | import Network.BitTorrent.DHT.Query | 67 | import Network.BitTorrent.DHT.Query |
68 | import Network.BitTorrent.DHT.Session | 68 | import Network.BitTorrent.DHT.Session |
69 | import Network.BitTorrent.DHT.Routing as T | 69 | import Network.BitTorrent.DHT.Routing as T |
diff --git a/src/Network/BitTorrent/DHT/ContactInfo.hs b/src/Network/BitTorrent/DHT/ContactInfo.hs index 201b84ee..baa240b4 100644 --- a/src/Network/BitTorrent/DHT/ContactInfo.hs +++ b/src/Network/BitTorrent/DHT/ContactInfo.hs | |||
@@ -12,13 +12,13 @@ import Data.HashMap.Strict as HM | |||
12 | import Data.Serialize | 12 | import Data.Serialize |
13 | 13 | ||
14 | import Data.Torrent | 14 | import Data.Torrent |
15 | import Network.BitTorrent.Core.PeerAddr | 15 | import Network.BitTorrent.Address |
16 | 16 | ||
17 | {- | 17 | {- |
18 | import Data.HashMap.Strict as HM | 18 | import Data.HashMap.Strict as HM |
19 | 19 | ||
20 | import Data.Torrent.InfoHash | 20 | import Data.Torrent.InfoHash |
21 | import Network.BitTorrent.Core | 21 | import Network.BitTorrent.Address |
22 | 22 | ||
23 | -- increase prefix when table is too large | 23 | -- increase prefix when table is too large |
24 | -- decrease prefix when table is too small | 24 | -- decrease prefix when table is too small |
diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs index 06274fa7..145141ee 100644 --- a/src/Network/BitTorrent/DHT/Message.hs +++ b/src/Network/BitTorrent/DHT/Message.hs | |||
@@ -93,7 +93,7 @@ import Network | |||
93 | import Network.KRPC | 93 | import Network.KRPC |
94 | 94 | ||
95 | import Data.Torrent | 95 | import Data.Torrent |
96 | import Network.BitTorrent.Core | 96 | import Network.BitTorrent.Address |
97 | import Network.BitTorrent.DHT.Token | 97 | import Network.BitTorrent.DHT.Token |
98 | import Network.KRPC () | 98 | import Network.KRPC () |
99 | 99 | ||
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs index 497c9001..d4710ecf 100644 --- a/src/Network/BitTorrent/DHT/Query.hs +++ b/src/Network/BitTorrent/DHT/Query.hs | |||
@@ -57,7 +57,7 @@ import Text.PrettyPrint.Class | |||
57 | 57 | ||
58 | import Network.KRPC hiding (Options, def) | 58 | import Network.KRPC hiding (Options, def) |
59 | import Data.Torrent | 59 | import Data.Torrent |
60 | import Network.BitTorrent.Core | 60 | import Network.BitTorrent.Address |
61 | import Network.BitTorrent.DHT.Message | 61 | import Network.BitTorrent.DHT.Message |
62 | import Network.BitTorrent.DHT.Routing | 62 | import Network.BitTorrent.DHT.Routing |
63 | import Network.BitTorrent.DHT.Session | 63 | import Network.BitTorrent.DHT.Session |
diff --git a/src/Network/BitTorrent/DHT/Routing.hs b/src/Network/BitTorrent/DHT/Routing.hs index 5dc511bd..ee295125 100644 --- a/src/Network/BitTorrent/DHT/Routing.hs +++ b/src/Network/BitTorrent/DHT/Routing.hs | |||
@@ -74,7 +74,7 @@ import Text.PrettyPrint as PP hiding ((<>)) | |||
74 | import Text.PrettyPrint.Class | 74 | import Text.PrettyPrint.Class |
75 | 75 | ||
76 | import Data.Torrent | 76 | import Data.Torrent |
77 | import Network.BitTorrent.Core | 77 | import Network.BitTorrent.Address |
78 | 78 | ||
79 | {----------------------------------------------------------------------- | 79 | {----------------------------------------------------------------------- |
80 | -- Routing monad | 80 | -- Routing monad |
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs index 8fe81abd..0dd4b862 100644 --- a/src/Network/BitTorrent/DHT/Session.hs +++ b/src/Network/BitTorrent/DHT/Session.hs | |||
@@ -94,8 +94,7 @@ import Text.PrettyPrint.Class | |||
94 | import Data.Torrent as Torrent | 94 | import Data.Torrent as Torrent |
95 | import Network.KRPC hiding (Options, def) | 95 | import Network.KRPC hiding (Options, def) |
96 | import qualified Network.KRPC as KRPC (def) | 96 | import qualified Network.KRPC as KRPC (def) |
97 | import Network.BitTorrent.Core | 97 | import Network.BitTorrent.Address |
98 | import Network.BitTorrent.Core.PeerAddr | ||
99 | import Network.BitTorrent.DHT.ContactInfo as P | 98 | import Network.BitTorrent.DHT.ContactInfo as P |
100 | import Network.BitTorrent.DHT.Message | 99 | import Network.BitTorrent.DHT.Message |
101 | import Network.BitTorrent.DHT.Routing as R | 100 | import Network.BitTorrent.DHT.Routing as R |
diff --git a/src/Network/BitTorrent/DHT/Token.hs b/src/Network/BitTorrent/DHT/Token.hs index a38456fd..a0ed428b 100644 --- a/src/Network/BitTorrent/DHT/Token.hs +++ b/src/Network/BitTorrent/DHT/Token.hs | |||
@@ -50,7 +50,7 @@ import Data.String | |||
50 | import Data.Time | 50 | import Data.Time |
51 | import System.Random | 51 | import System.Random |
52 | 52 | ||
53 | import Network.BitTorrent.Core | 53 | import Network.BitTorrent.Address |
54 | 54 | ||
55 | -- TODO use ShortByteString | 55 | -- TODO use ShortByteString |
56 | 56 | ||
diff --git a/src/Network/BitTorrent/Exchange/Assembler.hs b/src/Network/BitTorrent/Exchange/Assembler.hs index e17dfbe2..7abb8ab0 100644 --- a/src/Network/BitTorrent/Exchange/Assembler.hs +++ b/src/Network/BitTorrent/Exchange/Assembler.hs | |||
@@ -68,7 +68,7 @@ import Data.Maybe | |||
68 | import Data.IP | 68 | import Data.IP |
69 | 69 | ||
70 | import Data.Torrent | 70 | import Data.Torrent |
71 | import Network.BitTorrent.Core | 71 | import Network.BitTorrent.Address |
72 | import Network.BitTorrent.Exchange.Block as B | 72 | import Network.BitTorrent.Exchange.Block as B |
73 | 73 | ||
74 | {----------------------------------------------------------------------- | 74 | {----------------------------------------------------------------------- |
diff --git a/src/Network/BitTorrent/Exchange/Connection.hs b/src/Network/BitTorrent/Exchange/Connection.hs index 42b991a0..9b7942ae 100644 --- a/src/Network/BitTorrent/Exchange/Connection.hs +++ b/src/Network/BitTorrent/Exchange/Connection.hs | |||
@@ -137,7 +137,7 @@ import System.Timeout | |||
137 | 137 | ||
138 | import Data.Torrent.Bitfield as BF | 138 | import Data.Torrent.Bitfield as BF |
139 | import Data.Torrent | 139 | import Data.Torrent |
140 | import Network.BitTorrent.Core | 140 | import Network.BitTorrent.Address |
141 | import Network.BitTorrent.Exchange.Message as Msg | 141 | import Network.BitTorrent.Exchange.Message as Msg |
142 | 142 | ||
143 | -- TODO handle port message? | 143 | -- TODO handle port message? |
diff --git a/src/Network/BitTorrent/Exchange/Manager.hs b/src/Network/BitTorrent/Exchange/Manager.hs index ad7a47a2..54727805 100644 --- a/src/Network/BitTorrent/Exchange/Manager.hs +++ b/src/Network/BitTorrent/Exchange/Manager.hs | |||
@@ -13,7 +13,7 @@ import Data.Default | |||
13 | import Network.Socket | 13 | import Network.Socket |
14 | 14 | ||
15 | import Data.Torrent | 15 | import Data.Torrent |
16 | import Network.BitTorrent.Core | 16 | import Network.BitTorrent.Address |
17 | import Network.BitTorrent.Exchange.Connection hiding (Options) | 17 | import Network.BitTorrent.Exchange.Connection hiding (Options) |
18 | import Network.BitTorrent.Exchange.Session | 18 | import Network.BitTorrent.Exchange.Session |
19 | 19 | ||
diff --git a/src/Network/BitTorrent/Exchange/Message.hs b/src/Network/BitTorrent/Exchange/Message.hs index 5ca7c97e..a0cb5c91 100644 --- a/src/Network/BitTorrent/Exchange/Message.hs +++ b/src/Network/BitTorrent/Exchange/Message.hs | |||
@@ -120,7 +120,7 @@ import Text.PrettyPrint.Class | |||
120 | import Data.Torrent.Bitfield | 120 | import Data.Torrent.Bitfield |
121 | import Data.Torrent hiding (Piece (..)) | 121 | import Data.Torrent hiding (Piece (..)) |
122 | import qualified Data.Torrent as P (Piece (..)) | 122 | import qualified Data.Torrent as P (Piece (..)) |
123 | import Network.BitTorrent.Core | 123 | import Network.BitTorrent.Address |
124 | import Network.BitTorrent.Exchange.Block | 124 | import Network.BitTorrent.Exchange.Block |
125 | 125 | ||
126 | {----------------------------------------------------------------------- | 126 | {----------------------------------------------------------------------- |
diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs index cae3a2d5..b68f17a0 100644 --- a/src/Network/BitTorrent/Exchange/Session.hs +++ b/src/Network/BitTorrent/Exchange/Session.hs | |||
@@ -48,7 +48,7 @@ import Data.BEncode as BE | |||
48 | import Data.Torrent as Torrent | 48 | import Data.Torrent as Torrent |
49 | import Data.Torrent.Bitfield as BF | 49 | import Data.Torrent.Bitfield as BF |
50 | import Network.BitTorrent.Internal.Types | 50 | import Network.BitTorrent.Internal.Types |
51 | import Network.BitTorrent.Core | 51 | import Network.BitTorrent.Address |
52 | import Network.BitTorrent.Exchange.Block as Block | 52 | import Network.BitTorrent.Exchange.Block as Block |
53 | import Network.BitTorrent.Exchange.Connection | 53 | import Network.BitTorrent.Exchange.Connection |
54 | import Network.BitTorrent.Exchange.Message as Message | 54 | import Network.BitTorrent.Exchange.Message as Message |
diff --git a/src/Network/BitTorrent/Exchange/Session/Metadata.hs b/src/Network/BitTorrent/Exchange/Session/Metadata.hs index a4e54659..f08ebe00 100644 --- a/src/Network/BitTorrent/Exchange/Session/Metadata.hs +++ b/src/Network/BitTorrent/Exchange/Session/Metadata.hs | |||
@@ -27,7 +27,7 @@ import Data.Tuple | |||
27 | 27 | ||
28 | import Data.BEncode as BE | 28 | import Data.BEncode as BE |
29 | import Data.Torrent as Torrent | 29 | import Data.Torrent as Torrent |
30 | import Network.BitTorrent.Core | 30 | import Network.BitTorrent.Address |
31 | import Network.BitTorrent.Exchange.Block as Block | 31 | import Network.BitTorrent.Exchange.Block as Block |
32 | import Network.BitTorrent.Exchange.Message as Message hiding (Status) | 32 | import Network.BitTorrent.Exchange.Message as Message hiding (Status) |
33 | 33 | ||
diff --git a/src/Network/BitTorrent/Exchange/Session/Status.hs b/src/Network/BitTorrent/Exchange/Session/Status.hs index 4feff8d6..63b91926 100644 --- a/src/Network/BitTorrent/Exchange/Session/Status.hs +++ b/src/Network/BitTorrent/Exchange/Session/Status.hs | |||
@@ -30,7 +30,7 @@ import Data.Tuple | |||
30 | 30 | ||
31 | import Data.Torrent | 31 | import Data.Torrent |
32 | import Data.Torrent.Bitfield as BF | 32 | import Data.Torrent.Bitfield as BF |
33 | import Network.BitTorrent.Core | 33 | import Network.BitTorrent.Address |
34 | import Network.BitTorrent.Exchange.Block as Block | 34 | import Network.BitTorrent.Exchange.Block as Block |
35 | import System.Torrent.Storage (Storage, writePiece) | 35 | import System.Torrent.Storage (Storage, writePiece) |
36 | 36 | ||
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs index e58f6d70..d251d0ad 100644 --- a/src/Network/BitTorrent/Tracker/Message.hs +++ b/src/Network/BitTorrent/Tracker/Message.hs | |||
@@ -126,7 +126,7 @@ import Text.Read (readMaybe) | |||
126 | 126 | ||
127 | import Data.Torrent | 127 | import Data.Torrent |
128 | import Data.Torrent.Progress | 128 | import Data.Torrent.Progress |
129 | import Network.BitTorrent.Core | 129 | import Network.BitTorrent.Address |
130 | 130 | ||
131 | 131 | ||
132 | {----------------------------------------------------------------------- | 132 | {----------------------------------------------------------------------- |
diff --git a/src/Network/BitTorrent/Tracker/RPC.hs b/src/Network/BitTorrent/Tracker/RPC.hs index 9148f1f5..ecb1001c 100644 --- a/src/Network/BitTorrent/Tracker/RPC.hs +++ b/src/Network/BitTorrent/Tracker/RPC.hs | |||
@@ -38,7 +38,7 @@ import Network.Socket (HostAddress) | |||
38 | 38 | ||
39 | import Data.Torrent | 39 | import Data.Torrent |
40 | import Data.Torrent.Progress | 40 | import Data.Torrent.Progress |
41 | import Network.BitTorrent.Core | 41 | import Network.BitTorrent.Address |
42 | import Network.BitTorrent.Tracker.Message | 42 | import Network.BitTorrent.Tracker.Message |
43 | import qualified Network.BitTorrent.Tracker.RPC.HTTP as HTTP | 43 | import qualified Network.BitTorrent.Tracker.RPC.HTTP as HTTP |
44 | import qualified Network.BitTorrent.Tracker.RPC.UDP as UDP | 44 | import qualified Network.BitTorrent.Tracker.RPC.UDP as UDP |
diff --git a/src/Network/BitTorrent/Tracker/RPC/HTTP.hs b/src/Network/BitTorrent/Tracker/RPC/HTTP.hs index b4924e6d..6e55eb04 100644 --- a/src/Network/BitTorrent/Tracker/RPC/HTTP.hs +++ b/src/Network/BitTorrent/Tracker/RPC/HTTP.hs | |||
@@ -48,7 +48,7 @@ import Network.HTTP.Types.Header (hUserAgent) | |||
48 | import Network.HTTP.Types.URI (SimpleQuery, renderSimpleQuery) | 48 | import Network.HTTP.Types.URI (SimpleQuery, renderSimpleQuery) |
49 | 49 | ||
50 | import Data.Torrent (InfoHash) | 50 | import Data.Torrent (InfoHash) |
51 | import Network.BitTorrent.Core.Fingerprint (libUserAgent) | 51 | import Network.BitTorrent.Address (libUserAgent) |
52 | import Network.BitTorrent.Tracker.Message hiding (Request, Response) | 52 | import Network.BitTorrent.Tracker.Message hiding (Request, Response) |
53 | 53 | ||
54 | {----------------------------------------------------------------------- | 54 | {----------------------------------------------------------------------- |
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs index 35db459f..cef7d665 100644 --- a/src/Network/BitTorrent/Tracker/Session.hs +++ b/src/Network/BitTorrent/Tracker/Session.hs | |||
@@ -58,7 +58,7 @@ import Data.Traversable | |||
58 | import Network.URI | 58 | import Network.URI |
59 | 59 | ||
60 | import Data.Torrent | 60 | import Data.Torrent |
61 | import Network.BitTorrent.Core | 61 | import Network.BitTorrent.Address |
62 | import Network.BitTorrent.Internal.Cache | 62 | import Network.BitTorrent.Internal.Cache |
63 | import Network.BitTorrent.Internal.Types | 63 | import Network.BitTorrent.Internal.Types |
64 | import Network.BitTorrent.Tracker.List as TL | 64 | import Network.BitTorrent.Tracker.List as TL |