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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Data.Bits
import Data.Word
import Test.Framework (defaultMain)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Encoding
import Network.BitTorrent as BT
prop_bitfieldDiff0 :: Bitfield -> Bool
prop_bitfieldDiff0 b = (b `difference` empty (8 * bitfieldByteCount b)) == b
prop_bitfieldDiff1 :: Bitfield -> Bool
prop_bitfieldDiff1 b = em `difference` b == em
where
em = empty (8 * bitfieldByteCount b)
prop_bitfieldMaxNothing :: Int -> Bool
prop_bitfieldMaxNothing n = findMax (empty (n `mod` 1024)) == Nothing
prop_bitfieldMinNothing :: Int -> Bool
prop_bitfieldMinNothing n = findMax (empty (n `mod` 1024)) == Nothing
prop_bitfieldMaxJust :: Word -> Bool
prop_bitfieldMaxJust n =
let m = findMax (full (8 * s)) in
if n == 0 then m == Nothing
else m == Just ((s * 8) - 1)
where
s = fromIntegral n `mod` 1024
prop_bitfieldMinCases :: Bool
prop_bitfieldMinCases = all mkTestCase
[ ("\x0\x3", Just 8)
, ("\x0\x127", Just 8)
]
where
mkTestCase (bs, res) = findMin (MkBitfield bs) == res
prop_bitfieldMaxCases :: Bool
prop_bitfieldMaxCases = all mkTestCase
[ ("\x0\x3", Just 9)
, ("\x0\x127", Just 13)
]
where
mkTestCase (bs, res) = findMax (MkBitfield bs) == res
prop_bitfieldMinJust :: Word -> Bool
prop_bitfieldMinJust n =
let m = findMin (full (fromIntegral n `mod` 1024)) in
if n == 0 then m == Nothing
else m == Just 0
prop_bitfieldUnionIdentity :: Bitfield -> Bool
prop_bitfieldUnionIdentity b =
((b `union` empty (8 * bitfieldByteCount b)) == b)
&& ((empty (8 * bitfieldByteCount b) `union` b) == b)
prop_bitfieldUnionCommutative :: Bitfield -> Bitfield -> Bool
prop_bitfieldUnionCommutative a b = union a b == union b a
prop_bitfieldUnionAssociative :: Bitfield -> Bitfield -> Bitfield -> Bool
prop_bitfieldUnionAssociative a b c = union a (union b c) == union (union a b) c
prop_bitfieldUnionIdempotent :: Bitfield -> Bitfield -> Bool
prop_bitfieldUnionIdempotent a b = union a b == union a (union a b)
prop_bitfieldIntersectionIdentity :: Bitfield -> Bool
prop_bitfieldIntersectionIdentity b =
((b `intersection` full (8 * bitfieldByteCount b)) == b)
&& ((full (8 * bitfieldByteCount b) `intersection` b) == b)
prop_bitfieldIntersectionCommutative :: Bitfield -> Bitfield -> Bool
prop_bitfieldIntersectionCommutative a b = intersection a b == intersection b a
prop_bitfieldIntersectionAssociative :: Bitfield -> Bitfield -> Bitfield -> Bool
prop_bitfieldIntersectionAssociative a b c =
intersection a (intersection b c) == intersection (intersection a b) c
prop_bitfieldIntersectionIndempotent :: Bitfield -> Bitfield -> Bool
prop_bitfieldIntersectionIndempotent a b = f b == f (f b)
where
f = intersection a
prop_bitfieldHaveCount :: Bitfield -> Bool
prop_bitfieldHaveCount b = listHaveCount (toList b) == haveCount b
where
listHaveCount = foldr f 0
f :: Bool -> Int -> Int
f byte count = fromEnum byte + count
prop_bitfieldCompeteness :: Bitfield -> Bool
prop_bitfieldCompeteness b = let (have, total) = completeness b in have <= total
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 ++
[
testProperty "bitfield `difference` empty bitfield" prop_bitfieldDiff0
, testProperty "empty bitfield `difference` bitfield" prop_bitfieldDiff1
, testProperty "prop_bitfieldMinNothing" prop_bitfieldMinNothing
, testProperty "prop_bitfieldMaxNothing" prop_bitfieldMaxNothing
, testProperty "prop_bitfieldMaxJust" prop_bitfieldMaxJust
, testProperty "prop_bitfieldMinJust" prop_bitfieldMinJust
, testProperty "prop_bitfieldMinCases" prop_bitfieldMinCases
, testProperty "prop_bitfieldMaxCases" prop_bitfieldMaxCases
, testProperty "prop_bitfieldUnionIdentity" prop_bitfieldUnionIdentity
, testProperty "prop_bitfieldUnionCommutative" prop_bitfieldUnionCommutative
, testProperty "prop_bitfieldUnionAssociative" prop_bitfieldUnionAssociative
, testProperty "prop_bitfieldUnionIdempotent" prop_bitfieldUnionIdempotent
, testProperty "prop_bitfieldIntersectionIdentity" prop_bitfieldIntersectionIdentity
, testProperty "prop_bitfieldIntersectionCommutative" prop_bitfieldIntersectionCommutative
, testProperty "prop_bitfieldIntersectionAssociative" prop_bitfieldIntersectionAssociative
, testProperty "prop_bitfieldIntersectionIndempotent" prop_bitfieldIntersectionIndempotent
, testProperty "prop_bitfieldHaveCount" prop_bitfieldHaveCount
, testProperty "prop_bitfieldCompeteness" prop_bitfieldCompeteness
]
|
