blob: 8d3a64125920ec815a9c00967b26f212df7405d8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
-- |
-- Copyright : (c) Sam T. 2013
-- License : MIT
-- Maintainer : pxqr.sta@gmail.com
-- Stability : experimental
-- Portability : non-portable
--
-- The tracker is an HTTP/HTTPS service used to discovery peers for
-- a particular existing torrent and keep statistics about the
-- swarm. This module also provides a way to easily request scrape
-- info for a particular torrent list.
--
-- For more information see:
-- <https://wiki.theory.org/BitTorrentSpecification#Tracker_HTTP.2FHTTPS_Protocol>
--
module Network.BitTorrent.Tracker.HTTP
( askTracker, leaveTracker
, scrapeURL, scrape, scrapeOne
) where
import Control.Applicative
import Control.Monad
import Data.BEncode
import Data.ByteString as B
import Data.ByteString.Char8 as BC
import Data.List as L
import Data.Map as M
import Data.Monoid
import Data.URLEncoded as URL
import Network.URI
import Network.HTTP
import Data.Torrent.Metainfo hiding (announce)
import Network.BitTorrent.Tracker.Protocol
data HTTPTracker = HTTPTracker URI
instance Tracker URI where
announce = askTracker
scrape_ uri ihs = do
e <- scrape uri ihs
case e of
Left str -> error str
Right si -> return si
{-----------------------------------------------------------------------
Announce
-----------------------------------------------------------------------}
encodeRequest :: URI -> AnnounceQuery -> URI
encodeRequest announce req = URL.urlEncode req
`addToURI` announce
`addHashToURI` reqInfoHash req
mkGET :: URI -> Request ByteString
mkGET uri = Request uri GET [] ""
-- TODO rename to something like "announceBlahBlah"
-- | Send request and receive response from the tracker specified in
-- announce list. This function throws 'IOException' if it couldn't
-- send request or receive response or decode response.
--
askTracker :: URI -> AnnounceQuery -> IO AnnounceInfo
askTracker announce req = do
let r = mkGET (encodeRequest announce req)
rawResp <- simpleHTTP r
respBody <- getResponseBody rawResp
checkResult $ decoded respBody
where
checkResult (Left err)
= ioError $ userError $ err ++ " in tracker response"
checkResult (Right (Failure err))
= ioError $ userError $ show err ++ " in tracker response"
checkResult (Right resp) = return resp
-- | The same as the 'askTracker' but ignore response. Used in
-- conjunction with 'Stopped'.
leaveTracker :: URI -> AnnounceQuery -> IO ()
leaveTracker announce req = do
let r = mkGET (encodeRequest announce req)
void $ simpleHTTP r >>= getResponseBody
{-----------------------------------------------------------------------
Scrape
-----------------------------------------------------------------------}
-- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL'
-- gives 'Nothing' then tracker do not support scraping. The info hash
-- list is used to restrict the tracker's report to that particular
-- torrents. Note that scrapping of multiple torrents may not be
-- supported. (Even if scrapping convention is supported)
--
scrapeURL :: URI -> [InfoHash] -> Maybe URI
scrapeURL uri ihs = do
newPath <- replace (BC.pack (uriPath uri))
let newURI = uri { uriPath = BC.unpack newPath }
return (L.foldl addHashToURI newURI ihs)
where
replace :: ByteString -> Maybe ByteString
replace p
| ps <- BC.splitWith (== '/') p
, "announce" `B.isPrefixOf` L.last ps
= let newSuff = "scrape" <> B.drop (B.length "announce") (L.last ps)
in Just (B.intercalate "/" (L.init ps ++ [newSuff]))
| otherwise = Nothing
-- | For each 'InfoHash' of torrents request scrape info from the tracker.
-- However if the info hash list is 'null', the tracker should list
-- all available torrents.
-- Note that the 'URI' should be /announce/ URI, not /scrape/ URI.
--
scrape :: URI -- ^ Announce 'URI'.
-> [InfoHash] -- ^ Torrents to be scrapped.
-> IO (Result Scrape) -- ^ 'ScrapeInfo' for each torrent.
scrape announce ihs
| Just uri<- scrapeURL announce ihs = do
rawResp <- simpleHTTP (Request uri GET [] "")
respBody <- getResponseBody rawResp
return (decoded (BC.pack respBody))
| otherwise = return (Left "Tracker do not support scraping")
-- | More particular version of 'scrape', just for one torrent.
--
scrapeOne :: URI -- ^ Announce 'URI'
-> InfoHash -- ^ Hash of the torrent info.
-> IO (Result ScrapeInfo) -- ^ 'ScrapeInfo' for the torrent.
scrapeOne uri ih = extract <$> scrape uri [ih]
where
extract (Right m)
| Just s <- M.lookup ih m = Right s
| otherwise = Left "unable to find info hash in response dict"
extract (Left e) = Left e
|
