diff options
Diffstat (limited to 'tests')
-rw-r--r-- | tests/encoding.hs | 26 |
1 files changed, 17 insertions, 9 deletions
diff --git a/tests/encoding.hs b/tests/encoding.hs index 9141a1ba..12278ed9 100644 --- a/tests/encoding.hs +++ b/tests/encoding.hs | |||
@@ -11,7 +11,7 @@ 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 Network.Torrent.PWP | 14 | import Network.Torrent |
15 | 15 | ||
16 | positive :: Gen Int | 16 | positive :: Gen Int |
17 | positive = fromIntegral <$> (arbitrary :: Gen Word32) | 17 | positive = fromIntegral <$> (arbitrary :: Gen Word32) |
@@ -40,20 +40,28 @@ instance Arbitrary Message where | |||
40 | , Port <$> choose (0, fromIntegral (maxBound :: Word16)) | 40 | , Port <$> choose (0, fromIntegral (maxBound :: Word16)) |
41 | ] | 41 | ] |
42 | 42 | ||
43 | instance Arbitrary PeerID where | ||
44 | arbitrary = azureusStyle <$> pure defaultClientID | ||
45 | <*> arbitrary | ||
46 | <*> arbitrary | ||
43 | 47 | ||
44 | encodeMessages :: [Message] -> ByteString | 48 | instance Arbitrary Handshake where |
45 | encodeMessages xs = runPut (mapM_ put xs) | 49 | arbitrary = defaultHandshake |
50 | <$> (B.pack <$> (vectorOf 20 arbitrary)) | ||
51 | <*> arbitrary | ||
46 | 52 | ||
47 | decodeMessages :: ByteString -> Either String [Message] | 53 | data T a = T |
48 | decodeMessages = runGet (many get) | ||
49 | 54 | ||
50 | -- | TODO move tests | 55 | prop_encoding :: (Serialize a, Eq a) => T a -> [a] -> Bool |
51 | prop_encoding :: [Message] -> Bool | 56 | prop_encoding _ msgs = decode (encode msgs) == Right msgs |
52 | prop_encoding msgs = decodeMessages (encodeMessages msgs) == Right msgs | ||
53 | 57 | ||
54 | 58 | ||
55 | main :: IO () | 59 | main :: IO () |
56 | main = do | 60 | main = do |
57 | defaultMain | 61 | defaultMain |
58 | [ testProperty "encode <-> decode" prop_encoding | 62 | [ testProperty "Message encode <-> decode" $ |
63 | prop_encoding (T :: T Message) | ||
64 | |||
65 | , testProperty "Handshake encode <-> decode" $ | ||
66 | prop_encoding (T :: T Handshake) | ||
59 | ] \ No newline at end of file | 67 | ] \ No newline at end of file |