root / Ganeti / HTools / QC.hs @ 306cccd5
History | View | Annotate | Download (25.9 kB)
1 |
{-| Unittests for ganeti-htools |
---|---|
2 |
|
3 |
-} |
4 |
|
5 |
{- |
6 |
|
7 |
Copyright (C) 2009, 2010 Google Inc. |
8 |
|
9 |
This program is free software; you can redistribute it and/or modify |
10 |
it under the terms of the GNU General Public License as published by |
11 |
the Free Software Foundation; either version 2 of the License, or |
12 |
(at your option) any later version. |
13 |
|
14 |
This program is distributed in the hope that it will be useful, but |
15 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
16 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 |
General Public License for more details. |
18 |
|
19 |
You should have received a copy of the GNU General Public License |
20 |
along with this program; if not, write to the Free Software |
21 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 |
02110-1301, USA. |
23 |
|
24 |
-} |
25 |
|
26 |
module Ganeti.HTools.QC |
27 |
( testUtils |
28 |
, testPeerMap |
29 |
, testContainer |
30 |
, testInstance |
31 |
, testNode |
32 |
, testText |
33 |
, testOpCodes |
34 |
, testJobs |
35 |
, testCluster |
36 |
, testLoader |
37 |
) where |
38 |
|
39 |
import Test.QuickCheck |
40 |
import Test.QuickCheck.Batch |
41 |
import Data.List (findIndex, intercalate) |
42 |
import Data.Maybe |
43 |
import Control.Monad |
44 |
import qualified Text.JSON as J |
45 |
import qualified Data.Map |
46 |
import qualified Data.IntMap as IntMap |
47 |
import qualified Ganeti.OpCodes as OpCodes |
48 |
import qualified Ganeti.Jobs as Jobs |
49 |
import qualified Ganeti.Luxi |
50 |
import qualified Ganeti.HTools.CLI as CLI |
51 |
import qualified Ganeti.HTools.Cluster as Cluster |
52 |
import qualified Ganeti.HTools.Container as Container |
53 |
import qualified Ganeti.HTools.ExtLoader |
54 |
import qualified Ganeti.HTools.IAlloc as IAlloc |
55 |
import qualified Ganeti.HTools.Instance as Instance |
56 |
import qualified Ganeti.HTools.Loader as Loader |
57 |
import qualified Ganeti.HTools.Luxi |
58 |
import qualified Ganeti.HTools.Node as Node |
59 |
import qualified Ganeti.HTools.PeerMap as PeerMap |
60 |
import qualified Ganeti.HTools.Rapi |
61 |
import qualified Ganeti.HTools.Simu |
62 |
import qualified Ganeti.HTools.Text as Text |
63 |
import qualified Ganeti.HTools.Types as Types |
64 |
import qualified Ganeti.HTools.Utils as Utils |
65 |
import qualified Ganeti.HTools.Version |
66 |
|
67 |
-- * Constants |
68 |
|
69 |
-- | Maximum memory (1TiB, somewhat random value) |
70 |
maxMem :: Int |
71 |
maxMem = 1024 * 1024 |
72 |
|
73 |
-- | Maximum disk (8TiB, somewhat random value) |
74 |
maxDsk :: Int |
75 |
maxDsk = 1024 * 1024 * 8 |
76 |
|
77 |
-- | Max CPUs (1024, somewhat random value) |
78 |
maxCpu :: Int |
79 |
maxCpu = 1024 |
80 |
|
81 |
-- * Helper functions |
82 |
|
83 |
-- | Simple checker for whether OpResult is fail or pass |
84 |
isFailure :: Types.OpResult a -> Bool |
85 |
isFailure (Types.OpFail _) = True |
86 |
isFailure _ = False |
87 |
|
88 |
-- | Simple checker for whether Result is fail or pass |
89 |
isOk :: Types.Result a -> Bool |
90 |
isOk (Types.Ok _ ) = True |
91 |
isOk _ = False |
92 |
|
93 |
isBad :: Types.Result a -> Bool |
94 |
isBad = not . isOk |
95 |
|
96 |
-- | Update an instance to be smaller than a node |
97 |
setInstanceSmallerThanNode node inst = |
98 |
inst { Instance.mem = Node.availMem node `div` 2 |
99 |
, Instance.dsk = Node.availDisk node `div` 2 |
100 |
, Instance.vcpus = Node.availCpu node `div` 2 |
101 |
} |
102 |
|
103 |
-- | Create an instance given its spec |
104 |
createInstance mem dsk vcpus = |
105 |
Instance.create "inst-unnamed" mem dsk vcpus "running" [] (-1) (-1) |
106 |
|
107 |
-- | Create a small cluster by repeating a node spec |
108 |
makeSmallCluster :: Node.Node -> Int -> Node.List |
109 |
makeSmallCluster node count = |
110 |
let fn = Node.buildPeers node Container.empty |
111 |
namelst = map (\n -> (Node.name n, n)) (replicate count fn) |
112 |
(_, nlst) = Loader.assignIndices namelst |
113 |
in Container.fromAssocList nlst |
114 |
|
115 |
-- | Checks if a node is "big" enough |
116 |
isNodeBig :: Node.Node -> Int -> Bool |
117 |
isNodeBig node size = Node.availDisk node > size * Types.unitDsk |
118 |
&& Node.availMem node > size * Types.unitMem |
119 |
&& Node.availCpu node > size * Types.unitCpu |
120 |
|
121 |
canBalance :: Cluster.Table -> Bool -> Bool -> Bool |
122 |
canBalance tbl dm evac = isJust $ Cluster.tryBalance tbl dm evac 0 0 |
123 |
|
124 |
-- * Arbitrary instances |
125 |
|
126 |
-- copied from the introduction to quickcheck |
127 |
instance Arbitrary Char where |
128 |
arbitrary = choose ('\32', '\128') |
129 |
|
130 |
newtype DNSChar = DNSChar { dnsGetChar::Char } |
131 |
instance Arbitrary DNSChar where |
132 |
arbitrary = do |
133 |
x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-") |
134 |
return (DNSChar x) |
135 |
|
136 |
getName :: Gen String |
137 |
getName = do |
138 |
n <- choose (1, 64) |
139 |
dn <- vector n::Gen [DNSChar] |
140 |
return (map dnsGetChar dn) |
141 |
|
142 |
|
143 |
getFQDN :: Gen String |
144 |
getFQDN = do |
145 |
felem <- getName |
146 |
ncomps <- choose (1, 4) |
147 |
frest <- vector ncomps::Gen [[DNSChar]] |
148 |
let frest' = map (map dnsGetChar) frest |
149 |
return (felem ++ "." ++ intercalate "." frest') |
150 |
|
151 |
-- let's generate a random instance |
152 |
instance Arbitrary Instance.Instance where |
153 |
arbitrary = do |
154 |
name <- getFQDN |
155 |
mem <- choose (0, maxMem) |
156 |
dsk <- choose (0, maxDsk) |
157 |
run_st <- elements ["ERROR_up", "ERROR_down", "ADMIN_down" |
158 |
, "ERROR_nodedown", "ERROR_nodeoffline" |
159 |
, "running" |
160 |
, "no_such_status1", "no_such_status2"] |
161 |
pn <- arbitrary |
162 |
sn <- arbitrary |
163 |
vcpus <- choose (0, maxCpu) |
164 |
return $ Instance.create name mem dsk vcpus run_st [] pn sn |
165 |
|
166 |
-- and a random node |
167 |
instance Arbitrary Node.Node where |
168 |
arbitrary = do |
169 |
name <- getFQDN |
170 |
mem_t <- choose (0, maxMem) |
171 |
mem_f <- choose (0, mem_t) |
172 |
mem_n <- choose (0, mem_t - mem_f) |
173 |
dsk_t <- choose (0, maxDsk) |
174 |
dsk_f <- choose (0, dsk_t) |
175 |
cpu_t <- choose (0, maxCpu) |
176 |
offl <- arbitrary |
177 |
let n = Node.create name (fromIntegral mem_t) mem_n mem_f |
178 |
(fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl |
179 |
n' = Node.buildPeers n Container.empty |
180 |
return n' |
181 |
|
182 |
-- replace disks |
183 |
instance Arbitrary OpCodes.ReplaceDisksMode where |
184 |
arbitrary = elements [ OpCodes.ReplaceOnPrimary |
185 |
, OpCodes.ReplaceOnSecondary |
186 |
, OpCodes.ReplaceNewSecondary |
187 |
, OpCodes.ReplaceAuto |
188 |
] |
189 |
|
190 |
instance Arbitrary OpCodes.OpCode where |
191 |
arbitrary = do |
192 |
op_id <- elements [ "OP_TEST_DELAY" |
193 |
, "OP_INSTANCE_REPLACE_DISKS" |
194 |
, "OP_INSTANCE_FAILOVER" |
195 |
, "OP_INSTANCE_MIGRATE" |
196 |
] |
197 |
(case op_id of |
198 |
"OP_TEST_DELAY" -> |
199 |
liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary |
200 |
"OP_INSTANCE_REPLACE_DISKS" -> |
201 |
liftM5 OpCodes.OpReplaceDisks arbitrary arbitrary |
202 |
arbitrary arbitrary arbitrary |
203 |
"OP_INSTANCE_FAILOVER" -> |
204 |
liftM2 OpCodes.OpFailoverInstance arbitrary arbitrary |
205 |
"OP_INSTANCE_MIGRATE" -> |
206 |
liftM3 OpCodes.OpMigrateInstance arbitrary arbitrary arbitrary |
207 |
_ -> fail "Wrong opcode") |
208 |
|
209 |
instance Arbitrary Jobs.OpStatus where |
210 |
arbitrary = elements [minBound..maxBound] |
211 |
|
212 |
instance Arbitrary Jobs.JobStatus where |
213 |
arbitrary = elements [minBound..maxBound] |
214 |
|
215 |
-- * Actual tests |
216 |
|
217 |
-- If the list is not just an empty element, and if the elements do |
218 |
-- not contain commas, then join+split should be idepotent |
219 |
prop_Utils_commaJoinSplit lst = lst /= [""] && |
220 |
all (not . elem ',') lst ==> |
221 |
Utils.sepSplit ',' (Utils.commaJoin lst) == lst |
222 |
-- Split and join should always be idempotent |
223 |
prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s |
224 |
|
225 |
testUtils = |
226 |
[ run prop_Utils_commaJoinSplit |
227 |
, run prop_Utils_commaSplitJoin |
228 |
] |
229 |
|
230 |
-- | Make sure add is idempotent |
231 |
prop_PeerMap_addIdempotent pmap key em = |
232 |
fn puniq == fn (fn puniq) |
233 |
where _types = (pmap::PeerMap.PeerMap, |
234 |
key::PeerMap.Key, em::PeerMap.Elem) |
235 |
fn = PeerMap.add key em |
236 |
puniq = PeerMap.accumArray const pmap |
237 |
|
238 |
-- | Make sure remove is idempotent |
239 |
prop_PeerMap_removeIdempotent pmap key = |
240 |
fn puniq == fn (fn puniq) |
241 |
where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key) |
242 |
fn = PeerMap.remove key |
243 |
puniq = PeerMap.accumArray const pmap |
244 |
|
245 |
-- | Make sure a missing item returns 0 |
246 |
prop_PeerMap_findMissing pmap key = |
247 |
PeerMap.find key (PeerMap.remove key puniq) == 0 |
248 |
where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key) |
249 |
puniq = PeerMap.accumArray const pmap |
250 |
|
251 |
-- | Make sure an added item is found |
252 |
prop_PeerMap_addFind pmap key em = |
253 |
PeerMap.find key (PeerMap.add key em puniq) == em |
254 |
where _types = (pmap::PeerMap.PeerMap, |
255 |
key::PeerMap.Key, em::PeerMap.Elem) |
256 |
puniq = PeerMap.accumArray const pmap |
257 |
|
258 |
-- | Manual check that maxElem returns the maximum indeed, or 0 for null |
259 |
prop_PeerMap_maxElem pmap = |
260 |
PeerMap.maxElem puniq == if null puniq then 0 |
261 |
else (maximum . snd . unzip) puniq |
262 |
where _types = pmap::PeerMap.PeerMap |
263 |
puniq = PeerMap.accumArray const pmap |
264 |
|
265 |
testPeerMap = |
266 |
[ run prop_PeerMap_addIdempotent |
267 |
, run prop_PeerMap_removeIdempotent |
268 |
, run prop_PeerMap_maxElem |
269 |
, run prop_PeerMap_addFind |
270 |
, run prop_PeerMap_findMissing |
271 |
] |
272 |
|
273 |
-- Container tests |
274 |
|
275 |
prop_Container_addTwo cdata i1 i2 = |
276 |
fn i1 i2 cont == fn i2 i1 cont && |
277 |
fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont) |
278 |
where _types = (cdata::[Int], |
279 |
i1::Int, i2::Int) |
280 |
cont = foldl (\c x -> Container.add x x c) Container.empty cdata |
281 |
fn x1 x2 = Container.addTwo x1 x1 x2 x2 |
282 |
|
283 |
testContainer = |
284 |
[ run prop_Container_addTwo ] |
285 |
|
286 |
-- Simple instance tests, we only have setter/getters |
287 |
|
288 |
prop_Instance_creat inst = |
289 |
Instance.name inst == Instance.alias inst |
290 |
|
291 |
prop_Instance_setIdx inst idx = |
292 |
Instance.idx (Instance.setIdx inst idx) == idx |
293 |
where _types = (inst::Instance.Instance, idx::Types.Idx) |
294 |
|
295 |
prop_Instance_setName inst name = |
296 |
Instance.name newinst == name && |
297 |
Instance.alias newinst == name |
298 |
where _types = (inst::Instance.Instance, name::String) |
299 |
newinst = Instance.setName inst name |
300 |
|
301 |
prop_Instance_setAlias inst name = |
302 |
Instance.name newinst == Instance.name inst && |
303 |
Instance.alias newinst == name |
304 |
where _types = (inst::Instance.Instance, name::String) |
305 |
newinst = Instance.setAlias inst name |
306 |
|
307 |
prop_Instance_setPri inst pdx = |
308 |
Instance.pNode (Instance.setPri inst pdx) == pdx |
309 |
where _types = (inst::Instance.Instance, pdx::Types.Ndx) |
310 |
|
311 |
prop_Instance_setSec inst sdx = |
312 |
Instance.sNode (Instance.setSec inst sdx) == sdx |
313 |
where _types = (inst::Instance.Instance, sdx::Types.Ndx) |
314 |
|
315 |
prop_Instance_setBoth inst pdx sdx = |
316 |
Instance.pNode si == pdx && Instance.sNode si == sdx |
317 |
where _types = (inst::Instance.Instance, pdx::Types.Ndx, sdx::Types.Ndx) |
318 |
si = Instance.setBoth inst pdx sdx |
319 |
|
320 |
prop_Instance_runStatus_True inst = |
321 |
let run_st = Instance.running inst |
322 |
run_tx = Instance.runSt inst |
323 |
in |
324 |
run_tx `elem` Instance.runningStates ==> run_st |
325 |
|
326 |
prop_Instance_runStatus_False inst = |
327 |
let run_st = Instance.running inst |
328 |
run_tx = Instance.runSt inst |
329 |
in |
330 |
run_tx `notElem` Instance.runningStates ==> not run_st |
331 |
|
332 |
prop_Instance_shrinkMG inst = |
333 |
Instance.mem inst >= 2 * Types.unitMem ==> |
334 |
case Instance.shrinkByType inst Types.FailMem of |
335 |
Types.Ok inst' -> |
336 |
Instance.mem inst' == Instance.mem inst - Types.unitMem |
337 |
_ -> False |
338 |
|
339 |
prop_Instance_shrinkMF inst = |
340 |
Instance.mem inst < 2 * Types.unitMem ==> |
341 |
isBad $ Instance.shrinkByType inst Types.FailMem |
342 |
|
343 |
prop_Instance_shrinkCG inst = |
344 |
Instance.vcpus inst >= 2 * Types.unitCpu ==> |
345 |
case Instance.shrinkByType inst Types.FailCPU of |
346 |
Types.Ok inst' -> |
347 |
Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu |
348 |
_ -> False |
349 |
|
350 |
prop_Instance_shrinkCF inst = |
351 |
Instance.vcpus inst < 2 * Types.unitCpu ==> |
352 |
isBad $ Instance.shrinkByType inst Types.FailCPU |
353 |
|
354 |
prop_Instance_shrinkDG inst = |
355 |
Instance.dsk inst >= 2 * Types.unitDsk ==> |
356 |
case Instance.shrinkByType inst Types.FailDisk of |
357 |
Types.Ok inst' -> |
358 |
Instance.dsk inst' == Instance.dsk inst - Types.unitDsk |
359 |
_ -> False |
360 |
|
361 |
prop_Instance_shrinkDF inst = |
362 |
Instance.dsk inst < 2 * Types.unitDsk ==> |
363 |
isBad $ Instance.shrinkByType inst Types.FailDisk |
364 |
|
365 |
prop_Instance_setMovable inst m = |
366 |
Instance.movable inst' == m |
367 |
where inst' = Instance.setMovable inst m |
368 |
|
369 |
testInstance = |
370 |
[ run prop_Instance_creat |
371 |
, run prop_Instance_setIdx |
372 |
, run prop_Instance_setName |
373 |
, run prop_Instance_setAlias |
374 |
, run prop_Instance_setPri |
375 |
, run prop_Instance_setSec |
376 |
, run prop_Instance_setBoth |
377 |
, run prop_Instance_runStatus_True |
378 |
, run prop_Instance_runStatus_False |
379 |
, run prop_Instance_shrinkMG |
380 |
, run prop_Instance_shrinkMF |
381 |
, run prop_Instance_shrinkCG |
382 |
, run prop_Instance_shrinkCF |
383 |
, run prop_Instance_shrinkDG |
384 |
, run prop_Instance_shrinkDF |
385 |
, run prop_Instance_setMovable |
386 |
] |
387 |
|
388 |
-- Instance text loader tests |
389 |
|
390 |
prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx = |
391 |
not (null pnode) && pdx >= 0 && sdx >= 0 ==> |
392 |
let vcpus_s = show vcpus |
393 |
dsk_s = show dsk |
394 |
mem_s = show mem |
395 |
rsdx = if pdx == sdx |
396 |
then sdx + 1 |
397 |
else sdx |
398 |
ndx = if null snode |
399 |
then [(pnode, pdx)] |
400 |
else [(pnode, pdx), (snode, rsdx)] |
401 |
tags = "" |
402 |
inst = Text.loadInst ndx |
403 |
[name, mem_s, dsk_s, vcpus_s, status, pnode, snode, tags]:: |
404 |
Maybe (String, Instance.Instance) |
405 |
fail1 = Text.loadInst ndx |
406 |
[name, mem_s, dsk_s, vcpus_s, status, pnode, pnode, tags]:: |
407 |
Maybe (String, Instance.Instance) |
408 |
_types = ( name::String, mem::Int, dsk::Int |
409 |
, vcpus::Int, status::String |
410 |
, pnode::String, snode::String |
411 |
, pdx::Types.Ndx, sdx::Types.Ndx) |
412 |
in |
413 |
case inst of |
414 |
Nothing -> False |
415 |
Just (_, i) -> |
416 |
(Instance.name i == name && |
417 |
Instance.vcpus i == vcpus && |
418 |
Instance.mem i == mem && |
419 |
Instance.pNode i == pdx && |
420 |
Instance.sNode i == (if null snode |
421 |
then Node.noSecondary |
422 |
else rsdx) && |
423 |
isNothing fail1) |
424 |
|
425 |
prop_Text_Load_InstanceFail ktn fields = |
426 |
length fields /= 8 ==> isNothing $ Text.loadInst ktn fields |
427 |
|
428 |
prop_Text_Load_Node name tm nm fm td fd tc fo = |
429 |
let conv v = if v < 0 |
430 |
then "?" |
431 |
else show v |
432 |
tm_s = conv tm |
433 |
nm_s = conv nm |
434 |
fm_s = conv fm |
435 |
td_s = conv td |
436 |
fd_s = conv fd |
437 |
tc_s = conv tc |
438 |
fo_s = if fo |
439 |
then "Y" |
440 |
else "N" |
441 |
any_broken = any (< 0) [tm, nm, fm, td, fd, tc] |
442 |
in case Text.loadNode [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s] of |
443 |
Nothing -> False |
444 |
Just (name', node) -> |
445 |
if fo || any_broken |
446 |
then Node.offline node |
447 |
else Node.name node == name' && name' == name && |
448 |
Node.alias node == name && |
449 |
Node.tMem node == fromIntegral tm && |
450 |
Node.nMem node == nm && |
451 |
Node.fMem node == fm && |
452 |
Node.tDsk node == fromIntegral td && |
453 |
Node.fDsk node == fd && |
454 |
Node.tCpu node == fromIntegral tc |
455 |
|
456 |
prop_Text_Load_NodeFail fields = |
457 |
length fields /= 8 ==> isNothing $ Text.loadNode fields |
458 |
|
459 |
prop_Text_NodeLSIdempotent node = |
460 |
(Text.loadNode . |
461 |
Utils.sepSplit '|' . Text.serializeNode) n == |
462 |
Just (Node.name n, n) |
463 |
-- override failN1 to what loadNode returns by default |
464 |
where n = node { Node.failN1 = True, Node.offline = False } |
465 |
|
466 |
testText = |
467 |
[ run prop_Text_Load_Instance |
468 |
, run prop_Text_Load_InstanceFail |
469 |
, run prop_Text_Load_Node |
470 |
, run prop_Text_Load_NodeFail |
471 |
, run prop_Text_NodeLSIdempotent |
472 |
] |
473 |
|
474 |
-- Node tests |
475 |
|
476 |
prop_Node_setAlias node name = |
477 |
Node.name newnode == Node.name node && |
478 |
Node.alias newnode == name |
479 |
where _types = (node::Node.Node, name::String) |
480 |
newnode = Node.setAlias node name |
481 |
|
482 |
prop_Node_setOffline node status = |
483 |
Node.offline newnode == status |
484 |
where newnode = Node.setOffline node status |
485 |
|
486 |
prop_Node_setXmem node xm = |
487 |
Node.xMem newnode == xm |
488 |
where newnode = Node.setXmem node xm |
489 |
|
490 |
prop_Node_setMcpu node mc = |
491 |
Node.mCpu newnode == mc |
492 |
where newnode = Node.setMcpu node mc |
493 |
|
494 |
-- | Check that an instance add with too high memory or disk will be rejected |
495 |
prop_Node_addPriFM node inst = Instance.mem inst >= Node.fMem node && |
496 |
not (Node.failN1 node) |
497 |
==> |
498 |
case Node.addPri node inst'' of |
499 |
Types.OpFail Types.FailMem -> True |
500 |
_ -> False |
501 |
where _types = (node::Node.Node, inst::Instance.Instance) |
502 |
inst' = setInstanceSmallerThanNode node inst |
503 |
inst'' = inst' { Instance.mem = Instance.mem inst } |
504 |
|
505 |
prop_Node_addPriFD node inst = Instance.dsk inst >= Node.fDsk node && |
506 |
not (Node.failN1 node) |
507 |
==> |
508 |
case Node.addPri node inst'' of |
509 |
Types.OpFail Types.FailDisk -> True |
510 |
_ -> False |
511 |
where _types = (node::Node.Node, inst::Instance.Instance) |
512 |
inst' = setInstanceSmallerThanNode node inst |
513 |
inst'' = inst' { Instance.dsk = Instance.dsk inst } |
514 |
|
515 |
prop_Node_addPriFC node inst = Instance.vcpus inst > Node.availCpu node && |
516 |
not (Node.failN1 node) |
517 |
==> |
518 |
case Node.addPri node inst'' of |
519 |
Types.OpFail Types.FailCPU -> True |
520 |
_ -> False |
521 |
where _types = (node::Node.Node, inst::Instance.Instance) |
522 |
inst' = setInstanceSmallerThanNode node inst |
523 |
inst'' = inst' { Instance.vcpus = Instance.vcpus inst } |
524 |
|
525 |
-- | Check that an instance add with too high memory or disk will be rejected |
526 |
prop_Node_addSec node inst pdx = |
527 |
(Instance.mem inst >= (Node.fMem node - Node.rMem node) || |
528 |
Instance.dsk inst >= Node.fDsk node) && |
529 |
not (Node.failN1 node) |
530 |
==> isFailure (Node.addSec node inst pdx) |
531 |
where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int) |
532 |
|
533 |
newtype SmallRatio = SmallRatio Double deriving Show |
534 |
instance Arbitrary SmallRatio where |
535 |
arbitrary = do |
536 |
v <- choose (0, 1) |
537 |
return $ SmallRatio v |
538 |
|
539 |
-- | Check mdsk setting |
540 |
prop_Node_setMdsk node mx = |
541 |
Node.loDsk node' >= 0 && |
542 |
fromIntegral (Node.loDsk node') <= Node.tDsk node && |
543 |
Node.availDisk node' >= 0 && |
544 |
Node.availDisk node' <= Node.fDsk node' && |
545 |
fromIntegral (Node.availDisk node') <= Node.tDsk node' && |
546 |
Node.mDsk node' == mx' |
547 |
where _types = (node::Node.Node, mx::SmallRatio) |
548 |
node' = Node.setMdsk node mx' |
549 |
SmallRatio mx' = mx |
550 |
|
551 |
-- Check tag maps |
552 |
prop_Node_tagMaps_idempotent tags = |
553 |
Node.delTags (Node.addTags m tags) tags == m |
554 |
where m = Data.Map.empty |
555 |
|
556 |
prop_Node_tagMaps_reject tags = |
557 |
not (null tags) ==> |
558 |
any (\t -> Node.rejectAddTags m [t]) tags |
559 |
where m = Node.addTags Data.Map.empty tags |
560 |
|
561 |
prop_Node_showField node = |
562 |
forAll (elements Node.defaultFields) $ \ field -> |
563 |
fst (Node.showHeader field) /= Types.unknownField && |
564 |
Node.showField node field /= Types.unknownField |
565 |
|
566 |
testNode = |
567 |
[ run prop_Node_setAlias |
568 |
, run prop_Node_setOffline |
569 |
, run prop_Node_setMcpu |
570 |
, run prop_Node_setXmem |
571 |
, run prop_Node_addPriFM |
572 |
, run prop_Node_addPriFD |
573 |
, run prop_Node_addPriFC |
574 |
, run prop_Node_addSec |
575 |
, run prop_Node_setMdsk |
576 |
, run prop_Node_tagMaps_idempotent |
577 |
, run prop_Node_tagMaps_reject |
578 |
, run prop_Node_showField |
579 |
] |
580 |
|
581 |
|
582 |
-- Cluster tests |
583 |
|
584 |
-- | Check that the cluster score is close to zero for a homogeneous cluster |
585 |
prop_Score_Zero node count = |
586 |
(not (Node.offline node) && not (Node.failN1 node) && (count > 0) && |
587 |
(Node.tDsk node > 0) && (Node.tMem node > 0)) ==> |
588 |
let fn = Node.buildPeers node Container.empty |
589 |
nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)] |
590 |
nl = Container.fromAssocList nlst |
591 |
score = Cluster.compCV nl |
592 |
-- we can't say == 0 here as the floating point errors accumulate; |
593 |
-- this should be much lower than the default score in CLI.hs |
594 |
in score <= 1e-15 |
595 |
|
596 |
-- | Check that cluster stats are sane |
597 |
prop_CStats_sane node count = |
598 |
(not (Node.offline node) && not (Node.failN1 node) && (count > 0) && |
599 |
(Node.availDisk node > 0) && (Node.availMem node > 0)) ==> |
600 |
let fn = Node.buildPeers node Container.empty |
601 |
nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)] |
602 |
nl = Container.fromAssocList nlst |
603 |
cstats = Cluster.totalResources nl |
604 |
in Cluster.csAdsk cstats >= 0 && |
605 |
Cluster.csAdsk cstats <= Cluster.csFdsk cstats |
606 |
|
607 |
-- | Check that one instance is allocated correctly, without |
608 |
-- rebalances needed |
609 |
prop_ClusterAlloc_sane node inst = |
610 |
forAll (choose (5, 20)) $ \count -> |
611 |
not (Node.offline node) |
612 |
&& not (Node.failN1 node) |
613 |
&& Node.availDisk node > 0 |
614 |
&& Node.availMem node > 0 |
615 |
==> |
616 |
let nl = makeSmallCluster node count |
617 |
il = Container.empty |
618 |
rqnodes = 2 |
619 |
inst' = setInstanceSmallerThanNode node inst |
620 |
in case Cluster.tryAlloc nl il inst' rqnodes of |
621 |
Types.Bad _ -> False |
622 |
Types.Ok (_, _, sols3) -> |
623 |
case sols3 of |
624 |
[] -> False |
625 |
(_, (xnl, xi, _)):[] -> |
626 |
let cv = Cluster.compCV xnl |
627 |
il' = Container.add (Instance.idx xi) xi il |
628 |
tbl = Cluster.Table xnl il' cv [] |
629 |
in not (canBalance tbl True False) |
630 |
_ -> False |
631 |
|
632 |
-- | Checks that on a 2-5 node cluster, we can allocate a random |
633 |
-- instance spec via tiered allocation (whatever the original instance |
634 |
-- spec), on either one or two nodes |
635 |
prop_ClusterCanTieredAlloc node inst = |
636 |
forAll (choose (2, 5)) $ \count -> |
637 |
forAll (choose (1, 2)) $ \rqnodes -> |
638 |
not (Node.offline node) |
639 |
&& not (Node.failN1 node) |
640 |
&& isNodeBig node 4 |
641 |
==> |
642 |
let nl = makeSmallCluster node count |
643 |
il = Container.empty |
644 |
in case Cluster.tieredAlloc nl il inst rqnodes [] of |
645 |
Types.Bad _ -> False |
646 |
Types.Ok (_, _, il', ixes) -> not (null ixes) && |
647 |
IntMap.size il' == length ixes |
648 |
|
649 |
-- | Checks that on a 4-8 node cluster, once we allocate an instance, |
650 |
-- we can also evacuate it |
651 |
prop_ClusterAllocEvac node inst = |
652 |
forAll (choose (4, 8)) $ \count -> |
653 |
not (Node.offline node) |
654 |
&& not (Node.failN1 node) |
655 |
&& isNodeBig node 4 |
656 |
==> |
657 |
let nl = makeSmallCluster node count |
658 |
il = Container.empty |
659 |
rqnodes = 2 |
660 |
inst' = setInstanceSmallerThanNode node inst |
661 |
in case Cluster.tryAlloc nl il inst' rqnodes of |
662 |
Types.Bad _ -> False |
663 |
Types.Ok (_, _, sols3) -> |
664 |
case sols3 of |
665 |
[] -> False |
666 |
(_, (xnl, xi, _)):[] -> |
667 |
let sdx = Instance.sNode xi |
668 |
il' = Container.add (Instance.idx xi) xi il |
669 |
in case Cluster.tryEvac xnl il' [sdx] of |
670 |
Just _ -> True |
671 |
_ -> False |
672 |
_ -> False |
673 |
|
674 |
-- | Check that allocating multiple instances on a cluster, then |
675 |
-- adding an empty node, results in a valid rebalance |
676 |
prop_ClusterAllocBalance node = |
677 |
forAll (choose (3, 5)) $ \count -> |
678 |
not (Node.offline node) |
679 |
&& not (Node.failN1 node) |
680 |
&& isNodeBig node 4 |
681 |
&& not (isNodeBig node 8) |
682 |
==> |
683 |
let nl = makeSmallCluster node count |
684 |
(hnode, nl') = IntMap.deleteFindMax nl |
685 |
il = Container.empty |
686 |
rqnodes = 2 |
687 |
i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu |
688 |
in case Cluster.iterateAlloc nl' il i_templ rqnodes [] of |
689 |
Types.Bad _ -> False |
690 |
Types.Ok (_, xnl, il', _) -> |
691 |
let ynl = Container.add (Node.idx hnode) hnode xnl |
692 |
cv = Cluster.compCV ynl |
693 |
tbl = Cluster.Table ynl il' cv [] |
694 |
in canBalance tbl True False |
695 |
|
696 |
testCluster = |
697 |
[ run prop_Score_Zero |
698 |
, run prop_CStats_sane |
699 |
, run prop_ClusterAlloc_sane |
700 |
, run prop_ClusterCanTieredAlloc |
701 |
, run prop_ClusterAllocEvac |
702 |
, run prop_ClusterAllocBalance |
703 |
] |
704 |
|
705 |
-- | Check that opcode serialization is idempotent |
706 |
|
707 |
prop_OpCodes_serialization op = |
708 |
case J.readJSON (J.showJSON op) of |
709 |
J.Error _ -> False |
710 |
J.Ok op' -> op == op' |
711 |
where _types = op::OpCodes.OpCode |
712 |
|
713 |
testOpCodes = |
714 |
[ run prop_OpCodes_serialization |
715 |
] |
716 |
|
717 |
-- | Check that (queued) job\/opcode status serialization is idempotent |
718 |
prop_OpStatus_serialization os = |
719 |
case J.readJSON (J.showJSON os) of |
720 |
J.Error _ -> False |
721 |
J.Ok os' -> os == os' |
722 |
where _types = os::Jobs.OpStatus |
723 |
|
724 |
prop_JobStatus_serialization js = |
725 |
case J.readJSON (J.showJSON js) of |
726 |
J.Error _ -> False |
727 |
J.Ok js' -> js == js' |
728 |
where _types = js::Jobs.JobStatus |
729 |
|
730 |
testJobs = |
731 |
[ run prop_OpStatus_serialization |
732 |
, run prop_JobStatus_serialization |
733 |
] |
734 |
|
735 |
-- | Loader tests |
736 |
|
737 |
prop_Loader_lookupNode ktn inst node = |
738 |
isJust (Loader.lookupNode ktn inst node) == (node `elem` names) |
739 |
where names = map fst ktn |
740 |
|
741 |
prop_Loader_lookupInstance kti inst = |
742 |
isJust (Loader.lookupInstance kti inst) == (inst `elem` names) |
743 |
where names = map fst kti |
744 |
|
745 |
prop_Loader_lookupInstanceIdx kti inst = |
746 |
case (Loader.lookupInstance kti inst, |
747 |
findIndex (\p -> fst p == inst) kti) of |
748 |
(Nothing, Nothing) -> True |
749 |
(Just idx, Just ex) -> idx == snd (kti !! ex) |
750 |
_ -> False |
751 |
|
752 |
prop_Loader_assignIndices enames = |
753 |
length nassoc == length enames && |
754 |
length kt == length enames && |
755 |
(if not (null enames) |
756 |
then maximum (map fst kt) == length enames - 1 |
757 |
else True) |
758 |
where (nassoc, kt) = Loader.assignIndices enames |
759 |
_types = enames::[(String, Node.Node)] |
760 |
|
761 |
|
762 |
-- | Checks that the number of primary instances recorded on the nodes |
763 |
-- is zero |
764 |
prop_Loader_mergeData ns = |
765 |
let na = map (\n -> (Node.idx n, n)) ns |
766 |
in case Loader.mergeData [] [] [] (na, [], []) of |
767 |
Types.Bad _ -> False |
768 |
Types.Ok (nl, il, _) -> |
769 |
let nodes = Container.elems nl |
770 |
instances = Container.elems il |
771 |
in (sum . map (length . Node.pList)) nodes == 0 && |
772 |
null instances |
773 |
|
774 |
testLoader = |
775 |
[ run prop_Loader_lookupNode |
776 |
, run prop_Loader_lookupInstance |
777 |
, run prop_Loader_lookupInstanceIdx |
778 |
, run prop_Loader_assignIndices |
779 |
, run prop_Loader_mergeData |
780 |
] |