Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / Objects.hs @ e7124835

History | View | Annotate | Download (15.4 kB)

1
{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-}
2
{-# OPTIONS_GHC -fno-warn-orphans #-}
3

    
4
{-| Unittests for ganeti-htools.
5

    
6
-}
7

    
8
{-
9

    
10
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
11

    
12
This program is free software; you can redistribute it and/or modify
13
it under the terms of the GNU General Public License as published by
14
the Free Software Foundation; either version 2 of the License, or
15
(at your option) any later version.
16

    
17
This program is distributed in the hope that it will be useful, but
18
WITHOUT ANY WARRANTY; without even the implied warranty of
19
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20
General Public License for more details.
21

    
22
You should have received a copy of the GNU General Public License
23
along with this program; if not, write to the Free Software
24
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25
02110-1301, USA.
26

    
27
-}
28

    
29
module Test.Ganeti.Objects
30
  ( testObjects
31
  , Node(..)
32
  , genConfigDataWithNetworks
33
  , genEmptyCluster
34
  , genInstWithNets
35
  , genValidNetwork
36
  , genBitStringMaxLen
37
  ) where
38

    
39
import Test.QuickCheck
40
import qualified Test.HUnit as HUnit
41

    
42
import Control.Applicative
43
import Control.Monad
44
import Data.Char
45
import qualified Data.List as List
46
import qualified Data.Map as Map
47
import qualified Data.Set as Set
48
import qualified Text.JSON as J
49

    
50
import Test.Ganeti.TestHelper
51
import Test.Ganeti.TestCommon
52
import Test.Ganeti.Types ()
53

    
54
import qualified Ganeti.Constants as C
55
import Ganeti.Network
56
import Ganeti.Objects as Objects
57
import Ganeti.JSON
58
import Ganeti.Types
59

    
60
{-# ANN module "HLint: ignore Use camelCase" #-}
61

    
62
-- * Arbitrary instances
63

    
64
$(genArbitrary ''PartialNDParams)
65

    
66
instance Arbitrary Node where
67
  arbitrary = Node <$> genFQDN <*> genFQDN <*> genFQDN
68
              <*> arbitrary <*> arbitrary <*> arbitrary <*> genFQDN
69
              <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
70
              <*> arbitrary <*> arbitrary <*> genFQDN <*> arbitrary
71
              <*> (Set.fromList <$> genTags)
72

    
73
$(genArbitrary ''BlockDriver)
74

    
75
$(genArbitrary ''DiskMode)
76

    
77
instance Arbitrary DiskLogicalId where
78
  arbitrary = oneof [ LIDPlain <$> arbitrary <*> arbitrary
79
                    , LIDDrbd8 <$> genFQDN <*> genFQDN <*> arbitrary
80
                               <*> arbitrary <*> arbitrary <*> arbitrary
81
                    , LIDFile  <$> arbitrary <*> arbitrary
82
                    , LIDBlockDev <$> arbitrary <*> arbitrary
83
                    , LIDRados <$> arbitrary <*> arbitrary
84
                    ]
85

    
86
-- | 'Disk' 'arbitrary' instance. Since we don't test disk hierarchy
87
-- properties, we only generate disks with no children (FIXME), as
88
-- generating recursive datastructures is a bit more work.
89
instance Arbitrary Disk where
90
  arbitrary = Disk <$> arbitrary <*> pure [] <*> arbitrary
91
                   <*> arbitrary <*> arbitrary
92

    
93
-- FIXME: we should generate proper values, >=0, etc., but this is
94
-- hard for partial ones, where all must be wrapped in a 'Maybe'
95
$(genArbitrary ''PartialBeParams)
96

    
97
$(genArbitrary ''AdminState)
98

    
99
$(genArbitrary ''PartialNicParams)
100

    
101
$(genArbitrary ''PartialNic)
102

    
103
instance Arbitrary Instance where
104
  arbitrary =
105
    Instance
106
      <$> genFQDN <*> genFQDN <*> genFQDN -- OS name, but...
107
      <*> arbitrary
108
      -- FIXME: add non-empty hvparams when they're a proper type
109
      <*> pure (GenericContainer Map.empty) <*> arbitrary
110
      -- ... and for OSParams
111
      <*> pure (GenericContainer Map.empty) <*> arbitrary <*> arbitrary
112
      <*> arbitrary <*> arbitrary <*> arbitrary
113
      -- ts
114
      <*> arbitrary <*> arbitrary
115
      -- uuid
116
      <*> arbitrary
117
      -- serial
118
      <*> arbitrary
119
      -- tags
120
      <*> (Set.fromList <$> genTags)
121

    
122
-- | Generates an instance that is connected to the given networks
123
-- and possibly some other networks
124
genInstWithNets :: [String] -> Gen Instance
125
genInstWithNets nets = do
126
  plain_inst <- arbitrary
127
  mac <- arbitrary
128
  ip <- arbitrary
129
  nicparams <- arbitrary
130
  -- generate some more networks than the given ones
131
  num_more_nets <- choose (0,3)
132
  more_nets <- vectorOf num_more_nets genName
133
  let partial_nics = map (PartialNic mac ip nicparams . Just)
134
                       (List.nub (nets ++ more_nets))
135
      new_inst = plain_inst { instNics = partial_nics }
136
  return new_inst
137

    
138
-- | FIXME: This generates completely random data, without normal
139
-- validation rules.
140
$(genArbitrary ''PartialISpecParams)
141

    
142
-- | FIXME: This generates completely random data, without normal
143
-- validation rules.
144
$(genArbitrary ''PartialIPolicy)
145

    
146
$(genArbitrary ''FilledISpecParams)
147
$(genArbitrary ''FilledIPolicy)
148
$(genArbitrary ''IpFamily)
149
$(genArbitrary ''FilledNDParams)
150
$(genArbitrary ''FilledNicParams)
151
$(genArbitrary ''FilledBeParams)
152

    
153
-- | No real arbitrary instance for 'ClusterHvParams' yet.
154
instance Arbitrary ClusterHvParams where
155
  arbitrary = return $ GenericContainer Map.empty
156

    
157
-- | No real arbitrary instance for 'OsHvParams' yet.
158
instance Arbitrary OsHvParams where
159
  arbitrary = return $ GenericContainer Map.empty
160

    
161
instance Arbitrary ClusterNicParams where
162
  arbitrary = (GenericContainer . Map.singleton C.ppDefault) <$> arbitrary
163

    
164
instance Arbitrary OsParams where
165
  arbitrary = (GenericContainer . Map.fromList) <$> arbitrary
166

    
167
instance Arbitrary ClusterOsParams where
168
  arbitrary = (GenericContainer . Map.fromList) <$> arbitrary
169

    
170
instance Arbitrary ClusterBeParams where
171
  arbitrary = (GenericContainer . Map.fromList) <$> arbitrary
172

    
173
instance Arbitrary TagSet where
174
  arbitrary = Set.fromList <$> genTags
175

    
176
$(genArbitrary ''Cluster)
177

    
178
instance Arbitrary Network where
179
  arbitrary = genValidNetwork
180

    
181
-- | Generates a network instance with minimum netmasks of /24. Generating
182
-- bigger networks slows down the tests, because long bit strings are generated
183
-- for the reservations.
184
genValidNetwork :: Gen Objects.Network
185
genValidNetwork = do
186
  -- generate netmask for the IPv4 network
187
  netmask <- choose (24::Int, 30)
188
  name <- genName >>= mkNonEmpty
189
  mac_prefix <- genMaybe genName
190
  net <- genIp4NetWithNetmask netmask
191
  net6 <- genMaybe genIp6Net
192
  gateway <- genMaybe genIp4AddrStr
193
  gateway6 <- genMaybe genIp6Addr
194
  res <- liftM Just (genBitString $ netmask2NumHosts netmask)
195
  ext_res <- liftM Just (genBitString $ netmask2NumHosts netmask)
196
  uuid <- arbitrary
197
  let n = Network name mac_prefix net net6 gateway
198
          gateway6 res ext_res uuid 0 Set.empty
199
  return n
200

    
201
-- | Generate an arbitrary string consisting of '0' and '1' of the given length.
202
genBitString :: Int -> Gen String
203
genBitString len = vectorOf len (elements "01")
204

    
205
-- | Generate an arbitrary string consisting of '0' and '1' of the maximum given
206
-- length.
207
genBitStringMaxLen :: Int -> Gen String
208
genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString
209

    
210
-- | Generator for config data with an empty cluster (no instances),
211
-- with N defined nodes.
212
genEmptyCluster :: Int -> Gen ConfigData
213
genEmptyCluster ncount = do
214
  nodes <- vector ncount
215
  version <- arbitrary
216
  grp <- arbitrary
217
  let guuid = groupUuid grp
218
      nodes' = zipWith (\n idx ->
219
                          let newname = nodeName n ++ "-" ++ show idx
220
                          in (newname, n { nodeGroup = guuid,
221
                                           nodeName = newname}))
222
               nodes [(1::Int)..]
223
      nodemap = Map.fromList nodes'
224
      contnodes = if Map.size nodemap /= ncount
225
                    then error ("Inconsistent node map, duplicates in" ++
226
                                " node name list? Names: " ++
227
                                show (map fst nodes'))
228
                    else GenericContainer nodemap
229
      continsts = GenericContainer Map.empty
230
      networks = GenericContainer Map.empty
231
  let contgroups = GenericContainer $ Map.singleton guuid grp
232
  serial <- arbitrary
233
  cluster <- resize 8 arbitrary
234
  let c = ConfigData version cluster contnodes contgroups continsts networks
235
            serial
236
  return c
237

    
238
-- | FIXME: make an even simpler base version of creating a cluster.
239

    
240
-- | Generates config data with a couple of networks.
241
genConfigDataWithNetworks :: ConfigData -> Gen ConfigData
242
genConfigDataWithNetworks old_cfg = do
243
  num_nets <- choose (0, 3)
244
  -- generate a list of network names (no duplicates)
245
  net_names <- genUniquesList num_nets genName >>= mapM mkNonEmpty
246
  -- generate a random list of networks (possibly with duplicate names)
247
  nets <- vectorOf num_nets genValidNetwork
248
  -- use unique names for the networks
249
  let nets_unique = map ( \(name, net) -> net { networkName = name } )
250
        (zip net_names nets)
251
      net_map = GenericContainer $ Map.fromList
252
        (map (\n -> (networkUuid n, n)) nets_unique)
253
      new_cfg = old_cfg { configNetworks = net_map }
254
  return new_cfg
255

    
256
-- * Test properties
257

    
258
-- | Tests that fillDict behaves correctly
259
prop_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property
260
prop_fillDict defaults custom =
261
  let d_map = Map.fromList defaults
262
      d_keys = map fst defaults
263
      c_map = Map.fromList custom
264
      c_keys = map fst custom
265
  in conjoin [ printTestCase "Empty custom filling"
266
               (fillDict d_map Map.empty [] == d_map)
267
             , printTestCase "Empty defaults filling"
268
               (fillDict Map.empty c_map [] == c_map)
269
             , printTestCase "Delete all keys"
270
               (fillDict d_map c_map (d_keys++c_keys) == Map.empty)
271
             ]
272

    
273
-- | Test that the serialisation of 'DiskLogicalId', which is
274
-- implemented manually, is idempotent. Since we don't have a
275
-- standalone JSON instance for DiskLogicalId (it's a data type that
276
-- expands over two fields in a JSObject), we test this by actially
277
-- testing entire Disk serialisations. So this tests two things at
278
-- once, basically.
279
prop_Disk_serialisation :: Disk -> Property
280
prop_Disk_serialisation = testSerialisation
281

    
282
-- | Check that node serialisation is idempotent.
283
prop_Node_serialisation :: Node -> Property
284
prop_Node_serialisation = testSerialisation
285

    
286
-- | Check that instance serialisation is idempotent.
287
prop_Inst_serialisation :: Instance -> Property
288
prop_Inst_serialisation = testSerialisation
289

    
290
-- | Check that network serialisation is idempotent.
291
prop_Network_serialisation :: Network -> Property
292
prop_Network_serialisation = testSerialisation
293

    
294
-- | Check config serialisation.
295
prop_Config_serialisation :: Property
296
prop_Config_serialisation =
297
  forAll (choose (0, maxNodes `div` 4) >>= genEmptyCluster) testSerialisation
298

    
299
-- | Custom HUnit test to check the correspondence between Haskell-generated
300
-- networks and their Python decoded, validated and re-encoded version.
301
-- For the technical background of this unit test, check the documentation
302
-- of "case_py_compat_types" of test/hs/Test/Ganeti/Opcodes.hs
303
case_py_compat_networks :: HUnit.Assertion
304
case_py_compat_networks = do
305
  let num_networks = 500::Int
306
  networks <- genSample (vectorOf num_networks genValidNetwork)
307
  let networks_with_properties = map getNetworkProperties networks
308
      serialized = J.encode networks
309
  -- check for non-ASCII fields, usually due to 'arbitrary :: String'
310
  mapM_ (\net -> when (any (not . isAscii) (J.encode net)) .
311
                 HUnit.assertFailure $
312
                 "Network has non-ASCII fields: " ++ show net
313
        ) networks
314
  py_stdout <-
315
    runPython "from ganeti import network\n\
316
              \from ganeti import objects\n\
317
              \from ganeti import serializer\n\
318
              \import sys\n\
319
              \net_data = serializer.Load(sys.stdin.read())\n\
320
              \decoded = [objects.Network.FromDict(n) for n in net_data]\n\
321
              \encoded = []\n\
322
              \for net in decoded:\n\
323
              \  a = network.AddressPool(net)\n\
324
              \  encoded.append((a.GetFreeCount(), a.GetReservedCount(), \\\n\
325
              \    net.ToDict()))\n\
326
              \print serializer.Dump(encoded)" serialized
327
    >>= checkPythonResult
328
  let deserialised = J.decode py_stdout::J.Result [(Int, Int, Network)]
329
  decoded <- case deserialised of
330
               J.Ok ops -> return ops
331
               J.Error msg ->
332
                 HUnit.assertFailure ("Unable to decode networks: " ++ msg)
333
                 -- this already raised an expection, but we need it
334
                 -- for proper types
335
                 >> fail "Unable to decode networks"
336
  HUnit.assertEqual "Mismatch in number of returned networks"
337
    (length decoded) (length networks_with_properties)
338
  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
339
        ) $ zip decoded networks_with_properties
340

    
341
-- | Creates a tuple of the given network combined with some of its properties
342
-- to be compared against the same properties generated by the python code.
343
getNetworkProperties :: Network -> (Int, Int, Network)
344
getNetworkProperties net =
345
  let maybePool = createAddressPool net
346
  in  case maybePool of
347
           (Just pool) -> (getFreeCount pool, getReservedCount pool, net)
348
           Nothing -> (-1, -1, net)
349

    
350
-- | Tests the compatibility between Haskell-serialized node groups and their
351
-- python-decoded and encoded version.
352
case_py_compat_nodegroups :: HUnit.Assertion
353
case_py_compat_nodegroups = do
354
  let num_groups = 500::Int
355
  groups <- genSample (vectorOf num_groups genNodeGroup)
356
  let serialized = J.encode groups
357
  -- check for non-ASCII fields, usually due to 'arbitrary :: String'
358
  mapM_ (\group -> when (any (not . isAscii) (J.encode group)) .
359
                 HUnit.assertFailure $
360
                 "Node group has non-ASCII fields: " ++ show group
361
        ) groups
362
  py_stdout <-
363
    runPython "from ganeti import objects\n\
364
              \from ganeti import serializer\n\
365
              \import sys\n\
366
              \group_data = serializer.Load(sys.stdin.read())\n\
367
              \decoded = [objects.NodeGroup.FromDict(g) for g in group_data]\n\
368
              \encoded = [g.ToDict() for g in decoded]\n\
369
              \print serializer.Dump(encoded)" serialized
370
    >>= checkPythonResult
371
  let deserialised = J.decode py_stdout::J.Result [NodeGroup]
372
  decoded <- case deserialised of
373
               J.Ok ops -> return ops
374
               J.Error msg ->
375
                 HUnit.assertFailure ("Unable to decode node groups: " ++ msg)
376
                 -- this already raised an expection, but we need it
377
                 -- for proper types
378
                 >> fail "Unable to decode node groups"
379
  HUnit.assertEqual "Mismatch in number of returned node groups"
380
    (length decoded) (length groups)
381
  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
382
        ) $ zip decoded groups
383

    
384
-- | Generates a node group with up to 3 networks.
385
-- | FIXME: This generates still somewhat completely random data, without normal
386
-- validation rules.
387
genNodeGroup :: Gen NodeGroup
388
genNodeGroup = do
389
  name <- genFQDN
390
  members <- pure []
391
  ndparams <- arbitrary
392
  alloc_policy <- arbitrary
393
  ipolicy <- arbitrary
394
  diskparams <- pure (GenericContainer Map.empty)
395
  num_networks <- choose (0, 3)
396
  net_uuid_list <- vectorOf num_networks (arbitrary::Gen String)
397
  nic_param_list <- vectorOf num_networks (arbitrary::Gen PartialNicParams)
398
  net_map <- pure (GenericContainer . Map.fromList $
399
    zip net_uuid_list nic_param_list)
400
  -- timestamp fields
401
  ctime <- arbitrary
402
  mtime <- arbitrary
403
  uuid <- genFQDN `suchThat` (/= name)
404
  serial <- arbitrary
405
  tags <- Set.fromList <$> genTags
406
  let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams
407
              net_map ctime mtime uuid serial tags
408
  return group
409

    
410
instance Arbitrary NodeGroup where
411
  arbitrary = genNodeGroup
412

    
413
testSuite "Objects"
414
  [ 'prop_fillDict
415
  , 'prop_Disk_serialisation
416
  , 'prop_Inst_serialisation
417
  , 'prop_Network_serialisation
418
  , 'prop_Node_serialisation
419
  , 'prop_Config_serialisation
420
  , 'case_py_compat_networks
421
  , 'case_py_compat_nodegroups
422
  ]