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