IAllocator: respect the alloc_policy for groups

This patch changes the allocate mode to respect the alloc_policy for
groups. It does this by changing the sort key from simply the solution
score, to a tuple with two elements: the alloc policy (which is now an
Ord instance) and the solution score. Also, the unallocable groups are
filtered out in the filterMGResults phase.

The patch also slightly enhances the informational message by
including the policy in the group information, to help debugging.

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Balazs Lecz <leczb@google.com>

Ganeti/HTools/Cluster.hs

@@ -629,19 +629,34 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \
 solutionDescription :: Group.List -> (Gdx, Result AllocSolution) -> [String]
 solutionDescription gl (groupId, result) =
   case result of
-    Ok solution -> map (printf "Group %s: %s" gname) (asLog solution)
+    Ok solution -> map (printf "Group %s (%s): %s" gname pol) (asLog solution)
     Bad message -> [printf "Group %s: error %s" gname message]
-  where gname = Group.name $ Container.find groupId gl
+  where grp = Container.find groupId gl
+        gname = Group.name grp
+        pol = apolToString (Group.allocPolicy grp)
 
 -- | From a list of possibly bad and possibly empty solutions, filter
 -- only the groups with a valid result
-filterMGResults :: [(Gdx, Result AllocSolution)] ->
-                   [(Gdx, AllocSolution)]
-filterMGResults =
+filterMGResults :: Group.List
+                -> [(Gdx, Result AllocSolution)]
+                -> [(Gdx, AllocSolution)]
+filterMGResults gl=
+  filter ((/= AllocUnallocable) . Group.allocPolicy .
+             flip Container.find gl . fst) .
   filter (not . null . asSolutions . snd) .
   map (\(y, Ok x) -> (y, x)) .
   filter (isOk . snd)
 
+-- | Sort multigroup results based on policy and score
+sortMGResults :: Group.List
+             -> [(Gdx, AllocSolution)]
+             -> [(Gdx, AllocSolution)]
+sortMGResults gl sols =
+    let extractScore = \(_, _, _, x) -> x
+        solScore (gdx, sol) = (Group.allocPolicy (Container.find gdx gl),
+                               (extractScore . head . asSolutions) sol)
+    in sortBy (comparing solScore) sols
+
 -- | Try to allocate an instance on a multi-group cluster.
 tryMGAlloc :: Group.List           -- ^ The group list
            -> Node.List            -- ^ The node list
@@ -656,10 +671,8 @@ tryMGAlloc mggl mgnl mgil inst cnt =
                    (gid, tryAlloc nl il inst cnt)) groups::
         [(Gdx, Result AllocSolution)]
       all_msgs = concatMap (solutionDescription mggl) sols
-      goodSols = filterMGResults sols
-      extractScore = \(_, _, _, x) -> x
-      solScore = extractScore . head . asSolutions . snd
-      sortedSols = sortBy (comparing solScore) goodSols
+      goodSols = filterMGResults mggl sols
+      sortedSols = sortMGResults mggl goodSols
   in if null sortedSols
      then Bad $ intercalate ", " all_msgs
      else let (final_group, final_sol) = head sortedSols

Ganeti/HTools/Types.hs

@@ -86,10 +86,19 @@ type Weight = Double
 type GroupID = String
 
 -- | The Group allocation policy type.
-data AllocPolicy = AllocPreferred
-                 | AllocLastResort
-                 | AllocUnallocable
-                   deriving (Show, Eq)
+--
+-- Note that the order of constructors is important as the automatic
+-- Ord instance will order them in the order they are defined, so when
+-- changing this data type be careful about the interaction with the
+-- desired sorting order.
+data AllocPolicy
+    = AllocPreferred   -- ^ This is the normal status, the group
+                       -- should be used normally during allocations
+    | AllocLastResort  -- ^ This group should be used only as
+                       -- last-resort, after the preferred groups
+    | AllocUnallocable -- ^ This group must not be used for new
+                       -- allocations
+      deriving (Show, Eq, Ord)
 
 -- | Convert a string to an alloc policy
 apolFromString :: (Monad m) => String -> m AllocPolicy