summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--tests/encoding.hs26
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)
11import Test.Framework.Providers.QuickCheck2 (testProperty) 11import Test.Framework.Providers.QuickCheck2 (testProperty)
12import Test.QuickCheck 12import Test.QuickCheck
13 13
14import Network.Torrent.PWP 14import Network.Torrent
15 15
16positive :: Gen Int 16positive :: Gen Int
17positive = fromIntegral <$> (arbitrary :: Gen Word32) 17positive = 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
43instance Arbitrary PeerID where
44 arbitrary = azureusStyle <$> pure defaultClientID
45 <*> arbitrary
46 <*> arbitrary
43 47
44encodeMessages :: [Message] -> ByteString 48instance Arbitrary Handshake where
45encodeMessages xs = runPut (mapM_ put xs) 49 arbitrary = defaultHandshake
50 <$> (B.pack <$> (vectorOf 20 arbitrary))
51 <*> arbitrary
46 52
47decodeMessages :: ByteString -> Either String [Message] 53data T a = T
48decodeMessages = runGet (many get)
49 54
50-- | TODO move tests 55prop_encoding :: (Serialize a, Eq a) => T a -> [a] -> Bool
51prop_encoding :: [Message] -> Bool 56prop_encoding _ msgs = decode (encode msgs) == Right msgs
52prop_encoding msgs = decodeMessages (encodeMessages msgs) == Right msgs
53 57
54 58
55main :: IO () 59main :: IO ()
56main = do 60main = 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