Increase minimal sizes of test online nodes
[ganeti-github.git] / test / hs / 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, 2013 Google Inc.
11 All rights reserved.
12
13 Redistribution and use in source and binary forms, with or without
14 modification, are permitted provided that the following conditions are
15 met:
16
17 1. Redistributions of source code must retain the above copyright notice,
18 this list of conditions and the following disclaimer.
19
20 2. Redistributions in binary form must reproduce the above copyright
21 notice, this list of conditions and the following disclaimer in the
22 documentation and/or other materials provided with the distribution.
23
24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
25 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
26 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
27 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
28 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
29 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
30 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
31 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
32 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
33 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
34 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
35
36 -}
37
38 module Test.Ganeti.HTools.Node
39 ( testHTools_Node
40 , Node.Node(..)
41 , setInstanceSmallerThanNode
42 , genNode
43 , genOnlineNode
44 , genNodeList
45 , genUniqueNodeList
46 ) where
47
48 import Test.QuickCheck
49 import Test.HUnit
50
51 import Control.Monad
52 import qualified Data.Map as Map
53 import qualified Data.Graph as Graph
54 import Data.List
55
56 import Test.Ganeti.TestHelper
57 import Test.Ganeti.TestCommon
58 import Test.Ganeti.TestHTools
59 import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode
60 , genInstanceList
61 , genInstanceOnNodeList)
62
63 import Ganeti.BasicTypes
64 import qualified Ganeti.HTools.Loader as Loader
65 import qualified Ganeti.HTools.Container as Container
66 import qualified Ganeti.HTools.Instance as Instance
67 import qualified Ganeti.HTools.Node as Node
68 import qualified Ganeti.HTools.Types as Types
69 import qualified Ganeti.HTools.Graph as HGraph
70
71 {-# ANN module "HLint: ignore Use camelCase" #-}
72
73 -- * Arbitrary instances
74
75 -- | Generates an arbitrary node based on sizing information.
76 genNode :: Maybe Int -- ^ Minimum node size in terms of units
77 -> Maybe Int -- ^ Maximum node size (when Nothing, bounded
78 -- just by the max... constants)
79 -> Gen Node.Node
80 genNode min_multiplier max_multiplier = do
81 let (base_mem, base_dsk, base_cpu, base_spindles) =
82 case min_multiplier of
83 Just mm -> (mm * Types.unitMem,
84 mm * Types.unitDsk,
85 mm * Types.unitCpu,
86 mm)
87 Nothing -> (0, 0, 0, 0)
88 (top_mem, top_dsk, top_cpu, top_spindles) =
89 case max_multiplier of
90 Just mm -> (mm * Types.unitMem,
91 mm * Types.unitDsk,
92 mm * Types.unitCpu,
93 mm)
94 Nothing -> (maxMem, maxDsk, maxCpu, maxSpindles)
95 name <- genFQDN
96 mem_t <- choose (base_mem, top_mem)
97 mem_f <- choose (base_mem, mem_t)
98 mem_n <- choose (0, mem_t - mem_f)
99 dsk_t <- choose (base_dsk, top_dsk)
100 dsk_f <- choose (base_dsk, dsk_t)
101 cpu_t <- choose (base_cpu, top_cpu)
102 cpu_n <- choose (base_cpu, cpu_t)
103 offl <- arbitrary
104 spindles <- choose (base_spindles, top_spindles)
105 let n = Node.create name (fromIntegral mem_t) mem_n mem_f
106 (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) cpu_n offl spindles
107 0 0 False
108 n' = Node.setPolicy nullIPolicy n
109 return $ Node.buildPeers n' Container.empty
110
111 -- | Helper function to generate a sane node.
112 genOnlineNode :: Gen Node.Node
113 genOnlineNode =
114 arbitrary `suchThat` (\n -> not (Node.offline n) &&
115 not (Node.failN1 n) &&
116 Node.availDisk n > 2 * Types.unitDsk &&
117 Node.availMem n > 2 * Types.unitMem &&
118 Node.availCpu n > 2 &&
119 Node.tSpindles n > 2)
120
121 -- | Generate a node with exclusive storage enabled.
122 genExclStorNode :: Gen Node.Node
123 genExclStorNode = do
124 n <- genOnlineNode
125 fs <- choose (Types.unitSpindle, Node.tSpindles n)
126 let pd = fromIntegral fs / fromIntegral (Node.tSpindles n)::Double
127 return n { Node.exclStorage = True
128 , Node.fSpindles = fs
129 , Node.pDsk = pd
130 }
131
132 -- | Generate a node with exclusive storage possibly enabled.
133 genMaybeExclStorNode :: Gen Node.Node
134 genMaybeExclStorNode = oneof [genOnlineNode, genExclStorNode]
135
136 -- and a random node
137 instance Arbitrary Node.Node where
138 arbitrary = genNode Nothing Nothing
139
140 -- | Node list generator.
141 -- Given a node generator, create a random length node list. Note that "real"
142 -- clusters always have at least one node, so we don't generate empty node
143 -- lists here.
144 genNodeList :: Gen Node.Node -> Gen Node.List
145 genNodeList ngen = fmap (snd . Loader.assignIndices) names_nodes
146 where names_nodes = (fmap . map) (\n -> (Node.name n, n)) nodes
147 nodes = listOf1 ngen `suchThat`
148 ((\ns -> ns == nub ns) . map Node.name)
149
150 -- | Node list generator where node names are unique
151 genUniqueNodeList :: Gen Node.Node -> Gen (Node.List, Types.NameAssoc)
152 genUniqueNodeList ngen = (do
153 nl <- genNodeList ngen
154 let na = (fst . Loader.assignIndices) $
155 map (\n -> (Node.name n, n)) (Container.elems nl)
156 return (nl, na)) `suchThat`
157 (\(nl, na) -> Container.size nl == Map.size na)
158
159 -- | Generate a node list, an instance list, and a node graph.
160 -- We choose instances with nodes contained in the node list.
161 genNodeGraph :: Gen (Maybe Graph.Graph, Node.List, Instance.List)
162 genNodeGraph = do
163 nl <- genNodeList genOnlineNode `suchThat` ((2<=).Container.size)
164 il <- genInstanceList (genInstanceOnNodeList nl)
165 return (Node.mkNodeGraph nl il, nl, il)
166
167 -- * Test cases
168
169 prop_setAlias :: Node.Node -> String -> Bool
170 prop_setAlias node name =
171 Node.name newnode == Node.name node &&
172 Node.alias newnode == name
173 where newnode = Node.setAlias node name
174
175 prop_setOffline :: Node.Node -> Bool -> Property
176 prop_setOffline node status =
177 Node.offline newnode ==? status
178 where newnode = Node.setOffline node status
179
180 prop_setXmem :: Node.Node -> Int -> Property
181 prop_setXmem node xm =
182 Node.xMem newnode ==? xm
183 where newnode = Node.setXmem node xm
184
185 prop_setMcpu :: Node.Node -> Double -> Property
186 prop_setMcpu node mc =
187 Types.iPolicyVcpuRatio (Node.iPolicy newnode) ==? mc
188 where newnode = Node.setMcpu node mc
189
190 prop_setFmemGreater :: Node.Node -> Int -> Property
191 prop_setFmemGreater node new_mem =
192 not (Node.failN1 node) && (Node.rMem node >= 0) &&
193 (new_mem > Node.rMem node) ==>
194 not (Node.failN1 (Node.setFmem node new_mem))
195
196 prop_setFmemExact :: Node.Node -> Property
197 prop_setFmemExact node =
198 not (Node.failN1 node) && (Node.rMem node >= 0) ==>
199 not (Node.failN1 (Node.setFmem node (Node.rMem node)))
200
201 -- Check if adding an instance that consumes exactly all reserved
202 -- memory does not raise an N+1 error
203 prop_addPri_NoN1Fail :: Property
204 prop_addPri_NoN1Fail =
205 forAll genMaybeExclStorNode $ \node ->
206 forAll (genInstanceSmallerThanNode node) $ \inst ->
207 let inst' = inst { Instance.mem = Node.fMem node - Node.rMem node }
208 in (Node.addPri node inst' /=? Bad Types.FailN1)
209
210 -- | Check that an instance add with too high memory or disk will be
211 -- rejected.
212 prop_addPriFM :: Node.Node -> Instance.Instance -> Property
213 prop_addPriFM node inst =
214 Instance.mem inst >= Node.fMem node && not (Node.failN1 node) &&
215 not (Instance.isOffline inst) ==>
216 (Node.addPri node inst'' ==? Bad Types.FailMem)
217 where inst' = setInstanceSmallerThanNode node inst
218 inst'' = inst' { Instance.mem = Instance.mem inst }
219
220 -- | Check that adding a primary instance with too much disk fails
221 -- with type FailDisk.
222 prop_addPriFD :: Node.Node -> Instance.Instance -> Property
223 prop_addPriFD node inst =
224 forAll (elements Instance.localStorageTemplates) $ \dt ->
225 Instance.dsk inst >= Node.fDsk node && not (Node.failN1 node) ==>
226 let inst' = setInstanceSmallerThanNode node inst
227 inst'' = inst' { Instance.dsk = Instance.dsk inst
228 , Instance.diskTemplate = dt }
229 in (Node.addPri node inst'' ==? Bad Types.FailDisk)
230
231 -- | Check if an instance exceeds a spindles limit or has no spindles set.
232 hasInstTooManySpindles :: Instance.Instance -> Int -> Bool
233 hasInstTooManySpindles inst sp_lim =
234 case Instance.getTotalSpindles inst of
235 Just s -> s > sp_lim
236 Nothing -> True
237
238 -- | Check that adding a primary instance with too many spindles fails
239 -- with type FailSpindles (when exclusive storage is enabled).
240 prop_addPriFS :: Instance.Instance -> Property
241 prop_addPriFS inst =
242 forAll genExclStorNode $ \node ->
243 forAll (elements Instance.localStorageTemplates) $ \dt ->
244 hasInstTooManySpindles inst (Node.fSpindles node) &&
245 not (Node.failN1 node) ==>
246 let inst' = setInstanceSmallerThanNode node inst
247 inst'' = inst' { Instance.disks = Instance.disks inst
248 , Instance.diskTemplate = dt }
249 in (Node.addPri node inst'' ==? Bad Types.FailSpindles)
250
251 -- | Check that adding a primary instance with too many VCPUs fails
252 -- with type FailCPU.
253 prop_addPriFC :: Property
254 prop_addPriFC =
255 forAll (choose (1, maxCpu)) $ \extra ->
256 forAll genMaybeExclStorNode $ \node ->
257 forAll (arbitrary `suchThat` Instance.notOffline) $ \inst ->
258 let inst' = setInstanceSmallerThanNode node inst
259 inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
260 in case Node.addPri node inst'' of
261 Bad Types.FailCPU -> passTest
262 v -> failTest $ "Expected OpFail FailCPU, but got " ++ show v
263
264 -- | Check that an instance add with too high memory or disk will be
265 -- rejected.
266 prop_addSec :: Node.Node -> Instance.Instance -> Int -> Property
267 prop_addSec node inst pdx =
268 ((Instance.mem inst >= (Node.fMem node - Node.rMem node) &&
269 not (Instance.isOffline inst)) ||
270 Instance.dsk inst >= Node.fDsk node ||
271 (Node.exclStorage node &&
272 hasInstTooManySpindles inst (Node.fSpindles node))) &&
273 not (Node.failN1 node) ==>
274 isBad (Node.addSec node inst pdx)
275
276 -- | Check that an offline instance with reasonable disk size but
277 -- extra mem/cpu can always be added.
278 prop_addOfflinePri :: NonNegative Int -> NonNegative Int -> Property
279 prop_addOfflinePri (NonNegative extra_mem) (NonNegative extra_cpu) =
280 forAll genMaybeExclStorNode $ \node ->
281 forAll (genInstanceSmallerThanNode node) $ \inst ->
282 let inst' = inst { Instance.runSt = Types.StatusOffline
283 , Instance.mem = Node.availMem node + extra_mem
284 , Instance.vcpus = Node.availCpu node + extra_cpu }
285 in case Node.addPri node inst' of
286 Ok _ -> passTest
287 v -> failTest $ "Expected OpGood, but got: " ++ show v
288
289 -- | Check that an offline instance with reasonable disk size but
290 -- extra mem/cpu can always be added.
291 prop_addOfflineSec :: NonNegative Int -> NonNegative Int
292 -> Types.Ndx -> Property
293 prop_addOfflineSec (NonNegative extra_mem) (NonNegative extra_cpu) pdx =
294 forAll genMaybeExclStorNode $ \node ->
295 forAll (genInstanceSmallerThanNode node) $ \inst ->
296 let inst' = inst { Instance.runSt = Types.StatusOffline
297 , Instance.mem = Node.availMem node + extra_mem
298 , Instance.vcpus = Node.availCpu node + extra_cpu
299 , Instance.diskTemplate = Types.DTDrbd8 }
300 in case Node.addSec node inst' pdx of
301 Ok _ -> passTest
302 v -> failTest $ "Expected OpGood/OpGood, but got: " ++ show v
303
304 -- | Checks for memory reservation changes.
305 prop_rMem :: Instance.Instance -> Property
306 prop_rMem inst =
307 not (Instance.isOffline inst) ==>
308 forAll (genMaybeExclStorNode `suchThat` ((> Types.unitMem) . Node.fMem)) $
309 \node ->
310 -- ab = auto_balance, nb = non-auto_balance
311 -- we use -1 as the primary node of the instance
312 let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True
313 , Instance.diskTemplate = Types.DTDrbd8 }
314 inst_ab = setInstanceSmallerThanNode node inst'
315 inst_nb = inst_ab { Instance.autoBalance = False }
316 -- now we have the two instances, identical except the
317 -- autoBalance attribute
318 orig_rmem = Node.rMem node
319 inst_idx = Instance.idx inst_ab
320 node_add_ab = Node.addSec node inst_ab (-1)
321 node_add_nb = Node.addSec node inst_nb (-1)
322 node_del_ab = liftM (`Node.removeSec` inst_ab) node_add_ab
323 node_del_nb = liftM (`Node.removeSec` inst_nb) node_add_nb
324 in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of
325 (Ok a_ab, Ok a_nb,
326 Ok d_ab, Ok d_nb) ->
327 counterexample "Consistency checks failed" $
328 Node.rMem a_ab > orig_rmem &&
329 Node.rMem a_ab - orig_rmem == Instance.mem inst_ab &&
330 Node.rMem a_nb == orig_rmem &&
331 Node.rMem d_ab == orig_rmem &&
332 Node.rMem d_nb == orig_rmem &&
333 -- this is not related to rMem, but as good a place to
334 -- test as any
335 inst_idx `elem` Node.sList a_ab &&
336 inst_idx `notElem` Node.sList d_ab
337 x -> failTest $ "Failed to add/remove instances: " ++ show x
338
339 -- | Check mdsk setting.
340 prop_setMdsk :: Node.Node -> SmallRatio -> Bool
341 prop_setMdsk node mx =
342 Node.loDsk node' >= 0 &&
343 fromIntegral (Node.loDsk node') <= Node.tDsk node &&
344 Node.availDisk node' >= 0 &&
345 Node.availDisk node' <= Node.fDsk node' &&
346 fromIntegral (Node.availDisk node') <= Node.tDsk node' &&
347 Node.mDsk node' == mx'
348 where node' = Node.setMdsk node mx'
349 SmallRatio mx' = mx
350
351 -- Check tag maps
352 prop_tagMaps_idempotent :: Property
353 prop_tagMaps_idempotent =
354 forAll genTags $ \tags ->
355 Node.delTags (Node.addTags m tags) tags ==? m
356 where m = Map.empty
357
358 prop_tagMaps_reject :: Property
359 prop_tagMaps_reject =
360 forAll (genTags `suchThat` (not . null)) $ \tags ->
361 let m = Node.addTags Map.empty tags
362 in all (\t -> Node.rejectAddTags m [t]) tags
363
364 prop_showField :: Node.Node -> Property
365 prop_showField node =
366 forAll (elements Node.defaultFields) $ \ field ->
367 fst (Node.showHeader field) /= Types.unknownField &&
368 Node.showField node field /= Types.unknownField
369
370 prop_computeGroups :: [Node.Node] -> Bool
371 prop_computeGroups nodes =
372 let ng = Node.computeGroups nodes
373 onlyuuid = map fst ng
374 in length nodes == sum (map (length . snd) ng) &&
375 all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng &&
376 length (nub onlyuuid) == length onlyuuid &&
377 (null nodes || not (null ng))
378
379 -- Check idempotence of add/remove operations
380 prop_addPri_idempotent :: Property
381 prop_addPri_idempotent =
382 forAll genMaybeExclStorNode $ \node ->
383 forAll (genInstanceSmallerThanNode node) $ \inst ->
384 case Node.addPri node inst of
385 Ok node' -> Node.removePri node' inst ==? node
386 _ -> failTest "Can't add instance"
387
388 prop_addSec_idempotent :: Property
389 prop_addSec_idempotent =
390 forAll genMaybeExclStorNode $ \node ->
391 forAll (genInstanceSmallerThanNode node) $ \inst ->
392 let pdx = Node.idx node + 1
393 inst' = Instance.setPri inst pdx
394 inst'' = inst' { Instance.diskTemplate = Types.DTDrbd8 }
395 in case Node.addSec node inst'' pdx of
396 Ok node' -> Node.removeSec node' inst'' ==? node
397 _ -> failTest "Can't add instance"
398
399 -- | Check that no graph is created on an empty node list.
400 case_emptyNodeList :: Assertion
401 case_emptyNodeList =
402 assertEqual "" Nothing $ Node.mkNodeGraph emptynodes emptyinstances
403 where emptynodes = Container.empty :: Node.List
404 emptyinstances = Container.empty :: Instance.List
405
406 -- | Check that the number of vertices of a nodegraph is equal to the number of
407 -- nodes in the original node list.
408 prop_numVertices :: Property
409 prop_numVertices =
410 forAll genNodeGraph $ \(graph, nl, _) ->
411 (fmap numvertices graph ==? Just (Container.size nl))
412 where numvertices = length . Graph.vertices
413
414 -- | Check that the number of edges of a nodegraph is equal to twice the number
415 -- of instances with secondary nodes in the original instance list.
416 prop_numEdges :: Property
417 prop_numEdges =
418 forAll genNodeGraph $ \(graph, _, il) ->
419 (fmap numedges graph ==? Just (numwithsec il * 2))
420 where numedges = length . Graph.edges
421 numwithsec = length . filter Instance.hasSecondary . Container.elems
422
423 -- | Check that a node graph is colorable.
424 prop_nodeGraphIsColorable :: Property
425 prop_nodeGraphIsColorable =
426 forAll genNodeGraph $ \(graph, _, _) ->
427 fmap HGraph.isColorable graph ==? Just True
428
429 -- | Check that each edge in a nodegraph is an instance.
430 prop_instanceIsEdge :: Property
431 prop_instanceIsEdge =
432 forAll genNodeGraph $ \(graph, _, il) ->
433 fmap (\g -> all (`isEdgeOn` g) (iwithsec il)) graph ==? Just True
434 where i `isEdgeOn` g = iEdges i `intersect` Graph.edges g == iEdges i
435 iEdges i = [ (Instance.pNode i, Instance.sNode i)
436 , (Instance.sNode i, Instance.pNode i)]
437 iwithsec = filter Instance.hasSecondary . Container.elems
438
439 -- | Check that each instance in an edge in the resulting nodegraph.
440 prop_edgeIsInstance :: Property
441 prop_edgeIsInstance =
442 forAll genNodeGraph $ \(graph, _, il) ->
443 fmap (all (`isInstanceIn` il).Graph.edges) graph ==? Just True
444 where e `isInstanceIn` il = any (`hasNodes` e) (Container.elems il)
445 i `hasNodes` (v1,v2) =
446 Instance.allNodes i `elem` permutations [v1,v2]
447
448 -- | List of tests for the Node module.
449 testSuite "HTools/Node"
450 [ 'prop_setAlias
451 , 'prop_setOffline
452 , 'prop_setMcpu
453 , 'prop_setFmemGreater
454 , 'prop_setFmemExact
455 , 'prop_setXmem
456 , 'prop_addPriFM
457 , 'prop_addPriFD
458 , 'prop_addPriFS
459 , 'prop_addPriFC
460 , 'prop_addPri_NoN1Fail
461 , 'prop_addSec
462 , 'prop_addOfflinePri
463 , 'prop_addOfflineSec
464 , 'prop_rMem
465 , 'prop_setMdsk
466 , 'prop_tagMaps_idempotent
467 , 'prop_tagMaps_reject
468 , 'prop_showField
469 , 'prop_computeGroups
470 , 'prop_addPri_idempotent
471 , 'prop_addSec_idempotent
472 , 'case_emptyNodeList
473 , 'prop_numVertices
474 , 'prop_numEdges
475 , 'prop_nodeGraphIsColorable
476 , 'prop_edgeIsInstance
477 , 'prop_instanceIsEdge
478 ]