root / htest / Test / Ganeti / Objects.hs @ 63b068c1
History | View | Annotate | Download (3.9 kB)
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 |
|
41 |
import Test.Ganeti.TestHelper |
42 |
import Test.Ganeti.TestCommon |
43 |
import Ganeti.Objects as Objects |
44 |
|
45 |
-- * Arbitrary instances |
46 |
|
47 |
instance Arbitrary Hypervisor where |
48 |
arbitrary = elements [minBound..maxBound] |
49 |
|
50 |
instance Arbitrary PartialNDParams where |
51 |
arbitrary = PartialNDParams <$> arbitrary <*> arbitrary |
52 |
|
53 |
instance Arbitrary Node where |
54 |
arbitrary = Node <$> getFQDN <*> getFQDN <*> getFQDN |
55 |
<*> arbitrary <*> arbitrary <*> arbitrary <*> getFQDN |
56 |
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary |
57 |
<*> arbitrary <*> arbitrary <*> getFQDN <*> arbitrary |
58 |
<*> (Set.fromList <$> genTags) |
59 |
|
60 |
instance Arbitrary FileDriver where |
61 |
arbitrary = elements [minBound..maxBound] |
62 |
|
63 |
instance Arbitrary BlockDriver where |
64 |
arbitrary = elements [minBound..maxBound] |
65 |
|
66 |
instance Arbitrary DiskMode where |
67 |
arbitrary = elements [minBound..maxBound] |
68 |
|
69 |
instance Arbitrary DiskLogicalId where |
70 |
arbitrary = oneof [ LIDPlain <$> arbitrary <*> arbitrary |
71 |
, LIDDrbd8 <$> getFQDN <*> getFQDN <*> arbitrary |
72 |
<*> arbitrary <*> arbitrary <*> arbitrary |
73 |
, LIDFile <$> arbitrary <*> arbitrary |
74 |
, LIDBlockDev <$> arbitrary <*> arbitrary |
75 |
, LIDRados <$> arbitrary <*> arbitrary |
76 |
] |
77 |
|
78 |
-- | 'Disk' 'arbitrary' instance. Since we don't test disk hierarchy |
79 |
-- properties, we only generate disks with no children (FIXME), as |
80 |
-- generating recursive datastructures is a bit more work. |
81 |
instance Arbitrary Disk where |
82 |
arbitrary = Disk <$> arbitrary <*> (pure []) <*> arbitrary |
83 |
<*> arbitrary <*> arbitrary |
84 |
|
85 |
-- * Test properties |
86 |
|
87 |
-- | Tests that fillDict behaves correctly |
88 |
prop_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property |
89 |
prop_fillDict defaults custom = |
90 |
let d_map = Map.fromList defaults |
91 |
d_keys = map fst defaults |
92 |
c_map = Map.fromList custom |
93 |
c_keys = map fst custom |
94 |
in printTestCase "Empty custom filling" |
95 |
(fillDict d_map Map.empty [] == d_map) .&&. |
96 |
printTestCase "Empty defaults filling" |
97 |
(fillDict Map.empty c_map [] == c_map) .&&. |
98 |
printTestCase "Delete all keys" |
99 |
(fillDict d_map c_map (d_keys++c_keys) == Map.empty) |
100 |
|
101 |
-- | Test that the serialisation of 'DiskLogicalId', which is |
102 |
-- implemented manually, is idempotent. Since we don't have a |
103 |
-- standalone JSON instance for DiskLogicalId (it's a data type that |
104 |
-- expands over two fields in a JSObject), we test this by actially |
105 |
-- testing entire Disk serialisations. So this tests two things at |
106 |
-- once, basically. |
107 |
prop_Disk_serialisation :: Disk -> Property |
108 |
prop_Disk_serialisation = testSerialisation |
109 |
|
110 |
-- | Check that node serialisation is idempotent. |
111 |
prop_Node_serialisation :: Node -> Property |
112 |
prop_Node_serialisation = testSerialisation |
113 |
|
114 |
testSuite "Objects" |
115 |
[ 'prop_fillDict |
116 |
, 'prop_Disk_serialisation |
117 |
, 'prop_Node_serialisation |
118 |
] |