code.grnet.gr Git - ganeti-local/blob - Ganeti/HTools/QC.hs

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