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