Commit aec636b9 authored by Iustin Pop's avatar Iustin Pop
Browse files

hail: display group names in info messages



This patch switches from the group index to the group name for the
informational messages in the hail results.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarBalazs Lecz <leczb@google.com>
parent e0c85e08
...@@ -75,6 +75,7 @@ import Control.Monad ...@@ -75,6 +75,7 @@ import Control.Monad
import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Group as Group
import Ganeti.HTools.Types import Ganeti.HTools.Types
import Ganeti.HTools.Utils import Ganeti.HTools.Utils
import qualified Ganeti.OpCodes as OpCodes import qualified Ganeti.OpCodes as OpCodes
...@@ -625,11 +626,12 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \ ...@@ -625,11 +626,12 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \
"), only two supported" "), only two supported"
-- | Given a group/result, describe it as a nice (list of) messages -- | Given a group/result, describe it as a nice (list of) messages
solutionDescription :: (Gdx, Result AllocSolution) -> [String] solutionDescription :: Group.List -> (Gdx, Result AllocSolution) -> [String]
solutionDescription (groupId, result) = solutionDescription gl (groupId, result) =
case result of case result of
Ok solution -> map (printf "Group %d: %s" groupId) (asLog solution) Ok solution -> map (printf "Group %s: %s" gname) (asLog solution)
Bad message -> [printf "Group %d: error %s" groupId message] 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 -- | From a list of possibly bad and possibly empty solutions, filter
-- only the groups with a valid result -- only the groups with a valid result
...@@ -641,18 +643,19 @@ filterMGResults = ...@@ -641,18 +643,19 @@ filterMGResults =
filter (isOk . snd) filter (isOk . snd)
-- | Try to allocate an instance on a multi-group cluster. -- | Try to allocate an instance on a multi-group cluster.
tryMGAlloc :: Node.List -- ^ The node list tryMGAlloc :: Group.List -- ^ The group list
-> Instance.List -- ^ The instance list -> Node.List -- ^ The node list
-> Instance.Instance -- ^ The instance to allocate -> Instance.List -- ^ The instance list
-> Int -- ^ Required number of nodes -> Instance.Instance -- ^ The instance to allocate
-> Result AllocSolution -- ^ Possible solution list -> Int -- ^ Required number of nodes
tryMGAlloc mgnl mgil inst cnt = -> Result AllocSolution -- ^ Possible solution list
tryMGAlloc mggl mgnl mgil inst cnt =
let groups = splitCluster mgnl mgil let groups = splitCluster mgnl mgil
-- TODO: currently we consider all groups preferred -- TODO: currently we consider all groups preferred
sols = map (\(gid, (nl, il)) -> sols = map (\(gid, (nl, il)) ->
(gid, tryAlloc nl il inst cnt)) groups:: (gid, tryAlloc nl il inst cnt)) groups::
[(Gdx, Result AllocSolution)] [(Gdx, Result AllocSolution)]
all_msgs = concatMap solutionDescription sols all_msgs = concatMap (solutionDescription mggl) sols
goodSols = filterMGResults sols goodSols = filterMGResults sols
extractScore = \(_, _, _, x) -> x extractScore = \(_, _, _, x) -> x
solScore = extractScore . head . asSolutions . snd solScore = extractScore . head . asSolutions . snd
...@@ -660,7 +663,8 @@ tryMGAlloc mgnl mgil inst cnt = ...@@ -660,7 +663,8 @@ tryMGAlloc mgnl mgil inst cnt =
in if null sortedSols in if null sortedSols
then Bad $ intercalate ", " all_msgs then Bad $ intercalate ", " all_msgs
else let (final_group, final_sol) = head sortedSols 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 } in Ok $ final_sol { asLog = selmsg:all_msgs }
-- | Try to relocate an instance on the cluster. -- | Try to relocate an instance on the cluster.
......
...@@ -61,9 +61,9 @@ processResults _ as = ...@@ -61,9 +61,9 @@ processResults _ as =
processRequest :: Request processRequest :: Request
-> Result Cluster.AllocSolution -> Result Cluster.AllocSolution
processRequest request = processRequest request =
let Request rqtype _ nl il _ = request let Request rqtype gl nl il _ = request
in case rqtype of 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 Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes
Evacuate exnodes -> Cluster.tryEvac nl il 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