Commit 85d0ddc3 authored by Iustin Pop's avatar Iustin Pop
Browse files

Change AllocSolution from tuple to its own type



Tuples are good for two, three, at most four elements. Beyond that, the
continuous pattern matching and construction/deconstruction becomes
tedious.

Since in the future we'll probably keep more information in the
AllocSolution type, we change it now from a triple to a "real" data
type. We also do some cleanups: adding a real emptyAlloc value, instead
of the previous hardcoded ones, and add some more comments on how we do
the multi-evacuation.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarBalazs Lecz <leczb@google.com>
parent a334d536
......@@ -29,7 +29,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.HTools.Cluster
(
-- * Types
AllocSolution
AllocSolution(..)
, Table(..)
, CStats(..)
, AllocStats
......@@ -81,7 +81,19 @@ import qualified Ganeti.OpCodes as OpCodes
-- * Types
-- | Allocation\/relocation solution.
type AllocSolution = ([FailMode], Int, [Node.AllocElement])
data AllocSolution = AllocSolution
{ asFailures :: [FailMode] -- ^ Failure counts
, asAllocs :: Int -- ^ Good allocation count
, asSolutions :: [Node.AllocElement] -- ^ The actual result, length
-- of the list depends on the
-- allocation/relocation mode
}
-- | The empty solution we start with when computing allocations
emptySolution :: AllocSolution
emptySolution = AllocSolution { asFailures = [], asAllocs = 0
, asSolutions = [] }
-- | The complete state for the balancing solution
data Table = Table Node.List Instance.List Score [Placement]
......@@ -533,10 +545,12 @@ collapseFailures flst =
-- | Update current Allocation solution and failure stats with new
-- elements
concatAllocs :: AllocSolution -> OpResult Node.AllocElement -> AllocSolution
concatAllocs (flst, cntok, sols) (OpFail reason) = (reason:flst, cntok, sols)
concatAllocs as (OpFail reason) = as { asFailures = reason : asFailures as }
concatAllocs (flst, cntok, osols) (OpGood ns@(_, _, _, nscore)) =
concatAllocs as (OpGood ns@(_, _, _, nscore)) =
let -- Choose the old or new solution, based on the cluster score
cntok = asAllocs as
osols = asSolutions as
nsols = case osols of
[] -> [ns]
(_, _, _, oscore):[] ->
......@@ -553,7 +567,7 @@ concatAllocs (flst, cntok, osols) (OpGood ns@(_, _, _, nscore)) =
-- in the next cycle, so we force evaluation of nsols, since the
-- foldl' in the caller will only evaluate the tuple, but not the
-- elements of the tuple
in nsols `seq` nsuc `seq` (flst, nsuc, nsols)
in nsols `seq` nsuc `seq` as { asAllocs = nsuc, asSolutions = nsols }
-- | Try to allocate an instance on the cluster.
tryAlloc :: (Monad m) =>
......@@ -568,14 +582,14 @@ tryAlloc nl _ inst 2 =
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs
sols = foldl' (\cstate (p, s) ->
concatAllocs cstate $ allocateOnPair nl inst p s
) ([], 0, []) ok_pairs
) emptySolution ok_pairs
in return sols
tryAlloc nl _ inst 1 =
let all_nodes = getOnline nl
sols = foldl' (\cstate ->
concatAllocs cstate . allocateOnSingle nl inst
) ([], 0, []) all_nodes
) emptySolution all_nodes
in return sols
tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \
......@@ -603,7 +617,7 @@ tryReloc nl il xid 1 ex_idx =
return (mnl, i, [Container.find x mnl],
compCV mnl)
in concatAllocs cstate em
) ([], 0, []) valid_idxes
) emptySolution valid_idxes
in return sols1
tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \
......@@ -620,15 +634,23 @@ tryEvac nl il ex_ndx =
let ex_nodes = map (`Container.find` nl) ex_ndx
all_insts = nub . concatMap Node.sList $ ex_nodes
in do
(_, sol) <- foldM (\(nl', (_, _, rsols)) idx -> do
-- FIXME: hardcoded one node here
(fm, cs, aes) <- tryReloc nl' il idx 1 ex_ndx
case aes of
csol@(nl'', _, _, _):_ ->
return (nl'', (fm, cs, csol:rsols))
_ -> fail $ "Can't evacuate instance " ++
Instance.name (Container.find idx il)
) (nl, ([], 0, [])) all_insts
(_, sol) <- foldM (\(nl', old_as) idx -> do
-- FIXME: hardcoded one node here
-- (fm, cs, aes)
new_as <- tryReloc nl' il idx 1 ex_ndx
case asSolutions new_as of
csol@(nl'', _, _, _):_ ->
-- an individual relocation succeeded,
-- we kind of compose the data from
-- the two solutions
return (nl'',
new_as { asSolutions =
csol:asSolutions old_as })
-- this relocation failed, so we fail
-- the entire evac
_ -> fail $ "Can't evacuate instance " ++
Instance.name (Container.find idx il)
) (nl, emptySolution) all_insts
return sol
-- | Recursively place instances on the cluster until we're out of space
......@@ -646,7 +668,7 @@ iterateAlloc nl il newinst nreq ixes =
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
in case tryAlloc nl il newi2 nreq of
Bad s -> Bad s
Ok (errs, _, sols3) ->
Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) ->
case sols3 of
[] -> Ok (collapseFailures errs, nl, il, ixes)
(xnl, xi, _, _):[] ->
......
......@@ -673,8 +673,8 @@ prop_ClusterAlloc_sane node inst =
inst' = setInstanceSmallerThanNode node inst
in case Cluster.tryAlloc nl il inst' rqnodes of
Types.Bad _ -> False
Types.Ok (_, _, sols3) ->
case sols3 of
Types.Ok as ->
case Cluster.asSolutions as of
[] -> False
(xnl, xi, _, cv):[] ->
let il' = Container.add (Instance.idx xi) xi il
......@@ -713,8 +713,8 @@ prop_ClusterAllocEvac node inst =
inst' = setInstanceSmallerThanNode node inst
in case Cluster.tryAlloc nl il inst' rqnodes of
Types.Bad _ -> False
Types.Ok (_, _, sols3) ->
case sols3 of
Types.Ok as ->
case Cluster.asSolutions as of
[] -> False
(xnl, xi, _, _):[] ->
let sdx = Instance.sNode xi
......
......@@ -49,21 +49,24 @@ options = [oPrintNodes, oShowVer, oShowHelp]
processResults :: (Monad m) =>
RqType -> Cluster.AllocSolution
-> m (String, Cluster.AllocSolution)
processResults _ (_, _, []) = fail "No valid allocation solutions"
processResults (Evacuate _) as@(fstats, successes, sols) =
let (_, _, _, best) = head sols
processResults _ (Cluster.AllocSolution { Cluster.asSolutions = [] }) =
fail "No valid allocation solutions"
processResults (Evacuate _) as =
let fstats = Cluster.asFailures as
successes = Cluster.asAllocs as
(_, _, _, best) = head (Cluster.asSolutions as)
tfails = length fstats
info = printf "for last allocation, successes %d, failures %d,\
\ best score: %.8f" successes tfails best::String
in return (info, as)
processResults _ as@(fstats, successes, sols) =
case sols of
processResults _ as =
case Cluster.asSolutions as of
(_, _, w, best):[] ->
let tfails = length fstats
let tfails = length (Cluster.asFailures as)
info = printf "successes %d, failures %d,\
\ best score: %.8f for node(s) %s"
successes tfails
(Cluster.asAllocs as) tfails
best (intercalate "/" . map Node.name $ w)::String
in return (info, as)
_ -> fail "Internal error: multiple allocation solutions"
......@@ -107,8 +110,8 @@ main = do
let sols = processRequest request >>= processResults rq
let (ok, info, rn) =
case sols of
Ok (ginfo, (_, _, sn)) -> (True, "Request successful: " ++ ginfo,
sn)
Ok (ginfo, as) -> (True, "Request successful: " ++ ginfo,
Cluster.asSolutions as)
Bad s -> (False, "Request failed: " ++ s, [])
resp = formatResponse ok info rq rn
putStrLn resp
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment