summaryrefslogtreecommitdiff
path: root/tests/Main.hs
blob: ff3d826025e7914a2beb73b61428e6dcc5277d53 (plain)
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
130
131
{-# 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 Data.Bitfield as BT
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
       ]