Fix inconsistency in python and haskell objects
[ganeti-github.git] / test / hs / Test / Ganeti / Objects.hs
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 All rights reserved.
13
14 Redistribution and use in source and binary forms, with or without
15 modification, are permitted provided that the following conditions are
16 met:
17
18 1. Redistributions of source code must retain the above copyright notice,
19 this list of conditions and the following disclaimer.
20
21 2. Redistributions in binary form must reproduce the above copyright
22 notice, this list of conditions and the following disclaimer in the
23 documentation and/or other materials provided with the distribution.
24
25 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
26 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
27 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
28 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
29 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
30 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
31 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
32 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
33 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
34 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
35 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36
37 -}
38
39 module Test.Ganeti.Objects
40 ( testObjects
41 , Node(..)
42 , genConfigDataWithNetworks
43 , genDisk
44 , genDiskWithChildren
45 , genEmptyCluster
46 , genInst
47 , genInstWithNets
48 , genValidNetwork
49 , genBitStringMaxLen
50 ) where
51
52 import Test.QuickCheck
53 import qualified Test.HUnit as HUnit
54
55 import Control.Applicative
56 import Control.Monad
57 import Data.Char
58 import qualified Data.List as List
59 import qualified Data.Map as Map
60 import Data.Maybe (fromMaybe)
61 import qualified Data.Set as Set
62 import Data.Word (Word32)
63 import GHC.Exts (IsString(..))
64 import System.Time (ClockTime(..))
65 import qualified Text.JSON as J
66
67 import Test.Ganeti.TestHelper
68 import Test.Ganeti.TestCommon
69 import Test.Ganeti.Types ()
70
71 import qualified Ganeti.Constants as C
72 import Ganeti.Network
73 import Ganeti.Objects as Objects
74 import qualified Ganeti.Objects.BitArray as BA
75 import Ganeti.JSON
76 import Ganeti.Types
77
78 -- * Arbitrary instances
79
80 $(genArbitrary ''PartialNDParams)
81
82 instance Arbitrary Node where
83 arbitrary = Node <$> genFQDN <*> genFQDN <*> genFQDN
84 <*> arbitrary <*> arbitrary <*> arbitrary <*> genFQDN
85 <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
86 <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
87 <*> genFQDN <*> arbitrary <*> (Set.fromList <$> genTags)
88
89 $(genArbitrary ''BlockDriver)
90
91 $(genArbitrary ''DiskMode)
92
93 instance Arbitrary LogicalVolume where
94 arbitrary = LogicalVolume <$> validName <*> validName
95 where
96 validName = -- we intentionally omit '.' and '-' to avoid forbidden names
97 listOf1 $ elements (['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "+_")
98
99 instance Arbitrary DiskLogicalId where
100 arbitrary = oneof [ LIDPlain <$> arbitrary
101 , LIDDrbd8 <$> genFQDN <*> genFQDN <*> arbitrary
102 <*> arbitrary <*> arbitrary <*> arbitrary
103 , LIDFile <$> arbitrary <*> arbitrary
104 , LIDBlockDev <$> arbitrary <*> arbitrary
105 , LIDRados <$> arbitrary <*> arbitrary
106 ]
107
108 -- | 'Disk' 'arbitrary' instance. Since we don't test disk hierarchy
109 -- properties, we only generate disks with no children (FIXME), as
110 -- generating recursive datastructures is a bit more work.
111 instance Arbitrary Disk where
112 arbitrary = Disk <$> arbitrary <*> pure [] <*> arbitrary
113 <*> arbitrary <*> arbitrary <*> arbitrary
114 <*> arbitrary <*> arbitrary <*> arbitrary
115 <*> arbitrary <*> arbitrary <*> arbitrary
116
117 -- FIXME: we should generate proper values, >=0, etc., but this is
118 -- hard for partial ones, where all must be wrapped in a 'Maybe'
119 $(genArbitrary ''PartialBeParams)
120
121 $(genArbitrary ''AdminState)
122
123 $(genArbitrary ''AdminStateSource)
124
125 $(genArbitrary ''PartialNicParams)
126
127 $(genArbitrary ''PartialNic)
128
129 instance Arbitrary Instance where
130 arbitrary =
131 Instance
132 -- name
133 <$> genFQDN
134 -- primary node
135 <*> genFQDN
136 -- OS
137 <*> genFQDN
138 -- hypervisor
139 <*> arbitrary
140 -- hvparams
141 -- FIXME: add non-empty hvparams when they're a proper type
142 <*> pure (GenericContainer Map.empty)
143 -- beparams
144 <*> arbitrary
145 -- osparams
146 <*> pure (GenericContainer Map.empty)
147 -- osparams_private
148 <*> pure (GenericContainer Map.empty)
149 -- admin_state
150 <*> arbitrary
151 -- admin_state_source
152 <*> arbitrary
153 -- nics
154 <*> arbitrary
155 -- disks
156 <*> vectorOf 5 arbitrary
157 -- disk template
158 <*> arbitrary
159 -- disks active
160 <*> arbitrary
161 -- network port
162 <*> arbitrary
163 -- ts
164 <*> arbitrary <*> arbitrary
165 -- uuid
166 <*> arbitrary
167 -- serial
168 <*> arbitrary
169 -- tags
170 <*> (Set.fromList <$> genTags)
171
172 -- | Generates an instance that is connected to the given networks
173 -- and possibly some other networks
174 genInstWithNets :: [String] -> Gen Instance
175 genInstWithNets nets = do
176 plain_inst <- arbitrary
177 enhanceInstWithNets plain_inst nets
178
179 -- | Generates an instance that is connected to some networks
180 genInst :: Gen Instance
181 genInst = genInstWithNets []
182
183 -- | Enhances a given instance with network information, by connecting it to the
184 -- given networks and possibly some other networks
185 enhanceInstWithNets :: Instance -> [String] -> Gen Instance
186 enhanceInstWithNets inst nets = do
187 mac <- arbitrary
188 ip <- arbitrary
189 nicparams <- arbitrary
190 name <- arbitrary
191 uuid <- arbitrary
192 -- generate some more networks than the given ones
193 num_more_nets <- choose (0,3)
194 more_nets <- vectorOf num_more_nets genUUID
195 let genNic net = PartialNic mac ip nicparams net name uuid
196 partial_nics = map (genNic . Just)
197 (List.nub (nets ++ more_nets))
198 new_inst = inst { instNics = partial_nics }
199 return new_inst
200
201 genDiskWithChildren :: Int -> Gen Disk
202 genDiskWithChildren num_children = do
203 logicalid <- arbitrary
204 children <- vectorOf num_children (genDiskWithChildren 0)
205 ivname <- genName
206 size <- arbitrary
207 mode <- arbitrary
208 name <- genMaybe genName
209 spindles <- arbitrary
210 params <- arbitrary
211 uuid <- genName
212 serial <- arbitrary
213 time <- arbitrary
214 return $
215 Disk logicalid children ivname size mode name
216 spindles params uuid serial time time
217
218 genDisk :: Gen Disk
219 genDisk = genDiskWithChildren 3
220
221 -- | FIXME: This generates completely random data, without normal
222 -- validation rules.
223 $(genArbitrary ''PartialISpecParams)
224
225 -- | FIXME: This generates completely random data, without normal
226 -- validation rules.
227 $(genArbitrary ''PartialIPolicy)
228
229 $(genArbitrary ''FilledISpecParams)
230 $(genArbitrary ''MinMaxISpecs)
231 $(genArbitrary ''FilledIPolicy)
232 $(genArbitrary ''IpFamily)
233 $(genArbitrary ''FilledNDParams)
234 $(genArbitrary ''FilledNicParams)
235 $(genArbitrary ''FilledBeParams)
236
237 -- | No real arbitrary instance for 'ClusterHvParams' yet.
238 instance Arbitrary ClusterHvParams where
239 arbitrary = return $ GenericContainer Map.empty
240
241 -- | No real arbitrary instance for 'OsHvParams' yet.
242 instance Arbitrary OsHvParams where
243 arbitrary = return $ GenericContainer Map.empty
244
245 -- | No real arbitrary instance for 'GroupDiskParams' yet.
246 instance Arbitrary GroupDiskParams where
247 arbitrary = return $ GenericContainer Map.empty
248
249 instance Arbitrary ClusterNicParams where
250 arbitrary = (GenericContainer . Map.singleton C.ppDefault) <$> arbitrary
251
252 instance Arbitrary OsParams where
253 arbitrary = (GenericContainer . Map.fromList) <$> arbitrary
254
255 instance Arbitrary Objects.ClusterOsParamsPrivate where
256 arbitrary = (GenericContainer . Map.fromList) <$> arbitrary
257
258 instance Arbitrary a => Arbitrary (Private a) where
259 arbitrary = Private <$> arbitrary
260
261 instance Arbitrary ClusterOsParams where
262 arbitrary = (GenericContainer . Map.fromList) <$> arbitrary
263
264 instance Arbitrary ClusterBeParams where
265 arbitrary = (GenericContainer . Map.fromList) <$> arbitrary
266
267 instance Arbitrary TagSet where
268 arbitrary = Set.fromList <$> genTags
269
270 instance Arbitrary IAllocatorParams where
271 arbitrary = return $ GenericContainer Map.empty
272
273 $(genArbitrary ''Cluster)
274
275 instance Arbitrary AddressPool where
276 arbitrary = AddressPool . BA.fromList <$> arbitrary
277
278 instance Arbitrary Network where
279 arbitrary = genValidNetwork
280
281 -- | Generates a network instance with minimum netmasks of /24. Generating
282 -- bigger networks slows down the tests, because long bit strings are generated
283 -- for the reservations.
284 genValidNetwork :: Gen Objects.Network
285 genValidNetwork = do
286 -- generate netmask for the IPv4 network
287 netmask <- fromIntegral <$> choose (24::Int, 30)
288 name <- genName >>= mkNonEmpty
289 mac_prefix <- genMaybe genName
290 net <- arbitrary
291 net6 <- genMaybe genIp6Net
292 gateway <- genMaybe arbitrary
293 gateway6 <- genMaybe genIp6Addr
294 res <- liftM Just (genBitString $ netmask2NumHosts netmask)
295 ext_res <- liftM Just (genBitString $ netmask2NumHosts netmask)
296 uuid <- arbitrary
297 ctime <- arbitrary
298 mtime <- arbitrary
299 let n = Network name mac_prefix (mkIp4Network net netmask) net6 gateway
300 gateway6 res ext_res uuid ctime mtime 0 Set.empty
301 return n
302
303 -- | Generate an arbitrary string consisting of '0' and '1' of the given length.
304 genBitString :: Int -> Gen AddressPool
305 genBitString len =
306 (AddressPool . BA.fromList) `liftM` vectorOf len (elements [False, True])
307
308 -- | Generate an arbitrary string consisting of '0' and '1' of the maximum given
309 -- length.
310 genBitStringMaxLen :: Int -> Gen AddressPool
311 genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString
312
313 -- | Generator for config data with an empty cluster (no instances),
314 -- with N defined nodes.
315 genEmptyCluster :: Int -> Gen ConfigData
316 genEmptyCluster ncount = do
317 nodes <- vector ncount
318 version <- arbitrary
319 grp <- arbitrary
320 let guuid = groupUuid grp
321 nodes' = zipWith (\n idx ->
322 let newname = takeWhile (/= '.') (nodeName n)
323 ++ "-" ++ show idx
324 in (newname, n { nodeGroup = guuid,
325 nodeName = newname}))
326 nodes [(1::Int)..]
327 nodemap = Map.fromList nodes'
328 contnodes = if Map.size nodemap /= ncount
329 then error ("Inconsistent node map, duplicates in" ++
330 " node name list? Names: " ++
331 show (map fst nodes'))
332 else GenericContainer nodemap
333 continsts = GenericContainer Map.empty
334 networks = GenericContainer Map.empty
335 disks = GenericContainer Map.empty
336 let contgroups = GenericContainer $ Map.singleton guuid grp
337 serial <- arbitrary
338 -- timestamp fields
339 ctime <- arbitrary
340 mtime <- arbitrary
341 cluster <- resize 8 arbitrary
342 let c = ConfigData version cluster contnodes contgroups continsts networks
343 disks ctime mtime serial
344 return c
345
346 -- | FIXME: make an even simpler base version of creating a cluster.
347
348 -- | Generates config data with a couple of networks.
349 genConfigDataWithNetworks :: ConfigData -> Gen ConfigData
350 genConfigDataWithNetworks old_cfg = do
351 num_nets <- choose (0, 3)
352 -- generate a list of network names (no duplicates)
353 net_names <- genUniquesList num_nets genName >>= mapM mkNonEmpty
354 -- generate a random list of networks (possibly with duplicate names)
355 nets <- vectorOf num_nets genValidNetwork
356 -- use unique names for the networks
357 let nets_unique = map ( \(name, net) -> net { networkName = name } )
358 (zip net_names nets)
359 net_map = GenericContainer $ Map.fromList
360 (map (\n -> (networkUuid n, n)) nets_unique)
361 new_cfg = old_cfg { configNetworks = net_map }
362 return new_cfg
363
364 -- * Test properties
365
366 -- | Tests that fillDict behaves correctly
367 prop_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property
368 prop_fillDict defaults custom =
369 let d_map = Map.fromList defaults
370 d_keys = map fst defaults
371 c_map = Map.fromList custom
372 c_keys = map fst custom
373 in conjoin [ counterexample "Empty custom filling"
374 (fillDict d_map Map.empty [] == d_map)
375 , counterexample "Empty defaults filling"
376 (fillDict Map.empty c_map [] == c_map)
377 , counterexample "Delete all keys"
378 (fillDict d_map c_map (d_keys++c_keys) == Map.empty)
379 ]
380
381 prop_LogicalVolume_serialisation :: LogicalVolume -> Property
382 prop_LogicalVolume_serialisation = testSerialisation
383
384 prop_LogicalVolume_deserialisationFail :: Property
385 prop_LogicalVolume_deserialisationFail =
386 conjoin . map (testDeserialisationFail (LogicalVolume "" "")) $
387 [ J.JSArray []
388 , J.JSString $ J.toJSString "/abc"
389 , J.JSString $ J.toJSString "abc/"
390 , J.JSString $ J.toJSString "../."
391 , J.JSString $ J.toJSString "g/snapshot"
392 , J.JSString $ J.toJSString "g/a_mimagex"
393 , J.JSString $ J.toJSString "g/r;3"
394 ]
395
396 -- | Test that the serialisation of 'DiskLogicalId', which is
397 -- implemented manually, is idempotent. Since we don't have a
398 -- standalone JSON instance for DiskLogicalId (it's a data type that
399 -- expands over two fields in a JSObject), we test this by actially
400 -- testing entire Disk serialisations. So this tests two things at
401 -- once, basically.
402 prop_Disk_serialisation :: Disk -> Property
403 prop_Disk_serialisation = testSerialisation
404
405 prop_Disk_array_serialisation :: Disk -> Property
406 prop_Disk_array_serialisation = testArraySerialisation
407
408 -- | Check that node serialisation is idempotent.
409 prop_Node_serialisation :: Node -> Property
410 prop_Node_serialisation = testSerialisation
411
412 -- | Check that instance serialisation is idempotent.
413 prop_Inst_serialisation :: Instance -> Property
414 prop_Inst_serialisation = testSerialisation
415
416 -- | Check that address pool serialisation is idempotent.
417 prop_AddressPool_serialisation :: AddressPool -> Property
418 prop_AddressPool_serialisation = testSerialisation
419
420 -- | Check that network serialisation is idempotent.
421 prop_Network_serialisation :: Network -> Property
422 prop_Network_serialisation = testSerialisation
423
424 -- | Check config serialisation.
425 prop_Config_serialisation :: Property
426 prop_Config_serialisation =
427 forAll (choose (0, maxNodes `div` 4) >>= genEmptyCluster) testSerialisation
428
429 -- | Custom HUnit test to check the correspondence between Haskell-generated
430 -- networks and their Python decoded, validated and re-encoded version.
431 -- For the technical background of this unit test, check the documentation
432 -- of "case_py_compat_types" of test/hs/Test/Ganeti/Opcodes.hs
433 casePyCompatNetworks :: HUnit.Assertion
434 casePyCompatNetworks = do
435 let num_networks = 500::Int
436 networks <- genSample (vectorOf num_networks genValidNetwork)
437 let networks_with_properties = map getNetworkProperties networks
438 serialized = J.encode networks
439 -- check for non-ASCII fields, usually due to 'arbitrary :: String'
440 mapM_ (\net -> when (any (not . isAscii) (J.encode net)) .
441 HUnit.assertFailure $
442 "Network has non-ASCII fields: " ++ show net
443 ) networks
444 py_stdout <-
445 runPython "from ganeti import network\n\
446 \from ganeti import objects\n\
447 \from ganeti import serializer\n\
448 \import sys\n\
449 \net_data = serializer.Load(sys.stdin.read())\n\
450 \decoded = [objects.Network.FromDict(n) for n in net_data]\n\
451 \encoded = []\n\
452 \for net in decoded:\n\
453 \ a = network.AddressPool(net)\n\
454 \ encoded.append((a.GetFreeCount(), a.GetReservedCount(), \\\n\
455 \ net.ToDict()))\n\
456 \print serializer.Dump(encoded)" serialized
457 >>= checkPythonResult
458 let deserialised = J.decode py_stdout::J.Result [(Int, Int, Network)]
459 decoded <- case deserialised of
460 J.Ok ops -> return ops
461 J.Error msg ->
462 HUnit.assertFailure ("Unable to decode networks: " ++ msg)
463 -- this already raised an expection, but we need it
464 -- for proper types
465 >> fail "Unable to decode networks"
466 HUnit.assertEqual "Mismatch in number of returned networks"
467 (length decoded) (length networks_with_properties)
468 mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
469 ) $ zip networks_with_properties decoded
470
471 -- | Creates a tuple of the given network combined with some of its properties
472 -- to be compared against the same properties generated by the python code.
473 getNetworkProperties :: Network -> (Int, Int, Network)
474 getNetworkProperties net =
475 (getFreeCount net, getReservedCount net, net)
476
477 -- | Tests the compatibility between Haskell-serialized node groups and their
478 -- python-decoded and encoded version.
479 casePyCompatNodegroups :: HUnit.Assertion
480 casePyCompatNodegroups = do
481 let num_groups = 500::Int
482 groups <- genSample (vectorOf num_groups genNodeGroup)
483 let serialized = J.encode groups
484 -- check for non-ASCII fields, usually due to 'arbitrary :: String'
485 mapM_ (\group -> when (any (not . isAscii) (J.encode group)) .
486 HUnit.assertFailure $
487 "Node group has non-ASCII fields: " ++ show group
488 ) groups
489 py_stdout <-
490 runPython "from ganeti import objects\n\
491 \from ganeti import serializer\n\
492 \import sys\n\
493 \group_data = serializer.Load(sys.stdin.read())\n\
494 \decoded = [objects.NodeGroup.FromDict(g) for g in group_data]\n\
495 \encoded = [g.ToDict() for g in decoded]\n\
496 \print serializer.Dump(encoded)" serialized
497 >>= checkPythonResult
498 let deserialised = J.decode py_stdout::J.Result [NodeGroup]
499 decoded <- case deserialised of
500 J.Ok ops -> return ops
501 J.Error msg ->
502 HUnit.assertFailure ("Unable to decode node groups: " ++ msg)
503 -- this already raised an expection, but we need it
504 -- for proper types
505 >> fail "Unable to decode node groups"
506 HUnit.assertEqual "Mismatch in number of returned node groups"
507 (length decoded) (length groups)
508 mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
509 ) $ zip groups decoded
510
511 -- | Generates a node group with up to 3 networks.
512 -- | FIXME: This generates still somewhat completely random data, without normal
513 -- validation rules.
514 genNodeGroup :: Gen NodeGroup
515 genNodeGroup = do
516 name <- genFQDN
517 members <- pure []
518 ndparams <- arbitrary
519 alloc_policy <- arbitrary
520 ipolicy <- arbitrary
521 diskparams <- pure (GenericContainer Map.empty)
522 num_networks <- choose (0, 3)
523 net_uuid_list <- vectorOf num_networks (arbitrary::Gen String)
524 nic_param_list <- vectorOf num_networks (arbitrary::Gen PartialNicParams)
525 net_map <- pure (GenericContainer . Map.fromList $
526 zip net_uuid_list nic_param_list)
527 hv_state <- arbitrary
528 disk_state <- arbitrary
529 -- timestamp fields
530 ctime <- arbitrary
531 mtime <- arbitrary
532 uuid <- genFQDN `suchThat` (/= name)
533 serial <- arbitrary
534 tags <- Set.fromList <$> genTags
535 let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams
536 net_map hv_state disk_state ctime mtime uuid serial tags
537 return group
538
539 instance Arbitrary NodeGroup where
540 arbitrary = genNodeGroup
541
542 instance Arbitrary Ip4Address where
543 arbitrary = liftM mkIp4Address $ (,,,) <$> choose (0, 255)
544 <*> choose (0, 255)
545 <*> choose (0, 255)
546 <*> choose (0, 255)
547
548 $(genArbitrary ''Ip4Network)
549
550 -- | Tests conversions of ip addresses from/to numbers.
551 prop_ip4AddressAsNum :: Ip4Address -> Property
552 prop_ip4AddressAsNum ip4 =
553 ip4AddressFromNumber (ip4AddressToNumber ip4) ==? ip4
554
555 -- | Tests that the number produced by 'ip4AddressToNumber' has the correct
556 -- order of bytes.
557 prop_ip4AddressToNumber :: Word32 -> Property
558 prop_ip4AddressToNumber w =
559 let byte :: Int -> Word32
560 byte i = (w `div` (256^i)) `mod` 256
561 ipaddr = List.intercalate "." $ map (show . byte) [3,2..0]
562 in ip4AddressToNumber <$> readIp4Address ipaddr
563 ==? (return (toInteger w) :: Either String Integer)
564
565 -- | IsString instance for 'Ip4Address', to help write the tests.
566 instance IsString Ip4Address where
567 fromString s =
568 fromMaybe (error $ "Failed to parse address from " ++ s) (readIp4Address s)
569
570 -- | Tests a few simple cases of IPv4 next address.
571 caseNextIp4Address :: HUnit.Assertion
572 caseNextIp4Address = do
573 HUnit.assertEqual "" "0.0.0.1" $ nextIp4Address "0.0.0.0"
574 HUnit.assertEqual "" "0.0.0.0" $ nextIp4Address "255.255.255.255"
575 HUnit.assertEqual "" "1.2.3.5" $ nextIp4Address "1.2.3.4"
576 HUnit.assertEqual "" "1.3.0.0" $ nextIp4Address "1.2.255.255"
577 HUnit.assertEqual "" "1.2.255.63" $ nextIp4Address "1.2.255.62"
578
579 -- | Tests the compatibility between Haskell-serialized instances and their
580 -- python-decoded and encoded version.
581 -- Note: this can be enhanced with logical validations on the decoded objects
582 casePyCompatInstances :: HUnit.Assertion
583 casePyCompatInstances = do
584 let num_inst = 500::Int
585 instances <- genSample (vectorOf num_inst genInst)
586 let serialized = J.encode instances
587 -- check for non-ASCII fields, usually due to 'arbitrary :: String'
588 mapM_ (\inst -> when (any (not . isAscii) (J.encode inst)) .
589 HUnit.assertFailure $
590 "Instance has non-ASCII fields: " ++ show inst
591 ) instances
592 py_stdout <-
593 runPython "from ganeti import objects\n\
594 \from ganeti import serializer\n\
595 \import sys\n\
596 \inst_data = serializer.Load(sys.stdin.read())\n\
597 \decoded = [objects.Instance.FromDict(i) for i in inst_data]\n\
598 \encoded = [i.ToDict() for i in decoded]\n\
599 \print serializer.Dump(encoded)" serialized
600 >>= checkPythonResult
601 let deserialised = J.decode py_stdout::J.Result [Instance]
602 decoded <- case deserialised of
603 J.Ok ops -> return ops
604 J.Error msg ->
605 HUnit.assertFailure ("Unable to decode instance: " ++ msg)
606 -- this already raised an expection, but we need it
607 -- for proper types
608 >> fail "Unable to decode instances"
609 HUnit.assertEqual "Mismatch in number of returned instances"
610 (length decoded) (length instances)
611 mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
612 ) $ zip instances decoded
613
614 -- | A helper function for creating 'LIDPlain' values.
615 mkLIDPlain :: String -> String -> DiskLogicalId
616 mkLIDPlain = (LIDPlain .) . LogicalVolume
617
618 -- | Tests that the logical ID is correctly found in a plain disk
619 caseIncludeLogicalIdPlain :: HUnit.Assertion
620 caseIncludeLogicalIdPlain =
621 let vg_name = "xenvg" :: String
622 lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String
623 lv = LogicalVolume vg_name lv_name
624 time = TOD 0 0
625 d =
626 Disk (LIDPlain lv) [] "diskname" 1000 DiskRdWr
627 Nothing Nothing Nothing "asdfgr-1234-5123-daf3-sdfw-134f43"
628 0 time time
629 in
630 HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $
631 includesLogicalId lv d
632
633 -- | Tests that the logical ID is correctly found in a DRBD disk
634 caseIncludeLogicalIdDrbd :: HUnit.Assertion
635 caseIncludeLogicalIdDrbd =
636 let vg_name = "xenvg" :: String
637 lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String
638 time = TOD 0 0
639 d =
640 Disk
641 (LIDDrbd8 "node1.example.com" "node2.example.com" 2000 1 5 "secret")
642 [ Disk (mkLIDPlain "onevg" "onelv") [] "disk1" 1000 DiskRdWr Nothing
643 Nothing Nothing "145145-asdf-sdf2-2134-asfd-534g2x" 0 time time
644 , Disk (mkLIDPlain vg_name lv_name) [] "disk2" 1000 DiskRdWr Nothing
645 Nothing Nothing "6gd3sd-423f-ag2j-563b-dg34-gj3fse" 0 time time
646 ] "diskname" 1000 DiskRdWr Nothing Nothing Nothing
647 "asdfgr-1234-5123-daf3-sdfw-134f43" 0 time time
648 in
649 HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $
650 includesLogicalId (LogicalVolume vg_name lv_name) d
651
652 -- | Tests that the logical ID is correctly NOT found in a plain disk
653 caseNotIncludeLogicalIdPlain :: HUnit.Assertion
654 caseNotIncludeLogicalIdPlain =
655 let vg_name = "xenvg" :: String
656 lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String
657 time = TOD 0 0
658 d =
659 Disk (mkLIDPlain "othervg" "otherlv") [] "diskname" 1000 DiskRdWr
660 Nothing Nothing Nothing "asdfgr-1234-5123-daf3-sdfw-134f43"
661 0 time time
662 in
663 HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $
664 not (includesLogicalId (LogicalVolume vg_name lv_name) d)
665
666 testSuite "Objects"
667 [ 'prop_fillDict
668 , 'prop_LogicalVolume_serialisation
669 , 'prop_LogicalVolume_deserialisationFail
670 , 'prop_Disk_serialisation
671 , 'prop_Disk_array_serialisation
672 , 'prop_Inst_serialisation
673 , 'prop_AddressPool_serialisation
674 , 'prop_Network_serialisation
675 , 'prop_Node_serialisation
676 , 'prop_Config_serialisation
677 , 'casePyCompatNetworks
678 , 'casePyCompatNodegroups
679 , 'casePyCompatInstances
680 , 'prop_ip4AddressAsNum
681 , 'prop_ip4AddressToNumber
682 , 'caseNextIp4Address
683 , 'caseIncludeLogicalIdPlain
684 , 'caseIncludeLogicalIdDrbd
685 , 'caseNotIncludeLogicalIdPlain
686 ]