Allocation routines: return list of resource stats

Currently, the allocation routines (iterateAlloc and tieredAlloc)
return only the final state of the cluster and the list of allocated
instances. For better visibility in how the cluster resources change,
we compute and return a list of cluster resources at each step, which
should be a good indicator of the cluster state. The cost of the
computation for the new resource when not used is undetectable (< 1%).

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Balazs Lecz <leczb@google.com>

Ganeti/HTools/Cluster.hs

@@ -748,9 +748,10 @@ iterateAlloc :: Node.List
              -> Instance.Instance
              -> Int
              -> [Instance.Instance]
+             -> [CStats]
              -> Result (FailStats, Node.List, Instance.List,
-                        [Instance.Instance])
-iterateAlloc nl il newinst nreq ixes =
+                        [Instance.Instance], [CStats])
+iterateAlloc nl il newinst nreq ixes cstats =
       let depth = length ixes
           newname = printf "new-%d" depth::String
           newidx = length (Container.elems il) + depth
@@ -759,10 +760,11 @@ iterateAlloc nl il newinst nreq ixes =
            Bad s -> Bad s
            Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) ->
                case sols3 of
-                 [] -> Ok (collapseFailures errs, nl, il, ixes)
+                 [] -> Ok (collapseFailures errs, nl, il, ixes, cstats)
                  (xnl, xi, _, _):[] ->
                      iterateAlloc xnl (Container.add newidx xi il)
-                                  newinst nreq $! (xi:ixes)
+                                  newinst nreq (xi:ixes)
+                                  (totalResources xnl:cstats)
                  _ -> Bad "Internal error: multiple solutions for single\
                           \ allocation"
 
@@ -772,17 +774,18 @@ tieredAlloc :: Node.List
             -> Instance.Instance
             -> Int
             -> [Instance.Instance]
+            -> [CStats]
             -> Result (FailStats, Node.List, Instance.List,
-                       [Instance.Instance])
-tieredAlloc nl il newinst nreq ixes =
-    case iterateAlloc nl il newinst nreq ixes of
+                       [Instance.Instance], [CStats])
+tieredAlloc nl il newinst nreq ixes cstats =
+    case iterateAlloc nl il newinst nreq ixes cstats of
       Bad s -> Bad s
-      Ok (errs, nl', il', ixes') ->
+      Ok (errs, nl', il', ixes', cstats') ->
           case Instance.shrinkByType newinst . fst . last $
                sortBy (comparing snd) errs of
-            Bad _ -> Ok (errs, nl', il', ixes')
+            Bad _ -> Ok (errs, nl', il', ixes', cstats')
             Ok newinst' ->
-                tieredAlloc nl' il' newinst' nreq ixes'
+                tieredAlloc nl' il' newinst' nreq ixes' cstats'
 
 -- | Compute the tiered spec string description from a list of
 -- allocated instances.

Ganeti/HTools/QC.hs

@@ -708,10 +708,11 @@ prop_ClusterCanTieredAlloc node inst =
             ==>
     let nl = makeSmallCluster node count
         il = Container.empty
-    in case Cluster.tieredAlloc nl il inst rqnodes [] of
+    in case Cluster.tieredAlloc nl il inst rqnodes [] []of
          Types.Bad _ -> False
-         Types.Ok (_, _, il', ixes) -> not (null ixes) &&
-                                      IntMap.size il' == length ixes
+         Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) &&
+                                      IntMap.size il' == length ixes &&
+                                      length ixes == length cstats
 
 -- | Checks that on a 4-8 node cluster, once we allocate an instance,
 -- we can also evacuate it
@@ -752,9 +753,9 @@ prop_ClusterAllocBalance node =
         il = Container.empty
         rqnodes = 2
         i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
-    in case Cluster.iterateAlloc nl' il i_templ rqnodes [] of
+    in case Cluster.iterateAlloc nl' il i_templ rqnodes [] [] of
          Types.Bad _ -> False
-         Types.Ok (_, xnl, il', _) ->
+         Types.Ok (_, xnl, il', _, _) ->
                    let ynl = Container.add (Node.idx hnode) hnode xnl
                        cv = Cluster.compCV ynl
                        tbl = Cluster.Table ynl il' cv []

hspace.hs

@@ -276,7 +276,7 @@ main = do
 
   let bad_nodes = fst $ Cluster.computeBadItems nl il
       stop_allocation = length bad_nodes > 0
-      result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [])
+      result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], [])
 
   -- utility functions
   let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
@@ -295,11 +295,11 @@ main = do
   (case optTieredSpec opts of
      Nothing -> return ()
      Just tspec -> do
-       (_, trl_nl, trl_il, trl_ixes) <-
+       (_, trl_nl, trl_il, trl_ixes, _) <-
            if stop_allocation
            then return result_noalloc
            else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
-                                  req_nodes [])
+                                  req_nodes [] [])
        let spec_map' = Cluster.tieredSpecMap trl_ixes
 
        printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes
@@ -316,10 +316,10 @@ main = do
 
   -- Run the standard (avg-mode) allocation
 
-  (ereason, fin_nl, fin_il, ixes) <-
+  (ereason, fin_nl, fin_il, ixes, _) <-
       if stop_allocation
       then return result_noalloc
-      else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [])
+      else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [] [])
 
   let allocs = length ixes
       sreason = reverse $ sortBy (comparing snd) ereason