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 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 testNode =
 568     [ run prop_Node_setAlias
 569     , run prop_Node_setOffline
 570     , run prop_Node_setMcpu
 571     , run prop_Node_setXmem
 572     , run prop_Node_addPriFM
 573     , run prop_Node_addPriFD
 574     , run prop_Node_addPriFC
 575     , run prop_Node_addSec
 576     , run prop_Node_setMdsk
 577     , run prop_Node_tagMaps_idempotent
 578     , run prop_Node_tagMaps_reject
 579     , run prop_Node_showField
 580     ]
 581
 582
 583 -- Cluster tests
 584
 585 -- | Check that the cluster score is close to zero for a homogeneous cluster
 586 prop_Score_Zero node count =
 587     (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
 588      (Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
 589     let fn = Node.buildPeers node Container.empty
 590         nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
 591         nl = Container.fromAssocList nlst
 592         score = Cluster.compCV nl
 593     -- we can't say == 0 here as the floating point errors accumulate;
 594     -- this should be much lower than the default score in CLI.hs
 595     in score <= 1e-15
 596
 597 -- | Check that cluster stats are sane
 598 prop_CStats_sane node count =
 599     (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
 600      (Node.availDisk node > 0) && (Node.availMem node > 0)) ==>
 601     let fn = Node.buildPeers node Container.empty
 602         nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
 603         nl = Container.fromAssocList nlst
 604         cstats = Cluster.totalResources nl
 605     in Cluster.csAdsk cstats >= 0 &&
 606        Cluster.csAdsk cstats <= Cluster.csFdsk cstats
 607
 608 -- | Check that one instance is allocated correctly, without
 609 -- rebalances needed
 610 prop_ClusterAlloc_sane node inst =
 611     forAll (choose (5, 20)) $ \count ->
 612     not (Node.offline node)
 613             && not (Node.failN1 node)
 614             && Node.availDisk node > 0
 615             && Node.availMem node > 0
 616             ==>
 617     let nl = makeSmallCluster node count
 618         il = Container.empty
 619         rqnodes = 2
 620         inst' = setInstanceSmallerThanNode node inst
 621     in case Cluster.tryAlloc nl il inst' rqnodes of
 622          Types.Bad _ -> False
 623          Types.Ok (_, _, sols3) ->
 624              case sols3 of
 625                [] -> False
 626                (_, (xnl, xi, _)):[] ->
 627                    let cv = Cluster.compCV xnl
 628                        il' = Container.add (Instance.idx xi) xi il
 629                        tbl = Cluster.Table xnl il' cv []
 630                    in not (canBalance tbl True False)
 631                _ -> False
 632
 633 -- | Checks that on a 2-5 node cluster, we can allocate a random
 634 -- instance spec via tiered allocation (whatever the original instance
 635 -- spec), on either one or two nodes
 636 prop_ClusterCanTieredAlloc node inst =
 637     forAll (choose (2, 5)) $ \count ->
 638     forAll (choose (1, 2)) $ \rqnodes ->
 639     not (Node.offline node)
 640             && not (Node.failN1 node)
 641             && isNodeBig node 4
 642             ==>
 643     let nl = makeSmallCluster node count
 644         il = Container.empty
 645     in case Cluster.tieredAlloc nl il inst rqnodes [] of
 646          Types.Bad _ -> False
 647          Types.Ok (_, _, il', ixes) -> not (null ixes) &&
 648                                       IntMap.size il' == length ixes
 649
 650 -- | Checks that on a 4-8 node cluster, once we allocate an instance,
 651 -- we can also evacuate it
 652 prop_ClusterAllocEvac node inst =
 653     forAll (choose (4, 8)) $ \count ->
 654     not (Node.offline node)
 655             && not (Node.failN1 node)
 656             && isNodeBig node 4
 657             ==>
 658     let nl = makeSmallCluster node count
 659         il = Container.empty
 660         rqnodes = 2
 661         inst' = setInstanceSmallerThanNode node inst
 662     in case Cluster.tryAlloc nl il inst' rqnodes of
 663          Types.Bad _ -> False
 664          Types.Ok (_, _, sols3) ->
 665              case sols3 of
 666                [] -> False
 667                (_, (xnl, xi, _)):[] ->
 668                    let sdx = Instance.sNode xi
 669                        il' = Container.add (Instance.idx xi) xi il
 670                    in case Cluster.tryEvac xnl il' [sdx] of
 671                         Just _ -> True
 672                         _ -> False
 673                _ -> False
 674
 675 -- | Check that allocating multiple instances on a cluster, then
 676 -- adding an empty node, results in a valid rebalance
 677 prop_ClusterAllocBalance node =
 678     forAll (choose (3, 5)) $ \count ->
 679     not (Node.offline node)
 680             && not (Node.failN1 node)
 681             && isNodeBig node 4
 682             && not (isNodeBig node 8)
 683             ==>
 684     let nl = makeSmallCluster node count
 685         (hnode, nl') = IntMap.deleteFindMax nl
 686         il = Container.empty
 687         rqnodes = 2
 688         i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
 689     in case Cluster.iterateAlloc nl' il i_templ rqnodes [] of
 690          Types.Bad _ -> False
 691          Types.Ok (_, xnl, il', _) ->
 692                    let ynl = Container.add (Node.idx hnode) hnode xnl
 693                        cv = Cluster.compCV ynl
 694                        tbl = Cluster.Table ynl il' cv []
 695                    in canBalance tbl True False
 696
 697 testCluster =
 698     [ run prop_Score_Zero
 699     , run prop_CStats_sane
 700     , run prop_ClusterAlloc_sane
 701     , run prop_ClusterCanTieredAlloc
 702     , run prop_ClusterAllocEvac
 703     , run prop_ClusterAllocBalance
 704     ]
 705
 706 -- | Check that opcode serialization is idempotent
 707
 708 prop_OpCodes_serialization op =
 709   case J.readJSON (J.showJSON op) of
 710     J.Error _ -> False
 711     J.Ok op' -> op == op'
 712   where _types = op::OpCodes.OpCode
 713
 714 testOpCodes =
 715   [ run prop_OpCodes_serialization
 716   ]
 717
 718 -- | Check that (queued) job\/opcode status serialization is idempotent
 719 prop_OpStatus_serialization os =
 720   case J.readJSON (J.showJSON os) of
 721     J.Error _ -> False
 722     J.Ok os' -> os == os'
 723   where _types = os::Jobs.OpStatus
 724
 725 prop_JobStatus_serialization js =
 726   case J.readJSON (J.showJSON js) of
 727     J.Error _ -> False
 728     J.Ok js' -> js == js'
 729   where _types = js::Jobs.JobStatus
 730
 731 testJobs =
 732   [ run prop_OpStatus_serialization
 733   , run prop_JobStatus_serialization
 734   ]
 735
 736 -- | Loader tests
 737
 738 prop_Loader_lookupNode ktn inst node =
 739   isJust (Loader.lookupNode ktn inst node) == (node `elem` names)
 740     where names = map fst ktn
 741
 742 prop_Loader_lookupInstance kti inst =
 743   isJust (Loader.lookupInstance kti inst) == (inst `elem` names)
 744     where names = map fst kti
 745
 746 prop_Loader_lookupInstanceIdx kti inst =
 747   case (Loader.lookupInstance kti inst,
 748         findIndex (\p -> fst p == inst) kti) of
 749     (Nothing, Nothing) -> True
 750     (Just idx, Just ex) -> idx == snd (kti !! ex)
 751     _ -> False
 752
 753 prop_Loader_assignIndices enames =
 754   length nassoc == length enames &&
 755   length kt == length enames &&
 756   (if not (null enames)
 757    then maximum (map fst kt) == length enames - 1
 758    else True)
 759   where (nassoc, kt) = Loader.assignIndices enames
 760         _types = enames::[(String, Node.Node)]
 761
 762
 763 -- | Checks that the number of primary instances recorded on the nodes
 764 -- is zero
 765 prop_Loader_mergeData ns =
 766   let na = map (\n -> (Node.idx n, n)) ns
 767   in case Loader.mergeData [] [] [] (na, [], []) of
 768     Types.Bad _ -> False
 769     Types.Ok (nl, il, _) ->
 770       let nodes = Container.elems nl
 771           instances = Container.elems il
 772       in (sum . map (length . Node.pList)) nodes == 0 &&
 773          null instances
 774
 775 testLoader =
 776   [ run prop_Loader_lookupNode
 777   , run prop_Loader_lookupInstance
 778   , run prop_Loader_lookupInstanceIdx
 779   , run prop_Loader_assignIndices
 780   , run prop_Loader_mergeData
 781   ]