Merge 'EvacNode' and 'NodeEvacMode'

[ganeti-local] / src / Ganeti / HTools / Cluster.hs

diff --git a/src/Ganeti/HTools/Cluster.hs b/src/Ganeti/HTools/Cluster.hs
index 6e615d7..fe3432c 100644 (file)
--- a/src/Ganeti/HTools/Cluster.hs
+++ b/src/Ganeti/HTools/Cluster.hs
@@ -76,9 +76,11 @@ module Ganeti.HTools.Cluster
   , splitCluster
   ) where
 
+import Control.Applicative (liftA2)
+import Control.Arrow ((&&&))
 import qualified Data.IntSet as IntSet
 import Data.List
-import Data.Maybe (fromJust, isNothing)
+import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
 import Data.Ord (comparing)
 import Text.Printf (printf)
 
@@ -92,7 +94,7 @@ import Ganeti.HTools.Types
 import Ganeti.Compat
 import qualified Ganeti.OpCodes as OpCodes
 import Ganeti.Utils
-import Ganeti.Types (mkNonEmpty)
+import Ganeti.Types (EvacMode(..), mkNonEmpty)
 
 -- * Types
 
@@ -1292,6 +1294,19 @@ iterateAlloc nl il limit newinst allocnodes ixes cstats =
                       newlimit newinst allocnodes (xi:ixes)
                       (totalResources xnl:cstats)
 
+-- | Predicate whether shrinking a single resource can lead to a valid
+-- allocation.
+sufficesShrinking :: (Instance.Instance -> AllocSolution) -> Instance.Instance
+                     -> FailMode  -> Maybe Instance.Instance
+sufficesShrinking allocFn inst fm =
+  case dropWhile (isNothing . asSolution . fst)
+       . takeWhile (liftA2 (||) (elem fm . asFailures . fst)
+                                (isJust . asSolution . fst))
+       . map (allocFn &&& id) $
+       iterateOk (`Instance.shrinkByType` fm) inst
+  of x:_ -> Just . snd $ x
+     _ -> Nothing
+
 -- | Tiered allocation method.
 --
 -- This places instances on the cluster, and decreases the spec until
@@ -1307,13 +1322,20 @@ tieredAlloc nl il limit newinst allocnodes ixes cstats =
           (stop, newlimit) = case limit of
                                Nothing -> (False, Nothing)
                                Just n -> (n <= ixes_cnt,
-                                            Just (n - ixes_cnt)) in
-      if stop then newsol else
-          case Instance.shrinkByType newinst . fst . last $
-               sortBy (comparing snd) errs of
-            Bad _ -> newsol
-            Ok newinst' -> tieredAlloc nl' il' newlimit
-                           newinst' allocnodes ixes' cstats'
+                                            Just (n - ixes_cnt))
+          sortedErrs = map fst $ sortBy (comparing snd) errs
+          suffShrink = sufficesShrinking (fromMaybe emptyAllocSolution
+                                          . flip (tryAlloc nl' il') allocnodes)
+                       newinst
+          bigSteps = filter isJust . map suffShrink . reverse $ sortedErrs
+      in if stop then newsol else
+          case bigSteps of
+            Just newinst':_ -> tieredAlloc nl' il' newlimit
+                               newinst' allocnodes ixes' cstats'
+            _ -> case Instance.shrinkByType newinst . last $ sortedErrs of
+                   Bad _ -> newsol
+                   Ok newinst' -> tieredAlloc nl' il' newlimit
+                                  newinst' allocnodes ixes' cstats'
 
 -- * Formatting functions
 
@@ -1496,9 +1518,11 @@ iMoveToJob nl il idx move =
                       Ok ne -> Just ne
       opF = OpCodes.OpInstanceMigrate
               { OpCodes.opInstanceName        = iname
+              , OpCodes.opInstanceUuid        = Nothing
               , OpCodes.opMigrationMode       = Nothing -- default
               , OpCodes.opOldLiveMode         = Nothing -- default as well
               , OpCodes.opTargetNode          = Nothing -- this is drbd
+              , OpCodes.opTargetNodeUuid      = Nothing
               , OpCodes.opAllowRuntimeChanges = False
               , OpCodes.opIgnoreIpolicy       = False
               , OpCodes.opMigrationCleanup    = False
@@ -1507,11 +1531,13 @@ iMoveToJob nl il idx move =
       opFA n = opF { OpCodes.opTargetNode = lookNode n } -- not drbd
       opR n = OpCodes.OpInstanceReplaceDisks
                 { OpCodes.opInstanceName     = iname
+                , OpCodes.opInstanceUuid     = Nothing
                 , OpCodes.opEarlyRelease     = False
                 , OpCodes.opIgnoreIpolicy    = False
                 , OpCodes.opReplaceDisksMode = OpCodes.ReplaceNewSecondary
                 , OpCodes.opReplaceDisksList = []
                 , OpCodes.opRemoteNode       = lookNode n
+                , OpCodes.opRemoteNodeUuid   = Nothing
                 , OpCodes.opIallocator       = Nothing
                 }
   in case move of