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