Implement balancing with no instance moves

Note that --no-disk-moves and --no-instance-moves are not incompatible,
but if both are used no solution can possibly exist.

Signed-off-by: Guido Trotter <ultrotter@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>

htools/Ganeti/HTools/Cluster.hs

@@ -465,35 +465,42 @@ checkSingleStep ini_tbl target cur_tbl move =
 -- the current candidate target node, generate the possible moves for
 -- a instance.
 possibleMoves :: Bool      -- ^ Whether the secondary node is a valid new node
+              -> Bool      -- ^ Whether we can change the primary node
               -> Ndx       -- ^ Target node candidate
               -> [IMove]   -- ^ List of valid result moves
-possibleMoves True tdx =
+
+possibleMoves _ False tdx =
+    [ReplaceSecondary tdx]
+
+possibleMoves True True tdx =
     [ReplaceSecondary tdx,
      ReplaceAndFailover tdx,
      ReplacePrimary tdx,
      FailoverAndReplace tdx]
 
-possibleMoves False tdx =
+possibleMoves False True tdx =
     [ReplaceSecondary tdx,
      ReplaceAndFailover tdx]
 
 -- | Compute the best move for a given instance.
 checkInstanceMove :: [Ndx]             -- ^ Allowed target node indices
                   -> Bool              -- ^ Whether disk moves are allowed
+                  -> Bool              -- ^ Whether instance moves are allowed
                   -> Table             -- ^ Original table
                   -> Instance.Instance -- ^ Instance to move
                   -> Table             -- ^ Best new table for this instance
-checkInstanceMove nodes_idx disk_moves ini_tbl target =
+checkInstanceMove nodes_idx disk_moves inst_moves ini_tbl target =
     let
         opdx = Instance.pNode target
         osdx = Instance.sNode target
         nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
-        use_secondary = elem osdx nodes_idx
+        use_secondary = elem osdx nodes_idx && inst_moves
         aft_failover = if use_secondary -- if allowed to failover
                        then checkSingleStep ini_tbl target ini_tbl Failover
                        else ini_tbl
         all_moves = if disk_moves
-                    then concatMap (possibleMoves use_secondary) nodes
+                    then concatMap
+                         (possibleMoves use_secondary inst_moves) nodes
                     else []
     in
       -- iterate over the possible nodes for this instance
@@ -502,17 +509,19 @@ checkInstanceMove nodes_idx disk_moves ini_tbl target =
 -- | Compute the best next move.
 checkMove :: [Ndx]               -- ^ Allowed target node indices
           -> Bool                -- ^ Whether disk moves are allowed
+          -> Bool                -- ^ Whether instance moves are allowed
           -> Table               -- ^ The current solution
           -> [Instance.Instance] -- ^ List of instances still to move
           -> Table               -- ^ The new solution
-checkMove nodes_idx disk_moves ini_tbl victims =
+checkMove nodes_idx disk_moves inst_moves ini_tbl victims =
     let Table _ _ _ ini_plc = ini_tbl
         -- we're using rwhnf from the Control.Parallel.Strategies
         -- package; we don't need to use rnf as that would force too
         -- much evaluation in single-threaded cases, and in
         -- multi-threaded case the weak head normal form is enough to
         -- spark the evaluation
-        tables = parMap rwhnf (checkInstanceMove nodes_idx disk_moves ini_tbl)
+        tables = parMap rwhnf (checkInstanceMove nodes_idx disk_moves
+                               inst_moves ini_tbl)
                  victims
         -- iterate over all instances, computing the best move
         best_tbl = foldl' compareTables ini_tbl tables
@@ -534,11 +543,12 @@ doNextBalance ini_tbl max_rounds min_score =
 -- | Run a balance move
 tryBalance :: Table       -- ^ The starting table
            -> Bool        -- ^ Allow disk moves
+           -> Bool        -- ^ Allow instance moves
            -> Bool        -- ^ Only evacuate moves
            -> Score       -- ^ Min gain threshold
            -> Score       -- ^ Min gain
            -> Maybe Table -- ^ The resulting table and commands
-tryBalance ini_tbl disk_moves evac_mode mg_limit min_gain =
+tryBalance ini_tbl disk_moves inst_moves evac_mode mg_limit min_gain =
     let Table ini_nl ini_il ini_cv _ = ini_tbl
         all_inst = Container.elems ini_il
         all_inst' = if evac_mode
@@ -551,7 +561,7 @@ tryBalance ini_tbl disk_moves evac_mode mg_limit min_gain =
         reloc_inst = filter Instance.movable all_inst'
         node_idx = map Node.idx . filter (not . Node.offline) $
                    Container.elems ini_nl
-        fin_tbl = checkMove node_idx disk_moves ini_tbl reloc_inst
+        fin_tbl = checkMove node_idx disk_moves inst_moves ini_tbl reloc_inst
         (Table _ _ fin_cv _) = fin_tbl
     in
       if fin_cv < ini_cv && (ini_cv > mg_limit || ini_cv - fin_cv >= min_gain)

htools/Ganeti/HTools/QC.hs

@@ -123,8 +123,8 @@ isNodeBig node size = Node.availDisk node > size * Types.unitDsk
                       && Node.availMem node > size * Types.unitMem
                       && Node.availCpu node > size * Types.unitCpu
 
-canBalance :: Cluster.Table -> Bool -> Bool -> Bool
-canBalance tbl dm evac = isJust $ Cluster.tryBalance tbl dm evac 0 0
+canBalance :: Cluster.Table -> Bool -> Bool -> Bool -> Bool
+canBalance tbl dm im evac = isJust $ Cluster.tryBalance tbl dm im evac 0 0
 
 -- | Assigns a new fresh instance to a cluster; this is not
 -- allocation, so no resource checks are done
@@ -746,7 +746,7 @@ prop_ClusterAlloc_sane node inst =
                (xnl, xi, _, cv):[] ->
                    let il' = Container.add (Instance.idx xi) xi il
                        tbl = Cluster.Table xnl il' cv []
-                   in not (canBalance tbl True False)
+                   in not (canBalance tbl True True False)
                _ -> False
 
 -- | Checks that on a 2-5 node cluster, we can allocate a random
@@ -815,7 +815,7 @@ prop_ClusterAllocBalance node =
                    let ynl = Container.add (Node.idx hnode) hnode xnl
                        cv = Cluster.compCV ynl
                        tbl = Cluster.Table ynl il' cv []
-                   in canBalance tbl True False
+                   in canBalance tbl True True False
 
 -- | Checks consistency
 prop_ClusterCheckConsistency node inst =

htools/hbal.hs

@@ -109,8 +109,8 @@ iterateDepth ini_tbl max_rounds disk_moves inst_moves nmlen imlen
     let Cluster.Table ini_nl ini_il _ _ = ini_tbl
         allowed_next = Cluster.doNextBalance ini_tbl max_rounds min_score
         m_fin_tbl = if allowed_next
-                    then Cluster.tryBalance ini_tbl disk_moves evac_mode
-                         mg_limit min_gain
+                    then Cluster.tryBalance ini_tbl disk_moves inst_moves
+                         evac_mode mg_limit min_gain
                     else Nothing
     in
       case m_fin_tbl of