diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2013-11-22 06:20:23 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2013-11-22 06:20:23 +0400 |
commit | 0af9747748cc4fa5b551f835eee140e0c414a9b6 (patch) | |
tree | 9e29b944881a6213726f31ab767d0d29fd220626 | |
parent | 1c0b414c732507851454cf75da1e74b1c89fed7d (diff) |
Add documentation to Message module
-rw-r--r-- | src/Network/BitTorrent/Core/PeerAddr.hs | 6 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/HTTP.hs | 32 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/Message.hs | 42 |
3 files changed, 39 insertions, 41 deletions
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs index a4f45e74..5570bfc1 100644 --- a/src/Network/BitTorrent/Core/PeerAddr.hs +++ b/src/Network/BitTorrent/Core/PeerAddr.hs | |||
@@ -16,6 +16,7 @@ | |||
16 | module Network.BitTorrent.Core.PeerAddr | 16 | module Network.BitTorrent.Core.PeerAddr |
17 | ( -- * Peer address | 17 | ( -- * Peer address |
18 | PeerAddr(..) | 18 | PeerAddr(..) |
19 | , defaultPorts | ||
19 | , peerSockAddr | 20 | , peerSockAddr |
20 | , connectToPeer | 21 | , connectToPeer |
21 | , ppPeer | 22 | , ppPeer |
@@ -81,12 +82,17 @@ instance BEncode PeerAddr where | |||
81 | -- 'peerId' is always 'Nothing'. | 82 | -- 'peerId' is always 'Nothing'. |
82 | -- | 83 | -- |
83 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | 84 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> |
85 | -- | ||
84 | instance Serialize PeerAddr where | 86 | instance Serialize PeerAddr where |
85 | put PeerAddr {..} = put peerID >> put peerPort | 87 | put PeerAddr {..} = put peerID >> put peerPort |
86 | {-# INLINE put #-} | 88 | {-# INLINE put #-} |
87 | get = PeerAddr Nothing <$> get <*> get | 89 | get = PeerAddr Nothing <$> get <*> get |
88 | {-# INLINE get #-} | 90 | {-# INLINE get #-} |
89 | 91 | ||
92 | -- | Ports typically reserved for bittorrent P2P listener. | ||
93 | defaultPorts :: [PortNumber] | ||
94 | defaultPorts = [6881..6889] | ||
95 | |||
90 | -- TODO make platform independent, clarify htonl | 96 | -- TODO make platform independent, clarify htonl |
91 | 97 | ||
92 | -- | Convert peer info from tracker response to socket address. Used | 98 | -- | Convert peer info from tracker response to socket address. Used |
diff --git a/src/Network/BitTorrent/Tracker/HTTP.hs b/src/Network/BitTorrent/Tracker/HTTP.hs index 55b347ce..2d49436d 100644 --- a/src/Network/BitTorrent/Tracker/HTTP.hs +++ b/src/Network/BitTorrent/Tracker/HTTP.hs | |||
@@ -17,7 +17,7 @@ module Network.BitTorrent.Tracker.HTTP | |||
17 | ( HTTPTracker | 17 | ( HTTPTracker |
18 | 18 | ||
19 | -- * Extra | 19 | -- * Extra |
20 | , scrapeURL | 20 | -- , scrapeURL |
21 | ) where | 21 | ) where |
22 | 22 | ||
23 | import Control.Exception | 23 | import Control.Exception |
@@ -25,13 +25,27 @@ import Data.BEncode | |||
25 | import Data.ByteString as B | 25 | import Data.ByteString as B |
26 | import Data.ByteString.Char8 as BC | 26 | import Data.ByteString.Char8 as BC |
27 | import Data.List as L | 27 | import Data.List as L |
28 | import Data.Map as M | ||
28 | import Data.Monoid | 29 | import Data.Monoid |
29 | import Data.URLEncoded as URL | 30 | import Data.URLEncoded as URL |
30 | import Network.URI | 31 | import Network.URI |
31 | import Network.HTTP | 32 | import Network.HTTP |
32 | 33 | ||
33 | import Network.BitTorrent.Tracker.Protocol | 34 | import Data.Torrent.InfoHash |
35 | import Network.BitTorrent.Tracker.Message | ||
34 | 36 | ||
37 | -- | Set of tracker RPCs. | ||
38 | class Tracker s where | ||
39 | connect :: URI -> IO s | ||
40 | announce :: s -> AnnounceQuery -> IO AnnounceInfo | ||
41 | scrape :: s -> ScrapeQuery -> IO Scrape | ||
42 | |||
43 | -- | More particular version of 'scrape', just for one torrent. | ||
44 | -- | ||
45 | scrapeOne :: Tracker t => t -> InfoHash -> IO ScrapeInfo | ||
46 | scrapeOne uri ih = scrape uri [ih] >>= maybe err return . M.lookup ih | ||
47 | where | ||
48 | err = throwIO $ userError "unable to find info hash in response dict" | ||
35 | 49 | ||
36 | data HTTPTracker = HTTPTracker | 50 | data HTTPTracker = HTTPTracker |
37 | { announceURI :: URI | 51 | { announceURI :: URI |
@@ -40,17 +54,12 @@ data HTTPTracker = HTTPTracker | |||
40 | instance Tracker HTTPTracker where | 54 | instance Tracker HTTPTracker where |
41 | connect = return . HTTPTracker | 55 | connect = return . HTTPTracker |
42 | announce = announceHTTP | 56 | announce = announceHTTP |
43 | scrape = scrapeHTTP | 57 | -- scrape = scrapeHTTP |
44 | 58 | ||
45 | {----------------------------------------------------------------------- | 59 | {----------------------------------------------------------------------- |
46 | Announce | 60 | Announce |
47 | -----------------------------------------------------------------------} | 61 | -----------------------------------------------------------------------} |
48 | 62 | ||
49 | encodeRequest :: URI -> AnnounceQuery -> URI | ||
50 | encodeRequest announceURI req = URL.urlEncode req | ||
51 | `addToURI` announceURI | ||
52 | `addHashToURI` reqInfoHash req | ||
53 | |||
54 | mkGET :: URI -> Request ByteString | 63 | mkGET :: URI -> Request ByteString |
55 | mkGET uri = Request uri GET [] "" | 64 | mkGET uri = Request uri GET [] "" |
56 | 65 | ||
@@ -64,14 +73,14 @@ announceHTTP HTTPTracker {..} req = do | |||
64 | 73 | ||
65 | rawResp <- simpleHTTP r | 74 | rawResp <- simpleHTTP r |
66 | respBody <- getResponseBody rawResp | 75 | respBody <- getResponseBody rawResp |
67 | checkResult $ decoded respBody | 76 | checkResult $ decode respBody |
68 | where | 77 | where |
69 | checkResult (Left err) | 78 | checkResult (Left err) |
70 | = ioError $ userError $ err ++ " in tracker response" | 79 | = ioError $ userError $ err ++ " in tracker response" |
71 | checkResult (Right (Failure err)) | 80 | checkResult (Right (Failure err)) |
72 | = ioError $ userError $ show err ++ " in tracker response" | 81 | = ioError $ userError $ show err ++ " in tracker response" |
73 | checkResult (Right resp) = return resp | 82 | checkResult (Right resp) = return resp |
74 | 83 | {- | |
75 | {----------------------------------------------------------------------- | 84 | {----------------------------------------------------------------------- |
76 | Scrape | 85 | Scrape |
77 | -----------------------------------------------------------------------} | 86 | -----------------------------------------------------------------------} |
@@ -109,8 +118,9 @@ scrapeHTTP HTTPTracker {..} ihs | |||
109 | | Just uri <- scrapeURL announceURI ihs = do | 118 | | Just uri <- scrapeURL announceURI ihs = do |
110 | rawResp <- simpleHTTP (Request uri GET [] "") | 119 | rawResp <- simpleHTTP (Request uri GET [] "") |
111 | respBody <- getResponseBody rawResp | 120 | respBody <- getResponseBody rawResp |
112 | case decoded (BC.pack respBody) of | 121 | case decode (BC.pack respBody) of |
113 | Left e -> throwIO $ userError $ e ++ " in scrape response" | 122 | Left e -> throwIO $ userError $ e ++ " in scrape response" |
114 | Right r -> return r | 123 | Right r -> return r |
115 | 124 | ||
116 | | otherwise = throwIO $ userError "Tracker do not support scraping" | 125 | | otherwise = throwIO $ userError "Tracker do not support scraping" |
126 | -} \ No newline at end of file | ||
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs index c46d5d58..508ff4c5 100644 --- a/src/Network/BitTorrent/Tracker/Message.hs +++ b/src/Network/BitTorrent/Tracker/Message.hs | |||
@@ -25,23 +25,20 @@ | |||
25 | {-# OPTIONS -fno-warn-orphans #-} | 25 | {-# OPTIONS -fno-warn-orphans #-} |
26 | module Network.BitTorrent.Tracker.Message | 26 | module Network.BitTorrent.Tracker.Message |
27 | ( -- * Announce | 27 | ( -- * Announce |
28 | -- ** Request | ||
28 | Event(..) | 29 | Event(..) |
29 | , AnnounceQuery(..) | 30 | , AnnounceQuery(..) |
31 | , encodeRequest | ||
32 | |||
33 | -- ** Response | ||
30 | , PeerList (..) | 34 | , PeerList (..) |
31 | , AnnounceInfo(..) | 35 | , AnnounceInfo(..) |
32 | |||
33 | -- ** Defaults | ||
34 | , defaultNumWant | 36 | , defaultNumWant |
35 | , defaultPorts | ||
36 | 37 | ||
37 | -- * Scrape | 38 | -- * Scrape |
38 | , ScrapeQuery | 39 | , ScrapeQuery |
39 | , ScrapeInfo(..) | 40 | , ScrapeInfo(..) |
40 | , Scrape | 41 | , Scrape |
41 | |||
42 | -- * TODO | ||
43 | , Tracker(..) | ||
44 | , scrapeOne | ||
45 | ) | 42 | ) |
46 | where | 43 | where |
47 | 44 | ||
@@ -212,10 +209,16 @@ instance Serialize AnnounceQuery where | |||
212 | , reqEvent = ev | 209 | , reqEvent = ev |
213 | } | 210 | } |
214 | 211 | ||
212 | encodeRequest :: URI -> AnnounceQuery -> URI | ||
213 | encodeRequest announceURI req = URL.urlEncode req | ||
214 | `addToURI` announceURI | ||
215 | `addHashToURI` reqInfoHash req | ||
216 | |||
215 | {----------------------------------------------------------------------- | 217 | {----------------------------------------------------------------------- |
216 | -- Announce response | 218 | -- Announce response |
217 | -----------------------------------------------------------------------} | 219 | -----------------------------------------------------------------------} |
218 | 220 | ||
221 | -- | For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | ||
219 | data PeerList | 222 | data PeerList |
220 | = PeerList { getPeerList :: [PeerAddr] } | 223 | = PeerList { getPeerList :: [PeerAddr] } |
221 | | CompactPeerList { getPeerList :: [PeerAddr] } | 224 | | CompactPeerList { getPeerList :: [PeerAddr] } |
@@ -323,24 +326,16 @@ instance Serialize AnnounceInfo where | |||
323 | , respPeers = PeerList peers | 326 | , respPeers = PeerList peers |
324 | } | 327 | } |
325 | 328 | ||
326 | -- TODO move this somewhere else | ||
327 | -- | Ports typically reserved for bittorrent P2P listener. | ||
328 | defaultPorts :: [PortNumber] | ||
329 | defaultPorts = [6881..6889] | ||
330 | |||
331 | -- | Above 25, new peers are highly unlikely to increase download | 329 | -- | Above 25, new peers are highly unlikely to increase download |
332 | -- speed. Even 30 peers is /plenty/, the official client version 3 | 330 | -- speed. Even 30 peers is /plenty/, the official client version 3 |
333 | -- in fact only actively forms new connections if it has less than | 331 | -- in fact only actively forms new connections if it has less than |
334 | -- 30 peers and will refuse connections if it has 55. | 332 | -- 30 peers and will refuse connections if it has 55. |
335 | -- | 333 | -- |
336 | -- So the default value is set to 50 because usually 30-50% of peers | 334 | -- <https://wiki.theory.org/BitTorrent_Tracker_Protocol#Basic_Tracker_Announce_Request> |
337 | -- are not responding. | ||
338 | -- | 335 | -- |
339 | defaultNumWant :: Int | 336 | defaultNumWant :: Int |
340 | defaultNumWant = 50 | 337 | defaultNumWant = 50 |
341 | 338 | ||
342 | -- default value here: <https://wiki.theory.org/BitTorrent_Tracker_Protocol> | ||
343 | |||
344 | {----------------------------------------------------------------------- | 339 | {----------------------------------------------------------------------- |
345 | Scrape message | 340 | Scrape message |
346 | -----------------------------------------------------------------------} | 341 | -----------------------------------------------------------------------} |
@@ -384,7 +379,7 @@ instance BEncode ScrapeInfo where | |||
384 | <*>! "incomplete" | 379 | <*>! "incomplete" |
385 | <*>? "name" | 380 | <*>? "name" |
386 | 381 | ||
387 | -- | UDP tracker protocol complatble encoding. | 382 | -- | UDP tracker protocol compatible encoding. |
388 | instance Serialize ScrapeInfo where | 383 | instance Serialize ScrapeInfo where |
389 | put ScrapeInfo {..} = do | 384 | put ScrapeInfo {..} = do |
390 | putWord32be $ fromIntegral siComplete | 385 | putWord32be $ fromIntegral siComplete |
@@ -402,16 +397,3 @@ instance Serialize ScrapeInfo where | |||
402 | , siIncomplete = fromIntegral leechers | 397 | , siIncomplete = fromIntegral leechers |
403 | , siName = Nothing | 398 | , siName = Nothing |
404 | } | 399 | } |
405 | |||
406 | -- | Set of tracker RPCs. | ||
407 | class Tracker s where | ||
408 | connect :: URI -> IO s | ||
409 | announce :: s -> AnnounceQuery -> IO AnnounceInfo | ||
410 | scrape :: s -> ScrapeQuery -> IO Scrape | ||
411 | |||
412 | -- | More particular version of 'scrape', just for one torrent. | ||
413 | -- | ||
414 | scrapeOne :: Tracker t => t -> InfoHash -> IO ScrapeInfo | ||
415 | scrapeOne uri ih = scrape uri [ih] >>= maybe err return . M.lookup ih | ||
416 | where | ||
417 | err = throwIO $ userError "unable to find info hash in response dict" | ||