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 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 ''NetworkType)
 116
 117 $(genArbitrary ''NICMode)
 118
 119 $(genArbitrary ''JobStatus)
 120
 121 $(genArbitrary ''FinalizedJobStatus)
 122
 123 instance Arbitrary JobId where
 124   arbitrary = do
 125     (Positive i) <- arbitrary
 126     makeJobId i
 127
 128 $(genArbitrary ''JobIdDep)
 129
 130 $(genArbitrary ''JobDependency)
 131
 132 $(genArbitrary ''OpSubmitPriority)
 133
 134 $(genArbitrary ''OpStatus)
 135
 136 $(genArbitrary ''ELogType)
 137
 138 -- * Properties
 139
 140 prop_AllocPolicy_serialisation :: AllocPolicy -> Property
 141 prop_AllocPolicy_serialisation = testSerialisation
 142
 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]
 150
 151 prop_DiskTemplate_serialisation :: DiskTemplate -> Property
 152 prop_DiskTemplate_serialisation = testSerialisation
 153
 154 prop_InstanceStatus_serialisation :: InstanceStatus -> Property
 155 prop_InstanceStatus_serialisation = testSerialisation
 156
 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
 163
 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
 168     Bad _ -> passTest
 169     Ok nn -> failTest $ "Built non-negative number '" ++ show nn ++
 170              "' from negative value " ++ show i
 171
 172 -- | Tests building positive numbers.
 173 prop_Positive_pass :: QuickCheck.Positive Int -> Property
 174 prop_Positive_pass (QuickCheck.Positive i) =
 175   case mkPositive i of
 176     Bad msg -> failTest $ "Fail to build positive: " ++ msg
 177     Ok nn -> fromPositive nn ==? i
 178
 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
 183     Bad _ -> passTest
 184     Ok nn -> failTest $ "Built positive number '" ++ show nn ++
 185              "' from negative or zero value " ++ show i
 186
 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'
 193   where i' = negate i
 194
 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
 199     Bad _ -> passTest
 200     Ok nn -> failTest $ "Built negative number '" ++ show nn ++
 201              "' from non-negative value " ++ show i
 202
 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
 209
 210 -- | Tests building positive numbers.
 211 case_NonEmpty_fail :: Assertion
 212 case_NonEmpty_fail =
 213   assertEqual "building non-empty list from an empty list"
 214     (Bad "Received empty value for non-empty list") (mkNonEmpty ([]::[Int]))
 215
 216 -- | Tests migration mode serialisation.
 217 prop_MigrationMode_serialisation :: MigrationMode -> Property
 218 prop_MigrationMode_serialisation = testSerialisation
 219
 220 -- | Tests verify optional checks serialisation.
 221 prop_VerifyOptionalChecks_serialisation :: VerifyOptionalChecks -> Property
 222 prop_VerifyOptionalChecks_serialisation = testSerialisation
 223
 224 -- | Tests 'DdmSimple' serialisation.
 225 prop_DdmSimple_serialisation :: DdmSimple -> Property
 226 prop_DdmSimple_serialisation = testSerialisation
 227
 228 -- | Tests 'DdmFull' serialisation.
 229 prop_DdmFull_serialisation :: DdmFull -> Property
 230 prop_DdmFull_serialisation = testSerialisation
 231
 232 -- | Tests 'CVErrorCode' serialisation.
 233 prop_CVErrorCode_serialisation :: CVErrorCode -> Property
 234 prop_CVErrorCode_serialisation = testSerialisation
 235
 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
 242
 243 -- | Test 'Hypervisor' serialisation.
 244 prop_Hypervisor_serialisation :: Hypervisor -> Property
 245 prop_Hypervisor_serialisation = testSerialisation
 246
 247 -- | Test 'OobCommand' serialisation.
 248 prop_OobCommand_serialisation :: OobCommand -> Property
 249 prop_OobCommand_serialisation = testSerialisation
 250
 251 -- | Test 'StorageType' serialisation.
 252 prop_StorageType_serialisation :: StorageType -> Property
 253 prop_StorageType_serialisation = testSerialisation
 254
 255 -- | Test 'NodeEvacMode' serialisation.
 256 prop_NodeEvacMode_serialisation :: NodeEvacMode -> Property
 257 prop_NodeEvacMode_serialisation = testSerialisation
 258
 259 -- | Test 'FileDriver' serialisation.
 260 prop_FileDriver_serialisation :: FileDriver -> Property
 261 prop_FileDriver_serialisation = testSerialisation
 262
 263 -- | Test 'InstCreate' serialisation.
 264 prop_InstCreateMode_serialisation :: InstCreateMode -> Property
 265 prop_InstCreateMode_serialisation = testSerialisation
 266
 267 -- | Test 'RebootType' serialisation.
 268 prop_RebootType_serialisation :: RebootType -> Property
 269 prop_RebootType_serialisation = testSerialisation
 270
 271 -- | Test 'ExportMode' serialisation.
 272 prop_ExportMode_serialisation :: ExportMode -> Property
 273 prop_ExportMode_serialisation = testSerialisation
 274
 275 -- | Test 'IAllocatorTestDir' serialisation.
 276 prop_IAllocatorTestDir_serialisation :: IAllocatorTestDir -> Property
 277 prop_IAllocatorTestDir_serialisation = testSerialisation
 278
 279 -- | Test 'IAllocatorMode' serialisation.
 280 prop_IAllocatorMode_serialisation :: IAllocatorMode -> Property
 281 prop_IAllocatorMode_serialisation = testSerialisation
 282
 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
 289
 290 -- | Test 'NetworkType' serialisation.
 291 prop_NetworkType_serialisation :: NetworkType -> Property
 292 prop_NetworkType_serialisation = testSerialisation
 293
 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
 300
 301 -- | Test 'NICMode' serialisation.
 302 prop_NICMode_serialisation :: NICMode -> Property
 303 prop_NICMode_serialisation = testSerialisation
 304
 305 -- | Test 'OpStatus' serialisation.
 306 prop_OpStatus_serialization :: OpStatus -> Property
 307 prop_OpStatus_serialization = testSerialisation
 308
 309 -- | Test 'JobStatus' serialisation.
 310 prop_JobStatus_serialization :: JobStatus -> Property
 311 prop_JobStatus_serialization = testSerialisation
 312
 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]
 324
 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
 331
 332 -- | Test 'FinalizedJobStatus' serialisation.
 333 prop_FinalizedJobStatus_serialisation :: FinalizedJobStatus -> Property
 334 prop_FinalizedJobStatus_serialisation = testSerialisation
 335
 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
 341                             [minBound..maxBound]
 342   assertEqual "for FinalizedJobStatus equivalence" all_py_codes all_hs_codes
 343
 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
 351               Bad _ -> passTest
 352               Ok jid' -> failTest $ "Parsed negative job id as id " ++
 353                          show (fromJobId jid')
 354           ]
 355
 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)
 365
 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)
 373   helper J.JSNull
 374   helper (J.JSBool True)
 375   helper (J.JSBool False)
 376   helper (J.JSArray [])
 377
 378 -- | Test 'JobDependency' serialisation.
 379 prop_JobDependency_serialisation :: JobDependency -> Property
 380 prop_JobDependency_serialisation = testSerialisation
 381
 382 -- | Test 'OpSubmitPriority' serialisation.
 383 prop_OpSubmitPriority_serialisation :: OpSubmitPriority -> Property
 384 prop_OpSubmitPriority_serialisation = testSerialisation
 385
 386 -- | Test 'ELogType' serialisation.
 387 prop_ELogType_serialisation :: ELogType -> Property
 388 prop_ELogType_serialisation = testSerialisation
 389
 390 testSuite "Types"
 391   [ 'prop_AllocPolicy_serialisation
 392   , 'case_AllocPolicy_order
 393   , 'prop_DiskTemplate_serialisation
 394   , 'prop_InstanceStatus_serialisation
 395   , 'prop_NonNeg_pass
 396   , 'prop_NonNeg_fail
 397   , 'prop_Positive_pass
 398   , 'prop_Positive_fail
 399   , 'prop_Neg_pass
 400   , 'prop_Neg_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
 435   ]