Objects.hs 21.5 KB
Newer Older
1 2
{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances,
  OverloadedStrings #-}
Iustin Pop's avatar
Iustin Pop committed
3 4 5 6 7 8 9 10
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-| Unittests for ganeti-htools.

-}

{-

11
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
Iustin Pop's avatar
Iustin Pop committed
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29

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

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

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

-}

Iustin Pop's avatar
Iustin Pop committed
30 31
module Test.Ganeti.Objects
  ( testObjects
32
  , Node(..)
33
  , genConfigDataWithNetworks
Helga Velroyen's avatar
Helga Velroyen committed
34 35
  , genDisk
  , genDiskWithChildren
36
  , genEmptyCluster
Helga Velroyen's avatar
Helga Velroyen committed
37
  , genInst
38
  , genInstWithNets
39 40
  , genValidNetwork
  , genBitStringMaxLen
Iustin Pop's avatar
Iustin Pop committed
41
  ) where
Iustin Pop's avatar
Iustin Pop committed
42

43
import Test.QuickCheck
44
import qualified Test.HUnit as HUnit
45

Iustin Pop's avatar
Iustin Pop committed
46
import Control.Applicative
47 48
import Control.Monad
import Data.Char
49
import qualified Data.List as List
Iustin Pop's avatar
Iustin Pop committed
50
import qualified Data.Map as Map
51
import Data.Maybe (fromMaybe)
Iustin Pop's avatar
Iustin Pop committed
52
import qualified Data.Set as Set
53
import GHC.Exts (IsString(..))
54
import qualified Text.JSON as J
Iustin Pop's avatar
Iustin Pop committed
55 56

import Test.Ganeti.TestHelper
Iustin Pop's avatar
Iustin Pop committed
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
Iustin Pop's avatar
Iustin Pop committed
63
import Ganeti.JSON
64
import Ganeti.Types
65 66

-- * Arbitrary instances
Iustin Pop's avatar
Iustin Pop committed
67

68
$(genArbitrary ''PartialNDParams)
Iustin Pop's avatar
Iustin Pop committed
69

70
instance Arbitrary Node where
71 72
  arbitrary = Node <$> genFQDN <*> genFQDN <*> genFQDN
              <*> arbitrary <*> arbitrary <*> arbitrary <*> genFQDN
Iustin Pop's avatar
Iustin Pop committed
73
              <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
74
              <*> arbitrary <*> arbitrary <*> genFQDN <*> arbitrary
Iustin Pop's avatar
Iustin Pop committed
75 76
              <*> (Set.fromList <$> genTags)

77
$(genArbitrary ''BlockDriver)
78

79
$(genArbitrary ''DiskMode)
80 81 82

instance Arbitrary DiskLogicalId where
  arbitrary = oneof [ LIDPlain <$> arbitrary <*> arbitrary
83
                    , LIDDrbd8 <$> genFQDN <*> genFQDN <*> arbitrary
84 85 86 87 88 89 90 91 92 93
                               <*> arbitrary <*> arbitrary <*> arbitrary
                    , LIDFile  <$> arbitrary <*> arbitrary
                    , LIDBlockDev <$> arbitrary <*> arbitrary
                    , LIDRados <$> arbitrary <*> arbitrary
                    ]

-- | 'Disk' 'arbitrary' instance. Since we don't test disk hierarchy
-- properties, we only generate disks with no children (FIXME), as
-- generating recursive datastructures is a bit more work.
instance Arbitrary Disk where
Iustin Pop's avatar
Iustin Pop committed
94
  arbitrary = Disk <$> arbitrary <*> pure [] <*> arbitrary
95
                   <*> arbitrary <*> arbitrary <*> arbitrary
96
                   <*> arbitrary <*> arbitrary
97

98 99 100
-- FIXME: we should generate proper values, >=0, etc., but this is
-- hard for partial ones, where all must be wrapped in a 'Maybe'
$(genArbitrary ''PartialBeParams)
Iustin Pop's avatar
Iustin Pop committed
101

102
$(genArbitrary ''AdminState)
Iustin Pop's avatar
Iustin Pop committed
103

104
$(genArbitrary ''PartialNicParams)
Iustin Pop's avatar
Iustin Pop committed
105

106
$(genArbitrary ''PartialNic)
Iustin Pop's avatar
Iustin Pop committed
107 108 109 110

instance Arbitrary Instance where
  arbitrary =
    Instance
111 112 113 114 115 116 117
      -- name
      <$> genFQDN
      -- primary node
      <*> genFQDN
      -- OS
      <*> genFQDN
      -- hypervisor
Iustin Pop's avatar
Iustin Pop committed
118
      <*> arbitrary
119
      -- hvparams
Iustin Pop's avatar
Iustin Pop committed
120
      -- FIXME: add non-empty hvparams when they're a proper type
121 122 123 124 125 126 127 128 129 130
      <*> pure (GenericContainer Map.empty)
      -- beparams
      <*> arbitrary
      -- osparams
      <*> pure (GenericContainer Map.empty)
      -- admin_state
      <*> arbitrary
      -- nics
      <*> arbitrary
      -- disks
Helga Velroyen's avatar
Helga Velroyen committed
131
      <*> vectorOf 5 genDisk
132 133
      -- disk template
      <*> arbitrary
134 135
      -- disks active
      <*> arbitrary
136 137
      -- network port
      <*> arbitrary
Iustin Pop's avatar
Iustin Pop committed
138 139 140 141 142 143 144 145 146
      -- ts
      <*> arbitrary <*> arbitrary
      -- uuid
      <*> arbitrary
      -- serial
      <*> arbitrary
      -- tags
      <*> (Set.fromList <$> genTags)

147 148 149 150 151
-- | Generates an instance that is connected to the given networks
-- and possibly some other networks
genInstWithNets :: [String] -> Gen Instance
genInstWithNets nets = do
  plain_inst <- arbitrary
Helga Velroyen's avatar
Helga Velroyen committed
152 153 154 155 156 157 158 159 160 161
  enhanceInstWithNets plain_inst nets

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

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

Helga Velroyen's avatar
Helga Velroyen committed
176 177 178 179 180 181 182 183
genDiskWithChildren :: Int -> Gen Disk
genDiskWithChildren num_children = do
  logicalid <- arbitrary
  children <- vectorOf num_children (genDiskWithChildren 0)
  ivname <- genName
  size <- arbitrary
  mode <- arbitrary
  name <- genMaybe genName
184
  spindles <- arbitrary
Helga Velroyen's avatar
Helga Velroyen committed
185
  uuid <- genName
186
  let disk = Disk logicalid children ivname size mode name spindles uuid
Helga Velroyen's avatar
Helga Velroyen committed
187 188 189 190 191
  return disk

genDisk :: Gen Disk
genDisk = genDiskWithChildren 3

192 193 194 195 196 197 198 199 200
-- | FIXME: This generates completely random data, without normal
-- validation rules.
$(genArbitrary ''PartialISpecParams)

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

$(genArbitrary ''FilledISpecParams)
201
$(genArbitrary ''MinMaxISpecs)
202 203 204 205 206 207 208 209
$(genArbitrary ''FilledIPolicy)
$(genArbitrary ''IpFamily)
$(genArbitrary ''FilledNDParams)
$(genArbitrary ''FilledNicParams)
$(genArbitrary ''FilledBeParams)

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

-- | No real arbitrary instance for 'OsHvParams' yet.
instance Arbitrary OsHvParams where
214
  arbitrary = return $ GenericContainer Map.empty
215 216

instance Arbitrary ClusterNicParams where
217
  arbitrary = (GenericContainer . Map.singleton C.ppDefault) <$> arbitrary
218 219

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

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

instance Arbitrary ClusterBeParams where
226
  arbitrary = (GenericContainer . Map.fromList) <$> arbitrary
227 228 229 230 231 232

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

$(genArbitrary ''Cluster)

233
instance Arbitrary Network where
234 235 236 237 238 239 240 241
  arbitrary = genValidNetwork

-- | Generates a network instance with minimum netmasks of /24. Generating
-- bigger networks slows down the tests, because long bit strings are generated
-- for the reservations.
genValidNetwork :: Gen Objects.Network
genValidNetwork = do
  -- generate netmask for the IPv4 network
242
  netmask <- fromIntegral <$> choose (24::Int, 30)
243 244
  name <- genName >>= mkNonEmpty
  mac_prefix <- genMaybe genName
245
  net <- arbitrary
246
  net6 <- genMaybe genIp6Net
247
  gateway <- genMaybe arbitrary
248 249 250
  gateway6 <- genMaybe genIp6Addr
  res <- liftM Just (genBitString $ netmask2NumHosts netmask)
  ext_res <- liftM Just (genBitString $ netmask2NumHosts netmask)
251
  uuid <- arbitrary
252 253
  ctime <- arbitrary
  mtime <- arbitrary
254
  let n = Network name mac_prefix (Ip4Network net netmask) net6 gateway
255
          gateway6 res ext_res uuid ctime mtime 0 Set.empty
256 257 258 259 260 261 262 263 264 265
  return n

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

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

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

295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312
-- | FIXME: make an even simpler base version of creating a cluster.

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

313 314
-- * Test properties

Iustin Pop's avatar
Iustin Pop committed
315
-- | Tests that fillDict behaves correctly
316 317
prop_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property
prop_fillDict defaults custom =
Iustin Pop's avatar
Iustin Pop committed
318 319 320 321
  let d_map = Map.fromList defaults
      d_keys = map fst defaults
      c_map = Map.fromList custom
      c_keys = map fst custom
322 323 324 325 326 327 328
  in conjoin [ printTestCase "Empty custom filling"
               (fillDict d_map Map.empty [] == d_map)
             , printTestCase "Empty defaults filling"
               (fillDict Map.empty c_map [] == c_map)
             , printTestCase "Delete all keys"
               (fillDict d_map c_map (d_keys++c_keys) == Map.empty)
             ]
329 330 331 332 333 334 335 336

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

-- | Check that node serialisation is idempotent.
prop_Node_serialisation :: Node -> Property
341
prop_Node_serialisation = testSerialisation
Iustin Pop's avatar
Iustin Pop committed
342

Iustin Pop's avatar
Iustin Pop committed
343 344 345 346
-- | Check that instance serialisation is idempotent.
prop_Inst_serialisation :: Instance -> Property
prop_Inst_serialisation = testSerialisation

347 348 349 350
-- | Check that network serialisation is idempotent.
prop_Network_serialisation :: Network -> Property
prop_Network_serialisation = testSerialisation

351 352 353
-- | Check config serialisation.
prop_Config_serialisation :: Property
prop_Config_serialisation =
354
  forAll (choose (0, maxNodes `div` 4) >>= genEmptyCluster) testSerialisation
355

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

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

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

-- | Generates a node group with up to 3 networks.
-- | FIXME: This generates still somewhat completely random data, without normal
-- validation rules.
genNodeGroup :: Gen NodeGroup
genNodeGroup = do
  name <- genFQDN
  members <- pure []
  ndparams <- arbitrary
  alloc_policy <- arbitrary
  ipolicy <- arbitrary
  diskparams <- pure (GenericContainer Map.empty)
  num_networks <- choose (0, 3)
453
  net_uuid_list <- vectorOf num_networks (arbitrary::Gen String)
454
  nic_param_list <- vectorOf num_networks (arbitrary::Gen PartialNicParams)
455 456
  net_map <- pure (GenericContainer . Map.fromList $
    zip net_uuid_list nic_param_list)
457 458 459
  -- timestamp fields
  ctime <- arbitrary
  mtime <- arbitrary
460
  uuid <- genFQDN `suchThat` (/= name)
461 462 463
  serial <- arbitrary
  tags <- Set.fromList <$> genTags
  let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams
464
              net_map ctime mtime uuid serial tags
465 466 467 468 469
  return group

instance Arbitrary NodeGroup where
  arbitrary = genNodeGroup

470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499
$(genArbitrary ''Ip4Address)

$(genArbitrary ''Ip4Network)

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

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

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

-- | Tests a few simple cases of IPv4 next address.
caseNextIp4Address :: HUnit.Assertion
caseNextIp4Address = do
  HUnit.assertEqual "" "0.0.0.1" $ nextIp4Address "0.0.0.0"
  HUnit.assertEqual "" "0.0.0.0" $ nextIp4Address "255.255.255.255"
  HUnit.assertEqual "" "1.2.3.5" $ nextIp4Address "1.2.3.4"
  HUnit.assertEqual "" "1.3.0.0" $ nextIp4Address "1.2.255.255"
  HUnit.assertEqual "" "1.2.255.63" $ nextIp4Address "1.2.255.62"

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

535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576
-- | Tests that the logical ID is correctly found in a plain disk
caseIncludeLogicalIdPlain :: HUnit.Assertion
caseIncludeLogicalIdPlain =
  let vg_name = "xenvg" :: String
      lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String
      d =
        Disk (LIDPlain vg_name lv_name) [] "diskname" 1000 DiskRdWr
          Nothing Nothing "asdfgr-1234-5123-daf3-sdfw-134f43"
  in
    HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $
      includesLogicalId vg_name lv_name d

-- | Tests that the logical ID is correctly found in a DRBD disk
caseIncludeLogicalIdDrbd :: HUnit.Assertion
caseIncludeLogicalIdDrbd =
  let vg_name = "xenvg" :: String
      lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String
      d = 
        Disk
          (LIDDrbd8 "node1.example.com" "node2.example.com" 2000 1 5 "secret")
          [ Disk (LIDPlain "onevg" "onelv") [] "disk1" 1000 DiskRdWr Nothing
              Nothing "145145-asdf-sdf2-2134-asfd-534g2x"
          , Disk (LIDPlain vg_name lv_name) [] "disk2" 1000 DiskRdWr Nothing
              Nothing "6gd3sd-423f-ag2j-563b-dg34-gj3fse"
          ] "diskname" 1000 DiskRdWr Nothing Nothing
          "asdfgr-1234-5123-daf3-sdfw-134f43"
  in
    HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $
      includesLogicalId vg_name lv_name d

-- | Tests that the logical ID is correctly NOT found in a plain disk
caseNotIncludeLogicalIdPlain :: HUnit.Assertion
caseNotIncludeLogicalIdPlain =
  let vg_name = "xenvg" :: String
      lv_name = "1234sdf-qwef-2134-asff-asd2-23145d.data" :: String
      d =
        Disk (LIDPlain "othervg" "otherlv") [] "diskname" 1000 DiskRdWr
          Nothing Nothing "asdfgr-1234-5123-daf3-sdfw-134f43"
  in
    HUnit.assertBool "Unable to detect that plain Disk includes logical ID" $
      not (includesLogicalId vg_name lv_name d)

Iustin Pop's avatar
Iustin Pop committed
577
testSuite "Objects"
578
  [ 'prop_fillDict
579
  , 'prop_Disk_serialisation
Iustin Pop's avatar
Iustin Pop committed
580
  , 'prop_Inst_serialisation
581
  , 'prop_Network_serialisation
582
  , 'prop_Node_serialisation
583
  , 'prop_Config_serialisation
584 585
  , 'casePyCompatNetworks
  , 'casePyCompatNodegroups
586
  , 'casePyCompatInstances
587 588
  , 'prop_nextIp4Address
  , 'caseNextIp4Address
589 590 591
  , 'caseIncludeLogicalIdPlain
  , 'caseIncludeLogicalIdDrbd
  , 'caseNotIncludeLogicalIdPlain
592
  ]