AllocElement: extend with the cluster score
[ganeti-local] / Ganeti / HTools / QC.hs
index 8b46aa5..f411a8e 100644 (file)
@@ -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
   ]