summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker
diff options
context:
space:
mode:
authorSam T <pxqr.sta@gmail.com>2013-06-11 08:02:09 +0400
committerSam T <pxqr.sta@gmail.com>2013-06-11 08:02:09 +0400
commit0e3903fa3d486c57504837fd497a3a348793f7fc (patch)
treeb47f210c347062ca8fbe7c34012bb36107c86e52 /src/Network/BitTorrent/Tracker
parent0254b200cd4aa5245c37c7a650f8b14567a3b4cf (diff)
~ Merge Scrape to Tracker.
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r--src/Network/BitTorrent/Tracker/Protocol.hs5
-rw-r--r--src/Network/BitTorrent/Tracker/Scrape.hs115
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
23module Network.BitTorrent.Tracker.Protocol 23module 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
50import Network.URI 48import Network.URI
51 49
52import Network.BitTorrent.Peer 50import Network.BitTorrent.Peer
53import 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 #-}
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 Network.URI
32import Network.HTTP
33
34import Data.Torrent
35
36
37-- | Information about particular torrent.
38data 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.
51type Scrape = Map InfoHash ScrapeInfo
52
53instance 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--
74scrapeURL :: URI -> [InfoHash] -> Maybe URI
75scrapeURL 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--
94scrape :: URI -- ^ Announce 'URI'.
95 -> [InfoHash] -- ^ Torrents to be scrapped.
96 -> IO (Result Scrape) -- ^ 'ScrapeInfo' for each torrent.
97scrape 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--
107scrapeOne :: URI -- ^ Announce 'URI'
108 -> InfoHash -- ^ Hash of the torrent info.
109 -> IO (Result ScrapeInfo) -- ^ 'ScrapeInfo' for the torrent.
110scrapeOne 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