root / test / hs / Test / Ganeti / Objects.hs @ e465608f
History | View | Annotate | Download (21.9 kB)
1 |
{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances, |
---|---|
2 |
OverloadedStrings #-} |
3 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
4 |
|
5 |
{-| Unittests for ganeti-htools. |
6 |
|
7 |
-} |
8 |
|
9 |
{- |
10 |
|
11 |
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc. |
12 |
|
13 |
This program is free software; you can redistribute it and/or modify |
14 |
it under the terms of the GNU General Public License as published by |
15 |
the Free Software Foundation; either version 2 of the License, or |
16 |
(at your option) any later version. |
17 |
|
18 |
This program is distributed in the hope that it will be useful, but |
19 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
20 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
21 |
General Public License for more details. |
22 |
|
23 |
You should have received a copy of the GNU General Public License |
24 |
along with this program; if not, write to the Free Software |
25 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
26 |
02110-1301, USA. |
27 |
|
28 |
-} |
29 |
|
30 |
module Test.Ganeti.Objects |
31 |
( testObjects |
32 |
, Node(..) |
33 |
, genConfigDataWithNetworks |
34 |
, genDisk |
35 |
, genDiskWithChildren |
36 |
, genEmptyCluster |
37 |
, genInst |
38 |
, genInstWithNets |
39 |
, genValidNetwork |
40 |
, genBitStringMaxLen |
41 |
) where |
42 |
|
43 |
import Test.QuickCheck |
44 |
import qualified Test.HUnit as HUnit |
45 |
|
46 |
import Control.Applicative |
47 |
import Control.Monad |
48 |
import Data.Char |
49 |
import qualified Data.List as List |
50 |
import qualified Data.Map as Map |
51 |
import Data.Maybe (fromMaybe) |
52 |
import qualified Data.Set as Set |
53 |
import GHC.Exts (IsString(..)) |
54 |
import qualified Text.JSON as J |
55 |
|
56 |
import Test.Ganeti.TestHelper |
57 |
import Test.Ganeti.TestCommon |
58 |
import Test.Ganeti.Types () |
59 |
|
60 |
import qualified Ganeti.Constants as C |
61 |
import Ganeti.Network |
62 |
import Ganeti.Objects as Objects |
63 |
import Ganeti.JSON |
64 |
import Ganeti.Types |
65 |
|
66 |
-- * Arbitrary instances |
67 |
|
68 |
$(genArbitrary ''PartialNDParams) |
69 |
|
70 |
instance Arbitrary Node where |
71 |
arbitrary = Node <$> genFQDN <*> genFQDN <*> genFQDN |
72 |
<*> arbitrary <*> arbitrary <*> arbitrary <*> genFQDN |
73 |
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary |
74 |
<*> arbitrary <*> arbitrary <*> genFQDN <*> arbitrary |
75 |
<*> (Set.fromList <$> genTags) |
76 |
|
77 |
$(genArbitrary ''BlockDriver) |
78 |
|
79 |
$(genArbitrary ''DiskMode) |
80 |
|
81 |
instance Arbitrary DiskLogicalId where |
82 |
arbitrary = oneof [ LIDPlain <$> arbitrary <*> arbitrary |
83 |
, LIDDrbd8 <$> genFQDN <*> genFQDN <*> arbitrary |
84 |
<*> arbitrary <*> arbitrary <*> arbitrary |
85 |
, LIDFile <$> arbitrary <*> arbitrary |
86 |
, LIDBlockDev <$> arbitrary <*> arbitrary |
87 |
, LIDRados <$> arbitrary <*> arbitrary |
88 |
] |
89 |
|
90 |
-- | 'Disk' 'arbitrary' instance. Since we don't test disk hierarchy |
91 |
-- properties, we only generate disks with no children (FIXME), as |
92 |
-- generating recursive datastructures is a bit more work. |
93 |
instance Arbitrary Disk where |
94 |
arbitrary = Disk <$> arbitrary <*> pure [] <*> arbitrary |
95 |
<*> arbitrary <*> arbitrary <*> arbitrary |
96 |
<*> arbitrary <*> arbitrary |
97 |
|
98 |
-- FIXME: we should generate proper values, >=0, etc., but this is |
99 |
-- hard for partial ones, where all must be wrapped in a 'Maybe' |
100 |
$(genArbitrary ''PartialBeParams) |
101 |
|
102 |
$(genArbitrary ''AdminState) |
103 |
|
104 |
$(genArbitrary ''PartialNicParams) |
105 |
|
106 |
$(genArbitrary ''PartialNic) |
107 |
|
108 |
instance Arbitrary Instance where |
109 |
arbitrary = |
110 |
Instance |
111 |
-- name |
112 |
<$> genFQDN |
113 |
-- primary node |
114 |
<*> genFQDN |
115 |
-- OS |
116 |
<*> genFQDN |
117 |
-- hypervisor |
118 |
<*> arbitrary |
119 |
-- hvparams |
120 |
-- FIXME: add non-empty hvparams when they're a proper type |
121 |
<*> pure (GenericContainer Map.empty) |
122 |
-- beparams |
123 |
<*> arbitrary |
124 |
-- osparams |
125 |
<*> pure (GenericContainer Map.empty) |
126 |
-- osparams_private |
127 |
<*> pure (GenericContainer Map.empty) |
128 |
-- admin_state |
129 |
<*> arbitrary |
130 |
-- nics |
131 |
<*> arbitrary |
132 |
-- disks |
133 |
<*> vectorOf 5 genDisk |
134 |
-- disk template |
135 |
<*> arbitrary |
136 |
-- disks active |
137 |
<*> arbitrary |
138 |
-- network port |
139 |
<*> arbitrary |
140 |
-- ts |
141 |
<*> arbitrary <*> arbitrary |
142 |
-- uuid |
143 |
<*> arbitrary |
144 |
-- serial |
145 |
<*> arbitrary |
146 |
-- tags |
147 |
<*> (Set.fromList <$> genTags) |
148 |
|
149 |
-- | Generates an instance that is connected to the given networks |
150 |
-- and possibly some other networks |
151 |
genInstWithNets :: [String] -> Gen Instance |
152 |
genInstWithNets nets = do |
153 |
plain_inst <- arbitrary |
154 |
enhanceInstWithNets plain_inst nets |
155 |
|
156 |
-- | Generates an instance that is connected to some networks |
157 |
genInst :: Gen Instance |
158 |
genInst = genInstWithNets [] |
159 |
|
160 |
-- | Enhances a given instance with network information, by connecting it to the |
161 |
-- given networks and possibly some other networks |
162 |
enhanceInstWithNets :: Instance -> [String] -> Gen Instance |
163 |
enhanceInstWithNets inst nets = do |
164 |
mac <- arbitrary |
165 |
ip <- arbitrary |
166 |
nicparams <- arbitrary |
167 |
name <- arbitrary |
168 |
uuid <- arbitrary |
169 |
-- generate some more networks than the given ones |
170 |
num_more_nets <- choose (0,3) |
171 |
more_nets <- vectorOf num_more_nets genName |
172 |
let genNic net = PartialNic mac ip nicparams net name uuid |
173 |
partial_nics = map (genNic . Just) |
174 |
(List.nub (nets ++ more_nets)) |
175 |
new_inst = inst { instNics = partial_nics } |
176 |
return new_inst |
177 |
|
178 |
genDiskWithChildren :: Int -> Gen Disk |
179 |
genDiskWithChildren num_children = do |
180 |
logicalid <- arbitrary |
181 |
children <- vectorOf num_children (genDiskWithChildren 0) |
182 |
ivname <- genName |
183 |
size <- arbitrary |
184 |
mode <- arbitrary |
185 |
name <- genMaybe genName |
186 |
spindles <- arbitrary |
187 |
uuid <- genName |
188 |
let disk = Disk logicalid children ivname size mode name spindles uuid |
189 |
return disk |
190 |
|
191 |
genDisk :: Gen Disk |
192 |
genDisk = genDiskWithChildren 3 |
193 |
|
194 |
-- | FIXME: This generates completely random data, without normal |
195 |
-- validation rules. |
196 |
$(genArbitrary ''PartialISpecParams) |
197 |
|
198 |
-- | FIXME: This generates completely random data, without normal |
199 |
-- validation rules. |
200 |
$(genArbitrary ''PartialIPolicy) |
201 |
|
202 |
$(genArbitrary ''FilledISpecParams) |
203 |
$(genArbitrary ''MinMaxISpecs) |
204 |
$(genArbitrary ''FilledIPolicy) |
205 |
$(genArbitrary ''IpFamily) |
206 |
$(genArbitrary ''FilledNDParams) |
207 |
$(genArbitrary ''FilledNicParams) |
208 |
$(genArbitrary ''FilledBeParams) |
209 |
|
210 |
-- | No real arbitrary instance for 'ClusterHvParams' yet. |
211 |
instance Arbitrary ClusterHvParams where |
212 |
arbitrary = return $ GenericContainer Map.empty |
213 |
|
214 |
-- | No real arbitrary instance for 'OsHvParams' yet. |
215 |
instance Arbitrary OsHvParams where |
216 |
arbitrary = return $ GenericContainer Map.empty |
217 |
|
218 |
instance Arbitrary ClusterNicParams where |
219 |
arbitrary = (GenericContainer . Map.singleton C.ppDefault) <$> arbitrary |
220 |
|
221 |
instance Arbitrary OsParams where |
222 |
arbitrary = (GenericContainer . Map.fromList) <$> arbitrary |
223 |
|
224 |
instance Arbitrary Objects.ClusterOsParamsPrivate where |
225 |
arbitrary = (GenericContainer . Map.fromList) <$> arbitrary |
226 |
|
227 |
instance Arbitrary a => Arbitrary (Private a) where |
228 |
arbitrary = Private <$> arbitrary |
229 |
|
230 |
instance Arbitrary ClusterOsParams where |
231 |
arbitrary = (GenericContainer . Map.fromList) <$> arbitrary |
232 |
|
233 |
instance Arbitrary ClusterBeParams where |
234 |
arbitrary = (GenericContainer . Map.fromList) <$> arbitrary |
235 |
|
236 |
instance Arbitrary TagSet where |
237 |
arbitrary = Set.fromList <$> genTags |
238 |
|
239 |
instance Arbitrary IAllocatorParams where |
240 |
arbitrary = return $ GenericContainer Map.empty |
241 |
|
242 |
$(genArbitrary ''Cluster) |
243 |
|
244 |
instance Arbitrary Network where |
245 |
arbitrary = genValidNetwork |
246 |
|
247 |
-- | Generates a network instance with minimum netmasks of /24. Generating |
248 |
-- bigger networks slows down the tests, because long bit strings are generated |
249 |
-- for the reservations. |
250 |
genValidNetwork :: Gen Objects.Network |
251 |
genValidNetwork = do |
252 |
-- generate netmask for the IPv4 network |
253 |
netmask <- fromIntegral <$> choose (24::Int, 30) |
254 |
name <- genName >>= mkNonEmpty |
255 |
mac_prefix <- genMaybe genName |
256 |
net <- arbitrary |
257 |
net6 <- genMaybe genIp6Net |
258 |
gateway <- genMaybe arbitrary |
259 |
gateway6 <- genMaybe genIp6Addr |
260 |
res <- liftM Just (genBitString $ netmask2NumHosts netmask) |
261 |
ext_res <- liftM Just (genBitString $ netmask2NumHosts netmask) |
262 |
uuid <- arbitrary |
263 |
ctime <- arbitrary |
264 |
mtime <- arbitrary |
265 |
let n = Network name mac_prefix (Ip4Network net netmask) net6 gateway |
266 |
gateway6 res ext_res uuid ctime mtime 0 Set.empty |
267 |
return n |
268 |
|
269 |
-- | Generate an arbitrary string consisting of '0' and '1' of the given length. |
270 |
genBitString :: Int -> Gen String |
271 |
genBitString len = vectorOf len (elements "01") |
272 |
|
273 |
-- | Generate an arbitrary string consisting of '0' and '1' of the maximum given |
274 |
-- length. |
275 |
genBitStringMaxLen :: Int -> Gen String |
276 |
genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString |
277 |
|
278 |
-- | Generator for config data with an empty cluster (no instances), |
279 |
-- with N defined nodes. |
280 |
genEmptyCluster :: Int -> Gen ConfigData |
281 |
genEmptyCluster ncount = do |
282 |
nodes <- vector ncount |
283 |
version <- arbitrary |
284 |
grp <- arbitrary |
285 |
let guuid = groupUuid grp |
286 |
nodes' = zipWith (\n idx -> |
287 |
let newname = nodeName n ++ "-" ++ show idx |
288 |
in (newname, n { nodeGroup = guuid, |
289 |
nodeName = newname})) |
290 |
nodes [(1::Int)..] |
291 |
nodemap = Map.fromList nodes' |
292 |
contnodes = if Map.size nodemap /= ncount |
293 |
then error ("Inconsistent node map, duplicates in" ++ |
294 |
" node name list? Names: " ++ |
295 |
show (map fst nodes')) |
296 |
else GenericContainer nodemap |
297 |
continsts = GenericContainer Map.empty |
298 |
networks = GenericContainer Map.empty |
299 |
let contgroups = GenericContainer $ Map.singleton guuid grp |
300 |
serial <- arbitrary |
301 |
-- timestamp fields |
302 |
ctime <- arbitrary |
303 |
mtime <- arbitrary |
304 |
cluster <- resize 8 arbitrary |
305 |
let c = ConfigData version cluster contnodes contgroups continsts networks |
306 |
ctime mtime serial |
307 |
return c |
308 |
|
309 |
-- | FIXME: make an even simpler base version of creating a cluster. |
310 |
|
311 |
-- | Generates config data with a couple of networks. |
312 |
genConfigDataWithNetworks :: ConfigData -> Gen ConfigData |
313 |
genConfigDataWithNetworks old_cfg = do |
314 |
num_nets <- choose (0, 3) |
315 |
-- generate a list of network names (no duplicates) |
316 |
net_names <- genUniquesList num_nets genName >>= mapM mkNonEmpty |
317 |
-- generate a random list of networks (possibly with duplicate names) |
318 |
nets <- vectorOf num_nets genValidNetwork |
319 |
-- use unique names for the networks |
320 |
let nets_unique = map ( \(name, net) -> net { networkName = name } ) |
321 |
(zip net_names nets) |
322 |
net_map = GenericContainer $ Map.fromList |
323 |
(map (\n -> (networkUuid n, n)) nets_unique) |
324 |
new_cfg = old_cfg { configNetworks = net_map } |
325 |
return new_cfg |
326 |
|
327 |
-- * Test properties |
328 |
|
329 |
-- | Tests that fillDict behaves correctly |
330 |
prop_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property |
331 |
prop_fillDict defaults custom = |
332 |
let d_map = Map.fromList defaults |
333 |
d_keys = map fst defaults |
334 |
c_map = Map.fromList custom |
335 |
c_keys = map fst custom |
336 |
in conjoin [ printTestCase "Empty custom filling" |
337 |
(fillDict d_map Map.empty [] == d_map) |
338 |
, printTestCase "Empty defaults filling" |
339 |
(fillDict Map.empty c_map [] == c_map) |
340 |
, printTestCase "Delete all keys" |
341 |
(fillDict d_map c_map (d_keys++c_keys) == Map.empty) |
342 |
] |
343 |
|
344 |
-- | Test that the serialisation of 'DiskLogicalId', which is |
345 |
-- implemented manually, is idempotent. Since we don't have a |
346 |
-- standalone JSON instance for DiskLogicalId (it's a data type that |
347 |
-- expands over two fields in a JSObject), we test this by actially |
348 |
-- testing entire Disk serialisations. So this tests two things at |
349 |
-- once, basically. |
350 |
prop_Disk_serialisation :: Disk -> Property |
351 |
prop_Disk_serialisation = testSerialisation |
352 |
|
353 |
-- | Check that node serialisation is idempotent. |
354 |
prop_Node_serialisation :: Node -> Property |
355 |
prop_Node_serialisation = testSerialisation |
356 |
|
357 |
-- | Check that instance serialisation is idempotent. |
358 |
prop_Inst_serialisation :: Instance -> Property |
359 |
prop_Inst_serialisation = testSerialisation |
360 |
|
361 |
-- | Check that network serialisation is idempotent. |
362 |
prop_Network_serialisation :: Network -> Property |
363 |
prop_Network_serialisation = testSerialisation |
364 |
|
365 |
-- | Check config serialisation. |
366 |
prop_Config_serialisation :: Property |
367 |
prop_Config_serialisation = |
368 |
forAll (choose (0, maxNodes `div` 4) >>= genEmptyCluster) testSerialisation |
369 |
|
370 |
-- | Custom HUnit test to check the correspondence between Haskell-generated |
371 |
-- networks and their Python decoded, validated and re-encoded version. |
372 |
-- For the technical background of this unit test, check the documentation |
373 |
-- of "case_py_compat_types" of test/hs/Test/Ganeti/Opcodes.hs |
374 |
casePyCompatNetworks :: HUnit.Assertion |
375 |
casePyCompatNetworks = do |
376 |
let num_networks = 500::Int |
377 |
networks <- genSample (vectorOf num_networks genValidNetwork) |
378 |
let networks_with_properties = map getNetworkProperties networks |
379 |
serialized = J.encode networks |
380 |
-- check for non-ASCII fields, usually due to 'arbitrary :: String' |
381 |
mapM_ (\net -> when (any (not . isAscii) (J.encode net)) . |
382 |
HUnit.assertFailure $ |
383 |
"Network has non-ASCII fields: " ++ show net |
384 |
) networks |
385 |
py_stdout <- |
386 |
runPython "from ganeti import network\n\ |
387 |
\from ganeti import objects\n\ |
388 |
\from ganeti import serializer\n\ |
389 |
\import sys\n\ |
390 |
\net_data = serializer.Load(sys.stdin.read())\n\ |
391 |
\decoded = [objects.Network.FromDict(n) for n in net_data]\n\ |
392 |
\encoded = []\n\ |
393 |
\for net in decoded:\n\ |
394 |
\ a = network.AddressPool(net)\n\ |
395 |
\ encoded.append((a.GetFreeCount(), a.GetReservedCount(), \\\n\ |
396 |
\ net.ToDict()))\n\ |
397 |
\print serializer.Dump(encoded)" serialized |
398 |
>>= checkPythonResult |
399 |
let deserialised = J.decode py_stdout::J.Result [(Int, Int, Network)] |
400 |
decoded <- case deserialised of |
401 |
J.Ok ops -> return ops |
402 |
J.Error msg -> |
403 |
HUnit.assertFailure ("Unable to decode networks: " ++ msg) |
404 |
-- this already raised an expection, but we need it |
405 |
-- for proper types |
406 |
>> fail "Unable to decode networks" |
407 |
HUnit.assertEqual "Mismatch in number of returned networks" |
408 |
(length decoded) (length networks_with_properties) |
409 |
mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding") |
410 |
) $ zip networks_with_properties decoded |
411 |
|
412 |
-- | Creates a tuple of the given network combined with some of its properties |
413 |
-- to be compared against the same properties generated by the python code. |
414 |
getNetworkProperties :: Network -> (Int, Int, Network) |
415 |
getNetworkProperties net = |
416 |
let maybePool = createAddressPool net |
417 |
in case maybePool of |
418 |
(Just pool) -> (getFreeCount pool, getReservedCount pool, net) |
419 |
Nothing -> (-1, -1, net) |
420 |
|
421 |
-- | Tests the compatibility between Haskell-serialized node groups and their |
422 |
-- python-decoded and encoded version. |
423 |
casePyCompatNodegroups :: HUnit.Assertion |
424 |
casePyCompatNodegroups = do |
425 |
let num_groups = 500::Int |
426 |
groups <- genSample (vectorOf num_groups genNodeGroup) |
427 |
let serialized = J.encode groups |
428 |
-- check for non-ASCII fields, usually due to 'arbitrary :: String' |
429 |
mapM_ (\group -> when (any (not . isAscii) (J.encode group)) . |
430 |
HUnit.assertFailure $ |
431 |
"Node group has non-ASCII fields: " ++ show group |
432 |
) groups |
433 |
py_stdout <- |
434 |
runPython "from ganeti import objects\n\ |
435 |
\from ganeti import serializer\n\ |
436 |
\import sys\n\ |
437 |
\group_data = serializer.Load(sys.stdin.read())\n\ |
438 |
\decoded = [objects.NodeGroup.FromDict(g) for g in group_data]\n\ |
439 |
\encoded = [g.ToDict() for g in decoded]\n\ |
440 |
\print serializer.Dump(encoded)" serialized |
441 |
>>= checkPythonResult |
442 |
let deserialised = J.decode py_stdout::J.Result [NodeGroup] |
443 |
decoded <- case deserialised of |
444 |
J.Ok ops -> return ops |
445 |
J.Error msg -> |
446 |
HUnit.assertFailure ("Unable to decode node groups: " ++ msg) |
447 |
-- this already raised an expection, but we need it |
448 |
-- for proper types |
449 |
>> fail "Unable to decode node groups" |
450 |
HUnit.assertEqual "Mismatch in number of returned node groups" |
451 |
(length decoded) (length groups) |
452 |
mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding") |
453 |
) $ zip groups decoded |
454 |
|
455 |
-- | Generates a node group with up to 3 networks. |
456 |
-- | FIXME: This generates still somewhat completely random data, without normal |
457 |
-- validation rules. |
458 |
genNodeGroup :: Gen NodeGroup |
459 |
genNodeGroup = do |
460 |
name <- genFQDN |
461 |
members <- pure [] |
462 |
ndparams <- arbitrary |
463 |
alloc_policy <- arbitrary |
464 |
ipolicy <- arbitrary |
465 |
diskparams <- pure (GenericContainer Map.empty) |
466 |
num_networks <- choose (0, 3) |
467 |
net_uuid_list <- vectorOf num_networks (arbitrary::Gen String) |
468 |
nic_param_list <- vectorOf num_networks (arbitrary::Gen PartialNicParams) |
469 |
net_map <- pure (GenericContainer . Map.fromList $ |
470 |
zip net_uuid_list nic_param_list) |
471 |
-- timestamp fields |
472 |
ctime <- arbitrary |
473 |
mtime <- arbitrary |
474 |
uuid <- genFQDN `suchThat` (/= name) |
475 |
serial <- arbitrary |
476 |
tags <- Set.fromList <$> genTags |
477 |
let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams |
478 |
net_map ctime mtime uuid serial tags |
479 |
return group |
480 |
|
481 |
instance Arbitrary NodeGroup where |
482 |
arbitrary = genNodeGroup |
483 |
|
484 |
$(genArbitrary ''Ip4Address) |
485 |
|
486 |
$(genArbitrary ''Ip4Network) |
487 |
|
488 |
-- | Helper to compute absolute value of an IPv4 address. |
489 |
ip4AddrValue :: Ip4Address -> Integer |
490 |
ip4AddrValue (Ip4Address a b c d) = |
491 |
fromIntegral a * (2^(24::Integer)) + |
492 |
fromIntegral b * (2^(16::Integer)) + |
493 |
fromIntegral c * (2^(8::Integer)) + fromIntegral d |
494 |
|
495 |
-- | Tests that any difference between IPv4 consecutive addresses is 1. |
496 |
prop_nextIp4Address :: Ip4Address -> Property |
497 |
prop_nextIp4Address ip4 = |
498 |
ip4AddrValue (nextIp4Address ip4) ==? ip4AddrValue ip4 + 1 |
499 |
|
500 |
-- | IsString instance for 'Ip4Address', to help write the tests. |
501 |
instance IsString Ip4Address where |
502 |
fromString s = |
503 |
fromMaybe (error $ "Failed to parse address from " ++ s) (readIp4Address s) |
504 |
|
505 |
-- | Tests a few simple cases of IPv4 next address. |
506 |
caseNextIp4Address :: HUnit.Assertion |
507 |
caseNextIp4Address = do |
508 |
HUnit.assertEqual "" "0.0.0.1" $ nextIp4Address "0.0.0.0" |
509 |
HUnit.assertEqual "" "0.0.0.0" $ nextIp4Address "255.255.255.255" |
510 |
HUnit.assertEqual "" "1.2.3.5" $ nextIp4Address "1.2.3.4" |
511 |
HUnit.assertEqual "" "1.3.0.0" $ nextIp4Address "1.2.255.255" |
512 |
HUnit.assertEqual "" "1.2.255.63" $ nextIp4Address "1.2.255.62" |
513 |
|
514 |
-- | Tests the compatibility between Haskell-serialized instances and their |
515 |
-- python-decoded and encoded version. |
516 |
-- Note: this can be enhanced with logical validations on the decoded objects |
517 |
casePyCompatInstances :: HUnit.Assertion |
518 |
casePyCompatInstances = do |
519 |
let num_inst = 500::Int |
520 |
instances <- genSample (vectorOf num_inst genInst) |
521 |
let serialized = J.encode instances |
522 |
-- check for non-ASCII fields, usually due to 'arbitrary :: String' |
523 |
mapM_ (\inst -> when (any (not . isAscii) (J.encode inst)) . |
524 |
HUnit.assertFailure $ |
525 |
"Instance has non-ASCII fields: " ++ show inst |
526 |
) instances |
527 |
py_stdout <- |
528 |
runPython "from ganeti import objects\n\ |
529 |
\from ganeti import serializer\n\ |
530 |
\import sys\n\ |
531 |
\inst_data = serializer.Load(sys.stdin.read())\n\ |
532 |
\decoded = [objects.Instance.FromDict(i) for i in inst_data]\n\ |
533 |
\encoded = [i.ToDict() for i in decoded]\n\ |
534 |
\print serializer.Dump(encoded)" serialized |
535 |
>>= checkPythonResult |
536 |
let deserialised = J.decode py_stdout::J.Result [Instance] |
537 |
decoded <- case deserialised of |
538 |
J.Ok ops -> return ops |
539 |
J.Error msg -> |
540 |
HUnit.assertFailure ("Unable to decode instance: " ++ msg) |
541 |
-- this already raised an expection, but we need it |
542 |
-- for proper types |
543 |
>> fail "Unable to decode instances" |
544 |
HUnit.assertEqual "Mismatch in number of returned instances" |
545 |
(length decoded) (length instances) |
546 |
mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding") |
547 |
) $ zip instances decoded |
548 |
|
549 |
-- | Tests that the logical ID is correctly found in a plain disk |
550 |
caseIncludeLogicalIdPlain :: HUnit.Assertion |
551 |
caseIncludeLogicalIdPlain = |
552 |
let vg_name = "xenvg" :: String |
553 |
lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String |
554 |
d = |
555 |
Disk (LIDPlain vg_name lv_name) [] "diskname" 1000 DiskRdWr |
556 |
Nothing Nothing "asdfgr-1234-5123-daf3-sdfw-134f43" |
557 |
in |
558 |
HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $ |
559 |
includesLogicalId vg_name lv_name d |
560 |
|
561 |
-- | Tests that the logical ID is correctly found in a DRBD disk |
562 |
caseIncludeLogicalIdDrbd :: HUnit.Assertion |
563 |
caseIncludeLogicalIdDrbd = |
564 |
let vg_name = "xenvg" :: String |
565 |
lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String |
566 |
d = |
567 |
Disk |
568 |
(LIDDrbd8 "node1.example.com" "node2.example.com" 2000 1 5 "secret") |
569 |
[ Disk (LIDPlain "onevg" "onelv") [] "disk1" 1000 DiskRdWr Nothing |
570 |
Nothing "145145-asdf-sdf2-2134-asfd-534g2x" |
571 |
, Disk (LIDPlain vg_name lv_name) [] "disk2" 1000 DiskRdWr Nothing |
572 |
Nothing "6gd3sd-423f-ag2j-563b-dg34-gj3fse" |
573 |
] "diskname" 1000 DiskRdWr Nothing Nothing |
574 |
"asdfgr-1234-5123-daf3-sdfw-134f43" |
575 |
in |
576 |
HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $ |
577 |
includesLogicalId vg_name lv_name d |
578 |
|
579 |
-- | Tests that the logical ID is correctly NOT found in a plain disk |
580 |
caseNotIncludeLogicalIdPlain :: HUnit.Assertion |
581 |
caseNotIncludeLogicalIdPlain = |
582 |
let vg_name = "xenvg" :: String |
583 |
lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String |
584 |
d = |
585 |
Disk (LIDPlain "othervg" "otherlv") [] "diskname" 1000 DiskRdWr |
586 |
Nothing Nothing "asdfgr-1234-5123-daf3-sdfw-134f43" |
587 |
in |
588 |
HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $ |
589 |
not (includesLogicalId vg_name lv_name d) |
590 |
|
591 |
testSuite "Objects" |
592 |
[ 'prop_fillDict |
593 |
, 'prop_Disk_serialisation |
594 |
, 'prop_Inst_serialisation |
595 |
, 'prop_Network_serialisation |
596 |
, 'prop_Node_serialisation |
597 |
, 'prop_Config_serialisation |
598 |
, 'casePyCompatNetworks |
599 |
, 'casePyCompatNodegroups |
600 |
, 'casePyCompatInstances |
601 |
, 'prop_nextIp4Address |
602 |
, 'caseNextIp4Address |
603 |
, 'caseIncludeLogicalIdPlain |
604 |
, 'caseIncludeLogicalIdDrbd |
605 |
, 'caseNotIncludeLogicalIdPlain |
606 |
] |