diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-06-11 08:02:09 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-06-11 08:02:09 +0400 |
commit | 0e3903fa3d486c57504837fd497a3a348793f7fc (patch) | |
tree | b47f210c347062ca8fbe7c34012bb36107c86e52 /src/Network/BitTorrent/Tracker | |
parent | 0254b200cd4aa5245c37c7a650f8b14567a3b4cf (diff) |
~ Merge Scrape to Tracker.
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Protocol.hs | 5 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/Scrape.hs | 115 |
2 files changed, 1 insertions, 119 deletions
diff --git a/src/Network/BitTorrent/Tracker/Protocol.hs b/src/Network/BitTorrent/Tracker/Protocol.hs index af48e3e9..c94a2dfc 100644 --- a/src/Network/BitTorrent/Tracker/Protocol.hs +++ b/src/Network/BitTorrent/Tracker/Protocol.hs | |||
@@ -21,9 +21,7 @@ | |||
21 | {-# LANGUAGE OverloadedStrings #-} | 21 | {-# LANGUAGE OverloadedStrings #-} |
22 | -- TODO: add "compact" field to TRequest | 22 | -- TODO: add "compact" field to TRequest |
23 | module Network.BitTorrent.Tracker.Protocol | 23 | module Network.BitTorrent.Tracker.Protocol |
24 | ( module Network.BitTorrent.Tracker.Scrape | 24 | ( Event(..), TRequest(..), TResponse(..) |
25 | |||
26 | , Event(..), TRequest(..), TResponse(..) | ||
27 | , askTracker | 25 | , askTracker |
28 | 26 | ||
29 | -- * Defaults | 27 | -- * Defaults |
@@ -50,7 +48,6 @@ import Network.HTTP | |||
50 | import Network.URI | 48 | import Network.URI |
51 | 49 | ||
52 | import Network.BitTorrent.Peer | 50 | import Network.BitTorrent.Peer |
53 | import Network.BitTorrent.Tracker.Scrape | ||
54 | 51 | ||
55 | 52 | ||
56 | 53 | ||
diff --git a/src/Network/BitTorrent/Tracker/Scrape.hs b/src/Network/BitTorrent/Tracker/Scrape.hs deleted file mode 100644 index 0181cf9f..00000000 --- a/src/Network/BitTorrent/Tracker/Scrape.hs +++ /dev/null | |||
@@ -1,115 +0,0 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam T. 2013 | ||
3 | -- License : MIT | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- By convention most trackers support another form of request, | ||
9 | -- which queries the state of a given torrent (or all torrents) that the | ||
10 | -- tracker is managing. This module provides a way to easily request | ||
11 | -- scrape info for a particular torrent list. | ||
12 | -- | ||
13 | {-# LANGUAGE OverloadedStrings #-} | ||
14 | module Network.BitTorrent.Tracker.Scrape | ||
15 | ( ScrapeInfo(..), Scrape | ||
16 | , scrapeURL | ||
17 | |||
18 | -- * Requests | ||
19 | , scrape | ||
20 | , scrapeOne | ||
21 | ) where | ||
22 | |||
23 | import Control.Applicative | ||
24 | import Data.BEncode | ||
25 | import Data.ByteString (ByteString) | ||
26 | import qualified Data.ByteString as B | ||
27 | import qualified Data.ByteString.Char8 as BC | ||
28 | import Data.Map (Map) | ||
29 | import qualified Data.Map as M | ||
30 | import Data.Monoid | ||
31 | import Network.URI | ||
32 | import Network.HTTP | ||
33 | |||
34 | import Data.Torrent | ||
35 | |||
36 | |||
37 | -- | Information about particular torrent. | ||
38 | data ScrapeInfo = ScrapeInfo { | ||
39 | siComplete :: Int | ||
40 | -- ^ Number of seeders - peers with the entire file. | ||
41 | , siDownloaded :: Int | ||
42 | -- ^ Total number of times the tracker has registered a completion. | ||
43 | , siIncomplete :: Int | ||
44 | -- ^ Number of leechers. | ||
45 | , siName :: Maybe ByteString | ||
46 | -- ^ Name of the torrent file, as specified by the "name" | ||
47 | -- file in the info section of the .torrent file. | ||
48 | } deriving (Show, Eq) | ||
49 | |||
50 | -- | Scrape info about a set of torrents. | ||
51 | type Scrape = Map InfoHash ScrapeInfo | ||
52 | |||
53 | instance BEncodable ScrapeInfo where | ||
54 | toBEncode si = fromAssocs | ||
55 | [ "complete" --> siComplete si | ||
56 | , "downloaded" --> siDownloaded si | ||
57 | , "incomplete" --> siIncomplete si | ||
58 | , "name" -->? siName si | ||
59 | ] | ||
60 | |||
61 | fromBEncode (BDict d) = | ||
62 | ScrapeInfo <$> d >-- "complete" | ||
63 | <*> d >-- "downloaded" | ||
64 | <*> d >-- "incomplete" | ||
65 | <*> d >--? "name" | ||
66 | fromBEncode _ = decodingError "ScrapeInfo" | ||
67 | |||
68 | -- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL' | ||
69 | -- gives 'Nothing' then tracker do not support scraping. The info hash | ||
70 | -- list is used to restrict the tracker's report to that particular | ||
71 | -- torrents. Note that scrapping of multiple torrents may not be | ||
72 | -- supported. (Even if scrapping convention is supported) | ||
73 | -- | ||
74 | scrapeURL :: URI -> [InfoHash] -> Maybe URI | ||
75 | scrapeURL uri ihs = do | ||
76 | newPath <- replace (BC.pack (uriPath uri)) | ||
77 | let newURI = uri { uriPath = BC.unpack newPath } | ||
78 | return (foldl addHashToURI newURI ihs) | ||
79 | where | ||
80 | replace :: ByteString -> Maybe ByteString | ||
81 | replace p | ||
82 | | ps <- BC.splitWith (== '/') p | ||
83 | , "announce" `B.isPrefixOf` last ps | ||
84 | = let newSuff = "scrape" <> B.drop (B.length "announce") (last ps) | ||
85 | in Just (B.intercalate "/" (init ps ++ [newSuff])) | ||
86 | | otherwise = Nothing | ||
87 | |||
88 | |||
89 | -- | For each 'InfoHash' of torrents request scrape info from the tracker. | ||
90 | -- However if the info hash list is 'null', the tracker should list | ||
91 | -- all available torrents. | ||
92 | -- Note that the 'URI' should be /announce/ URI, not /scrape/ URI. | ||
93 | -- | ||
94 | scrape :: URI -- ^ Announce 'URI'. | ||
95 | -> [InfoHash] -- ^ Torrents to be scrapped. | ||
96 | -> IO (Result Scrape) -- ^ 'ScrapeInfo' for each torrent. | ||
97 | scrape announce ihs | ||
98 | | Just uri<- scrapeURL announce ihs = do | ||
99 | rawResp <- simpleHTTP (Request uri GET [] "") | ||
100 | respBody <- getResponseBody rawResp | ||
101 | return (decoded (BC.pack respBody)) | ||
102 | |||
103 | | otherwise = return (Left "Tracker do not support scraping") | ||
104 | |||
105 | -- | More particular version of 'scrape', just for one torrent. | ||
106 | -- | ||
107 | scrapeOne :: URI -- ^ Announce 'URI' | ||
108 | -> InfoHash -- ^ Hash of the torrent info. | ||
109 | -> IO (Result ScrapeInfo) -- ^ 'ScrapeInfo' for the torrent. | ||
110 | scrapeOne uri ih = extract <$> scrape uri [ih] | ||
111 | where | ||
112 | extract (Right m) | ||
113 | | Just s <- M.lookup ih m = Right s | ||
114 | | otherwise = Left "unable to find info hash in response dict" | ||
115 | extract (Left e) = Left e | ||