AllocElement, a type used as a result of allocations, holds the status
of the nodes after the allocation. In most cases, we'll compare this
allocation result with others, to see which allocation decision makes
the most sense. This comparison is done via the cluster score.
However, if we later need to redo this computation, as part of other
comparisons, we'd need to evaluate it again, etc. So it's easier to just
compute the score at the place where we compute the node list in the
initial step.
---
Ganeti/HTools/Cluster.hs | 32 ++++++++++++++++----------------
Ganeti/HTools/IAlloc.hs | 6 +++---
Ganeti/HTools/Node.hs | 2 +-
Ganeti/HTools/QC.hs | 7 +++----
hail.hs | 2 +-
5 files changed, 24 insertions(+), 25 deletions(-)
diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index 7172cff..c52093d 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -387,9 +387,10 @@ allocateOnSingle :: Node.List -> Instance.Instance ->
Node.Node
allocateOnSingle nl inst p =
let new_pdx = Node.idx p
new_inst = Instance.setBoth inst new_pdx Node.noSecondary
- new_nl = Node.addPri p inst >>= \new_p ->
- return (Container.add new_pdx new_p nl, new_inst, [new_p])
- in new_nl
+ in Node.addPri p inst >>= \new_p -> do
+ let new_nl = Container.add new_pdx new_p nl
+ new_score = compCV nl
+ return (new_nl, new_inst, [new_p], new_score)
-- | Tries to allocate an instance on a given pair of nodes.
allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node
@@ -397,13 +398,12 @@ allocateOnPair :: Node.List -> Instance.Instance ->
Node.Node -> Node.Node
allocateOnPair nl inst tgt_p tgt_s =
let new_pdx = Node.idx tgt_p
new_sdx = Node.idx tgt_s
- new_nl = do -- Maybe monad
- new_p <- Node.addPri tgt_p inst
- new_s <- Node.addSec tgt_s inst new_pdx
- let new_inst = Instance.setBoth inst new_pdx new_sdx
- return (Container.addTwo new_pdx new_p new_sdx new_s nl, new_inst,
- [new_p, new_s])
- in new_nl
+ in do
+ new_p <- Node.addPri tgt_p inst
+ new_s <- Node.addSec tgt_s inst new_pdx
+ let new_inst = Instance.setBoth inst new_pdx new_sdx
+ new_nl = Container.addTwo new_pdx new_p new_sdx new_s nl
+ return (new_nl, new_inst, [new_p, new_s], compCV new_nl)
-- | Tries to perform an instance move and returns the best table
-- between the original one and the new one.
@@ -535,9 +535,8 @@ collapseFailures flst =
concatAllocs :: AllocSolution -> OpResult Node.AllocElement -> AllocSolution
concatAllocs (flst, cntok, sols) (OpFail reason) = (reason:flst, cntok, sols)
-concatAllocs (flst, cntok, osols) (OpGood ns@(nl, _, _)) =
- let nscore = compCV nl
- -- Choose the old or new solution, based on the cluster score
+concatAllocs (flst, cntok, osols) (OpGood ns@(_, _, _, nscore)) =
+ let -- Choose the old or new solution, based on the cluster score
nsols = case osols of
[] -> [(nscore, ns)]
(oscore, _):[] ->
@@ -601,7 +600,8 @@ tryReloc nl il xid 1 ex_idx =
let em = do
(mnl, i, _, _) <-
applyMove nl inst (ReplaceSecondary x)
- return (mnl, i, [Container.find x mnl])
+ return (mnl, i, [Container.find x mnl],
+ compCV mnl)
in concatAllocs cstate em
) ([], 0, []) valid_idxes
in return sols1
@@ -624,7 +624,7 @@ tryEvac nl il ex_ndx =
-- FIXME: hardcoded one node here
(fm, cs, aes) <- tryReloc nl' il idx 1 ex_ndx
case aes of
- csol@(_, (nl'', _, _)):_ ->
+ csol@(_, (nl'', _, _, _)):_ ->
return (nl'', (fm, cs, csol:rsols))
_ -> fail $ "Can't evacuate instance " ++
Instance.name (Container.find idx il)
@@ -649,7 +649,7 @@ iterateAlloc nl il newinst nreq ixes =
Ok (errs, _, sols3) ->
case sols3 of
[] -> Ok (collapseFailures errs, nl, il, ixes)
- (_, (xnl, xi, _)):[] ->
+ (_, (xnl, xi, _, _)):[] ->
iterateAlloc xnl (Container.add newidx xi il)
newinst nreq $! (xi:ixes)
_ -> Bad "Internal error: multiple solutions for single\
diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs
index d0bfec6..c60e361 100644
--- a/Ganeti/HTools/IAlloc.hs
+++ b/Ganeti/HTools/IAlloc.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
@@ -147,13 +147,13 @@ formatRVal :: RqType -> [Node.AllocElement] -> JSValue
formatRVal _ [] = JSArray []
formatRVal (Evacuate _) elems =
- let sols = map (\(_, inst, nl) -> Instance.name inst : map Node.name nl)
+ let sols = map (\(_, inst, nl, _) -> Instance.name inst : map Node.name nl)
elems
jsols = map (JSArray . map (JSString . toJSString)) sols
in JSArray jsols
formatRVal _ elems =
- let (_, _, nodes) = head elems
+ let (_, _, nodes, _) = head elems
nodes' = map Node.name nodes
in JSArray $ map (JSString . toJSString) nodes'
diff --git a/Ganeti/HTools/Node.hs b/Ganeti/HTools/Node.hs
index 2740d18..5fd331d 100644
--- a/Ganeti/HTools/Node.hs
+++ b/Ganeti/HTools/Node.hs
@@ -139,7 +139,7 @@ type List = Container.Container Node
-- | A simple name for an allocation element (here just for logistic
-- reasons)
-type AllocElement = (List, Instance.Instance, [Node])
+type AllocElement = (List, Instance.Instance, [Node], T.Score)
-- | Constant node index for a non-moveable instance.
noSecondary :: T.Ndx
diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs
index 206d86e..f411a8e 100644
--- a/Ganeti/HTools/QC.hs
+++ b/Ganeti/HTools/QC.hs
@@ -676,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
@@ -717,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
diff --git a/hail.hs b/hail.hs
index d67bd68..2f00da2 100644
--- a/hail.hs
+++ b/hail.hs
@@ -59,7 +59,7 @@ processResults (Evacuate _) as@(fstats, successes, sols) =
processResults _ as@(fstats, successes, sols) =
case sols of
- (best, (_, _, w)):[] ->
+ (best, (_, _, w, _)):[] ->
let tfails = length fstats
info = printf "successes %d, failures %d,\
\ best score: %.8f for node(s) %s"
--
1.7.2.3
