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