Synnefo » snf-ganeti

{-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances #-}

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

{-| Unittests for ganeti-htools.

-}

{-

Copyright (C) 2009, 2010, 2011, 2012 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.HTools.Types

  ( testHTools_Types

  , Types.AllocPolicy(..)

  , Types.DiskTemplate(..)

  , Types.FailMode(..)

  , Types.EvacMode(..)

  , Types.ISpec(..)

  , Types.IPolicy(..)

  , nullIPolicy

  ) where

import Test.QuickCheck hiding (Result)

import Test.HUnit

import Control.Applicative

import Data.List (sort)

import Test.Ganeti.TestHelper

import Test.Ganeti.TestCommon

import Test.Ganeti.TestHTools

import Test.Ganeti.Types ()

import Ganeti.BasicTypes

import qualified Ganeti.Constants as C

import qualified Ganeti.HTools.Types as Types

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

-- * Helpers

-- | All disk templates (used later)

allDiskTemplates :: [Types.DiskTemplate]

allDiskTemplates = [minBound..maxBound]

-- * Arbitrary instance

$(genArbitrary ''Types.FailMode)

$(genArbitrary ''Types.EvacMode)

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

  arbitrary = arbitrary >>= \c ->

              if c

                then Ok  <$> arbitrary

                else Bad <$> arbitrary

instance Arbitrary Types.ISpec where

  arbitrary = do

    mem_s <- arbitrary::Gen (NonNegative Int)

    dsk_c <- arbitrary::Gen (NonNegative Int)

    dsk_s <- arbitrary::Gen (NonNegative Int)

    cpu_c <- arbitrary::Gen (NonNegative Int)

    nic_c <- arbitrary::Gen (NonNegative Int)

    su    <- arbitrary::Gen (NonNegative Int)

    return Types.ISpec { Types.iSpecMemorySize = fromIntegral mem_s

                       , Types.iSpecCpuCount   = fromIntegral cpu_c

                       , Types.iSpecDiskSize   = fromIntegral dsk_s

                       , Types.iSpecDiskCount  = fromIntegral dsk_c

                       , Types.iSpecNicCount   = fromIntegral nic_c

                       , Types.iSpecSpindleUse = fromIntegral su

                       }

-- | Generates an ispec bigger than the given one.

genBiggerISpec :: Types.ISpec -> Gen Types.ISpec

genBiggerISpec imin = do

  mem_s <- choose (Types.iSpecMemorySize imin, maxBound)

  dsk_c <- choose (Types.iSpecDiskCount imin, maxBound)

  dsk_s <- choose (Types.iSpecDiskSize imin, maxBound)

  cpu_c <- choose (Types.iSpecCpuCount imin, maxBound)

  nic_c <- choose (Types.iSpecNicCount imin, maxBound)

  su    <- choose (Types.iSpecSpindleUse imin, maxBound)

  return Types.ISpec { Types.iSpecMemorySize = fromIntegral mem_s

                     , Types.iSpecCpuCount   = fromIntegral cpu_c

                     , Types.iSpecDiskSize   = fromIntegral dsk_s

                     , Types.iSpecDiskCount  = fromIntegral dsk_c

                     , Types.iSpecNicCount   = fromIntegral nic_c

                     , Types.iSpecSpindleUse = fromIntegral su

                     }

instance Arbitrary Types.IPolicy where

  arbitrary = do

    imin <- arbitrary

    istd <- genBiggerISpec imin

    imax <- genBiggerISpec istd

    num_tmpl <- choose (0, length allDiskTemplates)

    dts  <- genUniquesList num_tmpl arbitrary

    vcpu_ratio <- choose (1.0, maxVcpuRatio)

    spindle_ratio <- choose (1.0, maxSpindleRatio)

    return Types.IPolicy { Types.iPolicyMinSpec = imin

                         , Types.iPolicyStdSpec = istd

                         , Types.iPolicyMaxSpec = imax

                         , Types.iPolicyDiskTemplates = dts

                         , Types.iPolicyVcpuRatio = vcpu_ratio

                         , Types.iPolicySpindleRatio = spindle_ratio

                         }

-- * Test cases

prop_ISpec_serialisation :: Types.ISpec -> Property

prop_ISpec_serialisation = testSerialisation

prop_IPolicy_serialisation :: Types.IPolicy -> Property

prop_IPolicy_serialisation = testSerialisation

prop_EvacMode_serialisation :: Types.EvacMode -> Property

prop_EvacMode_serialisation = testSerialisation

prop_opToResult :: Types.OpResult Int -> Property

prop_opToResult op =

  case op of

    Bad _ -> printTestCase ("expected bad but got " ++ show r) $ isBad r

    Ok v  -> case r of

               Bad msg -> failTest ("expected Ok but got Bad " ++ msg)

               Ok v' -> v ==? v'

  where r = Types.opToResult op

prop_eitherToResult :: Either String Int -> Bool

prop_eitherToResult ei =

  case ei of

    Left _ -> isBad r

    Right v -> case r of

                 Bad _ -> False

                 Ok v' -> v == v'

    where r = eitherToResult ei

-- | Test 'AutoRepairType' ordering is as expected and consistent with Python

-- codebase.

case_AutoRepairType_sort :: Assertion

case_AutoRepairType_sort = do

  let expected = [ Types.ArFixStorage

                 , Types.ArMigrate

                 , Types.ArFailover

                 , Types.ArReinstall

                 ]

      all_hs_raw = map Types.autoRepairTypeToRaw [minBound..maxBound]

  assertEqual "Haskell order" expected [minBound..maxBound]

  assertEqual "consistent with Python" C.autoRepairAllTypes all_hs_raw

-- | Test 'AutoRepairResult' type is equivalent with Python codebase.

case_AutoRepairResult_pyequiv :: Assertion

case_AutoRepairResult_pyequiv = do

  let all_py_results = sort C.autoRepairAllResults

      all_hs_results = sort $

                       map Types.autoRepairResultToRaw [minBound..maxBound]

  assertEqual "for AutoRepairResult equivalence" all_py_results all_hs_results

testSuite "HTools/Types"

            [ 'prop_ISpec_serialisation

            , 'prop_IPolicy_serialisation

            , 'prop_EvacMode_serialisation

            , 'prop_opToResult

            , 'prop_eitherToResult

            , 'case_AutoRepairType_sort

            , 'case_AutoRepairResult_pyequiv

            ]