Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / Objects.hs @ 7af7da68

History | View | Annotate | Download (19.4 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
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
      -- admin_state
127
      <*> arbitrary
128
      -- nics
129
      <*> arbitrary
130
      -- disks
131
      <*> vectorOf 5 genDisk
132
      -- disk template
133
      <*> arbitrary
134
      -- network port
135
      <*> arbitrary
136
      -- ts
137
      <*> arbitrary <*> arbitrary
138
      -- uuid
139
      <*> arbitrary
140
      -- serial
141
      <*> arbitrary
142
      -- tags
143
      <*> (Set.fromList <$> genTags)
144

    
145
-- | Generates an instance that is connected to the given networks
146
-- and possibly some other networks
147
genInstWithNets :: [String] -> Gen Instance
148
genInstWithNets nets = do
149
  plain_inst <- arbitrary
150
  enhanceInstWithNets plain_inst nets
151

    
152
-- | Generates an instance that is connected to some networks
153
genInst :: Gen Instance
154
genInst = genInstWithNets []
155

    
156
-- | Enhances a given instance with network information, by connecting it to the
157
-- given networks and possibly some other networks
158
enhanceInstWithNets :: Instance -> [String] -> Gen Instance
159
enhanceInstWithNets inst nets = do
160
  mac <- arbitrary
161
  ip <- arbitrary
162
  nicparams <- arbitrary
163
  name <- arbitrary
164
  uuid <- arbitrary
165
  -- generate some more networks than the given ones
166
  num_more_nets <- choose (0,3)
167
  more_nets <- vectorOf num_more_nets genName
168
  let genNic net = PartialNic mac ip nicparams net name uuid
169
      partial_nics = map (genNic . Just)
170
                         (List.nub (nets ++ more_nets))
171
      new_inst = inst { instNics = partial_nics }
172
  return new_inst
173

    
174
genDiskWithChildren :: Int -> Gen Disk
175
genDiskWithChildren num_children = do
176
  logicalid <- arbitrary
177
  children <- vectorOf num_children (genDiskWithChildren 0)
178
  ivname <- genName
179
  size <- arbitrary
180
  mode <- arbitrary
181
  name <- genMaybe genName
182
  uuid <- genName
183
  let disk = Disk logicalid children ivname size mode name uuid
184
  return disk
185

    
186
genDisk :: Gen Disk
187
genDisk = genDiskWithChildren 3
188

    
189
-- | FIXME: This generates completely random data, without normal
190
-- validation rules.
191
$(genArbitrary ''PartialISpecParams)
192

    
193
-- | FIXME: This generates completely random data, without normal
194
-- validation rules.
195
$(genArbitrary ''PartialIPolicy)
196

    
197
$(genArbitrary ''FilledISpecParams)
198
$(genArbitrary ''MinMaxISpecs)
199
$(genArbitrary ''FilledIPolicy)
200
$(genArbitrary ''IpFamily)
201
$(genArbitrary ''FilledNDParams)
202
$(genArbitrary ''FilledNicParams)
203
$(genArbitrary ''FilledBeParams)
204

    
205
-- | No real arbitrary instance for 'ClusterHvParams' yet.
206
instance Arbitrary ClusterHvParams where
207
  arbitrary = return $ GenericContainer Map.empty
208

    
209
-- | No real arbitrary instance for 'OsHvParams' yet.
210
instance Arbitrary OsHvParams where
211
  arbitrary = return $ GenericContainer Map.empty
212

    
213
instance Arbitrary ClusterNicParams where
214
  arbitrary = (GenericContainer . Map.singleton C.ppDefault) <$> arbitrary
215

    
216
instance Arbitrary OsParams where
217
  arbitrary = (GenericContainer . Map.fromList) <$> arbitrary
218

    
219
instance Arbitrary ClusterOsParams where
220
  arbitrary = (GenericContainer . Map.fromList) <$> arbitrary
221

    
222
instance Arbitrary ClusterBeParams where
223
  arbitrary = (GenericContainer . Map.fromList) <$> arbitrary
224

    
225
instance Arbitrary TagSet where
226
  arbitrary = Set.fromList <$> genTags
227

    
228
$(genArbitrary ''Cluster)
229

    
230
instance Arbitrary Network where
231
  arbitrary = genValidNetwork
232

    
233
-- | Generates a network instance with minimum netmasks of /24. Generating
234
-- bigger networks slows down the tests, because long bit strings are generated
235
-- for the reservations.
236
genValidNetwork :: Gen Objects.Network
237
genValidNetwork = do
238
  -- generate netmask for the IPv4 network
239
  netmask <- fromIntegral <$> choose (24::Int, 30)
240
  name <- genName >>= mkNonEmpty
241
  mac_prefix <- genMaybe genName
242
  net <- arbitrary
243
  net6 <- genMaybe genIp6Net
244
  gateway <- genMaybe arbitrary
245
  gateway6 <- genMaybe genIp6Addr
246
  res <- liftM Just (genBitString $ netmask2NumHosts netmask)
247
  ext_res <- liftM Just (genBitString $ netmask2NumHosts netmask)
248
  uuid <- arbitrary
249
  let n = Network name mac_prefix (Ip4Network net netmask) net6 gateway
250
          gateway6 res ext_res uuid 0 Set.empty
251
  return n
252

    
253
-- | Generate an arbitrary string consisting of '0' and '1' of the given length.
254
genBitString :: Int -> Gen String
255
genBitString len = vectorOf len (elements "01")
256

    
257
-- | Generate an arbitrary string consisting of '0' and '1' of the maximum given
258
-- length.
259
genBitStringMaxLen :: Int -> Gen String
260
genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString
261

    
262
-- | Generator for config data with an empty cluster (no instances),
263
-- with N defined nodes.
264
genEmptyCluster :: Int -> Gen ConfigData
265
genEmptyCluster ncount = do
266
  nodes <- vector ncount
267
  version <- arbitrary
268
  grp <- arbitrary
269
  let guuid = groupUuid grp
270
      nodes' = zipWith (\n idx ->
271
                          let newname = nodeName n ++ "-" ++ show idx
272
                          in (newname, n { nodeGroup = guuid,
273
                                           nodeName = newname}))
274
               nodes [(1::Int)..]
275
      nodemap = Map.fromList nodes'
276
      contnodes = if Map.size nodemap /= ncount
277
                    then error ("Inconsistent node map, duplicates in" ++
278
                                " node name list? Names: " ++
279
                                show (map fst nodes'))
280
                    else GenericContainer nodemap
281
      continsts = GenericContainer Map.empty
282
      networks = GenericContainer Map.empty
283
  let contgroups = GenericContainer $ Map.singleton guuid grp
284
  serial <- arbitrary
285
  cluster <- resize 8 arbitrary
286
  let c = ConfigData version cluster contnodes contgroups continsts networks
287
            serial
288
  return c
289

    
290
-- | FIXME: make an even simpler base version of creating a cluster.
291

    
292
-- | Generates config data with a couple of networks.
293
genConfigDataWithNetworks :: ConfigData -> Gen ConfigData
294
genConfigDataWithNetworks old_cfg = do
295
  num_nets <- choose (0, 3)
296
  -- generate a list of network names (no duplicates)
297
  net_names <- genUniquesList num_nets genName >>= mapM mkNonEmpty
298
  -- generate a random list of networks (possibly with duplicate names)
299
  nets <- vectorOf num_nets genValidNetwork
300
  -- use unique names for the networks
301
  let nets_unique = map ( \(name, net) -> net { networkName = name } )
302
        (zip net_names nets)
303
      net_map = GenericContainer $ Map.fromList
304
        (map (\n -> (networkUuid n, n)) nets_unique)
305
      new_cfg = old_cfg { configNetworks = net_map }
306
  return new_cfg
307

    
308
-- * Test properties
309

    
310
-- | Tests that fillDict behaves correctly
311
prop_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property
312
prop_fillDict defaults custom =
313
  let d_map = Map.fromList defaults
314
      d_keys = map fst defaults
315
      c_map = Map.fromList custom
316
      c_keys = map fst custom
317
  in conjoin [ printTestCase "Empty custom filling"
318
               (fillDict d_map Map.empty [] == d_map)
319
             , printTestCase "Empty defaults filling"
320
               (fillDict Map.empty c_map [] == c_map)
321
             , printTestCase "Delete all keys"
322
               (fillDict d_map c_map (d_keys++c_keys) == Map.empty)
323
             ]
324

    
325
-- | Test that the serialisation of 'DiskLogicalId', which is
326
-- implemented manually, is idempotent. Since we don't have a
327
-- standalone JSON instance for DiskLogicalId (it's a data type that
328
-- expands over two fields in a JSObject), we test this by actially
329
-- testing entire Disk serialisations. So this tests two things at
330
-- once, basically.
331
prop_Disk_serialisation :: Disk -> Property
332
prop_Disk_serialisation = testSerialisation
333

    
334
-- | Check that node serialisation is idempotent.
335
prop_Node_serialisation :: Node -> Property
336
prop_Node_serialisation = testSerialisation
337

    
338
-- | Check that instance serialisation is idempotent.
339
prop_Inst_serialisation :: Instance -> Property
340
prop_Inst_serialisation = testSerialisation
341

    
342
-- | Check that network serialisation is idempotent.
343
prop_Network_serialisation :: Network -> Property
344
prop_Network_serialisation = testSerialisation
345

    
346
-- | Check config serialisation.
347
prop_Config_serialisation :: Property
348
prop_Config_serialisation =
349
  forAll (choose (0, maxNodes `div` 4) >>= genEmptyCluster) testSerialisation
350

    
351
-- | Custom HUnit test to check the correspondence between Haskell-generated
352
-- networks and their Python decoded, validated and re-encoded version.
353
-- For the technical background of this unit test, check the documentation
354
-- of "case_py_compat_types" of test/hs/Test/Ganeti/Opcodes.hs
355
casePyCompatNetworks :: HUnit.Assertion
356
casePyCompatNetworks = do
357
  let num_networks = 500::Int
358
  networks <- genSample (vectorOf num_networks genValidNetwork)
359
  let networks_with_properties = map getNetworkProperties networks
360
      serialized = J.encode networks
361
  -- check for non-ASCII fields, usually due to 'arbitrary :: String'
362
  mapM_ (\net -> when (any (not . isAscii) (J.encode net)) .
363
                 HUnit.assertFailure $
364
                 "Network has non-ASCII fields: " ++ show net
365
        ) networks
366
  py_stdout <-
367
    runPython "from ganeti import network\n\
368
              \from ganeti import objects\n\
369
              \from ganeti import serializer\n\
370
              \import sys\n\
371
              \net_data = serializer.Load(sys.stdin.read())\n\
372
              \decoded = [objects.Network.FromDict(n) for n in net_data]\n\
373
              \encoded = []\n\
374
              \for net in decoded:\n\
375
              \  a = network.AddressPool(net)\n\
376
              \  encoded.append((a.GetFreeCount(), a.GetReservedCount(), \\\n\
377
              \    net.ToDict()))\n\
378
              \print serializer.Dump(encoded)" serialized
379
    >>= checkPythonResult
380
  let deserialised = J.decode py_stdout::J.Result [(Int, Int, Network)]
381
  decoded <- case deserialised of
382
               J.Ok ops -> return ops
383
               J.Error msg ->
384
                 HUnit.assertFailure ("Unable to decode networks: " ++ msg)
385
                 -- this already raised an expection, but we need it
386
                 -- for proper types
387
                 >> fail "Unable to decode networks"
388
  HUnit.assertEqual "Mismatch in number of returned networks"
389
    (length decoded) (length networks_with_properties)
390
  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
391
        ) $ zip decoded networks_with_properties
392

    
393
-- | Creates a tuple of the given network combined with some of its properties
394
-- to be compared against the same properties generated by the python code.
395
getNetworkProperties :: Network -> (Int, Int, Network)
396
getNetworkProperties net =
397
  let maybePool = createAddressPool net
398
  in  case maybePool of
399
           (Just pool) -> (getFreeCount pool, getReservedCount pool, net)
400
           Nothing -> (-1, -1, net)
401

    
402
-- | Tests the compatibility between Haskell-serialized node groups and their
403
-- python-decoded and encoded version.
404
casePyCompatNodegroups :: HUnit.Assertion
405
casePyCompatNodegroups = do
406
  let num_groups = 500::Int
407
  groups <- genSample (vectorOf num_groups genNodeGroup)
408
  let serialized = J.encode groups
409
  -- check for non-ASCII fields, usually due to 'arbitrary :: String'
410
  mapM_ (\group -> when (any (not . isAscii) (J.encode group)) .
411
                 HUnit.assertFailure $
412
                 "Node group has non-ASCII fields: " ++ show group
413
        ) groups
414
  py_stdout <-
415
    runPython "from ganeti import objects\n\
416
              \from ganeti import serializer\n\
417
              \import sys\n\
418
              \group_data = serializer.Load(sys.stdin.read())\n\
419
              \decoded = [objects.NodeGroup.FromDict(g) for g in group_data]\n\
420
              \encoded = [g.ToDict() for g in decoded]\n\
421
              \print serializer.Dump(encoded)" serialized
422
    >>= checkPythonResult
423
  let deserialised = J.decode py_stdout::J.Result [NodeGroup]
424
  decoded <- case deserialised of
425
               J.Ok ops -> return ops
426
               J.Error msg ->
427
                 HUnit.assertFailure ("Unable to decode node groups: " ++ msg)
428
                 -- this already raised an expection, but we need it
429
                 -- for proper types
430
                 >> fail "Unable to decode node groups"
431
  HUnit.assertEqual "Mismatch in number of returned node groups"
432
    (length decoded) (length groups)
433
  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
434
        ) $ zip decoded groups
435

    
436
-- | Generates a node group with up to 3 networks.
437
-- | FIXME: This generates still somewhat completely random data, without normal
438
-- validation rules.
439
genNodeGroup :: Gen NodeGroup
440
genNodeGroup = do
441
  name <- genFQDN
442
  members <- pure []
443
  ndparams <- arbitrary
444
  alloc_policy <- arbitrary
445
  ipolicy <- arbitrary
446
  diskparams <- pure (GenericContainer Map.empty)
447
  num_networks <- choose (0, 3)
448
  net_uuid_list <- vectorOf num_networks (arbitrary::Gen String)
449
  nic_param_list <- vectorOf num_networks (arbitrary::Gen PartialNicParams)
450
  net_map <- pure (GenericContainer . Map.fromList $
451
    zip net_uuid_list nic_param_list)
452
  -- timestamp fields
453
  ctime <- arbitrary
454
  mtime <- arbitrary
455
  uuid <- genFQDN `suchThat` (/= name)
456
  serial <- arbitrary
457
  tags <- Set.fromList <$> genTags
458
  let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams
459
              net_map ctime mtime uuid serial tags
460
  return group
461

    
462
instance Arbitrary NodeGroup where
463
  arbitrary = genNodeGroup
464

    
465
$(genArbitrary ''Ip4Address)
466

    
467
$(genArbitrary ''Ip4Network)
468

    
469
-- | Helper to compute absolute value of an IPv4 address.
470
ip4AddrValue :: Ip4Address -> Integer
471
ip4AddrValue (Ip4Address a b c d) =
472
  fromIntegral a * (2^(24::Integer)) +
473
  fromIntegral b * (2^(16::Integer)) +
474
  fromIntegral c * (2^(8::Integer)) + fromIntegral d
475

    
476
-- | Tests that any difference between IPv4 consecutive addresses is 1.
477
prop_nextIp4Address :: Ip4Address -> Property
478
prop_nextIp4Address ip4 =
479
  ip4AddrValue (nextIp4Address ip4) ==? ip4AddrValue ip4 + 1
480

    
481
-- | IsString instance for 'Ip4Address', to help write the tests.
482
instance IsString Ip4Address where
483
  fromString s =
484
    fromMaybe (error $ "Failed to parse address from " ++ s) (readIp4Address s)
485

    
486
-- | Tests a few simple cases of IPv4 next address.
487
caseNextIp4Address :: HUnit.Assertion
488
caseNextIp4Address = do
489
  HUnit.assertEqual "" "0.0.0.1" $ nextIp4Address "0.0.0.0"
490
  HUnit.assertEqual "" "0.0.0.0" $ nextIp4Address "255.255.255.255"
491
  HUnit.assertEqual "" "1.2.3.5" $ nextIp4Address "1.2.3.4"
492
  HUnit.assertEqual "" "1.3.0.0" $ nextIp4Address "1.2.255.255"
493
  HUnit.assertEqual "" "1.2.255.63" $ nextIp4Address "1.2.255.62"
494

    
495
-- | Tests the compatibility between Haskell-serialized instances and their
496
-- python-decoded and encoded version.
497
-- Note: this can be enhanced with logical validations on the decoded objects
498
casePyCompatInstances :: HUnit.Assertion
499
casePyCompatInstances = do
500
  let num_inst = 500::Int
501
  instances <- genSample (vectorOf num_inst genInst)
502
  let serialized = J.encode instances
503
  -- check for non-ASCII fields, usually due to 'arbitrary :: String'
504
  mapM_ (\inst -> when (any (not . isAscii) (J.encode inst)) .
505
                 HUnit.assertFailure $
506
                 "Instance has non-ASCII fields: " ++ show inst
507
        ) instances
508
  py_stdout <-
509
    runPython "from ganeti import objects\n\
510
              \from ganeti import serializer\n\
511
              \import sys\n\
512
              \inst_data = serializer.Load(sys.stdin.read())\n\
513
              \decoded = [objects.Instance.FromDict(i) for i in inst_data]\n\
514
              \encoded = [i.ToDict() for i in decoded]\n\
515
              \print serializer.Dump(encoded)" serialized
516
    >>= checkPythonResult
517
  let deserialised = J.decode py_stdout::J.Result [Instance]
518
  decoded <- case deserialised of
519
               J.Ok ops -> return ops
520
               J.Error msg ->
521
                 HUnit.assertFailure ("Unable to decode instance: " ++ msg)
522
                 -- this already raised an expection, but we need it
523
                 -- for proper types
524
                 >> fail "Unable to decode instances"
525
  HUnit.assertEqual "Mismatch in number of returned instances"
526
    (length decoded) (length instances)
527
  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
528
        ) $ zip decoded instances
529

    
530
testSuite "Objects"
531
  [ 'prop_fillDict
532
  , 'prop_Disk_serialisation
533
  , 'prop_Inst_serialisation
534
  , 'prop_Network_serialisation
535
  , 'prop_Node_serialisation
536
  , 'prop_Config_serialisation
537
  , 'casePyCompatNetworks
538
  , 'casePyCompatNodegroups
539
  , 'casePyCompatInstances
540
  , 'prop_nextIp4Address
541
  , 'caseNextIp4Address
542
  ]