X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/dc384cf064e529f2af240e10da763962889970ce..1fe412bb9ec1b5666d4a32b1ee499c14c191e563:/htools/Ganeti/HTools/QC.hs diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs index 534a7b1..df3051b 100644 --- a/htools/Ganeti/HTools/QC.hs +++ b/htools/Ganeti/HTools/QC.hs @@ -1,4 +1,4 @@ -{-| Unittests for ganeti-htools +{-| Unittests for ganeti-htools. -} @@ -37,8 +37,7 @@ module Ganeti.HTools.QC ) where import Test.QuickCheck -import Test.QuickCheck.Batch -import Data.List (findIndex, intercalate, nub) +import Data.List (findIndex, intercalate, nub, isPrefixOf) import Data.Maybe import Control.Monad import qualified Text.JSON as J @@ -64,18 +63,22 @@ import qualified Ganeti.HTools.Text as Text import qualified Ganeti.HTools.Types as Types import qualified Ganeti.HTools.Utils as Utils import qualified Ganeti.HTools.Version +import qualified Ganeti.Constants as C + +run :: Testable prop => prop -> Args -> IO Result +run = flip quickCheckWithResult -- * Constants --- | Maximum memory (1TiB, somewhat random value) +-- | Maximum memory (1TiB, somewhat random value). maxMem :: Int maxMem = 1024 * 1024 --- | Maximum disk (8TiB, somewhat random value) +-- | Maximum disk (8TiB, somewhat random value). maxDsk :: Int maxDsk = 1024 * 1024 * 8 --- | Max CPUs (1024, somewhat random value) +-- | Max CPUs (1024, somewhat random value). maxCpu :: Int maxCpu = 1024 @@ -92,23 +95,23 @@ defGroupAssoc = Data.Map.singleton (Group.uuid defGroup) (Group.idx defGroup) -- * Helper functions --- | Simple checker for whether OpResult is fail or pass +-- | Simple checker for whether OpResult is fail or pass. isFailure :: Types.OpResult a -> Bool isFailure (Types.OpFail _) = True isFailure _ = False --- | Update an instance to be smaller than a node +-- | Update an instance to be smaller than a node. setInstanceSmallerThanNode node inst = inst { Instance.mem = Node.availMem node `div` 2 , Instance.dsk = Node.availDisk node `div` 2 , Instance.vcpus = Node.availCpu node `div` 2 } --- | Create an instance given its spec +-- | Create an instance given its spec. createInstance mem dsk vcpus = - Instance.create "inst-unnamed" mem dsk vcpus "running" [] (-1) (-1) + Instance.create "inst-unnamed" mem dsk vcpus "running" [] True (-1) (-1) --- | Create a small cluster by repeating a node spec +-- | Create a small cluster by repeating a node spec. makeSmallCluster :: Node.Node -> Int -> Node.List makeSmallCluster node count = let fn = Node.buildPeers node Container.empty @@ -116,17 +119,17 @@ makeSmallCluster node count = (_, nlst) = Loader.assignIndices namelst in nlst --- | Checks if a node is "big" enough +-- | Checks if a node is "big" enough. isNodeBig :: Node.Node -> Int -> Bool isNodeBig node size = Node.availDisk node > size * Types.unitDsk && Node.availMem node > size * Types.unitMem && Node.availCpu node > size * Types.unitCpu -canBalance :: Cluster.Table -> Bool -> Bool -> Bool -canBalance tbl dm evac = isJust $ Cluster.tryBalance tbl dm evac 0 0 +canBalance :: Cluster.Table -> Bool -> Bool -> Bool -> Bool +canBalance tbl dm im evac = isJust $ Cluster.tryBalance tbl dm im evac 0 0 -- | Assigns a new fresh instance to a cluster; this is not --- allocation, so no resource checks are done +-- allocation, so no resource checks are done. assignInstance :: Node.List -> Instance.List -> Instance.Instance -> Types.Idx -> Types.Idx -> (Node.List, Instance.List) @@ -146,11 +149,9 @@ assignInstance nl il inst pdx sdx = -- * Arbitrary instances --- copied from the introduction to quickcheck -instance Arbitrary Char where - arbitrary = choose ('\32', '\128') - +-- | Defines a DNS name. newtype DNSChar = DNSChar { dnsGetChar::Char } + instance Arbitrary DNSChar where arbitrary = do x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-") @@ -177,31 +178,52 @@ instance Arbitrary Instance.Instance where name <- getFQDN mem <- choose (0, maxMem) dsk <- choose (0, maxDsk) - run_st <- elements ["ERROR_up", "ERROR_down", "ADMIN_down" - , "ERROR_nodedown", "ERROR_nodeoffline" - , "running" - , "no_such_status1", "no_such_status2"] + run_st <- elements [ C.inststErrorup + , C.inststErrordown + , C.inststAdmindown + , C.inststNodedown + , C.inststNodeoffline + , C.inststRunning + , "no_such_status1" + , "no_such_status2"] pn <- arbitrary sn <- arbitrary vcpus <- choose (0, maxCpu) - return $ Instance.create name mem dsk vcpus run_st [] pn sn + return $ Instance.create name mem dsk vcpus run_st [] True pn sn + +-- | Generas an arbitrary node based on sizing information. +genNode :: Maybe Int -- ^ Minimum node size in terms of units + -> Maybe Int -- ^ Maximum node size (when Nothing, bounded + -- just by the max... constants) + -> Gen Node.Node +genNode min_multiplier max_multiplier = do + let (base_mem, base_dsk, base_cpu) = + case min_multiplier of + Just mm -> (mm * Types.unitMem, + mm * Types.unitDsk, + mm * Types.unitCpu) + Nothing -> (0, 0, 0) + (top_mem, top_dsk, top_cpu) = + case max_multiplier of + Just mm -> (mm * Types.unitMem, + mm * Types.unitDsk, + mm * Types.unitCpu) + Nothing -> (maxMem, maxDsk, maxCpu) + name <- getFQDN + mem_t <- choose (base_mem, top_mem) + mem_f <- choose (base_mem, mem_t) + mem_n <- choose (0, mem_t - mem_f) + dsk_t <- choose (base_dsk, top_dsk) + dsk_f <- choose (base_dsk, dsk_t) + cpu_t <- choose (base_cpu, top_cpu) + offl <- arbitrary + let n = Node.create name (fromIntegral mem_t) mem_n mem_f + (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl 0 + return $ Node.buildPeers n Container.empty -- and a random node instance Arbitrary Node.Node where - arbitrary = do - name <- getFQDN - mem_t <- choose (0, maxMem) - mem_f <- choose (0, mem_t) - mem_n <- choose (0, mem_t - mem_f) - dsk_t <- choose (0, maxDsk) - dsk_f <- choose (0, dsk_t) - cpu_t <- choose (0, maxCpu) - offl <- arbitrary - let n = Node.create name (fromIntegral mem_t) mem_n mem_f - (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl - 0 - n' = Node.buildPeers n Container.empty - return n' + arbitrary = genNode Nothing Nothing -- replace disks instance Arbitrary OpCodes.ReplaceDisksMode where @@ -222,12 +244,13 @@ instance Arbitrary OpCodes.OpCode where "OP_TEST_DELAY" -> liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary "OP_INSTANCE_REPLACE_DISKS" -> - liftM5 OpCodes.OpReplaceDisks arbitrary arbitrary + liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary arbitrary arbitrary arbitrary "OP_INSTANCE_FAILOVER" -> - liftM2 OpCodes.OpFailoverInstance arbitrary arbitrary + liftM2 OpCodes.OpInstanceFailover arbitrary arbitrary "OP_INSTANCE_MIGRATE" -> - liftM3 OpCodes.OpMigrateInstance arbitrary arbitrary arbitrary + liftM4 OpCodes.OpInstanceMigrate arbitrary arbitrary arbitrary + arbitrary _ -> fail "Wrong opcode") instance Arbitrary Jobs.OpStatus where @@ -236,22 +259,46 @@ instance Arbitrary Jobs.OpStatus where instance Arbitrary Jobs.JobStatus where arbitrary = elements [minBound..maxBound] +newtype SmallRatio = SmallRatio Double deriving Show +instance Arbitrary SmallRatio where + arbitrary = do + v <- choose (0, 1) + return $ SmallRatio v + -- * Actual tests --- If the list is not just an empty element, and if the elements do --- not contain commas, then join+split should be idepotent -prop_Utils_commaJoinSplit lst = lst /= [""] && - all (not . elem ',') lst ==> - Utils.sepSplit ',' (Utils.commaJoin lst) == lst --- Split and join should always be idempotent +-- ** Utils tests + +-- | If the list is not just an empty element, and if the elements do +-- not contain commas, then join+split should be idempotent. +prop_Utils_commaJoinSplit = + forAll (arbitrary `suchThat` + (\l -> l /= [""] && all (not . elem ',') l )) $ \lst -> + Utils.sepSplit ',' (Utils.commaJoin lst) == lst + +-- | Split and join should always be idempotent. prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s +-- | fromObjWithDefault, we test using the Maybe monad and an integer +-- value. +prop_Utils_fromObjWithDefault def_value random_key = + -- a missing key will be returned with the default + Utils.fromObjWithDefault [] random_key def_value == Just def_value && + -- a found key will be returned as is, not with default + Utils.fromObjWithDefault [(random_key, J.showJSON def_value)] + random_key (def_value+1) == Just def_value + where _types = def_value :: Integer + +-- | Test list for the Utils module. testUtils = [ run prop_Utils_commaJoinSplit , run prop_Utils_commaSplitJoin + , run prop_Utils_fromObjWithDefault ] --- | Make sure add is idempotent +-- ** PeerMap tests + +-- | Make sure add is idempotent. prop_PeerMap_addIdempotent pmap key em = fn puniq == fn (fn puniq) where _types = (pmap::PeerMap.PeerMap, @@ -259,33 +306,34 @@ prop_PeerMap_addIdempotent pmap key em = fn = PeerMap.add key em puniq = PeerMap.accumArray const pmap --- | Make sure remove is idempotent +-- | Make sure remove is idempotent. prop_PeerMap_removeIdempotent pmap key = fn puniq == fn (fn puniq) where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key) fn = PeerMap.remove key puniq = PeerMap.accumArray const pmap --- | Make sure a missing item returns 0 +-- | Make sure a missing item returns 0. prop_PeerMap_findMissing pmap key = PeerMap.find key (PeerMap.remove key puniq) == 0 where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key) puniq = PeerMap.accumArray const pmap --- | Make sure an added item is found +-- | Make sure an added item is found. prop_PeerMap_addFind pmap key em = PeerMap.find key (PeerMap.add key em puniq) == em where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key, em::PeerMap.Elem) puniq = PeerMap.accumArray const pmap --- | Manual check that maxElem returns the maximum indeed, or 0 for null +-- | Manual check that maxElem returns the maximum indeed, or 0 for null. prop_PeerMap_maxElem pmap = PeerMap.maxElem puniq == if null puniq then 0 else (maximum . snd . unzip) puniq where _types = pmap::PeerMap.PeerMap puniq = PeerMap.accumArray const pmap +-- | List of tests for the PeerMap module. testPeerMap = [ run prop_PeerMap_addIdempotent , run prop_PeerMap_removeIdempotent @@ -294,7 +342,7 @@ testPeerMap = , run prop_PeerMap_findMissing ] --- Container tests +-- ** Container tests prop_Container_addTwo cdata i1 i2 = fn i1 i2 cont == fn i2 i1 cont && @@ -309,9 +357,9 @@ prop_Container_nameOf node = fnode = head (Container.elems nl) in Container.nameOf nl (Node.idx fnode) == Node.name fnode --- We test that in a cluster, given a random node, we can find it by +-- | We test that in a cluster, given a random node, we can find it by -- its name and alias, as long as all names and aliases are unique, --- and that we fail to find a non-existing name +-- and that we fail to find a non-existing name. prop_Container_findByName node othername = forAll (choose (1, 20)) $ \ cnt -> forAll (choose (0, cnt - 1)) $ \ fidx -> @@ -337,6 +385,8 @@ testContainer = , run prop_Container_findByName ] +-- ** Instance tests + -- Simple instance tests, we only have setter/getters prop_Instance_creat inst = @@ -371,11 +421,10 @@ prop_Instance_setBoth inst pdx sdx = where _types = (inst::Instance.Instance, pdx::Types.Ndx, sdx::Types.Ndx) si = Instance.setBoth inst pdx sdx -prop_Instance_runStatus_True inst = - let run_st = Instance.running inst - run_tx = Instance.runSt inst - in - run_tx `elem` Instance.runningStates ==> run_st +prop_Instance_runStatus_True = + forAll (arbitrary `suchThat` + ((`elem` Instance.runningStates) . Instance.runSt)) + Instance.running prop_Instance_runStatus_False inst = let run_st = Instance.running inst @@ -391,8 +440,9 @@ prop_Instance_shrinkMG inst = _ -> False prop_Instance_shrinkMF inst = - Instance.mem inst < 2 * Types.unitMem ==> - Types.isBad $ Instance.shrinkByType inst Types.FailMem + forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem -> + let inst' = inst { Instance.mem = mem} + in Types.isBad $ Instance.shrinkByType inst' Types.FailMem prop_Instance_shrinkCG inst = Instance.vcpus inst >= 2 * Types.unitCpu ==> @@ -402,8 +452,9 @@ prop_Instance_shrinkCG inst = _ -> False prop_Instance_shrinkCF inst = - Instance.vcpus inst < 2 * Types.unitCpu ==> - Types.isBad $ Instance.shrinkByType inst Types.FailCPU + forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus -> + let inst' = inst { Instance.vcpus = vcpus } + in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU prop_Instance_shrinkDG inst = Instance.dsk inst >= 2 * Types.unitDsk ==> @@ -413,8 +464,9 @@ prop_Instance_shrinkDG inst = _ -> False prop_Instance_shrinkDF inst = - Instance.dsk inst < 2 * Types.unitDsk ==> - Types.isBad $ Instance.shrinkByType inst Types.FailDisk + forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk -> + let inst' = inst { Instance.dsk = dsk } + in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk prop_Instance_setMovable inst m = Instance.movable inst' == m @@ -439,46 +491,52 @@ testInstance = , run prop_Instance_setMovable ] +-- ** Text backend tests + -- Instance text loader tests -prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx = - not (null pnode) && pdx >= 0 && sdx >= 0 ==> +prop_Text_Load_Instance name mem dsk vcpus status + (NonEmpty pnode) snode + (NonNegative pdx) (NonNegative sdx) autobal = + pnode /= snode && pdx /= sdx ==> let vcpus_s = show vcpus dsk_s = show dsk mem_s = show mem - rsdx = if pdx == sdx - then sdx + 1 - else sdx ndx = if null snode then [(pnode, pdx)] - else [(pnode, pdx), (snode, rsdx)] + else [(pnode, pdx), (snode, sdx)] nl = Data.Map.fromList ndx tags = "" + sbal = if autobal then "Y" else "N" inst = Text.loadInst nl - [name, mem_s, dsk_s, vcpus_s, status, pnode, snode, tags]:: - Maybe (String, Instance.Instance) + [name, mem_s, dsk_s, vcpus_s, status, + sbal, pnode, snode, tags]:: Maybe (String, Instance.Instance) fail1 = Text.loadInst nl - [name, mem_s, dsk_s, vcpus_s, status, pnode, pnode, tags]:: - Maybe (String, Instance.Instance) + [name, mem_s, dsk_s, vcpus_s, status, + sbal, pnode, pnode, tags]:: Maybe (String, Instance.Instance) _types = ( name::String, mem::Int, dsk::Int , vcpus::Int, status::String - , pnode::String, snode::String - , pdx::Types.Ndx, sdx::Types.Ndx) + , snode::String + , autobal::Bool) in case inst of Nothing -> False Just (_, i) -> - (Instance.name i == name && - Instance.vcpus i == vcpus && - Instance.mem i == mem && - Instance.pNode i == pdx && - Instance.sNode i == (if null snode - then Node.noSecondary - else rsdx) && - isNothing fail1) + Instance.name i == name && + Instance.vcpus i == vcpus && + Instance.mem i == mem && + Instance.pNode i == pdx && + Instance.sNode i == (if null snode + then Node.noSecondary + else sdx) && + Instance.auto_balance i == autobal && + isNothing fail1 prop_Text_Load_InstanceFail ktn fields = - length fields /= 8 ==> isNothing $ Text.loadInst nl fields + length fields /= 9 ==> + case Text.loadInst nl fields of + Types.Ok _ -> False + Types.Bad msg -> "Invalid/incomplete instance data: '" `isPrefixOf` msg where nl = Data.Map.fromList ktn prop_Text_Load_Node name tm nm fm td fd tc fo = @@ -529,7 +587,7 @@ testText = , run prop_Text_NodeLSIdempotent ] --- Node tests +-- ** Node tests prop_Node_setAlias node name = Node.name newnode == Node.name node && @@ -549,7 +607,8 @@ prop_Node_setMcpu node mc = Node.mCpu newnode == mc where newnode = Node.setMcpu node mc --- | Check that an instance add with too high memory or disk will be rejected +-- | Check that an instance add with too high memory or disk will be +-- rejected. prop_Node_addPriFM node inst = Instance.mem inst >= Node.fMem node && not (Node.failN1 node) ==> @@ -570,17 +629,17 @@ prop_Node_addPriFD node inst = Instance.dsk inst >= Node.fDsk node && inst' = setInstanceSmallerThanNode node inst inst'' = inst' { Instance.dsk = Instance.dsk inst } -prop_Node_addPriFC node inst = Instance.vcpus inst > Node.availCpu node && - not (Node.failN1 node) - ==> - case Node.addPri node inst'' of - Types.OpFail Types.FailCPU -> True - _ -> False +prop_Node_addPriFC node inst (Positive extra) = + not (Node.failN1 node) ==> + case Node.addPri node inst'' of + Types.OpFail Types.FailCPU -> True + _ -> False where _types = (node::Node.Node, inst::Instance.Instance) inst' = setInstanceSmallerThanNode node inst - inst'' = inst' { Instance.vcpus = Instance.vcpus inst } + inst'' = inst' { Instance.vcpus = Node.availCpu node + extra } --- | Check that an instance add with too high memory or disk will be rejected +-- | Check that an instance add with too high memory or disk will be +-- rejected. prop_Node_addSec node inst pdx = (Instance.mem inst >= (Node.fMem node - Node.rMem node) || Instance.dsk inst >= Node.fDsk node) && @@ -588,13 +647,39 @@ prop_Node_addSec node inst pdx = ==> isFailure (Node.addSec node inst pdx) where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int) -newtype SmallRatio = SmallRatio Double deriving Show -instance Arbitrary SmallRatio where - arbitrary = do - v <- choose (0, 1) - return $ SmallRatio v - --- | Check mdsk setting +-- | Checks for memory reservation changes. +prop_Node_rMem inst = + forAll (arbitrary `suchThat` ((> 0) . Node.fMem)) $ \node -> + -- ab = auto_balance, nb = non-auto_balance + -- we use -1 as the primary node of the instance + let inst' = inst { Instance.pNode = -1, Instance.auto_balance = True } + inst_ab = setInstanceSmallerThanNode node inst' + inst_nb = inst_ab { Instance.auto_balance = False } + -- now we have the two instances, identical except the + -- auto_balance attribute + orig_rmem = Node.rMem node + inst_idx = Instance.idx inst_ab + node_add_ab = Node.addSec node inst_ab (-1) + node_add_nb = Node.addSec node inst_nb (-1) + node_del_ab = liftM (flip Node.removeSec inst_ab) node_add_ab + node_del_nb = liftM (flip Node.removeSec inst_nb) node_add_nb + in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of + (Types.OpGood a_ab, Types.OpGood a_nb, + Types.OpGood d_ab, Types.OpGood d_nb) -> + printTestCase "Consistency checks failed" $ + Node.rMem a_ab > orig_rmem && + Node.rMem a_ab - orig_rmem == Instance.mem inst_ab && + Node.rMem a_nb == orig_rmem && + Node.rMem d_ab == orig_rmem && + Node.rMem d_nb == orig_rmem && + -- this is not related to rMem, but as good a place to + -- test as any + inst_idx `elem` Node.sList a_ab && + not (inst_idx `elem` Node.sList d_ab) + x -> printTestCase ("Failed to add/remove instances: " ++ show x) + False + +-- | Check mdsk setting. prop_Node_setMdsk node mx = Node.loDsk node' >= 0 && fromIntegral (Node.loDsk node') <= Node.tDsk node && @@ -628,7 +713,7 @@ prop_Node_computeGroups nodes = in length nodes == sum (map (length . snd) ng) && all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng && length (nub onlyuuid) == length onlyuuid && - if null nodes then True else not (null ng) + (null nodes || not (null ng)) testNode = [ run prop_Node_setAlias @@ -639,6 +724,7 @@ testNode = , run prop_Node_addPriFD , run prop_Node_addPriFC , run prop_Node_addSec + , run prop_Node_rMem , run prop_Node_setMdsk , run prop_Node_tagMaps_idempotent , run prop_Node_tagMaps_reject @@ -647,10 +733,12 @@ testNode = ] --- Cluster tests +-- ** Cluster tests --- | Check that the cluster score is close to zero for a homogeneous cluster -prop_Score_Zero node count = +-- | Check that the cluster score is close to zero for a homogeneous +-- cluster. +prop_Score_Zero node = + forAll (choose (1, 1024)) $ \count -> (not (Node.offline node) && not (Node.failN1 node) && (count > 0) && (Node.tDsk node > 0) && (Node.tMem node > 0)) ==> let fn = Node.buildPeers node Container.empty @@ -659,11 +747,12 @@ prop_Score_Zero node count = score = Cluster.compCV nl -- we can't say == 0 here as the floating point errors accumulate; -- this should be much lower than the default score in CLI.hs - in score <= 1e-15 + in score <= 1e-12 --- | Check that cluster stats are sane -prop_CStats_sane node count = - (not (Node.offline node) && not (Node.failN1 node) && (count > 0) && +-- | Check that cluster stats are sane. +prop_CStats_sane node = + forAll (choose (1, 1024)) $ \count -> + (not (Node.offline node) && not (Node.failN1 node) && (Node.availDisk node > 0) && (Node.availMem node > 0)) ==> let fn = Node.buildPeers node Container.empty nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)] @@ -673,7 +762,7 @@ prop_CStats_sane node count = Cluster.csAdsk cstats <= Cluster.csFdsk cstats -- | Check that one instance is allocated correctly, without --- rebalances needed +-- rebalances needed. prop_ClusterAlloc_sane node inst = forAll (choose (5, 20)) $ \count -> not (Node.offline node) @@ -693,12 +782,12 @@ prop_ClusterAlloc_sane node inst = (xnl, xi, _, cv):[] -> let il' = Container.add (Instance.idx xi) xi il tbl = Cluster.Table xnl il' cv [] - in not (canBalance tbl True False) + in not (canBalance tbl True True False) _ -> False -- | Checks that on a 2-5 node cluster, we can allocate a random -- instance spec via tiered allocation (whatever the original instance --- spec), on either one or two nodes +-- spec), on either one or two nodes. prop_ClusterCanTieredAlloc node inst = forAll (choose (2, 5)) $ \count -> forAll (choose (1, 2)) $ \rqnodes -> @@ -717,7 +806,7 @@ prop_ClusterCanTieredAlloc node inst = length ixes == length cstats -- | Checks that on a 4-8 node cluster, once we allocate an instance, --- we can also evacuate it +-- we can also evacuate it. prop_ClusterAllocEvac node inst = forAll (choose (4, 8)) $ \count -> not (Node.offline node) @@ -742,14 +831,11 @@ prop_ClusterAllocEvac node inst = _ -> False -- | Check that allocating multiple instances on a cluster, then --- adding an empty node, results in a valid rebalance -prop_ClusterAllocBalance node = +-- adding an empty node, results in a valid rebalance. +prop_ClusterAllocBalance = + forAll (genNode (Just 5) (Just 128)) $ \node -> forAll (choose (3, 5)) $ \count -> - not (Node.offline node) - && not (Node.failN1 node) - && isNodeBig node 4 - && not (isNodeBig node 8) - ==> + not (Node.offline node) && not (Node.failN1 node) ==> let nl = makeSmallCluster node count (hnode, nl') = IntMap.deleteFindMax nl il = Container.empty @@ -762,9 +848,9 @@ prop_ClusterAllocBalance node = let ynl = Container.add (Node.idx hnode) hnode xnl cv = Cluster.compCV ynl tbl = Cluster.Table ynl il' cv [] - in canBalance tbl True False + in canBalance tbl True True False --- | Checks consistency +-- | Checks consistency. prop_ClusterCheckConsistency node inst = let nl = makeSmallCluster node 3 [node1, node2, node3] = Container.elems nl @@ -778,7 +864,7 @@ prop_ClusterCheckConsistency node inst = null (ccheck [(0, inst2)]) && (not . null $ ccheck [(0, inst3)]) --- For now, we only test that we don't lose instances during the split +-- | For now, we only test that we don't lose instances during the split. prop_ClusterSplitCluster node inst = forAll (choose (0, 100)) $ \icnt -> let nl = makeSmallCluster node 2 @@ -800,8 +886,9 @@ testCluster = , run prop_ClusterSplitCluster ] --- | Check that opcode serialization is idempotent +-- ** OpCodes tests +-- | Check that opcode serialization is idempotent. prop_OpCodes_serialization op = case J.readJSON (J.showJSON op) of J.Error _ -> False @@ -812,7 +899,9 @@ testOpCodes = [ run prop_OpCodes_serialization ] --- | Check that (queued) job\/opcode status serialization is idempotent +-- ** Jobs tests + +-- | Check that (queued) job\/opcode status serialization is idempotent. prop_OpStatus_serialization os = case J.readJSON (J.showJSON os) of J.Error _ -> False @@ -830,7 +919,7 @@ testJobs = , run prop_JobStatus_serialization ] --- | Loader tests +-- ** Loader tests prop_Loader_lookupNode ktn inst node = Loader.lookupNode nl inst node == Data.Map.lookup node nl @@ -848,12 +937,11 @@ prop_Loader_assignIndices nodes = else True) where (nassoc, kt) = Loader.assignIndices (map (\n -> (Node.name n, n)) nodes) - -- | Checks that the number of primary instances recorded on the nodes --- is zero +-- is zero. prop_Loader_mergeData ns = let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns - in case Loader.mergeData [] [] [] + in case Loader.mergeData [] [] [] [] (Loader.emptyCluster {Loader.cdNodes = na}) of Types.Bad _ -> False Types.Ok (Loader.ClusterData _ nl il _) ->