summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSam T <pxqr.sta@gmail.com>2013-08-17 19:43:31 +0400
committerSam T <pxqr.sta@gmail.com>2013-08-17 19:43:31 +0400
commitca2e04725e3fa9adf7f9f1acac8588dde6d95cde (patch)
tree70fb7e90b3e6fe73367cb468e8027b665b24958f
parentec3d89b295a004e992dec3ba03a7efe9a1b62fe2 (diff)
~ Cosmetic changes.
-rw-r--r--src/Network/BitTorrent/Tracker/HTTP.hs22
-rw-r--r--src/Network/BitTorrent/Tracker/Protocol.hs27
2 files changed, 39 insertions, 10 deletions
diff --git a/src/Network/BitTorrent/Tracker/HTTP.hs b/src/Network/BitTorrent/Tracker/HTTP.hs
index 4fef5e56..8d3a6412 100644
--- a/src/Network/BitTorrent/Tracker/HTTP.hs
+++ b/src/Network/BitTorrent/Tracker/HTTP.hs
@@ -33,6 +33,17 @@ import Network.HTTP
33import Data.Torrent.Metainfo hiding (announce) 33import Data.Torrent.Metainfo hiding (announce)
34import Network.BitTorrent.Tracker.Protocol 34import Network.BitTorrent.Tracker.Protocol
35 35
36
37data HTTPTracker = HTTPTracker URI
38
39instance Tracker URI where
40 announce = askTracker
41 scrape_ uri ihs = do
42 e <- scrape uri ihs
43 case e of
44 Left str -> error str
45 Right si -> return si
46
36{----------------------------------------------------------------------- 47{-----------------------------------------------------------------------
37 Announce 48 Announce
38-----------------------------------------------------------------------} 49-----------------------------------------------------------------------}
@@ -42,8 +53,8 @@ encodeRequest announce req = URL.urlEncode req
42 `addToURI` announce 53 `addToURI` announce
43 `addHashToURI` reqInfoHash req 54 `addHashToURI` reqInfoHash req
44 55
45mkHTTPRequest :: URI -> Request ByteString 56mkGET :: URI -> Request ByteString
46mkHTTPRequest uri = Request uri GET [] "" 57mkGET uri = Request uri GET [] ""
47 58
48-- TODO rename to something like "announceBlahBlah" 59-- TODO rename to something like "announceBlahBlah"
49 60
@@ -53,7 +64,7 @@ mkHTTPRequest uri = Request uri GET [] ""
53-- 64--
54askTracker :: URI -> AnnounceQuery -> IO AnnounceInfo 65askTracker :: URI -> AnnounceQuery -> IO AnnounceInfo
55askTracker announce req = do 66askTracker announce req = do
56 let r = mkHTTPRequest (encodeRequest announce req) 67 let r = mkGET (encodeRequest announce req)
57 68
58 rawResp <- simpleHTTP r 69 rawResp <- simpleHTTP r
59 respBody <- getResponseBody rawResp 70 respBody <- getResponseBody rawResp
@@ -69,16 +80,13 @@ askTracker announce req = do
69-- conjunction with 'Stopped'. 80-- conjunction with 'Stopped'.
70leaveTracker :: URI -> AnnounceQuery -> IO () 81leaveTracker :: URI -> AnnounceQuery -> IO ()
71leaveTracker announce req = do 82leaveTracker announce req = do
72 let r = mkHTTPRequest (encodeRequest announce req) 83 let r = mkGET (encodeRequest announce req)
73 void $ simpleHTTP r >>= getResponseBody 84 void $ simpleHTTP r >>= getResponseBody
74 85
75{----------------------------------------------------------------------- 86{-----------------------------------------------------------------------
76 Scrape 87 Scrape
77-----------------------------------------------------------------------} 88-----------------------------------------------------------------------}
78 89
79-- | Scrape info about a set of torrents.
80type Scrape = Map InfoHash ScrapeInfo
81
82-- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL' 90-- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL'
83-- gives 'Nothing' then tracker do not support scraping. The info hash 91-- gives 'Nothing' then tracker do not support scraping. The info hash
84-- list is used to restrict the tracker's report to that particular 92-- list is used to restrict the tracker's report to that particular
diff --git a/src/Network/BitTorrent/Tracker/Protocol.hs b/src/Network/BitTorrent/Tracker/Protocol.hs
index 4e1262ed..b67b856d 100644
--- a/src/Network/BitTorrent/Tracker/Protocol.hs
+++ b/src/Network/BitTorrent/Tracker/Protocol.hs
@@ -23,9 +23,22 @@
23{-# LANGUAGE TemplateHaskell #-} 23{-# LANGUAGE TemplateHaskell #-}
24{-# OPTIONS -fno-warn-orphans #-} 24{-# OPTIONS -fno-warn-orphans #-}
25module Network.BitTorrent.Tracker.Protocol 25module Network.BitTorrent.Tracker.Protocol
26 ( Event(..), AnnounceQuery(..), AnnounceInfo(..) 26 ( -- * Announce
27 , defaultNumWant , defaultPorts 27 Event(..)
28 , ScrapeQuery, ScrapeInfo(..) 28 , AnnounceQuery(..)
29 , AnnounceInfo(..)
30
31 -- ** Defaults
32 , defaultNumWant
33 , defaultPorts
34
35 -- * Scrape
36 , ScrapeQuery
37 , ScrapeInfo(..)
38 , Scrape
39
40 -- * TODO
41 , Tracker(..)
29 ) 42 )
30 where 43 where
31 44
@@ -325,6 +338,9 @@ data ScrapeInfo = ScrapeInfo {
325 338
326$(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) 339$(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo)
327 340
341-- | Scrape info about a set of torrents.
342type Scrape = Map InfoHash ScrapeInfo
343
328instance BEncodable ScrapeInfo where 344instance BEncodable ScrapeInfo where
329 toBEncode ScrapeInfo {..} = fromAssocs 345 toBEncode ScrapeInfo {..} = fromAssocs
330 [ "complete" --> siComplete 346 [ "complete" --> siComplete
@@ -357,3 +373,8 @@ instance Serialize ScrapeInfo where
357 , siIncomplete = fromIntegral leechers 373 , siIncomplete = fromIntegral leechers
358 , siName = Nothing 374 , siName = Nothing
359 } 375 }
376
377-- | Set of tracker RPCs.
378class Tracker s where
379 announce :: s -> AnnounceQuery -> IO AnnounceInfo
380 scrape_ :: s -> ScrapeQuery -> IO Scrape