code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/HTools/QC.hs

   1 {-| Unittests for ganeti-htools.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2009, 2010, 2011 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     , testTypes
  38     ) where
  39
  40 import Test.QuickCheck
  41 import Data.List (findIndex, intercalate, nub, isPrefixOf)
  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.Group as Group
  60 import qualified Ganeti.HTools.PeerMap as PeerMap
  61 import qualified Ganeti.HTools.Rapi
  62 import qualified Ganeti.HTools.Simu
  63 import qualified Ganeti.HTools.Text as Text
  64 import qualified Ganeti.HTools.Types as Types
  65 import qualified Ganeti.HTools.Utils as Utils
  66 import qualified Ganeti.HTools.Version
  67 import qualified Ganeti.Constants as C
  68
  69 run :: Testable prop => prop -> Args -> IO Result
  70 run = flip quickCheckWithResult
  71
  72 -- * Constants
  73
  74 -- | Maximum memory (1TiB, somewhat random value).
  75 maxMem :: Int
  76 maxMem = 1024 * 1024
  77
  78 -- | Maximum disk (8TiB, somewhat random value).
  79 maxDsk :: Int
  80 maxDsk = 1024 * 1024 * 8
  81
  82 -- | Max CPUs (1024, somewhat random value).
  83 maxCpu :: Int
  84 maxCpu = 1024
  85
  86 defGroup :: Group.Group
  87 defGroup = flip Group.setIdx 0 $
  88                Group.create "default" Utils.defaultGroupID
  89                     Types.AllocPreferred
  90
  91 defGroupList :: Group.List
  92 defGroupList = Container.fromList [(Group.idx defGroup, defGroup)]
  93
  94 defGroupAssoc :: Data.Map.Map String Types.Gdx
  95 defGroupAssoc = Data.Map.singleton (Group.uuid defGroup) (Group.idx defGroup)
  96
  97 -- * Helper functions
  98
  99 -- | Simple checker for whether OpResult is fail or pass.
 100 isFailure :: Types.OpResult a -> Bool
 101 isFailure (Types.OpFail _) = True
 102 isFailure _ = False
 103
 104 -- | Update an instance to be smaller than a node.
 105 setInstanceSmallerThanNode node inst =
 106     inst { Instance.mem = Node.availMem node `div` 2
 107          , Instance.dsk = Node.availDisk node `div` 2
 108          , Instance.vcpus = Node.availCpu node `div` 2
 109          }
 110
 111 -- | Create an instance given its spec.
 112 createInstance mem dsk vcpus =
 113     Instance.create "inst-unnamed" mem dsk vcpus "running" [] True (-1) (-1)
 114                     Types.DTDrbd8
 115
 116 -- | Create a small cluster by repeating a node spec.
 117 makeSmallCluster :: Node.Node -> Int -> Node.List
 118 makeSmallCluster node count =
 119     let fn = Node.buildPeers node Container.empty
 120         namelst = map (\n -> (Node.name n, n)) (replicate count fn)
 121         (_, nlst) = Loader.assignIndices namelst
 122     in nlst
 123
 124 -- | Checks if a node is "big" enough.
 125 isNodeBig :: Node.Node -> Int -> Bool
 126 isNodeBig node size = Node.availDisk node > size * Types.unitDsk
 127                       && Node.availMem node > size * Types.unitMem
 128                       && Node.availCpu node > size * Types.unitCpu
 129
 130 canBalance :: Cluster.Table -> Bool -> Bool -> Bool -> Bool
 131 canBalance tbl dm im evac = isJust $ Cluster.tryBalance tbl dm im evac 0 0
 132
 133 -- | Assigns a new fresh instance to a cluster; this is not
 134 -- allocation, so no resource checks are done.
 135 assignInstance :: Node.List -> Instance.List -> Instance.Instance ->
 136                   Types.Idx -> Types.Idx ->
 137                   (Node.List, Instance.List)
 138 assignInstance nl il inst pdx sdx =
 139   let pnode = Container.find pdx nl
 140       snode = Container.find sdx nl
 141       maxiidx = if Container.null il
 142                 then 0
 143                 else fst (Container.findMax il) + 1
 144       inst' = inst { Instance.idx = maxiidx,
 145                      Instance.pNode = pdx, Instance.sNode = sdx }
 146       pnode' = Node.setPri pnode inst'
 147       snode' = Node.setSec snode inst'
 148       nl' = Container.addTwo pdx pnode' sdx snode' nl
 149       il' = Container.add maxiidx inst' il
 150   in (nl', il')
 151
 152 -- * Arbitrary instances
 153
 154 -- | Defines a DNS name.
 155 newtype DNSChar = DNSChar { dnsGetChar::Char }
 156
 157 instance Arbitrary DNSChar where
 158     arbitrary = do
 159       x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
 160       return (DNSChar x)
 161
 162 getName :: Gen String
 163 getName = do
 164   n <- choose (1, 64)
 165   dn <- vector n::Gen [DNSChar]
 166   return (map dnsGetChar dn)
 167
 168
 169 getFQDN :: Gen String
 170 getFQDN = do
 171   felem <- getName
 172   ncomps <- choose (1, 4)
 173   frest <- vector ncomps::Gen [[DNSChar]]
 174   let frest' = map (map dnsGetChar) frest
 175   return (felem ++ "." ++ intercalate "." frest')
 176
 177 -- let's generate a random instance
 178 instance Arbitrary Instance.Instance where
 179     arbitrary = do
 180       name <- getFQDN
 181       mem <- choose (0, maxMem)
 182       dsk <- choose (0, maxDsk)
 183       run_st <- elements [ C.inststErrorup
 184                          , C.inststErrordown
 185                          , C.inststAdmindown
 186                          , C.inststNodedown
 187                          , C.inststNodeoffline
 188                          , C.inststRunning
 189                          , "no_such_status1"
 190                          , "no_such_status2"]
 191       pn <- arbitrary
 192       sn <- arbitrary
 193       vcpus <- choose (0, maxCpu)
 194       return $ Instance.create name mem dsk vcpus run_st [] True pn sn
 195                                Types.DTDrbd8
 196
 197 -- | Generas an arbitrary node based on sizing information.
 198 genNode :: Maybe Int -- ^ Minimum node size in terms of units
 199         -> Maybe Int -- ^ Maximum node size (when Nothing, bounded
 200                      -- just by the max... constants)
 201         -> Gen Node.Node
 202 genNode min_multiplier max_multiplier = do
 203   let (base_mem, base_dsk, base_cpu) =
 204           case min_multiplier of
 205             Just mm -> (mm * Types.unitMem,
 206                         mm * Types.unitDsk,
 207                         mm * Types.unitCpu)
 208             Nothing -> (0, 0, 0)
 209       (top_mem, top_dsk, top_cpu)  =
 210           case max_multiplier of
 211             Just mm -> (mm * Types.unitMem,
 212                         mm * Types.unitDsk,
 213                         mm * Types.unitCpu)
 214             Nothing -> (maxMem, maxDsk, maxCpu)
 215   name  <- getFQDN
 216   mem_t <- choose (base_mem, top_mem)
 217   mem_f <- choose (base_mem, mem_t)
 218   mem_n <- choose (0, mem_t - mem_f)
 219   dsk_t <- choose (base_dsk, top_dsk)
 220   dsk_f <- choose (base_dsk, dsk_t)
 221   cpu_t <- choose (base_cpu, top_cpu)
 222   offl  <- arbitrary
 223   let n = Node.create name (fromIntegral mem_t) mem_n mem_f
 224           (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl 0
 225   return $ Node.buildPeers n Container.empty
 226
 227 -- and a random node
 228 instance Arbitrary Node.Node where
 229     arbitrary = genNode Nothing Nothing
 230
 231 -- replace disks
 232 instance Arbitrary OpCodes.ReplaceDisksMode where
 233   arbitrary = elements [ OpCodes.ReplaceOnPrimary
 234                        , OpCodes.ReplaceOnSecondary
 235                        , OpCodes.ReplaceNewSecondary
 236                        , OpCodes.ReplaceAuto
 237                        ]
 238
 239 instance Arbitrary OpCodes.OpCode where
 240   arbitrary = do
 241     op_id <- elements [ "OP_TEST_DELAY"
 242                       , "OP_INSTANCE_REPLACE_DISKS"
 243                       , "OP_INSTANCE_FAILOVER"
 244                       , "OP_INSTANCE_MIGRATE"
 245                       ]
 246     (case op_id of
 247         "OP_TEST_DELAY" ->
 248           liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary
 249         "OP_INSTANCE_REPLACE_DISKS" ->
 250           liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary
 251           arbitrary arbitrary arbitrary
 252         "OP_INSTANCE_FAILOVER" ->
 253           liftM2 OpCodes.OpInstanceFailover arbitrary arbitrary
 254         "OP_INSTANCE_MIGRATE" ->
 255           liftM4 OpCodes.OpInstanceMigrate arbitrary arbitrary arbitrary
 256           arbitrary
 257         _ -> fail "Wrong opcode")
 258
 259 instance Arbitrary Jobs.OpStatus where
 260   arbitrary = elements [minBound..maxBound]
 261
 262 instance Arbitrary Jobs.JobStatus where
 263   arbitrary = elements [minBound..maxBound]
 264
 265 newtype SmallRatio = SmallRatio Double deriving Show
 266 instance Arbitrary SmallRatio where
 267     arbitrary = do
 268       v <- choose (0, 1)
 269       return $ SmallRatio v
 270
 271 instance Arbitrary Types.AllocPolicy where
 272   arbitrary = elements [minBound..maxBound]
 273
 274 instance Arbitrary Types.DiskTemplate where
 275   arbitrary = elements [minBound..maxBound]
 276
 277 -- * Actual tests
 278
 279 -- ** Utils tests
 280
 281 -- | If the list is not just an empty element, and if the elements do
 282 -- not contain commas, then join+split should be idempotent.
 283 prop_Utils_commaJoinSplit =
 284     forAll (arbitrary `suchThat`
 285             (\l -> l /= [""] && all (not . elem ',') l )) $ \lst ->
 286     Utils.sepSplit ',' (Utils.commaJoin lst) == lst
 287
 288 -- | Split and join should always be idempotent.
 289 prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s
 290
 291 -- | fromObjWithDefault, we test using the Maybe monad and an integer
 292 -- value.
 293 prop_Utils_fromObjWithDefault def_value random_key =
 294     -- a missing key will be returned with the default
 295     Utils.fromObjWithDefault [] random_key def_value == Just def_value &&
 296     -- a found key will be returned as is, not with default
 297     Utils.fromObjWithDefault [(random_key, J.showJSON def_value)]
 298          random_key (def_value+1) == Just def_value
 299         where _types = def_value :: Integer
 300
 301 -- | Test that functional if' behaves like the syntactic sugar if.
 302 prop_Utils_if'if :: Bool -> Int -> Int -> Bool
 303 prop_Utils_if'if cnd a b = Utils.if' cnd a b == if cnd then a else b
 304
 305 -- | Test basic select functionality
 306 prop_Utils_select :: Int   -- ^ Default result
 307                   -> [Int] -- ^ List of False values
 308                   -> [Int] -- ^ List of True values
 309                   -> Bool  -- ^ Test result
 310 prop_Utils_select def lst1 lst2 =
 311   Utils.select def cndlist == expectedresult
 312   where expectedresult = Utils.if' (null lst2) def (head lst2)
 313         flist = map (\e -> (False, e)) lst1
 314         tlist = map (\e -> (True, e)) lst2
 315         cndlist = flist ++ tlist
 316
 317 -- | Test basic select functionality with undefined default
 318 prop_Utils_select_undefd :: [Int] -- ^ List of False values
 319                          -> NonEmptyList Int -- ^ List of True values
 320                          -> Bool  -- ^ Test result
 321 prop_Utils_select_undefd lst1 (NonEmpty lst2) =
 322   Utils.select undefined cndlist == head lst2
 323   where flist = map (\e -> (False, e)) lst1
 324         tlist = map (\e -> (True, e)) lst2
 325         cndlist = flist ++ tlist
 326
 327 -- | Test basic select functionality with undefined list values
 328 prop_Utils_select_undefv :: [Int] -- ^ List of False values
 329                          -> NonEmptyList Int -- ^ List of True values
 330                          -> Bool  -- ^ Test result
 331 prop_Utils_select_undefv lst1 (NonEmpty lst2) =
 332   Utils.select undefined cndlist == head lst2
 333   where flist = map (\e -> (False, e)) lst1
 334         tlist = map (\e -> (True, e)) lst2
 335         cndlist = flist ++ tlist ++ [undefined]
 336
 337 prop_Utils_parseUnit (NonNegative n) =
 338     Utils.parseUnit (show n) == Types.Ok n &&
 339     Utils.parseUnit (show n ++ "m") == Types.Ok n &&
 340     (case Utils.parseUnit (show n ++ "M") of
 341       Types.Ok m -> if n > 0
 342                     then m < n  -- for positive values, X MB is less than X MiB
 343                     else m == 0 -- but for 0, 0 MB == 0 MiB
 344       Types.Bad _ -> False) &&
 345     Utils.parseUnit (show n ++ "g") == Types.Ok (n*1024) &&
 346     Utils.parseUnit (show n ++ "t") == Types.Ok (n*1048576) &&
 347     Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)
 348     where _types = (n::Int)
 349
 350 -- | Test list for the Utils module.
 351 testUtils =
 352   [ run prop_Utils_commaJoinSplit
 353   , run prop_Utils_commaSplitJoin
 354   , run prop_Utils_fromObjWithDefault
 355   , run prop_Utils_if'if
 356   , run prop_Utils_select
 357   , run prop_Utils_select_undefd
 358   , run prop_Utils_select_undefv
 359   , run prop_Utils_parseUnit
 360   ]
 361
 362 -- ** PeerMap tests
 363
 364 -- | Make sure add is idempotent.
 365 prop_PeerMap_addIdempotent pmap key em =
 366     fn puniq == fn (fn puniq)
 367     where _types = (pmap::PeerMap.PeerMap,
 368                     key::PeerMap.Key, em::PeerMap.Elem)
 369           fn = PeerMap.add key em
 370           puniq = PeerMap.accumArray const pmap
 371
 372 -- | Make sure remove is idempotent.
 373 prop_PeerMap_removeIdempotent pmap key =
 374     fn puniq == fn (fn puniq)
 375     where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
 376           fn = PeerMap.remove key
 377           puniq = PeerMap.accumArray const pmap
 378
 379 -- | Make sure a missing item returns 0.
 380 prop_PeerMap_findMissing pmap key =
 381     PeerMap.find key (PeerMap.remove key puniq) == 0
 382     where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
 383           puniq = PeerMap.accumArray const pmap
 384
 385 -- | Make sure an added item is found.
 386 prop_PeerMap_addFind pmap key em =
 387     PeerMap.find key (PeerMap.add key em puniq) == em
 388     where _types = (pmap::PeerMap.PeerMap,
 389                     key::PeerMap.Key, em::PeerMap.Elem)
 390           puniq = PeerMap.accumArray const pmap
 391
 392 -- | Manual check that maxElem returns the maximum indeed, or 0 for null.
 393 prop_PeerMap_maxElem pmap =
 394     PeerMap.maxElem puniq == if null puniq then 0
 395                              else (maximum . snd . unzip) puniq
 396     where _types = pmap::PeerMap.PeerMap
 397           puniq = PeerMap.accumArray const pmap
 398
 399 -- | List of tests for the PeerMap module.
 400 testPeerMap =
 401     [ run prop_PeerMap_addIdempotent
 402     , run prop_PeerMap_removeIdempotent
 403     , run prop_PeerMap_maxElem
 404     , run prop_PeerMap_addFind
 405     , run prop_PeerMap_findMissing
 406     ]
 407
 408 -- ** Container tests
 409
 410 prop_Container_addTwo cdata i1 i2 =
 411     fn i1 i2 cont == fn i2 i1 cont &&
 412        fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
 413     where _types = (cdata::[Int],
 414                     i1::Int, i2::Int)
 415           cont = foldl (\c x -> Container.add x x c) Container.empty cdata
 416           fn x1 x2 = Container.addTwo x1 x1 x2 x2
 417
 418 prop_Container_nameOf node =
 419   let nl = makeSmallCluster node 1
 420       fnode = head (Container.elems nl)
 421   in Container.nameOf nl (Node.idx fnode) == Node.name fnode
 422
 423 -- | We test that in a cluster, given a random node, we can find it by
 424 -- its name and alias, as long as all names and aliases are unique,
 425 -- and that we fail to find a non-existing name.
 426 prop_Container_findByName node othername =
 427   forAll (choose (1, 20)) $ \ cnt ->
 428   forAll (choose (0, cnt - 1)) $ \ fidx ->
 429   forAll (vector cnt) $ \ names ->
 430   (length . nub) (map fst names ++ map snd names) ==
 431   length names * 2 &&
 432   not (othername `elem` (map fst names ++ map snd names)) ==>
 433   let nl = makeSmallCluster node cnt
 434       nodes = Container.elems nl
 435       nodes' = map (\((name, alias), nn) -> (Node.idx nn,
 436                                              nn { Node.name = name,
 437                                                   Node.alias = alias }))
 438                $ zip names nodes
 439       nl' = Container.fromList nodes'
 440       target = snd (nodes' !! fidx)
 441   in Container.findByName nl' (Node.name target) == Just target &&
 442      Container.findByName nl' (Node.alias target) == Just target &&
 443      Container.findByName nl' othername == Nothing
 444
 445 testContainer =
 446     [ run prop_Container_addTwo
 447     , run prop_Container_nameOf
 448     , run prop_Container_findByName
 449     ]
 450
 451 -- ** Instance tests
 452
 453 -- Simple instance tests, we only have setter/getters
 454
 455 prop_Instance_creat inst =
 456     Instance.name inst == Instance.alias inst
 457
 458 prop_Instance_setIdx inst idx =
 459     Instance.idx (Instance.setIdx inst idx) == idx
 460     where _types = (inst::Instance.Instance, idx::Types.Idx)
 461
 462 prop_Instance_setName inst name =
 463     Instance.name newinst == name &&
 464     Instance.alias newinst == name
 465     where _types = (inst::Instance.Instance, name::String)
 466           newinst = Instance.setName inst name
 467
 468 prop_Instance_setAlias inst name =
 469     Instance.name newinst == Instance.name inst &&
 470     Instance.alias newinst == name
 471     where _types = (inst::Instance.Instance, name::String)
 472           newinst = Instance.setAlias inst name
 473
 474 prop_Instance_setPri inst pdx =
 475     Instance.pNode (Instance.setPri inst pdx) == pdx
 476     where _types = (inst::Instance.Instance, pdx::Types.Ndx)
 477
 478 prop_Instance_setSec inst sdx =
 479     Instance.sNode (Instance.setSec inst sdx) == sdx
 480     where _types = (inst::Instance.Instance, sdx::Types.Ndx)
 481
 482 prop_Instance_setBoth inst pdx sdx =
 483     Instance.pNode si == pdx && Instance.sNode si == sdx
 484     where _types = (inst::Instance.Instance, pdx::Types.Ndx, sdx::Types.Ndx)
 485           si = Instance.setBoth inst pdx sdx
 486
 487 prop_Instance_runStatus_True =
 488     forAll (arbitrary `suchThat`
 489             ((`elem` Instance.runningStates) . Instance.runSt))
 490     Instance.running
 491
 492 prop_Instance_runStatus_False inst =
 493     let run_st = Instance.running inst
 494         run_tx = Instance.runSt inst
 495     in
 496       run_tx `notElem` Instance.runningStates ==> not run_st
 497
 498 prop_Instance_shrinkMG inst =
 499     Instance.mem inst >= 2 * Types.unitMem ==>
 500         case Instance.shrinkByType inst Types.FailMem of
 501           Types.Ok inst' ->
 502               Instance.mem inst' == Instance.mem inst - Types.unitMem
 503           _ -> False
 504
 505 prop_Instance_shrinkMF inst =
 506     forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
 507     let inst' = inst { Instance.mem = mem}
 508     in Types.isBad $ Instance.shrinkByType inst' Types.FailMem
 509
 510 prop_Instance_shrinkCG inst =
 511     Instance.vcpus inst >= 2 * Types.unitCpu ==>
 512         case Instance.shrinkByType inst Types.FailCPU of
 513           Types.Ok inst' ->
 514               Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
 515           _ -> False
 516
 517 prop_Instance_shrinkCF inst =
 518     forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
 519     let inst' = inst { Instance.vcpus = vcpus }
 520     in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU
 521
 522 prop_Instance_shrinkDG inst =
 523     Instance.dsk inst >= 2 * Types.unitDsk ==>
 524         case Instance.shrinkByType inst Types.FailDisk of
 525           Types.Ok inst' ->
 526               Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
 527           _ -> False
 528
 529 prop_Instance_shrinkDF inst =
 530     forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
 531     let inst' = inst { Instance.dsk = dsk }
 532     in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk
 533
 534 prop_Instance_setMovable inst m =
 535     Instance.movable inst' == m
 536     where inst' = Instance.setMovable inst m
 537
 538 testInstance =
 539     [ run prop_Instance_creat
 540     , run prop_Instance_setIdx
 541     , run prop_Instance_setName
 542     , run prop_Instance_setAlias
 543     , run prop_Instance_setPri
 544     , run prop_Instance_setSec
 545     , run prop_Instance_setBoth
 546     , run prop_Instance_runStatus_True
 547     , run prop_Instance_runStatus_False
 548     , run prop_Instance_shrinkMG
 549     , run prop_Instance_shrinkMF
 550     , run prop_Instance_shrinkCG
 551     , run prop_Instance_shrinkCF
 552     , run prop_Instance_shrinkDG
 553     , run prop_Instance_shrinkDF
 554     , run prop_Instance_setMovable
 555     ]
 556
 557 -- ** Text backend tests
 558
 559 -- Instance text loader tests
 560
 561 prop_Text_Load_Instance name mem dsk vcpus status
 562                         (NonEmpty pnode) snode
 563                         (NonNegative pdx) (NonNegative sdx) autobal dt =
 564     pnode /= snode && pdx /= sdx ==>
 565     let vcpus_s = show vcpus
 566         dsk_s = show dsk
 567         mem_s = show mem
 568         ndx = if null snode
 569               then [(pnode, pdx)]
 570               else [(pnode, pdx), (snode, sdx)]
 571         nl = Data.Map.fromList ndx
 572         tags = ""
 573         sbal = if autobal then "Y" else "N"
 574         sdt = Types.dtToString dt
 575         inst = Text.loadInst nl
 576                [name, mem_s, dsk_s, vcpus_s, status,
 577                 sbal, pnode, snode, sdt, tags]
 578         fail1 = Text.loadInst nl
 579                [name, mem_s, dsk_s, vcpus_s, status,
 580                 sbal, pnode, pnode, tags]
 581         _types = ( name::String, mem::Int, dsk::Int
 582                  , vcpus::Int, status::String
 583                  , snode::String
 584                  , autobal::Bool)
 585     in
 586       case inst of
 587         Types.Bad msg -> printTestCase ("Failed to load instance: " ++ msg)
 588                          False
 589         Types.Ok (_, i) -> printTestCase ("Mismatch in some field while\
 590                                           \ loading the instance") $
 591             Instance.name i == name &&
 592             Instance.vcpus i == vcpus &&
 593             Instance.mem i == mem &&
 594             Instance.pNode i == pdx &&
 595             Instance.sNode i == (if null snode
 596                                  then Node.noSecondary
 597                                  else sdx) &&
 598             Instance.autoBalance i == autobal &&
 599             Types.isBad fail1
 600
 601 prop_Text_Load_InstanceFail ktn fields =
 602     length fields /= 10 ==>
 603     case Text.loadInst nl fields of
 604       Types.Ok _ -> printTestCase "Managed to load instance from invalid\
 605                                   \ data" False
 606       Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
 607                        "Invalid/incomplete instance data: '" `isPrefixOf` msg
 608     where nl = Data.Map.fromList ktn
 609
 610 prop_Text_Load_Node name tm nm fm td fd tc fo =
 611     let conv v = if v < 0
 612                     then "?"
 613                     else show v
 614         tm_s = conv tm
 615         nm_s = conv nm
 616         fm_s = conv fm
 617         td_s = conv td
 618         fd_s = conv fd
 619         tc_s = conv tc
 620         fo_s = if fo
 621                then "Y"
 622                else "N"
 623         any_broken = any (< 0) [tm, nm, fm, td, fd, tc]
 624         gid = Group.uuid defGroup
 625     in case Text.loadNode defGroupAssoc
 626            [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s, gid] of
 627          Nothing -> False
 628          Just (name', node) ->
 629              if fo || any_broken
 630              then Node.offline node
 631              else Node.name node == name' && name' == name &&
 632                   Node.alias node == name &&
 633                   Node.tMem node == fromIntegral tm &&
 634                   Node.nMem node == nm &&
 635                   Node.fMem node == fm &&
 636                   Node.tDsk node == fromIntegral td &&
 637                   Node.fDsk node == fd &&
 638                   Node.tCpu node == fromIntegral tc
 639
 640 prop_Text_Load_NodeFail fields =
 641     length fields /= 8 ==> isNothing $ Text.loadNode Data.Map.empty fields
 642
 643 prop_Text_NodeLSIdempotent node =
 644     (Text.loadNode defGroupAssoc.
 645          Utils.sepSplit '|' . Text.serializeNode defGroupList) n ==
 646     Just (Node.name n, n)
 647     -- override failN1 to what loadNode returns by default
 648     where n = node { Node.failN1 = True, Node.offline = False }
 649
 650 testText =
 651     [ run prop_Text_Load_Instance
 652     , run prop_Text_Load_InstanceFail
 653     , run prop_Text_Load_Node
 654     , run prop_Text_Load_NodeFail
 655     , run prop_Text_NodeLSIdempotent
 656     ]
 657
 658 -- ** Node tests
 659
 660 prop_Node_setAlias node name =
 661     Node.name newnode == Node.name node &&
 662     Node.alias newnode == name
 663     where _types = (node::Node.Node, name::String)
 664           newnode = Node.setAlias node name
 665
 666 prop_Node_setOffline node status =
 667     Node.offline newnode == status
 668     where newnode = Node.setOffline node status
 669
 670 prop_Node_setXmem node xm =
 671     Node.xMem newnode == xm
 672     where newnode = Node.setXmem node xm
 673
 674 prop_Node_setMcpu node mc =
 675     Node.mCpu newnode == mc
 676     where newnode = Node.setMcpu node mc
 677
 678 -- | Check that an instance add with too high memory or disk will be
 679 -- rejected.
 680 prop_Node_addPriFM node inst = Instance.mem inst >= Node.fMem node &&
 681                                not (Node.failN1 node)
 682                                ==>
 683                                case Node.addPri node inst'' of
 684                                  Types.OpFail Types.FailMem -> True
 685                                  _ -> False
 686     where _types = (node::Node.Node, inst::Instance.Instance)
 687           inst' = setInstanceSmallerThanNode node inst
 688           inst'' = inst' { Instance.mem = Instance.mem inst }
 689
 690 prop_Node_addPriFD node inst = Instance.dsk inst >= Node.fDsk node &&
 691                                not (Node.failN1 node)
 692                                ==>
 693                                case Node.addPri node inst'' of
 694                                  Types.OpFail Types.FailDisk -> True
 695                                  _ -> False
 696     where _types = (node::Node.Node, inst::Instance.Instance)
 697           inst' = setInstanceSmallerThanNode node inst
 698           inst'' = inst' { Instance.dsk = Instance.dsk inst }
 699
 700 prop_Node_addPriFC node inst (Positive extra) =
 701     not (Node.failN1 node) ==>
 702         case Node.addPri node inst'' of
 703           Types.OpFail Types.FailCPU -> True
 704           _ -> False
 705     where _types = (node::Node.Node, inst::Instance.Instance)
 706           inst' = setInstanceSmallerThanNode node inst
 707           inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
 708
 709 -- | Check that an instance add with too high memory or disk will be
 710 -- rejected.
 711 prop_Node_addSec node inst pdx =
 712     (Instance.mem inst >= (Node.fMem node - Node.rMem node) ||
 713      Instance.dsk inst >= Node.fDsk node) &&
 714     not (Node.failN1 node)
 715     ==> isFailure (Node.addSec node inst pdx)
 716         where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int)
 717
 718 -- | Checks for memory reservation changes.
 719 prop_Node_rMem inst =
 720     forAll (arbitrary `suchThat` ((> Types.unitMem) . Node.fMem)) $ \node ->
 721     -- ab = auto_balance, nb = non-auto_balance
 722     -- we use -1 as the primary node of the instance
 723     let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True }
 724         inst_ab = setInstanceSmallerThanNode node inst'
 725         inst_nb = inst_ab { Instance.autoBalance = False }
 726         -- now we have the two instances, identical except the
 727         -- autoBalance attribute
 728         orig_rmem = Node.rMem node
 729         inst_idx = Instance.idx inst_ab
 730         node_add_ab = Node.addSec node inst_ab (-1)
 731         node_add_nb = Node.addSec node inst_nb (-1)
 732         node_del_ab = liftM (flip Node.removeSec inst_ab) node_add_ab
 733         node_del_nb = liftM (flip Node.removeSec inst_nb) node_add_nb
 734     in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of
 735          (Types.OpGood a_ab, Types.OpGood a_nb,
 736           Types.OpGood d_ab, Types.OpGood d_nb) ->
 737              printTestCase "Consistency checks failed" $
 738              Node.rMem a_ab >  orig_rmem &&
 739              Node.rMem a_ab - orig_rmem == Instance.mem inst_ab &&
 740              Node.rMem a_nb == orig_rmem &&
 741              Node.rMem d_ab == orig_rmem &&
 742              Node.rMem d_nb == orig_rmem &&
 743              -- this is not related to rMem, but as good a place to
 744              -- test as any
 745              inst_idx `elem` Node.sList a_ab &&
 746              not (inst_idx `elem` Node.sList d_ab)
 747          x -> printTestCase ("Failed to add/remove instances: " ++ show x)
 748               False
 749
 750 -- | Check mdsk setting.
 751 prop_Node_setMdsk node mx =
 752     Node.loDsk node' >= 0 &&
 753     fromIntegral (Node.loDsk node') <= Node.tDsk node &&
 754     Node.availDisk node' >= 0 &&
 755     Node.availDisk node' <= Node.fDsk node' &&
 756     fromIntegral (Node.availDisk node') <= Node.tDsk node' &&
 757     Node.mDsk node' == mx'
 758     where _types = (node::Node.Node, mx::SmallRatio)
 759           node' = Node.setMdsk node mx'
 760           SmallRatio mx' = mx
 761
 762 -- Check tag maps
 763 prop_Node_tagMaps_idempotent tags =
 764     Node.delTags (Node.addTags m tags) tags == m
 765     where m = Data.Map.empty
 766
 767 prop_Node_tagMaps_reject tags =
 768     not (null tags) ==>
 769     any (\t -> Node.rejectAddTags m [t]) tags
 770     where m = Node.addTags Data.Map.empty tags
 771
 772 prop_Node_showField node =
 773   forAll (elements Node.defaultFields) $ \ field ->
 774   fst (Node.showHeader field) /= Types.unknownField &&
 775   Node.showField node field /= Types.unknownField
 776
 777
 778 prop_Node_computeGroups nodes =
 779   let ng = Node.computeGroups nodes
 780       onlyuuid = map fst ng
 781   in length nodes == sum (map (length . snd) ng) &&
 782      all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng &&
 783      length (nub onlyuuid) == length onlyuuid &&
 784      (null nodes || not (null ng))
 785
 786 testNode =
 787     [ run prop_Node_setAlias
 788     , run prop_Node_setOffline
 789     , run prop_Node_setMcpu
 790     , run prop_Node_setXmem
 791     , run prop_Node_addPriFM
 792     , run prop_Node_addPriFD
 793     , run prop_Node_addPriFC
 794     , run prop_Node_addSec
 795     , run prop_Node_rMem
 796     , run prop_Node_setMdsk
 797     , run prop_Node_tagMaps_idempotent
 798     , run prop_Node_tagMaps_reject
 799     , run prop_Node_showField
 800     , run prop_Node_computeGroups
 801     ]
 802
 803
 804 -- ** Cluster tests
 805
 806 -- | Check that the cluster score is close to zero for a homogeneous
 807 -- cluster.
 808 prop_Score_Zero node =
 809     forAll (choose (1, 1024)) $ \count ->
 810     (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
 811      (Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
 812     let fn = Node.buildPeers node Container.empty
 813         nlst = replicate count fn
 814         score = Cluster.compCVNodes nlst
 815     -- we can't say == 0 here as the floating point errors accumulate;
 816     -- this should be much lower than the default score in CLI.hs
 817     in score <= 1e-12
 818
 819 -- | Check that cluster stats are sane.
 820 prop_CStats_sane node =
 821     forAll (choose (1, 1024)) $ \count ->
 822     (not (Node.offline node) && not (Node.failN1 node) &&
 823      (Node.availDisk node > 0) && (Node.availMem node > 0)) ==>
 824     let fn = Node.buildPeers node Container.empty
 825         nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
 826         nl = Container.fromList nlst
 827         cstats = Cluster.totalResources nl
 828     in Cluster.csAdsk cstats >= 0 &&
 829        Cluster.csAdsk cstats <= Cluster.csFdsk cstats
 830
 831 -- | Check that one instance is allocated correctly, without
 832 -- rebalances needed.
 833 prop_ClusterAlloc_sane node inst =
 834     forAll (choose (5, 20)) $ \count ->
 835     not (Node.offline node)
 836             && not (Node.failN1 node)
 837             && Node.availDisk node > 0
 838             && Node.availMem node > 0
 839             ==>
 840     let nl = makeSmallCluster node count
 841         il = Container.empty
 842         inst' = setInstanceSmallerThanNode node inst
 843     in case Cluster.genAllocNodes defGroupList nl 2 True >>=
 844        Cluster.tryAlloc nl il inst' of
 845          Types.Bad _ -> False
 846          Types.Ok as ->
 847              case Cluster.asSolutions as of
 848                [] -> False
 849                (xnl, xi, _, cv):[] ->
 850                    let il' = Container.add (Instance.idx xi) xi il
 851                        tbl = Cluster.Table xnl il' cv []
 852                    in not (canBalance tbl True True False)
 853                _ -> False
 854
 855 -- | Checks that on a 2-5 node cluster, we can allocate a random
 856 -- instance spec via tiered allocation (whatever the original instance
 857 -- spec), on either one or two nodes.
 858 prop_ClusterCanTieredAlloc node inst =
 859     forAll (choose (2, 5)) $ \count ->
 860     forAll (choose (1, 2)) $ \rqnodes ->
 861     not (Node.offline node)
 862             && not (Node.failN1 node)
 863             && isNodeBig node 4
 864             ==>
 865     let nl = makeSmallCluster node count
 866         il = Container.empty
 867         allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
 868     in case allocnodes >>= \allocnodes' ->
 869         Cluster.tieredAlloc nl il inst allocnodes' [] [] of
 870          Types.Bad _ -> False
 871          Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) &&
 872                                       IntMap.size il' == length ixes &&
 873                                       length ixes == length cstats
 874
 875 -- | Checks that on a 4-8 node cluster, once we allocate an instance,
 876 -- we can also evacuate it.
 877 prop_ClusterAllocEvac node inst =
 878     forAll (choose (4, 8)) $ \count ->
 879     not (Node.offline node)
 880             && not (Node.failN1 node)
 881             && isNodeBig node 4
 882             ==>
 883     let nl = makeSmallCluster node count
 884         il = Container.empty
 885         inst' = setInstanceSmallerThanNode node inst
 886     in case Cluster.genAllocNodes defGroupList nl 2 True >>=
 887        Cluster.tryAlloc nl il inst' of
 888          Types.Bad _ -> False
 889          Types.Ok as ->
 890              case Cluster.asSolutions as of
 891                [] -> False
 892                (xnl, xi, _, _):[] ->
 893                    let sdx = Instance.sNode xi
 894                        il' = Container.add (Instance.idx xi) xi il
 895                    in case Cluster.tryEvac xnl il' [Instance.idx xi] [sdx] of
 896                         Just _ -> True
 897                         _ -> False
 898                _ -> False
 899
 900 -- | Check that allocating multiple instances on a cluster, then
 901 -- adding an empty node, results in a valid rebalance.
 902 prop_ClusterAllocBalance =
 903     forAll (genNode (Just 5) (Just 128)) $ \node ->
 904     forAll (choose (3, 5)) $ \count ->
 905     not (Node.offline node) && not (Node.failN1 node) ==>
 906     let nl = makeSmallCluster node count
 907         (hnode, nl') = IntMap.deleteFindMax nl
 908         il = Container.empty
 909         allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True
 910         i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
 911     in case allocnodes >>= \allocnodes' ->
 912         Cluster.iterateAlloc nl' il i_templ allocnodes' [] [] of
 913          Types.Bad _ -> False
 914          Types.Ok (_, xnl, il', _, _) ->
 915                    let ynl = Container.add (Node.idx hnode) hnode xnl
 916                        cv = Cluster.compCV ynl
 917                        tbl = Cluster.Table ynl il' cv []
 918                    in canBalance tbl True True False
 919
 920 -- | Checks consistency.
 921 prop_ClusterCheckConsistency node inst =
 922   let nl = makeSmallCluster node 3
 923       [node1, node2, node3] = Container.elems nl
 924       node3' = node3 { Node.group = 1 }
 925       nl' = Container.add (Node.idx node3') node3' nl
 926       inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2)
 927       inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary
 928       inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3)
 929       ccheck = Cluster.findSplitInstances nl' . Container.fromList
 930   in null (ccheck [(0, inst1)]) &&
 931      null (ccheck [(0, inst2)]) &&
 932      (not . null $ ccheck [(0, inst3)])
 933
 934 -- | For now, we only test that we don't lose instances during the split.
 935 prop_ClusterSplitCluster node inst =
 936   forAll (choose (0, 100)) $ \icnt ->
 937   let nl = makeSmallCluster node 2
 938       (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1)
 939                    (nl, Container.empty) [1..icnt]
 940       gni = Cluster.splitCluster nl' il'
 941   in sum (map (Container.size . snd . snd) gni) == icnt &&
 942      all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group)
 943                                  (Container.elems nl'')) gni
 944
 945 testCluster =
 946     [ run prop_Score_Zero
 947     , run prop_CStats_sane
 948     , run prop_ClusterAlloc_sane
 949     , run prop_ClusterCanTieredAlloc
 950     , run prop_ClusterAllocEvac
 951     , run prop_ClusterAllocBalance
 952     , run prop_ClusterCheckConsistency
 953     , run prop_ClusterSplitCluster
 954     ]
 955
 956 -- ** OpCodes tests
 957
 958 -- | Check that opcode serialization is idempotent.
 959 prop_OpCodes_serialization op =
 960   case J.readJSON (J.showJSON op) of
 961     J.Error _ -> False
 962     J.Ok op' -> op == op'
 963   where _types = op::OpCodes.OpCode
 964
 965 testOpCodes =
 966   [ run prop_OpCodes_serialization
 967   ]
 968
 969 -- ** Jobs tests
 970
 971 -- | Check that (queued) job\/opcode status serialization is idempotent.
 972 prop_OpStatus_serialization os =
 973   case J.readJSON (J.showJSON os) of
 974     J.Error _ -> False
 975     J.Ok os' -> os == os'
 976   where _types = os::Jobs.OpStatus
 977
 978 prop_JobStatus_serialization js =
 979   case J.readJSON (J.showJSON js) of
 980     J.Error _ -> False
 981     J.Ok js' -> js == js'
 982   where _types = js::Jobs.JobStatus
 983
 984 testJobs =
 985   [ run prop_OpStatus_serialization
 986   , run prop_JobStatus_serialization
 987   ]
 988
 989 -- ** Loader tests
 990
 991 prop_Loader_lookupNode ktn inst node =
 992   Loader.lookupNode nl inst node == Data.Map.lookup node nl
 993   where nl = Data.Map.fromList ktn
 994
 995 prop_Loader_lookupInstance kti inst =
 996   Loader.lookupInstance il inst == Data.Map.lookup inst il
 997   where il = Data.Map.fromList kti
 998
 999 prop_Loader_assignIndices nodes =
1000   Data.Map.size nassoc == length nodes &&
1001   Container.size kt == length nodes &&
1002   (if not (null nodes)
1003    then maximum (IntMap.keys kt) == length nodes - 1
1004    else True)
1005   where (nassoc, kt) = Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)
1006
1007 -- | Checks that the number of primary instances recorded on the nodes
1008 -- is zero.
1009 prop_Loader_mergeData ns =
1010   let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns
1011   in case Loader.mergeData [] [] [] []
1012          (Loader.emptyCluster {Loader.cdNodes = na}) of
1013     Types.Bad _ -> False
1014     Types.Ok (Loader.ClusterData _ nl il _) ->
1015       let nodes = Container.elems nl
1016           instances = Container.elems il
1017       in (sum . map (length . Node.pList)) nodes == 0 &&
1018          null instances
1019
1020 -- | Check that compareNameComponent on equal strings works.
1021 prop_Loader_compareNameComponent_equal :: String -> Bool
1022 prop_Loader_compareNameComponent_equal s =
1023   Loader.compareNameComponent s s ==
1024     Loader.LookupResult Loader.ExactMatch s
1025
1026 -- | Check that compareNameComponent on prefix strings works.
1027 prop_Loader_compareNameComponent_prefix :: NonEmptyList Char -> String -> Bool
1028 prop_Loader_compareNameComponent_prefix (NonEmpty s1) s2 =
1029   Loader.compareNameComponent (s1 ++ "." ++ s2) s1 ==
1030     Loader.LookupResult Loader.PartialMatch s1
1031
1032 testLoader =
1033   [ run prop_Loader_lookupNode
1034   , run prop_Loader_lookupInstance
1035   , run prop_Loader_assignIndices
1036   , run prop_Loader_mergeData
1037   , run prop_Loader_compareNameComponent_equal
1038   , run prop_Loader_compareNameComponent_prefix
1039   ]
1040
1041 -- ** Types tests
1042
1043 prop_AllocPolicy_serialisation apol =
1044     case Types.apolFromString (Types.apolToString apol) of
1045       Types.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
1046                     p == apol
1047       Types.Bad s -> printTestCase ("failed to deserialise: " ++ s) False
1048
1049 prop_DiskTemplate_serialisation dt =
1050     case Types.dtFromString (Types.dtToString dt) of
1051       Types.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
1052                     p == dt
1053       Types.Bad s -> printTestCase ("failed to deserialise: " ++ s) False
1054
1055 testTypes =
1056     [ run prop_AllocPolicy_serialisation
1057     , run prop_DiskTemplate_serialisation
1058     ]