summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent/Tracker/List.hs8
-rw-r--r--tests/Network/BitTorrent/Tracker/ListSpec.hs5
2 files changed, 6 insertions, 7 deletions
diff --git a/src/Network/BitTorrent/Tracker/List.hs b/src/Network/BitTorrent/Tracker/List.hs
index b6371f1d..f2a4b264 100644
--- a/src/Network/BitTorrent/Tracker/List.hs
+++ b/src/Network/BitTorrent/Tracker/List.hs
@@ -26,6 +26,7 @@ import Prelude hiding (mapM, foldr)
26import Control.Applicative 26import Control.Applicative
27import Control.Exception 27import Control.Exception
28import Data.List as L (elem, any, filter, null) 28import Data.List as L (elem, any, filter, null)
29import Data.Maybe
29import Data.Foldable 30import Data.Foldable
30import Data.Traversable 31import Data.Traversable
31import Network.URI 32import Network.URI
@@ -95,9 +96,10 @@ fixList mxss mx = do
95 96
96-- | Extract set of trackers from torrent file. The 'tAnnounce' key is 97-- | Extract set of trackers from torrent file. The 'tAnnounce' key is
97-- only ignored if the 'tAnnounceList' key is present. 98-- only ignored if the 'tAnnounceList' key is present.
98trackerList :: Torrent -> Maybe (TrackerList URI) 99trackerList :: Torrent -> TrackerList URI
99trackerList Torrent {..} = TierList <$> (tAnnounceList `fixList` tAnnounce) 100trackerList Torrent {..} = fromMaybe (TierList []) $ do
100 <|> Announce <$> tAnnounce 101 TierList <$> (tAnnounceList `fixList` tAnnounce)
102 <|> Announce <$> tAnnounce
101 103
102-- | Shuffle /order of trackers/ in each tier, preserving original 104-- | Shuffle /order of trackers/ in each tier, preserving original
103-- /order of tiers/. This can help to balance the load between the 105-- /order of tiers/. This can help to balance the load between the
diff --git a/tests/Network/BitTorrent/Tracker/ListSpec.hs b/tests/Network/BitTorrent/Tracker/ListSpec.hs
index 8decd3c9..03379136 100644
--- a/tests/Network/BitTorrent/Tracker/ListSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/ListSpec.hs
@@ -18,14 +18,11 @@ uris = fmap (fromJust . parseURI . renderURI) [1..10 :: Int]
18 renderURI n = "http://" ++ show n ++ ".org" 18 renderURI n = "http://" ++ show n ++ ".org"
19 19
20list :: TrackerList URI 20list :: TrackerList URI
21list = fromJust $ trackerList def { tAnnounceList = Just [uris] } 21list = trackerList def { tAnnounceList = Just [uris] }
22 22
23spec :: Spec 23spec :: Spec
24spec = do 24spec = do
25 describe "TrackerList" $ do 25 describe "TrackerList" $ do
26 it "trackerList is not empty" $ do
27 pending
28
29 it "shuffleTiers (may fail with very small probability)" $ do 26 it "shuffleTiers (may fail with very small probability)" $ do
30 list' <- shuffleTiers list 27 list' <- shuffleTiers list
31 list' `shouldSatisfy` (/= list) 28 list' `shouldSatisfy` (/= list)