Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / QC.hs @ 1cb92fac

History | View | Annotate | Download (37.7 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
    , testTypes
38
    ) where
39

    
40
import Test.QuickCheck
41
import Data.List (findIndex, intercalate, nub, isPrefixOf)
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.Group as Group
60
import qualified Ganeti.HTools.PeerMap as PeerMap
61
import qualified Ganeti.HTools.Rapi
62
import qualified Ganeti.HTools.Simu
63
import qualified Ganeti.HTools.Text as Text
64
import qualified Ganeti.HTools.Types as Types
65
import qualified Ganeti.HTools.Utils as Utils
66
import qualified Ganeti.HTools.Version
67
import qualified Ganeti.Constants as C
68

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

    
72
-- * Constants
73

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

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

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

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

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

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

    
97
-- * Helper functions
98

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

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

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

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

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

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

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

    
152
-- * Arbitrary instances
153

    
154
-- | Defines a DNS name.
155
newtype DNSChar = DNSChar { dnsGetChar::Char }
156

    
157
instance Arbitrary DNSChar where
158
    arbitrary = do
159
      x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
160
      return (DNSChar x)
161

    
162
getName :: Gen String
163
getName = do
164
  n <- choose (1, 64)
165
  dn <- vector n::Gen [DNSChar]
166
  return (map dnsGetChar dn)
167

    
168

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

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

    
197
-- | Generas an arbitrary node based on sizing information.
198
genNode :: Maybe Int -- ^ Minimum node size in terms of units
199
        -> Maybe Int -- ^ Maximum node size (when Nothing, bounded
200
                     -- just by the max... constants)
201
        -> Gen Node.Node
202
genNode min_multiplier max_multiplier = do
203
  let (base_mem, base_dsk, base_cpu) =
204
          case min_multiplier of
205
            Just mm -> (mm * Types.unitMem,
206
                        mm * Types.unitDsk,
207
                        mm * Types.unitCpu)
208
            Nothing -> (0, 0, 0)
209
      (top_mem, top_dsk, top_cpu)  =
210
          case max_multiplier of
211
            Just mm -> (mm * Types.unitMem,
212
                        mm * Types.unitDsk,
213
                        mm * Types.unitCpu)
214
            Nothing -> (maxMem, maxDsk, maxCpu)
215
  name  <- getFQDN
216
  mem_t <- choose (base_mem, top_mem)
217
  mem_f <- choose (base_mem, mem_t)
218
  mem_n <- choose (0, mem_t - mem_f)
219
  dsk_t <- choose (base_dsk, top_dsk)
220
  dsk_f <- choose (base_dsk, dsk_t)
221
  cpu_t <- choose (base_cpu, top_cpu)
222
  offl  <- arbitrary
223
  let n = Node.create name (fromIntegral mem_t) mem_n mem_f
224
          (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl 0
225
  return $ Node.buildPeers n Container.empty
226

    
227
-- and a random node
228
instance Arbitrary Node.Node where
229
    arbitrary = genNode Nothing Nothing
230

    
231
-- replace disks
232
instance Arbitrary OpCodes.ReplaceDisksMode where
233
  arbitrary = elements [ OpCodes.ReplaceOnPrimary
234
                       , OpCodes.ReplaceOnSecondary
235
                       , OpCodes.ReplaceNewSecondary
236
                       , OpCodes.ReplaceAuto
237
                       ]
238

    
239
instance Arbitrary OpCodes.OpCode where
240
  arbitrary = do
241
    op_id <- elements [ "OP_TEST_DELAY"
242
                      , "OP_INSTANCE_REPLACE_DISKS"
243
                      , "OP_INSTANCE_FAILOVER"
244
                      , "OP_INSTANCE_MIGRATE"
245
                      ]
246
    (case op_id of
247
        "OP_TEST_DELAY" ->
248
          liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary
249
        "OP_INSTANCE_REPLACE_DISKS" ->
250
          liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary
251
          arbitrary arbitrary arbitrary
252
        "OP_INSTANCE_FAILOVER" ->
253
          liftM2 OpCodes.OpInstanceFailover arbitrary arbitrary
254
        "OP_INSTANCE_MIGRATE" ->
255
          liftM4 OpCodes.OpInstanceMigrate arbitrary arbitrary arbitrary
256
          arbitrary
257
        _ -> fail "Wrong opcode")
258

    
259
instance Arbitrary Jobs.OpStatus where
260
  arbitrary = elements [minBound..maxBound]
261

    
262
instance Arbitrary Jobs.JobStatus where
263
  arbitrary = elements [minBound..maxBound]
264

    
265
newtype SmallRatio = SmallRatio Double deriving Show
266
instance Arbitrary SmallRatio where
267
    arbitrary = do
268
      v <- choose (0, 1)
269
      return $ SmallRatio v
270

    
271
instance Arbitrary Types.AllocPolicy where
272
  arbitrary = elements [minBound..maxBound]
273

    
274
instance Arbitrary Types.DiskTemplate where
275
  arbitrary = elements [minBound..maxBound]
276

    
277
-- * Actual tests
278

    
279
-- ** Utils tests
280

    
281
-- | If the list is not just an empty element, and if the elements do
282
-- not contain commas, then join+split should be idempotent.
283
prop_Utils_commaJoinSplit =
284
    forAll (arbitrary `suchThat`
285
            (\l -> l /= [""] && all (not . elem ',') l )) $ \lst ->
286
    Utils.sepSplit ',' (Utils.commaJoin lst) == lst
287

    
288
-- | Split and join should always be idempotent.
289
prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s
290

    
291
-- | fromObjWithDefault, we test using the Maybe monad and an integer
292
-- value.
293
prop_Utils_fromObjWithDefault def_value random_key =
294
    -- a missing key will be returned with the default
295
    Utils.fromObjWithDefault [] random_key def_value == Just def_value &&
296
    -- a found key will be returned as is, not with default
297
    Utils.fromObjWithDefault [(random_key, J.showJSON def_value)]
298
         random_key (def_value+1) == Just def_value
299
        where _types = def_value :: Integer
300

    
301
-- | Test that functional if' behaves like the syntactic sugar if.
302
prop_Utils_if'if :: Bool -> Int -> Int -> Bool
303
prop_Utils_if'if cnd a b = Utils.if' cnd a b == if cnd then a else b
304

    
305
-- | Test basic select functionality
306
prop_Utils_select :: Int   -- ^ Default result
307
                  -> [Int] -- ^ List of False values
308
                  -> [Int] -- ^ List of True values
309
                  -> Bool  -- ^ Test result
310
prop_Utils_select def lst1 lst2 =
311
  Utils.select def cndlist == expectedresult
312
  where expectedresult = Utils.if' (null lst2) def (head lst2)
313
        flist = map (\e -> (False, e)) lst1
314
        tlist = map (\e -> (True, e)) lst2
315
        cndlist = flist ++ tlist
316

    
317
-- | Test basic select functionality with undefined default
318
prop_Utils_select_undefd :: [Int] -- ^ List of False values
319
                         -> NonEmptyList Int -- ^ List of True values
320
                         -> Bool  -- ^ Test result
321
prop_Utils_select_undefd lst1 (NonEmpty lst2) =
322
  Utils.select undefined cndlist == head lst2
323
  where flist = map (\e -> (False, e)) lst1
324
        tlist = map (\e -> (True, e)) lst2
325
        cndlist = flist ++ tlist
326

    
327
-- | Test basic select functionality with undefined list values
328
prop_Utils_select_undefv :: [Int] -- ^ List of False values
329
                         -> NonEmptyList Int -- ^ List of True values
330
                         -> Bool  -- ^ Test result
331
prop_Utils_select_undefv lst1 (NonEmpty lst2) =
332
  Utils.select undefined cndlist == head lst2
333
  where flist = map (\e -> (False, e)) lst1
334
        tlist = map (\e -> (True, e)) lst2
335
        cndlist = flist ++ tlist ++ [undefined]
336

    
337
prop_Utils_parseUnit (NonNegative n) =
338
    Utils.parseUnit (show n) == Types.Ok n &&
339
    Utils.parseUnit (show n ++ "m") == Types.Ok n &&
340
    (case Utils.parseUnit (show n ++ "M") of
341
      Types.Ok m -> if n > 0
342
                    then m < n  -- for positive values, X MB is less than X MiB
343
                    else m == 0 -- but for 0, 0 MB == 0 MiB
344
      Types.Bad _ -> False) &&
345
    Utils.parseUnit (show n ++ "g") == Types.Ok (n*1024) &&
346
    Utils.parseUnit (show n ++ "t") == Types.Ok (n*1048576) &&
347
    Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)
348
    where _types = (n::Int)
349

    
350
-- | Test list for the Utils module.
351
testUtils =
352
  [ run prop_Utils_commaJoinSplit
353
  , run prop_Utils_commaSplitJoin
354
  , run prop_Utils_fromObjWithDefault
355
  , run prop_Utils_if'if
356
  , run prop_Utils_select
357
  , run prop_Utils_select_undefd
358
  , run prop_Utils_select_undefv
359
  , run prop_Utils_parseUnit
360
  ]
361

    
362
-- ** PeerMap tests
363

    
364
-- | Make sure add is idempotent.
365
prop_PeerMap_addIdempotent pmap key em =
366
    fn puniq == fn (fn puniq)
367
    where _types = (pmap::PeerMap.PeerMap,
368
                    key::PeerMap.Key, em::PeerMap.Elem)
369
          fn = PeerMap.add key em
370
          puniq = PeerMap.accumArray const pmap
371

    
372
-- | Make sure remove is idempotent.
373
prop_PeerMap_removeIdempotent pmap key =
374
    fn puniq == fn (fn puniq)
375
    where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
376
          fn = PeerMap.remove key
377
          puniq = PeerMap.accumArray const pmap
378

    
379
-- | Make sure a missing item returns 0.
380
prop_PeerMap_findMissing pmap key =
381
    PeerMap.find key (PeerMap.remove key puniq) == 0
382
    where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
383
          puniq = PeerMap.accumArray const pmap
384

    
385
-- | Make sure an added item is found.
386
prop_PeerMap_addFind pmap key em =
387
    PeerMap.find key (PeerMap.add key em puniq) == em
388
    where _types = (pmap::PeerMap.PeerMap,
389
                    key::PeerMap.Key, em::PeerMap.Elem)
390
          puniq = PeerMap.accumArray const pmap
391

    
392
-- | Manual check that maxElem returns the maximum indeed, or 0 for null.
393
prop_PeerMap_maxElem pmap =
394
    PeerMap.maxElem puniq == if null puniq then 0
395
                             else (maximum . snd . unzip) puniq
396
    where _types = pmap::PeerMap.PeerMap
397
          puniq = PeerMap.accumArray const pmap
398

    
399
-- | List of tests for the PeerMap module.
400
testPeerMap =
401
    [ run prop_PeerMap_addIdempotent
402
    , run prop_PeerMap_removeIdempotent
403
    , run prop_PeerMap_maxElem
404
    , run prop_PeerMap_addFind
405
    , run prop_PeerMap_findMissing
406
    ]
407

    
408
-- ** Container tests
409

    
410
prop_Container_addTwo cdata i1 i2 =
411
    fn i1 i2 cont == fn i2 i1 cont &&
412
       fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
413
    where _types = (cdata::[Int],
414
                    i1::Int, i2::Int)
415
          cont = foldl (\c x -> Container.add x x c) Container.empty cdata
416
          fn x1 x2 = Container.addTwo x1 x1 x2 x2
417

    
418
prop_Container_nameOf node =
419
  let nl = makeSmallCluster node 1
420
      fnode = head (Container.elems nl)
421
  in Container.nameOf nl (Node.idx fnode) == Node.name fnode
422

    
423
-- | We test that in a cluster, given a random node, we can find it by
424
-- its name and alias, as long as all names and aliases are unique,
425
-- and that we fail to find a non-existing name.
426
prop_Container_findByName node othername =
427
  forAll (choose (1, 20)) $ \ cnt ->
428
  forAll (choose (0, cnt - 1)) $ \ fidx ->
429
  forAll (vector cnt) $ \ names ->
430
  (length . nub) (map fst names ++ map snd names) ==
431
  length names * 2 &&
432
  not (othername `elem` (map fst names ++ map snd names)) ==>
433
  let nl = makeSmallCluster node cnt
434
      nodes = Container.elems nl
435
      nodes' = map (\((name, alias), nn) -> (Node.idx nn,
436
                                             nn { Node.name = name,
437
                                                  Node.alias = alias }))
438
               $ zip names nodes
439
      nl' = Container.fromList nodes'
440
      target = snd (nodes' !! fidx)
441
  in Container.findByName nl' (Node.name target) == Just target &&
442
     Container.findByName nl' (Node.alias target) == Just target &&
443
     Container.findByName nl' othername == Nothing
444

    
445
testContainer =
446
    [ run prop_Container_addTwo
447
    , run prop_Container_nameOf
448
    , run prop_Container_findByName
449
    ]
450

    
451
-- ** Instance tests
452

    
453
-- Simple instance tests, we only have setter/getters
454

    
455
prop_Instance_creat inst =
456
    Instance.name inst == Instance.alias inst
457

    
458
prop_Instance_setIdx inst idx =
459
    Instance.idx (Instance.setIdx inst idx) == idx
460
    where _types = (inst::Instance.Instance, idx::Types.Idx)
461

    
462
prop_Instance_setName inst name =
463
    Instance.name newinst == name &&
464
    Instance.alias newinst == name
465
    where _types = (inst::Instance.Instance, name::String)
466
          newinst = Instance.setName inst name
467

    
468
prop_Instance_setAlias inst name =
469
    Instance.name newinst == Instance.name inst &&
470
    Instance.alias newinst == name
471
    where _types = (inst::Instance.Instance, name::String)
472
          newinst = Instance.setAlias inst name
473

    
474
prop_Instance_setPri inst pdx =
475
    Instance.pNode (Instance.setPri inst pdx) == pdx
476
    where _types = (inst::Instance.Instance, pdx::Types.Ndx)
477

    
478
prop_Instance_setSec inst sdx =
479
    Instance.sNode (Instance.setSec inst sdx) == sdx
480
    where _types = (inst::Instance.Instance, sdx::Types.Ndx)
481

    
482
prop_Instance_setBoth inst pdx sdx =
483
    Instance.pNode si == pdx && Instance.sNode si == sdx
484
    where _types = (inst::Instance.Instance, pdx::Types.Ndx, sdx::Types.Ndx)
485
          si = Instance.setBoth inst pdx sdx
486

    
487
prop_Instance_runStatus_True =
488
    forAll (arbitrary `suchThat`
489
            ((`elem` Instance.runningStates) . Instance.runSt))
490
    Instance.running
491

    
492
prop_Instance_runStatus_False inst =
493
    let run_st = Instance.running inst
494
        run_tx = Instance.runSt inst
495
    in
496
      run_tx `notElem` Instance.runningStates ==> not run_st
497

    
498
prop_Instance_shrinkMG inst =
499
    Instance.mem inst >= 2 * Types.unitMem ==>
500
        case Instance.shrinkByType inst Types.FailMem of
501
          Types.Ok inst' ->
502
              Instance.mem inst' == Instance.mem inst - Types.unitMem
503
          _ -> False
504

    
505
prop_Instance_shrinkMF inst =
506
    forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
507
    let inst' = inst { Instance.mem = mem}
508
    in Types.isBad $ Instance.shrinkByType inst' Types.FailMem
509

    
510
prop_Instance_shrinkCG inst =
511
    Instance.vcpus inst >= 2 * Types.unitCpu ==>
512
        case Instance.shrinkByType inst Types.FailCPU of
513
          Types.Ok inst' ->
514
              Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
515
          _ -> False
516

    
517
prop_Instance_shrinkCF inst =
518
    forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
519
    let inst' = inst { Instance.vcpus = vcpus }
520
    in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU
521

    
522
prop_Instance_shrinkDG inst =
523
    Instance.dsk inst >= 2 * Types.unitDsk ==>
524
        case Instance.shrinkByType inst Types.FailDisk of
525
          Types.Ok inst' ->
526
              Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
527
          _ -> False
528

    
529
prop_Instance_shrinkDF inst =
530
    forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
531
    let inst' = inst { Instance.dsk = dsk }
532
    in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk
533

    
534
prop_Instance_setMovable inst m =
535
    Instance.movable inst' == m
536
    where inst' = Instance.setMovable inst m
537

    
538
testInstance =
539
    [ run prop_Instance_creat
540
    , run prop_Instance_setIdx
541
    , run prop_Instance_setName
542
    , run prop_Instance_setAlias
543
    , run prop_Instance_setPri
544
    , run prop_Instance_setSec
545
    , run prop_Instance_setBoth
546
    , run prop_Instance_runStatus_True
547
    , run prop_Instance_runStatus_False
548
    , run prop_Instance_shrinkMG
549
    , run prop_Instance_shrinkMF
550
    , run prop_Instance_shrinkCG
551
    , run prop_Instance_shrinkCF
552
    , run prop_Instance_shrinkDG
553
    , run prop_Instance_shrinkDF
554
    , run prop_Instance_setMovable
555
    ]
556

    
557
-- ** Text backend tests
558

    
559
-- Instance text loader tests
560

    
561
prop_Text_Load_Instance name mem dsk vcpus status
562
                        (NonEmpty pnode) snode
563
                        (NonNegative pdx) (NonNegative sdx) autobal dt =
564
    pnode /= snode && pdx /= sdx ==>
565
    let vcpus_s = show vcpus
566
        dsk_s = show dsk
567
        mem_s = show mem
568
        ndx = if null snode
569
              then [(pnode, pdx)]
570
              else [(pnode, pdx), (snode, sdx)]
571
        nl = Data.Map.fromList ndx
572
        tags = ""
573
        sbal = if autobal then "Y" else "N"
574
        sdt = Types.dtToString dt
575
        inst = Text.loadInst nl
576
               [name, mem_s, dsk_s, vcpus_s, status,
577
                sbal, pnode, snode, sdt, tags]
578
        fail1 = Text.loadInst nl
579
               [name, mem_s, dsk_s, vcpus_s, status,
580
                sbal, pnode, pnode, tags]
581
        _types = ( name::String, mem::Int, dsk::Int
582
                 , vcpus::Int, status::String
583
                 , snode::String
584
                 , autobal::Bool)
585
    in
586
      case inst of
587
        Types.Bad msg -> printTestCase ("Failed to load instance: " ++ msg)
588
                         False
589
        Types.Ok (_, i) -> printTestCase ("Mismatch in some field while\
590
                                          \ loading the instance") $
591
            Instance.name i == name &&
592
            Instance.vcpus i == vcpus &&
593
            Instance.mem i == mem &&
594
            Instance.pNode i == pdx &&
595
            Instance.sNode i == (if null snode
596
                                 then Node.noSecondary
597
                                 else sdx) &&
598
            Instance.autoBalance i == autobal &&
599
            Types.isBad fail1
600

    
601
prop_Text_Load_InstanceFail ktn fields =
602
    length fields /= 10 ==>
603
    case Text.loadInst nl fields of
604
      Types.Ok _ -> printTestCase "Managed to load instance from invalid\
605
                                  \ data" False
606
      Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
607
                       "Invalid/incomplete instance data: '" `isPrefixOf` msg
608
    where nl = Data.Map.fromList ktn
609

    
610
prop_Text_Load_Node name tm nm fm td fd tc fo =
611
    let conv v = if v < 0
612
                    then "?"
613
                    else show v
614
        tm_s = conv tm
615
        nm_s = conv nm
616
        fm_s = conv fm
617
        td_s = conv td
618
        fd_s = conv fd
619
        tc_s = conv tc
620
        fo_s = if fo
621
               then "Y"
622
               else "N"
623
        any_broken = any (< 0) [tm, nm, fm, td, fd, tc]
624
        gid = Group.uuid defGroup
625
    in case Text.loadNode defGroupAssoc
626
           [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s, gid] of
627
         Nothing -> False
628
         Just (name', node) ->
629
             if fo || any_broken
630
             then Node.offline node
631
             else Node.name node == name' && name' == name &&
632
                  Node.alias node == name &&
633
                  Node.tMem node == fromIntegral tm &&
634
                  Node.nMem node == nm &&
635
                  Node.fMem node == fm &&
636
                  Node.tDsk node == fromIntegral td &&
637
                  Node.fDsk node == fd &&
638
                  Node.tCpu node == fromIntegral tc
639

    
640
prop_Text_Load_NodeFail fields =
641
    length fields /= 8 ==> isNothing $ Text.loadNode Data.Map.empty fields
642

    
643
prop_Text_NodeLSIdempotent node =
644
    (Text.loadNode defGroupAssoc.
645
         Utils.sepSplit '|' . Text.serializeNode defGroupList) n ==
646
    Just (Node.name n, n)
647
    -- override failN1 to what loadNode returns by default
648
    where n = node { Node.failN1 = True, Node.offline = False }
649

    
650
testText =
651
    [ run prop_Text_Load_Instance
652
    , run prop_Text_Load_InstanceFail
653
    , run prop_Text_Load_Node
654
    , run prop_Text_Load_NodeFail
655
    , run prop_Text_NodeLSIdempotent
656
    ]
657

    
658
-- ** Node tests
659

    
660
prop_Node_setAlias node name =
661
    Node.name newnode == Node.name node &&
662
    Node.alias newnode == name
663
    where _types = (node::Node.Node, name::String)
664
          newnode = Node.setAlias node name
665

    
666
prop_Node_setOffline node status =
667
    Node.offline newnode == status
668
    where newnode = Node.setOffline node status
669

    
670
prop_Node_setXmem node xm =
671
    Node.xMem newnode == xm
672
    where newnode = Node.setXmem node xm
673

    
674
prop_Node_setMcpu node mc =
675
    Node.mCpu newnode == mc
676
    where newnode = Node.setMcpu node mc
677

    
678
-- | Check that an instance add with too high memory or disk will be
679
-- rejected.
680
prop_Node_addPriFM node inst = Instance.mem inst >= Node.fMem node &&
681
                               not (Node.failN1 node)
682
                               ==>
683
                               case Node.addPri node inst'' of
684
                                 Types.OpFail Types.FailMem -> True
685
                                 _ -> False
686
    where _types = (node::Node.Node, inst::Instance.Instance)
687
          inst' = setInstanceSmallerThanNode node inst
688
          inst'' = inst' { Instance.mem = Instance.mem inst }
689

    
690
prop_Node_addPriFD node inst = Instance.dsk inst >= Node.fDsk node &&
691
                               not (Node.failN1 node)
692
                               ==>
693
                               case Node.addPri node inst'' of
694
                                 Types.OpFail Types.FailDisk -> True
695
                                 _ -> False
696
    where _types = (node::Node.Node, inst::Instance.Instance)
697
          inst' = setInstanceSmallerThanNode node inst
698
          inst'' = inst' { Instance.dsk = Instance.dsk inst }
699

    
700
prop_Node_addPriFC node inst (Positive extra) =
701
    not (Node.failN1 node) ==>
702
        case Node.addPri node inst'' of
703
          Types.OpFail Types.FailCPU -> True
704
          _ -> False
705
    where _types = (node::Node.Node, inst::Instance.Instance)
706
          inst' = setInstanceSmallerThanNode node inst
707
          inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
708

    
709
-- | Check that an instance add with too high memory or disk will be
710
-- rejected.
711
prop_Node_addSec node inst pdx =
712
    (Instance.mem inst >= (Node.fMem node - Node.rMem node) ||
713
     Instance.dsk inst >= Node.fDsk node) &&
714
    not (Node.failN1 node)
715
    ==> isFailure (Node.addSec node inst pdx)
716
        where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int)
717

    
718
-- | Checks for memory reservation changes.
719
prop_Node_rMem inst =
720
    forAll (arbitrary `suchThat` ((> 0) . Node.fMem)) $ \node ->
721
    -- ab = auto_balance, nb = non-auto_balance
722
    -- we use -1 as the primary node of the instance
723
    let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True }
724
        inst_ab = setInstanceSmallerThanNode node inst'
725
        inst_nb = inst_ab { Instance.autoBalance = False }
726
        -- now we have the two instances, identical except the
727
        -- autoBalance attribute
728
        orig_rmem = Node.rMem node
729
        inst_idx = Instance.idx inst_ab
730
        node_add_ab = Node.addSec node inst_ab (-1)
731
        node_add_nb = Node.addSec node inst_nb (-1)
732
        node_del_ab = liftM (flip Node.removeSec inst_ab) node_add_ab
733
        node_del_nb = liftM (flip Node.removeSec inst_nb) node_add_nb
734
    in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of
735
         (Types.OpGood a_ab, Types.OpGood a_nb,
736
          Types.OpGood d_ab, Types.OpGood d_nb) ->
737
             printTestCase "Consistency checks failed" $
738
             Node.rMem a_ab >  orig_rmem &&
739
             Node.rMem a_ab - orig_rmem == Instance.mem inst_ab &&
740
             Node.rMem a_nb == orig_rmem &&
741
             Node.rMem d_ab == orig_rmem &&
742
             Node.rMem d_nb == orig_rmem &&
743
             -- this is not related to rMem, but as good a place to
744
             -- test as any
745
             inst_idx `elem` Node.sList a_ab &&
746
             not (inst_idx `elem` Node.sList d_ab)
747
         x -> printTestCase ("Failed to add/remove instances: " ++ show x)
748
              False
749

    
750
-- | Check mdsk setting.
751
prop_Node_setMdsk node mx =
752
    Node.loDsk node' >= 0 &&
753
    fromIntegral (Node.loDsk node') <= Node.tDsk node &&
754
    Node.availDisk node' >= 0 &&
755
    Node.availDisk node' <= Node.fDsk node' &&
756
    fromIntegral (Node.availDisk node') <= Node.tDsk node' &&
757
    Node.mDsk node' == mx'
758
    where _types = (node::Node.Node, mx::SmallRatio)
759
          node' = Node.setMdsk node mx'
760
          SmallRatio mx' = mx
761

    
762
-- Check tag maps
763
prop_Node_tagMaps_idempotent tags =
764
    Node.delTags (Node.addTags m tags) tags == m
765
    where m = Data.Map.empty
766

    
767
prop_Node_tagMaps_reject tags =
768
    not (null tags) ==>
769
    any (\t -> Node.rejectAddTags m [t]) tags
770
    where m = Node.addTags Data.Map.empty tags
771

    
772
prop_Node_showField node =
773
  forAll (elements Node.defaultFields) $ \ field ->
774
  fst (Node.showHeader field) /= Types.unknownField &&
775
  Node.showField node field /= Types.unknownField
776

    
777

    
778
prop_Node_computeGroups nodes =
779
  let ng = Node.computeGroups nodes
780
      onlyuuid = map fst ng
781
  in length nodes == sum (map (length . snd) ng) &&
782
     all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng &&
783
     length (nub onlyuuid) == length onlyuuid &&
784
     (null nodes || not (null ng))
785

    
786
testNode =
787
    [ run prop_Node_setAlias
788
    , run prop_Node_setOffline
789
    , run prop_Node_setMcpu
790
    , run prop_Node_setXmem
791
    , run prop_Node_addPriFM
792
    , run prop_Node_addPriFD
793
    , run prop_Node_addPriFC
794
    , run prop_Node_addSec
795
    , run prop_Node_rMem
796
    , run prop_Node_setMdsk
797
    , run prop_Node_tagMaps_idempotent
798
    , run prop_Node_tagMaps_reject
799
    , run prop_Node_showField
800
    , run prop_Node_computeGroups
801
    ]
802

    
803

    
804
-- ** Cluster tests
805

    
806
-- | Check that the cluster score is close to zero for a homogeneous
807
-- cluster.
808
prop_Score_Zero node =
809
    forAll (choose (1, 1024)) $ \count ->
810
    (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
811
     (Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
812
    let fn = Node.buildPeers node Container.empty
813
        nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
814
        nl = Container.fromList nlst
815
        score = Cluster.compCV nl
816
    -- we can't say == 0 here as the floating point errors accumulate;
817
    -- this should be much lower than the default score in CLI.hs
818
    in score <= 1e-12
819

    
820
-- | Check that cluster stats are sane.
821
prop_CStats_sane node =
822
    forAll (choose (1, 1024)) $ \count ->
823
    (not (Node.offline node) && not (Node.failN1 node) &&
824
     (Node.availDisk node > 0) && (Node.availMem node > 0)) ==>
825
    let fn = Node.buildPeers node Container.empty
826
        nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
827
        nl = Container.fromList nlst
828
        cstats = Cluster.totalResources nl
829
    in Cluster.csAdsk cstats >= 0 &&
830
       Cluster.csAdsk cstats <= Cluster.csFdsk cstats
831

    
832
-- | Check that one instance is allocated correctly, without
833
-- rebalances needed.
834
prop_ClusterAlloc_sane node inst =
835
    forAll (choose (5, 20)) $ \count ->
836
    not (Node.offline node)
837
            && not (Node.failN1 node)
838
            && Node.availDisk node > 0
839
            && Node.availMem node > 0
840
            ==>
841
    let nl = makeSmallCluster node count
842
        il = Container.empty
843
        inst' = setInstanceSmallerThanNode node inst
844
    in case Cluster.genAllocNodes defGroupList nl 2 True >>=
845
       Cluster.tryAlloc nl il inst' of
846
         Types.Bad _ -> False
847
         Types.Ok as ->
848
             case Cluster.asSolutions as of
849
               [] -> False
850
               (xnl, xi, _, cv):[] ->
851
                   let il' = Container.add (Instance.idx xi) xi il
852
                       tbl = Cluster.Table xnl il' cv []
853
                   in not (canBalance tbl True True False)
854
               _ -> False
855

    
856
-- | Checks that on a 2-5 node cluster, we can allocate a random
857
-- instance spec via tiered allocation (whatever the original instance
858
-- spec), on either one or two nodes.
859
prop_ClusterCanTieredAlloc node inst =
860
    forAll (choose (2, 5)) $ \count ->
861
    forAll (choose (1, 2)) $ \rqnodes ->
862
    not (Node.offline node)
863
            && not (Node.failN1 node)
864
            && isNodeBig node 4
865
            ==>
866
    let nl = makeSmallCluster node count
867
        il = Container.empty
868
        allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
869
    in case allocnodes >>= \allocnodes' ->
870
        Cluster.tieredAlloc nl il inst allocnodes' [] [] of
871
         Types.Bad _ -> False
872
         Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) &&
873
                                      IntMap.size il' == length ixes &&
874
                                      length ixes == length cstats
875

    
876
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
877
-- we can also evacuate it.
878
prop_ClusterAllocEvac node inst =
879
    forAll (choose (4, 8)) $ \count ->
880
    not (Node.offline node)
881
            && not (Node.failN1 node)
882
            && isNodeBig node 4
883
            ==>
884
    let nl = makeSmallCluster node count
885
        il = Container.empty
886
        inst' = setInstanceSmallerThanNode node inst
887
    in case Cluster.genAllocNodes defGroupList nl 2 True >>=
888
       Cluster.tryAlloc nl il inst' of
889
         Types.Bad _ -> False
890
         Types.Ok as ->
891
             case Cluster.asSolutions as of
892
               [] -> False
893
               (xnl, xi, _, _):[] ->
894
                   let sdx = Instance.sNode xi
895
                       il' = Container.add (Instance.idx xi) xi il
896
                   in case Cluster.tryEvac xnl il' [Instance.idx xi] [sdx] of
897
                        Just _ -> True
898
                        _ -> False
899
               _ -> False
900

    
901
-- | Check that allocating multiple instances on a cluster, then
902
-- adding an empty node, results in a valid rebalance.
903
prop_ClusterAllocBalance =
904
    forAll (genNode (Just 5) (Just 128)) $ \node ->
905
    forAll (choose (3, 5)) $ \count ->
906
    not (Node.offline node) && not (Node.failN1 node) ==>
907
    let nl = makeSmallCluster node count
908
        (hnode, nl') = IntMap.deleteFindMax nl
909
        il = Container.empty
910
        allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True
911
        i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
912
    in case allocnodes >>= \allocnodes' ->
913
        Cluster.iterateAlloc nl' il i_templ allocnodes' [] [] of
914
         Types.Bad _ -> False
915
         Types.Ok (_, xnl, il', _, _) ->
916
                   let ynl = Container.add (Node.idx hnode) hnode xnl
917
                       cv = Cluster.compCV ynl
918
                       tbl = Cluster.Table ynl il' cv []
919
                   in canBalance tbl True True False
920

    
921
-- | Checks consistency.
922
prop_ClusterCheckConsistency node inst =
923
  let nl = makeSmallCluster node 3
924
      [node1, node2, node3] = Container.elems nl
925
      node3' = node3 { Node.group = 1 }
926
      nl' = Container.add (Node.idx node3') node3' nl
927
      inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2)
928
      inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary
929
      inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3)
930
      ccheck = Cluster.findSplitInstances nl' . Container.fromList
931
  in null (ccheck [(0, inst1)]) &&
932
     null (ccheck [(0, inst2)]) &&
933
     (not . null $ ccheck [(0, inst3)])
934

    
935
-- | For now, we only test that we don't lose instances during the split.
936
prop_ClusterSplitCluster node inst =
937
  forAll (choose (0, 100)) $ \icnt ->
938
  let nl = makeSmallCluster node 2
939
      (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1)
940
                   (nl, Container.empty) [1..icnt]
941
      gni = Cluster.splitCluster nl' il'
942
  in sum (map (Container.size . snd . snd) gni) == icnt &&
943
     all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group)
944
                                 (Container.elems nl'')) gni
945

    
946
testCluster =
947
    [ run prop_Score_Zero
948
    , run prop_CStats_sane
949
    , run prop_ClusterAlloc_sane
950
    , run prop_ClusterCanTieredAlloc
951
    , run prop_ClusterAllocEvac
952
    , run prop_ClusterAllocBalance
953
    , run prop_ClusterCheckConsistency
954
    , run prop_ClusterSplitCluster
955
    ]
956

    
957
-- ** OpCodes tests
958

    
959
-- | Check that opcode serialization is idempotent.
960
prop_OpCodes_serialization op =
961
  case J.readJSON (J.showJSON op) of
962
    J.Error _ -> False
963
    J.Ok op' -> op == op'
964
  where _types = op::OpCodes.OpCode
965

    
966
testOpCodes =
967
  [ run prop_OpCodes_serialization
968
  ]
969

    
970
-- ** Jobs tests
971

    
972
-- | Check that (queued) job\/opcode status serialization is idempotent.
973
prop_OpStatus_serialization os =
974
  case J.readJSON (J.showJSON os) of
975
    J.Error _ -> False
976
    J.Ok os' -> os == os'
977
  where _types = os::Jobs.OpStatus
978

    
979
prop_JobStatus_serialization js =
980
  case J.readJSON (J.showJSON js) of
981
    J.Error _ -> False
982
    J.Ok js' -> js == js'
983
  where _types = js::Jobs.JobStatus
984

    
985
testJobs =
986
  [ run prop_OpStatus_serialization
987
  , run prop_JobStatus_serialization
988
  ]
989

    
990
-- ** Loader tests
991

    
992
prop_Loader_lookupNode ktn inst node =
993
  Loader.lookupNode nl inst node == Data.Map.lookup node nl
994
  where nl = Data.Map.fromList ktn
995

    
996
prop_Loader_lookupInstance kti inst =
997
  Loader.lookupInstance il inst == Data.Map.lookup inst il
998
  where il = Data.Map.fromList kti
999

    
1000
prop_Loader_assignIndices nodes =
1001
  Data.Map.size nassoc == length nodes &&
1002
  Container.size kt == length nodes &&
1003
  (if not (null nodes)
1004
   then maximum (IntMap.keys kt) == length nodes - 1
1005
   else True)
1006
  where (nassoc, kt) = Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)
1007

    
1008
-- | Checks that the number of primary instances recorded on the nodes
1009
-- is zero.
1010
prop_Loader_mergeData ns =
1011
  let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns
1012
  in case Loader.mergeData [] [] [] []
1013
         (Loader.emptyCluster {Loader.cdNodes = na}) of
1014
    Types.Bad _ -> False
1015
    Types.Ok (Loader.ClusterData _ nl il _) ->
1016
      let nodes = Container.elems nl
1017
          instances = Container.elems il
1018
      in (sum . map (length . Node.pList)) nodes == 0 &&
1019
         null instances
1020

    
1021
-- | Check that compareNameComponent on equal strings works.
1022
prop_Loader_compareNameComponent_equal :: String -> Bool
1023
prop_Loader_compareNameComponent_equal s =
1024
  Loader.compareNameComponent s s ==
1025
    Loader.LookupResult Loader.ExactMatch s
1026

    
1027
-- | Check that compareNameComponent on prefix strings works.
1028
prop_Loader_compareNameComponent_prefix :: NonEmptyList Char -> String -> Bool
1029
prop_Loader_compareNameComponent_prefix (NonEmpty s1) s2 =
1030
  Loader.compareNameComponent (s1 ++ "." ++ s2) s1 ==
1031
    Loader.LookupResult Loader.PartialMatch s1
1032

    
1033
testLoader =
1034
  [ run prop_Loader_lookupNode
1035
  , run prop_Loader_lookupInstance
1036
  , run prop_Loader_assignIndices
1037
  , run prop_Loader_mergeData
1038
  , run prop_Loader_compareNameComponent_equal
1039
  , run prop_Loader_compareNameComponent_prefix
1040
  ]
1041

    
1042
-- ** Types tests
1043

    
1044
prop_AllocPolicy_serialisation apol =
1045
    case Types.apolFromString (Types.apolToString apol) of
1046
      Types.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
1047
                    p == apol
1048
      Types.Bad s -> printTestCase ("failed to deserialise: " ++ s) False
1049

    
1050
prop_DiskTemplate_serialisation dt =
1051
    case Types.dtFromString (Types.dtToString dt) of
1052
      Types.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
1053
                    p == dt
1054
      Types.Bad s -> printTestCase ("failed to deserialise: " ++ s) False
1055

    
1056
testTypes =
1057
    [ run prop_AllocPolicy_serialisation
1058
    , run prop_DiskTemplate_serialisation
1059
    ]