Synnefo » snf-ganeti

{-# LANGUAGE TemplateHaskell #-}

{-# 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.Loader (testHTools_Loader) where

import Test.QuickCheck

import qualified Data.IntMap as IntMap

import qualified Data.Map as Map

import Data.List

import Test.Ganeti.TestHelper

import Test.Ganeti.TestCommon

import Test.Ganeti.HTools.Node ()

import qualified Ganeti.BasicTypes as BasicTypes

import qualified Ganeti.HTools.Container as Container

import qualified Ganeti.HTools.Loader as Loader

import qualified Ganeti.HTools.Node as Node

prop_lookupNode :: [(String, Int)] -> String -> String -> Property

prop_lookupNode ktn inst node =

  Loader.lookupNode nl inst node ==? Map.lookup node nl

    where nl = Map.fromList ktn

prop_lookupInstance :: [(String, Int)] -> String -> Property

prop_lookupInstance kti inst =

  Loader.lookupInstance il inst ==? Map.lookup inst il

    where il = Map.fromList kti

prop_assignIndices :: Property

prop_assignIndices =

  -- generate nodes with unique names

  forAll (arbitrary `suchThat`

          (\nodes ->

             let names = map Node.name nodes

             in length names == length (nub names))) $ \nodes ->

  let (nassoc, kt) =

        Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)

  in Map.size nassoc == length nodes &&

     Container.size kt == length nodes &&

     (null nodes || maximum (IntMap.keys kt) == length nodes - 1)

-- | Checks that the number of primary instances recorded on the nodes

-- is zero.

prop_mergeData :: [Node.Node] -> Bool

prop_mergeData ns =

  let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns

  in case Loader.mergeData [] [] [] []

         (Loader.emptyCluster {Loader.cdNodes = na}) of

    BasicTypes.Bad _ -> False

    BasicTypes.Ok (Loader.ClusterData _ nl il _ _) ->

      let nodes = Container.elems nl

          instances = Container.elems il

      in (sum . map (length . Node.pList)) nodes == 0 &&

         null instances

-- | Check that compareNameComponent on equal strings works.

prop_compareNameComponent_equal :: String -> Bool

prop_compareNameComponent_equal s =

  BasicTypes.compareNameComponent s s ==

    BasicTypes.LookupResult BasicTypes.ExactMatch s

-- | Check that compareNameComponent on prefix strings works.

prop_compareNameComponent_prefix :: NonEmptyList Char -> String -> Bool

prop_compareNameComponent_prefix (NonEmpty s1) s2 =

  BasicTypes.compareNameComponent (s1 ++ "." ++ s2) s1 ==

    BasicTypes.LookupResult BasicTypes.PartialMatch s1

testSuite "HTools/Loader"

            [ 'prop_lookupNode

            , 'prop_lookupInstance

            , 'prop_assignIndices

            , 'prop_mergeData

            , 'prop_compareNameComponent_equal

            , 'prop_compareNameComponent_prefix

            ]