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 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   ]