Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / QC.hs @ 41085bd3

History | View | Annotate | Download (32.4 kB)

1
{-| Unittests for ganeti-htools
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2009, 2010, 2011 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 Data.List (findIndex, intercalate, nub, isPrefixOf)
41
import Data.Maybe
42
import Control.Monad
43
import qualified Text.JSON as J
44
import qualified Data.Map
45
import qualified Data.IntMap as IntMap
46
import qualified Ganeti.OpCodes as OpCodes
47
import qualified Ganeti.Jobs as Jobs
48
import qualified Ganeti.Luxi
49
import qualified Ganeti.HTools.CLI as CLI
50
import qualified Ganeti.HTools.Cluster as Cluster
51
import qualified Ganeti.HTools.Container as Container
52
import qualified Ganeti.HTools.ExtLoader
53
import qualified Ganeti.HTools.IAlloc as IAlloc
54
import qualified Ganeti.HTools.Instance as Instance
55
import qualified Ganeti.HTools.Loader as Loader
56
import qualified Ganeti.HTools.Luxi
57
import qualified Ganeti.HTools.Node as Node
58
import qualified Ganeti.HTools.Group as Group
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
import qualified Ganeti.Constants as C
67

    
68
run :: Testable prop => prop -> Args -> IO Result
69
run = flip quickCheckWithResult
70

    
71
-- * Constants
72

    
73
-- | Maximum memory (1TiB, somewhat random value)
74
maxMem :: Int
75
maxMem = 1024 * 1024
76

    
77
-- | Maximum disk (8TiB, somewhat random value)
78
maxDsk :: Int
79
maxDsk = 1024 * 1024 * 8
80

    
81
-- | Max CPUs (1024, somewhat random value)
82
maxCpu :: Int
83
maxCpu = 1024
84

    
85
defGroup :: Group.Group
86
defGroup = flip Group.setIdx 0 $
87
               Group.create "default" Utils.defaultGroupID
88
                    Types.AllocPreferred
89

    
90
defGroupList :: Group.List
91
defGroupList = Container.fromList [(Group.idx defGroup, defGroup)]
92

    
93
defGroupAssoc :: Data.Map.Map String Types.Gdx
94
defGroupAssoc = Data.Map.singleton (Group.uuid defGroup) (Group.idx defGroup)
95

    
96
-- * Helper functions
97

    
98
-- | Simple checker for whether OpResult is fail or pass
99
isFailure :: Types.OpResult a -> Bool
100
isFailure (Types.OpFail _) = True
101
isFailure _ = False
102

    
103
-- | Update an instance to be smaller than a node
104
setInstanceSmallerThanNode node inst =
105
    inst { Instance.mem = Node.availMem node `div` 2
106
         , Instance.dsk = Node.availDisk node `div` 2
107
         , Instance.vcpus = Node.availCpu node `div` 2
108
         }
109

    
110
-- | Create an instance given its spec
111
createInstance mem dsk vcpus =
112
    Instance.create "inst-unnamed" mem dsk vcpus "running" [] True (-1) (-1)
113

    
114
-- | Create a small cluster by repeating a node spec
115
makeSmallCluster :: Node.Node -> Int -> Node.List
116
makeSmallCluster node count =
117
    let fn = Node.buildPeers node Container.empty
118
        namelst = map (\n -> (Node.name n, n)) (replicate count fn)
119
        (_, nlst) = Loader.assignIndices namelst
120
    in nlst
121

    
122
-- | Checks if a node is "big" enough
123
isNodeBig :: Node.Node -> Int -> Bool
124
isNodeBig node size = Node.availDisk node > size * Types.unitDsk
125
                      && Node.availMem node > size * Types.unitMem
126
                      && Node.availCpu node > size * Types.unitCpu
127

    
128
canBalance :: Cluster.Table -> Bool -> Bool -> Bool -> Bool
129
canBalance tbl dm im evac = isJust $ Cluster.tryBalance tbl dm im evac 0 0
130

    
131
-- | Assigns a new fresh instance to a cluster; this is not
132
-- allocation, so no resource checks are done
133
assignInstance :: Node.List -> Instance.List -> Instance.Instance ->
134
                  Types.Idx -> Types.Idx ->
135
                  (Node.List, Instance.List)
136
assignInstance nl il inst pdx sdx =
137
  let pnode = Container.find pdx nl
138
      snode = Container.find sdx nl
139
      maxiidx = if Container.null il
140
                then 0
141
                else fst (Container.findMax il) + 1
142
      inst' = inst { Instance.idx = maxiidx,
143
                     Instance.pNode = pdx, Instance.sNode = sdx }
144
      pnode' = Node.setPri pnode inst'
145
      snode' = Node.setSec snode inst'
146
      nl' = Container.addTwo pdx pnode' sdx snode' nl
147
      il' = Container.add maxiidx inst' il
148
  in (nl', il')
149

    
150
-- * Arbitrary instances
151

    
152
newtype DNSChar = DNSChar { dnsGetChar::Char }
153
instance Arbitrary DNSChar where
154
    arbitrary = do
155
      x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
156
      return (DNSChar x)
157

    
158
getName :: Gen String
159
getName = do
160
  n <- choose (1, 64)
161
  dn <- vector n::Gen [DNSChar]
162
  return (map dnsGetChar dn)
163

    
164

    
165
getFQDN :: Gen String
166
getFQDN = do
167
  felem <- getName
168
  ncomps <- choose (1, 4)
169
  frest <- vector ncomps::Gen [[DNSChar]]
170
  let frest' = map (map dnsGetChar) frest
171
  return (felem ++ "." ++ intercalate "." frest')
172

    
173
-- let's generate a random instance
174
instance Arbitrary Instance.Instance where
175
    arbitrary = do
176
      name <- getFQDN
177
      mem <- choose (0, maxMem)
178
      dsk <- choose (0, maxDsk)
179
      run_st <- elements [ C.inststErrorup
180
                         , C.inststErrordown
181
                         , C.inststAdmindown
182
                         , C.inststNodedown
183
                         , C.inststNodeoffline
184
                         , C.inststRunning
185
                         , "no_such_status1"
186
                         , "no_such_status2"]
187
      pn <- arbitrary
188
      sn <- arbitrary
189
      vcpus <- choose (0, maxCpu)
190
      return $ Instance.create name mem dsk vcpus run_st [] True pn sn
191

    
192
-- and a random node
193
instance Arbitrary Node.Node where
194
    arbitrary = do
195
      name <- getFQDN
196
      mem_t <- choose (0, maxMem)
197
      mem_f <- choose (0, mem_t)
198
      mem_n <- choose (0, mem_t - mem_f)
199
      dsk_t <- choose (0, maxDsk)
200
      dsk_f <- choose (0, dsk_t)
201
      cpu_t <- choose (0, maxCpu)
202
      offl <- arbitrary
203
      let n = Node.create name (fromIntegral mem_t) mem_n mem_f
204
              (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl
205
              0
206
          n' = Node.buildPeers n Container.empty
207
      return n'
208

    
209
-- replace disks
210
instance Arbitrary OpCodes.ReplaceDisksMode where
211
  arbitrary = elements [ OpCodes.ReplaceOnPrimary
212
                       , OpCodes.ReplaceOnSecondary
213
                       , OpCodes.ReplaceNewSecondary
214
                       , OpCodes.ReplaceAuto
215
                       ]
216

    
217
instance Arbitrary OpCodes.OpCode where
218
  arbitrary = do
219
    op_id <- elements [ "OP_TEST_DELAY"
220
                      , "OP_INSTANCE_REPLACE_DISKS"
221
                      , "OP_INSTANCE_FAILOVER"
222
                      , "OP_INSTANCE_MIGRATE"
223
                      ]
224
    (case op_id of
225
        "OP_TEST_DELAY" ->
226
          liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary
227
        "OP_INSTANCE_REPLACE_DISKS" ->
228
          liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary
229
          arbitrary arbitrary arbitrary
230
        "OP_INSTANCE_FAILOVER" ->
231
          liftM2 OpCodes.OpInstanceFailover arbitrary arbitrary
232
        "OP_INSTANCE_MIGRATE" ->
233
          liftM4 OpCodes.OpInstanceMigrate arbitrary arbitrary arbitrary
234
          arbitrary
235
        _ -> fail "Wrong opcode")
236

    
237
instance Arbitrary Jobs.OpStatus where
238
  arbitrary = elements [minBound..maxBound]
239

    
240
instance Arbitrary Jobs.JobStatus where
241
  arbitrary = elements [minBound..maxBound]
242

    
243
-- * Actual tests
244

    
245
-- If the list is not just an empty element, and if the elements do
246
-- not contain commas, then join+split should be idepotent
247
prop_Utils_commaJoinSplit lst = lst /= [""] &&
248
                                all (not . elem ',') lst ==>
249
                                Utils.sepSplit ',' (Utils.commaJoin lst) == lst
250
-- Split and join should always be idempotent
251
prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s
252

    
253
-- | fromObjWithDefault, we test using the Maybe monad and an integer
254
-- value
255
prop_Utils_fromObjWithDefault def_value random_key =
256
    -- a missing key will be returned with the default
257
    Utils.fromObjWithDefault [] random_key def_value == Just def_value &&
258
    -- a found key will be returned as is, not with default
259
    Utils.fromObjWithDefault [(random_key, J.showJSON def_value)]
260
         random_key (def_value+1) == Just def_value
261
        where _types = def_value :: Integer
262

    
263
testUtils =
264
  [ run prop_Utils_commaJoinSplit
265
  , run prop_Utils_commaSplitJoin
266
  , run prop_Utils_fromObjWithDefault
267
  ]
268

    
269
-- | Make sure add is idempotent
270
prop_PeerMap_addIdempotent pmap key em =
271
    fn puniq == fn (fn puniq)
272
    where _types = (pmap::PeerMap.PeerMap,
273
                    key::PeerMap.Key, em::PeerMap.Elem)
274
          fn = PeerMap.add key em
275
          puniq = PeerMap.accumArray const pmap
276

    
277
-- | Make sure remove is idempotent
278
prop_PeerMap_removeIdempotent pmap key =
279
    fn puniq == fn (fn puniq)
280
    where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
281
          fn = PeerMap.remove key
282
          puniq = PeerMap.accumArray const pmap
283

    
284
-- | Make sure a missing item returns 0
285
prop_PeerMap_findMissing pmap key =
286
    PeerMap.find key (PeerMap.remove key puniq) == 0
287
    where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
288
          puniq = PeerMap.accumArray const pmap
289

    
290
-- | Make sure an added item is found
291
prop_PeerMap_addFind pmap key em =
292
    PeerMap.find key (PeerMap.add key em puniq) == em
293
    where _types = (pmap::PeerMap.PeerMap,
294
                    key::PeerMap.Key, em::PeerMap.Elem)
295
          puniq = PeerMap.accumArray const pmap
296

    
297
-- | Manual check that maxElem returns the maximum indeed, or 0 for null
298
prop_PeerMap_maxElem pmap =
299
    PeerMap.maxElem puniq == if null puniq then 0
300
                             else (maximum . snd . unzip) puniq
301
    where _types = pmap::PeerMap.PeerMap
302
          puniq = PeerMap.accumArray const pmap
303

    
304
testPeerMap =
305
    [ run prop_PeerMap_addIdempotent
306
    , run prop_PeerMap_removeIdempotent
307
    , run prop_PeerMap_maxElem
308
    , run prop_PeerMap_addFind
309
    , run prop_PeerMap_findMissing
310
    ]
311

    
312
-- Container tests
313

    
314
prop_Container_addTwo cdata i1 i2 =
315
    fn i1 i2 cont == fn i2 i1 cont &&
316
       fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
317
    where _types = (cdata::[Int],
318
                    i1::Int, i2::Int)
319
          cont = foldl (\c x -> Container.add x x c) Container.empty cdata
320
          fn x1 x2 = Container.addTwo x1 x1 x2 x2
321

    
322
prop_Container_nameOf node =
323
  let nl = makeSmallCluster node 1
324
      fnode = head (Container.elems nl)
325
  in Container.nameOf nl (Node.idx fnode) == Node.name fnode
326

    
327
-- We test that in a cluster, given a random node, we can find it by
328
-- its name and alias, as long as all names and aliases are unique,
329
-- and that we fail to find a non-existing name
330
prop_Container_findByName node othername =
331
  forAll (choose (1, 20)) $ \ cnt ->
332
  forAll (choose (0, cnt - 1)) $ \ fidx ->
333
  forAll (vector cnt) $ \ names ->
334
  (length . nub) (map fst names ++ map snd names) ==
335
  length names * 2 &&
336
  not (othername `elem` (map fst names ++ map snd names)) ==>
337
  let nl = makeSmallCluster node cnt
338
      nodes = Container.elems nl
339
      nodes' = map (\((name, alias), nn) -> (Node.idx nn,
340
                                             nn { Node.name = name,
341
                                                  Node.alias = alias }))
342
               $ zip names nodes
343
      nl' = Container.fromList nodes'
344
      target = snd (nodes' !! fidx)
345
  in Container.findByName nl' (Node.name target) == Just target &&
346
     Container.findByName nl' (Node.alias target) == Just target &&
347
     Container.findByName nl' othername == Nothing
348

    
349
testContainer =
350
    [ run prop_Container_addTwo
351
    , run prop_Container_nameOf
352
    , run prop_Container_findByName
353
    ]
354

    
355
-- Simple instance tests, we only have setter/getters
356

    
357
prop_Instance_creat inst =
358
    Instance.name inst == Instance.alias inst
359

    
360
prop_Instance_setIdx inst idx =
361
    Instance.idx (Instance.setIdx inst idx) == idx
362
    where _types = (inst::Instance.Instance, idx::Types.Idx)
363

    
364
prop_Instance_setName inst name =
365
    Instance.name newinst == name &&
366
    Instance.alias newinst == name
367
    where _types = (inst::Instance.Instance, name::String)
368
          newinst = Instance.setName inst name
369

    
370
prop_Instance_setAlias inst name =
371
    Instance.name newinst == Instance.name inst &&
372
    Instance.alias newinst == name
373
    where _types = (inst::Instance.Instance, name::String)
374
          newinst = Instance.setAlias inst name
375

    
376
prop_Instance_setPri inst pdx =
377
    Instance.pNode (Instance.setPri inst pdx) == pdx
378
    where _types = (inst::Instance.Instance, pdx::Types.Ndx)
379

    
380
prop_Instance_setSec inst sdx =
381
    Instance.sNode (Instance.setSec inst sdx) == sdx
382
    where _types = (inst::Instance.Instance, sdx::Types.Ndx)
383

    
384
prop_Instance_setBoth inst pdx sdx =
385
    Instance.pNode si == pdx && Instance.sNode si == sdx
386
    where _types = (inst::Instance.Instance, pdx::Types.Ndx, sdx::Types.Ndx)
387
          si = Instance.setBoth inst pdx sdx
388

    
389
prop_Instance_runStatus_True inst =
390
    let run_st = Instance.running inst
391
        run_tx = Instance.runSt inst
392
    in
393
      run_tx `elem` Instance.runningStates ==> run_st
394

    
395
prop_Instance_runStatus_False inst =
396
    let run_st = Instance.running inst
397
        run_tx = Instance.runSt inst
398
    in
399
      run_tx `notElem` Instance.runningStates ==> not run_st
400

    
401
prop_Instance_shrinkMG inst =
402
    Instance.mem inst >= 2 * Types.unitMem ==>
403
        case Instance.shrinkByType inst Types.FailMem of
404
          Types.Ok inst' ->
405
              Instance.mem inst' == Instance.mem inst - Types.unitMem
406
          _ -> False
407

    
408
prop_Instance_shrinkMF inst =
409
    forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
410
    let inst' = inst { Instance.mem = mem}
411
    in Types.isBad $ Instance.shrinkByType inst' Types.FailMem
412

    
413
prop_Instance_shrinkCG inst =
414
    Instance.vcpus inst >= 2 * Types.unitCpu ==>
415
        case Instance.shrinkByType inst Types.FailCPU of
416
          Types.Ok inst' ->
417
              Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
418
          _ -> False
419

    
420
prop_Instance_shrinkCF inst =
421
    forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
422
    let inst' = inst { Instance.vcpus = vcpus }
423
    in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU
424

    
425
prop_Instance_shrinkDG inst =
426
    Instance.dsk inst >= 2 * Types.unitDsk ==>
427
        case Instance.shrinkByType inst Types.FailDisk of
428
          Types.Ok inst' ->
429
              Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
430
          _ -> False
431

    
432
prop_Instance_shrinkDF inst =
433
    forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
434
    let inst' = inst { Instance.dsk = dsk }
435
    in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk
436

    
437
prop_Instance_setMovable inst m =
438
    Instance.movable inst' == m
439
    where inst' = Instance.setMovable inst m
440

    
441
testInstance =
442
    [ run prop_Instance_creat
443
    , run prop_Instance_setIdx
444
    , run prop_Instance_setName
445
    , run prop_Instance_setAlias
446
    , run prop_Instance_setPri
447
    , run prop_Instance_setSec
448
    , run prop_Instance_setBoth
449
    , run prop_Instance_runStatus_True
450
    , run prop_Instance_runStatus_False
451
    , run prop_Instance_shrinkMG
452
    , run prop_Instance_shrinkMF
453
    , run prop_Instance_shrinkCG
454
    , run prop_Instance_shrinkCF
455
    , run prop_Instance_shrinkDG
456
    , run prop_Instance_shrinkDF
457
    , run prop_Instance_setMovable
458
    ]
459

    
460
-- Instance text loader tests
461

    
462
prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx autobal =
463
    not (null pnode) && pdx >= 0 && sdx >= 0 ==>
464
    let vcpus_s = show vcpus
465
        dsk_s = show dsk
466
        mem_s = show mem
467
        rsdx = if pdx == sdx
468
               then sdx + 1
469
               else sdx
470
        ndx = if null snode
471
              then [(pnode, pdx)]
472
              else [(pnode, pdx), (snode, rsdx)]
473
        nl = Data.Map.fromList ndx
474
        tags = ""
475
        sbal = if autobal then "Y" else "N"
476
        inst = Text.loadInst nl
477
               [name, mem_s, dsk_s, vcpus_s, status,
478
                sbal, pnode, snode, tags]:: Maybe (String, Instance.Instance)
479
        fail1 = Text.loadInst nl
480
               [name, mem_s, dsk_s, vcpus_s, status,
481
                sbal, pnode, pnode, tags]:: Maybe (String, Instance.Instance)
482
        _types = ( name::String, mem::Int, dsk::Int
483
                 , vcpus::Int, status::String
484
                 , pnode::String, snode::String
485
                 , pdx::Types.Ndx, sdx::Types.Ndx
486
                 , autobal::Bool)
487
    in
488
      case inst of
489
        Nothing -> False
490
        Just (_, i) ->
491
            Instance.name i == name &&
492
            Instance.vcpus i == vcpus &&
493
            Instance.mem i == mem &&
494
            Instance.pNode i == pdx &&
495
            Instance.sNode i == (if null snode
496
                                 then Node.noSecondary
497
                                 else rsdx) &&
498
            Instance.auto_balance i == autobal &&
499
            isNothing fail1
500

    
501
prop_Text_Load_InstanceFail ktn fields =
502
    length fields /= 9 ==>
503
    case Text.loadInst nl fields of
504
      Types.Ok _ -> False
505
      Types.Bad msg -> "Invalid/incomplete instance data: '" `isPrefixOf` msg
506
    where nl = Data.Map.fromList ktn
507

    
508
prop_Text_Load_Node name tm nm fm td fd tc fo =
509
    let conv v = if v < 0
510
                    then "?"
511
                    else show v
512
        tm_s = conv tm
513
        nm_s = conv nm
514
        fm_s = conv fm
515
        td_s = conv td
516
        fd_s = conv fd
517
        tc_s = conv tc
518
        fo_s = if fo
519
               then "Y"
520
               else "N"
521
        any_broken = any (< 0) [tm, nm, fm, td, fd, tc]
522
        gid = Group.uuid defGroup
523
    in case Text.loadNode defGroupAssoc
524
           [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s, gid] of
525
         Nothing -> False
526
         Just (name', node) ->
527
             if fo || any_broken
528
             then Node.offline node
529
             else Node.name node == name' && name' == name &&
530
                  Node.alias node == name &&
531
                  Node.tMem node == fromIntegral tm &&
532
                  Node.nMem node == nm &&
533
                  Node.fMem node == fm &&
534
                  Node.tDsk node == fromIntegral td &&
535
                  Node.fDsk node == fd &&
536
                  Node.tCpu node == fromIntegral tc
537

    
538
prop_Text_Load_NodeFail fields =
539
    length fields /= 8 ==> isNothing $ Text.loadNode Data.Map.empty fields
540

    
541
prop_Text_NodeLSIdempotent node =
542
    (Text.loadNode defGroupAssoc.
543
         Utils.sepSplit '|' . Text.serializeNode defGroupList) n ==
544
    Just (Node.name n, n)
545
    -- override failN1 to what loadNode returns by default
546
    where n = node { Node.failN1 = True, Node.offline = False }
547

    
548
testText =
549
    [ run prop_Text_Load_Instance
550
    , run prop_Text_Load_InstanceFail
551
    , run prop_Text_Load_Node
552
    , run prop_Text_Load_NodeFail
553
    , run prop_Text_NodeLSIdempotent
554
    ]
555

    
556
-- Node tests
557

    
558
prop_Node_setAlias node name =
559
    Node.name newnode == Node.name node &&
560
    Node.alias newnode == name
561
    where _types = (node::Node.Node, name::String)
562
          newnode = Node.setAlias node name
563

    
564
prop_Node_setOffline node status =
565
    Node.offline newnode == status
566
    where newnode = Node.setOffline node status
567

    
568
prop_Node_setXmem node xm =
569
    Node.xMem newnode == xm
570
    where newnode = Node.setXmem node xm
571

    
572
prop_Node_setMcpu node mc =
573
    Node.mCpu newnode == mc
574
    where newnode = Node.setMcpu node mc
575

    
576
-- | Check that an instance add with too high memory or disk will be rejected
577
prop_Node_addPriFM node inst = Instance.mem inst >= Node.fMem node &&
578
                               not (Node.failN1 node)
579
                               ==>
580
                               case Node.addPri node inst'' of
581
                                 Types.OpFail Types.FailMem -> True
582
                                 _ -> False
583
    where _types = (node::Node.Node, inst::Instance.Instance)
584
          inst' = setInstanceSmallerThanNode node inst
585
          inst'' = inst' { Instance.mem = Instance.mem inst }
586

    
587
prop_Node_addPriFD node inst = Instance.dsk inst >= Node.fDsk node &&
588
                               not (Node.failN1 node)
589
                               ==>
590
                               case Node.addPri node inst'' of
591
                                 Types.OpFail Types.FailDisk -> True
592
                                 _ -> False
593
    where _types = (node::Node.Node, inst::Instance.Instance)
594
          inst' = setInstanceSmallerThanNode node inst
595
          inst'' = inst' { Instance.dsk = Instance.dsk inst }
596

    
597
prop_Node_addPriFC node inst (Positive extra) =
598
    not (Node.failN1 node) ==>
599
        case Node.addPri node inst'' of
600
          Types.OpFail Types.FailCPU -> True
601
          _ -> False
602
    where _types = (node::Node.Node, inst::Instance.Instance)
603
          inst' = setInstanceSmallerThanNode node inst
604
          inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
605

    
606
-- | Check that an instance add with too high memory or disk will be rejected
607
prop_Node_addSec node inst pdx =
608
    (Instance.mem inst >= (Node.fMem node - Node.rMem node) ||
609
     Instance.dsk inst >= Node.fDsk node) &&
610
    not (Node.failN1 node)
611
    ==> isFailure (Node.addSec node inst pdx)
612
        where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int)
613

    
614
-- | Checks for memory reservation changes
615
prop_Node_rMem node inst =
616
    -- ab = auto_balance, nb = non-auto_balance
617
    -- we use -1 as the primary node of the instance
618
    let inst' = inst { Instance.pNode = -1, Instance.auto_balance = True }
619
        inst_ab = setInstanceSmallerThanNode node inst'
620
        inst_nb = inst_ab { Instance.auto_balance = False }
621
        -- now we have the two instances, identical except the
622
        -- auto_balance attribute
623
        orig_rmem = Node.rMem node
624
        inst_idx = Instance.idx inst_ab
625
        node_add_ab = Node.addSec node inst_ab (-1)
626
        node_add_nb = Node.addSec node inst_nb (-1)
627
        node_del_ab = liftM (flip Node.removeSec inst_ab) node_add_ab
628
        node_del_nb = liftM (flip Node.removeSec inst_nb) node_add_nb
629
    in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of
630
         (Types.OpGood a_ab, Types.OpGood a_nb,
631
          Types.OpGood d_ab, Types.OpGood d_nb) ->
632
             Node.rMem a_ab >  orig_rmem &&
633
             Node.rMem a_ab - orig_rmem == Instance.mem inst_ab &&
634
             Node.rMem a_nb == orig_rmem &&
635
             Node.rMem d_ab == orig_rmem &&
636
             Node.rMem d_nb == orig_rmem &&
637
             -- this is not related to rMem, but as good a place to
638
             -- test as any
639
             inst_idx `elem` Node.sList a_ab &&
640
             not (inst_idx `elem` Node.sList d_ab)
641
         _ -> False
642

    
643
newtype SmallRatio = SmallRatio Double deriving Show
644
instance Arbitrary SmallRatio where
645
    arbitrary = do
646
      v <- choose (0, 1)
647
      return $ SmallRatio v
648

    
649
-- | Check mdsk setting
650
prop_Node_setMdsk node mx =
651
    Node.loDsk node' >= 0 &&
652
    fromIntegral (Node.loDsk node') <= Node.tDsk node &&
653
    Node.availDisk node' >= 0 &&
654
    Node.availDisk node' <= Node.fDsk node' &&
655
    fromIntegral (Node.availDisk node') <= Node.tDsk node' &&
656
    Node.mDsk node' == mx'
657
    where _types = (node::Node.Node, mx::SmallRatio)
658
          node' = Node.setMdsk node mx'
659
          SmallRatio mx' = mx
660

    
661
-- Check tag maps
662
prop_Node_tagMaps_idempotent tags =
663
    Node.delTags (Node.addTags m tags) tags == m
664
    where m = Data.Map.empty
665

    
666
prop_Node_tagMaps_reject tags =
667
    not (null tags) ==>
668
    any (\t -> Node.rejectAddTags m [t]) tags
669
    where m = Node.addTags Data.Map.empty tags
670

    
671
prop_Node_showField node =
672
  forAll (elements Node.defaultFields) $ \ field ->
673
  fst (Node.showHeader field) /= Types.unknownField &&
674
  Node.showField node field /= Types.unknownField
675

    
676

    
677
prop_Node_computeGroups nodes =
678
  let ng = Node.computeGroups nodes
679
      onlyuuid = map fst ng
680
  in length nodes == sum (map (length . snd) ng) &&
681
     all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng &&
682
     length (nub onlyuuid) == length onlyuuid &&
683
     (null nodes || not (null ng))
684

    
685
testNode =
686
    [ run prop_Node_setAlias
687
    , run prop_Node_setOffline
688
    , run prop_Node_setMcpu
689
    , run prop_Node_setXmem
690
    , run prop_Node_addPriFM
691
    , run prop_Node_addPriFD
692
    , run prop_Node_addPriFC
693
    , run prop_Node_addSec
694
    , run prop_Node_rMem
695
    , run prop_Node_setMdsk
696
    , run prop_Node_tagMaps_idempotent
697
    , run prop_Node_tagMaps_reject
698
    , run prop_Node_showField
699
    , run prop_Node_computeGroups
700
    ]
701

    
702

    
703
-- Cluster tests
704

    
705
-- | Check that the cluster score is close to zero for a homogeneous cluster
706
prop_Score_Zero node =
707
    forAll (choose (1, 1024)) $ \count ->
708
    (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
709
     (Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
710
    let fn = Node.buildPeers node Container.empty
711
        nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
712
        nl = Container.fromList nlst
713
        score = Cluster.compCV nl
714
    -- we can't say == 0 here as the floating point errors accumulate;
715
    -- this should be much lower than the default score in CLI.hs
716
    in score <= 1e-12
717

    
718
-- | Check that cluster stats are sane
719
prop_CStats_sane node =
720
    forAll (choose (1, 1024)) $ \count ->
721
    (not (Node.offline node) && not (Node.failN1 node) &&
722
     (Node.availDisk node > 0) && (Node.availMem node > 0)) ==>
723
    let fn = Node.buildPeers node Container.empty
724
        nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
725
        nl = Container.fromList nlst
726
        cstats = Cluster.totalResources nl
727
    in Cluster.csAdsk cstats >= 0 &&
728
       Cluster.csAdsk cstats <= Cluster.csFdsk cstats
729

    
730
-- | Check that one instance is allocated correctly, without
731
-- rebalances needed
732
prop_ClusterAlloc_sane node inst =
733
    forAll (choose (5, 20)) $ \count ->
734
    not (Node.offline node)
735
            && not (Node.failN1 node)
736
            && Node.availDisk node > 0
737
            && Node.availMem node > 0
738
            ==>
739
    let nl = makeSmallCluster node count
740
        il = Container.empty
741
        inst' = setInstanceSmallerThanNode node inst
742
    in case Cluster.genAllocNodes defGroupList nl 2 True >>=
743
       Cluster.tryAlloc nl il inst' of
744
         Types.Bad _ -> False
745
         Types.Ok as ->
746
             case Cluster.asSolutions as of
747
               [] -> False
748
               (xnl, xi, _, cv):[] ->
749
                   let il' = Container.add (Instance.idx xi) xi il
750
                       tbl = Cluster.Table xnl il' cv []
751
                   in not (canBalance tbl True True False)
752
               _ -> False
753

    
754
-- | Checks that on a 2-5 node cluster, we can allocate a random
755
-- instance spec via tiered allocation (whatever the original instance
756
-- spec), on either one or two nodes
757
prop_ClusterCanTieredAlloc node inst =
758
    forAll (choose (2, 5)) $ \count ->
759
    forAll (choose (1, 2)) $ \rqnodes ->
760
    not (Node.offline node)
761
            && not (Node.failN1 node)
762
            && isNodeBig node 4
763
            ==>
764
    let nl = makeSmallCluster node count
765
        il = Container.empty
766
        allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
767
    in case allocnodes >>= \allocnodes' ->
768
        Cluster.tieredAlloc nl il inst allocnodes' [] [] of
769
         Types.Bad _ -> False
770
         Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) &&
771
                                      IntMap.size il' == length ixes &&
772
                                      length ixes == length cstats
773

    
774
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
775
-- we can also evacuate it
776
prop_ClusterAllocEvac node inst =
777
    forAll (choose (4, 8)) $ \count ->
778
    not (Node.offline node)
779
            && not (Node.failN1 node)
780
            && isNodeBig node 4
781
            ==>
782
    let nl = makeSmallCluster node count
783
        il = Container.empty
784
        inst' = setInstanceSmallerThanNode node inst
785
    in case Cluster.genAllocNodes defGroupList nl 2 True >>=
786
       Cluster.tryAlloc nl il inst' of
787
         Types.Bad _ -> False
788
         Types.Ok as ->
789
             case Cluster.asSolutions as of
790
               [] -> False
791
               (xnl, xi, _, _):[] ->
792
                   let sdx = Instance.sNode xi
793
                       il' = Container.add (Instance.idx xi) xi il
794
                   in case Cluster.tryEvac xnl il' [Instance.idx xi] [sdx] of
795
                        Just _ -> True
796
                        _ -> False
797
               _ -> False
798

    
799
-- | Check that allocating multiple instances on a cluster, then
800
-- adding an empty node, results in a valid rebalance
801
prop_ClusterAllocBalance node =
802
    forAll (choose (3, 5)) $ \count ->
803
    not (Node.offline node)
804
            && not (Node.failN1 node)
805
            && isNodeBig node 4
806
            && not (isNodeBig node 8)
807
            ==>
808
    let nl = makeSmallCluster node count
809
        (hnode, nl') = IntMap.deleteFindMax nl
810
        il = Container.empty
811
        allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True
812
        i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
813
    in case allocnodes >>= \allocnodes' ->
814
        Cluster.iterateAlloc nl' il i_templ allocnodes' [] [] of
815
         Types.Bad _ -> False
816
         Types.Ok (_, xnl, il', _, _) ->
817
                   let ynl = Container.add (Node.idx hnode) hnode xnl
818
                       cv = Cluster.compCV ynl
819
                       tbl = Cluster.Table ynl il' cv []
820
                   in canBalance tbl True True False
821

    
822
-- | Checks consistency
823
prop_ClusterCheckConsistency node inst =
824
  let nl = makeSmallCluster node 3
825
      [node1, node2, node3] = Container.elems nl
826
      node3' = node3 { Node.group = 1 }
827
      nl' = Container.add (Node.idx node3') node3' nl
828
      inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2)
829
      inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary
830
      inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3)
831
      ccheck = Cluster.findSplitInstances nl' . Container.fromList
832
  in null (ccheck [(0, inst1)]) &&
833
     null (ccheck [(0, inst2)]) &&
834
     (not . null $ ccheck [(0, inst3)])
835

    
836
-- For now, we only test that we don't lose instances during the split
837
prop_ClusterSplitCluster node inst =
838
  forAll (choose (0, 100)) $ \icnt ->
839
  let nl = makeSmallCluster node 2
840
      (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1)
841
                   (nl, Container.empty) [1..icnt]
842
      gni = Cluster.splitCluster nl' il'
843
  in sum (map (Container.size . snd . snd) gni) == icnt &&
844
     all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group)
845
                                 (Container.elems nl'')) gni
846

    
847
testCluster =
848
    [ run prop_Score_Zero
849
    , run prop_CStats_sane
850
    , run prop_ClusterAlloc_sane
851
    , run prop_ClusterCanTieredAlloc
852
    , run prop_ClusterAllocEvac
853
    , run prop_ClusterAllocBalance
854
    , run prop_ClusterCheckConsistency
855
    , run prop_ClusterSplitCluster
856
    ]
857

    
858
-- | Check that opcode serialization is idempotent
859

    
860
prop_OpCodes_serialization op =
861
  case J.readJSON (J.showJSON op) of
862
    J.Error _ -> False
863
    J.Ok op' -> op == op'
864
  where _types = op::OpCodes.OpCode
865

    
866
testOpCodes =
867
  [ run prop_OpCodes_serialization
868
  ]
869

    
870
-- | Check that (queued) job\/opcode status serialization is idempotent
871
prop_OpStatus_serialization os =
872
  case J.readJSON (J.showJSON os) of
873
    J.Error _ -> False
874
    J.Ok os' -> os == os'
875
  where _types = os::Jobs.OpStatus
876

    
877
prop_JobStatus_serialization js =
878
  case J.readJSON (J.showJSON js) of
879
    J.Error _ -> False
880
    J.Ok js' -> js == js'
881
  where _types = js::Jobs.JobStatus
882

    
883
testJobs =
884
  [ run prop_OpStatus_serialization
885
  , run prop_JobStatus_serialization
886
  ]
887

    
888
-- | Loader tests
889

    
890
prop_Loader_lookupNode ktn inst node =
891
  Loader.lookupNode nl inst node == Data.Map.lookup node nl
892
  where nl = Data.Map.fromList ktn
893

    
894
prop_Loader_lookupInstance kti inst =
895
  Loader.lookupInstance il inst == Data.Map.lookup inst il
896
  where il = Data.Map.fromList kti
897

    
898
prop_Loader_assignIndices nodes =
899
  Data.Map.size nassoc == length nodes &&
900
  Container.size kt == length nodes &&
901
  (if not (null nodes)
902
   then maximum (IntMap.keys kt) == length nodes - 1
903
   else True)
904
  where (nassoc, kt) = Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)
905

    
906

    
907
-- | Checks that the number of primary instances recorded on the nodes
908
-- is zero
909
prop_Loader_mergeData ns =
910
  let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns
911
  in case Loader.mergeData [] [] [] []
912
         (Loader.emptyCluster {Loader.cdNodes = na}) of
913
    Types.Bad _ -> False
914
    Types.Ok (Loader.ClusterData _ nl il _) ->
915
      let nodes = Container.elems nl
916
          instances = Container.elems il
917
      in (sum . map (length . Node.pList)) nodes == 0 &&
918
         null instances
919

    
920
testLoader =
921
  [ run prop_Loader_lookupNode
922
  , run prop_Loader_lookupInstance
923
  , run prop_Loader_assignIndices
924
  , run prop_Loader_mergeData
925
  ]