Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / Types.hs @ 37fe56e0

History | View | Annotate | Download (13.9 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
  , InstanceStatus(..)
34
  , NonEmpty(..)
35
  , Hypervisor(..)
36
  , JobId(..)
37
  ) where
38

    
39
import Data.List (sort)
40
import Test.QuickCheck as QuickCheck hiding (Result)
41
import Test.HUnit
42
import qualified Text.JSON as J
43

    
44
import Test.Ganeti.TestHelper
45
import Test.Ganeti.TestCommon
46

    
47
import Ganeti.BasicTypes
48
import qualified Ganeti.Constants as C
49
import Ganeti.Types as Types
50
import Ganeti.JSON
51

    
52
{-# ANN module "HLint: ignore Use camelCase" #-}
53

    
54
-- * Arbitrary instance
55

    
56
instance (Arbitrary a, Ord a, Num a, Show a) =>
57
  Arbitrary (Types.Positive a) where
58
  arbitrary = do
59
    (QuickCheck.Positive i) <- arbitrary
60
    Types.mkPositive i
61

    
62
instance (Arbitrary a, Ord a, Num a, Show a) =>
63
  Arbitrary (Types.NonNegative a) where
64
  arbitrary = do
65
    (QuickCheck.NonNegative i) <- arbitrary
66
    Types.mkNonNegative i
67

    
68
instance (Arbitrary a, Ord a, Num a, Show a) =>
69
  Arbitrary (Types.Negative a) where
70
  arbitrary = do
71
    (QuickCheck.Positive i) <- arbitrary
72
    Types.mkNegative $ negate i
73

    
74
instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where
75
  arbitrary = do
76
    QuickCheck.NonEmpty lst <- arbitrary
77
    Types.mkNonEmpty lst
78

    
79
$(genArbitrary ''AllocPolicy)
80

    
81
$(genArbitrary ''DiskTemplate)
82

    
83
$(genArbitrary ''InstanceStatus)
84

    
85
$(genArbitrary ''MigrationMode)
86

    
87
$(genArbitrary ''VerifyOptionalChecks)
88

    
89
$(genArbitrary ''DdmSimple)
90

    
91
$(genArbitrary ''DdmFull)
92

    
93
$(genArbitrary ''CVErrorCode)
94

    
95
$(genArbitrary ''Hypervisor)
96

    
97
$(genArbitrary ''OobCommand)
98

    
99
$(genArbitrary ''StorageType)
100

    
101
$(genArbitrary ''NodeEvacMode)
102

    
103
$(genArbitrary ''FileDriver)
104

    
105
$(genArbitrary ''InstCreateMode)
106

    
107
$(genArbitrary ''RebootType)
108

    
109
$(genArbitrary ''ExportMode)
110

    
111
$(genArbitrary ''IAllocatorTestDir)
112

    
113
$(genArbitrary ''IAllocatorMode)
114

    
115
$(genArbitrary ''NICMode)
116

    
117
$(genArbitrary ''JobStatus)
118

    
119
$(genArbitrary ''FinalizedJobStatus)
120

    
121
instance Arbitrary JobId where
122
  arbitrary = do
123
    (Positive i) <- arbitrary
124
    makeJobId i
125

    
126
$(genArbitrary ''JobIdDep)
127

    
128
$(genArbitrary ''JobDependency)
129

    
130
$(genArbitrary ''OpSubmitPriority)
131

    
132
$(genArbitrary ''OpStatus)
133

    
134
$(genArbitrary ''ELogType)
135

    
136
-- * Properties
137

    
138
prop_AllocPolicy_serialisation :: AllocPolicy -> Property
139
prop_AllocPolicy_serialisation = testSerialisation
140

    
141
-- | Test 'AllocPolicy' ordering is as expected.
142
case_AllocPolicy_order :: Assertion
143
case_AllocPolicy_order =
144
  assertEqual "sort order" [ Types.AllocPreferred
145
                           , Types.AllocLastResort
146
                           , Types.AllocUnallocable
147
                           ] [minBound..maxBound]
148

    
149
prop_DiskTemplate_serialisation :: DiskTemplate -> Property
150
prop_DiskTemplate_serialisation = testSerialisation
151

    
152
prop_InstanceStatus_serialisation :: InstanceStatus -> Property
153
prop_InstanceStatus_serialisation = testSerialisation
154

    
155
-- | Tests building non-negative numbers.
156
prop_NonNeg_pass :: QuickCheck.NonNegative Int -> Property
157
prop_NonNeg_pass (QuickCheck.NonNegative i) =
158
  case mkNonNegative i of
159
    Bad msg -> failTest $ "Fail to build non-negative: " ++ msg
160
    Ok nn -> fromNonNegative nn ==? i
161

    
162
-- | Tests building non-negative numbers.
163
prop_NonNeg_fail :: QuickCheck.Positive Int -> Property
164
prop_NonNeg_fail (QuickCheck.Positive i) =
165
  case mkNonNegative (negate i)::Result (Types.NonNegative Int) of
166
    Bad _ -> passTest
167
    Ok nn -> failTest $ "Built non-negative number '" ++ show nn ++
168
             "' from negative value " ++ show i
169

    
170
-- | Tests building positive numbers.
171
prop_Positive_pass :: QuickCheck.Positive Int -> Property
172
prop_Positive_pass (QuickCheck.Positive i) =
173
  case mkPositive i of
174
    Bad msg -> failTest $ "Fail to build positive: " ++ msg
175
    Ok nn -> fromPositive nn ==? i
176

    
177
-- | Tests building positive numbers.
178
prop_Positive_fail :: QuickCheck.NonNegative Int -> Property
179
prop_Positive_fail (QuickCheck.NonNegative i) =
180
  case mkPositive (negate i)::Result (Types.Positive Int) of
181
    Bad _ -> passTest
182
    Ok nn -> failTest $ "Built positive number '" ++ show nn ++
183
             "' from negative or zero value " ++ show i
184

    
185
-- | Tests building negative numbers.
186
prop_Neg_pass :: QuickCheck.Positive Int -> Property
187
prop_Neg_pass (QuickCheck.Positive i) =
188
  case mkNegative i' of
189
    Bad msg -> failTest $ "Fail to build negative: " ++ msg
190
    Ok nn -> fromNegative nn ==? i'
191
  where i' = negate i
192

    
193
-- | Tests building negative numbers.
194
prop_Neg_fail :: QuickCheck.NonNegative Int -> Property
195
prop_Neg_fail (QuickCheck.NonNegative i) =
196
  case mkNegative i::Result (Types.Negative Int) of
197
    Bad _ -> passTest
198
    Ok nn -> failTest $ "Built negative number '" ++ show nn ++
199
             "' from non-negative value " ++ show i
200

    
201
-- | Tests building non-empty lists.
202
prop_NonEmpty_pass :: QuickCheck.NonEmptyList String -> Property
203
prop_NonEmpty_pass (QuickCheck.NonEmpty xs) =
204
  case mkNonEmpty xs of
205
    Bad msg -> failTest $ "Fail to build non-empty list: " ++ msg
206
    Ok nn -> fromNonEmpty nn ==? xs
207

    
208
-- | Tests building positive numbers.
209
case_NonEmpty_fail :: Assertion
210
case_NonEmpty_fail =
211
  assertEqual "building non-empty list from an empty list"
212
    (Bad "Received empty value for non-empty list") (mkNonEmpty ([]::[Int]))
213

    
214
-- | Tests migration mode serialisation.
215
prop_MigrationMode_serialisation :: MigrationMode -> Property
216
prop_MigrationMode_serialisation = testSerialisation
217

    
218
-- | Tests verify optional checks serialisation.
219
prop_VerifyOptionalChecks_serialisation :: VerifyOptionalChecks -> Property
220
prop_VerifyOptionalChecks_serialisation = testSerialisation
221

    
222
-- | Tests 'DdmSimple' serialisation.
223
prop_DdmSimple_serialisation :: DdmSimple -> Property
224
prop_DdmSimple_serialisation = testSerialisation
225

    
226
-- | Tests 'DdmFull' serialisation.
227
prop_DdmFull_serialisation :: DdmFull -> Property
228
prop_DdmFull_serialisation = testSerialisation
229

    
230
-- | Tests 'CVErrorCode' serialisation.
231
prop_CVErrorCode_serialisation :: CVErrorCode -> Property
232
prop_CVErrorCode_serialisation = testSerialisation
233

    
234
-- | Tests equivalence with Python, based on Constants.hs code.
235
case_CVErrorCode_pyequiv :: Assertion
236
case_CVErrorCode_pyequiv = do
237
  let all_py_codes = sort C.cvAllEcodesStrings
238
      all_hs_codes = sort $ map Types.cVErrorCodeToRaw [minBound..maxBound]
239
  assertEqual "for CVErrorCode equivalence" all_py_codes all_hs_codes
240

    
241
-- | Test 'Hypervisor' serialisation.
242
prop_Hypervisor_serialisation :: Hypervisor -> Property
243
prop_Hypervisor_serialisation = testSerialisation
244

    
245
-- | Test 'OobCommand' serialisation.
246
prop_OobCommand_serialisation :: OobCommand -> Property
247
prop_OobCommand_serialisation = testSerialisation
248

    
249
-- | Test 'StorageType' serialisation.
250
prop_StorageType_serialisation :: StorageType -> Property
251
prop_StorageType_serialisation = testSerialisation
252

    
253
-- | Test 'NodeEvacMode' serialisation.
254
prop_NodeEvacMode_serialisation :: NodeEvacMode -> Property
255
prop_NodeEvacMode_serialisation = testSerialisation
256

    
257
-- | Test 'FileDriver' serialisation.
258
prop_FileDriver_serialisation :: FileDriver -> Property
259
prop_FileDriver_serialisation = testSerialisation
260

    
261
-- | Test 'InstCreate' serialisation.
262
prop_InstCreateMode_serialisation :: InstCreateMode -> Property
263
prop_InstCreateMode_serialisation = testSerialisation
264

    
265
-- | Test 'RebootType' serialisation.
266
prop_RebootType_serialisation :: RebootType -> Property
267
prop_RebootType_serialisation = testSerialisation
268

    
269
-- | Test 'ExportMode' serialisation.
270
prop_ExportMode_serialisation :: ExportMode -> Property
271
prop_ExportMode_serialisation = testSerialisation
272

    
273
-- | Test 'IAllocatorTestDir' serialisation.
274
prop_IAllocatorTestDir_serialisation :: IAllocatorTestDir -> Property
275
prop_IAllocatorTestDir_serialisation = testSerialisation
276

    
277
-- | Test 'IAllocatorMode' serialisation.
278
prop_IAllocatorMode_serialisation :: IAllocatorMode -> Property
279
prop_IAllocatorMode_serialisation = testSerialisation
280

    
281
-- | Tests equivalence with Python, based on Constants.hs code.
282
case_IAllocatorMode_pyequiv :: Assertion
283
case_IAllocatorMode_pyequiv = do
284
  let all_py_codes = sort C.validIallocatorModes
285
      all_hs_codes = sort $ map Types.iAllocatorModeToRaw [minBound..maxBound]
286
  assertEqual "for IAllocatorMode equivalence" all_py_codes all_hs_codes
287

    
288
-- | Test 'NICMode' serialisation.
289
prop_NICMode_serialisation :: NICMode -> Property
290
prop_NICMode_serialisation = testSerialisation
291

    
292
-- | Test 'OpStatus' serialisation.
293
prop_OpStatus_serialization :: OpStatus -> Property
294
prop_OpStatus_serialization = testSerialisation
295

    
296
-- | Test 'JobStatus' serialisation.
297
prop_JobStatus_serialization :: JobStatus -> Property
298
prop_JobStatus_serialization = testSerialisation
299

    
300
-- | Test 'JobStatus' ordering is as expected.
301
case_JobStatus_order :: Assertion
302
case_JobStatus_order =
303
  assertEqual "sort order" [ Types.JOB_STATUS_QUEUED
304
                           , Types.JOB_STATUS_WAITING
305
                           , Types.JOB_STATUS_CANCELING
306
                           , Types.JOB_STATUS_RUNNING
307
                           , Types.JOB_STATUS_CANCELED
308
                           , Types.JOB_STATUS_SUCCESS
309
                           , Types.JOB_STATUS_ERROR
310
                           ] [minBound..maxBound]
311

    
312
-- | Tests equivalence with Python, based on Constants.hs code.
313
case_NICMode_pyequiv :: Assertion
314
case_NICMode_pyequiv = do
315
  let all_py_codes = sort C.nicValidModes
316
      all_hs_codes = sort $ map Types.nICModeToRaw [minBound..maxBound]
317
  assertEqual "for NICMode equivalence" all_py_codes all_hs_codes
318

    
319
-- | Test 'FinalizedJobStatus' serialisation.
320
prop_FinalizedJobStatus_serialisation :: FinalizedJobStatus -> Property
321
prop_FinalizedJobStatus_serialisation = testSerialisation
322

    
323
-- | Tests equivalence with Python, based on Constants.hs code.
324
case_FinalizedJobStatus_pyequiv :: Assertion
325
case_FinalizedJobStatus_pyequiv = do
326
  let all_py_codes = sort C.jobsFinalized
327
      all_hs_codes = sort $ map Types.finalizedJobStatusToRaw
328
                            [minBound..maxBound]
329
  assertEqual "for FinalizedJobStatus equivalence" all_py_codes all_hs_codes
330

    
331
-- | Tests JobId serialisation (both from string and ints).
332
prop_JobId_serialisation :: JobId -> Property
333
prop_JobId_serialisation jid =
334
  conjoin [ testSerialisation jid
335
          , (J.readJSON . J.showJSON . show $ fromJobId jid) ==? J.Ok jid
336
          , case (fromJVal . J.showJSON . negate $
337
                  fromJobId jid)::Result JobId of
338
              Bad _ -> passTest
339
              Ok jid' -> failTest $ "Parsed negative job id as id " ++
340
                         show (fromJobId jid')
341
          ]
342

    
343
-- | Tests that fractional job IDs are not accepted.
344
prop_JobId_fractional :: Property
345
prop_JobId_fractional =
346
  forAll (arbitrary `suchThat`
347
          (\d -> fromIntegral (truncate d::Int) /= d)) $ \d ->
348
  case J.readJSON (J.showJSON (d::Double)) of
349
    J.Error _ -> passTest
350
    J.Ok jid -> failTest $ "Parsed fractional value " ++ show d ++
351
                " as job id " ++ show (fromJobId jid)
352

    
353
-- | Tests that a job ID is not parseable from \"bad\" JSON values.
354
case_JobId_BadTypes :: Assertion
355
case_JobId_BadTypes = do
356
  let helper jsval = case J.readJSON jsval of
357
                       J.Error _ -> return ()
358
                       J.Ok jid -> assertFailure $ "Parsed " ++ show jsval
359
                                   ++ " as job id " ++ show (fromJobId jid)
360
  helper J.JSNull
361
  helper (J.JSBool True)
362
  helper (J.JSBool False)
363
  helper (J.JSArray [])
364

    
365
-- | Test 'JobDependency' serialisation.
366
prop_JobDependency_serialisation :: JobDependency -> Property
367
prop_JobDependency_serialisation = testSerialisation
368

    
369
-- | Test 'OpSubmitPriority' serialisation.
370
prop_OpSubmitPriority_serialisation :: OpSubmitPriority -> Property
371
prop_OpSubmitPriority_serialisation = testSerialisation
372

    
373
-- | Tests string formatting for 'OpSubmitPriority'.
374
prop_OpSubmitPriority_string :: OpSubmitPriority -> Property
375
prop_OpSubmitPriority_string prio =
376
  parseSubmitPriority (fmtSubmitPriority prio) ==? Just prio
377

    
378
-- | Test 'ELogType' serialisation.
379
prop_ELogType_serialisation :: ELogType -> Property
380
prop_ELogType_serialisation = testSerialisation
381

    
382
testSuite "Types"
383
  [ 'prop_AllocPolicy_serialisation
384
  , 'case_AllocPolicy_order
385
  , 'prop_DiskTemplate_serialisation
386
  , 'prop_InstanceStatus_serialisation
387
  , 'prop_NonNeg_pass
388
  , 'prop_NonNeg_fail
389
  , 'prop_Positive_pass
390
  , 'prop_Positive_fail
391
  , 'prop_Neg_pass
392
  , 'prop_Neg_fail
393
  , 'prop_NonEmpty_pass
394
  , 'case_NonEmpty_fail
395
  , 'prop_MigrationMode_serialisation
396
  , 'prop_VerifyOptionalChecks_serialisation
397
  , 'prop_DdmSimple_serialisation
398
  , 'prop_DdmFull_serialisation
399
  , 'prop_CVErrorCode_serialisation
400
  , 'case_CVErrorCode_pyequiv
401
  , 'prop_Hypervisor_serialisation
402
  , 'prop_OobCommand_serialisation
403
  , 'prop_StorageType_serialisation
404
  , 'prop_NodeEvacMode_serialisation
405
  , 'prop_FileDriver_serialisation
406
  , 'prop_InstCreateMode_serialisation
407
  , 'prop_RebootType_serialisation
408
  , 'prop_ExportMode_serialisation
409
  , 'prop_IAllocatorTestDir_serialisation
410
  , 'prop_IAllocatorMode_serialisation
411
  , 'case_IAllocatorMode_pyequiv
412
  , 'prop_NICMode_serialisation
413
  , 'prop_OpStatus_serialization
414
  , 'prop_JobStatus_serialization
415
  , 'case_JobStatus_order
416
  , 'case_NICMode_pyequiv
417
  , 'prop_FinalizedJobStatus_serialisation
418
  , 'case_FinalizedJobStatus_pyequiv
419
  , 'prop_JobId_serialisation
420
  , 'prop_JobId_fractional
421
  , 'case_JobId_BadTypes
422
  , 'prop_JobDependency_serialisation
423
  , 'prop_OpSubmitPriority_serialisation
424
  , 'prop_OpSubmitPriority_string
425
  , 'prop_ELogType_serialisation
426
  ]