Commit 9b1584fc authored by Iustin Pop's avatar Iustin Pop
Browse files

hail/allocate: implement multi-group support



This is a bit hackish. We add a new function that takes the input data,
splits it into groups, runs the original tryAlloc for each group, and
then chooses the best solution, but adds the log messages from all the
groups, as to give better debugging information. In hail, we just point
to this new function.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarBalazs Lecz <leczb@google.com>
parent db4d9a9b
......@@ -55,6 +55,7 @@ module Ganeti.HTools.Cluster
, iMoveToJob
-- * IAllocator functions
, tryAlloc
, tryMGAlloc
, tryReloc
, tryEvac
, collapseFailures
......@@ -619,7 +620,46 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \
\destinations required (" ++ show reqn ++
"), only two supported"
-- | Try to allocate an instance on the cluster.
-- | Given a group/result, describe it as a nice (list of) messages
solutionDescription :: (GroupID, Result AllocSolution) -> [String]
solutionDescription (groupId, result) =
case result of
Ok solution -> map (printf "Group %s: %s" groupId) (asLog solution)
Bad message -> [printf "Group %s: error %s" groupId message]
-- | From a list of possibly bad and possibly empty solutions, filter
-- only the groups with a valid result
filterMGResults :: [(GroupID, Result AllocSolution)] ->
[(GroupID, AllocSolution)]
filterMGResults =
filter (not . null . asSolutions . snd) .
map (\(y, Ok x) -> (y, x)) .
filter (isOk . snd)
-- | Try to allocate an instance on a multi-group cluster.
tryMGAlloc :: Node.List -- ^ The node list
-> Instance.List -- ^ The instance list
-> Instance.Instance -- ^ The instance to allocate
-> Int -- ^ Required number of nodes
-> Result AllocSolution -- ^ Possible solution list
tryMGAlloc mgnl mgil inst cnt =
let groups = splitCluster mgnl mgil
-- TODO: currently we consider all groups preferred
sols = map (\(gid, (nl, il)) ->
(gid, tryAlloc nl il inst cnt)) groups::
[(GroupID, Result AllocSolution)]
all_msgs = concatMap solutionDescription sols
goodSols = filterMGResults sols
extractScore = \(_, _, _, x) -> x
solScore = extractScore . head . asSolutions . snd
sortedSols = sortBy (comparing solScore) goodSols
in if null sortedSols
then Bad $ intercalate ", " all_msgs
else let (final_group, final_sol) = head sortedSols
selmsg = "Selected group: " ++ final_group
in Ok $ final_sol { asLog = selmsg:all_msgs }
-- | Try to relocate an instance on the cluster.
tryReloc :: (Monad m) =>
Node.List -- ^ The node list
-> Instance.List -- ^ The instance list
......
......@@ -63,7 +63,7 @@ processRequest :: Request
processRequest request =
let Request rqtype nl il _ = request
in case rqtype of
Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn
Allocate xi reqn -> Cluster.tryMGAlloc nl il xi reqn
Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes
Evacuate exnodes -> Cluster.tryEvac nl il exnodes
......
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