summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bittorrent.cabal1
-rw-r--r--src/Network/BitTorrent/Tracker/RPC/Message.hs2
-rw-r--r--src/Network/BitTorrent/Tracker/RPC/UDP.hs18
-rw-r--r--tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs53
4 files changed, 62 insertions, 12 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal
index 4d11b346..ebecaa26 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -162,6 +162,7 @@ test-suite spec
162 , filepath 162 , filepath
163 , time 163 , time
164 , convertible 164 , convertible
165 , data-default
165 166
166 , aeson 167 , aeson
167 , cereal 168 , cereal
diff --git a/src/Network/BitTorrent/Tracker/RPC/Message.hs b/src/Network/BitTorrent/Tracker/RPC/Message.hs
index 18c1a4c7..a0691f37 100644
--- a/src/Network/BitTorrent/Tracker/RPC/Message.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/Message.hs
@@ -482,6 +482,7 @@ parseFailureStatus = mkStatus <$> parseFailureCode <*> parseFailureMessage
482 482
483type ScrapeQuery = [InfoHash] 483type ScrapeQuery = [InfoHash]
484 484
485-- TODO rename to ScrapeEntry
485-- | Overall information about particular torrent. 486-- | Overall information about particular torrent.
486data ScrapeInfo = ScrapeInfo { 487data ScrapeInfo = ScrapeInfo {
487 -- | Number of seeders - peers with the entire file. 488 -- | Number of seeders - peers with the entire file.
@@ -501,6 +502,7 @@ data ScrapeInfo = ScrapeInfo {
501$(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) 502$(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo)
502 503
503-- TODO hash map 504-- TODO hash map
505-- TODO rename to ScrapeInfo
504-- | Scrape info about a set of torrents. 506-- | Scrape info about a set of torrents.
505type Scrape = Map InfoHash ScrapeInfo 507type Scrape = Map InfoHash ScrapeInfo
506 508
diff --git a/src/Network/BitTorrent/Tracker/RPC/UDP.hs b/src/Network/BitTorrent/Tracker/RPC/UDP.hs
index beff6b4f..0336db8d 100644
--- a/src/Network/BitTorrent/Tracker/RPC/UDP.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/UDP.hs
@@ -39,7 +39,7 @@ import Data.Text.Encoding
39import Data.Time 39import Data.Time
40import Data.Word 40import Data.Word
41import Text.Read (readMaybe) 41import Text.Read (readMaybe)
42import Network.Socket hiding (Connected) 42import Network.Socket hiding (Connected, connect)
43import Network.Socket.ByteString as BS 43import Network.Socket.ByteString as BS
44import Network.URI 44import Network.URI
45import System.Entropy 45import System.Entropy
@@ -290,8 +290,8 @@ connectUDP tracker = do
290 Failed msg -> throwIO $ userError $ T.unpack msg 290 Failed msg -> throwIO $ userError $ T.unpack msg
291 _ -> throwIO $ userError "message type mismatch" 291 _ -> throwIO $ userError "message type mismatch"
292 292
293initialTracker :: URI -> IO UDPTracker 293connect :: URI -> IO UDPTracker
294initialTracker uri = do 294connect uri = do
295 tracker <- UDPTracker uri <$> (newIORef =<< initialConnection) 295 tracker <- UDPTracker uri <$> (newIORef =<< initialConnection)
296 connId <- connectUDP tracker 296 connId <- connectUDP tracker
297 updateConnection connId tracker 297 updateConnection connId tracker
@@ -305,20 +305,20 @@ freshConnection tracker @ UDPTracker {..} = do
305 connId <- connectUDP tracker 305 connId <- connectUDP tracker
306 updateConnection connId tracker 306 updateConnection connId tracker
307 307
308announce :: UDPTracker -> AnnounceQuery -> IO AnnounceInfo 308announce :: AnnounceQuery -> UDPTracker -> IO AnnounceInfo
309announce tracker ann = do 309announce ann tracker = do
310 freshConnection tracker 310 freshConnection tracker
311 resp <- transaction tracker (Announce ann) 311 resp <- transaction tracker (Announce ann)
312 case resp of 312 case resp of
313 Announced info -> return info 313 Announced info -> return info
314 _ -> fail "announce: response type mismatch" 314 _ -> fail "announce: response type mismatch"
315 315
316scrape :: UDPTracker -> ScrapeQuery -> IO Scrape 316scrape :: ScrapeQuery -> UDPTracker -> IO Scrape
317scrape tracker scr = do 317scrape ihs tracker = do
318 freshConnection tracker 318 freshConnection tracker
319 resp <- transaction tracker (Scrape scr) 319 resp <- transaction tracker (Scrape ihs)
320 case resp of 320 case resp of
321 Scraped info -> return $ M.fromList $ L.zip scr info 321 Scraped info -> return $ M.fromList $ L.zip ihs info
322 _ -> fail "scrape: response type mismatch" 322 _ -> fail "scrape: response type mismatch"
323 323
324{----------------------------------------------------------------------- 324{-----------------------------------------------------------------------
diff --git a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
index 4cbaa09d..1a893011 100644
--- a/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPC/UDPSpec.hs
@@ -1,7 +1,54 @@
1{-# LANGUAGE RecordWildCards #-}
1module Network.BitTorrent.Tracker.RPC.UDPSpec (spec) where 2module Network.BitTorrent.Tracker.RPC.UDPSpec (spec) where
3
4import Control.Applicative
5import Control.Monad
6import Data.Default
7import Data.List as L
8import Data.Maybe
9import Network.URI
2import Test.Hspec 10import Test.Hspec
11import Test.QuickCheck
12
13import Network.BitTorrent.Core.PeerAddr
14import Network.BitTorrent.Tracker.RPC.Message
15import Network.BitTorrent.Tracker.RPC.UDP
16import Network.BitTorrent.Tracker.RPC.MessageSpec ()
17
18
19arbitrarySample :: Arbitrary a => IO a
20arbitrarySample = L.head <$> sample' arbitrary
21
22trackerURIs :: [URI]
23trackerURIs =
24 [ fromJust $ parseURI "udp://tracker.openbittorrent.com:80/announce"
25 , fromJust $ parseURI "udp://tracker.publicbt.com:80/announce"
26 ]
27
28-- relation with query: peer id, numwant
29validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation
30validateInfo AnnounceQuery {..} AnnounceInfo {..} = do
31 respComplete `shouldSatisfy` isJust
32 respIncomplete `shouldSatisfy` isJust
33 respMinInterval `shouldSatisfy` isNothing
34 respWarning `shouldSatisfy` isNothing
35 peerList `shouldSatisfy` L.all (isNothing . peerID)
36 fromJust respComplete + fromJust respIncomplete `shouldBe` L.length peerList
37 where
38 peerList = getPeerList respPeers
39
3 40
4spec :: Spec 41spec :: Spec
5spec = 42spec = do
6 describe "UDP tracker client RPC" $ do 43 forM_ trackerURIs $ \ uri ->
7 return () \ No newline at end of file 44 context (show uri) $ do
45 describe "announce" $ do
46 it "have valid response" $ do
47 query <- arbitrarySample
48 connect uri >>= announce query >>= validateInfo query
49
50 describe "scrape" $ do
51 it "have valid response" $ do
52 xs <- connect uri >>= scrape [def]
53 return ()
54-- L.length xs `shouldSatisfy` (>= 1)