8de58d2a9a4e5f331879b0a4acb74e307bf2c446
[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 <*> genFQDN <*> arbitrary
87 <*> (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 -- timestamp fields
528 ctime <- arbitrary
529 mtime <- arbitrary
530 uuid <- genFQDN `suchThat` (/= name)
531 serial <- arbitrary
532 tags <- Set.fromList <$> genTags
533 let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams
534 net_map ctime mtime uuid serial tags
535 return group
536
537 instance Arbitrary NodeGroup where
538 arbitrary = genNodeGroup
539
540 instance Arbitrary Ip4Address where
541 arbitrary = liftM mkIp4Address $ (,,,) <$> choose (0, 255)
542 <*> choose (0, 255)
543 <*> choose (0, 255)
544 <*> choose (0, 255)
545
546 $(genArbitrary ''Ip4Network)
547
548 -- | Tests conversions of ip addresses from/to numbers.
549 prop_ip4AddressAsNum :: Ip4Address -> Property
550 prop_ip4AddressAsNum ip4 =
551 ip4AddressFromNumber (ip4AddressToNumber ip4) ==? ip4
552
553 -- | Tests that the number produced by 'ip4AddressToNumber' has the correct
554 -- order of bytes.
555 prop_ip4AddressToNumber :: Word32 -> Property
556 prop_ip4AddressToNumber w =
557 let byte :: Int -> Word32
558 byte i = (w `div` (256^i)) `mod` 256
559 ipaddr = List.intercalate "." $ map (show . byte) [3,2..0]
560 in ip4AddressToNumber <$> readIp4Address ipaddr
561 ==? (return (toInteger w) :: Either String Integer)
562
563 -- | IsString instance for 'Ip4Address', to help write the tests.
564 instance IsString Ip4Address where
565 fromString s =
566 fromMaybe (error $ "Failed to parse address from " ++ s) (readIp4Address s)
567
568 -- | Tests a few simple cases of IPv4 next address.
569 caseNextIp4Address :: HUnit.Assertion
570 caseNextIp4Address = do
571 HUnit.assertEqual "" "0.0.0.1" $ nextIp4Address "0.0.0.0"
572 HUnit.assertEqual "" "0.0.0.0" $ nextIp4Address "255.255.255.255"
573 HUnit.assertEqual "" "1.2.3.5" $ nextIp4Address "1.2.3.4"
574 HUnit.assertEqual "" "1.3.0.0" $ nextIp4Address "1.2.255.255"
575 HUnit.assertEqual "" "1.2.255.63" $ nextIp4Address "1.2.255.62"
576
577 -- | Tests the compatibility between Haskell-serialized instances and their
578 -- python-decoded and encoded version.
579 -- Note: this can be enhanced with logical validations on the decoded objects
580 casePyCompatInstances :: HUnit.Assertion
581 casePyCompatInstances = do
582 let num_inst = 500::Int
583 instances <- genSample (vectorOf num_inst genInst)
584 let serialized = J.encode instances
585 -- check for non-ASCII fields, usually due to 'arbitrary :: String'
586 mapM_ (\inst -> when (any (not . isAscii) (J.encode inst)) .
587 HUnit.assertFailure $
588 "Instance has non-ASCII fields: " ++ show inst
589 ) instances
590 py_stdout <-
591 runPython "from ganeti import objects\n\
592 \from ganeti import serializer\n\
593 \import sys\n\
594 \inst_data = serializer.Load(sys.stdin.read())\n\
595 \decoded = [objects.Instance.FromDict(i) for i in inst_data]\n\
596 \encoded = [i.ToDict() for i in decoded]\n\
597 \print serializer.Dump(encoded)" serialized
598 >>= checkPythonResult
599 let deserialised = J.decode py_stdout::J.Result [Instance]
600 decoded <- case deserialised of
601 J.Ok ops -> return ops
602 J.Error msg ->
603 HUnit.assertFailure ("Unable to decode instance: " ++ msg)
604 -- this already raised an expection, but we need it
605 -- for proper types
606 >> fail "Unable to decode instances"
607 HUnit.assertEqual "Mismatch in number of returned instances"
608 (length decoded) (length instances)
609 mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
610 ) $ zip instances decoded
611
612 -- | A helper function for creating 'LIDPlain' values.
613 mkLIDPlain :: String -> String -> DiskLogicalId
614 mkLIDPlain = (LIDPlain .) . LogicalVolume
615
616 -- | Tests that the logical ID is correctly found in a plain disk
617 caseIncludeLogicalIdPlain :: HUnit.Assertion
618 caseIncludeLogicalIdPlain =
619 let vg_name = "xenvg" :: String
620 lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String
621 lv = LogicalVolume vg_name lv_name
622 time = TOD 0 0
623 d =
624 Disk (LIDPlain lv) [] "diskname" 1000 DiskRdWr
625 Nothing Nothing Nothing "asdfgr-1234-5123-daf3-sdfw-134f43"
626 0 time time
627 in
628 HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $
629 includesLogicalId lv d
630
631 -- | Tests that the logical ID is correctly found in a DRBD disk
632 caseIncludeLogicalIdDrbd :: HUnit.Assertion
633 caseIncludeLogicalIdDrbd =
634 let vg_name = "xenvg" :: String
635 lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String
636 time = TOD 0 0
637 d =
638 Disk
639 (LIDDrbd8 "node1.example.com" "node2.example.com" 2000 1 5 "secret")
640 [ Disk (mkLIDPlain "onevg" "onelv") [] "disk1" 1000 DiskRdWr Nothing
641 Nothing Nothing "145145-asdf-sdf2-2134-asfd-534g2x" 0 time time
642 , Disk (mkLIDPlain vg_name lv_name) [] "disk2" 1000 DiskRdWr Nothing
643 Nothing Nothing "6gd3sd-423f-ag2j-563b-dg34-gj3fse" 0 time time
644 ] "diskname" 1000 DiskRdWr Nothing Nothing Nothing
645 "asdfgr-1234-5123-daf3-sdfw-134f43" 0 time time
646 in
647 HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $
648 includesLogicalId (LogicalVolume vg_name lv_name) d
649
650 -- | Tests that the logical ID is correctly NOT found in a plain disk
651 caseNotIncludeLogicalIdPlain :: HUnit.Assertion
652 caseNotIncludeLogicalIdPlain =
653 let vg_name = "xenvg" :: String
654 lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String
655 time = TOD 0 0
656 d =
657 Disk (mkLIDPlain "othervg" "otherlv") [] "diskname" 1000 DiskRdWr
658 Nothing Nothing Nothing "asdfgr-1234-5123-daf3-sdfw-134f43"
659 0 time time
660 in
661 HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $
662 not (includesLogicalId (LogicalVolume vg_name lv_name) d)
663
664 testSuite "Objects"
665 [ 'prop_fillDict
666 , 'prop_LogicalVolume_serialisation
667 , 'prop_LogicalVolume_deserialisationFail
668 , 'prop_Disk_serialisation
669 , 'prop_Disk_array_serialisation
670 , 'prop_Inst_serialisation
671 , 'prop_AddressPool_serialisation
672 , 'prop_Network_serialisation
673 , 'prop_Node_serialisation
674 , 'prop_Config_serialisation
675 , 'casePyCompatNetworks
676 , 'casePyCompatNodegroups
677 , 'casePyCompatInstances
678 , 'prop_ip4AddressAsNum
679 , 'prop_ip4AddressToNumber
680 , 'caseNextIp4Address
681 , 'caseIncludeLogicalIdPlain
682 , 'caseIncludeLogicalIdDrbd
683 , 'caseNotIncludeLogicalIdPlain
684 ]