Revision e1ee7d5a

b/Makefile.am
64 64
	htest/Test \
65 65
	htest/Test/Ganeti \
66 66
	htest/Test/Ganeti/Confd \
67
	htest/Test/Ganeti/HTools \
67 68
	htest/Test/Ganeti/Query
68 69

  
69 70
DIRS = \
......
378 379
	--exclude Ganeti.THH \
379 380
	--exclude Ganeti.HTools.QC \
380 381
	--exclude Ganeti.HTools.Version \
381
	--exclude Test.Ganeti.TestHelper \
382 382
	--exclude Test.Ganeti.TestCommon \
383
	--exclude Test.Ganeti.TestHTools \
384
	--exclude Test.Ganeti.TestHelper \
383 385
	$(patsubst htools.%,--exclude Test.%,$(subst /,.,$(patsubst %.hs,%, $(filter-out htest/%,$(HS_LIB_SRCS)))))
384 386

  
385 387
HS_LIB_SRCS = \
......
432 434
	htools/Ganeti/Runtime.hs \
433 435
	htools/Ganeti/Ssconf.hs \
434 436
	htools/Ganeti/THH.hs \
435
	htest/Test/Ganeti/TestHelper.hs \
436
	htest/Test/Ganeti/TestCommon.hs \
437 437
	htest/Test/Ganeti/Confd/Utils.hs \
438
	htest/Test/Ganeti/HTools/CLI.hs \
439
	htest/Test/Ganeti/HTools/Cluster.hs \
440
	htest/Test/Ganeti/HTools/Container.hs \
441
	htest/Test/Ganeti/HTools/Instance.hs \
442
	htest/Test/Ganeti/HTools/Loader.hs \
443
	htest/Test/Ganeti/HTools/Node.hs \
444
	htest/Test/Ganeti/HTools/PeerMap.hs \
445
	htest/Test/Ganeti/HTools/Simu.hs \
446
	htest/Test/Ganeti/HTools/Text.hs \
447
	htest/Test/Ganeti/HTools/Types.hs \
448
	htest/Test/Ganeti/HTools/Utils.hs \
438 449
	htest/Test/Ganeti/Luxi.hs \
439 450
	htest/Test/Ganeti/Objects.hs \
440 451
	htest/Test/Ganeti/OpCodes.hs \
441 452
	htest/Test/Ganeti/Query/Language.hs \
442 453
	htest/Test/Ganeti/Rpc.hs \
443
	htest/Test/Ganeti/Ssconf.hs
454
	htest/Test/Ganeti/Ssconf.hs \
455
	htest/Test/Ganeti/TestCommon.hs \
456
	htest/Test/Ganeti/TestHTools.hs \
457
	htest/Test/Ganeti/TestHelper.hs
444 458

  
445 459

  
446 460
HS_BUILT_SRCS = htools/Ganeti/HTools/Version.hs htools/Ganeti/Constants.hs
b/htest/Test/Ganeti/HTools/CLI.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.CLI (testCLI) where
30

  
31
import Test.QuickCheck
32

  
33
import Control.Monad
34
import Data.List
35
import Text.Printf (printf)
36
import qualified System.Console.GetOpt as GetOpt
37

  
38
import Test.Ganeti.TestHelper
39
import Test.Ganeti.TestCommon
40

  
41
import qualified Ganeti.HTools.CLI as CLI
42
import qualified Ganeti.HTools.Program as Program
43
import qualified Ganeti.HTools.Types as Types
44

  
45
-- | Test correct parsing.
46
prop_CLI_parseISpec :: String -> Int -> Int -> Int -> Property
47
prop_CLI_parseISpec descr dsk mem cpu =
48
  let str = printf "%d,%d,%d" dsk mem cpu::String
49
  in CLI.parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk)
50

  
51
-- | Test parsing failure due to wrong section count.
52
prop_CLI_parseISpecFail :: String -> Property
53
prop_CLI_parseISpecFail descr =
54
  forAll (choose (0,100) `suchThat` ((/=) 3)) $ \nelems ->
55
  forAll (replicateM nelems arbitrary) $ \values ->
56
  let str = intercalate "," $ map show (values::[Int])
57
  in case CLI.parseISpecString descr str of
58
       Types.Ok v -> failTest $ "Expected failure, got " ++ show v
59
       _ -> property True
60

  
61
-- | Test parseYesNo.
62
prop_CLI_parseYesNo :: Bool -> Bool -> [Char] -> Property
63
prop_CLI_parseYesNo def testval val =
64
  forAll (elements [val, "yes", "no"]) $ \actual_val ->
65
  if testval
66
    then CLI.parseYesNo def Nothing ==? Types.Ok def
67
    else let result = CLI.parseYesNo def (Just actual_val)
68
         in if actual_val `elem` ["yes", "no"]
69
              then result ==? Types.Ok (actual_val == "yes")
70
              else property $ Types.isBad result
71

  
72
-- | Helper to check for correct parsing of string arg.
73
checkStringArg :: [Char]
74
               -> (GetOpt.OptDescr (CLI.Options -> Types.Result CLI.Options),
75
                   CLI.Options -> Maybe [Char])
76
               -> Property
77
checkStringArg val (opt, fn) =
78
  let GetOpt.Option _ longs _ _ = opt
79
  in case longs of
80
       [] -> failTest "no long options?"
81
       cmdarg:_ ->
82
         case CLI.parseOptsInner ["--" ++ cmdarg ++ "=" ++ val] "prog" [opt] of
83
           Left e -> failTest $ "Failed to parse option: " ++ show e
84
           Right (options, _) -> fn options ==? Just val
85

  
86
-- | Test a few string arguments.
87
prop_CLI_StringArg :: [Char] -> Property
88
prop_CLI_StringArg argument =
89
  let args = [ (CLI.oDataFile,      CLI.optDataFile)
90
             , (CLI.oDynuFile,      CLI.optDynuFile)
91
             , (CLI.oSaveCluster,   CLI.optSaveCluster)
92
             , (CLI.oReplay,        CLI.optReplay)
93
             , (CLI.oPrintCommands, CLI.optShowCmds)
94
             , (CLI.oLuxiSocket,    CLI.optLuxi)
95
             ]
96
  in conjoin $ map (checkStringArg argument) args
97

  
98
-- | Helper to test that a given option is accepted OK with quick exit.
99
checkEarlyExit :: String -> [CLI.OptType] -> String -> Property
100
checkEarlyExit name options param =
101
  case CLI.parseOptsInner [param] name options of
102
    Left (code, _) -> if code == 0
103
                          then property True
104
                          else failTest $ "Program " ++ name ++
105
                                 " returns invalid code " ++ show code ++
106
                                 " for option " ++ param
107
    _ -> failTest $ "Program " ++ name ++ " doesn't consider option " ++
108
         param ++ " as early exit one"
109

  
110
-- | Test that all binaries support some common options. There is
111
-- nothing actually random about this test...
112
prop_CLI_stdopts :: Property
113
prop_CLI_stdopts =
114
  let params = ["-h", "--help", "-V", "--version"]
115
      opts = map (\(name, (_, o)) -> (name, o)) Program.personalities
116
      -- apply checkEarlyExit across the cartesian product of params and opts
117
  in conjoin [checkEarlyExit n o p | p <- params, (n, o) <- opts]
118

  
119
testSuite "CLI"
120
          [ 'prop_CLI_parseISpec
121
          , 'prop_CLI_parseISpecFail
122
          , 'prop_CLI_parseYesNo
123
          , 'prop_CLI_StringArg
124
          , 'prop_CLI_stdopts
125
          ]
b/htest/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 (testCluster) 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_Cluster_Score_Zero :: Node.Node -> Property
102
prop_Cluster_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_Cluster_CStats_sane :: Property
115
prop_Cluster_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_Cluster_Alloc_sane :: Instance.Instance -> Property
128
prop_Cluster_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_Cluster_CanTieredAlloc :: Instance.Instance -> Property
149
prop_Cluster_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_Cluster_AllocRelocate :: Property
197
prop_Cluster_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 _ -> property True
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_Cluster_AllocEvacuate :: Property
239
prop_Cluster_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_Cluster_AllocChangeGroup :: Property
256
prop_Cluster_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_Cluster_AllocBalance :: Property
278
prop_Cluster_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_Cluster_CheckConsistency :: Node.Node -> Instance.Instance -> Bool
300
prop_Cluster_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_Cluster_SplitCluster :: Node.Node -> Instance.Instance -> Property
315
prop_Cluster_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_Cluster_AllocPolicy :: Node.Node -> Property
343
prop_Cluster_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 "Cluster"
356
            [ 'prop_Cluster_Score_Zero
357
            , 'prop_Cluster_CStats_sane
358
            , 'prop_Cluster_Alloc_sane
359
            , 'prop_Cluster_CanTieredAlloc
360
            , 'prop_Cluster_AllocRelocate
361
            , 'prop_Cluster_AllocEvacuate
362
            , 'prop_Cluster_AllocChangeGroup
363
            , 'prop_Cluster_AllocBalance
364
            , 'prop_Cluster_CheckConsistency
365
            , 'prop_Cluster_SplitCluster
366
            , 'prop_Cluster_AllocPolicy
367
            ]
b/htest/Test/Ganeti/HTools/Container.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.Container (testContainer) where
30

  
31
import Test.QuickCheck
32

  
33
import Data.Maybe
34

  
35
import Test.Ganeti.TestHelper
36
import Test.Ganeti.TestCommon
37
import Test.Ganeti.TestHTools
38
import Test.Ganeti.HTools.Node (genNode)
39

  
40
import qualified Ganeti.HTools.Container as Container
41
import qualified Ganeti.HTools.Node as Node
42

  
43
-- we silence the following due to hlint bug fixed in later versions
44
{-# ANN prop_Container_addTwo "HLint: ignore Avoid lambda" #-}
45
prop_Container_addTwo :: [Container.Key] -> Int -> Int -> Bool
46
prop_Container_addTwo cdata i1 i2 =
47
  fn i1 i2 cont == fn i2 i1 cont &&
48
  fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
49
    where cont = foldl (\c x -> Container.add x x c) Container.empty cdata
50
          fn x1 x2 = Container.addTwo x1 x1 x2 x2
51

  
52
prop_Container_nameOf :: Node.Node -> Property
53
prop_Container_nameOf node =
54
  let nl = makeSmallCluster node 1
55
      fnode = head (Container.elems nl)
56
  in Container.nameOf nl (Node.idx fnode) ==? Node.name fnode
57

  
58
-- | We test that in a cluster, given a random node, we can find it by
59
-- its name and alias, as long as all names and aliases are unique,
60
-- and that we fail to find a non-existing name.
61
prop_Container_findByName :: Property
62
prop_Container_findByName =
63
  forAll (genNode (Just 1) Nothing) $ \node ->
64
  forAll (choose (1, 20)) $ \ cnt ->
65
  forAll (choose (0, cnt - 1)) $ \ fidx ->
66
  forAll (genUniquesList (cnt * 2)) $ \ allnames ->
67
  forAll (arbitrary `suchThat` (`notElem` allnames)) $ \ othername ->
68
  let names = zip (take cnt allnames) (drop cnt allnames)
69
      nl = makeSmallCluster node cnt
70
      nodes = Container.elems nl
71
      nodes' = map (\((name, alias), nn) -> (Node.idx nn,
72
                                             nn { Node.name = name,
73
                                                  Node.alias = alias }))
74
               $ zip names nodes
75
      nl' = Container.fromList nodes'
76
      target = snd (nodes' !! fidx)
77
  in Container.findByName nl' (Node.name target) ==? Just target .&&.
78
     Container.findByName nl' (Node.alias target) ==? Just target .&&.
79
     printTestCase "Found non-existing name"
80
       (isNothing (Container.findByName nl' othername))
81

  
82
testSuite "Container"
83
            [ 'prop_Container_addTwo
84
            , 'prop_Container_nameOf
85
            , 'prop_Container_findByName
86
            ]
b/htest/Test/Ganeti/HTools/Instance.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.Instance
30
  ( testInstance
31
  , genInstanceSmallerThanNode
32
  , Instance.Instance(..)
33
  ) where
34

  
35
import Test.QuickCheck
36

  
37
import Test.Ganeti.TestHelper
38
import Test.Ganeti.TestCommon
39
import Test.Ganeti.HTools.Types ()
40

  
41
import qualified Ganeti.HTools.Instance as Instance
42
import qualified Ganeti.HTools.Node as Node
43
import qualified Ganeti.HTools.Types as Types
44

  
45
-- * Arbitrary instances
46

  
47
-- | Generates a random instance with maximum disk/mem/cpu values.
48
genInstanceSmallerThan :: Int -> Int -> Int -> Gen Instance.Instance
49
genInstanceSmallerThan lim_mem lim_dsk lim_cpu = do
50
  name <- getFQDN
51
  mem <- choose (0, lim_mem)
52
  dsk <- choose (0, lim_dsk)
53
  run_st <- arbitrary
54
  pn <- arbitrary
55
  sn <- arbitrary
56
  vcpus <- choose (0, lim_cpu)
57
  dt <- arbitrary
58
  return $ Instance.create name mem dsk vcpus run_st [] True pn sn dt 1
59

  
60
-- | Generates an instance smaller than a node.
61
genInstanceSmallerThanNode :: Node.Node -> Gen Instance.Instance
62
genInstanceSmallerThanNode node =
63
  genInstanceSmallerThan (Node.availMem node `div` 2)
64
                         (Node.availDisk node `div` 2)
65
                         (Node.availCpu node `div` 2)
66

  
67
-- let's generate a random instance
68
instance Arbitrary Instance.Instance where
69
  arbitrary = genInstanceSmallerThan maxMem maxDsk maxCpu
70

  
71
-- * Test cases
72

  
73
-- Simple instance tests, we only have setter/getters
74

  
75
prop_Instance_creat :: Instance.Instance -> Property
76
prop_Instance_creat inst =
77
  Instance.name inst ==? Instance.alias inst
78

  
79
prop_Instance_setIdx :: Instance.Instance -> Types.Idx -> Property
80
prop_Instance_setIdx inst idx =
81
  Instance.idx (Instance.setIdx inst idx) ==? idx
82

  
83
prop_Instance_setName :: Instance.Instance -> String -> Bool
84
prop_Instance_setName inst name =
85
  Instance.name newinst == name &&
86
  Instance.alias newinst == name
87
    where newinst = Instance.setName inst name
88

  
89
prop_Instance_setAlias :: Instance.Instance -> String -> Bool
90
prop_Instance_setAlias inst name =
91
  Instance.name newinst == Instance.name inst &&
92
  Instance.alias newinst == name
93
    where newinst = Instance.setAlias inst name
94

  
95
prop_Instance_setPri :: Instance.Instance -> Types.Ndx -> Property
96
prop_Instance_setPri inst pdx =
97
  Instance.pNode (Instance.setPri inst pdx) ==? pdx
98

  
99
prop_Instance_setSec :: Instance.Instance -> Types.Ndx -> Property
100
prop_Instance_setSec inst sdx =
101
  Instance.sNode (Instance.setSec inst sdx) ==? sdx
102

  
103
prop_Instance_setBoth :: Instance.Instance -> Types.Ndx -> Types.Ndx -> Bool
104
prop_Instance_setBoth inst pdx sdx =
105
  Instance.pNode si == pdx && Instance.sNode si == sdx
106
    where si = Instance.setBoth inst pdx sdx
107

  
108
prop_Instance_shrinkMG :: Instance.Instance -> Property
109
prop_Instance_shrinkMG inst =
110
  Instance.mem inst >= 2 * Types.unitMem ==>
111
    case Instance.shrinkByType inst Types.FailMem of
112
      Types.Ok inst' -> Instance.mem inst' == Instance.mem inst - Types.unitMem
113
      _ -> False
114

  
115
prop_Instance_shrinkMF :: Instance.Instance -> Property
116
prop_Instance_shrinkMF inst =
117
  forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
118
    let inst' = inst { Instance.mem = mem}
119
    in Types.isBad $ Instance.shrinkByType inst' Types.FailMem
120

  
121
prop_Instance_shrinkCG :: Instance.Instance -> Property
122
prop_Instance_shrinkCG inst =
123
  Instance.vcpus inst >= 2 * Types.unitCpu ==>
124
    case Instance.shrinkByType inst Types.FailCPU of
125
      Types.Ok inst' ->
126
        Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
127
      _ -> False
128

  
129
prop_Instance_shrinkCF :: Instance.Instance -> Property
130
prop_Instance_shrinkCF inst =
131
  forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
132
    let inst' = inst { Instance.vcpus = vcpus }
133
    in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU
134

  
135
prop_Instance_shrinkDG :: Instance.Instance -> Property
136
prop_Instance_shrinkDG inst =
137
  Instance.dsk inst >= 2 * Types.unitDsk ==>
138
    case Instance.shrinkByType inst Types.FailDisk of
139
      Types.Ok inst' ->
140
        Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
141
      _ -> False
142

  
143
prop_Instance_shrinkDF :: Instance.Instance -> Property
144
prop_Instance_shrinkDF inst =
145
  forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
146
    let inst' = inst { Instance.dsk = dsk }
147
    in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk
148

  
149
prop_Instance_setMovable :: Instance.Instance -> Bool -> Property
150
prop_Instance_setMovable inst m =
151
  Instance.movable inst' ==? m
152
    where inst' = Instance.setMovable inst m
153

  
154
testSuite "Instance"
155
            [ 'prop_Instance_creat
156
            , 'prop_Instance_setIdx
157
            , 'prop_Instance_setName
158
            , 'prop_Instance_setAlias
159
            , 'prop_Instance_setPri
160
            , 'prop_Instance_setSec
161
            , 'prop_Instance_setBoth
162
            , 'prop_Instance_shrinkMG
163
            , 'prop_Instance_shrinkMF
164
            , 'prop_Instance_shrinkCG
165
            , 'prop_Instance_shrinkCF
166
            , 'prop_Instance_shrinkDG
167
            , 'prop_Instance_shrinkDF
168
            , 'prop_Instance_setMovable
169
            ]
b/htest/Test/Ganeti/HTools/Loader.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.Loader (testLoader) where
30

  
31
import Test.QuickCheck
32

  
33
import qualified Data.IntMap as IntMap
34
import qualified Data.Map as Map
35
import Data.List
36

  
37
import Test.Ganeti.TestHelper
38
import Test.Ganeti.TestCommon
39
import Test.Ganeti.HTools.Node ()
40

  
41
import qualified Ganeti.BasicTypes as BasicTypes
42
import qualified Ganeti.HTools.Container as Container
43
import qualified Ganeti.HTools.Loader as Loader
44
import qualified Ganeti.HTools.Node as Node
45
import qualified Ganeti.HTools.Types as Types
46

  
47
prop_Loader_lookupNode :: [(String, Int)] -> String -> String -> Property
48
prop_Loader_lookupNode ktn inst node =
49
  Loader.lookupNode nl inst node ==? Map.lookup node nl
50
    where nl = Map.fromList ktn
51

  
52
prop_Loader_lookupInstance :: [(String, Int)] -> String -> Property
53
prop_Loader_lookupInstance kti inst =
54
  Loader.lookupInstance il inst ==? Map.lookup inst il
55
    where il = Map.fromList kti
56

  
57
prop_Loader_assignIndices :: Property
58
prop_Loader_assignIndices =
59
  -- generate nodes with unique names
60
  forAll (arbitrary `suchThat`
61
          (\nodes ->
62
             let names = map Node.name nodes
63
             in length names == length (nub names))) $ \nodes ->
64
  let (nassoc, kt) =
65
        Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)
66
  in Map.size nassoc == length nodes &&
67
     Container.size kt == length nodes &&
68
     if not (null nodes)
69
       then maximum (IntMap.keys kt) == length nodes - 1
70
       else True
71

  
72
-- | Checks that the number of primary instances recorded on the nodes
73
-- is zero.
74
prop_Loader_mergeData :: [Node.Node] -> Bool
75
prop_Loader_mergeData ns =
76
  let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns
77
  in case Loader.mergeData [] [] [] []
78
         (Loader.emptyCluster {Loader.cdNodes = na}) of
79
    Types.Bad _ -> False
80
    Types.Ok (Loader.ClusterData _ nl il _ _) ->
81
      let nodes = Container.elems nl
82
          instances = Container.elems il
83
      in (sum . map (length . Node.pList)) nodes == 0 &&
84
         null instances
85

  
86
-- | Check that compareNameComponent on equal strings works.
87
prop_Loader_compareNameComponent_equal :: String -> Bool
88
prop_Loader_compareNameComponent_equal s =
89
  BasicTypes.compareNameComponent s s ==
90
    BasicTypes.LookupResult BasicTypes.ExactMatch s
91

  
92
-- | Check that compareNameComponent on prefix strings works.
93
prop_Loader_compareNameComponent_prefix :: NonEmptyList Char -> String -> Bool
94
prop_Loader_compareNameComponent_prefix (NonEmpty s1) s2 =
95
  BasicTypes.compareNameComponent (s1 ++ "." ++ s2) s1 ==
96
    BasicTypes.LookupResult BasicTypes.PartialMatch s1
97

  
98
testSuite "Loader"
99
            [ 'prop_Loader_lookupNode
100
            , 'prop_Loader_lookupInstance
101
            , 'prop_Loader_assignIndices
102
            , 'prop_Loader_mergeData
103
            , 'prop_Loader_compareNameComponent_equal
104
            , 'prop_Loader_compareNameComponent_prefix
105
            ]
b/htest/Test/Ganeti/HTools/Node.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.Node
30
  ( testNode
31
  , Node.Node(..)
32
  , setInstanceSmallerThanNode
33
  , genNode
34
  , genOnlineNode
35
  ) where
36

  
37
import Test.QuickCheck
38

  
39
import Control.Monad
40
import qualified Data.Map as Map
41
import Data.List
42

  
43
import Test.Ganeti.TestHelper
44
import Test.Ganeti.TestCommon
45
import Test.Ganeti.TestHTools
46
import Test.Ganeti.HTools.Instance (genInstanceSmallerThanNode)
47

  
48
import qualified Ganeti.HTools.Container as Container
49
import qualified Ganeti.HTools.Instance as Instance
50
import qualified Ganeti.HTools.Node as Node
51
import qualified Ganeti.HTools.Types as Types
52

  
53
-- * Arbitrary instances
54

  
55
-- | Generas an arbitrary node based on sizing information.
56
genNode :: Maybe Int -- ^ Minimum node size in terms of units
57
        -> Maybe Int -- ^ Maximum node size (when Nothing, bounded
58
                     -- just by the max... constants)
59
        -> Gen Node.Node
60
genNode min_multiplier max_multiplier = do
61
  let (base_mem, base_dsk, base_cpu) =
62
        case min_multiplier of
63
          Just mm -> (mm * Types.unitMem,
64
                      mm * Types.unitDsk,
65
                      mm * Types.unitCpu)
66
          Nothing -> (0, 0, 0)
67
      (top_mem, top_dsk, top_cpu)  =
68
        case max_multiplier of
69
          Just mm -> (mm * Types.unitMem,
70
                      mm * Types.unitDsk,
71
                      mm * Types.unitCpu)
72
          Nothing -> (maxMem, maxDsk, maxCpu)
73
  name  <- getFQDN
74
  mem_t <- choose (base_mem, top_mem)
75
  mem_f <- choose (base_mem, mem_t)
76
  mem_n <- choose (0, mem_t - mem_f)
77
  dsk_t <- choose (base_dsk, top_dsk)
78
  dsk_f <- choose (base_dsk, dsk_t)
79
  cpu_t <- choose (base_cpu, top_cpu)
80
  offl  <- arbitrary
81
  let n = Node.create name (fromIntegral mem_t) mem_n mem_f
82
          (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl 1 0
83
      n' = Node.setPolicy nullIPolicy n
84
  return $ Node.buildPeers n' Container.empty
85

  
86
-- | Helper function to generate a sane node.
87
genOnlineNode :: Gen Node.Node
88
genOnlineNode = do
89
  arbitrary `suchThat` (\n -> not (Node.offline n) &&
90
                              not (Node.failN1 n) &&
91
                              Node.availDisk n > 0 &&
92
                              Node.availMem n > 0 &&
93
                              Node.availCpu n > 0)
94

  
95
-- and a random node
96
instance Arbitrary Node.Node where
97
  arbitrary = genNode Nothing Nothing
98

  
99
-- * Test cases
100

  
101
prop_Node_setAlias :: Node.Node -> String -> Bool
102
prop_Node_setAlias node name =
103
  Node.name newnode == Node.name node &&
104
  Node.alias newnode == name
105
    where newnode = Node.setAlias node name
106

  
107
prop_Node_setOffline :: Node.Node -> Bool -> Property
108
prop_Node_setOffline node status =
109
  Node.offline newnode ==? status
110
    where newnode = Node.setOffline node status
111

  
112
prop_Node_setXmem :: Node.Node -> Int -> Property
113
prop_Node_setXmem node xm =
114
  Node.xMem newnode ==? xm
115
    where newnode = Node.setXmem node xm
116

  
117
prop_Node_setMcpu :: Node.Node -> Double -> Property
118
prop_Node_setMcpu node mc =
119
  Types.iPolicyVcpuRatio (Node.iPolicy newnode) ==? mc
120
    where newnode = Node.setMcpu node mc
121

  
122
-- | Check that an instance add with too high memory or disk will be
123
-- rejected.
124
prop_Node_addPriFM :: Node.Node -> Instance.Instance -> Property
125
prop_Node_addPriFM node inst =
126
  Instance.mem inst >= Node.fMem node && not (Node.failN1 node) &&
127
  not (Instance.isOffline inst) ==>
128
  case Node.addPri node inst'' of
129
    Types.OpFail Types.FailMem -> True
130
    _ -> False
131
  where inst' = setInstanceSmallerThanNode node inst
132
        inst'' = inst' { Instance.mem = Instance.mem inst }
133

  
134
-- | Check that adding a primary instance with too much disk fails
135
-- with type FailDisk.
136
prop_Node_addPriFD :: Node.Node -> Instance.Instance -> Property
137
prop_Node_addPriFD node inst =
138
  forAll (elements Instance.localStorageTemplates) $ \dt ->
139
  Instance.dsk inst >= Node.fDsk node && not (Node.failN1 node) ==>
140
  let inst' = setInstanceSmallerThanNode node inst
141
      inst'' = inst' { Instance.dsk = Instance.dsk inst
142
                     , Instance.diskTemplate = dt }
143
  in case Node.addPri node inst'' of
144
       Types.OpFail Types.FailDisk -> True
145
       _ -> False
146

  
147
-- | Check that adding a primary instance with too many VCPUs fails
148
-- with type FailCPU.
149
prop_Node_addPriFC :: Property
150
prop_Node_addPriFC =
151
  forAll (choose (1, maxCpu)) $ \extra ->
152
  forAll genOnlineNode $ \node ->
153
  forAll (arbitrary `suchThat` Instance.notOffline) $ \inst ->
154
  let inst' = setInstanceSmallerThanNode node inst
155
      inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
156
  in case Node.addPri node inst'' of
157
       Types.OpFail Types.FailCPU -> property True
158
       v -> failTest $ "Expected OpFail FailCPU, but got " ++ show v
159

  
160
-- | Check that an instance add with too high memory or disk will be
161
-- rejected.
162
prop_Node_addSec :: Node.Node -> Instance.Instance -> Int -> Property
163
prop_Node_addSec node inst pdx =
164
  ((Instance.mem inst >= (Node.fMem node - Node.rMem node) &&
165
    not (Instance.isOffline inst)) ||
166
   Instance.dsk inst >= Node.fDsk node) &&
167
  not (Node.failN1 node) ==>
168
      isFailure (Node.addSec node inst pdx)
169

  
170
-- | Check that an offline instance with reasonable disk size but
171
-- extra mem/cpu can always be added.
172
prop_Node_addOfflinePri :: NonNegative Int -> NonNegative Int -> Property
173
prop_Node_addOfflinePri (NonNegative extra_mem) (NonNegative extra_cpu) =
174
  forAll genOnlineNode $ \node ->
175
  forAll (genInstanceSmallerThanNode node) $ \inst ->
176
  let inst' = inst { Instance.runSt = Types.AdminOffline
177
                   , Instance.mem = Node.availMem node + extra_mem
178
                   , Instance.vcpus = Node.availCpu node + extra_cpu }
179
  in case Node.addPri node inst' of
180
       Types.OpGood _ -> property True
181
       v -> failTest $ "Expected OpGood, but got: " ++ show v
182

  
183
-- | Check that an offline instance with reasonable disk size but
184
-- extra mem/cpu can always be added.
185
prop_Node_addOfflineSec :: NonNegative Int -> NonNegative Int
186
                        -> Types.Ndx -> Property
187
prop_Node_addOfflineSec (NonNegative extra_mem) (NonNegative extra_cpu) pdx =
188
  forAll genOnlineNode $ \node ->
189
  forAll (genInstanceSmallerThanNode node) $ \inst ->
190
  let inst' = inst { Instance.runSt = Types.AdminOffline
191
                   , Instance.mem = Node.availMem node + extra_mem
192
                   , Instance.vcpus = Node.availCpu node + extra_cpu
193
                   , Instance.diskTemplate = Types.DTDrbd8 }
194
  in case Node.addSec node inst' pdx of
195
       Types.OpGood _ -> property True
196
       v -> failTest $ "Expected OpGood/OpGood, but got: " ++ show v
197

  
198
-- | Checks for memory reservation changes.
199
prop_Node_rMem :: Instance.Instance -> Property
200
prop_Node_rMem inst =
201
  not (Instance.isOffline inst) ==>
202
  forAll (genOnlineNode `suchThat` ((> Types.unitMem) . Node.fMem)) $ \node ->
203
  -- ab = auto_balance, nb = non-auto_balance
204
  -- we use -1 as the primary node of the instance
205
  let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True
206
                   , Instance.diskTemplate = Types.DTDrbd8 }
207
      inst_ab = setInstanceSmallerThanNode node inst'
208
      inst_nb = inst_ab { Instance.autoBalance = False }
209
      -- now we have the two instances, identical except the
210
      -- autoBalance attribute
211
      orig_rmem = Node.rMem node
212
      inst_idx = Instance.idx inst_ab
213
      node_add_ab = Node.addSec node inst_ab (-1)
214
      node_add_nb = Node.addSec node inst_nb (-1)
215
      node_del_ab = liftM (`Node.removeSec` inst_ab) node_add_ab
216
      node_del_nb = liftM (`Node.removeSec` inst_nb) node_add_nb
217
  in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of
218
       (Types.OpGood a_ab, Types.OpGood a_nb,
219
        Types.OpGood d_ab, Types.OpGood d_nb) ->
220
         printTestCase "Consistency checks failed" $
221
           Node.rMem a_ab >  orig_rmem &&
222
           Node.rMem a_ab - orig_rmem == Instance.mem inst_ab &&
223
           Node.rMem a_nb == orig_rmem &&
224
           Node.rMem d_ab == orig_rmem &&
225
           Node.rMem d_nb == orig_rmem &&
226
           -- this is not related to rMem, but as good a place to
227
           -- test as any
228
           inst_idx `elem` Node.sList a_ab &&
229
           inst_idx `notElem` Node.sList d_ab
230
       x -> failTest $ "Failed to add/remove instances: " ++ show x
231

  
232
-- | Check mdsk setting.
233
prop_Node_setMdsk :: Node.Node -> SmallRatio -> Bool
234
prop_Node_setMdsk node mx =
235
  Node.loDsk node' >= 0 &&
236
  fromIntegral (Node.loDsk node') <= Node.tDsk node &&
237
  Node.availDisk node' >= 0 &&
238
  Node.availDisk node' <= Node.fDsk node' &&
239
  fromIntegral (Node.availDisk node') <= Node.tDsk node' &&
240
  Node.mDsk node' == mx'
241
    where node' = Node.setMdsk node mx'
242
          SmallRatio mx' = mx
243

  
244
-- Check tag maps
245
prop_Node_tagMaps_idempotent :: Property
246
prop_Node_tagMaps_idempotent =
247
  forAll genTags $ \tags ->
248
  Node.delTags (Node.addTags m tags) tags ==? m
249
    where m = Map.empty
250

  
251
prop_Node_tagMaps_reject :: Property
252
prop_Node_tagMaps_reject =
253
  forAll (genTags `suchThat` (not . null)) $ \tags ->
254
  let m = Node.addTags Map.empty tags
255
  in all (\t -> Node.rejectAddTags m [t]) tags
256

  
257
prop_Node_showField :: Node.Node -> Property
258
prop_Node_showField node =
259
  forAll (elements Node.defaultFields) $ \ field ->
260
  fst (Node.showHeader field) /= Types.unknownField &&
261
  Node.showField node field /= Types.unknownField
262

  
263
prop_Node_computeGroups :: [Node.Node] -> Bool
264
prop_Node_computeGroups nodes =
265
  let ng = Node.computeGroups nodes
266
      onlyuuid = map fst ng
267
  in length nodes == sum (map (length . snd) ng) &&
268
     all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng &&
269
     length (nub onlyuuid) == length onlyuuid &&
270
     (null nodes || not (null ng))
271

  
272
-- Check idempotence of add/remove operations
273
prop_Node_addPri_idempotent :: Property
274
prop_Node_addPri_idempotent =
275
  forAll genOnlineNode $ \node ->
276
  forAll (genInstanceSmallerThanNode node) $ \inst ->
277
  case Node.addPri node inst of
278
    Types.OpGood node' -> Node.removePri node' inst ==? node
279
    _ -> failTest "Can't add instance"
280

  
281
prop_Node_addSec_idempotent :: Property
282
prop_Node_addSec_idempotent =
283
  forAll genOnlineNode $ \node ->
284
  forAll (genInstanceSmallerThanNode node) $ \inst ->
285
  let pdx = Node.idx node + 1
286
      inst' = Instance.setPri inst pdx
287
      inst'' = inst' { Instance.diskTemplate = Types.DTDrbd8 }
288
  in case Node.addSec node inst'' pdx of
289
       Types.OpGood node' -> Node.removeSec node' inst'' ==? node
290
       _ -> failTest "Can't add instance"
291

  
292
testSuite "Node"
293
            [ 'prop_Node_setAlias
294
            , 'prop_Node_setOffline
295
            , 'prop_Node_setMcpu
296
            , 'prop_Node_setXmem
297
            , 'prop_Node_addPriFM
298
            , 'prop_Node_addPriFD
299
            , 'prop_Node_addPriFC
300
            , 'prop_Node_addSec
301
            , 'prop_Node_addOfflinePri
302
            , 'prop_Node_addOfflineSec
303
            , 'prop_Node_rMem
304
            , 'prop_Node_setMdsk
305
            , 'prop_Node_tagMaps_idempotent
306
            , 'prop_Node_tagMaps_reject
307
            , 'prop_Node_showField
308
            , 'prop_Node_computeGroups
309
            , 'prop_Node_addPri_idempotent
310
            , 'prop_Node_addSec_idempotent
311
            ]
b/htest/Test/Ganeti/HTools/PeerMap.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.PeerMap (testPeerMap) where
30

  
31
import Test.QuickCheck
32

  
33
import Test.Ganeti.TestHelper
34
import Test.Ganeti.TestCommon
35

  
36
import qualified Ganeti.HTools.PeerMap as PeerMap
37

  
38
-- | Make sure add is idempotent.
39
prop_PeerMap_addIdempotent :: PeerMap.PeerMap
40
                           -> PeerMap.Key -> PeerMap.Elem -> Property
41
prop_PeerMap_addIdempotent pmap key em =
42
  fn puniq ==? fn (fn puniq)
43
    where fn = PeerMap.add key em
44
          puniq = PeerMap.accumArray const pmap
45

  
46
-- | Make sure remove is idempotent.
47
prop_PeerMap_removeIdempotent :: PeerMap.PeerMap -> PeerMap.Key -> Property
48
prop_PeerMap_removeIdempotent pmap key =
49
  fn puniq ==? fn (fn puniq)
50
    where fn = PeerMap.remove key
51
          puniq = PeerMap.accumArray const pmap
52

  
53
-- | Make sure a missing item returns 0.
54
prop_PeerMap_findMissing :: PeerMap.PeerMap -> PeerMap.Key -> Property
55
prop_PeerMap_findMissing pmap key =
56
  PeerMap.find key (PeerMap.remove key puniq) ==? 0
57
    where puniq = PeerMap.accumArray const pmap
58

  
59
-- | Make sure an added item is found.
60
prop_PeerMap_addFind :: PeerMap.PeerMap
61
                     -> PeerMap.Key -> PeerMap.Elem -> Property
62
prop_PeerMap_addFind pmap key em =
63
  PeerMap.find key (PeerMap.add key em puniq) ==? em
64
    where puniq = PeerMap.accumArray const pmap
65

  
66
-- | Manual check that maxElem returns the maximum indeed, or 0 for null.
67
prop_PeerMap_maxElem :: PeerMap.PeerMap -> Property
68
prop_PeerMap_maxElem pmap =
69
  PeerMap.maxElem puniq ==? if null puniq then 0
70
                              else (maximum . snd . unzip) puniq
71
    where puniq = PeerMap.accumArray const pmap
72

  
73
-- | List of tests for the PeerMap module.
74
testSuite "PeerMap"
75
            [ 'prop_PeerMap_addIdempotent
76
            , 'prop_PeerMap_removeIdempotent
77
            , 'prop_PeerMap_maxElem
78
            , 'prop_PeerMap_addFind
79
            , 'prop_PeerMap_findMissing
80
            ]
b/htest/Test/Ganeti/HTools/Simu.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.Simu (testSimu) where
30

  
31
import Test.QuickCheck
32

  
33
import Control.Monad
34
import qualified Data.IntMap as IntMap
35
import Text.Printf (printf)
36

  
37
import Test.Ganeti.TestHelper
38
import Test.Ganeti.TestCommon
39

  
40
import qualified Ganeti.Constants as C
41
import qualified Ganeti.HTools.Container as Container
42
import qualified Ganeti.HTools.Group as Group
43
import qualified Ganeti.HTools.Loader as Loader
44
import qualified Ganeti.HTools.Node as Node
45
import qualified Ganeti.HTools.Simu as Simu
46
import qualified Ganeti.HTools.Types as Types
47

  
48
-- | Generates a tuple of specs for simulation.
49
genSimuSpec :: Gen (String, Int, Int, Int, Int)
50
genSimuSpec = do
51
  pol <- elements [C.allocPolicyPreferred,
52
                   C.allocPolicyLastResort, C.allocPolicyUnallocable,
53
                  "p", "a", "u"]
54
 -- should be reasonable (nodes/group), bigger values only complicate
55
 -- the display of failed tests, and we don't care (in this particular
56
 -- test) about big node groups
57
  nodes <- choose (0, 20)
58
  dsk <- choose (0, maxDsk)
59
  mem <- choose (0, maxMem)
60
  cpu <- choose (0, maxCpu)
61
  return (pol, nodes, dsk, mem, cpu)
62

  
63
-- | Checks that given a set of corrects specs, we can load them
64
-- successfully, and that at high-level the values look right.
65
prop_Simu_Load :: Property
66
prop_Simu_Load =
67
  forAll (choose (0, 10)) $ \ngroups ->
68
  forAll (replicateM ngroups genSimuSpec) $ \specs ->
69
  let strspecs = map (\(p, n, d, m, c) -> printf "%s,%d,%d,%d,%d"
70
                                          p n d m c::String) specs
71
      totnodes = sum $ map (\(_, n, _, _, _) -> n) specs
72
      mdc_in = concatMap (\(_, n, d, m, c) ->
73
                            replicate n (fromIntegral m, fromIntegral d,
74
                                         fromIntegral c,
75
                                         fromIntegral m, fromIntegral d))
76
               specs :: [(Double, Double, Double, Int, Int)]
77
  in case Simu.parseData strspecs of
78
       Types.Bad msg -> failTest $ "Failed to load specs: " ++ msg
79
       Types.Ok (Loader.ClusterData gl nl il tags ipol) ->
80
         let nodes = map snd $ IntMap.toAscList nl
81
             nidx = map Node.idx nodes
82
             mdc_out = map (\n -> (Node.tMem n, Node.tDsk n, Node.tCpu n,
83
                                   Node.fMem n, Node.fDsk n)) nodes
84
         in
85
         Container.size gl ==? ngroups .&&.
86
         Container.size nl ==? totnodes .&&.
87
         Container.size il ==? 0 .&&.
88
         length tags ==? 0 .&&.
89
         ipol ==? Types.defIPolicy .&&.
90
         nidx ==? [1..totnodes] .&&.
91
         mdc_in ==? mdc_out .&&.
92
         map Group.iPolicy (Container.elems gl) ==?
93
             replicate ngroups Types.defIPolicy
94

  
95
testSuite "Simu"
96
            [ 'prop_Simu_Load
97
            ]
b/htest/Test/Ganeti/HTools/Text.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.Text (testText) where
30

  
31
import Test.QuickCheck
32

  
33
import qualified Data.Map as Map
34
import Data.List
35
import Data.Maybe
36

  
37
import Test.Ganeti.TestHelper
38
import Test.Ganeti.TestCommon
... This diff was truncated because it exceeds the maximum size that can be displayed.

Also available in: Unified diff