Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / Types.hs @ 3cbd5808

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
  ]