root / htest / Test / Ganeti / Objects.hs @ 22381768
History | View | Annotate | Download (7.6 kB)
1 | 9924d61e | Iustin Pop | {-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-} |
---|---|---|---|
2 | e5a29b6c | Iustin Pop | {-# OPTIONS_GHC -fno-warn-orphans #-} |
3 | e5a29b6c | Iustin Pop | |
4 | e5a29b6c | Iustin Pop | {-| Unittests for ganeti-htools. |
5 | e5a29b6c | Iustin Pop | |
6 | e5a29b6c | Iustin Pop | -} |
7 | e5a29b6c | Iustin Pop | |
8 | e5a29b6c | Iustin Pop | {- |
9 | e5a29b6c | Iustin Pop | |
10 | e5a29b6c | Iustin Pop | Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
11 | e5a29b6c | Iustin Pop | |
12 | e5a29b6c | Iustin Pop | This program is free software; you can redistribute it and/or modify |
13 | e5a29b6c | Iustin Pop | it under the terms of the GNU General Public License as published by |
14 | e5a29b6c | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
15 | e5a29b6c | Iustin Pop | (at your option) any later version. |
16 | e5a29b6c | Iustin Pop | |
17 | e5a29b6c | Iustin Pop | This program is distributed in the hope that it will be useful, but |
18 | e5a29b6c | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | e5a29b6c | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 | e5a29b6c | Iustin Pop | General Public License for more details. |
21 | e5a29b6c | Iustin Pop | |
22 | e5a29b6c | Iustin Pop | You should have received a copy of the GNU General Public License |
23 | e5a29b6c | Iustin Pop | along with this program; if not, write to the Free Software |
24 | e5a29b6c | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 | e5a29b6c | Iustin Pop | 02110-1301, USA. |
26 | e5a29b6c | Iustin Pop | |
27 | e5a29b6c | Iustin Pop | -} |
28 | e5a29b6c | Iustin Pop | |
29 | 305e174c | Iustin Pop | module Test.Ganeti.Objects |
30 | 305e174c | Iustin Pop | ( testObjects |
31 | 8d2b6a12 | Iustin Pop | , Node(..) |
32 | 9924d61e | Iustin Pop | , genEmptyCluster |
33 | 305e174c | Iustin Pop | ) where |
34 | e5a29b6c | Iustin Pop | |
35 | 8d2b6a12 | Iustin Pop | import Test.QuickCheck |
36 | 8d2b6a12 | Iustin Pop | |
37 | 305e174c | Iustin Pop | import Control.Applicative |
38 | e5a29b6c | Iustin Pop | import qualified Data.Map as Map |
39 | 305e174c | Iustin Pop | import qualified Data.Set as Set |
40 | e5a29b6c | Iustin Pop | |
41 | e5a29b6c | Iustin Pop | import Test.Ganeti.TestHelper |
42 | 305e174c | Iustin Pop | import Test.Ganeti.TestCommon |
43 | 5e9deac0 | Iustin Pop | import Test.Ganeti.Types () |
44 | 9924d61e | Iustin Pop | |
45 | 9924d61e | Iustin Pop | import qualified Ganeti.Constants as C |
46 | 8d2b6a12 | Iustin Pop | import Ganeti.Objects as Objects |
47 | ce93b4a0 | Iustin Pop | import Ganeti.JSON |
48 | 8d2b6a12 | Iustin Pop | |
49 | 5b11f8db | Iustin Pop | {-# ANN module "HLint: ignore Use camelCase" #-} |
50 | 5b11f8db | Iustin Pop | |
51 | 8d2b6a12 | Iustin Pop | -- * Arbitrary instances |
52 | e5a29b6c | Iustin Pop | |
53 | 7022db83 | Iustin Pop | $(genArbitrary ''PartialNDParams) |
54 | 305e174c | Iustin Pop | |
55 | 8d2b6a12 | Iustin Pop | instance Arbitrary Node where |
56 | 8d2b6a12 | Iustin Pop | arbitrary = Node <$> getFQDN <*> getFQDN <*> getFQDN |
57 | 305e174c | Iustin Pop | <*> arbitrary <*> arbitrary <*> arbitrary <*> getFQDN |
58 | 305e174c | Iustin Pop | <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary |
59 | 305e174c | Iustin Pop | <*> arbitrary <*> arbitrary <*> getFQDN <*> arbitrary |
60 | 305e174c | Iustin Pop | <*> (Set.fromList <$> genTags) |
61 | 305e174c | Iustin Pop | |
62 | 7022db83 | Iustin Pop | $(genArbitrary ''FileDriver) |
63 | 8d2b6a12 | Iustin Pop | |
64 | 7022db83 | Iustin Pop | $(genArbitrary ''BlockDriver) |
65 | 8d2b6a12 | Iustin Pop | |
66 | 7022db83 | Iustin Pop | $(genArbitrary ''DiskMode) |
67 | 8d2b6a12 | Iustin Pop | |
68 | 8d2b6a12 | Iustin Pop | instance Arbitrary DiskLogicalId where |
69 | 8d2b6a12 | Iustin Pop | arbitrary = oneof [ LIDPlain <$> arbitrary <*> arbitrary |
70 | 8d2b6a12 | Iustin Pop | , LIDDrbd8 <$> getFQDN <*> getFQDN <*> arbitrary |
71 | 8d2b6a12 | Iustin Pop | <*> arbitrary <*> arbitrary <*> arbitrary |
72 | 8d2b6a12 | Iustin Pop | , LIDFile <$> arbitrary <*> arbitrary |
73 | 8d2b6a12 | Iustin Pop | , LIDBlockDev <$> arbitrary <*> arbitrary |
74 | 8d2b6a12 | Iustin Pop | , LIDRados <$> arbitrary <*> arbitrary |
75 | 8d2b6a12 | Iustin Pop | ] |
76 | 8d2b6a12 | Iustin Pop | |
77 | 8d2b6a12 | Iustin Pop | -- | 'Disk' 'arbitrary' instance. Since we don't test disk hierarchy |
78 | 8d2b6a12 | Iustin Pop | -- properties, we only generate disks with no children (FIXME), as |
79 | 8d2b6a12 | Iustin Pop | -- generating recursive datastructures is a bit more work. |
80 | 8d2b6a12 | Iustin Pop | instance Arbitrary Disk where |
81 | 5b11f8db | Iustin Pop | arbitrary = Disk <$> arbitrary <*> pure [] <*> arbitrary |
82 | 8d2b6a12 | Iustin Pop | <*> arbitrary <*> arbitrary |
83 | 8d2b6a12 | Iustin Pop | |
84 | 7022db83 | Iustin Pop | -- FIXME: we should generate proper values, >=0, etc., but this is |
85 | 7022db83 | Iustin Pop | -- hard for partial ones, where all must be wrapped in a 'Maybe' |
86 | 7022db83 | Iustin Pop | $(genArbitrary ''PartialBeParams) |
87 | ce93b4a0 | Iustin Pop | |
88 | 7022db83 | Iustin Pop | $(genArbitrary ''AdminState) |
89 | ce93b4a0 | Iustin Pop | |
90 | 7022db83 | Iustin Pop | $(genArbitrary ''NICMode) |
91 | ce93b4a0 | Iustin Pop | |
92 | 7022db83 | Iustin Pop | $(genArbitrary ''PartialNicParams) |
93 | ce93b4a0 | Iustin Pop | |
94 | 7022db83 | Iustin Pop | $(genArbitrary ''PartialNic) |
95 | ce93b4a0 | Iustin Pop | |
96 | ce93b4a0 | Iustin Pop | instance Arbitrary Instance where |
97 | ce93b4a0 | Iustin Pop | arbitrary = |
98 | ce93b4a0 | Iustin Pop | Instance |
99 | ce93b4a0 | Iustin Pop | <$> getFQDN <*> getFQDN <*> getFQDN -- OS name, but... |
100 | ce93b4a0 | Iustin Pop | <*> arbitrary |
101 | ce93b4a0 | Iustin Pop | -- FIXME: add non-empty hvparams when they're a proper type |
102 | edc1acde | Iustin Pop | <*> pure (GenericContainer Map.empty) <*> arbitrary |
103 | ce93b4a0 | Iustin Pop | -- ... and for OSParams |
104 | edc1acde | Iustin Pop | <*> pure (GenericContainer Map.empty) <*> arbitrary <*> arbitrary |
105 | ce93b4a0 | Iustin Pop | <*> arbitrary <*> arbitrary <*> arbitrary |
106 | ce93b4a0 | Iustin Pop | -- ts |
107 | ce93b4a0 | Iustin Pop | <*> arbitrary <*> arbitrary |
108 | ce93b4a0 | Iustin Pop | -- uuid |
109 | ce93b4a0 | Iustin Pop | <*> arbitrary |
110 | ce93b4a0 | Iustin Pop | -- serial |
111 | ce93b4a0 | Iustin Pop | <*> arbitrary |
112 | ce93b4a0 | Iustin Pop | -- tags |
113 | ce93b4a0 | Iustin Pop | <*> (Set.fromList <$> genTags) |
114 | ce93b4a0 | Iustin Pop | |
115 | 9924d61e | Iustin Pop | -- | FIXME: This generates completely random data, without normal |
116 | 9924d61e | Iustin Pop | -- validation rules. |
117 | 9924d61e | Iustin Pop | $(genArbitrary ''PartialISpecParams) |
118 | 9924d61e | Iustin Pop | |
119 | 9924d61e | Iustin Pop | -- | FIXME: This generates completely random data, without normal |
120 | 9924d61e | Iustin Pop | -- validation rules. |
121 | 9924d61e | Iustin Pop | $(genArbitrary ''PartialIPolicy) |
122 | 9924d61e | Iustin Pop | |
123 | 9924d61e | Iustin Pop | -- | FIXME: This generates completely random data, without normal |
124 | 9924d61e | Iustin Pop | -- validation rules. |
125 | 9924d61e | Iustin Pop | instance Arbitrary NodeGroup where |
126 | 9924d61e | Iustin Pop | arbitrary = NodeGroup <$> getFQDN <*> pure [] <*> arbitrary <*> arbitrary |
127 | edc1acde | Iustin Pop | <*> arbitrary <*> pure (GenericContainer Map.empty) |
128 | 9924d61e | Iustin Pop | -- ts |
129 | 9924d61e | Iustin Pop | <*> arbitrary <*> arbitrary |
130 | 9924d61e | Iustin Pop | -- uuid |
131 | 9924d61e | Iustin Pop | <*> arbitrary |
132 | 9924d61e | Iustin Pop | -- serial |
133 | 9924d61e | Iustin Pop | <*> arbitrary |
134 | 9924d61e | Iustin Pop | -- tags |
135 | 9924d61e | Iustin Pop | <*> (Set.fromList <$> genTags) |
136 | 9924d61e | Iustin Pop | |
137 | 9924d61e | Iustin Pop | $(genArbitrary ''FilledISpecParams) |
138 | 9924d61e | Iustin Pop | $(genArbitrary ''FilledIPolicy) |
139 | 9924d61e | Iustin Pop | $(genArbitrary ''IpFamily) |
140 | 9924d61e | Iustin Pop | $(genArbitrary ''FilledNDParams) |
141 | 9924d61e | Iustin Pop | $(genArbitrary ''FilledNicParams) |
142 | 9924d61e | Iustin Pop | $(genArbitrary ''FilledBeParams) |
143 | 9924d61e | Iustin Pop | |
144 | 9924d61e | Iustin Pop | -- | No real arbitrary instance for 'ClusterHvParams' yet. |
145 | 9924d61e | Iustin Pop | instance Arbitrary ClusterHvParams where |
146 | edc1acde | Iustin Pop | arbitrary = return $ GenericContainer Map.empty |
147 | 9924d61e | Iustin Pop | |
148 | 9924d61e | Iustin Pop | -- | No real arbitrary instance for 'OsHvParams' yet. |
149 | 9924d61e | Iustin Pop | instance Arbitrary OsHvParams where |
150 | edc1acde | Iustin Pop | arbitrary = return $ GenericContainer Map.empty |
151 | 9924d61e | Iustin Pop | |
152 | 9924d61e | Iustin Pop | instance Arbitrary ClusterNicParams where |
153 | edc1acde | Iustin Pop | arbitrary = (GenericContainer . Map.singleton C.ppDefault) <$> arbitrary |
154 | 9924d61e | Iustin Pop | |
155 | 9924d61e | Iustin Pop | instance Arbitrary OsParams where |
156 | edc1acde | Iustin Pop | arbitrary = (GenericContainer . Map.fromList) <$> arbitrary |
157 | 9924d61e | Iustin Pop | |
158 | 9924d61e | Iustin Pop | instance Arbitrary ClusterOsParams where |
159 | edc1acde | Iustin Pop | arbitrary = (GenericContainer . Map.fromList) <$> arbitrary |
160 | 9924d61e | Iustin Pop | |
161 | 9924d61e | Iustin Pop | instance Arbitrary ClusterBeParams where |
162 | edc1acde | Iustin Pop | arbitrary = (GenericContainer . Map.fromList) <$> arbitrary |
163 | 9924d61e | Iustin Pop | |
164 | 9924d61e | Iustin Pop | instance Arbitrary TagSet where |
165 | 9924d61e | Iustin Pop | arbitrary = Set.fromList <$> genTags |
166 | 9924d61e | Iustin Pop | |
167 | 9924d61e | Iustin Pop | $(genArbitrary ''Cluster) |
168 | 9924d61e | Iustin Pop | |
169 | 9924d61e | Iustin Pop | -- | Generator for config data with an empty cluster (no instances), |
170 | 9924d61e | Iustin Pop | -- with N defined nodes. |
171 | 9924d61e | Iustin Pop | genEmptyCluster :: Int -> Gen ConfigData |
172 | 9924d61e | Iustin Pop | genEmptyCluster ncount = do |
173 | 9924d61e | Iustin Pop | nodes <- vector ncount |
174 | 9924d61e | Iustin Pop | version <- arbitrary |
175 | 9924d61e | Iustin Pop | let guuid = "00" |
176 | b9bdc10e | Iustin Pop | nodes' = zipWith (\n idx -> n { nodeGroup = guuid, |
177 | b9bdc10e | Iustin Pop | nodeName = nodeName n ++ show idx }) |
178 | b9bdc10e | Iustin Pop | nodes [(1::Int)..] |
179 | edc1acde | Iustin Pop | contnodes = GenericContainer . Map.fromList $ |
180 | edc1acde | Iustin Pop | map (\n -> (nodeName n, n)) nodes' |
181 | edc1acde | Iustin Pop | continsts = GenericContainer Map.empty |
182 | 9924d61e | Iustin Pop | grp <- arbitrary |
183 | edc1acde | Iustin Pop | let contgroups = GenericContainer $ Map.singleton guuid grp |
184 | 9924d61e | Iustin Pop | serial <- arbitrary |
185 | c3a8e06d | Iustin Pop | cluster <- resize 8 arbitrary |
186 | 9924d61e | Iustin Pop | let c = ConfigData version cluster contnodes contgroups continsts serial |
187 | 9924d61e | Iustin Pop | return c |
188 | 9924d61e | Iustin Pop | |
189 | 8d2b6a12 | Iustin Pop | -- * Test properties |
190 | 8d2b6a12 | Iustin Pop | |
191 | e5a29b6c | Iustin Pop | -- | Tests that fillDict behaves correctly |
192 | 20bc5360 | Iustin Pop | prop_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property |
193 | 20bc5360 | Iustin Pop | prop_fillDict defaults custom = |
194 | e5a29b6c | Iustin Pop | let d_map = Map.fromList defaults |
195 | e5a29b6c | Iustin Pop | d_keys = map fst defaults |
196 | e5a29b6c | Iustin Pop | c_map = Map.fromList custom |
197 | e5a29b6c | Iustin Pop | c_keys = map fst custom |
198 | 942a9a6a | Iustin Pop | in conjoin [ printTestCase "Empty custom filling" |
199 | 942a9a6a | Iustin Pop | (fillDict d_map Map.empty [] == d_map) |
200 | 942a9a6a | Iustin Pop | , printTestCase "Empty defaults filling" |
201 | 942a9a6a | Iustin Pop | (fillDict Map.empty c_map [] == c_map) |
202 | 942a9a6a | Iustin Pop | , printTestCase "Delete all keys" |
203 | 942a9a6a | Iustin Pop | (fillDict d_map c_map (d_keys++c_keys) == Map.empty) |
204 | 942a9a6a | Iustin Pop | ] |
205 | 8d2b6a12 | Iustin Pop | |
206 | 8d2b6a12 | Iustin Pop | -- | Test that the serialisation of 'DiskLogicalId', which is |
207 | 8d2b6a12 | Iustin Pop | -- implemented manually, is idempotent. Since we don't have a |
208 | 8d2b6a12 | Iustin Pop | -- standalone JSON instance for DiskLogicalId (it's a data type that |
209 | 8d2b6a12 | Iustin Pop | -- expands over two fields in a JSObject), we test this by actially |
210 | 8d2b6a12 | Iustin Pop | -- testing entire Disk serialisations. So this tests two things at |
211 | 8d2b6a12 | Iustin Pop | -- once, basically. |
212 | 8d2b6a12 | Iustin Pop | prop_Disk_serialisation :: Disk -> Property |
213 | 63b068c1 | Iustin Pop | prop_Disk_serialisation = testSerialisation |
214 | 8d2b6a12 | Iustin Pop | |
215 | 8d2b6a12 | Iustin Pop | -- | Check that node serialisation is idempotent. |
216 | 8d2b6a12 | Iustin Pop | prop_Node_serialisation :: Node -> Property |
217 | 63b068c1 | Iustin Pop | prop_Node_serialisation = testSerialisation |
218 | e5a29b6c | Iustin Pop | |
219 | ce93b4a0 | Iustin Pop | -- | Check that instance serialisation is idempotent. |
220 | ce93b4a0 | Iustin Pop | prop_Inst_serialisation :: Instance -> Property |
221 | ce93b4a0 | Iustin Pop | prop_Inst_serialisation = testSerialisation |
222 | ce93b4a0 | Iustin Pop | |
223 | 9924d61e | Iustin Pop | -- | Check config serialisation. |
224 | 9924d61e | Iustin Pop | prop_Config_serialisation :: Property |
225 | 9924d61e | Iustin Pop | prop_Config_serialisation = |
226 | c3a8e06d | Iustin Pop | forAll (choose (0, maxNodes `div` 4) >>= genEmptyCluster) testSerialisation |
227 | 9924d61e | Iustin Pop | |
228 | e5a29b6c | Iustin Pop | testSuite "Objects" |
229 | 20bc5360 | Iustin Pop | [ 'prop_fillDict |
230 | 8d2b6a12 | Iustin Pop | , 'prop_Disk_serialisation |
231 | ce93b4a0 | Iustin Pop | , 'prop_Inst_serialisation |
232 | 8d2b6a12 | Iustin Pop | , 'prop_Node_serialisation |
233 | 44be51aa | Iustin Pop | , 'prop_Config_serialisation |
234 | 9924d61e | Iustin Pop | ] |