summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bittorrent.cabal11
-rw-r--r--src/Network/BitTorrent/Tracker.hs21
-rw-r--r--src/Network/BitTorrent/Tracker/Extension.hs7
-rw-r--r--src/Network/BitTorrent/Tracker/RPC.hs41
-rw-r--r--src/Network/BitTorrent/Tracker/RPC/HTTP.hs (renamed from src/Network/BitTorrent/Tracker/HTTP.hs)78
-rw-r--r--src/Network/BitTorrent/Tracker/RPC/Message.hs (renamed from src/Network/BitTorrent/Tracker/Message.hs)4
-rw-r--r--src/Network/BitTorrent/Tracker/RPC/UDP.hs (renamed from src/Network/BitTorrent/Tracker/UDP.hs)23
-rw-r--r--src/Network/BitTorrent/Tracker/Session.hs56
-rw-r--r--tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs (renamed from tests/Network/BitTorrent/Tracker/MessageSpec.hs)4
-rw-r--r--tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs7
10 files changed, 161 insertions, 91 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal
index 51257ae9..4d11b346 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -65,9 +65,10 @@ library
65-- , Network.BitTorrent.Exchange.Wire 65-- , Network.BitTorrent.Exchange.Wire
66-- , Network.BitTorrent.Extension 66-- , Network.BitTorrent.Extension
67-- , Network.BitTorrent.Tracker 67-- , Network.BitTorrent.Tracker
68 , Network.BitTorrent.Tracker.Message 68-- , Network.BitTorrent.Tracker.RPC
69-- , Network.BitTorrent.Tracker.HTTP 69 , Network.BitTorrent.Tracker.RPC.Message
70-- , Network.BitTorrent.Tracker.UDP 70-- , Network.BitTorrent.Tracker.RPC.HTTP
71 , Network.BitTorrent.Tracker.RPC.UDP
71-- , Network.BitTorrent.Tracker.Session 72-- , Network.BitTorrent.Tracker.Session
72-- , Network.BitTorrent.Session 73-- , Network.BitTorrent.Session
73-- , Network.BitTorrent.Session.Types 74-- , Network.BitTorrent.Session.Types
@@ -128,6 +129,7 @@ library
128 -- Network 129 -- Network
129 , network >= 2.4 130 , network >= 2.4
130 , http-types >= 0.7 131 , http-types >= 0.7
132 , http-conduit
131-- , krpc 133-- , krpc
132 134
133 -- System 135 -- System
@@ -152,7 +154,8 @@ test-suite spec
152 Data.Torrent.MetainfoSpec 154 Data.Torrent.MetainfoSpec
153 Data.Torrent.ProgressSpec 155 Data.Torrent.ProgressSpec
154 Network.BitTorrent.Core.PeerIdSpec 156 Network.BitTorrent.Core.PeerIdSpec
155 Network.BitTorrent.Tracker.MessageSpec 157 Network.BitTorrent.Tracker.RPC.MessageSpec
158 Network.BitTorrent.Tracker.RPC.UDPSpec
156 build-depends: base == 4.* 159 build-depends: base == 4.*
157 , bytestring 160 , bytestring
158 , directory 161 , directory
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs
index 2507e353..9c7590c4 100644
--- a/src/Network/BitTorrent/Tracker.hs
+++ b/src/Network/BitTorrent/Tracker.hs
@@ -43,27 +43,6 @@ import Network.BitTorrent.Tracker.HTTP
43import Network.BitTorrent.Tracker.UDP 43import Network.BitTorrent.Tracker.UDP
44 44
45{----------------------------------------------------------------------- 45{-----------------------------------------------------------------------
46 Generalized Tracker instance — UDP + HTTP
47-----------------------------------------------------------------------}
48
49data BitTracker = HTTPTr HTTPTracker
50 | UDPTr UDPTracker
51
52instance Tracker BitTracker where
53 connect uri @ URI {..}
54 | uriScheme == "udp:" = UDPTr <$> connect uri
55 | uriScheme == "http:" = HTTPTr <$> connect uri
56 | otherwise = throwIO $ userError msg
57 where
58 msg = "unknown tracker protocol scheme: " ++ show uriScheme
59
60 announce (HTTPTr t) = Tracker.announce t
61 announce (UDPTr t) = Tracker.announce t
62
63 scrape (HTTPTr t) = scrape t
64 scrape (UDPTr t) = scrape t
65
66{-----------------------------------------------------------------------
67 Tracker connection 46 Tracker connection
68-----------------------------------------------------------------------} 47-----------------------------------------------------------------------}
69 48
diff --git a/src/Network/BitTorrent/Tracker/Extension.hs b/src/Network/BitTorrent/Tracker/Extension.hs
new file mode 100644
index 00000000..57e346d6
--- /dev/null
+++ b/src/Network/BitTorrent/Tracker/Extension.hs
@@ -0,0 +1,7 @@
1module Network.BitTorrent.Tracker.Extension
2 (
3 ) where
4
5data Extension
6 = NoPeerId
7 | CompactPeers \ No newline at end of file
diff --git a/src/Network/BitTorrent/Tracker/RPC.hs b/src/Network/BitTorrent/Tracker/RPC.hs
new file mode 100644
index 00000000..c5aaeb03
--- /dev/null
+++ b/src/Network/BitTorrent/Tracker/RPC.hs
@@ -0,0 +1,41 @@
1module Network.BitTorrent.Tracker.RPC
2 ( module Network.BitTorrent.Tracker.RPC.Message
3 , TrackerRPC (..)
4 ) where
5
6import Network.BitTorrent.Tracker.RPC.Message
7import Network.BitTorrent.Tracker.RPC.HTTP as HTTP
8import Network.BitTorrent.Tracker.RPC.UDP as UDP
9
10-- | Set of tracker RPCs.
11class Tracker s where
12 connect :: URI -> IO s
13 announce :: s -> AnnounceQuery -> IO AnnounceInfo
14 scrape :: s -> ScrapeQuery -> IO Scrape
15
16instance Tracker HTTP.Tracker where
17 connect = return . HTTP.Tracker
18 announce = HTTP.announce
19 scrape = undefined
20
21instance Tracker UDP.Tracker where
22 connect = initialTracker
23 announce = announce
24 scrape = undefined
25
26data BitTracker = HTTPTr HTTPTracker
27 | UDPTr UDPTracker
28
29instance Tracker BitTracker where
30 connect uri @ URI {..}
31 | uriScheme == "udp:" = UDPTr <$> connect uri
32 | uriScheme == "http:" = HTTPTr <$> connect uri
33 | otherwise = throwIO $ userError msg
34 where
35 msg = "unknown tracker protocol scheme: " ++ show uriScheme
36
37 announce (HTTPTr t) = Tracker.announce t
38 announce (UDPTr t) = Tracker.announce t
39
40 scrape (HTTPTr t) = scrape t
41 scrape (UDPTr t) = scrape t
diff --git a/src/Network/BitTorrent/Tracker/HTTP.hs b/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
index b466b49e..0eef2b7e 100644
--- a/src/Network/BitTorrent/Tracker/HTTP.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
@@ -13,78 +13,50 @@
13-- For more information see: 13-- For more information see:
14-- <https://wiki.theory.org/BitTorrentSpecification#Tracker_HTTP.2FHTTPS_Protocol> 14-- <https://wiki.theory.org/BitTorrentSpecification#Tracker_HTTP.2FHTTPS_Protocol>
15-- 15--
16module Network.BitTorrent.Tracker.HTTP 16module Network.BitTorrent.Tracker.RPC.HTTP
17 ( HTTPTracker 17 ( Connection
18 18 , connect
19 -- * Extra 19 , announce
20-- , scrapeURL 20 , scrape
21 ) where 21 ) where
22 22
23import Control.Applicative
23import Control.Exception 24import Control.Exception
24import Data.BEncode 25import Data.BEncode as BE
25import Data.ByteString as B 26import Data.ByteString as B
26import Data.ByteString.Char8 as BC 27import Data.ByteString.Char8 as BC
28import Data.ByteString.Lazy as BL
27import Data.List as L 29import Data.List as L
28import Data.Map as M 30import Data.Map as M
29import Data.Monoid 31import Data.Monoid
30import Data.URLEncoded as URL
31import Network.URI 32import Network.URI
32import Network.HTTP 33import Network.HTTP.Conduit
33 34
34import Data.Torrent.InfoHash 35import Data.Torrent.InfoHash
35import Network.BitTorrent.Tracker.Message 36import Network.BitTorrent.Tracker.RPC.Message
36 37
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 38
43-- | More particular version of 'scrape', just for one torrent. 39data Connection = Connection
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"
49
50data HTTPTracker = HTTPTracker
51 { announceURI :: URI 40 { announceURI :: URI
52 } deriving Show 41 } deriving Show
53 42
54instance Tracker HTTPTracker where 43connect :: URI -> IO Connection
55 connect = return . HTTPTracker 44connect = return . Connection
56 announce = announceHTTP
57-- scrape = scrapeHTTP
58
59{-----------------------------------------------------------------------
60 Announce
61-----------------------------------------------------------------------}
62
63mkGET :: URI -> Request ByteString
64mkGET uri = Request uri GET [] ""
65 45
66-- | Send request and receive response from the tracker specified in 46-- | Send request and receive response from the tracker specified in
67-- announce list. This function throws 'IOException' if it couldn't 47-- announce list. This function throws 'IOException' if it couldn't
68-- send request or receive response or decode response. 48-- send request or receive response or decode response.
69-- 49--
70announceHTTP :: HTTPTracker -> AnnounceQuery -> IO AnnounceInfo 50announce :: AnnounceQuery -> Connection -> IO (Result AnnounceInfo)
71announceHTTP HTTPTracker {..} req = do 51announce req = do
72 let r = mkGET (renderAnnounceQuery announceURI req) 52 let uri = undefined
53 resp <- BL.toStrict <$> simpleHttp uri
54 return $ BE.decode resp
73 55
74 rawResp <- simpleHTTP r 56scrape :: ScrapeQuery -> Connection -> IO (Result Scrape)
75 respBody <- getResponseBody rawResp 57scrape = undefined
76 checkResult $ decode respBody
77 where
78 checkResult (Left err)
79 = ioError $ userError $ err ++ " in tracker response"
80 checkResult (Right (Failure err))
81 = ioError $ userError $ show err ++ " in tracker response"
82 checkResult (Right resp) = return resp
83{-
84{-----------------------------------------------------------------------
85 Scrape
86-----------------------------------------------------------------------}
87 58
59{-
88-- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL' 60-- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL'
89-- gives 'Nothing' then tracker do not support scraping. The info hash 61-- gives 'Nothing' then tracker do not support scraping. The info hash
90-- list is used to restrict the tracker's report to that particular 62-- list is used to restrict the tracker's report to that particular
@@ -123,4 +95,12 @@ scrapeHTTP HTTPTracker {..} ihs
123 Right r -> return r 95 Right r -> return r
124 96
125 | otherwise = throwIO $ userError "Tracker do not support scraping" 97 | otherwise = throwIO $ userError "Tracker do not support scraping"
98
99-- | More particular version of 'scrape', just for one torrent.
100--
101scrapeOne :: Tracker t => t -> InfoHash -> IO ScrapeInfo
102scrapeOne uri ih = scrape uri [ih] >>= maybe err return . M.lookup ih
103 where
104 err = throwIO $ userError "unable to find info hash in response dict"
105
126-} \ No newline at end of file 106-} \ No newline at end of file
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/RPC/Message.hs
index dde13155..18c1a4c7 100644
--- a/src/Network/BitTorrent/Tracker/Message.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/Message.hs
@@ -23,7 +23,7 @@
23{-# LANGUAGE TemplateHaskell #-} 23{-# LANGUAGE TemplateHaskell #-}
24{-# LANGUAGE DeriveDataTypeable #-} 24{-# LANGUAGE DeriveDataTypeable #-}
25{-# OPTIONS -fno-warn-orphans #-} 25{-# OPTIONS -fno-warn-orphans #-}
26module Network.BitTorrent.Tracker.Message 26module Network.BitTorrent.Tracker.RPC.Message
27 ( -- * Announce 27 ( -- * Announce
28 -- ** Request 28 -- ** Request
29 Event(..) 29 Event(..)
@@ -132,7 +132,7 @@ getEvent = do
132data AnnounceQuery = AnnounceQuery 132data AnnounceQuery = AnnounceQuery
133 { 133 {
134 -- | Hash of info part of the torrent usually obtained from 134 -- | Hash of info part of the torrent usually obtained from
135 -- 'Torrent'. 135 -- 'Torrent' or 'Magnet'.
136 reqInfoHash :: !InfoHash 136 reqInfoHash :: !InfoHash
137 137
138 -- | ID of the peer doing request. 138 -- | ID of the peer doing request.
diff --git a/src/Network/BitTorrent/Tracker/UDP.hs b/src/Network/BitTorrent/Tracker/RPC/UDP.hs
index 59714317..beff6b4f 100644
--- a/src/Network/BitTorrent/Tracker/UDP.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/UDP.hs
@@ -13,8 +13,12 @@
13{-# LANGUAGE FlexibleInstances #-} 13{-# LANGUAGE FlexibleInstances #-}
14{-# LANGUAGE GeneralizedNewtypeDeriving #-} 14{-# LANGUAGE GeneralizedNewtypeDeriving #-}
15{-# LANGUAGE TypeFamilies #-} 15{-# LANGUAGE TypeFamilies #-}
16module Network.BitTorrent.Tracker.UDP 16module Network.BitTorrent.Tracker.RPC.UDP
17 ( UDPTracker 17 ( UDPTracker
18 , connect
19 , announce
20 , scrape
21 , retransmission
18 22
19 -- * Debug 23 -- * Debug
20 , putTracker 24 , putTracker
@@ -42,7 +46,7 @@ import System.Entropy
42import System.Timeout 46import System.Timeout
43import Numeric 47import Numeric
44 48
45import Network.BitTorrent.Tracker.Protocol 49import Network.BitTorrent.Tracker.RPC.Message
46 50
47{----------------------------------------------------------------------- 51{-----------------------------------------------------------------------
48 Tokens 52 Tokens
@@ -301,16 +305,16 @@ freshConnection tracker @ UDPTracker {..} = do
301 connId <- connectUDP tracker 305 connId <- connectUDP tracker
302 updateConnection connId tracker 306 updateConnection connId tracker
303 307
304announceUDP :: UDPTracker -> AnnounceQuery -> IO AnnounceInfo 308announce :: UDPTracker -> AnnounceQuery -> IO AnnounceInfo
305announceUDP tracker ann = do 309announce tracker ann = do
306 freshConnection tracker 310 freshConnection tracker
307 resp <- transaction tracker (Announce ann) 311 resp <- transaction tracker (Announce ann)
308 case resp of 312 case resp of
309 Announced info -> return info 313 Announced info -> return info
310 _ -> fail "announce: response type mismatch" 314 _ -> fail "announce: response type mismatch"
311 315
312scrapeUDP :: UDPTracker -> ScrapeQuery -> IO Scrape 316scrape :: UDPTracker -> ScrapeQuery -> IO Scrape
313scrapeUDP tracker scr = do 317scrape tracker scr = do
314 freshConnection tracker 318 freshConnection tracker
315 resp <- transaction tracker (Scrape scr) 319 resp <- transaction tracker (Scrape scr)
316 case resp of 320 case resp of
@@ -338,10 +342,3 @@ retransmission action = go minTimeout
338 | otherwise = do 342 | otherwise = do
339 r <- timeout curTimeout action 343 r <- timeout curTimeout action
340 maybe (go (2 * curTimeout)) return r 344 maybe (go (2 * curTimeout)) return r
341
342{----------------------------------------------------------------------}
343
344instance Tracker UDPTracker where
345 connect = initialTracker
346 announce t = retransmission . announceUDP t
347 scrape t = retransmission . scrapeUDP t
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs
new file mode 100644
index 00000000..3cfc4b52
--- /dev/null
+++ b/src/Network/BitTorrent/Tracker/Session.hs
@@ -0,0 +1,56 @@
1module Network.BitTorrent.Tracker.Session
2 (
3 ) where
4
5import Data.Torrent.Progress
6import Data.Torrent.InfoHash
7import Network.BitTorrent.Core.PeerAddr
8import Network.BitTorrent.Tracker.Message
9
10data PeerInfo = PeerInfo
11 { peerId :: PeerId
12 , peerPort :: PortNumber
13 , peerIP :: Maybe HostAddress
14 }
15
16data Session = Session
17 { sesInfoHash :: !InfoHash
18 , sesPeerInfo :: !PeerInfo
19 }
20
21data SAnnounceQuery = SAnnounceQuery
22 { sreqProgress :: Progress
23 , sreqNumWant :: Maybe Int
24 , sreqEvent :: Maybe Event
25 }
26
27type SAnnounceInfo = [PeerAddr]
28
29f :: Session -> SAnnounceQuery -> AnnounceQuery
30f Session {..} SAnnounceQuery {..} = AnnounceQuery
31 { reqInfoHash = sesInfoHash
32 , reqPeerInfo = sesPeerInfo
33 , reqProgress = sreqProgress
34 , reqNumWant = undefined
35 , reqEvent = sreqEvent
36 }
37
38data Settings = Settings
39
40data Manager = Manager
41 {
42 }
43
44
45g :: Session -> AnnounceInfo -> SAnnounceInfo
46g Session {..} SAnnounceInfo {..} = undefined
47
48
49reannounce :: HTracker -> IO ()
50reannounce = undefined
51
52forceReannounce :: HTracker -> IO ()
53forceReannounce = undefined
54
55scrape :: HTracker -> IO ()
56scrape = undefined
diff --git a/tests/Network/BitTorrent/Tracker/MessageSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs
index f1d9130c..8e95286a 100644
--- a/tests/Network/BitTorrent/Tracker/MessageSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPC/MessageSpec.hs
@@ -1,5 +1,5 @@
1{-# OPTIONS -fno-warn-orphans #-} 1{-# OPTIONS -fno-warn-orphans #-}
2module Network.BitTorrent.Tracker.MessageSpec (spec) where 2module Network.BitTorrent.Tracker.RPC.MessageSpec (spec) where
3 3
4import Control.Applicative 4import Control.Applicative
5import Data.Word 5import Data.Word
@@ -11,7 +11,7 @@ import Data.Torrent.InfoHashSpec ()
11import Data.Torrent.ProgressSpec () 11import Data.Torrent.ProgressSpec ()
12import Network.BitTorrent.Core.PeerIdSpec () 12import Network.BitTorrent.Core.PeerIdSpec ()
13 13
14import Network.BitTorrent.Tracker.Message 14import Network.BitTorrent.Tracker.RPC.Message
15 15
16 16
17--prop_bencode :: Eq a => BEncode a => a -> Bool 17--prop_bencode :: Eq a => BEncode a => a -> Bool
diff --git a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
new file mode 100644
index 00000000..4cbaa09d
--- /dev/null
+++ b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
@@ -0,0 +1,7 @@
1module Network.BitTorrent.Tracker.RPC.UDPSpec (spec) where
2import Test.Hspec
3
4spec :: Spec
5spec =
6 describe "UDP tracker client RPC" $ do
7 return () \ No newline at end of file