diff options
Diffstat (limited to 'tests/encoding.hs')
-rw-r--r-- | tests/encoding.hs | 25 |
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) | |||
11 | import Test.Framework.Providers.QuickCheck2 (testProperty) | 11 | import Test.Framework.Providers.QuickCheck2 (testProperty) |
12 | import Test.QuickCheck | 12 | import Test.QuickCheck |
13 | 13 | ||
14 | import Data.Torrent | ||
14 | import Network.Torrent | 15 | import Network.Torrent |
16 | import Network.URI | ||
15 | 17 | ||
16 | positive :: Gen Int | 18 | positive :: Gen Int |
17 | positive = fromIntegral <$> (arbitrary :: Gen Word32) | 19 | positive = fromIntegral <$> (arbitrary :: Gen Word32) |
@@ -45,16 +47,30 @@ instance Arbitrary PeerID where | |||
45 | <*> arbitrary | 47 | <*> arbitrary |
46 | <*> arbitrary | 48 | <*> arbitrary |
47 | 49 | ||
50 | instance Arbitrary InfoHash where | ||
51 | arbitrary = (hash . B.pack) <$> vectorOf 20 arbitrary | ||
52 | |||
48 | instance Arbitrary Handshake where | 53 | instance Arbitrary Handshake where |
49 | arbitrary = defaultHandshake | 54 | arbitrary = defaultHandshake <$> arbitrary <*> arbitrary |
50 | <$> (B.pack <$> (vectorOf 20 arbitrary)) | ||
51 | <*> arbitrary | ||
52 | 55 | ||
53 | data T a = T | 56 | data T a = T |
54 | 57 | ||
55 | prop_encoding :: (Serialize a, Eq a) => T a -> [a] -> Bool | 58 | prop_encoding :: (Serialize a, Eq a) => T a -> [a] -> Bool |
56 | prop_encoding _ msgs = decode (encode msgs) == Right msgs | 59 | prop_encoding _ msgs = decode (encode msgs) == Right msgs |
57 | 60 | ||
61 | test_scrape_url :: Bool | ||
62 | test_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 | ||
59 | main :: IO () | 75 | main :: IO () |
60 | main = do | 76 | main = 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 |