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