root / test / hs / Test / Ganeti / Types.hs @ 09d8b0fc
History | View | Annotate | Download (14.8 kB)
1 |
{-# LANGUAGE TemplateHaskell #-} |
---|---|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
3 |
|
4 |
{-| Unittests for 'Ganeti.Types'. |
5 |
|
6 |
-} |
7 |
|
8 |
{- |
9 |
|
10 |
Copyright (C) 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.Types |
30 |
( testTypes |
31 |
, AllocPolicy(..) |
32 |
, DiskTemplate(..) |
33 |
, allDiskTemplates |
34 |
, InstanceStatus(..) |
35 |
, NonEmpty(..) |
36 |
, Hypervisor(..) |
37 |
, JobId(..) |
38 |
) where |
39 |
|
40 |
import Data.List (delete, sort) |
41 |
import Test.QuickCheck as QuickCheck hiding (Result) |
42 |
import Test.HUnit |
43 |
import qualified Text.JSON as J |
44 |
|
45 |
import Test.Ganeti.TestHelper |
46 |
import Test.Ganeti.TestCommon |
47 |
|
48 |
import Ganeti.BasicTypes |
49 |
import qualified Ganeti.Constants as C |
50 |
import Ganeti.Types as Types |
51 |
import Ganeti.JSON |
52 |
|
53 |
{-# ANN module "HLint: ignore Use camelCase" #-} |
54 |
|
55 |
-- * Arbitrary instance |
56 |
|
57 |
instance (Arbitrary a, Ord a, Num a, Show a) => |
58 |
Arbitrary (Types.Positive a) where |
59 |
arbitrary = do |
60 |
(QuickCheck.Positive i) <- arbitrary |
61 |
Types.mkPositive i |
62 |
|
63 |
instance (Arbitrary a, Ord a, Num a, Show a) => |
64 |
Arbitrary (Types.NonNegative a) where |
65 |
arbitrary = do |
66 |
(QuickCheck.NonNegative i) <- arbitrary |
67 |
Types.mkNonNegative i |
68 |
|
69 |
instance (Arbitrary a, Ord a, Num a, Show a) => |
70 |
Arbitrary (Types.Negative a) where |
71 |
arbitrary = do |
72 |
(QuickCheck.Positive i) <- arbitrary |
73 |
Types.mkNegative $ negate i |
74 |
|
75 |
instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where |
76 |
arbitrary = do |
77 |
QuickCheck.NonEmpty lst <- arbitrary |
78 |
Types.mkNonEmpty lst |
79 |
|
80 |
$(genArbitrary ''AllocPolicy) |
81 |
|
82 |
-- | Valid disk templates (depending on configure options). |
83 |
allDiskTemplates :: [DiskTemplate] |
84 |
allDiskTemplates = |
85 |
let all_vals = [minBound..maxBound]::[DiskTemplate] |
86 |
sel1 = if C.enableFileStorage |
87 |
then all_vals |
88 |
else delete DTFile all_vals |
89 |
sel2 = if C.enableSharedFileStorage |
90 |
then sel1 |
91 |
else delete DTSharedFile sel1 |
92 |
in sel2 |
93 |
|
94 |
-- | Custom 'Arbitrary' instance for 'DiskTemplate', which needs to |
95 |
-- handle the case of file storage being disabled at configure time. |
96 |
instance Arbitrary DiskTemplate where |
97 |
arbitrary = elements allDiskTemplates |
98 |
|
99 |
$(genArbitrary ''InstanceStatus) |
100 |
|
101 |
$(genArbitrary ''MigrationMode) |
102 |
|
103 |
$(genArbitrary ''VerifyOptionalChecks) |
104 |
|
105 |
$(genArbitrary ''DdmSimple) |
106 |
|
107 |
$(genArbitrary ''DdmFull) |
108 |
|
109 |
$(genArbitrary ''CVErrorCode) |
110 |
|
111 |
$(genArbitrary ''Hypervisor) |
112 |
|
113 |
$(genArbitrary ''OobCommand) |
114 |
|
115 |
-- | Valid storage types. |
116 |
allStorageTypes :: [StorageType] |
117 |
allStorageTypes = |
118 |
let all_vals = [minBound..maxBound]::[StorageType] |
119 |
in if C.enableFileStorage |
120 |
then all_vals |
121 |
else delete StorageFile all_vals |
122 |
|
123 |
-- | Custom 'Arbitrary' instance for 'StorageType', which needs to |
124 |
-- handle the case of file storage being disabled at configure time. |
125 |
instance Arbitrary StorageType where |
126 |
arbitrary = elements allStorageTypes |
127 |
|
128 |
$(genArbitrary ''NodeEvacMode) |
129 |
|
130 |
$(genArbitrary ''FileDriver) |
131 |
|
132 |
$(genArbitrary ''InstCreateMode) |
133 |
|
134 |
$(genArbitrary ''RebootType) |
135 |
|
136 |
$(genArbitrary ''ExportMode) |
137 |
|
138 |
$(genArbitrary ''IAllocatorTestDir) |
139 |
|
140 |
$(genArbitrary ''IAllocatorMode) |
141 |
|
142 |
$(genArbitrary ''NICMode) |
143 |
|
144 |
$(genArbitrary ''JobStatus) |
145 |
|
146 |
$(genArbitrary ''FinalizedJobStatus) |
147 |
|
148 |
instance Arbitrary JobId where |
149 |
arbitrary = do |
150 |
(Positive i) <- arbitrary |
151 |
makeJobId i |
152 |
|
153 |
$(genArbitrary ''JobIdDep) |
154 |
|
155 |
$(genArbitrary ''JobDependency) |
156 |
|
157 |
$(genArbitrary ''OpSubmitPriority) |
158 |
|
159 |
$(genArbitrary ''OpStatus) |
160 |
|
161 |
$(genArbitrary ''ELogType) |
162 |
|
163 |
-- * Properties |
164 |
|
165 |
prop_AllocPolicy_serialisation :: AllocPolicy -> Property |
166 |
prop_AllocPolicy_serialisation = testSerialisation |
167 |
|
168 |
-- | Test 'AllocPolicy' ordering is as expected. |
169 |
case_AllocPolicy_order :: Assertion |
170 |
case_AllocPolicy_order = |
171 |
assertEqual "sort order" [ Types.AllocPreferred |
172 |
, Types.AllocLastResort |
173 |
, Types.AllocUnallocable |
174 |
] [minBound..maxBound] |
175 |
|
176 |
prop_DiskTemplate_serialisation :: DiskTemplate -> Property |
177 |
prop_DiskTemplate_serialisation = testSerialisation |
178 |
|
179 |
prop_InstanceStatus_serialisation :: InstanceStatus -> Property |
180 |
prop_InstanceStatus_serialisation = testSerialisation |
181 |
|
182 |
-- | Tests building non-negative numbers. |
183 |
prop_NonNeg_pass :: QuickCheck.NonNegative Int -> Property |
184 |
prop_NonNeg_pass (QuickCheck.NonNegative i) = |
185 |
case mkNonNegative i of |
186 |
Bad msg -> failTest $ "Fail to build non-negative: " ++ msg |
187 |
Ok nn -> fromNonNegative nn ==? i |
188 |
|
189 |
-- | Tests building non-negative numbers. |
190 |
prop_NonNeg_fail :: QuickCheck.Positive Int -> Property |
191 |
prop_NonNeg_fail (QuickCheck.Positive i) = |
192 |
case mkNonNegative (negate i)::Result (Types.NonNegative Int) of |
193 |
Bad _ -> passTest |
194 |
Ok nn -> failTest $ "Built non-negative number '" ++ show nn ++ |
195 |
"' from negative value " ++ show i |
196 |
|
197 |
-- | Tests building positive numbers. |
198 |
prop_Positive_pass :: QuickCheck.Positive Int -> Property |
199 |
prop_Positive_pass (QuickCheck.Positive i) = |
200 |
case mkPositive i of |
201 |
Bad msg -> failTest $ "Fail to build positive: " ++ msg |
202 |
Ok nn -> fromPositive nn ==? i |
203 |
|
204 |
-- | Tests building positive numbers. |
205 |
prop_Positive_fail :: QuickCheck.NonNegative Int -> Property |
206 |
prop_Positive_fail (QuickCheck.NonNegative i) = |
207 |
case mkPositive (negate i)::Result (Types.Positive Int) of |
208 |
Bad _ -> passTest |
209 |
Ok nn -> failTest $ "Built positive number '" ++ show nn ++ |
210 |
"' from negative or zero value " ++ show i |
211 |
|
212 |
-- | Tests building negative numbers. |
213 |
prop_Neg_pass :: QuickCheck.Positive Int -> Property |
214 |
prop_Neg_pass (QuickCheck.Positive i) = |
215 |
case mkNegative i' of |
216 |
Bad msg -> failTest $ "Fail to build negative: " ++ msg |
217 |
Ok nn -> fromNegative nn ==? i' |
218 |
where i' = negate i |
219 |
|
220 |
-- | Tests building negative numbers. |
221 |
prop_Neg_fail :: QuickCheck.NonNegative Int -> Property |
222 |
prop_Neg_fail (QuickCheck.NonNegative i) = |
223 |
case mkNegative i::Result (Types.Negative Int) of |
224 |
Bad _ -> passTest |
225 |
Ok nn -> failTest $ "Built negative number '" ++ show nn ++ |
226 |
"' from non-negative value " ++ show i |
227 |
|
228 |
-- | Tests building non-empty lists. |
229 |
prop_NonEmpty_pass :: QuickCheck.NonEmptyList String -> Property |
230 |
prop_NonEmpty_pass (QuickCheck.NonEmpty xs) = |
231 |
case mkNonEmpty xs of |
232 |
Bad msg -> failTest $ "Fail to build non-empty list: " ++ msg |
233 |
Ok nn -> fromNonEmpty nn ==? xs |
234 |
|
235 |
-- | Tests building positive numbers. |
236 |
case_NonEmpty_fail :: Assertion |
237 |
case_NonEmpty_fail = |
238 |
assertEqual "building non-empty list from an empty list" |
239 |
(Bad "Received empty value for non-empty list") (mkNonEmpty ([]::[Int])) |
240 |
|
241 |
-- | Tests migration mode serialisation. |
242 |
prop_MigrationMode_serialisation :: MigrationMode -> Property |
243 |
prop_MigrationMode_serialisation = testSerialisation |
244 |
|
245 |
-- | Tests verify optional checks serialisation. |
246 |
prop_VerifyOptionalChecks_serialisation :: VerifyOptionalChecks -> Property |
247 |
prop_VerifyOptionalChecks_serialisation = testSerialisation |
248 |
|
249 |
-- | Tests 'DdmSimple' serialisation. |
250 |
prop_DdmSimple_serialisation :: DdmSimple -> Property |
251 |
prop_DdmSimple_serialisation = testSerialisation |
252 |
|
253 |
-- | Tests 'DdmFull' serialisation. |
254 |
prop_DdmFull_serialisation :: DdmFull -> Property |
255 |
prop_DdmFull_serialisation = testSerialisation |
256 |
|
257 |
-- | Tests 'CVErrorCode' serialisation. |
258 |
prop_CVErrorCode_serialisation :: CVErrorCode -> Property |
259 |
prop_CVErrorCode_serialisation = testSerialisation |
260 |
|
261 |
-- | Tests equivalence with Python, based on Constants.hs code. |
262 |
case_CVErrorCode_pyequiv :: Assertion |
263 |
case_CVErrorCode_pyequiv = do |
264 |
let all_py_codes = sort C.cvAllEcodesStrings |
265 |
all_hs_codes = sort $ map Types.cVErrorCodeToRaw [minBound..maxBound] |
266 |
assertEqual "for CVErrorCode equivalence" all_py_codes all_hs_codes |
267 |
|
268 |
-- | Test 'Hypervisor' serialisation. |
269 |
prop_Hypervisor_serialisation :: Hypervisor -> Property |
270 |
prop_Hypervisor_serialisation = testSerialisation |
271 |
|
272 |
-- | Test 'OobCommand' serialisation. |
273 |
prop_OobCommand_serialisation :: OobCommand -> Property |
274 |
prop_OobCommand_serialisation = testSerialisation |
275 |
|
276 |
-- | Test 'StorageType' serialisation. |
277 |
prop_StorageType_serialisation :: StorageType -> Property |
278 |
prop_StorageType_serialisation = testSerialisation |
279 |
|
280 |
-- | Test 'NodeEvacMode' serialisation. |
281 |
prop_NodeEvacMode_serialisation :: NodeEvacMode -> Property |
282 |
prop_NodeEvacMode_serialisation = testSerialisation |
283 |
|
284 |
-- | Test 'FileDriver' serialisation. |
285 |
prop_FileDriver_serialisation :: FileDriver -> Property |
286 |
prop_FileDriver_serialisation = testSerialisation |
287 |
|
288 |
-- | Test 'InstCreate' serialisation. |
289 |
prop_InstCreateMode_serialisation :: InstCreateMode -> Property |
290 |
prop_InstCreateMode_serialisation = testSerialisation |
291 |
|
292 |
-- | Test 'RebootType' serialisation. |
293 |
prop_RebootType_serialisation :: RebootType -> Property |
294 |
prop_RebootType_serialisation = testSerialisation |
295 |
|
296 |
-- | Test 'ExportMode' serialisation. |
297 |
prop_ExportMode_serialisation :: ExportMode -> Property |
298 |
prop_ExportMode_serialisation = testSerialisation |
299 |
|
300 |
-- | Test 'IAllocatorTestDir' serialisation. |
301 |
prop_IAllocatorTestDir_serialisation :: IAllocatorTestDir -> Property |
302 |
prop_IAllocatorTestDir_serialisation = testSerialisation |
303 |
|
304 |
-- | Test 'IAllocatorMode' serialisation. |
305 |
prop_IAllocatorMode_serialisation :: IAllocatorMode -> Property |
306 |
prop_IAllocatorMode_serialisation = testSerialisation |
307 |
|
308 |
-- | Tests equivalence with Python, based on Constants.hs code. |
309 |
case_IAllocatorMode_pyequiv :: Assertion |
310 |
case_IAllocatorMode_pyequiv = do |
311 |
let all_py_codes = sort C.validIallocatorModes |
312 |
all_hs_codes = sort $ map Types.iAllocatorModeToRaw [minBound..maxBound] |
313 |
assertEqual "for IAllocatorMode equivalence" all_py_codes all_hs_codes |
314 |
|
315 |
-- | Test 'NICMode' serialisation. |
316 |
prop_NICMode_serialisation :: NICMode -> Property |
317 |
prop_NICMode_serialisation = testSerialisation |
318 |
|
319 |
-- | Test 'OpStatus' serialisation. |
320 |
prop_OpStatus_serialization :: OpStatus -> Property |
321 |
prop_OpStatus_serialization = testSerialisation |
322 |
|
323 |
-- | Test 'JobStatus' serialisation. |
324 |
prop_JobStatus_serialization :: JobStatus -> Property |
325 |
prop_JobStatus_serialization = testSerialisation |
326 |
|
327 |
-- | Test 'JobStatus' ordering is as expected. |
328 |
case_JobStatus_order :: Assertion |
329 |
case_JobStatus_order = |
330 |
assertEqual "sort order" [ Types.JOB_STATUS_QUEUED |
331 |
, Types.JOB_STATUS_WAITING |
332 |
, Types.JOB_STATUS_CANCELING |
333 |
, Types.JOB_STATUS_RUNNING |
334 |
, Types.JOB_STATUS_CANCELED |
335 |
, Types.JOB_STATUS_SUCCESS |
336 |
, Types.JOB_STATUS_ERROR |
337 |
] [minBound..maxBound] |
338 |
|
339 |
-- | Tests equivalence with Python, based on Constants.hs code. |
340 |
case_NICMode_pyequiv :: Assertion |
341 |
case_NICMode_pyequiv = do |
342 |
let all_py_codes = sort C.nicValidModes |
343 |
all_hs_codes = sort $ map Types.nICModeToRaw [minBound..maxBound] |
344 |
assertEqual "for NICMode equivalence" all_py_codes all_hs_codes |
345 |
|
346 |
-- | Test 'FinalizedJobStatus' serialisation. |
347 |
prop_FinalizedJobStatus_serialisation :: FinalizedJobStatus -> Property |
348 |
prop_FinalizedJobStatus_serialisation = testSerialisation |
349 |
|
350 |
-- | Tests equivalence with Python, based on Constants.hs code. |
351 |
case_FinalizedJobStatus_pyequiv :: Assertion |
352 |
case_FinalizedJobStatus_pyequiv = do |
353 |
let all_py_codes = sort C.jobsFinalized |
354 |
all_hs_codes = sort $ map Types.finalizedJobStatusToRaw |
355 |
[minBound..maxBound] |
356 |
assertEqual "for FinalizedJobStatus equivalence" all_py_codes all_hs_codes |
357 |
|
358 |
-- | Tests JobId serialisation (both from string and ints). |
359 |
prop_JobId_serialisation :: JobId -> Property |
360 |
prop_JobId_serialisation jid = |
361 |
conjoin [ testSerialisation jid |
362 |
, (J.readJSON . J.showJSON . show $ fromJobId jid) ==? J.Ok jid |
363 |
, case (fromJVal . J.showJSON . negate $ |
364 |
fromJobId jid)::Result JobId of |
365 |
Bad _ -> passTest |
366 |
Ok jid' -> failTest $ "Parsed negative job id as id " ++ |
367 |
show (fromJobId jid') |
368 |
] |
369 |
|
370 |
-- | Tests that fractional job IDs are not accepted. |
371 |
prop_JobId_fractional :: Property |
372 |
prop_JobId_fractional = |
373 |
forAll (arbitrary `suchThat` |
374 |
(\d -> fromIntegral (truncate d::Int) /= d)) $ \d -> |
375 |
case J.readJSON (J.showJSON (d::Double)) of |
376 |
J.Error _ -> passTest |
377 |
J.Ok jid -> failTest $ "Parsed fractional value " ++ show d ++ |
378 |
" as job id " ++ show (fromJobId jid) |
379 |
|
380 |
-- | Tests that a job ID is not parseable from \"bad\" JSON values. |
381 |
case_JobId_BadTypes :: Assertion |
382 |
case_JobId_BadTypes = do |
383 |
let helper jsval = case J.readJSON jsval of |
384 |
J.Error _ -> return () |
385 |
J.Ok jid -> assertFailure $ "Parsed " ++ show jsval |
386 |
++ " as job id " ++ show (fromJobId jid) |
387 |
helper J.JSNull |
388 |
helper (J.JSBool True) |
389 |
helper (J.JSBool False) |
390 |
helper (J.JSArray []) |
391 |
|
392 |
-- | Test 'JobDependency' serialisation. |
393 |
prop_JobDependency_serialisation :: JobDependency -> Property |
394 |
prop_JobDependency_serialisation = testSerialisation |
395 |
|
396 |
-- | Test 'OpSubmitPriority' serialisation. |
397 |
prop_OpSubmitPriority_serialisation :: OpSubmitPriority -> Property |
398 |
prop_OpSubmitPriority_serialisation = testSerialisation |
399 |
|
400 |
-- | Tests string formatting for 'OpSubmitPriority'. |
401 |
prop_OpSubmitPriority_string :: OpSubmitPriority -> Property |
402 |
prop_OpSubmitPriority_string prio = |
403 |
parseSubmitPriority (fmtSubmitPriority prio) ==? Just prio |
404 |
|
405 |
-- | Test 'ELogType' serialisation. |
406 |
prop_ELogType_serialisation :: ELogType -> Property |
407 |
prop_ELogType_serialisation = testSerialisation |
408 |
|
409 |
testSuite "Types" |
410 |
[ 'prop_AllocPolicy_serialisation |
411 |
, 'case_AllocPolicy_order |
412 |
, 'prop_DiskTemplate_serialisation |
413 |
, 'prop_InstanceStatus_serialisation |
414 |
, 'prop_NonNeg_pass |
415 |
, 'prop_NonNeg_fail |
416 |
, 'prop_Positive_pass |
417 |
, 'prop_Positive_fail |
418 |
, 'prop_Neg_pass |
419 |
, 'prop_Neg_fail |
420 |
, 'prop_NonEmpty_pass |
421 |
, 'case_NonEmpty_fail |
422 |
, 'prop_MigrationMode_serialisation |
423 |
, 'prop_VerifyOptionalChecks_serialisation |
424 |
, 'prop_DdmSimple_serialisation |
425 |
, 'prop_DdmFull_serialisation |
426 |
, 'prop_CVErrorCode_serialisation |
427 |
, 'case_CVErrorCode_pyequiv |
428 |
, 'prop_Hypervisor_serialisation |
429 |
, 'prop_OobCommand_serialisation |
430 |
, 'prop_StorageType_serialisation |
431 |
, 'prop_NodeEvacMode_serialisation |
432 |
, 'prop_FileDriver_serialisation |
433 |
, 'prop_InstCreateMode_serialisation |
434 |
, 'prop_RebootType_serialisation |
435 |
, 'prop_ExportMode_serialisation |
436 |
, 'prop_IAllocatorTestDir_serialisation |
437 |
, 'prop_IAllocatorMode_serialisation |
438 |
, 'case_IAllocatorMode_pyequiv |
439 |
, 'prop_NICMode_serialisation |
440 |
, 'prop_OpStatus_serialization |
441 |
, 'prop_JobStatus_serialization |
442 |
, 'case_JobStatus_order |
443 |
, 'case_NICMode_pyequiv |
444 |
, 'prop_FinalizedJobStatus_serialisation |
445 |
, 'case_FinalizedJobStatus_pyequiv |
446 |
, 'prop_JobId_serialisation |
447 |
, 'prop_JobId_fractional |
448 |
, 'case_JobId_BadTypes |
449 |
, 'prop_JobDependency_serialisation |
450 |
, 'prop_OpSubmitPriority_serialisation |
451 |
, 'prop_OpSubmitPriority_string |
452 |
, 'prop_ELogType_serialisation |
453 |
] |