diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs index 66d87526b3ad075a4f6e2e11639f58b202af0499..6ec2f9f4ae4df1cd8894896154d23cd977b01e56 100644 --- a/Ganeti/HTools/Cluster.hs +++ b/Ganeti/HTools/Cluster.hs @@ -75,6 +75,7 @@ import Control.Monad import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Node as Node +import qualified Ganeti.HTools.Group as Group import Ganeti.HTools.Types import Ganeti.HTools.Utils import qualified Ganeti.OpCodes as OpCodes @@ -625,11 +626,12 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \ "), only two supported" -- | Given a group/result, describe it as a nice (list of) messages -solutionDescription :: (Gdx, Result AllocSolution) -> [String] -solutionDescription (groupId, result) = +solutionDescription :: Group.List -> (Gdx, Result AllocSolution) -> [String] +solutionDescription gl (groupId, result) = case result of - Ok solution -> map (printf "Group %d: %s" groupId) (asLog solution) - Bad message -> [printf "Group %d: error %s" groupId message] + Ok solution -> map (printf "Group %s: %s" gname) (asLog solution) + Bad message -> [printf "Group %s: error %s" gname message] + where gname = Group.name $ Container.find groupId gl -- | From a list of possibly bad and possibly empty solutions, filter -- only the groups with a valid result @@ -641,18 +643,19 @@ filterMGResults = 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 = +tryMGAlloc :: Group.List -- ^ The group list + -> 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 mggl 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:: [(Gdx, Result AllocSolution)] - all_msgs = concatMap solutionDescription sols + all_msgs = concatMap (solutionDescription mggl) sols goodSols = filterMGResults sols extractScore = \(_, _, _, x) -> x solScore = extractScore . head . asSolutions . snd @@ -660,7 +663,8 @@ tryMGAlloc mgnl mgil inst cnt = in if null sortedSols then Bad $ intercalate ", " all_msgs else let (final_group, final_sol) = head sortedSols - selmsg = "Selected group: " ++ show final_group + final_name = Group.name $ Container.find final_group mggl + selmsg = "Selected group: " ++ final_name in Ok $ final_sol { asLog = selmsg:all_msgs } -- | Try to relocate an instance on the cluster. diff --git a/hail.hs b/hail.hs index 58a787e235f8e7eeba67f804e967a846724bc50d..a40898738254f35fef1bd2126cafd564b5c1b5cd 100644 --- a/hail.hs +++ b/hail.hs @@ -61,9 +61,9 @@ processResults _ as = processRequest :: Request -> Result Cluster.AllocSolution processRequest request = - let Request rqtype _ nl il _ = request + let Request rqtype gl nl il _ = request in case rqtype of - Allocate xi reqn -> Cluster.tryMGAlloc nl il xi reqn + Allocate xi reqn -> Cluster.tryMGAlloc gl nl il xi reqn Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes Evacuate exnodes -> Cluster.tryEvac nl il exnodes