diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-07-20 21:03:35 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-07-20 21:03:35 +0400 |
commit | 4a2563fde26c2c30b476d3451831341ea1398453 (patch) | |
tree | 6628cb1bfad59741cf0cb6c57c51c26bd858216d /src | |
parent | 2b0904572760fb7f3940168d6be5d1628854b009 (diff) |
~ Move scrape info to Protocol.
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent/Tracker.hs | 35 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/Protocol.hs | 87 |
2 files changed, 66 insertions, 56 deletions
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs index 7a43fb23..5acaa3cc 100644 --- a/src/Network/BitTorrent/Tracker.hs +++ b/src/Network/BitTorrent/Tracker.hs | |||
@@ -44,7 +44,6 @@ import Control.Concurrent.STM | |||
44 | import Control.Exception | 44 | import Control.Exception |
45 | import Control.Monad | 45 | import Control.Monad |
46 | 46 | ||
47 | import Data.Aeson.TH | ||
48 | import Data.BEncode | 47 | import Data.BEncode |
49 | import Data.ByteString (ByteString) | 48 | import Data.ByteString (ByteString) |
50 | import qualified Data.ByteString as B | 49 | import qualified Data.ByteString as B |
@@ -257,43 +256,9 @@ withTracker initProgress conn action = bracket start end (action . fst) | |||
257 | Scrape | 256 | Scrape |
258 | -----------------------------------------------------------------------} | 257 | -----------------------------------------------------------------------} |
259 | 258 | ||
260 | |||
261 | -- | Information about particular torrent. | ||
262 | data ScrapeInfo = ScrapeInfo { | ||
263 | -- | Number of seeders - peers with the entire file. | ||
264 | siComplete :: !Int | ||
265 | |||
266 | -- | Total number of times the tracker has registered a completion. | ||
267 | , siDownloaded :: !Int | ||
268 | |||
269 | -- | Number of leechers. | ||
270 | , siIncomplete :: !Int | ||
271 | |||
272 | -- | Name of the torrent file, as specified by the "name" | ||
273 | -- file in the info section of the .torrent file. | ||
274 | , siName :: !(Maybe Text) | ||
275 | } deriving (Show, Eq) | ||
276 | |||
277 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) | ||
278 | |||
279 | -- | Scrape info about a set of torrents. | 259 | -- | Scrape info about a set of torrents. |
280 | type Scrape = Map InfoHash ScrapeInfo | 260 | type Scrape = Map InfoHash ScrapeInfo |
281 | 261 | ||
282 | instance BEncodable ScrapeInfo where | ||
283 | toBEncode ScrapeInfo {..} = fromAssocs | ||
284 | [ "complete" --> siComplete | ||
285 | , "downloaded" --> siDownloaded | ||
286 | , "incomplete" --> siIncomplete | ||
287 | , "name" -->? siName | ||
288 | ] | ||
289 | |||
290 | fromBEncode (BDict d) = | ||
291 | ScrapeInfo <$> d >-- "complete" | ||
292 | <*> d >-- "downloaded" | ||
293 | <*> d >-- "incomplete" | ||
294 | <*> d >--? "name" | ||
295 | fromBEncode _ = decodingError "ScrapeInfo" | ||
296 | |||
297 | -- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL' | 262 | -- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL' |
298 | -- gives 'Nothing' then tracker do not support scraping. The info hash | 263 | -- gives 'Nothing' then tracker do not support scraping. The info hash |
299 | -- list is used to restrict the tracker's report to that particular | 264 | -- list is used to restrict the tracker's report to that particular |
diff --git a/src/Network/BitTorrent/Tracker/Protocol.hs b/src/Network/BitTorrent/Tracker/Protocol.hs index 95d82b36..7a5039cf 100644 --- a/src/Network/BitTorrent/Tracker/Protocol.hs +++ b/src/Network/BitTorrent/Tracker/Protocol.hs | |||
@@ -21,9 +21,11 @@ | |||
21 | {-# LANGUAGE OverloadedStrings #-} | 21 | {-# LANGUAGE OverloadedStrings #-} |
22 | {-# LANGUAGE RecordWildCards #-} | 22 | {-# LANGUAGE RecordWildCards #-} |
23 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 23 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
24 | {-# LANGUAGE FlexibleInstances #-} | 24 | {-# LANGUAGE FlexibleInstances #-} |
25 | {-# LANGUAGE TemplateHaskell #-} | ||
25 | module Network.BitTorrent.Tracker.Protocol | 26 | module Network.BitTorrent.Tracker.Protocol |
26 | ( Event(..), AnnounceQuery(..), AnnounceInfo(..) | 27 | ( Event(..), AnnounceQuery(..), AnnounceInfo(..) |
28 | , ScrapeQuery, ScrapeInfo(..) | ||
27 | , askTracker, leaveTracker | 29 | , askTracker, leaveTracker |
28 | 30 | ||
29 | -- * Defaults | 31 | -- * Defaults |
@@ -33,15 +35,18 @@ module Network.BitTorrent.Tracker.Protocol | |||
33 | 35 | ||
34 | import Control.Applicative | 36 | import Control.Applicative |
35 | import Control.Monad | 37 | import Control.Monad |
38 | |||
39 | import Data.Aeson.TH | ||
36 | import Data.Char as Char | 40 | import Data.Char as Char |
37 | import Data.Map as M | 41 | import Data.Map as M |
38 | import Data.Maybe | 42 | import Data.Maybe |
43 | import Data.List as L | ||
39 | import Data.Word | 44 | import Data.Word |
40 | import Data.Monoid | 45 | import Data.Monoid |
41 | import Data.BEncode | 46 | import Data.BEncode |
42 | import Data.ByteString as B | 47 | import Data.ByteString as B |
43 | import Data.Text as T | 48 | import Data.Text (Text) |
44 | import Data.Text.Encoding as T | 49 | import Data.Text.Encoding |
45 | import Data.Serialize hiding (Result) | 50 | import Data.Serialize hiding (Result) |
46 | import Data.URLEncoded as URL | 51 | import Data.URLEncoded as URL |
47 | import Data.Torrent | 52 | import Data.Torrent |
@@ -54,7 +59,7 @@ import Network.URI | |||
54 | import Network.BitTorrent.Peer | 59 | import Network.BitTorrent.Peer |
55 | 60 | ||
56 | {----------------------------------------------------------------------- | 61 | {----------------------------------------------------------------------- |
57 | Tracker Announce | 62 | Announce messages |
58 | -----------------------------------------------------------------------} | 63 | -----------------------------------------------------------------------} |
59 | 64 | ||
60 | -- | Events used to specify which kind of tracker request is performed. | 65 | -- | Events used to specify which kind of tracker request is performed. |
@@ -136,8 +141,24 @@ data AnnounceInfo = | |||
136 | -- ^ Peers that must be contacted. | 141 | -- ^ Peers that must be contacted. |
137 | } deriving Show | 142 | } deriving Show |
138 | 143 | ||
144 | |||
145 | -- | Ports typically reserved for bittorrent P2P listener. | ||
146 | defaultPorts :: [PortNumber] | ||
147 | defaultPorts = [6881..6889] | ||
148 | |||
149 | -- | Above 25, new peers are highly unlikely to increase download | ||
150 | -- speed. Even 30 peers is /plenty/, the official client version 3 | ||
151 | -- in fact only actively forms new connections if it has less than | ||
152 | -- 30 peers and will refuse connections if it has 55. | ||
153 | -- | ||
154 | -- So the default value is set to 50 because usually 30-50% of peers | ||
155 | -- are not responding. | ||
156 | -- | ||
157 | defaultNumWant :: Int | ||
158 | defaultNumWant = 50 | ||
159 | |||
139 | {----------------------------------------------------------------------- | 160 | {----------------------------------------------------------------------- |
140 | HTTP Announce | 161 | Bencode announce encoding |
141 | -----------------------------------------------------------------------} | 162 | -----------------------------------------------------------------------} |
142 | 163 | ||
143 | instance BEncodable AnnounceInfo where | 164 | instance BEncodable AnnounceInfo where |
@@ -198,7 +219,7 @@ encodeRequest announce req = URL.urlEncode req | |||
198 | `addHashToURI` reqInfoHash req | 219 | `addHashToURI` reqInfoHash req |
199 | 220 | ||
200 | {----------------------------------------------------------------------- | 221 | {----------------------------------------------------------------------- |
201 | UDP announce | 222 | Binary announce encoding |
202 | -----------------------------------------------------------------------} | 223 | -----------------------------------------------------------------------} |
203 | 224 | ||
204 | type EventId = Word32 | 225 | type EventId = Word32 |
@@ -249,7 +270,7 @@ instance Serialize AnnounceQuery where | |||
249 | 270 | ||
250 | ev <- getEvent | 271 | ev <- getEvent |
251 | ip <- getWord32be | 272 | ip <- getWord32be |
252 | key <- getWord32be | 273 | key <- getWord32be -- TODO |
253 | want <- getWord32be | 274 | want <- getWord32be |
254 | 275 | ||
255 | port <- get | 276 | port <- get |
@@ -290,23 +311,47 @@ instance Serialize AnnounceInfo where | |||
290 | } | 311 | } |
291 | 312 | ||
292 | {----------------------------------------------------------------------- | 313 | {----------------------------------------------------------------------- |
293 | Tracker | 314 | Scrape messages |
294 | -----------------------------------------------------------------------} | 315 | -----------------------------------------------------------------------} |
295 | 316 | ||
296 | -- | Ports typically reserved for bittorrent P2P listener. | 317 | type ScrapeQuery = [InfoHash] |
297 | defaultPorts :: [PortNumber] | ||
298 | defaultPorts = [6881..6889] | ||
299 | 318 | ||
300 | -- | Above 25, new peers are highly unlikely to increase download | 319 | -- | Overall information about particular torrent. |
301 | -- speed. Even 30 peers is /plenty/, the official client version 3 | 320 | data ScrapeInfo = ScrapeInfo { |
302 | -- in fact only actively forms new connections if it has less than | 321 | -- | Number of seeders - peers with the entire file. |
303 | -- 30 peers and will refuse connections if it has 55. | 322 | siComplete :: !Int |
304 | -- | 323 | |
305 | -- So the default value is set to 50 because usually 30-50% of peers | 324 | -- | Total number of times the tracker has registered a completion. |
306 | -- are not responding. | 325 | , siDownloaded :: !Int |
307 | -- | 326 | |
308 | defaultNumWant :: Int | 327 | -- | Number of leechers. |
309 | defaultNumWant = 50 | 328 | , siIncomplete :: !Int |
329 | |||
330 | -- | Name of the torrent file, as specified by the "name" | ||
331 | -- file in the info section of the .torrent file. | ||
332 | , siName :: !(Maybe Text) | ||
333 | } deriving (Show, Eq) | ||
334 | |||
335 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) | ||
336 | |||
337 | instance BEncodable ScrapeInfo where | ||
338 | toBEncode ScrapeInfo {..} = fromAssocs | ||
339 | [ "complete" --> siComplete | ||
340 | , "downloaded" --> siDownloaded | ||
341 | , "incomplete" --> siIncomplete | ||
342 | , "name" -->? siName | ||
343 | ] | ||
344 | |||
345 | fromBEncode (BDict d) = | ||
346 | ScrapeInfo <$> d >-- "complete" | ||
347 | <*> d >-- "downloaded" | ||
348 | <*> d >-- "incomplete" | ||
349 | <*> d >--? "name" | ||
350 | fromBEncode _ = decodingError "ScrapeInfo" | ||
351 | |||
352 | {----------------------------------------------------------------------- | ||
353 | Tracker | ||
354 | -----------------------------------------------------------------------} | ||
310 | 355 | ||
311 | mkHTTPRequest :: URI -> Request ByteString | 356 | mkHTTPRequest :: URI -> Request ByteString |
312 | mkHTTPRequest uri = Request uri GET [] "" | 357 | mkHTTPRequest uri = Request uri GET [] "" |