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