From 993bac7ce9ea580d964f1844968d1fec5a4d246b Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Thu, 27 Feb 2014 16:43:43 +0400 Subject: Add behavious for bad http: schemes --- tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) (limited to 'tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs') diff --git a/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs index 5288e304..f82263ee 100644 --- a/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs +++ b/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs @@ -12,6 +12,7 @@ import Network.BitTorrent.Tracker.Message as Message import Network.BitTorrent.Tracker.RPC.HTTP import Network.BitTorrent.Tracker.TestData +import Network.BitTorrent.Tracker.MessageSpec hiding (spec) validateInfo :: AnnounceQuery -> AnnounceInfo -> Expectation @@ -21,6 +22,10 @@ validateInfo AnnounceQuery {..} AnnounceInfo {..} = do Nothing -> return () Just n -> n `shouldBe` L.length (getPeerList respPeers) +isUnrecognizedScheme :: RpcException -> Bool +isUnrecognizedScheme (RequestFailed _) = True +isUnrecognizedScheme _ = False + spec :: Spec spec = parallel $ do describe "Manager" $ do @@ -36,11 +41,16 @@ spec = parallel $ do describe "RPC" $ do describe "announce" $ do it "must fail on bad uri scheme" $ do - pending + withManager def $ \ mgr -> do + q <- arbitrarySample + announce mgr "magnet://foo.bar" q + `shouldThrow` isUnrecognizedScheme describe "scrape" $ do - it "fail on bad uri scheme" $ do - pending + it "must fail on bad uri scheme" $ do + withManager def $ \ mgr -> do + scrape mgr "magnet://foo.bar" [] + `shouldThrow` isUnrecognizedScheme forM_ (L.filter isHttpTracker trackers) $ \ TrackerEntry {..} -> context trackerName $ do -- cgit v1.2.3