root / test / hs / Test / Ganeti / Network.hs @ 14933c17
History | View | Annotate | Download (4.5 kB)
1 |
{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-} |
---|---|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
3 |
|
4 |
module Test.Ganeti.Network |
5 |
( testNetwork |
6 |
, genBitStringMaxLen |
7 |
) where |
8 |
|
9 |
import Test.QuickCheck |
10 |
|
11 |
import Ganeti.Network as Network |
12 |
import Ganeti.Objects as Objects |
13 |
|
14 |
import Test.Ganeti.Objects |
15 |
( genBitStringMaxLen |
16 |
, genValidNetwork ) |
17 |
import Test.Ganeti.TestHelper |
18 |
import Test.Ganeti.TestCommon |
19 |
|
20 |
import qualified Data.Vector.Unboxed as V |
21 |
|
22 |
-- * Generators and arbitrary instances |
23 |
|
24 |
-- | Generates address pools. The size of the network is intentionally |
25 |
-- decoupled from the size of the bit vectors, to avoid slowing down |
26 |
-- the tests by generating unnecessary bit strings. |
27 |
genAddressPool :: Int -> Gen AddressPool |
28 |
genAddressPool maxLenBitVec = do |
29 |
-- Generating networks with netmask of minimum /24 to avoid too long |
30 |
-- bit strings being generated. |
31 |
net <- genValidNetwork |
32 |
lenBitVec <- choose (0, maxLenBitVec) |
33 |
res <- genBitVector lenBitVec |
34 |
ext_res <- genBitVector lenBitVec |
35 |
return AddressPool { network = net |
36 |
, reservations = res |
37 |
, extReservations = ext_res } |
38 |
|
39 |
-- | Generates an arbitrary bit vector of the given length. |
40 |
genBitVector :: Int -> Gen (V.Vector Bool) |
41 |
genBitVector len = do |
42 |
boolList <- vector len::Gen [Bool] |
43 |
return $ V.fromList boolList |
44 |
|
45 |
instance Arbitrary AddressPool where |
46 |
arbitrary = genAddressPool ((2::Int)^(8::Int)) |
47 |
|
48 |
-- * Test cases |
49 |
|
50 |
-- | Check the mapping of bit strings to bit vectors |
51 |
prop_bitStringToBitVector :: Property |
52 |
prop_bitStringToBitVector = |
53 |
forAll (genBitStringMaxLen 256) $ \bs -> |
54 |
let bitList = V.toList $ Network.bitStringToBitVector bs |
55 |
bitCharList = Prelude.zip bitList bs |
56 |
in Prelude.all checkBit bitCharList |
57 |
|
58 |
-- | Check whether an element of a bit vector is consistent with an element |
59 |
-- of a bit string (containing '0' and '1' characters). |
60 |
checkBit :: (Bool, Char) -> Bool |
61 |
checkBit (False, '0') = True |
62 |
checkBit (True, '1') = True |
63 |
checkBit _ = False |
64 |
|
65 |
-- | Check creation of an address pool when a network is given. |
66 |
prop_createAddressPool :: Objects.Network -> Property |
67 |
prop_createAddressPool n = |
68 |
let valid = networkIsValid n |
69 |
in case createAddressPool n of |
70 |
Just _ -> True ==? valid |
71 |
Nothing -> False ==? valid |
72 |
|
73 |
-- | Check that the address pool's properties are calculated correctly. |
74 |
prop_addressPoolProperties :: AddressPool -> Property |
75 |
prop_addressPoolProperties a = |
76 |
conjoin |
77 |
[ printTestCase |
78 |
("Not all reservations are included in 'allReservations' of " ++ |
79 |
"address pool:" ++ show a) (allReservationsSubsumesInternal a) |
80 |
, printTestCase |
81 |
("Not all external reservations are covered by 'allReservations' " ++ |
82 |
"of address pool: " ++ show a) |
83 |
(allReservationsSubsumesExternal a) |
84 |
, printTestCase |
85 |
("The counts of free and reserved addresses do not add up for " ++ |
86 |
"address pool: " ++ show a) |
87 |
(checkCounts a) |
88 |
, printTestCase |
89 |
("'isFull' wrongly classified the status of the address pool: " ++ |
90 |
show a) (checkIsFull a) |
91 |
, printTestCase |
92 |
("Network map is inconsistent with reservations of address pool: " ++ |
93 |
show a) (checkGetMap a) |
94 |
] |
95 |
|
96 |
-- | Check that all internally reserved ips are included in 'allReservations'. |
97 |
allReservationsSubsumesInternal :: AddressPool -> Bool |
98 |
allReservationsSubsumesInternal a = |
99 |
bitVectorSubsumes (allReservations a) (reservations a) |
100 |
|
101 |
-- | Check that all externally reserved ips are included in 'allReservations'. |
102 |
allReservationsSubsumesExternal :: AddressPool -> Bool |
103 |
allReservationsSubsumesExternal a = |
104 |
bitVectorSubsumes (allReservations a) (extReservations a) |
105 |
|
106 |
-- | Checks if one bit vector subsumes the other one. |
107 |
bitVectorSubsumes :: V.Vector Bool -> V.Vector Bool -> Bool |
108 |
bitVectorSubsumes v1 v2 = V.and $ |
109 |
V.zipWith (\a b -> not b || a) v1 v2 |
110 |
|
111 |
-- | Check that the counts of free and reserved ips add up. |
112 |
checkCounts :: AddressPool -> Bool |
113 |
checkCounts a = |
114 |
let res = reservations a |
115 |
in V.length res == getFreeCount a + getReservedCount a |
116 |
|
117 |
-- | Check that the detection of a full network works correctly. |
118 |
checkIsFull :: AddressPool -> Bool |
119 |
checkIsFull a = isFull a == V.notElem False (allReservations a) |
120 |
|
121 |
-- | Check that the map representation of the network corresponds to the |
122 |
-- network's reservations. |
123 |
checkGetMap :: AddressPool -> Bool |
124 |
checkGetMap a = |
125 |
allReservations a == V.fromList (Prelude.map (== 'X') (getMap a)) |
126 |
|
127 |
testSuite "Network" |
128 |
[ 'prop_bitStringToBitVector |
129 |
, 'prop_createAddressPool |
130 |
, 'prop_addressPoolProperties |
131 |
] |
132 |
|