summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker
diff options
context:
space:
mode:
authorSam T <sta.cs.vsu@gmail.com>2013-04-21 00:01:22 +0400
committerSam T <sta.cs.vsu@gmail.com>2013-04-21 00:01:22 +0400
commit3c32f381afea629e06e8f069e0a3fefc72c8732e (patch)
tree194a4ade1cf7dd4d747e39397a8170a6b253f749 /src/Network/BitTorrent/Tracker
parent08bb327005c2f0dc517d0a74cf29e9f7f9b08e21 (diff)
~ Rename modules.
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r--src/Network/BitTorrent/Tracker/Scrape.hs113
1 files changed, 113 insertions, 0 deletions
diff --git a/src/Network/BitTorrent/Tracker/Scrape.hs b/src/Network/BitTorrent/Tracker/Scrape.hs
new file mode 100644
index 00000000..49451a57
--- /dev/null
+++ b/src/Network/BitTorrent/Tracker/Scrape.hs
@@ -0,0 +1,113 @@
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 anouther 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 #-}
14module Network.BitTorrent.Tracker.Scrape
15 ( ScrapeInfo(..), Scrape
16 , scrapeURL
17
18 -- * Requests
19 , scrape
20 , scrapeOne
21 ) where
22
23import Control.Applicative
24import Data.BEncode
25import Data.ByteString (ByteString)
26import qualified Data.ByteString as B
27import qualified Data.ByteString.Char8 as BC
28import Data.Map (Map)
29import qualified Data.Map as M
30import Data.Monoid
31import Data.Torrent.InfoHash
32import Network.URI
33import Network.HTTP
34
35-- | Information about particular torrent.
36data ScrapeInfo = ScrapeInfo {
37 siComplete :: Int
38 -- ^ Number of seeders - peers with the entire file.
39 , siDownloaded :: Int
40 -- ^ Total number of times the tracker has registered a completion.
41 , siIncomplete :: Int
42 -- ^ Number of leechers.
43 , siName :: Maybe ByteString
44 -- ^ Name of the torrent file, as specified by the "name"
45 -- file in the info section of the .torrent file.
46 } deriving (Show, Eq)
47
48-- | Scrape info about a set of torrents.
49type Scrape = Map InfoHash ScrapeInfo
50
51instance BEncodable ScrapeInfo where
52 toBEncode si = fromAssocs
53 [ "complete" --> siComplete si
54 , "downloaded" --> siDownloaded si
55 , "incomplete" --> siIncomplete si
56 , "name" -->? siName si
57 ]
58
59 fromBEncode (BDict d) =
60 ScrapeInfo <$> d >-- "complete"
61 <*> d >-- "downloaded"
62 <*> d >-- "incomplete"
63 <*> d >--? "name"
64 fromBEncode _ = decodingError "ScrapeInfo"
65
66-- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL'
67-- gives 'Nothing' then tracker do not support scraping. The info hash
68-- list is used to restrict the tracker's report to that particular
69-- torrents. Note that scrapping of multiple torrents may not be
70-- supported. (Even if scrapping convention is supported)
71--
72scrapeURL :: URI -> [InfoHash] -> Maybe URI
73scrapeURL uri ihs = do
74 newPath <- replace (BC.pack (uriPath uri))
75 let newURI = uri { uriPath = BC.unpack newPath }
76 return (foldl addHashToURI newURI ihs)
77 where
78 replace :: ByteString -> Maybe ByteString
79 replace p
80 | ps <- BC.splitWith (== '/') p
81 , "announce" `B.isPrefixOf` last ps
82 = let newSuff = "scrape" <> B.drop (B.length "announce") (last ps)
83 in Just (B.intercalate "/" (init ps ++ [newSuff]))
84 | otherwise = Nothing
85
86
87-- | For each 'InfoHash' of torrents request scrape info from the tracker.
88-- However if the info hash list is 'null', the tracker should list
89-- all available torrents.
90-- Note that the 'URI' should be /announce/ URI, not /scrape/ URI.
91--
92scrape :: URI -- ^ Announce 'URI'.
93 -> [InfoHash] -- ^ Torrents to be scrapped.
94 -> IO (Result Scrape) -- ^ 'ScrapeInfo' for each torrent.
95scrape announce ihs
96 | Just uri<- scrapeURL announce ihs = do
97 rawResp <- simpleHTTP (Request uri GET [] "")
98 respBody <- getResponseBody rawResp
99 return (decoded (BC.pack respBody))
100
101 | otherwise = return (Left "Tracker do not support scraping")
102
103-- | More particular version of 'scrape', just for one torrent.
104--
105scrapeOne :: URI -- ^ Announce 'URI'
106 -> InfoHash -- ^ Hash of the torrent info.
107 -> IO (Result ScrapeInfo) -- ^ 'ScrapeInfo' for the torrent.
108scrapeOne uri ih = extract <$> scrape uri [ih]
109 where
110 extract (Right m)
111 | Just s <- M.lookup ih m = Right s
112 | otherwise = Left "unable to find info hash in response dict"
113 extract (Left e) = Left e