code.grnet.gr Git - ganeti-local/blob - test/hs/Test/Ganeti/HTools/Node.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3
   4 {-| Unittests for ganeti-htools.
   5
   6 -}
   7
   8 {-
   9
  10 Copyright (C) 2009, 2010, 2011, 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.HTools.Node
  30   ( testHTools_Node
  31   , Node.Node(..)
  32   , setInstanceSmallerThanNode
  33   , genNode
  34   , genOnlineNode
  35   , genNodeList
  36   ) where
  37
  38 import Test.QuickCheck
  39 import Test.HUnit
  40
  41 import Control.Monad
  42 import qualified Data.Map as Map
  43 import qualified Data.Graph as Graph
  44 import Data.List
  45
  46 import Test.Ganeti.TestHelper
  47 import Test.Ganeti.TestCommon
  48 import Test.Ganeti.TestHTools
  49 import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode
  50                                    , genInstanceList
  51                                    , genInstanceOnNodeList)
  52
  53 import Ganeti.BasicTypes
  54 import qualified Ganeti.HTools.Loader as Loader
  55 import qualified Ganeti.HTools.Container as Container
  56 import qualified Ganeti.HTools.Instance as Instance
  57 import qualified Ganeti.HTools.Node as Node
  58 import qualified Ganeti.HTools.Types as Types
  59 import qualified Ganeti.HTools.Graph as HGraph
  60
  61 {-# ANN module "HLint: ignore Use camelCase" #-}
  62
  63 -- * Arbitrary instances
  64
  65 -- | Generates an arbitrary node based on sizing information.
  66 genNode :: Maybe Int -- ^ Minimum node size in terms of units
  67         -> Maybe Int -- ^ Maximum node size (when Nothing, bounded
  68                      -- just by the max... constants)
  69         -> Gen Node.Node
  70 genNode min_multiplier max_multiplier = do
  71   let (base_mem, base_dsk, base_cpu) =
  72         case min_multiplier of
  73           Just mm -> (mm * Types.unitMem,
  74                       mm * Types.unitDsk,
  75                       mm * Types.unitCpu)
  76           Nothing -> (0, 0, 0)
  77       (top_mem, top_dsk, top_cpu)  =
  78         case max_multiplier of
  79           Just mm -> (mm * Types.unitMem,
  80                       mm * Types.unitDsk,
  81                       mm * Types.unitCpu)
  82           Nothing -> (maxMem, maxDsk, maxCpu)
  83   name  <- genFQDN
  84   mem_t <- choose (base_mem, top_mem)
  85   mem_f <- choose (base_mem, mem_t)
  86   mem_n <- choose (0, mem_t - mem_f)
  87   dsk_t <- choose (base_dsk, top_dsk)
  88   dsk_f <- choose (base_dsk, dsk_t)
  89   cpu_t <- choose (base_cpu, top_cpu)
  90   offl  <- arbitrary
  91   let n = Node.create name (fromIntegral mem_t) mem_n mem_f
  92           (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl 1 0
  93       n' = Node.setPolicy nullIPolicy n
  94   return $ Node.buildPeers n' Container.empty
  95
  96 -- | Helper function to generate a sane node.
  97 genOnlineNode :: Gen Node.Node
  98 genOnlineNode =
  99   arbitrary `suchThat` (\n -> not (Node.offline n) &&
 100                               not (Node.failN1 n) &&
 101                               Node.availDisk n > 0 &&
 102                               Node.availMem n > 0 &&
 103                               Node.availCpu n > 0)
 104
 105 -- and a random node
 106 instance Arbitrary Node.Node where
 107   arbitrary = genNode Nothing Nothing
 108
 109 -- | Node list generator.
 110 -- Given a node generator, create a random length node list.  Note that "real"
 111 -- clusters always have at least one node, so we don't generate empty node
 112 -- lists here.
 113 genNodeList :: Gen Node.Node -> Gen Node.List
 114 genNodeList ngen = fmap (snd . Loader.assignIndices) names_nodes
 115     where names_nodes = (fmap . map) (\n -> (Node.name n, n)) $ listOf1 ngen
 116
 117 -- | Generate a node list, an instance list, and a node graph.
 118 -- We choose instances with nodes contained in the node list.
 119 genNodeGraph :: Gen (Maybe Graph.Graph, Node.List, Instance.List)
 120 genNodeGraph = do
 121   nl <- genNodeList genOnlineNode `suchThat` ((2<=).Container.size)
 122   il <- genInstanceList (genInstanceOnNodeList nl)
 123   return (Node.mkNodeGraph nl il, nl, il)
 124
 125 -- * Test cases
 126
 127 prop_setAlias :: Node.Node -> String -> Bool
 128 prop_setAlias node name =
 129   Node.name newnode == Node.name node &&
 130   Node.alias newnode == name
 131     where newnode = Node.setAlias node name
 132
 133 prop_setOffline :: Node.Node -> Bool -> Property
 134 prop_setOffline node status =
 135   Node.offline newnode ==? status
 136     where newnode = Node.setOffline node status
 137
 138 prop_setXmem :: Node.Node -> Int -> Property
 139 prop_setXmem node xm =
 140   Node.xMem newnode ==? xm
 141     where newnode = Node.setXmem node xm
 142
 143 prop_setMcpu :: Node.Node -> Double -> Property
 144 prop_setMcpu node mc =
 145   Types.iPolicyVcpuRatio (Node.iPolicy newnode) ==? mc
 146     where newnode = Node.setMcpu node mc
 147
 148 prop_setFmemGreater :: Node.Node -> Int -> Property
 149 prop_setFmemGreater node new_mem =
 150   not (Node.failN1 node) && (Node.rMem node >= 0) &&
 151   (new_mem > Node.rMem node) ==>
 152   not (Node.failN1 (Node.setFmem node new_mem))
 153
 154 prop_setFmemExact :: Node.Node -> Property
 155 prop_setFmemExact node =
 156   not (Node.failN1 node) && (Node.rMem node >= 0) ==>
 157   not (Node.failN1 (Node.setFmem node (Node.rMem node)))
 158
 159 -- Check if adding an instance that consumes exactly all reserved
 160 -- memory does not raise an N+1 error
 161 prop_addPri_NoN1Fail :: Property
 162 prop_addPri_NoN1Fail =
 163   forAll genOnlineNode $ \node ->
 164   forAll (genInstanceSmallerThanNode node) $ \inst ->
 165   let inst' = inst { Instance.mem = Node.fMem node - Node.rMem node }
 166   in (Node.addPri node inst' /=? Bad Types.FailN1)
 167
 168 -- | Check that an instance add with too high memory or disk will be
 169 -- rejected.
 170 prop_addPriFM :: Node.Node -> Instance.Instance -> Property
 171 prop_addPriFM node inst =
 172   Instance.mem inst >= Node.fMem node && not (Node.failN1 node) &&
 173   not (Instance.isOffline inst) ==>
 174   (Node.addPri node inst'' ==? Bad Types.FailMem)
 175   where inst' = setInstanceSmallerThanNode node inst
 176         inst'' = inst' { Instance.mem = Instance.mem inst }
 177
 178 -- | Check that adding a primary instance with too much disk fails
 179 -- with type FailDisk.
 180 prop_addPriFD :: Node.Node -> Instance.Instance -> Property
 181 prop_addPriFD node inst =
 182   forAll (elements Instance.localStorageTemplates) $ \dt ->
 183   Instance.dsk inst >= Node.fDsk node && not (Node.failN1 node) ==>
 184   let inst' = setInstanceSmallerThanNode node inst
 185       inst'' = inst' { Instance.dsk = Instance.dsk inst
 186                      , Instance.diskTemplate = dt }
 187   in (Node.addPri node inst'' ==? Bad Types.FailDisk)
 188
 189 -- | Check that adding a primary instance with too many VCPUs fails
 190 -- with type FailCPU.
 191 prop_addPriFC :: Property
 192 prop_addPriFC =
 193   forAll (choose (1, maxCpu)) $ \extra ->
 194   forAll genOnlineNode $ \node ->
 195   forAll (arbitrary `suchThat` Instance.notOffline) $ \inst ->
 196   let inst' = setInstanceSmallerThanNode node inst
 197       inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
 198   in case Node.addPri node inst'' of
 199        Bad Types.FailCPU -> passTest
 200        v -> failTest $ "Expected OpFail FailCPU, but got " ++ show v
 201
 202 -- | Check that an instance add with too high memory or disk will be
 203 -- rejected.
 204 prop_addSec :: Node.Node -> Instance.Instance -> Int -> Property
 205 prop_addSec node inst pdx =
 206   ((Instance.mem inst >= (Node.fMem node - Node.rMem node) &&
 207     not (Instance.isOffline inst)) ||
 208    Instance.dsk inst >= Node.fDsk node) &&
 209   not (Node.failN1 node) ==>
 210       isBad (Node.addSec node inst pdx)
 211
 212 -- | Check that an offline instance with reasonable disk size but
 213 -- extra mem/cpu can always be added.
 214 prop_addOfflinePri :: NonNegative Int -> NonNegative Int -> Property
 215 prop_addOfflinePri (NonNegative extra_mem) (NonNegative extra_cpu) =
 216   forAll genOnlineNode $ \node ->
 217   forAll (genInstanceSmallerThanNode node) $ \inst ->
 218   let inst' = inst { Instance.runSt = Types.StatusOffline
 219                    , Instance.mem = Node.availMem node + extra_mem
 220                    , Instance.vcpus = Node.availCpu node + extra_cpu }
 221   in case Node.addPri node inst' of
 222        Ok _ -> passTest
 223        v -> failTest $ "Expected OpGood, but got: " ++ show v
 224
 225 -- | Check that an offline instance with reasonable disk size but
 226 -- extra mem/cpu can always be added.
 227 prop_addOfflineSec :: NonNegative Int -> NonNegative Int
 228                    -> Types.Ndx -> Property
 229 prop_addOfflineSec (NonNegative extra_mem) (NonNegative extra_cpu) pdx =
 230   forAll genOnlineNode $ \node ->
 231   forAll (genInstanceSmallerThanNode node) $ \inst ->
 232   let inst' = inst { Instance.runSt = Types.StatusOffline
 233                    , Instance.mem = Node.availMem node + extra_mem
 234                    , Instance.vcpus = Node.availCpu node + extra_cpu
 235                    , Instance.diskTemplate = Types.DTDrbd8 }
 236   in case Node.addSec node inst' pdx of
 237        Ok _ -> passTest
 238        v -> failTest $ "Expected OpGood/OpGood, but got: " ++ show v
 239
 240 -- | Checks for memory reservation changes.
 241 prop_rMem :: Instance.Instance -> Property
 242 prop_rMem inst =
 243   not (Instance.isOffline inst) ==>
 244   forAll (genOnlineNode `suchThat` ((> Types.unitMem) . Node.fMem)) $ \node ->
 245   -- ab = auto_balance, nb = non-auto_balance
 246   -- we use -1 as the primary node of the instance
 247   let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True
 248                    , Instance.diskTemplate = Types.DTDrbd8 }
 249       inst_ab = setInstanceSmallerThanNode node inst'
 250       inst_nb = inst_ab { Instance.autoBalance = False }
 251       -- now we have the two instances, identical except the
 252       -- autoBalance attribute
 253       orig_rmem = Node.rMem node
 254       inst_idx = Instance.idx inst_ab
 255       node_add_ab = Node.addSec node inst_ab (-1)
 256       node_add_nb = Node.addSec node inst_nb (-1)
 257       node_del_ab = liftM (`Node.removeSec` inst_ab) node_add_ab
 258       node_del_nb = liftM (`Node.removeSec` inst_nb) node_add_nb
 259   in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of
 260        (Ok a_ab, Ok a_nb,
 261         Ok d_ab, Ok d_nb) ->
 262          printTestCase "Consistency checks failed" $
 263            Node.rMem a_ab >  orig_rmem &&
 264            Node.rMem a_ab - orig_rmem == Instance.mem inst_ab &&
 265            Node.rMem a_nb == orig_rmem &&
 266            Node.rMem d_ab == orig_rmem &&
 267            Node.rMem d_nb == orig_rmem &&
 268            -- this is not related to rMem, but as good a place to
 269            -- test as any
 270            inst_idx `elem` Node.sList a_ab &&
 271            inst_idx `notElem` Node.sList d_ab
 272        x -> failTest $ "Failed to add/remove instances: " ++ show x
 273
 274 -- | Check mdsk setting.
 275 prop_setMdsk :: Node.Node -> SmallRatio -> Bool
 276 prop_setMdsk node mx =
 277   Node.loDsk node' >= 0 &&
 278   fromIntegral (Node.loDsk node') <= Node.tDsk node &&
 279   Node.availDisk node' >= 0 &&
 280   Node.availDisk node' <= Node.fDsk node' &&
 281   fromIntegral (Node.availDisk node') <= Node.tDsk node' &&
 282   Node.mDsk node' == mx'
 283     where node' = Node.setMdsk node mx'
 284           SmallRatio mx' = mx
 285
 286 -- Check tag maps
 287 prop_tagMaps_idempotent :: Property
 288 prop_tagMaps_idempotent =
 289   forAll genTags $ \tags ->
 290   Node.delTags (Node.addTags m tags) tags ==? m
 291     where m = Map.empty
 292
 293 prop_tagMaps_reject :: Property
 294 prop_tagMaps_reject =
 295   forAll (genTags `suchThat` (not . null)) $ \tags ->
 296   let m = Node.addTags Map.empty tags
 297   in all (\t -> Node.rejectAddTags m [t]) tags
 298
 299 prop_showField :: Node.Node -> Property
 300 prop_showField node =
 301   forAll (elements Node.defaultFields) $ \ field ->
 302   fst (Node.showHeader field) /= Types.unknownField &&
 303   Node.showField node field /= Types.unknownField
 304
 305 prop_computeGroups :: [Node.Node] -> Bool
 306 prop_computeGroups nodes =
 307   let ng = Node.computeGroups nodes
 308       onlyuuid = map fst ng
 309   in length nodes == sum (map (length . snd) ng) &&
 310      all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng &&
 311      length (nub onlyuuid) == length onlyuuid &&
 312      (null nodes || not (null ng))
 313
 314 -- Check idempotence of add/remove operations
 315 prop_addPri_idempotent :: Property
 316 prop_addPri_idempotent =
 317   forAll genOnlineNode $ \node ->
 318   forAll (genInstanceSmallerThanNode node) $ \inst ->
 319   case Node.addPri node inst of
 320     Ok node' -> Node.removePri node' inst ==? node
 321     _ -> failTest "Can't add instance"
 322
 323 prop_addSec_idempotent :: Property
 324 prop_addSec_idempotent =
 325   forAll genOnlineNode $ \node ->
 326   forAll (genInstanceSmallerThanNode node) $ \inst ->
 327   let pdx = Node.idx node + 1
 328       inst' = Instance.setPri inst pdx
 329       inst'' = inst' { Instance.diskTemplate = Types.DTDrbd8 }
 330   in case Node.addSec node inst'' pdx of
 331        Ok node' -> Node.removeSec node' inst'' ==? node
 332        _ -> failTest "Can't add instance"
 333
 334 -- | Check that no graph is created on an empty node list.
 335 case_emptyNodeList :: Assertion
 336 case_emptyNodeList =
 337   assertEqual "" Nothing $ Node.mkNodeGraph emptynodes emptyinstances
 338     where emptynodes = Container.empty :: Node.List
 339           emptyinstances = Container.empty :: Instance.List
 340
 341 -- | Check that the number of vertices of a nodegraph is equal to the number of
 342 -- nodes in the original node list.
 343 prop_numVertices :: Property
 344 prop_numVertices =
 345   forAll genNodeGraph $ \(graph, nl, _) ->
 346     (fmap numvertices graph ==? Just (Container.size nl))
 347     where numvertices = length . Graph.vertices
 348
 349 -- | Check that the number of edges of a nodegraph is equal to twice the number
 350 -- of instances with secondary nodes in the original instance list.
 351 prop_numEdges :: Property
 352 prop_numEdges =
 353   forAll genNodeGraph $ \(graph, _, il) ->
 354     (fmap numedges graph ==? Just (numwithsec il * 2))
 355     where numedges = length . Graph.edges
 356           numwithsec = length . filter Instance.hasSecondary . Container.elems
 357
 358 -- | Check that a node graph is colorable.
 359 prop_nodeGraphIsColorable :: Property
 360 prop_nodeGraphIsColorable =
 361   forAll genNodeGraph $ \(graph, _, _) ->
 362     fmap HGraph.isColorable graph ==? Just True
 363
 364 -- | Check that each edge in a nodegraph is an instance.
 365 prop_instanceIsEdge :: Property
 366 prop_instanceIsEdge =
 367   forAll genNodeGraph $ \(graph, _, il) ->
 368     fmap (\g -> all (`isEdgeOn` g) (iwithsec il)) graph ==? Just True
 369     where i `isEdgeOn` g = iEdges i `intersect` Graph.edges g == iEdges i
 370           iEdges i = [ (Instance.pNode i, Instance.sNode i)
 371                      , (Instance.sNode i, Instance.pNode i)]
 372           iwithsec = filter Instance.hasSecondary . Container.elems
 373
 374 -- | Check that each instance in an edge in the resulting nodegraph.
 375 prop_edgeIsInstance :: Property
 376 prop_edgeIsInstance =
 377   forAll genNodeGraph $ \(graph, _, il) ->
 378     fmap (all (`isInstanceIn` il).Graph.edges) graph ==? Just True
 379       where e `isInstanceIn` il = any (`hasNodes` e) (Container.elems il)
 380             i `hasNodes` (v1,v2) =
 381               Instance.allNodes i `elem` permutations [v1,v2]
 382
 383 -- | List of tests for the Node module.
 384 testSuite "HTools/Node"
 385             [ 'prop_setAlias
 386             , 'prop_setOffline
 387             , 'prop_setMcpu
 388             , 'prop_setFmemGreater
 389             , 'prop_setFmemExact
 390             , 'prop_setXmem
 391             , 'prop_addPriFM
 392             , 'prop_addPriFD
 393             , 'prop_addPriFC
 394             , 'prop_addPri_NoN1Fail
 395             , 'prop_addSec
 396             , 'prop_addOfflinePri
 397             , 'prop_addOfflineSec
 398             , 'prop_rMem
 399             , 'prop_setMdsk
 400             , 'prop_tagMaps_idempotent
 401             , 'prop_tagMaps_reject
 402             , 'prop_showField
 403             , 'prop_computeGroups
 404             , 'prop_addPri_idempotent
 405             , 'prop_addSec_idempotent
 406             , 'case_emptyNodeList
 407             , 'prop_numVertices
 408             , 'prop_numEdges
 409             , 'prop_nodeGraphIsColorable
 410             , 'prop_edgeIsInstance
 411             , 'prop_instanceIsEdge
 412             ]