diff options
-rw-r--r-- | src/Network/BitTorrent/Tracker/List.hs | 8 | ||||
-rw-r--r-- | tests/Network/BitTorrent/Tracker/ListSpec.hs | 5 |
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) | |||
26 | import Control.Applicative | 26 | import Control.Applicative |
27 | import Control.Exception | 27 | import Control.Exception |
28 | import Data.List as L (elem, any, filter, null) | 28 | import Data.List as L (elem, any, filter, null) |
29 | import Data.Maybe | ||
29 | import Data.Foldable | 30 | import Data.Foldable |
30 | import Data.Traversable | 31 | import Data.Traversable |
31 | import Network.URI | 32 | import 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. |
98 | trackerList :: Torrent -> Maybe (TrackerList URI) | 99 | trackerList :: Torrent -> TrackerList URI |
99 | trackerList Torrent {..} = TierList <$> (tAnnounceList `fixList` tAnnounce) | 100 | trackerList 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 | ||
20 | list :: TrackerList URI | 20 | list :: TrackerList URI |
21 | list = fromJust $ trackerList def { tAnnounceList = Just [uris] } | 21 | list = trackerList def { tAnnounceList = Just [uris] } |
22 | 22 | ||
23 | spec :: Spec | 23 | spec :: Spec |
24 | spec = do | 24 | spec = 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) |