summaryrefslogtreecommitdiff
path: root/tests/Encoding.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Encoding.hs')
-rw-r--r--tests/Encoding.hs96
1 files changed, 0 insertions, 96 deletions
diff --git a/tests/Encoding.hs b/tests/Encoding.hs
deleted file mode 100644
index 78f0dfc1..00000000
--- a/tests/Encoding.hs
+++ /dev/null
@@ -1,96 +0,0 @@
1{-# LANGUAGE StandaloneDeriving #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# OPTIONS -fno-warn-orphans #-}
4module Encoding where
5
6import Control.Applicative
7import Data.Word
8import Data.ByteString (ByteString)
9import qualified Data.ByteString as B
10import Data.Serialize
11import Test.Framework (Test)
12import Test.Framework.Providers.QuickCheck2 (testProperty)
13import Test.QuickCheck
14
15
16import Network.URI
17import Network
18
19
20import Data.Bitfield
21import Data.Torrent
22import Network.BitTorrent
23
24
25positive :: Gen Int
26positive = fromIntegral <$> (arbitrary :: Gen Word32)
27
28instance Arbitrary ByteString where
29 arbitrary = B.pack <$> arbitrary
30
31instance Arbitrary BlockIx where
32 arbitrary = BlockIx <$> positive <*> positive <*> positive
33
34instance Arbitrary Block where
35 arbitrary = Block <$> positive <*> positive <*> arbitrary
36
37instance Arbitrary Bitfield where
38 arbitrary = mkBitfield <$> (succ . min 1000 <$> positive)
39 <*> arbitrary
40
41instance Arbitrary PortNumber where
42 arbitrary = fromIntegral <$> (arbitrary :: Gen Word16)
43
44instance Arbitrary Message where
45 arbitrary = oneof
46 [ pure KeepAlive
47 , pure Choke
48 , pure Unchoke
49 , pure Interested
50 , pure NotInterested
51 , Have <$> positive
52 , Bitfield <$> arbitrary
53 , Request <$> arbitrary
54 , Piece <$> arbitrary
55 , Cancel <$> arbitrary
56 , Port <$> arbitrary
57 ]
58
59instance Arbitrary PeerID where
60 arbitrary = azureusStyle <$> pure defaultClientID
61 <*> arbitrary
62 <*> arbitrary
63
64instance Arbitrary InfoHash where
65 arbitrary = (hash . B.pack) <$> arbitrary
66
67instance Arbitrary Handshake where
68 arbitrary = defaultHandshake <$> arbitrary <*> arbitrary
69
70
71data T a = T
72
73prop_encoding :: (Serialize a, Eq a) => T a -> [a] -> Bool
74prop_encoding _ msgs = decode (encode msgs) == Right msgs
75
76-- | Note that in 6 esample we intensionally do not agree with specification,
77-- because taking in account '/' in query parameter seems to be meaningless.
78-- (And thats because other clients do not chunk uri by parts)
79-- Moreover in practice there should be no difference. (I hope)
80--
81test_scrape_url :: [Test]
82test_scrape_url = zipWith mkTest [1 :: Int ..] (check `map` tests)
83 where
84 check (iu, ou) = (parseURI iu >>= (`scrapeURL` []) >>= return . show) == ou
85 tests =
86 [ ("http://example.com/announce" , Just "http://example.com/scrape")
87 , ("http://example.com/x/announce" , Just "http://example.com/x/scrape")
88 , ("http://example.com/announce.php" , Just "http://example.com/scrape.php")
89 , ("http://example.com/a" , Nothing)
90 , ("http://example.com/announce?x2%0644", Just "http://example.com/scrape?x2%0644")
91 , ("http://example.com/announce?x=2/4" , Just "http://example.com/scrape?x=2/4")
92-- , ("http://example.com/announce?x=2/4" , Nothing) -- by specs
93 , ("http://example.com/x%064announce" , Nothing)
94 ]
95
96 mkTest i = testProperty ("scrape test #" ++ show i)