summaryrefslogtreecommitdiff
path: root/src
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
parent0254b200cd4aa5245c37c7a650f8b14567a3b4cf (diff)
~ Merge Scrape to Tracker.
Diffstat (limited to 'src')
-rw-r--r--src/Network/BitTorrent/Internal.hs8
-rw-r--r--src/Network/BitTorrent/Tracker.hs115
-rw-r--r--src/Network/BitTorrent/Tracker/Protocol.hs5
-rw-r--r--src/Network/BitTorrent/Tracker/Scrape.hs115
4 files changed, 111 insertions, 132 deletions
diff --git a/src/Network/BitTorrent/Internal.hs b/src/Network/BitTorrent/Internal.hs
index 39e10ce2..91dc35d5 100644
--- a/src/Network/BitTorrent/Internal.hs
+++ b/src/Network/BitTorrent/Internal.hs
@@ -226,12 +226,12 @@ updateOutcoming PeerSession {..} =
226 updateTimeout (eventManager (clientSession swarmSession)) 226 updateTimeout (eventManager (clientSession swarmSession))
227 outcomingTimeout maxOutcomingTime 227 outcomingTimeout maxOutcomingTime
228 228
229sendKA :: Socket -> SwarmSession -> IO () 229sendKA :: Socket -> IO ()
230sendKA sock SwarmSession {..} = do 230sendKA sock {- SwarmSession {..} -} = do
231 print "I'm sending keep alive." 231 print "I'm sending keep alive."
232 sendAll sock (encode BT.KeepAlive) 232 sendAll sock (encode BT.KeepAlive)
233 let mgr = eventManager clientSession 233-- let mgr = eventManager clientSession
234 updateTimeout mgr 234-- updateTimeout mgr
235 print "Done.." 235 print "Done.."
236 236
237abortSession :: IO () 237abortSession :: IO ()
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs
index 04a7b43e..275b5422 100644
--- a/src/Network/BitTorrent/Tracker.hs
+++ b/src/Network/BitTorrent/Tracker.hs
@@ -6,16 +6,18 @@
6-- Portability : non-portable 6-- Portability : non-portable
7-- 7--
8-- This module provides high level API for peer->tracker 8-- This module provides high level API for peer->tracker
9-- communication. 9-- communication. Tracker is used to discover other peers in the
10-- network.
10-- 11--
12-- By convention most trackers support another form of request,
13-- which queries the state of a given torrent (or all torrents) that
14-- the tracker is managing. This module also provides a way to
15-- easily request scrape info for a particular torrent list.
16--
17{-# LANGUAGE OverloadedStrings #-}
11{-# LANGUAGE RecordWildCards #-} 18{-# LANGUAGE RecordWildCards #-}
12module Network.BitTorrent.Tracker 19module Network.BitTorrent.Tracker
13 ( module Network.BitTorrent.Tracker.Scrape 20 ( withTracker, completedReq
14
15 , withTracker, completedReq
16
17 -- * Progress
18 , Progress(..), startProgress
19 21
20 -- * Connection 22 -- * Connection
21 , TConnection(..), tconnection 23 , TConnection(..), tconnection
@@ -27,6 +29,11 @@ module Network.BitTorrent.Tracker
27 29
28 -- * Re-export 30 -- * Re-export
29 , defaultPorts 31 , defaultPorts
32
33 -- * Scrape
34 , ScrapeInfo(..), Scrape
35 , scrapeURL
36 , scrape, scrapeOne
30 ) where 37 ) where
31 38
32import Control.Applicative 39import Control.Applicative
@@ -34,15 +41,23 @@ import Control.Concurrent
34import Control.Concurrent.STM 41import Control.Concurrent.STM
35import Control.Exception 42import Control.Exception
36import Control.Monad 43import Control.Monad
44import Data.BEncode
45import Data.ByteString (ByteString)
46import qualified Data.ByteString as B
47import qualified Data.ByteString.Char8 as BC
48import Data.Map (Map)
49import qualified Data.Map as M
50import Data.Monoid
37import Data.IORef 51import Data.IORef
38import Data.Torrent 52
39import Network 53import Network
54import Network.HTTP
40import Network.URI 55import Network.URI
41 56
57import Data.Torrent
42import Network.BitTorrent.Internal 58import Network.BitTorrent.Internal
43import Network.BitTorrent.Peer 59import Network.BitTorrent.Peer
44import Network.BitTorrent.Tracker.Protocol 60import Network.BitTorrent.Tracker.Protocol
45import Network.BitTorrent.Tracker.Scrape
46 61
47 62
48-- | 'TConnection' (shorthand for Tracker session) combines tracker request 63-- | 'TConnection' (shorthand for Tracker session) combines tracker request
@@ -179,3 +194,85 @@ withTracker initProgress conn action = bracket start end (action . fst)
179 killThread tid 194 killThread tid
180 pr <- getProgress se 195 pr <- getProgress se
181 askTracker $ stoppedReq conn pr 196 askTracker $ stoppedReq conn pr
197
198
199
200-- | Information about particular torrent.
201data ScrapeInfo = ScrapeInfo {
202 siComplete :: Int
203 -- ^ Number of seeders - peers with the entire file.
204 , siDownloaded :: Int
205 -- ^ Total number of times the tracker has registered a completion.
206 , siIncomplete :: Int
207 -- ^ Number of leechers.
208 , siName :: Maybe ByteString
209 -- ^ Name of the torrent file, as specified by the "name"
210 -- file in the info section of the .torrent file.
211 } deriving (Show, Eq)
212
213-- | Scrape info about a set of torrents.
214type Scrape = Map InfoHash ScrapeInfo
215
216instance BEncodable ScrapeInfo where
217 toBEncode si = fromAssocs
218 [ "complete" --> siComplete si
219 , "downloaded" --> siDownloaded si
220 , "incomplete" --> siIncomplete si
221 , "name" -->? siName si
222 ]
223
224 fromBEncode (BDict d) =
225 ScrapeInfo <$> d >-- "complete"
226 <*> d >-- "downloaded"
227 <*> d >-- "incomplete"
228 <*> d >--? "name"
229 fromBEncode _ = decodingError "ScrapeInfo"
230
231-- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL'
232-- gives 'Nothing' then tracker do not support scraping. The info hash
233-- list is used to restrict the tracker's report to that particular
234-- torrents. Note that scrapping of multiple torrents may not be
235-- supported. (Even if scrapping convention is supported)
236--
237scrapeURL :: URI -> [InfoHash] -> Maybe URI
238scrapeURL uri ihs = do
239 newPath <- replace (BC.pack (uriPath uri))
240 let newURI = uri { uriPath = BC.unpack newPath }
241 return (foldl addHashToURI newURI ihs)
242 where
243 replace :: ByteString -> Maybe ByteString
244 replace p
245 | ps <- BC.splitWith (== '/') p
246 , "announce" `B.isPrefixOf` last ps
247 = let newSuff = "scrape" <> B.drop (B.length "announce") (last ps)
248 in Just (B.intercalate "/" (init ps ++ [newSuff]))
249 | otherwise = Nothing
250
251
252-- | For each 'InfoHash' of torrents request scrape info from the tracker.
253-- However if the info hash list is 'null', the tracker should list
254-- all available torrents.
255-- Note that the 'URI' should be /announce/ URI, not /scrape/ URI.
256--
257scrape :: URI -- ^ Announce 'URI'.
258 -> [InfoHash] -- ^ Torrents to be scrapped.
259 -> IO (Result Scrape) -- ^ 'ScrapeInfo' for each torrent.
260scrape announce ihs
261 | Just uri<- scrapeURL announce ihs = do
262 rawResp <- simpleHTTP (Request uri GET [] "")
263 respBody <- getResponseBody rawResp
264 return (decoded (BC.pack respBody))
265
266 | otherwise = return (Left "Tracker do not support scraping")
267
268-- | More particular version of 'scrape', just for one torrent.
269--
270scrapeOne :: URI -- ^ Announce 'URI'
271 -> InfoHash -- ^ Hash of the torrent info.
272 -> IO (Result ScrapeInfo) -- ^ 'ScrapeInfo' for the torrent.
273scrapeOne uri ih = extract <$> scrape uri [ih]
274 where
275 extract (Right m)
276 | Just s <- M.lookup ih m = Right s
277 | otherwise = Left "unable to find info hash in response dict"
278 extract (Left e) = Left e
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