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 ''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 -- | Test 'ELogType' serialisation.
 374 prop_ELogType_serialisation :: ELogType -> Property
 375 prop_ELogType_serialisation = testSerialisation
 376
 377 testSuite "Types"
 378   [ 'prop_AllocPolicy_serialisation
 379   , 'case_AllocPolicy_order
 380   , 'prop_DiskTemplate_serialisation
 381   , 'prop_InstanceStatus_serialisation
 382   , 'prop_NonNeg_pass
 383   , 'prop_NonNeg_fail
 384   , 'prop_Positive_pass
 385   , 'prop_Positive_fail
 386   , 'prop_Neg_pass
 387   , 'prop_Neg_fail
 388   , 'prop_NonEmpty_pass
 389   , 'case_NonEmpty_fail
 390   , 'prop_MigrationMode_serialisation
 391   , 'prop_VerifyOptionalChecks_serialisation
 392   , 'prop_DdmSimple_serialisation
 393   , 'prop_DdmFull_serialisation
 394   , 'prop_CVErrorCode_serialisation
 395   , 'case_CVErrorCode_pyequiv
 396   , 'prop_Hypervisor_serialisation
 397   , 'prop_OobCommand_serialisation
 398   , 'prop_StorageType_serialisation
 399   , 'prop_NodeEvacMode_serialisation
 400   , 'prop_FileDriver_serialisation
 401   , 'prop_InstCreateMode_serialisation
 402   , 'prop_RebootType_serialisation
 403   , 'prop_ExportMode_serialisation
 404   , 'prop_IAllocatorTestDir_serialisation
 405   , 'prop_IAllocatorMode_serialisation
 406   , 'case_IAllocatorMode_pyequiv
 407   , 'prop_NICMode_serialisation
 408   , 'prop_OpStatus_serialization
 409   , 'prop_JobStatus_serialization
 410   , 'case_JobStatus_order
 411   , 'case_NICMode_pyequiv
 412   , 'prop_FinalizedJobStatus_serialisation
 413   , 'case_FinalizedJobStatus_pyequiv
 414   , 'prop_JobId_serialisation
 415   , 'prop_JobId_fractional
 416   , 'case_JobId_BadTypes
 417   , 'prop_JobDependency_serialisation
 418   , 'prop_OpSubmitPriority_serialisation
 419   , 'prop_ELogType_serialisation
 420   ]