Statistics
| Branch: | Tag: | Revision:

root / htest / Test / Ganeti / HTools / Cluster.hs @ d83903ee

History | View | Annotate | Download (17.5 kB)

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
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
import Test.Ganeti.HTools.Node (genOnlineNode, genNode)
41

    
42
import qualified Ganeti.HTools.Cluster as Cluster
43
import qualified Ganeti.HTools.Container as Container
44
import qualified Ganeti.HTools.Group as Group
45
import qualified Ganeti.HTools.IAlloc as IAlloc
46
import qualified Ganeti.HTools.Instance as Instance
47
import qualified Ganeti.HTools.Node as Node
48
import qualified Ganeti.HTools.Types as Types
49

    
50
{-# ANN module "HLint: ignore Use camelCase" #-}
51

    
52
-- * Helpers
53

    
54
-- | Make a small cluster, both nodes and instances.
55
makeSmallEmptyCluster :: Node.Node -> Int -> Instance.Instance
56
                      -> (Node.List, Instance.List, Instance.Instance)
57
makeSmallEmptyCluster node count inst =
58
  (makeSmallCluster node count, Container.empty,
59
   setInstanceSmallerThanNode node inst)
60

    
61
-- | Checks if a node is "big" enough.
62
isNodeBig :: Int -> Node.Node -> Bool
63
isNodeBig size node = Node.availDisk node > size * Types.unitDsk
64
                      && Node.availMem node > size * Types.unitMem
65
                      && Node.availCpu node > size * Types.unitCpu
66

    
67
canBalance :: Cluster.Table -> Bool -> Bool -> Bool -> Bool
68
canBalance tbl dm im evac = isJust $ Cluster.tryBalance tbl dm im evac 0 0
69

    
70
-- | Assigns a new fresh instance to a cluster; this is not
71
-- allocation, so no resource checks are done.
72
assignInstance :: Node.List -> Instance.List -> Instance.Instance ->
73
                  Types.Idx -> Types.Idx ->
74
                  (Node.List, Instance.List)
75
assignInstance nl il inst pdx sdx =
76
  let pnode = Container.find pdx nl
77
      snode = Container.find sdx nl
78
      maxiidx = if Container.null il
79
                  then 0
80
                  else fst (Container.findMax il) + 1
81
      inst' = inst { Instance.idx = maxiidx,
82
                     Instance.pNode = pdx, Instance.sNode = sdx }
83
      pnode' = Node.setPri pnode inst'
84
      snode' = Node.setSec snode inst'
85
      nl' = Container.addTwo pdx pnode' sdx snode' nl
86
      il' = Container.add maxiidx inst' il
87
  in (nl', il')
88

    
89
-- | Checks if an instance is mirrored.
90
isMirrored :: Instance.Instance -> Bool
91
isMirrored = (/= Types.MirrorNone) . Instance.mirrorType
92

    
93
-- | Returns the possible change node types for a disk template.
94
evacModeOptions :: Types.MirrorType -> [Types.EvacMode]
95
evacModeOptions Types.MirrorNone     = []
96
evacModeOptions Types.MirrorInternal = [minBound..maxBound] -- DRBD can do all
97
evacModeOptions Types.MirrorExternal = [Types.ChangePrimary, Types.ChangeAll]
98

    
99
-- * Test cases
100

    
101
-- | Check that the cluster score is close to zero for a homogeneous
102
-- cluster.
103
prop_Score_Zero :: Node.Node -> Property
104
prop_Score_Zero node =
105
  forAll (choose (1, 1024)) $ \count ->
106
    (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
107
     (Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
108
  let fn = Node.buildPeers node Container.empty
109
      nlst = replicate count fn
110
      score = Cluster.compCVNodes nlst
111
  -- we can't say == 0 here as the floating point errors accumulate;
112
  -- this should be much lower than the default score in CLI.hs
113
  in score <= 1e-12
114

    
115
-- | Check that cluster stats are sane.
116
prop_CStats_sane :: Property
117
prop_CStats_sane =
118
  forAll (choose (1, 1024)) $ \count ->
119
  forAll genOnlineNode $ \node ->
120
  let fn = Node.buildPeers node Container.empty
121
      nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
122
      nl = Container.fromList nlst
123
      cstats = Cluster.totalResources nl
124
  in Cluster.csAdsk cstats >= 0 &&
125
     Cluster.csAdsk cstats <= Cluster.csFdsk cstats
126

    
127
-- | Check that one instance is allocated correctly, without
128
-- rebalances needed.
129
prop_Alloc_sane :: Instance.Instance -> Property
130
prop_Alloc_sane inst =
131
  forAll (choose (5, 20)) $ \count ->
132
  forAll genOnlineNode $ \node ->
133
  let (nl, il, inst') = makeSmallEmptyCluster node count inst
134
      reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
135
  in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
136
     Cluster.tryAlloc nl il inst' of
137
       Types.Bad msg -> failTest msg
138
       Types.Ok as ->
139
         case Cluster.asSolution as of
140
           Nothing -> failTest "Failed to allocate, empty solution"
141
           Just (xnl, xi, _, cv) ->
142
             let il' = Container.add (Instance.idx xi) xi il
143
                 tbl = Cluster.Table xnl il' cv []
144
             in printTestCase "Cluster can be balanced after allocation"
145
                  (not (canBalance tbl True True False)) .&&.
146
                printTestCase "Solution score differs from actual node list:"
147
                  (Cluster.compCV xnl ==? cv)
148

    
149
-- | Check that multiple instances can allocated correctly, without
150
-- rebalances needed.
151
prop_IterateAlloc_sane :: Instance.Instance -> Property
152
prop_IterateAlloc_sane inst =
153
  forAll (choose (5, 10)) $ \count ->
154
  forAll genOnlineNode $ \node ->
155
  forAll (choose (2, 5)) $ \limit ->
156
  let (nl, il, inst') = makeSmallEmptyCluster node count inst
157
      reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
158
      allocnodes = Cluster.genAllocNodes defGroupList nl reqnodes True
159
  in case allocnodes >>= \allocnodes' ->
160
     Cluster.iterateAlloc nl il (Just limit) inst' allocnodes' [] [] of
161
       Types.Bad msg -> failTest msg
162
       Types.Ok (_, xnl, xil, _, _) ->
163
         let old_score = Cluster.compCV xnl
164
             tbl = Cluster.Table xnl xil old_score []
165
         in case Cluster.tryBalance tbl True True False 0 1e-4 of
166
              Nothing -> passTest
167
              Just (Cluster.Table ynl _ new_score plcs) ->
168
                -- note that with a "min_gain" of zero, sometime
169
                -- rounding errors can trigger a rebalance that
170
                -- improves the score by e.g. 2e-14; in order to
171
                -- prevent such no-real-change moves from happening,
172
                -- we check for a min-gain of 1e-9
173
                -- FIXME: correct rebalancing to not do no-ops
174
                printTestCase
175
                  ("Cluster can be balanced after allocation\n" ++
176
                   " old cluster (score " ++ show old_score ++
177
                   "):\n" ++ Cluster.printNodes xnl [] ++
178
                   " new cluster (score " ++ show new_score ++
179
                   "):\n" ++ Cluster.printNodes ynl [] ++
180
                   "placements:\n" ++ show plcs ++ "\nscore delta: " ++
181
                   show (old_score - new_score))
182
                  (old_score - new_score < 1e-9)
183

    
184
-- | Checks that on a 2-5 node cluster, we can allocate a random
185
-- instance spec via tiered allocation (whatever the original instance
186
-- spec), on either one or two nodes. Furthermore, we test that
187
-- computed allocation statistics are correct.
188
prop_CanTieredAlloc :: Instance.Instance -> Property
189
prop_CanTieredAlloc inst =
190
  forAll (choose (2, 5)) $ \count ->
191
  forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
192
  let nl = makeSmallCluster node count
193
      il = Container.empty
194
      rqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
195
      allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
196
  in case allocnodes >>= \allocnodes' ->
197
    Cluster.tieredAlloc nl il (Just 1) inst allocnodes' [] [] of
198
       Types.Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg
199
       Types.Ok (_, nl', il', ixes, cstats) ->
200
         let (ai_alloc, ai_pool, ai_unav) =
201
               Cluster.computeAllocationDelta
202
                (Cluster.totalResources nl)
203
                (Cluster.totalResources nl')
204
             all_nodes = Container.elems nl
205
         in property (not (null ixes)) .&&.
206
            IntMap.size il' ==? length ixes .&&.
207
            length ixes ==? length cstats .&&.
208
            sum (map Types.allocInfoVCpus [ai_alloc, ai_pool, ai_unav]) ==?
209
              sum (map Node.hiCpu all_nodes) .&&.
210
            sum (map Types.allocInfoNCpus [ai_alloc, ai_pool, ai_unav]) ==?
211
              sum (map Node.tCpu all_nodes) .&&.
212
            sum (map Types.allocInfoMem [ai_alloc, ai_pool, ai_unav]) ==?
213
              truncate (sum (map Node.tMem all_nodes)) .&&.
214
            sum (map Types.allocInfoDisk [ai_alloc, ai_pool, ai_unav]) ==?
215
              truncate (sum (map Node.tDsk all_nodes))
216

    
217
-- | Helper function to create a cluster with the given range of nodes
218
-- and allocate an instance on it.
219
genClusterAlloc :: Int -> Node.Node -> Instance.Instance
220
                -> Types.Result (Node.List, Instance.List, Instance.Instance)
221
genClusterAlloc count node inst =
222
  let nl = makeSmallCluster node count
223
      reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
224
  in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
225
     Cluster.tryAlloc nl Container.empty inst of
226
       Types.Bad _ -> Types.Bad "Can't allocate"
227
       Types.Ok as ->
228
         case Cluster.asSolution as of
229
           Nothing -> Types.Bad "Empty solution?"
230
           Just (xnl, xi, _, _) ->
231
             let xil = Container.add (Instance.idx xi) xi Container.empty
232
             in Types.Ok (xnl, xil, xi)
233

    
234
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
235
-- we can also relocate it.
236
prop_AllocRelocate :: Property
237
prop_AllocRelocate =
238
  forAll (choose (4, 8)) $ \count ->
239
  forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
240
  forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
241
  case genClusterAlloc count node inst of
242
    Types.Bad msg -> failTest msg
243
    Types.Ok (nl, il, inst') ->
244
      case IAlloc.processRelocate defGroupList nl il
245
             (Instance.idx inst) 1
246
             [(if Instance.diskTemplate inst' == Types.DTDrbd8
247
                 then Instance.sNode
248
                 else Instance.pNode) inst'] of
249
        Types.Ok _ -> passTest
250
        Types.Bad msg -> failTest $ "Failed to relocate: " ++ msg
251

    
252
-- | Helper property checker for the result of a nodeEvac or
253
-- changeGroup operation.
254
check_EvacMode :: Group.Group -> Instance.Instance
255
               -> Types.Result (Node.List, Instance.List, Cluster.EvacSolution)
256
               -> Property
257
check_EvacMode grp inst result =
258
  case result of
259
    Types.Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg
260
    Types.Ok (_, _, es) ->
261
      let moved = Cluster.esMoved es
262
          failed = Cluster.esFailed es
263
          opcodes = not . null $ Cluster.esOpCodes es
264
      in failmsg ("'failed' not empty: " ++ show failed) (null failed) .&&.
265
         failmsg "'opcodes' is null" opcodes .&&.
266
         case moved of
267
           [(idx', gdx, _)] -> failmsg "invalid instance moved" (idx == idx')
268
                               .&&.
269
                               failmsg "wrong target group"
270
                                         (gdx == Group.idx grp)
271
           v -> failmsg  ("invalid solution: " ++ show v) False
272
  where failmsg :: String -> Bool -> Property
273
        failmsg msg = printTestCase ("Failed to evacuate: " ++ msg)
274
        idx = Instance.idx inst
275

    
276
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
277
-- we can also node-evacuate it.
278
prop_AllocEvacuate :: Property
279
prop_AllocEvacuate =
280
  forAll (choose (4, 8)) $ \count ->
281
  forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
282
  forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
283
  case genClusterAlloc count node inst of
284
    Types.Bad msg -> failTest msg
285
    Types.Ok (nl, il, inst') ->
286
      conjoin . map (\mode -> check_EvacMode defGroup inst' $
287
                              Cluster.tryNodeEvac defGroupList nl il mode
288
                                [Instance.idx inst']) .
289
                              evacModeOptions .
290
                              Instance.mirrorType $ inst'
291

    
292
-- | Checks that on a 4-8 node cluster with two node groups, once we
293
-- allocate an instance on the first node group, we can also change
294
-- its group.
295
prop_AllocChangeGroup :: Property
296
prop_AllocChangeGroup =
297
  forAll (choose (4, 8)) $ \count ->
298
  forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
299
  forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
300
  case genClusterAlloc count node inst of
301
    Types.Bad msg -> failTest msg
302
    Types.Ok (nl, il, inst') ->
303
      -- we need to add a second node group and nodes to the cluster
304
      let nl2 = Container.elems $ makeSmallCluster node count
305
          grp2 = Group.setIdx defGroup (Group.idx defGroup + 1)
306
          maxndx = maximum . map Node.idx $ nl2
307
          nl3 = map (\n -> n { Node.group = Group.idx grp2
308
                             , Node.idx = Node.idx n + maxndx }) nl2
309
          nl4 = Container.fromList . map (\n -> (Node.idx n, n)) $ nl3
310
          gl' = Container.add (Group.idx grp2) grp2 defGroupList
311
          nl' = IntMap.union nl nl4
312
      in check_EvacMode grp2 inst' $
313
         Cluster.tryChangeGroup gl' nl' il [] [Instance.idx inst']
314

    
315
-- | Check that allocating multiple instances on a cluster, then
316
-- adding an empty node, results in a valid rebalance.
317
prop_AllocBalance :: Property
318
prop_AllocBalance =
319
  forAll (genNode (Just 5) (Just 128)) $ \node ->
320
  forAll (choose (3, 5)) $ \count ->
321
  not (Node.offline node) && not (Node.failN1 node) ==>
322
  let nl = makeSmallCluster node count
323
      (hnode, nl') = IntMap.deleteFindMax nl
324
      il = Container.empty
325
      allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True
326
      i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
327
  in case allocnodes >>= \allocnodes' ->
328
    Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of
329
       Types.Bad msg -> failTest $ "Failed to allocate: " ++ msg
330
       Types.Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances"
331
       Types.Ok (_, xnl, il', _, _) ->
332
         let ynl = Container.add (Node.idx hnode) hnode xnl
333
             cv = Cluster.compCV ynl
334
             tbl = Cluster.Table ynl il' cv []
335
         in printTestCase "Failed to rebalance" $
336
            canBalance tbl True True False
337

    
338
-- | Checks consistency.
339
prop_CheckConsistency :: Node.Node -> Instance.Instance -> Bool
340
prop_CheckConsistency node inst =
341
  let nl = makeSmallCluster node 3
342
      [node1, node2, node3] = Container.elems nl
343
      node3' = node3 { Node.group = 1 }
344
      nl' = Container.add (Node.idx node3') node3' nl
345
      inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2)
346
      inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary
347
      inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3)
348
      ccheck = Cluster.findSplitInstances nl' . Container.fromList
349
  in null (ccheck [(0, inst1)]) &&
350
     null (ccheck [(0, inst2)]) &&
351
     (not . null $ ccheck [(0, inst3)])
352

    
353
-- | For now, we only test that we don't lose instances during the split.
354
prop_SplitCluster :: Node.Node -> Instance.Instance -> Property
355
prop_SplitCluster node inst =
356
  forAll (choose (0, 100)) $ \icnt ->
357
  let nl = makeSmallCluster node 2
358
      (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1)
359
                   (nl, Container.empty) [1..icnt]
360
      gni = Cluster.splitCluster nl' il'
361
  in sum (map (Container.size . snd . snd) gni) == icnt &&
362
     all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group)
363
                                 (Container.elems nl'')) gni
364

    
365
-- | Helper function to check if we can allocate an instance on a
366
-- given node list.
367
canAllocOn :: Node.List -> Int -> Instance.Instance -> Bool
368
canAllocOn nl reqnodes inst =
369
  case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
370
       Cluster.tryAlloc nl Container.empty inst of
371
       Types.Bad _ -> False
372
       Types.Ok as ->
373
         case Cluster.asSolution as of
374
           Nothing -> False
375
           Just _ -> True
376

    
377
-- | Checks that allocation obeys minimum and maximum instance
378
-- policies. The unittest generates a random node, duplicates it /count/
379
-- times, and generates a random instance that can be allocated on
380
-- this mini-cluster; it then checks that after applying a policy that
381
-- the instance doesn't fits, the allocation fails.
382
prop_AllocPolicy :: Node.Node -> Property
383
prop_AllocPolicy node =
384
  -- rqn is the required nodes (1 or 2)
385
  forAll (choose (1, 2)) $ \rqn ->
386
  forAll (choose (5, 20)) $ \count ->
387
  forAll (arbitrary `suchThat` canAllocOn (makeSmallCluster node count) rqn)
388
         $ \inst ->
389
  forAll (arbitrary `suchThat` (isFailure .
390
                                Instance.instMatchesPolicy inst)) $ \ipol ->
391
  let node' = Node.setPolicy ipol node
392
      nl = makeSmallCluster node' count
393
  in not $ canAllocOn nl rqn inst
394

    
395
testSuite "HTools/Cluster"
396
            [ 'prop_Score_Zero
397
            , 'prop_CStats_sane
398
            , 'prop_Alloc_sane
399
            , 'prop_IterateAlloc_sane
400
            , 'prop_CanTieredAlloc
401
            , 'prop_AllocRelocate
402
            , 'prop_AllocEvacuate
403
            , 'prop_AllocChangeGroup
404
            , 'prop_AllocBalance
405
            , 'prop_CheckConsistency
406
            , 'prop_SplitCluster
407
            , 'prop_AllocPolicy
408
            ]