X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/fbb95f28346ff0d7eb0c1ac54b13a908209e07b7..7d3f42530a2e1cdd6ec09a6098402c7e05fc3bdf:/Ganeti/HTools/QC.hs diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs index bb5b455..f411a8e 100644 --- a/Ganeti/HTools/QC.hs +++ b/Ganeti/HTools/QC.hs @@ -4,7 +4,7 @@ {- -Copyright (C) 2009 Google Inc. +Copyright (C) 2009, 2010 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -24,69 +24,221 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} module Ganeti.HTools.QC - ( test_PeerMap - , test_Container - , test_Instance - , test_Node - , test_Text - , test_Cluster + ( testUtils + , testPeerMap + , testContainer + , testInstance + , testNode + , testText + , testOpCodes + , testJobs + , testCluster + , testLoader ) where import Test.QuickCheck import Test.QuickCheck.Batch +import Data.List (findIndex, intercalate, nub) import Data.Maybe +import Control.Monad +import qualified Text.JSON as J +import qualified Data.Map +import qualified Data.IntMap as IntMap +import qualified Ganeti.OpCodes as OpCodes +import qualified Ganeti.Jobs as Jobs +import qualified Ganeti.Luxi import qualified Ganeti.HTools.CLI as CLI import qualified Ganeti.HTools.Cluster as Cluster import qualified Ganeti.HTools.Container as Container +import qualified Ganeti.HTools.ExtLoader import qualified Ganeti.HTools.IAlloc as IAlloc import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Loader as Loader +import qualified Ganeti.HTools.Luxi import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.PeerMap as PeerMap +import qualified Ganeti.HTools.Rapi +import qualified Ganeti.HTools.Simu 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 + +-- * Constants + +-- | Maximum memory (1TiB, somewhat random value) +maxMem :: Int +maxMem = 1024 * 1024 + +-- | Maximum disk (8TiB, somewhat random value) +maxDsk :: Int +maxDsk = 1024 * 1024 * 8 + +-- | Max CPUs (1024, somewhat random value) +maxCpu :: Int +maxCpu = 1024 + +-- * Helper functions -- | 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 +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 +createInstance mem dsk vcpus = + Instance.create "inst-unnamed" mem dsk vcpus "running" [] (-1) (-1) + +-- | 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 + namelst = map (\n -> (Node.name n, n)) (replicate count fn) + (_, nlst) = Loader.assignIndices namelst + in nlst + +-- | 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 + +-- | Assigns a new fresh instance to a cluster; this is not +-- allocation, so no resource checks are done +assignInstance :: Node.List -> Instance.List -> Instance.Instance -> + Types.Idx -> Types.Idx -> + (Node.List, Instance.List) +assignInstance nl il inst pdx sdx = + let pnode = Container.find pdx nl + snode = Container.find sdx nl + maxiidx = if Container.null il + then 0 + else fst (Container.findMax il) + 1 + inst' = inst { Instance.idx = maxiidx, + Instance.pNode = pdx, Instance.sNode = sdx } + pnode' = Node.setPri pnode inst' + snode' = Node.setSec snode inst' + nl' = Container.addTwo pdx pnode' sdx snode' nl + il' = Container.add maxiidx inst' il + in (nl', il') + +-- * Arbitrary instances + -- copied from the introduction to quickcheck instance Arbitrary Char where arbitrary = choose ('\32', '\128') +newtype DNSChar = DNSChar { dnsGetChar::Char } +instance Arbitrary DNSChar where + arbitrary = do + x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-") + return (DNSChar x) + +getName :: Gen String +getName = do + n <- choose (1, 64) + dn <- vector n::Gen [DNSChar] + return (map dnsGetChar dn) + + +getFQDN :: Gen String +getFQDN = do + felem <- getName + ncomps <- choose (1, 4) + frest <- vector ncomps::Gen [[DNSChar]] + let frest' = map (map dnsGetChar) frest + return (felem ++ "." ++ intercalate "." frest') + -- let's generate a random instance instance Arbitrary Instance.Instance where arbitrary = do - name <- arbitrary - mem <- choose(0, 100) - dsk <- choose(0, 100) + 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"] pn <- arbitrary sn <- arbitrary - vcpus <- arbitrary - return $ Instance.create name mem dsk vcpus run_st pn sn + vcpus <- choose (0, maxCpu) + return $ Instance.create name mem dsk vcpus run_st [] pn sn -- and a random node instance Arbitrary Node.Node where arbitrary = do - name <- arbitrary - mem_t <- arbitrary + name <- getFQDN + mem_t <- choose (0, maxMem) mem_f <- choose (0, mem_t) mem_n <- choose (0, mem_t - mem_f) - dsk_t <- arbitrary + dsk_t <- choose (0, maxDsk) dsk_f <- choose (0, dsk_t) - cpu_t <- arbitrary + cpu_t <- choose (0, maxCpu) offl <- arbitrary let n = Node.create name (fromIntegral mem_t) mem_n mem_f - (fromIntegral dsk_t) dsk_f cpu_t offl + (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl + Utils.defaultGroupID n' = Node.buildPeers n Container.empty return n' +-- replace disks +instance Arbitrary OpCodes.ReplaceDisksMode where + arbitrary = elements [ OpCodes.ReplaceOnPrimary + , OpCodes.ReplaceOnSecondary + , OpCodes.ReplaceNewSecondary + , OpCodes.ReplaceAuto + ] + +instance Arbitrary OpCodes.OpCode where + arbitrary = do + op_id <- elements [ "OP_TEST_DELAY" + , "OP_INSTANCE_REPLACE_DISKS" + , "OP_INSTANCE_FAILOVER" + , "OP_INSTANCE_MIGRATE" + ] + (case op_id of + "OP_TEST_DELAY" -> + liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary + "OP_INSTANCE_REPLACE_DISKS" -> + liftM5 OpCodes.OpReplaceDisks arbitrary arbitrary + arbitrary arbitrary arbitrary + "OP_INSTANCE_FAILOVER" -> + liftM2 OpCodes.OpFailoverInstance arbitrary arbitrary + "OP_INSTANCE_MIGRATE" -> + liftM3 OpCodes.OpMigrateInstance arbitrary arbitrary arbitrary + _ -> fail "Wrong opcode") + +instance Arbitrary Jobs.OpStatus where + arbitrary = elements [minBound..maxBound] + +instance Arbitrary Jobs.JobStatus where + arbitrary = elements [minBound..maxBound] + +-- * 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 +prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s + +testUtils = + [ run prop_Utils_commaJoinSplit + , run prop_Utils_commaSplitJoin + ] + -- | Make sure add is idempotent prop_PeerMap_addIdempotent pmap key em = fn puniq == fn (fn puniq) @@ -122,7 +274,7 @@ prop_PeerMap_maxElem pmap = where _types = pmap::PeerMap.PeerMap puniq = PeerMap.accumArray const pmap -test_PeerMap = +testPeerMap = [ run prop_PeerMap_addIdempotent , run prop_PeerMap_removeIdempotent , run prop_PeerMap_maxElem @@ -140,67 +292,161 @@ prop_Container_addTwo cdata i1 i2 = cont = foldl (\c x -> Container.add x x c) Container.empty cdata fn x1 x2 = Container.addTwo x1 x1 x2 x2 -test_Container = - [ run prop_Container_addTwo ] +prop_Container_nameOf node = + let nl = makeSmallCluster node 1 + 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 +-- its name and alias, as long as all names and aliases are unique, +-- 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 -> + forAll (vector cnt) $ \ names -> + (length . nub) (map fst names ++ map snd names) == + length names * 2 && + not (othername `elem` (map fst names ++ map snd names)) ==> + let nl = makeSmallCluster node cnt + nodes = Container.elems nl + nodes' = map (\((name, alias), nn) -> (Node.idx nn, + nn { Node.name = name, + Node.alias = alias })) + $ zip names nodes + nl' = Container.fromAssocList nodes' + target = snd (nodes' !! fidx) + in Container.findByName nl' (Node.name target) == Just target && + Container.findByName nl' (Node.alias target) == Just target && + Container.findByName nl' othername == Nothing + +testContainer = + [ run prop_Container_addTwo + , run prop_Container_nameOf + , run prop_Container_findByName + ] -- Simple instance tests, we only have setter/getters +prop_Instance_creat inst = + Instance.name inst == Instance.alias inst + prop_Instance_setIdx inst idx = Instance.idx (Instance.setIdx inst idx) == idx where _types = (inst::Instance.Instance, idx::Types.Idx) prop_Instance_setName inst name = - Instance.name (Instance.setName inst name) == name + Instance.name newinst == name && + Instance.alias newinst == name where _types = (inst::Instance.Instance, name::String) + newinst = Instance.setName inst name + +prop_Instance_setAlias inst name = + Instance.name newinst == Instance.name inst && + Instance.alias newinst == name + where _types = (inst::Instance.Instance, name::String) + newinst = Instance.setAlias inst name prop_Instance_setPri inst pdx = - Instance.pnode (Instance.setPri inst pdx) == pdx + Instance.pNode (Instance.setPri inst pdx) == pdx where _types = (inst::Instance.Instance, pdx::Types.Ndx) prop_Instance_setSec inst sdx = - Instance.snode (Instance.setSec inst sdx) == sdx + Instance.sNode (Instance.setSec inst sdx) == sdx where _types = (inst::Instance.Instance, sdx::Types.Ndx) prop_Instance_setBoth inst pdx sdx = - Instance.pnode si == pdx && Instance.snode si == sdx + Instance.pNode si == pdx && Instance.sNode si == 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.run_st inst + run_tx = Instance.runSt inst in - run_tx == "running" || run_tx == "ERROR_up" ==> run_st == True + run_tx `elem` Instance.runningStates ==> run_st prop_Instance_runStatus_False inst = let run_st = Instance.running inst - run_tx = Instance.run_st inst + run_tx = Instance.runSt inst in - run_tx /= "running" && run_tx /= "ERROR_up" ==> run_st == False - -test_Instance = - [ run prop_Instance_setIdx + run_tx `notElem` Instance.runningStates ==> not run_st + +prop_Instance_shrinkMG inst = + Instance.mem inst >= 2 * Types.unitMem ==> + case Instance.shrinkByType inst Types.FailMem of + Types.Ok inst' -> + Instance.mem inst' == Instance.mem inst - Types.unitMem + _ -> False + +prop_Instance_shrinkMF inst = + Instance.mem inst < 2 * Types.unitMem ==> + Types.isBad $ Instance.shrinkByType inst Types.FailMem + +prop_Instance_shrinkCG inst = + Instance.vcpus inst >= 2 * Types.unitCpu ==> + case Instance.shrinkByType inst Types.FailCPU of + Types.Ok inst' -> + Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu + _ -> False + +prop_Instance_shrinkCF inst = + Instance.vcpus inst < 2 * Types.unitCpu ==> + Types.isBad $ Instance.shrinkByType inst Types.FailCPU + +prop_Instance_shrinkDG inst = + Instance.dsk inst >= 2 * Types.unitDsk ==> + case Instance.shrinkByType inst Types.FailDisk of + Types.Ok inst' -> + Instance.dsk inst' == Instance.dsk inst - Types.unitDsk + _ -> False + +prop_Instance_shrinkDF inst = + Instance.dsk inst < 2 * Types.unitDsk ==> + Types.isBad $ Instance.shrinkByType inst Types.FailDisk + +prop_Instance_setMovable inst m = + Instance.movable inst' == m + where inst' = Instance.setMovable inst m + +testInstance = + [ run prop_Instance_creat + , run prop_Instance_setIdx , run prop_Instance_setName + , run prop_Instance_setAlias , run prop_Instance_setPri , run prop_Instance_setSec , run prop_Instance_setBoth , run prop_Instance_runStatus_True , run prop_Instance_runStatus_False + , run prop_Instance_shrinkMG + , run prop_Instance_shrinkMF + , run prop_Instance_shrinkCG + , run prop_Instance_shrinkCF + , run prop_Instance_shrinkDG + , run prop_Instance_shrinkDF + , run prop_Instance_setMovable ] -- Instance text loader tests prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx = + not (null pnode) && pdx >= 0 && sdx >= 0 ==> let vcpus_s = show vcpus dsk_s = show dsk mem_s = show mem - rsnode = snode ++ "a" -- non-empty secondary node rsdx = if pdx == sdx then sdx + 1 else sdx - ndx = [(pnode, pdx), (rsnode, rsdx)] - inst = Text.loadInst ndx - (name:mem_s:dsk_s:vcpus_s:status:pnode:rsnode:[]):: + ndx = if null snode + then [(pnode, pdx)] + else [(pnode, pdx), (snode, rsdx)] + nl = Data.Map.fromList ndx + tags = "" + inst = Text.loadInst nl + [name, mem_s, dsk_s, vcpus_s, status, 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) _types = ( name::String, mem::Int, dsk::Int , vcpus::Int, status::String @@ -213,35 +459,177 @@ prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx = (Instance.name i == name && Instance.vcpus i == vcpus && Instance.mem i == mem && - Instance.pnode i == pdx && - Instance.snode i == rsdx) - -test_Text = + Instance.pNode i == pdx && + Instance.sNode i == (if null snode + then Node.noSecondary + else rsdx) && + isNothing fail1) + +prop_Text_Load_InstanceFail ktn fields = + length fields /= 8 ==> isNothing $ Text.loadInst nl fields + where nl = Data.Map.fromList ktn + +prop_Text_Load_Node name tm nm fm td fd tc fo = + let conv v = if v < 0 + then "?" + else show v + tm_s = conv tm + nm_s = conv nm + fm_s = conv fm + td_s = conv td + fd_s = conv fd + tc_s = conv tc + fo_s = if fo + then "Y" + else "N" + any_broken = any (< 0) [tm, nm, fm, td, fd, tc] + in case Text.loadNode [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s] of + Nothing -> False + Just (name', node) -> + if fo || any_broken + then Node.offline node + else Node.name node == name' && name' == name && + Node.alias node == name && + Node.tMem node == fromIntegral tm && + Node.nMem node == nm && + Node.fMem node == fm && + Node.tDsk node == fromIntegral td && + Node.fDsk node == fd && + Node.tCpu node == fromIntegral tc + +prop_Text_Load_NodeFail fields = + length fields /= 8 ==> isNothing $ Text.loadNode fields + +prop_Text_NodeLSIdempotent node = + (Text.loadNode . + Utils.sepSplit '|' . Text.serializeNode) n == + Just (Node.name n, n) + -- override failN1 to what loadNode returns by default + where n = node { Node.failN1 = True, Node.offline = False } + +testText = [ run prop_Text_Load_Instance + , run prop_Text_Load_InstanceFail + , run prop_Text_Load_Node + , run prop_Text_Load_NodeFail + , run prop_Text_NodeLSIdempotent ] -- Node tests +prop_Node_setAlias node name = + Node.name newnode == Node.name node && + Node.alias newnode == name + where _types = (node::Node.Node, name::String) + newnode = Node.setAlias node name + +prop_Node_setOffline node status = + Node.offline newnode == status + where newnode = Node.setOffline node status + +prop_Node_setXmem node xm = + Node.xMem newnode == xm + where newnode = Node.setXmem node xm + +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 -prop_Node_addPri node inst = (Instance.mem inst >= Node.f_mem node || - Instance.dsk inst >= Node.f_dsk node) && - not (Node.failN1 node) - ==> - isFailure (Node.addPri node inst) +prop_Node_addPriFM node inst = Instance.mem inst >= Node.fMem node && + not (Node.failN1 node) + ==> + case Node.addPri node inst'' of + Types.OpFail Types.FailMem -> True + _ -> False where _types = (node::Node.Node, inst::Instance.Instance) - + inst' = setInstanceSmallerThanNode node inst + inst'' = inst' { Instance.mem = Instance.mem inst } + +prop_Node_addPriFD node inst = Instance.dsk inst >= Node.fDsk node && + not (Node.failN1 node) + ==> + case Node.addPri node inst'' of + Types.OpFail Types.FailDisk -> True + _ -> False + where _types = (node::Node.Node, inst::Instance.Instance) + 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 + where _types = (node::Node.Node, inst::Instance.Instance) + inst' = setInstanceSmallerThanNode node inst + inst'' = inst' { Instance.vcpus = Instance.vcpus inst } -- | Check that an instance add with too high memory or disk will be rejected prop_Node_addSec node inst pdx = - (Instance.mem inst >= (Node.f_mem node - Node.r_mem node) || - Instance.dsk inst >= Node.f_dsk node) && + (Instance.mem inst >= (Node.fMem node - Node.rMem node) || + Instance.dsk inst >= Node.fDsk node) && not (Node.failN1 node) ==> isFailure (Node.addSec node inst pdx) where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int) -test_Node = - [ run prop_Node_addPri +newtype SmallRatio = SmallRatio Double deriving Show +instance Arbitrary SmallRatio where + arbitrary = do + v <- choose (0, 1) + return $ SmallRatio v + +-- | Check mdsk setting +prop_Node_setMdsk node mx = + Node.loDsk node' >= 0 && + fromIntegral (Node.loDsk node') <= Node.tDsk node && + Node.availDisk node' >= 0 && + Node.availDisk node' <= Node.fDsk node' && + fromIntegral (Node.availDisk node') <= Node.tDsk node' && + Node.mDsk node' == mx' + where _types = (node::Node.Node, mx::SmallRatio) + node' = Node.setMdsk node mx' + SmallRatio mx' = mx + +-- Check tag maps +prop_Node_tagMaps_idempotent tags = + Node.delTags (Node.addTags m tags) tags == m + where m = Data.Map.empty + +prop_Node_tagMaps_reject tags = + not (null tags) ==> + any (\t -> Node.rejectAddTags m [t]) tags + where m = Node.addTags Data.Map.empty tags + +prop_Node_showField node = + forAll (elements Node.defaultFields) $ \ field -> + fst (Node.showHeader field) /= Types.unknownField && + Node.showField node field /= Types.unknownField + + +prop_Node_computeGroups nodes = + let ng = Node.computeGroups nodes + onlyuuid = map fst ng + 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) + +testNode = + [ run prop_Node_setAlias + , run prop_Node_setOffline + , run prop_Node_setMcpu + , run prop_Node_setXmem + , run prop_Node_addPriFM + , run prop_Node_addPriFD + , run prop_Node_addPriFC , run prop_Node_addSec + , run prop_Node_setMdsk + , run prop_Node_tagMaps_idempotent + , run prop_Node_tagMaps_reject + , run prop_Node_showField + , run prop_Node_computeGroups ] @@ -249,16 +637,215 @@ test_Node = -- | Check that the cluster score is close to zero for a homogeneous cluster prop_Score_Zero node count = - ((not $ Node.offline node) && (not $ Node.failN1 node) && (count > 0) && - (Node.t_dsk node > 0) && (Node.t_mem node > 0)) ==> + (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 - nlst = (zip [1..] $ replicate count fn)::[(Types.Ndx, Node.Node)] + nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)] nl = Container.fromAssocList nlst 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 -test_Cluster = +-- | Check that cluster stats are sane +prop_CStats_sane node count = + (not (Node.offline node) && not (Node.failN1 node) && (count > 0) && + (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)] + nl = Container.fromAssocList nlst + cstats = Cluster.totalResources nl + in Cluster.csAdsk cstats >= 0 && + Cluster.csAdsk cstats <= Cluster.csFdsk cstats + +-- | Check that one instance is allocated correctly, without +-- rebalances needed +prop_ClusterAlloc_sane node inst = + forAll (choose (5, 20)) $ \count -> + not (Node.offline node) + && not (Node.failN1 node) + && Node.availDisk node > 0 + && Node.availMem node > 0 + ==> + let nl = makeSmallCluster node count + il = Container.empty + rqnodes = 2 + inst' = setInstanceSmallerThanNode node inst + in case Cluster.tryAlloc nl il inst' rqnodes of + Types.Bad _ -> False + Types.Ok (_, _, sols3) -> + case sols3 of + [] -> False + (_, (xnl, xi, _, cv)):[] -> + let il' = Container.add (Instance.idx xi) xi il + tbl = Cluster.Table xnl il' cv [] + in not (canBalance tbl 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 +prop_ClusterCanTieredAlloc node inst = + forAll (choose (2, 5)) $ \count -> + forAll (choose (1, 2)) $ \rqnodes -> + not (Node.offline node) + && not (Node.failN1 node) + && isNodeBig node 4 + ==> + let nl = makeSmallCluster node count + il = Container.empty + in case Cluster.tieredAlloc nl il inst rqnodes [] of + Types.Bad _ -> False + Types.Ok (_, _, il', ixes) -> not (null ixes) && + IntMap.size il' == length ixes + +-- | Checks that on a 4-8 node cluster, once we allocate an instance, +-- we can also evacuate it +prop_ClusterAllocEvac node inst = + forAll (choose (4, 8)) $ \count -> + not (Node.offline node) + && not (Node.failN1 node) + && isNodeBig node 4 + ==> + let nl = makeSmallCluster node count + il = Container.empty + rqnodes = 2 + inst' = setInstanceSmallerThanNode node inst + in case Cluster.tryAlloc nl il inst' rqnodes of + Types.Bad _ -> False + Types.Ok (_, _, sols3) -> + case sols3 of + [] -> False + (_, (xnl, xi, _, _)):[] -> + let sdx = Instance.sNode xi + il' = Container.add (Instance.idx xi) xi il + in case Cluster.tryEvac xnl il' [sdx] of + Just _ -> True + _ -> False + _ -> False + +-- | Check that allocating multiple instances on a cluster, then +-- adding an empty node, results in a valid rebalance +prop_ClusterAllocBalance node = + forAll (choose (3, 5)) $ \count -> + not (Node.offline node) + && not (Node.failN1 node) + && isNodeBig node 4 + && not (isNodeBig node 8) + ==> + let nl = makeSmallCluster node count + (hnode, nl') = IntMap.deleteFindMax nl + il = Container.empty + rqnodes = 2 + i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu + in case Cluster.iterateAlloc nl' il i_templ rqnodes [] of + Types.Bad _ -> False + Types.Ok (_, xnl, il', _) -> + let ynl = Container.add (Node.idx hnode) hnode xnl + cv = Cluster.compCV ynl + tbl = Cluster.Table ynl il' cv [] + in canBalance tbl True False + +-- | Checks consistency +prop_ClusterCheckConsistency node inst = + let nl = makeSmallCluster node 3 + [node1, node2, node3] = Container.elems nl + node3' = node3 { Node.group = "other-uuid" } + nl' = Container.add (Node.idx node3') node3' nl + inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2) + inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary + inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3) + ccheck = Cluster.findSplitInstances nl' . Container.fromAssocList + in null (ccheck [(0, inst1)]) && + null (ccheck [(0, inst2)]) && + (not . null $ ccheck [(0, inst3)]) + +-- 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 + (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1) + (nl, Container.empty) [1..icnt] + gni = Cluster.splitCluster nl' il' + in sum (map (Container.size . snd . snd) gni) == icnt && + all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group) + (Container.elems nl'')) gni + +testCluster = [ run prop_Score_Zero + , run prop_CStats_sane + , run prop_ClusterAlloc_sane + , run prop_ClusterCanTieredAlloc + , run prop_ClusterAllocEvac + , run prop_ClusterAllocBalance + , run prop_ClusterCheckConsistency + , run prop_ClusterSplitCluster ] + +-- | Check that opcode serialization is idempotent + +prop_OpCodes_serialization op = + case J.readJSON (J.showJSON op) of + J.Error _ -> False + J.Ok op' -> op == op' + where _types = op::OpCodes.OpCode + +testOpCodes = + [ run prop_OpCodes_serialization + ] + +-- | Check that (queued) job\/opcode status serialization is idempotent +prop_OpStatus_serialization os = + case J.readJSON (J.showJSON os) of + J.Error _ -> False + J.Ok os' -> os == os' + where _types = os::Jobs.OpStatus + +prop_JobStatus_serialization js = + case J.readJSON (J.showJSON js) of + J.Error _ -> False + J.Ok js' -> js == js' + where _types = js::Jobs.JobStatus + +testJobs = + [ run prop_OpStatus_serialization + , run prop_JobStatus_serialization + ] + +-- | Loader tests + +prop_Loader_lookupNode ktn inst node = + Loader.lookupNode nl inst node == Data.Map.lookup node nl + where nl = Data.Map.fromList ktn + +prop_Loader_lookupInstance kti inst = + Loader.lookupInstance il inst == Data.Map.lookup inst il + where il = Data.Map.fromList kti + +prop_Loader_assignIndices nodes = + Data.Map.size nassoc == length nodes && + Container.size kt == length nodes && + (if not (null nodes) + then maximum (IntMap.keys kt) == length nodes - 1 + 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 +prop_Loader_mergeData ns = + let na = Container.fromAssocList $ map (\n -> (Node.idx n, n)) ns + in case Loader.mergeData [] [] [] (na, Container.empty, []) of + Types.Bad _ -> False + Types.Ok (nl, il, _) -> + let nodes = Container.elems nl + instances = Container.elems il + in (sum . map (length . Node.pList)) nodes == 0 && + null instances + +testLoader = + [ run prop_Loader_lookupNode + , run prop_Loader_lookupInstance + , run prop_Loader_assignIndices + , run prop_Loader_mergeData + ]