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