code.grnet.gr Git - ganeti-local/blob - test/hs/Test/Ganeti/HTools/Cluster.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.Cluster (testHTools_Cluster) where
  30
  31 import Test.QuickCheck hiding (Result)
  32
  33 import qualified Data.IntMap as IntMap
  34 import Data.Maybe
  35
  36 import Test.Ganeti.TestHelper
  37 import Test.Ganeti.TestCommon
  38 import Test.Ganeti.TestHTools
  39 import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode
  40                                    , genInstanceMaybeBiggerThanNode )
  41 import Test.Ganeti.HTools.Node (genOnlineNode, genNode)
  42
  43 import Ganeti.BasicTypes
  44 import qualified Ganeti.HTools.Backend.IAlloc as IAlloc
  45 import qualified Ganeti.HTools.Cluster as Cluster
  46 import qualified Ganeti.HTools.Container as Container
  47 import qualified Ganeti.HTools.Group as Group
  48 import qualified Ganeti.HTools.Instance as Instance
  49 import qualified Ganeti.HTools.Node as Node
  50 import qualified Ganeti.HTools.Types as Types
  51
  52 {-# ANN module "HLint: ignore Use camelCase" #-}
  53
  54 -- * Helpers
  55
  56 -- | Make a small cluster, both nodes and instances.
  57 makeSmallEmptyCluster :: Node.Node -> Int -> Instance.Instance
  58                       -> (Node.List, Instance.List, Instance.Instance)
  59 makeSmallEmptyCluster node count inst =
  60   (makeSmallCluster node count, Container.empty,
  61    setInstanceSmallerThanNode node inst)
  62
  63 -- | Checks if a node is "big" enough.
  64 isNodeBig :: Int -> Node.Node -> Bool
  65 isNodeBig size node = Node.availDisk node > size * Types.unitDsk
  66                       && Node.availMem node > size * Types.unitMem
  67                       && Node.availCpu node > size * Types.unitCpu
  68
  69 canBalance :: Cluster.Table -> Bool -> Bool -> Bool -> Bool
  70 canBalance tbl dm im evac = isJust $ Cluster.tryBalance tbl dm im evac 0 0
  71
  72 -- | Assigns a new fresh instance to a cluster; this is not
  73 -- allocation, so no resource checks are done.
  74 assignInstance :: Node.List -> Instance.List -> Instance.Instance ->
  75                   Types.Idx -> Types.Idx ->
  76                   (Node.List, Instance.List)
  77 assignInstance nl il inst pdx sdx =
  78   let pnode = Container.find pdx nl
  79       snode = Container.find sdx nl
  80       maxiidx = if Container.null il
  81                   then 0
  82                   else fst (Container.findMax il) + 1
  83       inst' = inst { Instance.idx = maxiidx,
  84                      Instance.pNode = pdx, Instance.sNode = sdx }
  85       pnode' = Node.setPri pnode inst'
  86       snode' = Node.setSec snode inst'
  87       nl' = Container.addTwo pdx pnode' sdx snode' nl
  88       il' = Container.add maxiidx inst' il
  89   in (nl', il')
  90
  91 -- | Checks if an instance is mirrored.
  92 isMirrored :: Instance.Instance -> Bool
  93 isMirrored = (/= Types.MirrorNone) . Instance.mirrorType
  94
  95 -- | Returns the possible change node types for a disk template.
  96 evacModeOptions :: Types.MirrorType -> [Types.EvacMode]
  97 evacModeOptions Types.MirrorNone     = []
  98 evacModeOptions Types.MirrorInternal = [minBound..maxBound] -- DRBD can do all
  99 evacModeOptions Types.MirrorExternal = [Types.ChangePrimary, Types.ChangeAll]
 100
 101 -- * Test cases
 102
 103 -- | Check that the cluster score is close to zero for a homogeneous
 104 -- cluster.
 105 prop_Score_Zero :: Node.Node -> Property
 106 prop_Score_Zero node =
 107   forAll (choose (1, 1024)) $ \count ->
 108     (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
 109      (Node.tDsk node > 0) && (Node.tMem node > 0) &&
 110      (Node.tSpindles node > 0) && (Node.tCpu node > 0)) ==>
 111   let fn = Node.buildPeers node Container.empty
 112       nlst = replicate count fn
 113       score = Cluster.compCVNodes nlst
 114   -- we can't say == 0 here as the floating point errors accumulate;
 115   -- this should be much lower than the default score in CLI.hs
 116   in score <= 1e-12
 117
 118 -- | Check that cluster stats are sane.
 119 prop_CStats_sane :: Property
 120 prop_CStats_sane =
 121   forAll (choose (1, 1024)) $ \count ->
 122   forAll genOnlineNode $ \node ->
 123   let fn = Node.buildPeers node Container.empty
 124       nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
 125       nl = Container.fromList nlst
 126       cstats = Cluster.totalResources nl
 127   in Cluster.csAdsk cstats >= 0 &&
 128      Cluster.csAdsk cstats <= Cluster.csFdsk cstats
 129
 130 -- | Check that one instance is allocated correctly on an empty cluster,
 131 -- without rebalances needed.
 132 prop_Alloc_sane :: Instance.Instance -> Property
 133 prop_Alloc_sane inst =
 134   forAll (choose (5, 20)) $ \count ->
 135   forAll genOnlineNode $ \node ->
 136   let (nl, il, inst') = makeSmallEmptyCluster node count inst
 137       reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
 138   in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
 139      Cluster.tryAlloc nl il inst' of
 140        Bad msg -> failTest msg
 141        Ok as ->
 142          case Cluster.asSolution as of
 143            Nothing -> failTest "Failed to allocate, empty solution"
 144            Just (xnl, xi, _, cv) ->
 145              let il' = Container.add (Instance.idx xi) xi il
 146                  tbl = Cluster.Table xnl il' cv []
 147              in printTestCase "Cluster can be balanced after allocation"
 148                   (not (canBalance tbl True True False)) .&&.
 149                 printTestCase "Solution score differs from actual node list:"
 150                   (Cluster.compCV xnl ==? cv)
 151
 152 -- | Checks that on a 2-5 node cluster, we can allocate a random
 153 -- instance spec via tiered allocation (whatever the original instance
 154 -- spec), on either one or two nodes. Furthermore, we test that
 155 -- computed allocation statistics are correct.
 156 prop_CanTieredAlloc :: Property
 157 prop_CanTieredAlloc =
 158   forAll (choose (2, 5)) $ \count ->
 159   forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
 160   forAll (genInstanceMaybeBiggerThanNode node) $ \inst ->
 161   let nl = makeSmallCluster node count
 162       il = Container.empty
 163       rqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
 164       allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
 165   in case allocnodes >>= \allocnodes' ->
 166     Cluster.tieredAlloc nl il (Just 5) inst allocnodes' [] [] of
 167        Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg
 168        Ok (_, nl', il', ixes, cstats) ->
 169          let (ai_alloc, ai_pool, ai_unav) =
 170                Cluster.computeAllocationDelta
 171                 (Cluster.totalResources nl)
 172                 (Cluster.totalResources nl')
 173              all_nodes fn = sum $ map fn (Container.elems nl)
 174              all_res fn = sum $ map fn [ai_alloc, ai_pool, ai_unav]
 175          in conjoin
 176             [ printTestCase "No instances allocated" $ not (null ixes)
 177             , IntMap.size il' ==? length ixes
 178             , length ixes     ==? length cstats
 179             , all_res Types.allocInfoVCpus ==? all_nodes Node.hiCpu
 180             , all_res Types.allocInfoNCpus ==? all_nodes Node.tCpu
 181             , all_res Types.allocInfoMem   ==? truncate (all_nodes Node.tMem)
 182             , all_res Types.allocInfoDisk  ==? truncate (all_nodes Node.tDsk)
 183             ]
 184
 185 -- | Helper function to create a cluster with the given range of nodes
 186 -- and allocate an instance on it.
 187 genClusterAlloc :: Int -> Node.Node -> Instance.Instance
 188                 -> Result (Node.List, Instance.List, Instance.Instance)
 189 genClusterAlloc count node inst =
 190   let nl = makeSmallCluster node count
 191       reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
 192   in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
 193      Cluster.tryAlloc nl Container.empty inst of
 194        Bad msg -> Bad $ "Can't allocate: " ++ msg
 195        Ok as ->
 196          case Cluster.asSolution as of
 197            Nothing -> Bad "Empty solution?"
 198            Just (xnl, xi, _, _) ->
 199              let xil = Container.add (Instance.idx xi) xi Container.empty
 200              in Ok (xnl, xil, xi)
 201
 202 -- | Checks that on a 4-8 node cluster, once we allocate an instance,
 203 -- we can also relocate it.
 204 prop_AllocRelocate :: Property
 205 prop_AllocRelocate =
 206   forAll (choose (4, 8)) $ \count ->
 207   forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
 208   forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
 209   case genClusterAlloc count node inst of
 210     Bad msg -> failTest msg
 211     Ok (nl, il, inst') ->
 212       case IAlloc.processRelocate defGroupList nl il
 213              (Instance.idx inst) 1
 214              [(if Instance.diskTemplate inst' == Types.DTDrbd8
 215                  then Instance.sNode
 216                  else Instance.pNode) inst'] of
 217         Ok _ -> passTest
 218         Bad msg -> failTest $ "Failed to relocate: " ++ msg
 219
 220 -- | Helper property checker for the result of a nodeEvac or
 221 -- changeGroup operation.
 222 check_EvacMode :: Group.Group -> Instance.Instance
 223                -> Result (Node.List, Instance.List, Cluster.EvacSolution)
 224                -> Property
 225 check_EvacMode grp inst result =
 226   case result of
 227     Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg
 228     Ok (_, _, es) ->
 229       let moved = Cluster.esMoved es
 230           failed = Cluster.esFailed es
 231           opcodes = not . null $ Cluster.esOpCodes es
 232       in conjoin
 233            [ failmsg ("'failed' not empty: " ++ show failed) (null failed)
 234            , failmsg "'opcodes' is null" opcodes
 235            , case moved of
 236                [(idx', gdx, _)] ->
 237                  failmsg "invalid instance moved" (idx == idx') .&&.
 238                  failmsg "wrong target group" (gdx == Group.idx grp)
 239                v -> failmsg  ("invalid solution: " ++ show v) False
 240            ]
 241   where failmsg :: String -> Bool -> Property
 242         failmsg msg = printTestCase ("Failed to evacuate: " ++ msg)
 243         idx = Instance.idx inst
 244
 245 -- | Checks that on a 4-8 node cluster, once we allocate an instance,
 246 -- we can also node-evacuate it.
 247 prop_AllocEvacuate :: Property
 248 prop_AllocEvacuate =
 249   forAll (choose (4, 8)) $ \count ->
 250   forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
 251   forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
 252   case genClusterAlloc count node inst of
 253     Bad msg -> failTest msg
 254     Ok (nl, il, inst') ->
 255       conjoin . map (\mode -> check_EvacMode defGroup inst' $
 256                               Cluster.tryNodeEvac defGroupList nl il mode
 257                                 [Instance.idx inst']) .
 258                               evacModeOptions .
 259                               Instance.mirrorType $ inst'
 260
 261 -- | Checks that on a 4-8 node cluster with two node groups, once we
 262 -- allocate an instance on the first node group, we can also change
 263 -- its group.
 264 prop_AllocChangeGroup :: Property
 265 prop_AllocChangeGroup =
 266   forAll (choose (4, 8)) $ \count ->
 267   forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
 268   forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
 269   case genClusterAlloc count node inst of
 270     Bad msg -> failTest msg
 271     Ok (nl, il, inst') ->
 272       -- we need to add a second node group and nodes to the cluster
 273       let nl2 = Container.elems $ makeSmallCluster node count
 274           grp2 = Group.setIdx defGroup (Group.idx defGroup + 1)
 275           maxndx = maximum . map Node.idx $ nl2
 276           nl3 = map (\n -> n { Node.group = Group.idx grp2
 277                              , Node.idx = Node.idx n + maxndx }) nl2
 278           nl4 = Container.fromList . map (\n -> (Node.idx n, n)) $ nl3
 279           gl' = Container.add (Group.idx grp2) grp2 defGroupList
 280           nl' = IntMap.union nl nl4
 281       in check_EvacMode grp2 inst' $
 282          Cluster.tryChangeGroup gl' nl' il [] [Instance.idx inst']
 283
 284 -- | Check that allocating multiple instances on a cluster, then
 285 -- adding an empty node, results in a valid rebalance.
 286 prop_AllocBalance :: Property
 287 prop_AllocBalance =
 288   forAll (genNode (Just 5) (Just 128)) $ \node ->
 289   forAll (choose (3, 5)) $ \count ->
 290   not (Node.offline node) && not (Node.failN1 node) ==>
 291   let nl = makeSmallCluster node count
 292       hnode = snd $ IntMap.findMax nl
 293       nl' = IntMap.deleteMax nl
 294       il = Container.empty
 295       allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True
 296       i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
 297   in case allocnodes >>= \allocnodes' ->
 298     Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of
 299        Bad msg -> failTest $ "Failed to allocate: " ++ msg
 300        Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances"
 301        Ok (_, xnl, il', _, _) ->
 302          let ynl = Container.add (Node.idx hnode) hnode xnl
 303              cv = Cluster.compCV ynl
 304              tbl = Cluster.Table ynl il' cv []
 305          in printTestCase "Failed to rebalance" $
 306             canBalance tbl True True False
 307
 308 -- | Checks consistency.
 309 prop_CheckConsistency :: Node.Node -> Instance.Instance -> Bool
 310 prop_CheckConsistency node inst =
 311   let nl = makeSmallCluster node 3
 312       (node1, node2, node3) =
 313         case Container.elems nl of
 314           [a, b, c] -> (a, b, c)
 315           l -> error $ "Invalid node list out of makeSmallCluster/3: " ++
 316                show l
 317       node3' = node3 { Node.group = 1 }
 318       nl' = Container.add (Node.idx node3') node3' nl
 319       inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2)
 320       inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary
 321       inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3)
 322       ccheck = Cluster.findSplitInstances nl' . Container.fromList
 323   in null (ccheck [(0, inst1)]) &&
 324      null (ccheck [(0, inst2)]) &&
 325      (not . null $ ccheck [(0, inst3)])
 326
 327 -- | For now, we only test that we don't lose instances during the split.
 328 prop_SplitCluster :: Node.Node -> Instance.Instance -> Property
 329 prop_SplitCluster node inst =
 330   forAll (choose (0, 100)) $ \icnt ->
 331   let nl = makeSmallCluster node 2
 332       (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1)
 333                    (nl, Container.empty) [1..icnt]
 334       gni = Cluster.splitCluster nl' il'
 335   in sum (map (Container.size . snd . snd) gni) == icnt &&
 336      all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group)
 337                                  (Container.elems nl'')) gni
 338
 339 -- | Helper function to check if we can allocate an instance on a
 340 -- given node list. Successful allocation is denoted by 'Nothing',
 341 -- otherwise the 'Just' value will contain the error message.
 342 canAllocOn :: Node.List -> Int -> Instance.Instance -> Maybe String
 343 canAllocOn nl reqnodes inst =
 344   case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
 345        Cluster.tryAlloc nl Container.empty inst of
 346        Bad msg -> Just $ "Can't allocate: " ++ msg
 347        Ok as ->
 348          case Cluster.asSolution as of
 349            Nothing -> Just $ "No allocation solution; failures: " ++
 350                       show (Cluster.collapseFailures $ Cluster.asFailures as)
 351            Just _ -> Nothing
 352
 353 -- | Checks that allocation obeys minimum and maximum instance
 354 -- policies. The unittest generates a random node, duplicates it /count/
 355 -- times, and generates a random instance that can be allocated on
 356 -- this mini-cluster; it then checks that after applying a policy that
 357 -- the instance doesn't fits, the allocation fails.
 358 prop_AllocPolicy :: Property
 359 prop_AllocPolicy =
 360   forAll genOnlineNode $ \node ->
 361   forAll (choose (5, 20)) $ \count ->
 362   forAll (genInstanceSmallerThanNode node) $ \inst ->
 363   forAll (arbitrary `suchThat`
 364           (isBad . flip (Instance.instMatchesPolicy inst)
 365            (Node.exclStorage node))) $ \ipol ->
 366   let rqn = Instance.requiredNodes $ Instance.diskTemplate inst
 367       node' = Node.setPolicy ipol node
 368       nl = makeSmallCluster node' count
 369   in printTestCase "Allocation check:"
 370        (isNothing (canAllocOn (makeSmallCluster node count) rqn inst)) .&&.
 371      printTestCase "Policy failure check:" (isJust $ canAllocOn nl rqn inst)
 372
 373 testSuite "HTools/Cluster"
 374             [ 'prop_Score_Zero
 375             , 'prop_CStats_sane
 376             , 'prop_Alloc_sane
 377             , 'prop_CanTieredAlloc
 378             , 'prop_AllocRelocate
 379             , 'prop_AllocEvacuate
 380             , 'prop_AllocChangeGroup
 381             , 'prop_AllocBalance
 382             , 'prop_CheckConsistency
 383             , 'prop_SplitCluster
 384             , 'prop_AllocPolicy
 385             ]