code.grnet.gr Git - ganeti-local/blob - test/hs/Test/Ganeti/Types.hs

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