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