summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent/Tracker/RPC.hs4
-rw-r--r--tests/Network/BitTorrent/Tracker/RPCSpec.hs10
2 files changed, 7 insertions, 7 deletions
diff --git a/src/Network/BitTorrent/Tracker/RPC.hs b/src/Network/BitTorrent/Tracker/RPC.hs
index b3e962fa..cdc7d494 100644
--- a/src/Network/BitTorrent/Tracker/RPC.hs
+++ b/src/Network/BitTorrent/Tracker/RPC.hs
@@ -139,7 +139,7 @@ withManager opts info = bracket (newManager opts info) closeManager
139data RpcException 139data RpcException
140 = UdpException UDP.RpcException -- ^ UDP RPC driver failure; 140 = UdpException UDP.RpcException -- ^ UDP RPC driver failure;
141 | HttpException HTTP.RpcException -- ^ HTTP RPC driver failure; 141 | HttpException HTTP.RpcException -- ^ HTTP RPC driver failure;
142 | UnrecognizedProtocol String -- ^ unsupported scheme in announce URI; 142 | UnrecognizedScheme String -- ^ unsupported scheme in announce URI;
143 | GenericException String -- ^ for furter extensibility. 143 | GenericException String -- ^ for furter extensibility.
144 deriving (Show, Typeable) 144 deriving (Show, Typeable)
145 145
@@ -158,7 +158,7 @@ dispatch URI {..} http udp
158 | uriScheme == "http:" || 158 | uriScheme == "http:" ||
159 uriScheme == "https:" = packException HttpException http 159 uriScheme == "https:" = packException HttpException http
160 | uriScheme == "udp:" = packException UdpException udp 160 | uriScheme == "udp:" = packException UdpException udp
161 | otherwise = throwIO $ UnrecognizedProtocol uriScheme 161 | otherwise = throwIO $ UnrecognizedScheme uriScheme
162 162
163announce :: Manager -> URI -> SAnnounceQuery -> IO AnnounceInfo 163announce :: Manager -> URI -> SAnnounceQuery -> IO AnnounceInfo
164announce Manager {..} uri simpleQuery 164announce Manager {..} uri simpleQuery
diff --git a/tests/Network/BitTorrent/Tracker/RPCSpec.hs b/tests/Network/BitTorrent/Tracker/RPCSpec.hs
index b816a9ce..dfc13a1e 100644
--- a/tests/Network/BitTorrent/Tracker/RPCSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/RPCSpec.hs
@@ -24,9 +24,9 @@ rpcOpts = def
24 { optUdpRPC = UDP.rpcOpts 24 { optUdpRPC = UDP.rpcOpts
25 } 25 }
26 26
27isUnrecognizedProtocol :: String -> RpcException -> Bool 27matchUnrecognizedScheme :: String -> RpcException -> Bool
28isUnrecognizedProtocol x (UnrecognizedProtocol scheme) = x == scheme 28matchUnrecognizedScheme x (UnrecognizedScheme scheme) = x == scheme
29isUnrecognizedProtocol _ _ = False 29matchUnrecognizedScheme _ _ = False
30 30
31spec :: Spec 31spec :: Spec
32spec = parallel $ do 32spec = parallel $ do
@@ -46,13 +46,13 @@ spec = parallel $ do
46 withManager rpcOpts def $ \ mgr -> do 46 withManager rpcOpts def $ \ mgr -> do
47 q <- arbitrarySample 47 q <- arbitrarySample
48 announce mgr "magnet://foo.bar" q 48 announce mgr "magnet://foo.bar" q
49 `shouldThrow` isUnrecognizedProtocol "magnet:" 49 `shouldThrow` matchUnrecognizedScheme "magnet:"
50 50
51 describe "scrape" $ do 51 describe "scrape" $ do
52 it "must fail on bad uri scheme" $ do 52 it "must fail on bad uri scheme" $ do
53 withManager rpcOpts def $ \ mgr -> do 53 withManager rpcOpts def $ \ mgr -> do
54 scrape mgr "magnet://foo.bar" [] 54 scrape mgr "magnet://foo.bar" []
55 `shouldThrow` isUnrecognizedProtocol "magnet:" 55 `shouldThrow` matchUnrecognizedScheme "magnet:"
56 56
57 forM_ trackers $ \ TrackerEntry {..} -> 57 forM_ trackers $ \ TrackerEntry {..} ->
58 context trackerName $ do 58 context trackerName $ do