Statistics
| Branch: | Tag: | Revision:

root / htest / Test / Ganeti / HTools / Cluster.hs @ 2e0bb81d

History | View | Annotate | Download (15.4 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
-- * Helpers
51

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

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

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

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

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

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

    
97
-- * Test cases
98

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

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

    
125
-- | Check that one instance is allocated correctly, without
126
-- rebalances needed.
127
prop_Alloc_sane :: Instance.Instance -> Property
128
prop_Alloc_sane inst =
129
  forAll (choose (5, 20)) $ \count ->
130
  forAll genOnlineNode $ \node ->
131
  let (nl, il, inst') = makeSmallEmptyCluster node count inst
132
      reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
133
  in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
134
     Cluster.tryAlloc nl il inst' of
135
       Types.Bad _ -> False
136
       Types.Ok as ->
137
         case Cluster.asSolution as of
138
           Nothing -> False
139
           Just (xnl, xi, _, cv) ->
140
             let il' = Container.add (Instance.idx xi) xi il
141
                 tbl = Cluster.Table xnl il' cv []
142
             in not (canBalance tbl True True False)
143

    
144
-- | Checks that on a 2-5 node cluster, we can allocate a random
145
-- instance spec via tiered allocation (whatever the original instance
146
-- spec), on either one or two nodes. Furthermore, we test that
147
-- computed allocation statistics are correct.
148
prop_CanTieredAlloc :: Instance.Instance -> Property
149
prop_CanTieredAlloc inst =
150
  forAll (choose (2, 5)) $ \count ->
151
  forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
152
  let nl = makeSmallCluster node count
153
      il = Container.empty
154
      rqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
155
      allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
156
  in case allocnodes >>= \allocnodes' ->
157
    Cluster.tieredAlloc nl il (Just 1) inst allocnodes' [] [] of
158
       Types.Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg
159
       Types.Ok (_, nl', il', ixes, cstats) ->
160
         let (ai_alloc, ai_pool, ai_unav) =
161
               Cluster.computeAllocationDelta
162
                (Cluster.totalResources nl)
163
                (Cluster.totalResources nl')
164
             all_nodes = Container.elems nl
165
         in property (not (null ixes)) .&&.
166
            IntMap.size il' ==? length ixes .&&.
167
            length ixes ==? length cstats .&&.
168
            sum (map Types.allocInfoVCpus [ai_alloc, ai_pool, ai_unav]) ==?
169
              sum (map Node.hiCpu all_nodes) .&&.
170
            sum (map Types.allocInfoNCpus [ai_alloc, ai_pool, ai_unav]) ==?
171
              sum (map Node.tCpu all_nodes) .&&.
172
            sum (map Types.allocInfoMem [ai_alloc, ai_pool, ai_unav]) ==?
173
              truncate (sum (map Node.tMem all_nodes)) .&&.
174
            sum (map Types.allocInfoDisk [ai_alloc, ai_pool, ai_unav]) ==?
175
              truncate (sum (map Node.tDsk all_nodes))
176

    
177
-- | Helper function to create a cluster with the given range of nodes
178
-- and allocate an instance on it.
179
genClusterAlloc :: Int -> Node.Node -> Instance.Instance
180
                -> Types.Result (Node.List, Instance.List, Instance.Instance)
181
genClusterAlloc count node inst =
182
  let nl = makeSmallCluster node count
183
      reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
184
  in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
185
     Cluster.tryAlloc nl Container.empty inst of
186
       Types.Bad _ -> Types.Bad "Can't allocate"
187
       Types.Ok as ->
188
         case Cluster.asSolution as of
189
           Nothing -> Types.Bad "Empty solution?"
190
           Just (xnl, xi, _, _) ->
191
             let xil = Container.add (Instance.idx xi) xi Container.empty
192
             in Types.Ok (xnl, xil, xi)
193

    
194
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
195
-- we can also relocate it.
196
prop_AllocRelocate :: Property
197
prop_AllocRelocate =
198
  forAll (choose (4, 8)) $ \count ->
199
  forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
200
  forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
201
  case genClusterAlloc count node inst of
202
    Types.Bad msg -> failTest msg
203
    Types.Ok (nl, il, inst') ->
204
      case IAlloc.processRelocate defGroupList nl il
205
             (Instance.idx inst) 1
206
             [(if Instance.diskTemplate inst' == Types.DTDrbd8
207
                 then Instance.sNode
208
                 else Instance.pNode) inst'] of
209
        Types.Ok _ -> passTest
210
        Types.Bad msg -> failTest $ "Failed to relocate: " ++ msg
211

    
212
-- | Helper property checker for the result of a nodeEvac or
213
-- changeGroup operation.
214
check_EvacMode :: Group.Group -> Instance.Instance
215
               -> Types.Result (Node.List, Instance.List, Cluster.EvacSolution)
216
               -> Property
217
check_EvacMode grp inst result =
218
  case result of
219
    Types.Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg
220
    Types.Ok (_, _, es) ->
221
      let moved = Cluster.esMoved es
222
          failed = Cluster.esFailed es
223
          opcodes = not . null $ Cluster.esOpCodes es
224
      in failmsg ("'failed' not empty: " ++ show failed) (null failed) .&&.
225
         failmsg "'opcodes' is null" opcodes .&&.
226
         case moved of
227
           [(idx', gdx, _)] -> failmsg "invalid instance moved" (idx == idx')
228
                               .&&.
229
                               failmsg "wrong target group"
230
                                         (gdx == Group.idx grp)
231
           v -> failmsg  ("invalid solution: " ++ show v) False
232
  where failmsg :: String -> Bool -> Property
233
        failmsg = \msg -> printTestCase ("Failed to evacuate: " ++ msg)
234
        idx = Instance.idx inst
235

    
236
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
237
-- we can also node-evacuate it.
238
prop_AllocEvacuate :: Property
239
prop_AllocEvacuate =
240
  forAll (choose (4, 8)) $ \count ->
241
  forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
242
  forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
243
  case genClusterAlloc count node inst of
244
    Types.Bad msg -> failTest msg
245
    Types.Ok (nl, il, inst') ->
246
      conjoin . map (\mode -> check_EvacMode defGroup inst' $
247
                              Cluster.tryNodeEvac defGroupList nl il mode
248
                                [Instance.idx inst']) .
249
                              evacModeOptions .
250
                              Instance.mirrorType $ inst'
251

    
252
-- | Checks that on a 4-8 node cluster with two node groups, once we
253
-- allocate an instance on the first node group, we can also change
254
-- its group.
255
prop_AllocChangeGroup :: Property
256
prop_AllocChangeGroup =
257
  forAll (choose (4, 8)) $ \count ->
258
  forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
259
  forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
260
  case genClusterAlloc count node inst of
261
    Types.Bad msg -> failTest msg
262
    Types.Ok (nl, il, inst') ->
263
      -- we need to add a second node group and nodes to the cluster
264
      let nl2 = Container.elems $ makeSmallCluster node count
265
          grp2 = Group.setIdx defGroup (Group.idx defGroup + 1)
266
          maxndx = maximum . map Node.idx $ nl2
267
          nl3 = map (\n -> n { Node.group = Group.idx grp2
268
                             , Node.idx = Node.idx n + maxndx }) nl2
269
          nl4 = Container.fromList . map (\n -> (Node.idx n, n)) $ nl3
270
          gl' = Container.add (Group.idx grp2) grp2 defGroupList
271
          nl' = IntMap.union nl nl4
272
      in check_EvacMode grp2 inst' $
273
         Cluster.tryChangeGroup gl' nl' il [] [Instance.idx inst']
274

    
275
-- | Check that allocating multiple instances on a cluster, then
276
-- adding an empty node, results in a valid rebalance.
277
prop_AllocBalance :: Property
278
prop_AllocBalance =
279
  forAll (genNode (Just 5) (Just 128)) $ \node ->
280
  forAll (choose (3, 5)) $ \count ->
281
  not (Node.offline node) && not (Node.failN1 node) ==>
282
  let nl = makeSmallCluster node count
283
      (hnode, nl') = IntMap.deleteFindMax nl
284
      il = Container.empty
285
      allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True
286
      i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
287
  in case allocnodes >>= \allocnodes' ->
288
    Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of
289
       Types.Bad msg -> failTest $ "Failed to allocate: " ++ msg
290
       Types.Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances"
291
       Types.Ok (_, xnl, il', _, _) ->
292
         let ynl = Container.add (Node.idx hnode) hnode xnl
293
             cv = Cluster.compCV ynl
294
             tbl = Cluster.Table ynl il' cv []
295
         in printTestCase "Failed to rebalance" $
296
            canBalance tbl True True False
297

    
298
-- | Checks consistency.
299
prop_CheckConsistency :: Node.Node -> Instance.Instance -> Bool
300
prop_CheckConsistency node inst =
301
  let nl = makeSmallCluster node 3
302
      [node1, node2, node3] = Container.elems nl
303
      node3' = node3 { Node.group = 1 }
304
      nl' = Container.add (Node.idx node3') node3' nl
305
      inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2)
306
      inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary
307
      inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3)
308
      ccheck = Cluster.findSplitInstances nl' . Container.fromList
309
  in null (ccheck [(0, inst1)]) &&
310
     null (ccheck [(0, inst2)]) &&
311
     (not . null $ ccheck [(0, inst3)])
312

    
313
-- | For now, we only test that we don't lose instances during the split.
314
prop_SplitCluster :: Node.Node -> Instance.Instance -> Property
315
prop_SplitCluster node inst =
316
  forAll (choose (0, 100)) $ \icnt ->
317
  let nl = makeSmallCluster node 2
318
      (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1)
319
                   (nl, Container.empty) [1..icnt]
320
      gni = Cluster.splitCluster nl' il'
321
  in sum (map (Container.size . snd . snd) gni) == icnt &&
322
     all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group)
323
                                 (Container.elems nl'')) gni
324

    
325
-- | Helper function to check if we can allocate an instance on a
326
-- given node list.
327
canAllocOn :: Node.List -> Int -> Instance.Instance -> Bool
328
canAllocOn nl reqnodes inst =
329
  case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
330
       Cluster.tryAlloc nl (Container.empty) inst of
331
       Types.Bad _ -> False
332
       Types.Ok as ->
333
         case Cluster.asSolution as of
334
           Nothing -> False
335
           Just _ -> True
336

    
337
-- | Checks that allocation obeys minimum and maximum instance
338
-- policies. The unittest generates a random node, duplicates it /count/
339
-- times, and generates a random instance that can be allocated on
340
-- this mini-cluster; it then checks that after applying a policy that
341
-- the instance doesn't fits, the allocation fails.
342
prop_AllocPolicy :: Node.Node -> Property
343
prop_AllocPolicy node =
344
  -- rqn is the required nodes (1 or 2)
345
  forAll (choose (1, 2)) $ \rqn ->
346
  forAll (choose (5, 20)) $ \count ->
347
  forAll (arbitrary `suchThat` (canAllocOn (makeSmallCluster node count) rqn))
348
         $ \inst ->
349
  forAll (arbitrary `suchThat` (isFailure .
350
                                Instance.instMatchesPolicy inst)) $ \ipol ->
351
  let node' = Node.setPolicy ipol node
352
      nl = makeSmallCluster node' count
353
  in not $ canAllocOn nl rqn inst
354

    
355
testSuite "HTools/Cluster"
356
            [ 'prop_Score_Zero
357
            , 'prop_CStats_sane
358
            , 'prop_Alloc_sane
359
            , 'prop_CanTieredAlloc
360
            , 'prop_AllocRelocate
361
            , 'prop_AllocEvacuate
362
            , 'prop_AllocChangeGroup
363
            , 'prop_AllocBalance
364
            , 'prop_CheckConsistency
365
            , 'prop_SplitCluster
366
            , 'prop_AllocPolicy
367
            ]