summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/Core/PeerAddr.hs6
-rw-r--r--src/Network/BitTorrent/Tracker/HTTP.hs32
-rw-r--r--src/Network/BitTorrent/Tracker/Message.hs42
3 files changed, 39 insertions, 41 deletions
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index a4f45e74..5570bfc1 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -16,6 +16,7 @@
16module Network.BitTorrent.Core.PeerAddr 16module Network.BitTorrent.Core.PeerAddr
17 ( -- * Peer address 17 ( -- * Peer address
18 PeerAddr(..) 18 PeerAddr(..)
19 , defaultPorts
19 , peerSockAddr 20 , peerSockAddr
20 , connectToPeer 21 , connectToPeer
21 , ppPeer 22 , ppPeer
@@ -81,12 +82,17 @@ instance BEncode PeerAddr where
81-- 'peerId' is always 'Nothing'. 82-- 'peerId' is always 'Nothing'.
82-- 83--
83-- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> 84-- For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
85--
84instance Serialize PeerAddr where 86instance Serialize PeerAddr where
85 put PeerAddr {..} = put peerID >> put peerPort 87 put PeerAddr {..} = put peerID >> put peerPort
86 {-# INLINE put #-} 88 {-# INLINE put #-}
87 get = PeerAddr Nothing <$> get <*> get 89 get = PeerAddr Nothing <$> get <*> get
88 {-# INLINE get #-} 90 {-# INLINE get #-}
89 91
92-- | Ports typically reserved for bittorrent P2P listener.
93defaultPorts :: [PortNumber]
94defaultPorts = [6881..6889]
95
90-- TODO make platform independent, clarify htonl 96-- TODO make platform independent, clarify htonl
91 97
92-- | Convert peer info from tracker response to socket address. Used 98-- | Convert peer info from tracker response to socket address. Used
diff --git a/src/Network/BitTorrent/Tracker/HTTP.hs b/src/Network/BitTorrent/Tracker/HTTP.hs
index 55b347ce..2d49436d 100644
--- a/src/Network/BitTorrent/Tracker/HTTP.hs
+++ b/src/Network/BitTorrent/Tracker/HTTP.hs
@@ -17,7 +17,7 @@ module Network.BitTorrent.Tracker.HTTP
17 ( HTTPTracker 17 ( HTTPTracker
18 18
19 -- * Extra 19 -- * Extra
20 , scrapeURL 20-- , scrapeURL
21 ) where 21 ) where
22 22
23import Control.Exception 23import Control.Exception
@@ -25,13 +25,27 @@ import Data.BEncode
25import Data.ByteString as B 25import Data.ByteString as B
26import Data.ByteString.Char8 as BC 26import Data.ByteString.Char8 as BC
27import Data.List as L 27import Data.List as L
28import Data.Map as M
28import Data.Monoid 29import Data.Monoid
29import Data.URLEncoded as URL 30import Data.URLEncoded as URL
30import Network.URI 31import Network.URI
31import Network.HTTP 32import Network.HTTP
32 33
33import Network.BitTorrent.Tracker.Protocol 34import Data.Torrent.InfoHash
35import Network.BitTorrent.Tracker.Message
34 36
37-- | Set of tracker RPCs.
38class Tracker s where
39 connect :: URI -> IO s
40 announce :: s -> AnnounceQuery -> IO AnnounceInfo
41 scrape :: s -> ScrapeQuery -> IO Scrape
42
43-- | More particular version of 'scrape', just for one torrent.
44--
45scrapeOne :: Tracker t => t -> InfoHash -> IO ScrapeInfo
46scrapeOne uri ih = scrape uri [ih] >>= maybe err return . M.lookup ih
47 where
48 err = throwIO $ userError "unable to find info hash in response dict"
35 49
36data HTTPTracker = HTTPTracker 50data HTTPTracker = HTTPTracker
37 { announceURI :: URI 51 { announceURI :: URI
@@ -40,17 +54,12 @@ data HTTPTracker = HTTPTracker
40instance Tracker HTTPTracker where 54instance Tracker HTTPTracker where
41 connect = return . HTTPTracker 55 connect = return . HTTPTracker
42 announce = announceHTTP 56 announce = announceHTTP
43 scrape = scrapeHTTP 57-- scrape = scrapeHTTP
44 58
45{----------------------------------------------------------------------- 59{-----------------------------------------------------------------------
46 Announce 60 Announce
47-----------------------------------------------------------------------} 61-----------------------------------------------------------------------}
48 62
49encodeRequest :: URI -> AnnounceQuery -> URI
50encodeRequest announceURI req = URL.urlEncode req
51 `addToURI` announceURI
52 `addHashToURI` reqInfoHash req
53
54mkGET :: URI -> Request ByteString 63mkGET :: URI -> Request ByteString
55mkGET uri = Request uri GET [] "" 64mkGET uri = Request uri GET [] ""
56 65
@@ -64,14 +73,14 @@ announceHTTP HTTPTracker {..} req = do
64 73
65 rawResp <- simpleHTTP r 74 rawResp <- simpleHTTP r
66 respBody <- getResponseBody rawResp 75 respBody <- getResponseBody rawResp
67 checkResult $ decoded respBody 76 checkResult $ decode respBody
68 where 77 where
69 checkResult (Left err) 78 checkResult (Left err)
70 = ioError $ userError $ err ++ " in tracker response" 79 = ioError $ userError $ err ++ " in tracker response"
71 checkResult (Right (Failure err)) 80 checkResult (Right (Failure err))
72 = ioError $ userError $ show err ++ " in tracker response" 81 = ioError $ userError $ show err ++ " in tracker response"
73 checkResult (Right resp) = return resp 82 checkResult (Right resp) = return resp
74 83{-
75{----------------------------------------------------------------------- 84{-----------------------------------------------------------------------
76 Scrape 85 Scrape
77-----------------------------------------------------------------------} 86-----------------------------------------------------------------------}
@@ -109,8 +118,9 @@ scrapeHTTP HTTPTracker {..} ihs
109 | Just uri <- scrapeURL announceURI ihs = do 118 | Just uri <- scrapeURL announceURI ihs = do
110 rawResp <- simpleHTTP (Request uri GET [] "") 119 rawResp <- simpleHTTP (Request uri GET [] "")
111 respBody <- getResponseBody rawResp 120 respBody <- getResponseBody rawResp
112 case decoded (BC.pack respBody) of 121 case decode (BC.pack respBody) of
113 Left e -> throwIO $ userError $ e ++ " in scrape response" 122 Left e -> throwIO $ userError $ e ++ " in scrape response"
114 Right r -> return r 123 Right r -> return r
115 124
116 | otherwise = throwIO $ userError "Tracker do not support scraping" 125 | otherwise = throwIO $ userError "Tracker do not support scraping"
126-} \ No newline at end of file
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs
index c46d5d58..508ff4c5 100644
--- a/src/Network/BitTorrent/Tracker/Message.hs
+++ b/src/Network/BitTorrent/Tracker/Message.hs
@@ -25,23 +25,20 @@
25{-# OPTIONS -fno-warn-orphans #-} 25{-# OPTIONS -fno-warn-orphans #-}
26module Network.BitTorrent.Tracker.Message 26module Network.BitTorrent.Tracker.Message
27 ( -- * Announce 27 ( -- * Announce
28 -- ** Request
28 Event(..) 29 Event(..)
29 , AnnounceQuery(..) 30 , AnnounceQuery(..)
31 , encodeRequest
32
33 -- ** Response
30 , PeerList (..) 34 , PeerList (..)
31 , AnnounceInfo(..) 35 , AnnounceInfo(..)
32
33 -- ** Defaults
34 , defaultNumWant 36 , defaultNumWant
35 , defaultPorts
36 37
37 -- * Scrape 38 -- * Scrape
38 , ScrapeQuery 39 , ScrapeQuery
39 , ScrapeInfo(..) 40 , ScrapeInfo(..)
40 , Scrape 41 , Scrape
41
42 -- * TODO
43 , Tracker(..)
44 , scrapeOne
45 ) 42 )
46 where 43 where
47 44
@@ -212,10 +209,16 @@ instance Serialize AnnounceQuery where
212 , reqEvent = ev 209 , reqEvent = ev
213 } 210 }
214 211
212encodeRequest :: URI -> AnnounceQuery -> URI
213encodeRequest announceURI req = URL.urlEncode req
214 `addToURI` announceURI
215 `addHashToURI` reqInfoHash req
216
215{----------------------------------------------------------------------- 217{-----------------------------------------------------------------------
216-- Announce response 218-- Announce response
217-----------------------------------------------------------------------} 219-----------------------------------------------------------------------}
218 220
221-- | For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
219data PeerList 222data PeerList
220 = PeerList { getPeerList :: [PeerAddr] } 223 = PeerList { getPeerList :: [PeerAddr] }
221 | CompactPeerList { getPeerList :: [PeerAddr] } 224 | CompactPeerList { getPeerList :: [PeerAddr] }
@@ -323,24 +326,16 @@ instance Serialize AnnounceInfo where
323 , respPeers = PeerList peers 326 , respPeers = PeerList peers
324 } 327 }
325 328
326-- TODO move this somewhere else
327-- | Ports typically reserved for bittorrent P2P listener.
328defaultPorts :: [PortNumber]
329defaultPorts = [6881..6889]
330
331-- | Above 25, new peers are highly unlikely to increase download 329-- | Above 25, new peers are highly unlikely to increase download
332-- speed. Even 30 peers is /plenty/, the official client version 3 330-- speed. Even 30 peers is /plenty/, the official client version 3
333-- in fact only actively forms new connections if it has less than 331-- in fact only actively forms new connections if it has less than
334-- 30 peers and will refuse connections if it has 55. 332-- 30 peers and will refuse connections if it has 55.
335-- 333--
336-- So the default value is set to 50 because usually 30-50% of peers 334-- <https://wiki.theory.org/BitTorrent_Tracker_Protocol#Basic_Tracker_Announce_Request>
337-- are not responding.
338-- 335--
339defaultNumWant :: Int 336defaultNumWant :: Int
340defaultNumWant = 50 337defaultNumWant = 50
341 338
342-- default value here: <https://wiki.theory.org/BitTorrent_Tracker_Protocol>
343
344{----------------------------------------------------------------------- 339{-----------------------------------------------------------------------
345 Scrape message 340 Scrape message
346-----------------------------------------------------------------------} 341-----------------------------------------------------------------------}
@@ -384,7 +379,7 @@ instance BEncode ScrapeInfo where
384 <*>! "incomplete" 379 <*>! "incomplete"
385 <*>? "name" 380 <*>? "name"
386 381
387-- | UDP tracker protocol complatble encoding. 382-- | UDP tracker protocol compatible encoding.
388instance Serialize ScrapeInfo where 383instance Serialize ScrapeInfo where
389 put ScrapeInfo {..} = do 384 put ScrapeInfo {..} = do
390 putWord32be $ fromIntegral siComplete 385 putWord32be $ fromIntegral siComplete
@@ -402,16 +397,3 @@ instance Serialize ScrapeInfo where
402 , siIncomplete = fromIntegral leechers 397 , siIncomplete = fromIntegral leechers
403 , siName = Nothing 398 , siName = Nothing
404 } 399 }
405
406-- | Set of tracker RPCs.
407class Tracker s where
408 connect :: URI -> IO s
409 announce :: s -> AnnounceQuery -> IO AnnounceInfo
410 scrape :: s -> ScrapeQuery -> IO Scrape
411
412-- | More particular version of 'scrape', just for one torrent.
413--
414scrapeOne :: Tracker t => t -> InfoHash -> IO ScrapeInfo
415scrapeOne uri ih = scrape uri [ih] >>= maybe err return . M.lookup ih
416 where
417 err = throwIO $ userError "unable to find info hash in response dict"