X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/c4d98278dc11d64d903332056cf0c10c05155b32..7d3f42530a2e1cdd6ec09a6098402c7e05fc3bdf:/Ganeti/HTools/QC.hs diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs index 8b46aa5..f411a8e 100644 --- a/Ganeti/HTools/QC.hs +++ b/Ganeti/HTools/QC.hs @@ -38,7 +38,7 @@ module Ganeti.HTools.QC import Test.QuickCheck import Test.QuickCheck.Batch -import Data.List (findIndex, intercalate) +import Data.List (findIndex, intercalate, nub) import Data.Maybe import Control.Monad import qualified Text.JSON as J @@ -85,14 +85,6 @@ isFailure :: Types.OpResult a -> Bool isFailure (Types.OpFail _) = True isFailure _ = False --- | Simple checker for whether Result is fail or pass -isOk :: Types.Result a -> Bool -isOk (Types.Ok _ ) = True -isOk _ = False - -isBad :: Types.Result a -> Bool -isBad = not . isOk - -- | Update an instance to be smaller than a node setInstanceSmallerThanNode node inst = inst { Instance.mem = Node.availMem node `div` 2 @@ -110,7 +102,7 @@ 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 Container.fromAssocList nlst + in nlst -- | Checks if a node is "big" enough isNodeBig :: Node.Node -> Int -> Bool @@ -121,6 +113,25 @@ isNodeBig node size = Node.availDisk node > size * Types.unitDsk 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 @@ -281,8 +292,38 @@ 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 +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_addTwo + , run prop_Container_nameOf + , run prop_Container_findByName + ] -- Simple instance tests, we only have setter/getters @@ -339,7 +380,7 @@ prop_Instance_shrinkMG inst = prop_Instance_shrinkMF inst = Instance.mem inst < 2 * Types.unitMem ==> - isBad $ Instance.shrinkByType inst Types.FailMem + Types.isBad $ Instance.shrinkByType inst Types.FailMem prop_Instance_shrinkCG inst = Instance.vcpus inst >= 2 * Types.unitCpu ==> @@ -350,7 +391,7 @@ prop_Instance_shrinkCG inst = prop_Instance_shrinkCF inst = Instance.vcpus inst < 2 * Types.unitCpu ==> - isBad $ Instance.shrinkByType inst Types.FailCPU + Types.isBad $ Instance.shrinkByType inst Types.FailCPU prop_Instance_shrinkDG inst = Instance.dsk inst >= 2 * Types.unitDsk ==> @@ -361,7 +402,7 @@ prop_Instance_shrinkDG inst = prop_Instance_shrinkDF inst = Instance.dsk inst < 2 * Types.unitDsk ==> - isBad $ Instance.shrinkByType inst Types.FailDisk + Types.isBad $ Instance.shrinkByType inst Types.FailDisk prop_Instance_setMovable inst m = Instance.movable inst' == m @@ -399,11 +440,12 @@ prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx = ndx = if null snode then [(pnode, pdx)] else [(pnode, pdx), (snode, rsdx)] + nl = Data.Map.fromList ndx tags = "" - inst = Text.loadInst ndx + inst = Text.loadInst nl [name, mem_s, dsk_s, vcpus_s, status, pnode, snode, tags]:: Maybe (String, Instance.Instance) - fail1 = Text.loadInst ndx + 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 @@ -424,7 +466,8 @@ prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx = isNothing fail1) prop_Text_Load_InstanceFail ktn fields = - length fields /= 8 ==> isNothing $ Text.loadInst 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 @@ -564,6 +607,15 @@ prop_Node_showField node = 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 @@ -577,6 +629,7 @@ testNode = , run prop_Node_tagMaps_idempotent , run prop_Node_tagMaps_reject , run prop_Node_showField + , run prop_Node_computeGroups ] @@ -623,9 +676,8 @@ prop_ClusterAlloc_sane node inst = Types.Ok (_, _, sols3) -> case sols3 of [] -> False - (_, (xnl, xi, _)):[] -> - let cv = Cluster.compCV xnl - il' = Container.add (Instance.idx xi) xi il + (_, (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 @@ -664,7 +716,7 @@ prop_ClusterAllocEvac node inst = Types.Ok (_, _, sols3) -> case sols3 of [] -> False - (_, (xnl, xi, _)):[] -> + (_, (xnl, xi, _, _)):[] -> let sdx = Instance.sNode xi il' = Container.add (Instance.idx xi) xi il in case Cluster.tryEvac xnl il' [sdx] of @@ -694,6 +746,31 @@ prop_ClusterAllocBalance node = 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 @@ -701,6 +778,8 @@ testCluster = , run prop_ClusterCanTieredAlloc , run prop_ClusterAllocEvac , run prop_ClusterAllocBalance + , run prop_ClusterCheckConsistency + , run prop_ClusterSplitCluster ] -- | Check that opcode serialization is idempotent @@ -736,35 +815,27 @@ testJobs = -- | Loader tests prop_Loader_lookupNode ktn inst node = - isJust (Loader.lookupNode ktn inst node) == (node `elem` names) - where names = map fst ktn + Loader.lookupNode nl inst node == Data.Map.lookup node nl + where nl = Data.Map.fromList ktn prop_Loader_lookupInstance kti inst = - isJust (Loader.lookupInstance kti inst) == (inst `elem` names) - where names = map fst kti - -prop_Loader_lookupInstanceIdx kti inst = - case (Loader.lookupInstance kti inst, - findIndex (\p -> fst p == inst) kti) of - (Nothing, Nothing) -> True - (Just idx, Just ex) -> idx == snd (kti !! ex) - _ -> False - -prop_Loader_assignIndices enames = - length nassoc == length enames && - length kt == length enames && - (if not (null enames) - then maximum (map fst kt) == length enames - 1 + 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 enames - _types = enames::[(String, Node.Node)] + 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 = map (\n -> (Node.idx n, n)) ns - in case Loader.mergeData [] [] [] (na, [], []) of + 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 @@ -775,7 +846,6 @@ prop_Loader_mergeData ns = testLoader = [ run prop_Loader_lookupNode , run prop_Loader_lookupInstance - , run prop_Loader_lookupInstanceIdx , run prop_Loader_assignIndices , run prop_Loader_mergeData ]