Synnefo » snf-ganeti

{-# LANGUAGE TemplateHaskell #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-| Unittests for 'Ganeti.Types'.

-}

{-

Copyright (C) 2012, 2013 Google Inc.

This program is free software; you can redistribute it and/or modify

it under the terms of the GNU General Public License as published by

the Free Software Foundation; either version 2 of the License, or

(at your option) any later version.

This program is distributed in the hope that it will be useful, but

WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

General Public License for more details.

You should have received a copy of the GNU General Public License

along with this program; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA

02110-1301, USA.

-}

module Test.Ganeti.Types

  ( testTypes

  , AllocPolicy(..)

  , DiskTemplate(..)

  , allDiskTemplates

  , InstanceStatus(..)

  , NonEmpty(..)

  , Hypervisor(..)

  , JobId(..)

  ) where

import Data.List (delete, sort)

import Test.QuickCheck as QuickCheck hiding (Result)

import Test.HUnit

import qualified Text.JSON as J

import Test.Ganeti.TestHelper

import Test.Ganeti.TestCommon

import Ganeti.BasicTypes

import qualified Ganeti.Constants as C

import Ganeti.Types as Types

import Ganeti.JSON

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

-- * Arbitrary instance

instance (Arbitrary a, Ord a, Num a, Show a) =>

  Arbitrary (Types.Positive a) where

  arbitrary = do

    (QuickCheck.Positive i) <- arbitrary

    Types.mkPositive i

instance (Arbitrary a, Ord a, Num a, Show a) =>

  Arbitrary (Types.NonNegative a) where

  arbitrary = do

    (QuickCheck.NonNegative i) <- arbitrary

    Types.mkNonNegative i

instance (Arbitrary a, Ord a, Num a, Show a) =>

  Arbitrary (Types.Negative a) where

  arbitrary = do

    (QuickCheck.Positive i) <- arbitrary

    Types.mkNegative $ negate i

instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where

  arbitrary = do

    QuickCheck.NonEmpty lst <- arbitrary

    Types.mkNonEmpty lst

$(genArbitrary ''AllocPolicy)

-- | Valid disk templates (depending on configure options).

allDiskTemplates :: [DiskTemplate]

allDiskTemplates =

  let all_vals = [minBound..maxBound]::[DiskTemplate]

      sel1 = if C.enableFileStorage

               then all_vals

               else delete DTFile all_vals

      sel2 = if C.enableSharedFileStorage

               then sel1

               else delete DTSharedFile sel1

  in sel2

-- | Custom 'Arbitrary' instance for 'DiskTemplate', which needs to

-- handle the case of file storage being disabled at configure time.

instance Arbitrary DiskTemplate where

  arbitrary = elements allDiskTemplates

$(genArbitrary ''InstanceStatus)

$(genArbitrary ''MigrationMode)

$(genArbitrary ''VerifyOptionalChecks)

$(genArbitrary ''DdmSimple)

$(genArbitrary ''DdmFull)

$(genArbitrary ''CVErrorCode)

$(genArbitrary ''Hypervisor)

$(genArbitrary ''OobCommand)

-- | Valid storage types.

allStorageTypes :: [StorageType]

allStorageTypes =

  let all_vals = [minBound..maxBound]::[StorageType]

  in if C.enableFileStorage

       then all_vals

       else delete StorageFile all_vals

-- | Custom 'Arbitrary' instance for 'StorageType', which needs to

-- handle the case of file storage being disabled at configure time.

instance Arbitrary StorageType where

  arbitrary = elements allStorageTypes

$(genArbitrary ''NodeEvacMode)

$(genArbitrary ''FileDriver)

$(genArbitrary ''InstCreateMode)

$(genArbitrary ''RebootType)

$(genArbitrary ''ExportMode)

$(genArbitrary ''IAllocatorTestDir)

$(genArbitrary ''IAllocatorMode)

$(genArbitrary ''NICMode)

$(genArbitrary ''JobStatus)

$(genArbitrary ''FinalizedJobStatus)

instance Arbitrary JobId where

  arbitrary = do

    (Positive i) <- arbitrary

    makeJobId i

$(genArbitrary ''JobIdDep)

$(genArbitrary ''JobDependency)

$(genArbitrary ''OpSubmitPriority)

$(genArbitrary ''OpStatus)

$(genArbitrary ''ELogType)

-- * Properties

prop_AllocPolicy_serialisation :: AllocPolicy -> Property

prop_AllocPolicy_serialisation = testSerialisation

-- | Test 'AllocPolicy' ordering is as expected.

case_AllocPolicy_order :: Assertion

case_AllocPolicy_order =

  assertEqual "sort order" [ Types.AllocPreferred

                           , Types.AllocLastResort

                           , Types.AllocUnallocable

                           ] [minBound..maxBound]

prop_DiskTemplate_serialisation :: DiskTemplate -> Property

prop_DiskTemplate_serialisation = testSerialisation

prop_InstanceStatus_serialisation :: InstanceStatus -> Property

prop_InstanceStatus_serialisation = testSerialisation

-- | Tests building non-negative numbers.

prop_NonNeg_pass :: QuickCheck.NonNegative Int -> Property

prop_NonNeg_pass (QuickCheck.NonNegative i) =

  case mkNonNegative i of

    Bad msg -> failTest $ "Fail to build non-negative: " ++ msg

    Ok nn -> fromNonNegative nn ==? i

-- | Tests building non-negative numbers.

prop_NonNeg_fail :: QuickCheck.Positive Int -> Property

prop_NonNeg_fail (QuickCheck.Positive i) =

  case mkNonNegative (negate i)::Result (Types.NonNegative Int) of

    Bad _ -> passTest

    Ok nn -> failTest $ "Built non-negative number '" ++ show nn ++

             "' from negative value " ++ show i

-- | Tests building positive numbers.

prop_Positive_pass :: QuickCheck.Positive Int -> Property

prop_Positive_pass (QuickCheck.Positive i) =

  case mkPositive i of

    Bad msg -> failTest $ "Fail to build positive: " ++ msg

    Ok nn -> fromPositive nn ==? i

-- | Tests building positive numbers.

prop_Positive_fail :: QuickCheck.NonNegative Int -> Property

prop_Positive_fail (QuickCheck.NonNegative i) =

  case mkPositive (negate i)::Result (Types.Positive Int) of

    Bad _ -> passTest

    Ok nn -> failTest $ "Built positive number '" ++ show nn ++

             "' from negative or zero value " ++ show i

-- | Tests building negative numbers.

prop_Neg_pass :: QuickCheck.Positive Int -> Property

prop_Neg_pass (QuickCheck.Positive i) =

  case mkNegative i' of

    Bad msg -> failTest $ "Fail to build negative: " ++ msg

    Ok nn -> fromNegative nn ==? i'

  where i' = negate i

-- | Tests building negative numbers.

prop_Neg_fail :: QuickCheck.NonNegative Int -> Property

prop_Neg_fail (QuickCheck.NonNegative i) =

  case mkNegative i::Result (Types.Negative Int) of

    Bad _ -> passTest

    Ok nn -> failTest $ "Built negative number '" ++ show nn ++

             "' from non-negative value " ++ show i

-- | Tests building non-empty lists.

prop_NonEmpty_pass :: QuickCheck.NonEmptyList String -> Property

prop_NonEmpty_pass (QuickCheck.NonEmpty xs) =

  case mkNonEmpty xs of

    Bad msg -> failTest $ "Fail to build non-empty list: " ++ msg

    Ok nn -> fromNonEmpty nn ==? xs

-- | Tests building positive numbers.

case_NonEmpty_fail :: Assertion

case_NonEmpty_fail =

  assertEqual "building non-empty list from an empty list"

    (Bad "Received empty value for non-empty list") (mkNonEmpty ([]::[Int]))

-- | Tests migration mode serialisation.

prop_MigrationMode_serialisation :: MigrationMode -> Property

prop_MigrationMode_serialisation = testSerialisation

-- | Tests verify optional checks serialisation.

prop_VerifyOptionalChecks_serialisation :: VerifyOptionalChecks -> Property

prop_VerifyOptionalChecks_serialisation = testSerialisation

-- | Tests 'DdmSimple' serialisation.

prop_DdmSimple_serialisation :: DdmSimple -> Property

prop_DdmSimple_serialisation = testSerialisation

-- | Tests 'DdmFull' serialisation.

prop_DdmFull_serialisation :: DdmFull -> Property

prop_DdmFull_serialisation = testSerialisation

-- | Tests 'CVErrorCode' serialisation.

prop_CVErrorCode_serialisation :: CVErrorCode -> Property

prop_CVErrorCode_serialisation = testSerialisation

-- | Tests equivalence with Python, based on Constants.hs code.

case_CVErrorCode_pyequiv :: Assertion

case_CVErrorCode_pyequiv = do

  let all_py_codes = sort C.cvAllEcodesStrings

      all_hs_codes = sort $ map Types.cVErrorCodeToRaw [minBound..maxBound]

  assertEqual "for CVErrorCode equivalence" all_py_codes all_hs_codes

-- | Test 'Hypervisor' serialisation.

prop_Hypervisor_serialisation :: Hypervisor -> Property

prop_Hypervisor_serialisation = testSerialisation

-- | Test 'OobCommand' serialisation.

prop_OobCommand_serialisation :: OobCommand -> Property

prop_OobCommand_serialisation = testSerialisation

-- | Test 'StorageType' serialisation.

prop_StorageType_serialisation :: StorageType -> Property

prop_StorageType_serialisation = testSerialisation

-- | Test 'NodeEvacMode' serialisation.

prop_NodeEvacMode_serialisation :: NodeEvacMode -> Property

prop_NodeEvacMode_serialisation = testSerialisation

-- | Test 'FileDriver' serialisation.

prop_FileDriver_serialisation :: FileDriver -> Property

prop_FileDriver_serialisation = testSerialisation

-- | Test 'InstCreate' serialisation.

prop_InstCreateMode_serialisation :: InstCreateMode -> Property

prop_InstCreateMode_serialisation = testSerialisation

-- | Test 'RebootType' serialisation.

prop_RebootType_serialisation :: RebootType -> Property

prop_RebootType_serialisation = testSerialisation

-- | Test 'ExportMode' serialisation.

prop_ExportMode_serialisation :: ExportMode -> Property

prop_ExportMode_serialisation = testSerialisation

-- | Test 'IAllocatorTestDir' serialisation.

prop_IAllocatorTestDir_serialisation :: IAllocatorTestDir -> Property

prop_IAllocatorTestDir_serialisation = testSerialisation

-- | Test 'IAllocatorMode' serialisation.

prop_IAllocatorMode_serialisation :: IAllocatorMode -> Property

prop_IAllocatorMode_serialisation = testSerialisation

-- | Tests equivalence with Python, based on Constants.hs code.

case_IAllocatorMode_pyequiv :: Assertion

case_IAllocatorMode_pyequiv = do

  let all_py_codes = sort C.validIallocatorModes

      all_hs_codes = sort $ map Types.iAllocatorModeToRaw [minBound..maxBound]

  assertEqual "for IAllocatorMode equivalence" all_py_codes all_hs_codes

-- | Test 'NICMode' serialisation.

prop_NICMode_serialisation :: NICMode -> Property

prop_NICMode_serialisation = testSerialisation

-- | Test 'OpStatus' serialisation.

prop_OpStatus_serialization :: OpStatus -> Property

prop_OpStatus_serialization = testSerialisation

-- | Test 'JobStatus' serialisation.

prop_JobStatus_serialization :: JobStatus -> Property

prop_JobStatus_serialization = testSerialisation

-- | Test 'JobStatus' ordering is as expected.

case_JobStatus_order :: Assertion

case_JobStatus_order =

  assertEqual "sort order" [ Types.JOB_STATUS_QUEUED

                           , Types.JOB_STATUS_WAITING

                           , Types.JOB_STATUS_CANCELING

                           , Types.JOB_STATUS_RUNNING

                           , Types.JOB_STATUS_CANCELED

                           , Types.JOB_STATUS_SUCCESS

                           , Types.JOB_STATUS_ERROR

                           ] [minBound..maxBound]

-- | Tests equivalence with Python, based on Constants.hs code.

case_NICMode_pyequiv :: Assertion

case_NICMode_pyequiv = do

  let all_py_codes = sort C.nicValidModes

      all_hs_codes = sort $ map Types.nICModeToRaw [minBound..maxBound]

  assertEqual "for NICMode equivalence" all_py_codes all_hs_codes

-- | Test 'FinalizedJobStatus' serialisation.

prop_FinalizedJobStatus_serialisation :: FinalizedJobStatus -> Property

prop_FinalizedJobStatus_serialisation = testSerialisation

-- | Tests equivalence with Python, based on Constants.hs code.

case_FinalizedJobStatus_pyequiv :: Assertion

case_FinalizedJobStatus_pyequiv = do

  let all_py_codes = sort C.jobsFinalized

      all_hs_codes = sort $ map Types.finalizedJobStatusToRaw

                            [minBound..maxBound]

  assertEqual "for FinalizedJobStatus equivalence" all_py_codes all_hs_codes

-- | Tests JobId serialisation (both from string and ints).

prop_JobId_serialisation :: JobId -> Property

prop_JobId_serialisation jid =

  conjoin [ testSerialisation jid

          , (J.readJSON . J.showJSON . show $ fromJobId jid) ==? J.Ok jid

          , case (fromJVal . J.showJSON . negate $

                  fromJobId jid)::Result JobId of

              Bad _ -> passTest

              Ok jid' -> failTest $ "Parsed negative job id as id " ++

                         show (fromJobId jid')

          ]

-- | Tests that fractional job IDs are not accepted.

prop_JobId_fractional :: Property

prop_JobId_fractional =

  forAll (arbitrary `suchThat`

          (\d -> fromIntegral (truncate d::Int) /= d)) $ \d ->

  case J.readJSON (J.showJSON (d::Double)) of

    J.Error _ -> passTest

    J.Ok jid -> failTest $ "Parsed fractional value " ++ show d ++

                " as job id " ++ show (fromJobId jid)

-- | Tests that a job ID is not parseable from \"bad\" JSON values.

case_JobId_BadTypes :: Assertion

case_JobId_BadTypes = do

  let helper jsval = case J.readJSON jsval of

                       J.Error _ -> return ()

                       J.Ok jid -> assertFailure $ "Parsed " ++ show jsval

                                   ++ " as job id " ++ show (fromJobId jid)

  helper J.JSNull

  helper (J.JSBool True)

  helper (J.JSBool False)

  helper (J.JSArray [])

-- | Test 'JobDependency' serialisation.

prop_JobDependency_serialisation :: JobDependency -> Property

prop_JobDependency_serialisation = testSerialisation

-- | Test 'OpSubmitPriority' serialisation.

prop_OpSubmitPriority_serialisation :: OpSubmitPriority -> Property

prop_OpSubmitPriority_serialisation = testSerialisation

-- | Tests string formatting for 'OpSubmitPriority'.

prop_OpSubmitPriority_string :: OpSubmitPriority -> Property

prop_OpSubmitPriority_string prio =

  parseSubmitPriority (fmtSubmitPriority prio) ==? Just prio

-- | Test 'ELogType' serialisation.

prop_ELogType_serialisation :: ELogType -> Property

prop_ELogType_serialisation = testSerialisation

testSuite "Types"

  [ 'prop_AllocPolicy_serialisation

  , 'case_AllocPolicy_order

  , 'prop_DiskTemplate_serialisation

  , 'prop_InstanceStatus_serialisation

  , 'prop_NonNeg_pass

  , 'prop_NonNeg_fail

  , 'prop_Positive_pass

  , 'prop_Positive_fail

  , 'prop_Neg_pass

  , 'prop_Neg_fail

  , 'prop_NonEmpty_pass

  , 'case_NonEmpty_fail

  , 'prop_MigrationMode_serialisation

  , 'prop_VerifyOptionalChecks_serialisation

  , 'prop_DdmSimple_serialisation

  , 'prop_DdmFull_serialisation

  , 'prop_CVErrorCode_serialisation

  , 'case_CVErrorCode_pyequiv

  , 'prop_Hypervisor_serialisation

  , 'prop_OobCommand_serialisation

  , 'prop_StorageType_serialisation

  , 'prop_NodeEvacMode_serialisation

  , 'prop_FileDriver_serialisation

  , 'prop_InstCreateMode_serialisation

  , 'prop_RebootType_serialisation

  , 'prop_ExportMode_serialisation

  , 'prop_IAllocatorTestDir_serialisation

  , 'prop_IAllocatorMode_serialisation

  , 'case_IAllocatorMode_pyequiv

  , 'prop_NICMode_serialisation

  , 'prop_OpStatus_serialization

  , 'prop_JobStatus_serialization

  , 'case_JobStatus_order

  , 'case_NICMode_pyequiv

  , 'prop_FinalizedJobStatus_serialisation

  , 'case_FinalizedJobStatus_pyequiv

  , 'prop_JobId_serialisation

  , 'prop_JobId_fractional

  , 'case_JobId_BadTypes

  , 'prop_JobDependency_serialisation

  , 'prop_OpSubmitPriority_serialisation

  , 'prop_OpSubmitPriority_string

  , 'prop_ELogType_serialisation

  ]