summaryrefslogtreecommitdiff
path: root/tests/encoding.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/encoding.hs')
-rw-r--r--tests/encoding.hs25
1 files changed, 22 insertions, 3 deletions
diff --git a/tests/encoding.hs b/tests/encoding.hs
index b820dc26..e1a8b63e 100644
--- a/tests/encoding.hs
+++ b/tests/encoding.hs
@@ -11,7 +11,9 @@ import Test.Framework (defaultMain)
11import Test.Framework.Providers.QuickCheck2 (testProperty) 11import Test.Framework.Providers.QuickCheck2 (testProperty)
12import Test.QuickCheck 12import Test.QuickCheck
13 13
14import Data.Torrent
14import Network.Torrent 15import Network.Torrent
16import Network.URI
15 17
16positive :: Gen Int 18positive :: Gen Int
17positive = fromIntegral <$> (arbitrary :: Gen Word32) 19positive = fromIntegral <$> (arbitrary :: Gen Word32)
@@ -45,16 +47,30 @@ instance Arbitrary PeerID where
45 <*> arbitrary 47 <*> arbitrary
46 <*> arbitrary 48 <*> arbitrary
47 49
50instance Arbitrary InfoHash where
51 arbitrary = (hash . B.pack) <$> vectorOf 20 arbitrary
52
48instance Arbitrary Handshake where 53instance Arbitrary Handshake where
49 arbitrary = defaultHandshake 54 arbitrary = defaultHandshake <$> arbitrary <*> arbitrary
50 <$> (B.pack <$> (vectorOf 20 arbitrary))
51 <*> arbitrary
52 55
53data T a = T 56data T a = T
54 57
55prop_encoding :: (Serialize a, Eq a) => T a -> [a] -> Bool 58prop_encoding :: (Serialize a, Eq a) => T a -> [a] -> Bool
56prop_encoding _ msgs = decode (encode msgs) == Right msgs 59prop_encoding _ msgs = decode (encode msgs) == Right msgs
57 60
61test_scrape_url :: Bool
62test_scrape_url = check `all` tests
63 where
64 check (iu, ou) = (parseURI iu >>= (`scrapeURL` []) >>= return . show) == ou
65 tests =
66 [ ("http://example.com/announce" , Just "http://example.com/scrape")
67 , ("http://example.com/x/announce" , Just "http://example.com/x/scrape")
68 , ("http://example.com/announce.php" , Just "http://example.com/scrape.php")
69 , ("http://example.com/a" , Nothing)
70 , ("http://example.com/announce?x2%0644", Just "http://example.com/scrape?x2%0644")
71 , ("http://example.com/announce?x=2/4" , Nothing)
72 , ("http://example.com/x%064announce" , Nothing)
73 ]
58 74
59main :: IO () 75main :: IO ()
60main = do 76main = do
@@ -67,4 +83,7 @@ main = do
67 83
68 , testProperty "Handshake encode <-> decode" $ 84 , testProperty "Handshake encode <-> decode" $
69 prop_encoding (T :: T Handshake) 85 prop_encoding (T :: T Handshake)
86
87 , testProperty "Scrape URL" $
88 test_scrape_url
70 ] \ No newline at end of file 89 ] \ No newline at end of file