1 {-# LANGUAGE TemplateHaskell #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
4 {-| Unittests for 'Ganeti.Types'.
10 Copyright (C) 2012 Google Inc.
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.
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.
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
29 module Test.Ganeti.Types
39 import Data.List (sort)
40 import Test.QuickCheck as QuickCheck hiding (Result)
42 import qualified Text.JSON as J
44 import Test.Ganeti.TestHelper
45 import Test.Ganeti.TestCommon
47 import Ganeti.BasicTypes
48 import qualified Ganeti.Constants as C
49 import Ganeti.Types as Types
52 {-# ANN module "HLint: ignore Use camelCase" #-}
54 -- * Arbitrary instance
56 instance (Arbitrary a, Ord a, Num a, Show a) =>
57 Arbitrary (Types.Positive a) where
59 (QuickCheck.Positive i) <- arbitrary
62 instance (Arbitrary a, Ord a, Num a, Show a) =>
63 Arbitrary (Types.NonNegative a) where
65 (QuickCheck.NonNegative i) <- arbitrary
68 instance (Arbitrary a, Ord a, Num a, Show a) =>
69 Arbitrary (Types.Negative a) where
71 (QuickCheck.Positive i) <- arbitrary
72 Types.mkNegative $ negate i
74 instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where
76 QuickCheck.NonEmpty lst <- arbitrary
79 $(genArbitrary ''AllocPolicy)
81 $(genArbitrary ''DiskTemplate)
83 $(genArbitrary ''InstanceStatus)
85 $(genArbitrary ''MigrationMode)
87 $(genArbitrary ''VerifyOptionalChecks)
89 $(genArbitrary ''DdmSimple)
91 $(genArbitrary ''DdmFull)
93 $(genArbitrary ''CVErrorCode)
95 $(genArbitrary ''Hypervisor)
97 $(genArbitrary ''OobCommand)
99 $(genArbitrary ''StorageType)
101 $(genArbitrary ''NodeEvacMode)
103 $(genArbitrary ''FileDriver)
105 $(genArbitrary ''InstCreateMode)
107 $(genArbitrary ''RebootType)
109 $(genArbitrary ''ExportMode)
111 $(genArbitrary ''IAllocatorTestDir)
113 $(genArbitrary ''IAllocatorMode)
115 $(genArbitrary ''NetworkType)
117 $(genArbitrary ''NICMode)
119 $(genArbitrary ''JobStatus)
121 $(genArbitrary ''FinalizedJobStatus)
123 instance Arbitrary JobId where
125 (Positive i) <- arbitrary
128 $(genArbitrary ''JobIdDep)
130 $(genArbitrary ''JobDependency)
132 $(genArbitrary ''OpSubmitPriority)
134 $(genArbitrary ''OpStatus)
136 $(genArbitrary ''ELogType)
140 prop_AllocPolicy_serialisation :: AllocPolicy -> Property
141 prop_AllocPolicy_serialisation = testSerialisation
143 -- | Test 'AllocPolicy' ordering is as expected.
144 case_AllocPolicy_order :: Assertion
145 case_AllocPolicy_order =
146 assertEqual "sort order" [ Types.AllocPreferred
147 , Types.AllocLastResort
148 , Types.AllocUnallocable
149 ] [minBound..maxBound]
151 prop_DiskTemplate_serialisation :: DiskTemplate -> Property
152 prop_DiskTemplate_serialisation = testSerialisation
154 prop_InstanceStatus_serialisation :: InstanceStatus -> Property
155 prop_InstanceStatus_serialisation = testSerialisation
157 -- | Tests building non-negative numbers.
158 prop_NonNeg_pass :: QuickCheck.NonNegative Int -> Property
159 prop_NonNeg_pass (QuickCheck.NonNegative i) =
160 case mkNonNegative i of
161 Bad msg -> failTest $ "Fail to build non-negative: " ++ msg
162 Ok nn -> fromNonNegative nn ==? i
164 -- | Tests building non-negative numbers.
165 prop_NonNeg_fail :: QuickCheck.Positive Int -> Property
166 prop_NonNeg_fail (QuickCheck.Positive i) =
167 case mkNonNegative (negate i)::Result (Types.NonNegative Int) of
169 Ok nn -> failTest $ "Built non-negative number '" ++ show nn ++
170 "' from negative value " ++ show i
172 -- | Tests building positive numbers.
173 prop_Positive_pass :: QuickCheck.Positive Int -> Property
174 prop_Positive_pass (QuickCheck.Positive i) =
176 Bad msg -> failTest $ "Fail to build positive: " ++ msg
177 Ok nn -> fromPositive nn ==? i
179 -- | Tests building positive numbers.
180 prop_Positive_fail :: QuickCheck.NonNegative Int -> Property
181 prop_Positive_fail (QuickCheck.NonNegative i) =
182 case mkPositive (negate i)::Result (Types.Positive Int) of
184 Ok nn -> failTest $ "Built positive number '" ++ show nn ++
185 "' from negative or zero value " ++ show i
187 -- | Tests building negative numbers.
188 prop_Neg_pass :: QuickCheck.Positive Int -> Property
189 prop_Neg_pass (QuickCheck.Positive i) =
190 case mkNegative i' of
191 Bad msg -> failTest $ "Fail to build negative: " ++ msg
192 Ok nn -> fromNegative nn ==? i'
195 -- | Tests building negative numbers.
196 prop_Neg_fail :: QuickCheck.NonNegative Int -> Property
197 prop_Neg_fail (QuickCheck.NonNegative i) =
198 case mkNegative i::Result (Types.Negative Int) of
200 Ok nn -> failTest $ "Built negative number '" ++ show nn ++
201 "' from non-negative value " ++ show i
203 -- | Tests building non-empty lists.
204 prop_NonEmpty_pass :: QuickCheck.NonEmptyList String -> Property
205 prop_NonEmpty_pass (QuickCheck.NonEmpty xs) =
206 case mkNonEmpty xs of
207 Bad msg -> failTest $ "Fail to build non-empty list: " ++ msg
208 Ok nn -> fromNonEmpty nn ==? xs
210 -- | Tests building positive numbers.
211 case_NonEmpty_fail :: Assertion
213 assertEqual "building non-empty list from an empty list"
214 (Bad "Received empty value for non-empty list") (mkNonEmpty ([]::[Int]))
216 -- | Tests migration mode serialisation.
217 prop_MigrationMode_serialisation :: MigrationMode -> Property
218 prop_MigrationMode_serialisation = testSerialisation
220 -- | Tests verify optional checks serialisation.
221 prop_VerifyOptionalChecks_serialisation :: VerifyOptionalChecks -> Property
222 prop_VerifyOptionalChecks_serialisation = testSerialisation
224 -- | Tests 'DdmSimple' serialisation.
225 prop_DdmSimple_serialisation :: DdmSimple -> Property
226 prop_DdmSimple_serialisation = testSerialisation
228 -- | Tests 'DdmFull' serialisation.
229 prop_DdmFull_serialisation :: DdmFull -> Property
230 prop_DdmFull_serialisation = testSerialisation
232 -- | Tests 'CVErrorCode' serialisation.
233 prop_CVErrorCode_serialisation :: CVErrorCode -> Property
234 prop_CVErrorCode_serialisation = testSerialisation
236 -- | Tests equivalence with Python, based on Constants.hs code.
237 case_CVErrorCode_pyequiv :: Assertion
238 case_CVErrorCode_pyequiv = do
239 let all_py_codes = sort C.cvAllEcodesStrings
240 all_hs_codes = sort $ map Types.cVErrorCodeToRaw [minBound..maxBound]
241 assertEqual "for CVErrorCode equivalence" all_py_codes all_hs_codes
243 -- | Test 'Hypervisor' serialisation.
244 prop_Hypervisor_serialisation :: Hypervisor -> Property
245 prop_Hypervisor_serialisation = testSerialisation
247 -- | Test 'OobCommand' serialisation.
248 prop_OobCommand_serialisation :: OobCommand -> Property
249 prop_OobCommand_serialisation = testSerialisation
251 -- | Test 'StorageType' serialisation.
252 prop_StorageType_serialisation :: StorageType -> Property
253 prop_StorageType_serialisation = testSerialisation
255 -- | Test 'NodeEvacMode' serialisation.
256 prop_NodeEvacMode_serialisation :: NodeEvacMode -> Property
257 prop_NodeEvacMode_serialisation = testSerialisation
259 -- | Test 'FileDriver' serialisation.
260 prop_FileDriver_serialisation :: FileDriver -> Property
261 prop_FileDriver_serialisation = testSerialisation
263 -- | Test 'InstCreate' serialisation.
264 prop_InstCreateMode_serialisation :: InstCreateMode -> Property
265 prop_InstCreateMode_serialisation = testSerialisation
267 -- | Test 'RebootType' serialisation.
268 prop_RebootType_serialisation :: RebootType -> Property
269 prop_RebootType_serialisation = testSerialisation
271 -- | Test 'ExportMode' serialisation.
272 prop_ExportMode_serialisation :: ExportMode -> Property
273 prop_ExportMode_serialisation = testSerialisation
275 -- | Test 'IAllocatorTestDir' serialisation.
276 prop_IAllocatorTestDir_serialisation :: IAllocatorTestDir -> Property
277 prop_IAllocatorTestDir_serialisation = testSerialisation
279 -- | Test 'IAllocatorMode' serialisation.
280 prop_IAllocatorMode_serialisation :: IAllocatorMode -> Property
281 prop_IAllocatorMode_serialisation = testSerialisation
283 -- | Tests equivalence with Python, based on Constants.hs code.
284 case_IAllocatorMode_pyequiv :: Assertion
285 case_IAllocatorMode_pyequiv = do
286 let all_py_codes = sort C.validIallocatorModes
287 all_hs_codes = sort $ map Types.iAllocatorModeToRaw [minBound..maxBound]
288 assertEqual "for IAllocatorMode equivalence" all_py_codes all_hs_codes
290 -- | Test 'NetworkType' serialisation.
291 prop_NetworkType_serialisation :: NetworkType -> Property
292 prop_NetworkType_serialisation = testSerialisation
294 -- | Tests equivalence with Python, based on Constants.hs code.
295 case_NetworkType_pyequiv :: Assertion
296 case_NetworkType_pyequiv = do
297 let all_py_codes = sort C.networkValidTypes
298 all_hs_codes = sort $ map Types.networkTypeToRaw [minBound..maxBound]
299 assertEqual "for NetworkType equivalence" all_py_codes all_hs_codes
301 -- | Test 'NICMode' serialisation.
302 prop_NICMode_serialisation :: NICMode -> Property
303 prop_NICMode_serialisation = testSerialisation
305 -- | Test 'OpStatus' serialisation.
306 prop_OpStatus_serialization :: OpStatus -> Property
307 prop_OpStatus_serialization = testSerialisation
309 -- | Test 'JobStatus' serialisation.
310 prop_JobStatus_serialization :: JobStatus -> Property
311 prop_JobStatus_serialization = testSerialisation
313 -- | Test 'JobStatus' ordering is as expected.
314 case_JobStatus_order :: Assertion
315 case_JobStatus_order =
316 assertEqual "sort order" [ Types.JOB_STATUS_QUEUED
317 , Types.JOB_STATUS_WAITING
318 , Types.JOB_STATUS_CANCELING
319 , Types.JOB_STATUS_RUNNING
320 , Types.JOB_STATUS_CANCELED
321 , Types.JOB_STATUS_SUCCESS
322 , Types.JOB_STATUS_ERROR
323 ] [minBound..maxBound]
325 -- | Tests equivalence with Python, based on Constants.hs code.
326 case_NICMode_pyequiv :: Assertion
327 case_NICMode_pyequiv = do
328 let all_py_codes = sort C.nicValidModes
329 all_hs_codes = sort $ map Types.nICModeToRaw [minBound..maxBound]
330 assertEqual "for NICMode equivalence" all_py_codes all_hs_codes
332 -- | Test 'FinalizedJobStatus' serialisation.
333 prop_FinalizedJobStatus_serialisation :: FinalizedJobStatus -> Property
334 prop_FinalizedJobStatus_serialisation = testSerialisation
336 -- | Tests equivalence with Python, based on Constants.hs code.
337 case_FinalizedJobStatus_pyequiv :: Assertion
338 case_FinalizedJobStatus_pyequiv = do
339 let all_py_codes = sort C.jobsFinalized
340 all_hs_codes = sort $ map Types.finalizedJobStatusToRaw
342 assertEqual "for FinalizedJobStatus equivalence" all_py_codes all_hs_codes
344 -- | Tests JobId serialisation (both from string and ints).
345 prop_JobId_serialisation :: JobId -> Property
346 prop_JobId_serialisation jid =
347 conjoin [ testSerialisation jid
348 , (J.readJSON . J.showJSON . show $ fromJobId jid) ==? J.Ok jid
349 , case (fromJVal . J.showJSON . negate $
350 fromJobId jid)::Result JobId of
352 Ok jid' -> failTest $ "Parsed negative job id as id " ++
353 show (fromJobId jid')
356 -- | Tests that fractional job IDs are not accepted.
357 prop_JobId_fractional :: Property
358 prop_JobId_fractional =
359 forAll (arbitrary `suchThat`
360 (\d -> fromIntegral (truncate d::Int) /= d)) $ \d ->
361 case J.readJSON (J.showJSON (d::Double)) of
362 J.Error _ -> passTest
363 J.Ok jid -> failTest $ "Parsed fractional value " ++ show d ++
364 " as job id " ++ show (fromJobId jid)
366 -- | Tests that a job ID is not parseable from \"bad\" JSON values.
367 case_JobId_BadTypes :: Assertion
368 case_JobId_BadTypes = do
369 let helper jsval = case J.readJSON jsval of
370 J.Error _ -> return ()
371 J.Ok jid -> assertFailure $ "Parsed " ++ show jsval
372 ++ " as job id " ++ show (fromJobId jid)
374 helper (J.JSBool True)
375 helper (J.JSBool False)
376 helper (J.JSArray [])
378 -- | Test 'JobDependency' serialisation.
379 prop_JobDependency_serialisation :: JobDependency -> Property
380 prop_JobDependency_serialisation = testSerialisation
382 -- | Test 'OpSubmitPriority' serialisation.
383 prop_OpSubmitPriority_serialisation :: OpSubmitPriority -> Property
384 prop_OpSubmitPriority_serialisation = testSerialisation
386 -- | Test 'ELogType' serialisation.
387 prop_ELogType_serialisation :: ELogType -> Property
388 prop_ELogType_serialisation = testSerialisation
391 [ 'prop_AllocPolicy_serialisation
392 , 'case_AllocPolicy_order
393 , 'prop_DiskTemplate_serialisation
394 , 'prop_InstanceStatus_serialisation
397 , 'prop_Positive_pass
398 , 'prop_Positive_fail
401 , 'prop_NonEmpty_pass
402 , 'case_NonEmpty_fail
403 , 'prop_MigrationMode_serialisation
404 , 'prop_VerifyOptionalChecks_serialisation
405 , 'prop_DdmSimple_serialisation
406 , 'prop_DdmFull_serialisation
407 , 'prop_CVErrorCode_serialisation
408 , 'case_CVErrorCode_pyequiv
409 , 'prop_Hypervisor_serialisation
410 , 'prop_OobCommand_serialisation
411 , 'prop_StorageType_serialisation
412 , 'prop_NodeEvacMode_serialisation
413 , 'prop_FileDriver_serialisation
414 , 'prop_InstCreateMode_serialisation
415 , 'prop_RebootType_serialisation
416 , 'prop_ExportMode_serialisation
417 , 'prop_IAllocatorTestDir_serialisation
418 , 'prop_IAllocatorMode_serialisation
419 , 'case_IAllocatorMode_pyequiv
420 , 'prop_NetworkType_serialisation
421 , 'case_NetworkType_pyequiv
422 , 'prop_NICMode_serialisation
423 , 'prop_OpStatus_serialization
424 , 'prop_JobStatus_serialization
425 , 'case_JobStatus_order
426 , 'case_NICMode_pyequiv
427 , 'prop_FinalizedJobStatus_serialisation
428 , 'case_FinalizedJobStatus_pyequiv
429 , 'prop_JobId_serialisation
430 , 'prop_JobId_fractional
431 , 'case_JobId_BadTypes
432 , 'prop_JobDependency_serialisation
433 , 'prop_OpSubmitPriority_serialisation
434 , 'prop_ELogType_serialisation