diff options
-rw-r--r-- | tests/Main.hs | 28 |
1 files changed, 22 insertions, 6 deletions
diff --git a/tests/Main.hs b/tests/Main.hs index 44ea3393..0288cad9 100644 --- a/tests/Main.hs +++ b/tests/Main.hs | |||
@@ -36,6 +36,7 @@ import Test.Framework as Framework (Test, defaultMain) | |||
36 | import Test.Framework.Providers.QuickCheck2 (testProperty) | 36 | import Test.Framework.Providers.QuickCheck2 (testProperty) |
37 | import Test.Framework.Providers.HUnit (testCase) | 37 | import Test.Framework.Providers.HUnit (testCase) |
38 | 38 | ||
39 | import Data.Aeson as JSON | ||
39 | import Data.BEncode as BE | 40 | import Data.BEncode as BE |
40 | import Data.Bitfield as BF | 41 | import Data.Bitfield as BF |
41 | import Data.Torrent | 42 | import Data.Torrent |
@@ -51,6 +52,17 @@ import qualified System.IO.MMap.Fixed as Fixed | |||
51 | 52 | ||
52 | data T a = T | 53 | data T a = T |
53 | 54 | ||
55 | |||
56 | prop_properBEncode :: Show a => BEncodable a => Eq a => T a -> a -> Bool | ||
57 | prop_properBEncode _ expected = actual == Right expected | ||
58 | where | ||
59 | actual = decoded $ Lazy.toStrict $ encoded expected | ||
60 | |||
61 | prop_properJSON :: (FromJSON a, ToJSON a) => Eq a => T a -> a -> Bool | ||
62 | prop_properJSON _ expected = actual == Just expected | ||
63 | where | ||
64 | actual = JSON.decode $ JSON.encode expected | ||
65 | |||
54 | instance Arbitrary URI where | 66 | instance Arbitrary URI where |
55 | arbitrary = pure $ fromJust | 67 | arbitrary = pure $ fromJust |
56 | $ parseURI "http://exsample.com:80/123365_asd" | 68 | $ parseURI "http://exsample.com:80/123365_asd" |
@@ -93,12 +105,6 @@ prop_differenceDeMorgan a b c = | |||
93 | Torrent | 105 | Torrent |
94 | -----------------------------------------------------------------------} | 106 | -----------------------------------------------------------------------} |
95 | 107 | ||
96 | prop_properBEncode :: Show a => BEncodable a => Eq a => T a -> a -> Bool | ||
97 | prop_properBEncode _ expected = actual == Right expected | ||
98 | where | ||
99 | actual = decoded $ Lazy.toStrict $ encoded expected | ||
100 | |||
101 | |||
102 | -- TODO tests for torrent: encoding <-> decoding | 108 | -- TODO tests for torrent: encoding <-> decoding |
103 | instance Arbitrary FileInfo where | 109 | instance Arbitrary FileInfo where |
104 | arbitrary = FileInfo <$> arbitrary <*> arbitrary <*> arbitrary | 110 | arbitrary = FileInfo <$> arbitrary <*> arbitrary <*> arbitrary |
@@ -151,6 +157,10 @@ prop_cerealEncoding _ msgs = S.decode (S.encode msgs) == Right msgs | |||
151 | Tracker/Scrape | 157 | Tracker/Scrape |
152 | -----------------------------------------------------------------------} | 158 | -----------------------------------------------------------------------} |
153 | 159 | ||
160 | instance Arbitrary ScrapeInfo where | ||
161 | arbitrary = ScrapeInfo <$> arbitrary <*> arbitrary | ||
162 | <*> arbitrary <*> arbitrary | ||
163 | |||
154 | -- | Note that in 6 esample we intensionally do not agree with | 164 | -- | Note that in 6 esample we intensionally do not agree with |
155 | -- specification, because taking in account '/' in query parameter | 165 | -- specification, because taking in account '/' in query parameter |
156 | -- seems to be meaningless. (And thats because other clients do not | 166 | -- seems to be meaningless. (And thats because other clients do not |
@@ -294,6 +304,12 @@ allTests = | |||
294 | , testCase "single" mmapSingle | 304 | , testCase "single" mmapSingle |
295 | , testCase "coalesce" coalesceTest | 305 | , testCase "coalesce" coalesceTest |
296 | ] ++ test_scrape_url | 306 | ] ++ test_scrape_url |
307 | ++ | ||
308 | [ testProperty "scrape bencode" $ | ||
309 | prop_properBEncode (T :: T ScrapeInfo) | ||
310 | , testProperty "scrape json" $ | ||
311 | prop_properJSON (T :: T ScrapeInfo) | ||
312 | ] | ||
297 | 313 | ||
298 | main :: IO () | 314 | main :: IO () |
299 | main = do | 315 | main = do |