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, nub)
  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 0 0
 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               Utils.defaultGroupID
 180           n' = Node.buildPeers n Container.empty
 181       return n'
 182
 183 -- replace disks
 184 instance Arbitrary OpCodes.ReplaceDisksMode where
 185   arbitrary = elements [ OpCodes.ReplaceOnPrimary
 186                        , OpCodes.ReplaceOnSecondary
 187                        , OpCodes.ReplaceNewSecondary
 188                        , OpCodes.ReplaceAuto
 189                        ]
 190
 191 instance Arbitrary OpCodes.OpCode where
 192   arbitrary = do
 193     op_id <- elements [ "OP_TEST_DELAY"
 194                       , "OP_INSTANCE_REPLACE_DISKS"
 195                       , "OP_INSTANCE_FAILOVER"
 196                       , "OP_INSTANCE_MIGRATE"
 197                       ]
 198     (case op_id of
 199         "OP_TEST_DELAY" ->
 200           liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary
 201         "OP_INSTANCE_REPLACE_DISKS" ->
 202           liftM5 OpCodes.OpReplaceDisks arbitrary arbitrary
 203           arbitrary arbitrary arbitrary
 204         "OP_INSTANCE_FAILOVER" ->
 205           liftM2 OpCodes.OpFailoverInstance arbitrary arbitrary
 206         "OP_INSTANCE_MIGRATE" ->
 207           liftM3 OpCodes.OpMigrateInstance arbitrary arbitrary arbitrary
 208         _ -> fail "Wrong opcode")
 209
 210 instance Arbitrary Jobs.OpStatus where
 211   arbitrary = elements [minBound..maxBound]
 212
 213 instance Arbitrary Jobs.JobStatus where
 214   arbitrary = elements [minBound..maxBound]
 215
 216 -- * Actual tests
 217
 218 -- If the list is not just an empty element, and if the elements do
 219 -- not contain commas, then join+split should be idepotent
 220 prop_Utils_commaJoinSplit lst = lst /= [""] &&
 221                                 all (not . elem ',') lst ==>
 222                                 Utils.sepSplit ',' (Utils.commaJoin lst) == lst
 223 -- Split and join should always be idempotent
 224 prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s
 225
 226 testUtils =
 227   [ run prop_Utils_commaJoinSplit
 228   , run prop_Utils_commaSplitJoin
 229   ]
 230
 231 -- | Make sure add is idempotent
 232 prop_PeerMap_addIdempotent pmap key em =
 233     fn puniq == fn (fn puniq)
 234     where _types = (pmap::PeerMap.PeerMap,
 235                     key::PeerMap.Key, em::PeerMap.Elem)
 236           fn = PeerMap.add key em
 237           puniq = PeerMap.accumArray const pmap
 238
 239 -- | Make sure remove is idempotent
 240 prop_PeerMap_removeIdempotent pmap key =
 241     fn puniq == fn (fn puniq)
 242     where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
 243           fn = PeerMap.remove key
 244           puniq = PeerMap.accumArray const pmap
 245
 246 -- | Make sure a missing item returns 0
 247 prop_PeerMap_findMissing pmap key =
 248     PeerMap.find key (PeerMap.remove key puniq) == 0
 249     where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
 250           puniq = PeerMap.accumArray const pmap
 251
 252 -- | Make sure an added item is found
 253 prop_PeerMap_addFind pmap key em =
 254     PeerMap.find key (PeerMap.add key em puniq) == em
 255     where _types = (pmap::PeerMap.PeerMap,
 256                     key::PeerMap.Key, em::PeerMap.Elem)
 257           puniq = PeerMap.accumArray const pmap
 258
 259 -- | Manual check that maxElem returns the maximum indeed, or 0 for null
 260 prop_PeerMap_maxElem pmap =
 261     PeerMap.maxElem puniq == if null puniq then 0
 262                              else (maximum . snd . unzip) puniq
 263     where _types = pmap::PeerMap.PeerMap
 264           puniq = PeerMap.accumArray const pmap
 265
 266 testPeerMap =
 267     [ run prop_PeerMap_addIdempotent
 268     , run prop_PeerMap_removeIdempotent
 269     , run prop_PeerMap_maxElem
 270     , run prop_PeerMap_addFind
 271     , run prop_PeerMap_findMissing
 272     ]
 273
 274 -- Container tests
 275
 276 prop_Container_addTwo cdata i1 i2 =
 277     fn i1 i2 cont == fn i2 i1 cont &&
 278        fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
 279     where _types = (cdata::[Int],
 280                     i1::Int, i2::Int)
 281           cont = foldl (\c x -> Container.add x x c) Container.empty cdata
 282           fn x1 x2 = Container.addTwo x1 x1 x2 x2
 283
 284 testContainer =
 285     [ run prop_Container_addTwo ]
 286
 287 -- Simple instance tests, we only have setter/getters
 288
 289 prop_Instance_creat inst =
 290     Instance.name inst == Instance.alias inst
 291
 292 prop_Instance_setIdx inst idx =
 293     Instance.idx (Instance.setIdx inst idx) == idx
 294     where _types = (inst::Instance.Instance, idx::Types.Idx)
 295
 296 prop_Instance_setName inst name =
 297     Instance.name newinst == name &&
 298     Instance.alias newinst == name
 299     where _types = (inst::Instance.Instance, name::String)
 300           newinst = Instance.setName inst name
 301
 302 prop_Instance_setAlias inst name =
 303     Instance.name newinst == Instance.name inst &&
 304     Instance.alias newinst == name
 305     where _types = (inst::Instance.Instance, name::String)
 306           newinst = Instance.setAlias inst name
 307
 308 prop_Instance_setPri inst pdx =
 309     Instance.pNode (Instance.setPri inst pdx) == pdx
 310     where _types = (inst::Instance.Instance, pdx::Types.Ndx)
 311
 312 prop_Instance_setSec inst sdx =
 313     Instance.sNode (Instance.setSec inst sdx) == sdx
 314     where _types = (inst::Instance.Instance, sdx::Types.Ndx)
 315
 316 prop_Instance_setBoth inst pdx sdx =
 317     Instance.pNode si == pdx && Instance.sNode si == sdx
 318     where _types = (inst::Instance.Instance, pdx::Types.Ndx, sdx::Types.Ndx)
 319           si = Instance.setBoth inst pdx sdx
 320
 321 prop_Instance_runStatus_True inst =
 322     let run_st = Instance.running inst
 323         run_tx = Instance.runSt inst
 324     in
 325       run_tx `elem` Instance.runningStates ==> run_st
 326
 327 prop_Instance_runStatus_False inst =
 328     let run_st = Instance.running inst
 329         run_tx = Instance.runSt inst
 330     in
 331       run_tx `notElem` Instance.runningStates ==> not run_st
 332
 333 prop_Instance_shrinkMG inst =
 334     Instance.mem inst >= 2 * Types.unitMem ==>
 335         case Instance.shrinkByType inst Types.FailMem of
 336           Types.Ok inst' ->
 337               Instance.mem inst' == Instance.mem inst - Types.unitMem
 338           _ -> False
 339
 340 prop_Instance_shrinkMF inst =
 341     Instance.mem inst < 2 * Types.unitMem ==>
 342         isBad $ Instance.shrinkByType inst Types.FailMem
 343
 344 prop_Instance_shrinkCG inst =
 345     Instance.vcpus inst >= 2 * Types.unitCpu ==>
 346         case Instance.shrinkByType inst Types.FailCPU of
 347           Types.Ok inst' ->
 348               Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
 349           _ -> False
 350
 351 prop_Instance_shrinkCF inst =
 352     Instance.vcpus inst < 2 * Types.unitCpu ==>
 353         isBad $ Instance.shrinkByType inst Types.FailCPU
 354
 355 prop_Instance_shrinkDG inst =
 356     Instance.dsk inst >= 2 * Types.unitDsk ==>
 357         case Instance.shrinkByType inst Types.FailDisk of
 358           Types.Ok inst' ->
 359               Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
 360           _ -> False
 361
 362 prop_Instance_shrinkDF inst =
 363     Instance.dsk inst < 2 * Types.unitDsk ==>
 364         isBad $ Instance.shrinkByType inst Types.FailDisk
 365
 366 prop_Instance_setMovable inst m =
 367     Instance.movable inst' == m
 368     where inst' = Instance.setMovable inst m
 369
 370 testInstance =
 371     [ run prop_Instance_creat
 372     , run prop_Instance_setIdx
 373     , run prop_Instance_setName
 374     , run prop_Instance_setAlias
 375     , run prop_Instance_setPri
 376     , run prop_Instance_setSec
 377     , run prop_Instance_setBoth
 378     , run prop_Instance_runStatus_True
 379     , run prop_Instance_runStatus_False
 380     , run prop_Instance_shrinkMG
 381     , run prop_Instance_shrinkMF
 382     , run prop_Instance_shrinkCG
 383     , run prop_Instance_shrinkCF
 384     , run prop_Instance_shrinkDG
 385     , run prop_Instance_shrinkDF
 386     , run prop_Instance_setMovable
 387     ]
 388
 389 -- Instance text loader tests
 390
 391 prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx =
 392     not (null pnode) && pdx >= 0 && sdx >= 0 ==>
 393     let vcpus_s = show vcpus
 394         dsk_s = show dsk
 395         mem_s = show mem
 396         rsdx = if pdx == sdx
 397                then sdx + 1
 398                else sdx
 399         ndx = if null snode
 400               then [(pnode, pdx)]
 401               else [(pnode, pdx), (snode, rsdx)]
 402         tags = ""
 403         inst = Text.loadInst ndx
 404                [name, mem_s, dsk_s, vcpus_s, status, pnode, snode, tags]::
 405                Maybe (String, Instance.Instance)
 406         fail1 = Text.loadInst ndx
 407                [name, mem_s, dsk_s, vcpus_s, status, pnode, pnode, tags]::
 408                Maybe (String, Instance.Instance)
 409         _types = ( name::String, mem::Int, dsk::Int
 410                  , vcpus::Int, status::String
 411                  , pnode::String, snode::String
 412                  , pdx::Types.Ndx, sdx::Types.Ndx)
 413     in
 414       case inst of
 415         Nothing -> False
 416         Just (_, i) ->
 417             (Instance.name i == name &&
 418              Instance.vcpus i == vcpus &&
 419              Instance.mem i == mem &&
 420              Instance.pNode i == pdx &&
 421              Instance.sNode i == (if null snode
 422                                   then Node.noSecondary
 423                                   else rsdx) &&
 424              isNothing fail1)
 425
 426 prop_Text_Load_InstanceFail ktn fields =
 427     length fields /= 8 ==> isNothing $ Text.loadInst ktn fields
 428
 429 prop_Text_Load_Node name tm nm fm td fd tc fo =
 430     let conv v = if v < 0
 431                     then "?"
 432                     else show v
 433         tm_s = conv tm
 434         nm_s = conv nm
 435         fm_s = conv fm
 436         td_s = conv td
 437         fd_s = conv fd
 438         tc_s = conv tc
 439         fo_s = if fo
 440                then "Y"
 441                else "N"
 442         any_broken = any (< 0) [tm, nm, fm, td, fd, tc]
 443     in case Text.loadNode [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s] of
 444          Nothing -> False
 445          Just (name', node) ->
 446              if fo || any_broken
 447              then Node.offline node
 448              else Node.name node == name' && name' == name &&
 449                   Node.alias node == name &&
 450                   Node.tMem node == fromIntegral tm &&
 451                   Node.nMem node == nm &&
 452                   Node.fMem node == fm &&
 453                   Node.tDsk node == fromIntegral td &&
 454                   Node.fDsk node == fd &&
 455                   Node.tCpu node == fromIntegral tc
 456
 457 prop_Text_Load_NodeFail fields =
 458     length fields /= 8 ==> isNothing $ Text.loadNode fields
 459
 460 prop_Text_NodeLSIdempotent node =
 461     (Text.loadNode .
 462          Utils.sepSplit '|' . Text.serializeNode) n ==
 463     Just (Node.name n, n)
 464     -- override failN1 to what loadNode returns by default
 465     where n = node { Node.failN1 = True, Node.offline = False }
 466
 467 testText =
 468     [ run prop_Text_Load_Instance
 469     , run prop_Text_Load_InstanceFail
 470     , run prop_Text_Load_Node
 471     , run prop_Text_Load_NodeFail
 472     , run prop_Text_NodeLSIdempotent
 473     ]
 474
 475 -- Node tests
 476
 477 prop_Node_setAlias node name =
 478     Node.name newnode == Node.name node &&
 479     Node.alias newnode == name
 480     where _types = (node::Node.Node, name::String)
 481           newnode = Node.setAlias node name
 482
 483 prop_Node_setOffline node status =
 484     Node.offline newnode == status
 485     where newnode = Node.setOffline node status
 486
 487 prop_Node_setXmem node xm =
 488     Node.xMem newnode == xm
 489     where newnode = Node.setXmem node xm
 490
 491 prop_Node_setMcpu node mc =
 492     Node.mCpu newnode == mc
 493     where newnode = Node.setMcpu node mc
 494
 495 -- | Check that an instance add with too high memory or disk will be rejected
 496 prop_Node_addPriFM node inst = Instance.mem inst >= Node.fMem node &&
 497                                not (Node.failN1 node)
 498                                ==>
 499                                case Node.addPri node inst'' of
 500                                  Types.OpFail Types.FailMem -> True
 501                                  _ -> False
 502     where _types = (node::Node.Node, inst::Instance.Instance)
 503           inst' = setInstanceSmallerThanNode node inst
 504           inst'' = inst' { Instance.mem = Instance.mem inst }
 505
 506 prop_Node_addPriFD node inst = Instance.dsk inst >= Node.fDsk node &&
 507                                not (Node.failN1 node)
 508                                ==>
 509                                case Node.addPri node inst'' of
 510                                  Types.OpFail Types.FailDisk -> True
 511                                  _ -> False
 512     where _types = (node::Node.Node, inst::Instance.Instance)
 513           inst' = setInstanceSmallerThanNode node inst
 514           inst'' = inst' { Instance.dsk = Instance.dsk inst }
 515
 516 prop_Node_addPriFC node inst = Instance.vcpus inst > Node.availCpu node &&
 517                                not (Node.failN1 node)
 518                                ==>
 519                                case Node.addPri node inst'' of
 520                                  Types.OpFail Types.FailCPU -> True
 521                                  _ -> False
 522     where _types = (node::Node.Node, inst::Instance.Instance)
 523           inst' = setInstanceSmallerThanNode node inst
 524           inst'' = inst' { Instance.vcpus = Instance.vcpus inst }
 525
 526 -- | Check that an instance add with too high memory or disk will be rejected
 527 prop_Node_addSec node inst pdx =
 528     (Instance.mem inst >= (Node.fMem node - Node.rMem node) ||
 529      Instance.dsk inst >= Node.fDsk node) &&
 530     not (Node.failN1 node)
 531     ==> isFailure (Node.addSec node inst pdx)
 532         where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int)
 533
 534 newtype SmallRatio = SmallRatio Double deriving Show
 535 instance Arbitrary SmallRatio where
 536     arbitrary = do
 537       v <- choose (0, 1)
 538       return $ SmallRatio v
 539
 540 -- | Check mdsk setting
 541 prop_Node_setMdsk node mx =
 542     Node.loDsk node' >= 0 &&
 543     fromIntegral (Node.loDsk node') <= Node.tDsk node &&
 544     Node.availDisk node' >= 0 &&
 545     Node.availDisk node' <= Node.fDsk node' &&
 546     fromIntegral (Node.availDisk node') <= Node.tDsk node' &&
 547     Node.mDsk node' == mx'
 548     where _types = (node::Node.Node, mx::SmallRatio)
 549           node' = Node.setMdsk node mx'
 550           SmallRatio mx' = mx
 551
 552 -- Check tag maps
 553 prop_Node_tagMaps_idempotent tags =
 554     Node.delTags (Node.addTags m tags) tags == m
 555     where m = Data.Map.empty
 556
 557 prop_Node_tagMaps_reject tags =
 558     not (null tags) ==>
 559     any (\t -> Node.rejectAddTags m [t]) tags
 560     where m = Node.addTags Data.Map.empty tags
 561
 562 prop_Node_showField node =
 563   forAll (elements Node.defaultFields) $ \ field ->
 564   fst (Node.showHeader field) /= Types.unknownField &&
 565   Node.showField node field /= Types.unknownField
 566
 567
 568 prop_Node_computeGroups nodes =
 569   let ng = Node.computeGroups nodes
 570       onlyuuid = map fst ng
 571   in length nodes == sum (map (length . snd) ng) &&
 572      all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng &&
 573      length (nub onlyuuid) == length onlyuuid &&
 574      if null nodes then True else not (null ng)
 575
 576 testNode =
 577     [ run prop_Node_setAlias
 578     , run prop_Node_setOffline
 579     , run prop_Node_setMcpu
 580     , run prop_Node_setXmem
 581     , run prop_Node_addPriFM
 582     , run prop_Node_addPriFD
 583     , run prop_Node_addPriFC
 584     , run prop_Node_addSec
 585     , run prop_Node_setMdsk
 586     , run prop_Node_tagMaps_idempotent
 587     , run prop_Node_tagMaps_reject
 588     , run prop_Node_showField
 589     , run prop_Node_computeGroups
 590     ]
 591
 592
 593 -- Cluster tests
 594
 595 -- | Check that the cluster score is close to zero for a homogeneous cluster
 596 prop_Score_Zero node count =
 597     (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
 598      (Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
 599     let fn = Node.buildPeers node Container.empty
 600         nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
 601         nl = Container.fromAssocList nlst
 602         score = Cluster.compCV nl
 603     -- we can't say == 0 here as the floating point errors accumulate;
 604     -- this should be much lower than the default score in CLI.hs
 605     in score <= 1e-15
 606
 607 -- | Check that cluster stats are sane
 608 prop_CStats_sane node count =
 609     (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
 610      (Node.availDisk node > 0) && (Node.availMem node > 0)) ==>
 611     let fn = Node.buildPeers node Container.empty
 612         nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
 613         nl = Container.fromAssocList nlst
 614         cstats = Cluster.totalResources nl
 615     in Cluster.csAdsk cstats >= 0 &&
 616        Cluster.csAdsk cstats <= Cluster.csFdsk cstats
 617
 618 -- | Check that one instance is allocated correctly, without
 619 -- rebalances needed
 620 prop_ClusterAlloc_sane node inst =
 621     forAll (choose (5, 20)) $ \count ->
 622     not (Node.offline node)
 623             && not (Node.failN1 node)
 624             && Node.availDisk node > 0
 625             && Node.availMem node > 0
 626             ==>
 627     let nl = makeSmallCluster node count
 628         il = Container.empty
 629         rqnodes = 2
 630         inst' = setInstanceSmallerThanNode node inst
 631     in case Cluster.tryAlloc nl il inst' rqnodes of
 632          Types.Bad _ -> False
 633          Types.Ok (_, _, sols3) ->
 634              case sols3 of
 635                [] -> False
 636                (_, (xnl, xi, _)):[] ->
 637                    let cv = Cluster.compCV xnl
 638                        il' = Container.add (Instance.idx xi) xi il
 639                        tbl = Cluster.Table xnl il' cv []
 640                    in not (canBalance tbl True False)
 641                _ -> False
 642
 643 -- | Checks that on a 2-5 node cluster, we can allocate a random
 644 -- instance spec via tiered allocation (whatever the original instance
 645 -- spec), on either one or two nodes
 646 prop_ClusterCanTieredAlloc node inst =
 647     forAll (choose (2, 5)) $ \count ->
 648     forAll (choose (1, 2)) $ \rqnodes ->
 649     not (Node.offline node)
 650             && not (Node.failN1 node)
 651             && isNodeBig node 4
 652             ==>
 653     let nl = makeSmallCluster node count
 654         il = Container.empty
 655     in case Cluster.tieredAlloc nl il inst rqnodes [] of
 656          Types.Bad _ -> False
 657          Types.Ok (_, _, il', ixes) -> not (null ixes) &&
 658                                       IntMap.size il' == length ixes
 659
 660 -- | Checks that on a 4-8 node cluster, once we allocate an instance,
 661 -- we can also evacuate it
 662 prop_ClusterAllocEvac node inst =
 663     forAll (choose (4, 8)) $ \count ->
 664     not (Node.offline node)
 665             && not (Node.failN1 node)
 666             && isNodeBig node 4
 667             ==>
 668     let nl = makeSmallCluster node count
 669         il = Container.empty
 670         rqnodes = 2
 671         inst' = setInstanceSmallerThanNode node inst
 672     in case Cluster.tryAlloc nl il inst' rqnodes of
 673          Types.Bad _ -> False
 674          Types.Ok (_, _, sols3) ->
 675              case sols3 of
 676                [] -> False
 677                (_, (xnl, xi, _)):[] ->
 678                    let sdx = Instance.sNode xi
 679                        il' = Container.add (Instance.idx xi) xi il
 680                    in case Cluster.tryEvac xnl il' [sdx] of
 681                         Just _ -> True
 682                         _ -> False
 683                _ -> False
 684
 685 -- | Check that allocating multiple instances on a cluster, then
 686 -- adding an empty node, results in a valid rebalance
 687 prop_ClusterAllocBalance node =
 688     forAll (choose (3, 5)) $ \count ->
 689     not (Node.offline node)
 690             && not (Node.failN1 node)
 691             && isNodeBig node 4
 692             && not (isNodeBig node 8)
 693             ==>
 694     let nl = makeSmallCluster node count
 695         (hnode, nl') = IntMap.deleteFindMax nl
 696         il = Container.empty
 697         rqnodes = 2
 698         i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
 699     in case Cluster.iterateAlloc nl' il i_templ rqnodes [] of
 700          Types.Bad _ -> False
 701          Types.Ok (_, xnl, il', _) ->
 702                    let ynl = Container.add (Node.idx hnode) hnode xnl
 703                        cv = Cluster.compCV ynl
 704                        tbl = Cluster.Table ynl il' cv []
 705                    in canBalance tbl True False
 706
 707 -- | Checks consistency
 708 prop_ClusterCheckConsistency node inst =
 709   let nl = makeSmallCluster node 3
 710       [node1, node2, node3] = Container.elems nl
 711       node3' = node3 { Node.group = "other-uuid" }
 712       nl' = Container.add (Node.idx node3') node3' nl
 713       inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2)
 714       inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary
 715       inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3)
 716       ccheck = Cluster.findSplitInstances nl' . Container.fromAssocList
 717   in null (ccheck [(0, inst1)]) &&
 718      null (ccheck [(0, inst2)]) &&
 719      (not . null $ ccheck [(0, inst3)])
 720
 721
 722
 723 testCluster =
 724     [ run prop_Score_Zero
 725     , run prop_CStats_sane
 726     , run prop_ClusterAlloc_sane
 727     , run prop_ClusterCanTieredAlloc
 728     , run prop_ClusterAllocEvac
 729     , run prop_ClusterAllocBalance
 730     , run prop_ClusterCheckConsistency
 731     ]
 732
 733 -- | Check that opcode serialization is idempotent
 734
 735 prop_OpCodes_serialization op =
 736   case J.readJSON (J.showJSON op) of
 737     J.Error _ -> False
 738     J.Ok op' -> op == op'
 739   where _types = op::OpCodes.OpCode
 740
 741 testOpCodes =
 742   [ run prop_OpCodes_serialization
 743   ]
 744
 745 -- | Check that (queued) job\/opcode status serialization is idempotent
 746 prop_OpStatus_serialization os =
 747   case J.readJSON (J.showJSON os) of
 748     J.Error _ -> False
 749     J.Ok os' -> os == os'
 750   where _types = os::Jobs.OpStatus
 751
 752 prop_JobStatus_serialization js =
 753   case J.readJSON (J.showJSON js) of
 754     J.Error _ -> False
 755     J.Ok js' -> js == js'
 756   where _types = js::Jobs.JobStatus
 757
 758 testJobs =
 759   [ run prop_OpStatus_serialization
 760   , run prop_JobStatus_serialization
 761   ]
 762
 763 -- | Loader tests
 764
 765 prop_Loader_lookupNode ktn inst node =
 766   isJust (Loader.lookupNode ktn inst node) == (node `elem` names)
 767     where names = map fst ktn
 768
 769 prop_Loader_lookupInstance kti inst =
 770   isJust (Loader.lookupInstance kti inst) == (inst `elem` names)
 771     where names = map fst kti
 772
 773 prop_Loader_lookupInstanceIdx kti inst =
 774   case (Loader.lookupInstance kti inst,
 775         findIndex (\p -> fst p == inst) kti) of
 776     (Nothing, Nothing) -> True
 777     (Just idx, Just ex) -> idx == snd (kti !! ex)
 778     _ -> False
 779
 780 prop_Loader_assignIndices enames =
 781   length nassoc == length enames &&
 782   length kt == length enames &&
 783   (if not (null enames)
 784    then maximum (map fst kt) == length enames - 1
 785    else True)
 786   where (nassoc, kt) = Loader.assignIndices enames
 787         _types = enames::[(String, Node.Node)]
 788
 789
 790 -- | Checks that the number of primary instances recorded on the nodes
 791 -- is zero
 792 prop_Loader_mergeData ns =
 793   let na = map (\n -> (Node.idx n, n)) ns
 794   in case Loader.mergeData [] [] [] (na, [], []) of
 795     Types.Bad _ -> False
 796     Types.Ok (nl, il, _) ->
 797       let nodes = Container.elems nl
 798           instances = Container.elems il
 799       in (sum . map (length . Node.pList)) nodes == 0 &&
 800          null instances
 801
 802 testLoader =
 803   [ run prop_Loader_lookupNode
 804   , run prop_Loader_lookupInstance
 805   , run prop_Loader_lookupInstanceIdx
 806   , run prop_Loader_assignIndices
 807   , run prop_Loader_mergeData
 808   ]