Add behavious for bad http: schemes

1 files changed, 13 insertions, 3 deletions

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