code.grnet.gr Git - ganeti-local/blob - htest/Test/Ganeti/Objects.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3
   4 {-| Unittests for ganeti-htools.
   5
   6 -}
   7
   8 {-
   9
  10 Copyright (C) 2009, 2010, 2011, 2012 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   , Hypervisor(..)
  32   , Node(..)
  33   ) where
  34
  35 import Test.QuickCheck
  36
  37 import Control.Applicative
  38 import qualified Data.Map as Map
  39 import qualified Data.Set as Set
  40 import qualified Text.JSON as J
  41
  42 import Test.Ganeti.TestHelper
  43 import Test.Ganeti.TestCommon
  44 import Ganeti.Objects as Objects
  45
  46 -- * Arbitrary instances
  47
  48 instance Arbitrary Hypervisor where
  49   arbitrary = elements [minBound..maxBound]
  50
  51 instance Arbitrary PartialNDParams where
  52   arbitrary = PartialNDParams <$> arbitrary <*> arbitrary
  53
  54 instance Arbitrary Node where
  55   arbitrary = Node <$> getFQDN <*> getFQDN <*> getFQDN
  56               <*> arbitrary <*> arbitrary <*> arbitrary <*> getFQDN
  57               <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
  58               <*> arbitrary <*> arbitrary <*> getFQDN <*> arbitrary
  59               <*> (Set.fromList <$> genTags)
  60
  61 instance Arbitrary FileDriver where
  62   arbitrary = elements [minBound..maxBound]
  63
  64 instance Arbitrary BlockDriver where
  65   arbitrary = elements [minBound..maxBound]
  66
  67 instance Arbitrary DiskMode where
  68   arbitrary = elements [minBound..maxBound]
  69
  70 instance Arbitrary DiskLogicalId where
  71   arbitrary = oneof [ LIDPlain <$> arbitrary <*> arbitrary
  72                     , LIDDrbd8 <$> getFQDN <*> getFQDN <*> arbitrary
  73                                <*> arbitrary <*> arbitrary <*> arbitrary
  74                     , LIDFile  <$> arbitrary <*> arbitrary
  75                     , LIDBlockDev <$> arbitrary <*> arbitrary
  76                     , LIDRados <$> arbitrary <*> arbitrary
  77                     ]
  78
  79 -- | 'Disk' 'arbitrary' instance. Since we don't test disk hierarchy
  80 -- properties, we only generate disks with no children (FIXME), as
  81 -- generating recursive datastructures is a bit more work.
  82 instance Arbitrary Disk where
  83   arbitrary = Disk <$> arbitrary <*> (pure []) <*> arbitrary
  84                    <*> arbitrary <*> arbitrary
  85
  86 -- * Test properties
  87
  88 -- | Tests that fillDict behaves correctly
  89 prop_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property
  90 prop_fillDict defaults custom =
  91   let d_map = Map.fromList defaults
  92       d_keys = map fst defaults
  93       c_map = Map.fromList custom
  94       c_keys = map fst custom
  95   in printTestCase "Empty custom filling"
  96       (fillDict d_map Map.empty [] == d_map) .&&.
  97      printTestCase "Empty defaults filling"
  98       (fillDict Map.empty c_map [] == c_map) .&&.
  99      printTestCase "Delete all keys"
 100       (fillDict d_map c_map (d_keys++c_keys) == Map.empty)
 101
 102 -- | Test that the serialisation of 'DiskLogicalId', which is
 103 -- implemented manually, is idempotent. Since we don't have a
 104 -- standalone JSON instance for DiskLogicalId (it's a data type that
 105 -- expands over two fields in a JSObject), we test this by actially
 106 -- testing entire Disk serialisations. So this tests two things at
 107 -- once, basically.
 108 prop_Disk_serialisation :: Disk -> Property
 109 prop_Disk_serialisation disk =
 110   J.readJSON (J.showJSON disk) ==? J.Ok disk
 111
 112 -- | Check that node serialisation is idempotent.
 113 prop_Node_serialisation :: Node -> Property
 114 prop_Node_serialisation node =
 115   J.readJSON (J.showJSON node) ==? J.Ok node
 116
 117 testSuite "Objects"
 118   [ 'prop_fillDict
 119   , 'prop_Disk_serialisation
 120   , 'prop_Node_serialisation
 121   ]