summaryrefslogtreecommitdiff
path: root/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
diff options
context:
space:
mode:
Diffstat (limited to 'bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs')
-rw-r--r--bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs191
1 files changed, 0 insertions, 191 deletions
diff --git a/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs b/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
deleted file mode 100644
index 6f7a53bf..00000000
--- a/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
+++ /dev/null
@@ -1,191 +0,0 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : provisional
6-- Portability : portable
7--
8-- This module implement HTTP tracker protocol.
9--
10-- For more information see:
11-- <https://wiki.theory.org/BitTorrentSpecification#Tracker_HTTP.2FHTTPS_Protocol>
12--
13{-# LANGUAGE DeriveDataTypeable #-}
14module Network.BitTorrent.Tracker.RPC.HTTP
15 ( -- * Manager
16 Options (..)
17 , Manager
18 , newManager
19 , closeManager
20 , withManager
21
22 -- * RPC
23 , RpcException (..)
24 , announce
25 , scrape
26 , scrapeOne
27 ) where
28
29import Control.Applicative
30import Control.Exception
31import Control.Monad
32import Control.Monad.Trans.Resource
33import Data.BEncode as BE
34import Data.ByteString as BS
35import Data.ByteString.Char8 as BC
36import Data.ByteString.Lazy as BL
37import Data.Default
38import Data.List as L
39import Data.Monoid
40import Data.Typeable hiding (Proxy)
41import Network.URI
42import Network.HTTP.Conduit hiding
43 (Manager, newManager, closeManager, withManager)
44import Network.HTTP.Client (defaultManagerSettings)
45import Network.HTTP.Client.Internal (setUri)
46import qualified Network.HTTP.Conduit as HTTP
47import Network.HTTP.Types.Header (hUserAgent)
48import Network.HTTP.Types.URI (SimpleQuery, renderSimpleQuery)
49
50import Data.Torrent (InfoHash)
51import Network.Address (libUserAgent)
52import Network.BitTorrent.Tracker.Message hiding (Request, Response)
53
54{-----------------------------------------------------------------------
55-- Exceptions
56-----------------------------------------------------------------------}
57
58data RpcException
59 = RequestFailed HttpException -- ^ failed HTTP request.
60 | ParserFailure String -- ^ unable to decode tracker response;
61 | ScrapelessTracker -- ^ tracker do not support scraping;
62 | BadScrape -- ^ unable to find info hash in response dict;
63 deriving (Show, Typeable)
64
65instance Exception RpcException
66
67packHttpException :: IO a -> IO a
68packHttpException m = try m >>= either (throwIO . RequestFailed) return
69
70{-----------------------------------------------------------------------
71-- Manager
72-----------------------------------------------------------------------}
73
74-- | HTTP tracker specific RPC options.
75data Options = Options
76 { -- | Global HTTP announce query preferences.
77 optAnnouncePrefs :: !AnnouncePrefs
78
79 -- | Whether to use HTTP proxy for HTTP tracker requests.
80 , optHttpProxy :: !(Maybe Proxy)
81
82 -- | Value to put in HTTP user agent header.
83 , optUserAgent :: !BS.ByteString
84
85 -- | HTTP manager options.
86 , optHttpOptions :: !ManagerSettings
87 }
88
89instance Default Options where
90 def = Options
91 { optAnnouncePrefs = def
92 , optHttpProxy = Nothing
93 , optUserAgent = BC.pack libUserAgent
94 , optHttpOptions = defaultManagerSettings
95 }
96
97-- | HTTP tracker manager.
98data Manager = Manager
99 { options :: !Options
100 , httpMgr :: !HTTP.Manager
101 }
102
103-- |
104newManager :: Options -> IO Manager
105newManager opts = Manager opts <$> HTTP.newManager (optHttpOptions opts)
106
107-- |
108closeManager :: Manager -> IO ()
109closeManager Manager {..} = HTTP.closeManager httpMgr
110
111-- | Normally you need to use 'Control.Monad.Trans.Resource.allocate'.
112withManager :: Options -> (Manager -> IO a) -> IO a
113withManager opts = bracket (newManager opts) closeManager
114
115{-----------------------------------------------------------------------
116-- Queries
117-----------------------------------------------------------------------}
118
119fillRequest :: Options -> SimpleQuery -> Request -> Request
120fillRequest Options {..} q r = r
121 { queryString = joinQuery (queryString r) (renderSimpleQuery False q)
122 , requestHeaders = (hUserAgent, optUserAgent) : requestHeaders r
123 , proxy = optHttpProxy
124 }
125 where
126 joinQuery a b
127 | BS.null a = b
128 | otherwise = a <> "&" <> b
129
130httpTracker :: BEncode a => Manager -> URI -> SimpleQuery -> IO a
131httpTracker Manager {..} uri q = packHttpException $ do
132 request <- fillRequest options q <$> setUri defaultRequest uri
133 response <- runResourceT $ httpLbs request httpMgr
134 case BE.decode $ BL.toStrict $ responseBody response of
135 Left msg -> throwIO (ParserFailure msg)
136 Right info -> return info
137
138{-----------------------------------------------------------------------
139-- RPC
140-----------------------------------------------------------------------}
141
142-- | Send request and receive response from the tracker specified in
143-- announce list.
144--
145-- This function can throw 'RpcException'.
146--
147announce :: Manager -> URI -> AnnounceQuery -> IO AnnounceInfo
148announce mgr uri q = httpTracker mgr uri (renderAnnounceRequest uriQ)
149 where
150 uriQ = AnnounceRequest
151 { announceQuery = q
152 , announcePrefs = optAnnouncePrefs (options mgr)
153 }
154
155-- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL'
156-- gives 'Nothing' then tracker do not support scraping.
157--
158scrapeURL :: URI -> Maybe URI
159scrapeURL uri = do
160 newPath <- replace (BC.pack (uriPath uri))
161 return uri { uriPath = BC.unpack newPath }
162 where
163 replace p = do
164 let ps = BC.splitWith (== '/') p
165 guard (not (L.null ps))
166 guard ("announce" `BS.isPrefixOf` L.last ps)
167 let newSuff = "scrape" <> BS.drop (BS.length "announce") (L.last ps)
168 return (BS.intercalate "/" (L.init ps ++ [newSuff]))
169
170-- | For each 'InfoHash' of torrents request scrape info from the tracker.
171-- However if the info hash list is 'null', the tracker should list
172-- all available torrents.
173--
174-- This function can throw 'RpcException'.
175--
176scrape :: Manager -> URI -> ScrapeQuery -> IO ScrapeInfo
177scrape m u q = do
178 case scrapeURL u of
179 Nothing -> throwIO ScrapelessTracker
180 Just uri -> httpTracker m uri (renderScrapeQuery q)
181
182-- | More particular version of 'scrape', just for one torrent.
183--
184-- This function can throw 'RpcException'.
185--
186scrapeOne :: Manager -> URI -> InfoHash -> IO ScrapeEntry
187scrapeOne m uri ih = do
188 xs <- scrape m uri [ih]
189 case L.lookup ih xs of
190 Nothing -> throwIO BadScrape
191 Just a -> return a
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 13:38:33 +0000