Move all data structures related to allocation solutions to a separate module. In this way, we can extend these in a clean way, e.g., to support later filtering.
Signed-off-by: Klaus Aehlig <[email protected]> --- Makefile.am | 1 + src/Ganeti/HTools/Backend/IAlloc.hs | 13 +- src/Ganeti/HTools/Cluster.hs | 142 +----------------- src/Ganeti/HTools/Cluster/AllocationSolution.hs | 192 ++++++++++++++++++++++++ src/Ganeti/HTools/Dedicated.hs | 37 ++--- src/Ganeti/HTools/Node.hs | 10 -- test/hs/Test/Ganeti/HTools/Cluster.hs | 9 +- 7 files changed, 232 insertions(+), 172 deletions(-) create mode 100644 src/Ganeti/HTools/Cluster/AllocationSolution.hs diff --git a/Makefile.am b/Makefile.am index 762e355..ed4e1b6 100644 --- a/Makefile.am +++ b/Makefile.am @@ -905,6 +905,7 @@ HS_LIB_SRCS = \ src/Ganeti/HTools/Backend/Text.hs \ src/Ganeti/HTools/CLI.hs \ src/Ganeti/HTools/Cluster.hs \ + src/Ganeti/HTools/Cluster/AllocationSolution.hs \ src/Ganeti/HTools/Cluster/Evacuate.hs \ src/Ganeti/HTools/Cluster/Metrics.hs \ src/Ganeti/HTools/Cluster/Moves.hs \ diff --git a/src/Ganeti/HTools/Backend/IAlloc.hs b/src/Ganeti/HTools/Backend/IAlloc.hs index 3451282..ffd277d 100644 --- a/src/Ganeti/HTools/Backend/IAlloc.hs +++ b/src/Ganeti/HTools/Backend/IAlloc.hs @@ -52,6 +52,7 @@ import Text.JSON (JSObject, JSValue(JSArray), import Ganeti.BasicTypes import qualified Ganeti.HTools.Cluster as Cluster +import qualified Ganeti.HTools.Cluster.AllocationSolution as AllocSol import qualified Ganeti.HTools.Cluster.Evacuate as Evacuate import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Group as Group @@ -287,16 +288,16 @@ formatResponse success info result = in encodeStrict $ makeObj [e_success, e_info, e_result] -- | Flatten the log of a solution into a string. -describeSolution :: Cluster.GenericAllocSolution a -> String -describeSolution = intercalate ", " . Cluster.asLog +describeSolution :: AllocSol.GenericAllocSolution a -> String +describeSolution = intercalate ", " . AllocSol.asLog -- | Convert allocation/relocation results into the result format. formatAllocate :: Instance.List - -> Cluster.GenericAllocSolution a + -> AllocSol.GenericAllocSolution a -> Result IAllocResult formatAllocate il as = do let info = describeSolution as - case Cluster.asSolution as of + case AllocSol.asSolution as of Nothing -> fail info Just (nl, inst, nodes, _) -> do @@ -309,9 +310,9 @@ formatMultiAlloc :: ( Node.List, Instance.List -> Result IAllocResult formatMultiAlloc (fin_nl, fin_il, ars) = let rars = reverse ars - (allocated, failed) = partition (isJust . Cluster.asSolution . snd) rars + (allocated, failed) = partition (isJust . AllocSol.asSolution . snd) rars aars = map (\(_, ar) -> - let (_, inst, nodes, _) = fromJust $ Cluster.asSolution ar + let (_, inst, nodes, _) = fromJust $ AllocSol.asSolution ar iname = Instance.name inst nnames = map Node.name nodes in (iname, nnames)) allocated diff --git a/src/Ganeti/HTools/Cluster.hs b/src/Ganeti/HTools/Cluster.hs index 8913c37..b7191fe 100644 --- a/src/Ganeti/HTools/Cluster.hs +++ b/src/Ganeti/HTools/Cluster.hs @@ -39,13 +39,6 @@ module Ganeti.HTools.Cluster ( -- * Types AllocDetails(..) - , GenericAllocSolution(..) - , AllocSolution - , emptyAllocSolution - , concatAllocs - , sumAllocs - , updateIl - , extractNl , Table(..) , CStats(..) , AllocNodes @@ -68,8 +61,6 @@ module Ganeti.HTools.Cluster -- * Display functions , printNodes , printInsts - , genericAnnotateSolution - , solutionDescription -- * Balacing functions , doNextBalance , tryBalance @@ -82,7 +73,6 @@ module Ganeti.HTools.Cluster , filterMGResults , sortMGResults , tryChangeGroup - , collapseFailures , allocList -- * Allocation functions , iterateAlloc @@ -104,6 +94,10 @@ import Text.Printf (printf) import Ganeti.BasicTypes import Ganeti.HTools.AlgorithmParams (AlgorithmOptions(..), defaultOptions) import qualified Ganeti.HTools.Container as Container +import Ganeti.HTools.Cluster.AllocationSolution + ( AllocElement, GenericAllocSolution(..) , AllocSolution, emptyAllocSolution + , sumAllocs, concatAllocs, extractNl, updateIl + , annotateSolution, solutionDescription, collapseFailures ) import Ganeti.HTools.Cluster.Evacuate ( EvacSolution(..), emptyEvacSolution , updateEvacSolution, reverseEvacSolution , nodeEvacInstance) @@ -131,23 +125,13 @@ import Ganeti.Types (EvacMode(..)) data AllocDetails = AllocDetails Int (Maybe String) deriving (Show) --- | Allocation\/relocation solution. -data GenericAllocSolution a = AllocSolution - { asFailures :: [FailMode] -- ^ Failure counts - , asAllocs :: Int -- ^ Good allocation count - , asSolution :: Maybe (Node.GenericAllocElement a) -- ^ The actual allocation - -- result - , asLog :: [String] -- ^ Informational messages - } - -type AllocSolution = GenericAllocSolution Score - -- | Allocation results, as used in 'iterateAlloc' and 'tieredAlloc'. type AllocResult = (FailStats, Node.List, Instance.List, [Instance.Instance], [CStats]) -- | Type alias for easier handling. -type GenericAllocSolutionList a = [(Instance.Instance, GenericAllocSolution a)] +type GenericAllocSolutionList a = + [(Instance.Instance, GenericAllocSolution a)] type AllocSolutionList = GenericAllocSolutionList Score -- | A type denoting the valid allocation mode/pairs. @@ -159,11 +143,6 @@ type AllocSolutionList = GenericAllocSolutionList Score -- secondary nodes in the sub-list. type AllocNodes = Either [Ndx] [(Ndx, [Ndx])] --- | The empty solution we start with when computing allocations. -emptyAllocSolution :: GenericAllocSolution a -emptyAllocSolution = AllocSolution { asFailures = [], asAllocs = 0 - , asSolution = Nothing, asLog = [] } - -- | The complete state for the balancing solution. data Table = Table Node.List Instance.List Score [Placement] deriving (Show) @@ -336,7 +315,7 @@ compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) = -- | Tries to allocate an instance on one given node. allocateOnSingle :: AlgorithmOptions -> Node.List -> Instance.Instance -> Ndx - -> OpResult Node.AllocElement + -> OpResult AllocElement allocateOnSingle opts nl inst new_pdx = let p = Container.find new_pdx nl new_inst = Instance.setBoth inst new_pdx Node.noSecondary @@ -352,7 +331,7 @@ allocateOnSingle opts nl inst new_pdx = allocateOnPair :: AlgorithmOptions -> [Statistics] -> Node.List -> Instance.Instance -> Ndx -> Ndx - -> OpResult Node.AllocElement + -> OpResult AllocElement allocateOnPair opts stats nl inst new_pdx new_sdx = let tgt_p = Container.find new_pdx nl tgt_s = Container.find new_sdx nl @@ -529,86 +508,6 @@ tryBalance opts ini_tbl = -- * Allocation functions --- | Build failure stats out of a list of failures. -collapseFailures :: [FailMode] -> FailStats -collapseFailures flst = - map (\k -> (k, foldl' (\a e -> if e == k then a + 1 else a) 0 flst)) - [minBound..maxBound] - --- | Compares two Maybe AllocElement and chooses the best score. -bestAllocElement :: Ord a - => Maybe (Node.GenericAllocElement a) - -> Maybe (Node.GenericAllocElement a) - -> Maybe (Node.GenericAllocElement a) -bestAllocElement a Nothing = a -bestAllocElement Nothing b = b -bestAllocElement a@(Just (_, _, _, ascore)) b@(Just (_, _, _, bscore)) = - if ascore < bscore then a else b - --- | Update current Allocation solution and failure stats with new --- elements. -concatAllocs :: Ord a - => GenericAllocSolution a - -> OpResult (Node.GenericAllocElement a) - -> GenericAllocSolution a -concatAllocs as (Bad reason) = as { asFailures = reason : asFailures as } - -concatAllocs as (Ok ns) = - let -- Choose the old or new solution, based on the cluster score - cntok = asAllocs as - osols = asSolution as - nsols = bestAllocElement osols (Just ns) - nsuc = cntok + 1 - -- Note: we force evaluation of nsols here in order to keep the - -- memory profile low - we know that we will need nsols for sure - -- in the next cycle, so we force evaluation of nsols, since the - -- foldl' in the caller will only evaluate the tuple, but not the - -- elements of the tuple - in nsols `seq` nsuc `seq` as { asAllocs = nsuc, asSolution = nsols } - --- | Sums two 'AllocSolution' structures. -sumAllocs :: Ord a - => GenericAllocSolution a - -> GenericAllocSolution a - -> GenericAllocSolution a -sumAllocs (AllocSolution aFails aAllocs aSols aLog) - (AllocSolution bFails bAllocs bSols bLog) = - -- note: we add b first, since usually it will be smaller; when - -- fold'ing, a will grow and grow whereas b is the per-group - -- result, hence smaller - let nFails = bFails ++ aFails - nAllocs = aAllocs + bAllocs - nSols = bestAllocElement aSols bSols - nLog = bLog ++ aLog - in AllocSolution nFails nAllocs nSols nLog - --- | Given a solution, generates a reasonable description for it. -genericDescribeSolution :: (a -> String) -> GenericAllocSolution a -> String -genericDescribeSolution formatMetrics as = - let fcnt = asFailures as - sols = asSolution as - freasons = - intercalate ", " . map (\(a, b) -> printf "%s: %d" (show a) b) . - filter ((> 0) . snd) . collapseFailures $ fcnt - in case sols of - Nothing -> "No valid allocation solutions, failure reasons: " ++ - (if null fcnt then "unknown reasons" else freasons) - Just (_, _, nodes, cv) -> - printf ("score: %s, successes %d, failures %d (%s)" ++ - " for node(s) %s") (formatMetrics cv) (asAllocs as) - (length fcnt) freasons - (intercalate "/" . map Node.name $ nodes) - --- | Annotates a solution with the appropriate string. -genericAnnotateSolution :: (a -> String) - ->GenericAllocSolution a -> GenericAllocSolution a -genericAnnotateSolution formatMetrics as = - as { asLog = genericDescribeSolution formatMetrics as : asLog as } - --- | Annotate a solution based on the standard metrics -annotateSolution :: AllocSolution -> AllocSolution -annotateSolution = genericAnnotateSolution (printf "%.8f") - -- | Generate the valid node allocation singles or pairs for a new instance. genAllocNodes :: Group.List -- ^ Group list -> Node.List -- ^ The node map @@ -658,16 +557,6 @@ tryAlloc opts nl _ inst (Left all_nodes) = ) emptyAllocSolution all_nodes in return $ annotateSolution sols --- | Given a group/result, describe it as a nice (list of) messages. -solutionDescription :: (Group.Group, Result (GenericAllocSolution a)) - -> [String] -solutionDescription (grp, result) = - case result of - 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 grp - pol = allocPolicyToRaw (Group.allocPolicy grp) - -- | From a list of possibly bad and possibly empty solutions, filter -- only the groups with a valid result. Note that the result will be -- reversed compared to the original list. @@ -797,21 +686,6 @@ tryGroupAlloc opts mggl mgnl ngil gn inst cnt = do (solution, msgs) <- findAllocation opts mggl mgnl ngil gdx inst cnt return $ solution { asLog = msgs } --- | Calculate the new instance list after allocation solution. -updateIl :: Instance.List -- ^ The original instance list - -> Maybe (Node.GenericAllocElement a) -- ^ The result of - -- the allocation attempt - -> Instance.List -- ^ The updated instance list -updateIl il Nothing = il -updateIl il (Just (_, xi, _, _)) = Container.add (Container.size il) xi il - --- | Extract the the new node list from the allocation solution. -extractNl :: Node.List -- ^ The original node list - -> Maybe (Node.GenericAllocElement a) -- ^ The result of the - -- allocation attempt - -> Node.List -- ^ The new node list -extractNl nl Nothing = nl -extractNl _ (Just (xnl, _, _, _)) = xnl -- | Try to allocate a list of instances on a multi-group cluster. allocList :: AlgorithmOptions diff --git a/src/Ganeti/HTools/Cluster/AllocationSolution.hs b/src/Ganeti/HTools/Cluster/AllocationSolution.hs new file mode 100644 index 0000000..267d4cf --- /dev/null +++ b/src/Ganeti/HTools/Cluster/AllocationSolution.hs @@ -0,0 +1,192 @@ +{-| Implementation of handling of Allocation Solutions + +-} + +{- + +Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-} + +module Ganeti.HTools.Cluster.AllocationSolution + ( GenericAllocElement + , AllocElement + , GenericAllocSolution(..) + , AllocSolution + , emptyAllocSolution + , sumAllocs + , concatAllocs + , updateIl + , extractNl + , collapseFailures + , genericAnnotateSolution + , annotateSolution + , solutionDescription + ) where + +import Data.List (intercalate, foldl') +import Text.Printf (printf) + +import Ganeti.BasicTypes (GenericResult(..), Result) +import qualified Ganeti.HTools.Container as Container +import qualified Ganeti.HTools.Group as Group +import qualified Ganeti.HTools.Instance as Instance +import qualified Ganeti.HTools.Node as Node +import qualified Ganeti.HTools.Types as T + +-- | A simple name for an allocation element (here just for logistic +-- reasons), generic in the type of the metric. +type GenericAllocElement a = (Node.List, Instance.Instance, [Node.Node], a) + +-- | A simple name for an allocation element (here just for logistic +-- reasons). +type AllocElement = GenericAllocElement T.Score + +-- | Allocation\/relocation solution. +data GenericAllocSolution a = AllocSolution + { asFailures :: [T.FailMode] -- ^ Failure counts + , asAllocs :: Int -- ^ Good allocation count + , asSolution :: Maybe (GenericAllocElement a) -- ^ The actual allocation + -- result + , asLog :: [String] -- ^ Informational messages + } +type AllocSolution = GenericAllocSolution T.Score + +-- | The empty solution we start with when computing allocations. +emptyAllocSolution :: GenericAllocSolution a +emptyAllocSolution = AllocSolution { asFailures = [], asAllocs = 0 + , asSolution = Nothing, asLog = [] } + + +-- | Calculate the new instance list after allocation solution. +updateIl :: Instance.List -- ^ The original instance list + -> Maybe (GenericAllocElement a) -- ^ The result of + -- the allocation attempt + -> Instance.List -- ^ The updated instance list +updateIl il Nothing = il +updateIl il (Just (_, xi, _, _)) = Container.add (Container.size il) xi il + +-- | Extract the the new node list from the allocation solution. +extractNl :: Node.List -- ^ The original node list + -> Maybe (GenericAllocElement a) -- ^ The result of the + -- allocation attempt + -> Node.List -- ^ The new node list +extractNl nl Nothing = nl +extractNl _ (Just (xnl, _, _, _)) = xnl + +-- | Compares two Maybe AllocElement and chooses the best score. +bestAllocElement :: Ord a + => Maybe (GenericAllocElement a) + -> Maybe (GenericAllocElement a) + -> Maybe (GenericAllocElement a) +bestAllocElement a Nothing = a +bestAllocElement Nothing b = b +bestAllocElement a@(Just (_, _, _, ascore)) b@(Just (_, _, _, bscore)) = + if ascore < bscore then a else b + +-- | Update current Allocation solution and failure stats with new +-- elements. +concatAllocs :: Ord a + => GenericAllocSolution a + -> T.OpResult (GenericAllocElement a) + -> GenericAllocSolution a +concatAllocs as (Bad reason) = as { asFailures = reason : asFailures as } + +concatAllocs as (Ok ns) = + let -- Choose the old or new solution, based on the cluster score + cntok = asAllocs as + osols = asSolution as + nsols = bestAllocElement osols (Just ns) + nsuc = cntok + 1 + -- Note: we force evaluation of nsols here in order to keep the + -- memory profile low - we know that we will need nsols for sure + -- in the next cycle, so we force evaluation of nsols, since the + -- foldl' in the caller will only evaluate the tuple, but not the + -- elements of the tuple + in nsols `seq` nsuc `seq` as { asAllocs = nsuc, asSolution = nsols } + +-- | Sums two 'AllocSolution' structures. +sumAllocs :: Ord a + => GenericAllocSolution a + -> GenericAllocSolution a + -> GenericAllocSolution a +sumAllocs (AllocSolution aFails aAllocs aSols aLog) + (AllocSolution bFails bAllocs bSols bLog) = + -- note: we add b first, since usually it will be smaller; when + -- fold'ing, a will grow and grow whereas b is the per-group + -- result, hence smaller + let nFails = bFails ++ aFails + nAllocs = aAllocs + bAllocs + nSols = bestAllocElement aSols bSols + nLog = bLog ++ aLog + in AllocSolution nFails nAllocs nSols nLog + +-- | Build failure stats out of a list of failures. +collapseFailures :: [T.FailMode] -> T.FailStats +collapseFailures flst = + map (\k -> (k, foldl' (\a e -> if e == k then a + 1 else a) 0 flst)) + [minBound..maxBound] + + +-- | Given a solution, generates a reasonable description for it. +genericDescribeSolution :: (a -> String) -> GenericAllocSolution a -> String +genericDescribeSolution formatMetrics as = + let fcnt = asFailures as + sols = asSolution as + freasons = + intercalate ", " . map (\(a, b) -> printf "%s: %d" (show a) b) . + filter ((> 0) . snd) . collapseFailures $ fcnt + in case sols of + Nothing -> "No valid allocation solutions, failure reasons: " ++ + (if null fcnt then "unknown reasons" else freasons) + Just (_, _, nodes, cv) -> + printf ("score: %s, successes %d, failures %d (%s)" ++ + " for node(s) %s") (formatMetrics cv) (asAllocs as) + (length fcnt) freasons + (intercalate "/" . map Node.name $ nodes) + +-- | Annotates a solution with the appropriate string. +genericAnnotateSolution :: (a -> String) + ->GenericAllocSolution a -> GenericAllocSolution a +genericAnnotateSolution formatMetrics as = + as { asLog = genericDescribeSolution formatMetrics as : asLog as } + +-- | Annotate a solution based on the standard metrics +annotateSolution :: AllocSolution -> AllocSolution +annotateSolution = genericAnnotateSolution (printf "%.8f") + + +-- | Given a group/result, describe it as a nice (list of) messages. +solutionDescription :: (Group.Group, Result (GenericAllocSolution a)) + -> [String] +solutionDescription (grp, result) = + case result of + 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 grp + pol = T.allocPolicyToRaw (Group.allocPolicy grp) + diff --git a/src/Ganeti/HTools/Dedicated.hs b/src/Ganeti/HTools/Dedicated.hs index 8059766..d31641d 100644 --- a/src/Ganeti/HTools/Dedicated.hs +++ b/src/Ganeti/HTools/Dedicated.hs @@ -57,6 +57,7 @@ import Ganeti.BasicTypes (iterateOk, Result, failError) import qualified Ganeti.HTools.AlgorithmParams as Alg import qualified Ganeti.HTools.Backend.IAlloc as IAlloc import qualified Ganeti.HTools.Cluster as Cluster +import qualified Ganeti.HTools.Cluster.AllocationSolution as AllocSol import qualified Ganeti.HTools.Cluster.Utils as ClusterUtils import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Group as Group @@ -132,7 +133,7 @@ lostAllocationsMetric opts insts inst node = do -- | Allocate an instance on a given node. allocateOnSingle :: Alg.AlgorithmOptions -> Node.List -> Instance.Instance -> T.Ndx - -> T.OpResult (Node.GenericAllocElement Metric) + -> T.OpResult (AllocSol.GenericAllocElement Metric) allocateOnSingle opts nl inst new_pdx = do let primary = Container.find new_pdx nl policy = Node.iPolicy primary @@ -150,7 +151,7 @@ allocateOnPair :: Alg.AlgorithmOptions -> Instance.Instance -> T.Ndx -> T.Ndx - -> T.OpResult (Node.GenericAllocElement Metric) + -> T.OpResult (AllocSol.GenericAllocElement Metric) allocateOnPair opts nl inst pdx sdx = do let primary = Container.find pdx nl secondary = Container.find sdx nl @@ -174,7 +175,7 @@ findAllocation :: Alg.AlgorithmOptions -> T.Gdx -> Instance.Instance -> Int - -> Result (Cluster.GenericAllocSolution Metric, [String]) + -> Result (AllocSol.GenericAllocSolution Metric, [String]) findAllocation opts mggl mgnl gdx inst count = do let nl = Container.filter ((== gdx) . Node.group) mgnl group = Container.find gdx mggl @@ -185,22 +186,22 @@ findAllocation opts mggl mgnl gdx inst count = do solution <- case allocNodes of (Right []) -> fail "Not enough online nodes" (Right pairs) -> - let sols = foldl Cluster.sumAllocs Cluster.emptyAllocSolution + let sols = foldl AllocSol.sumAllocs AllocSol.emptyAllocSolution $ map (\(p, ss) -> foldl (\cstate -> - Cluster.concatAllocs cstate + AllocSol.concatAllocs cstate . allocateOnPair opts nl inst p) - Cluster.emptyAllocSolution ss) + AllocSol.emptyAllocSolution ss) pairs - in return $ Cluster.genericAnnotateSolution show sols + in return $ AllocSol.genericAnnotateSolution show sols (Left []) -> fail "No online nodes" (Left nodes) -> let sols = foldl (\cstate -> - Cluster.concatAllocs cstate + AllocSol.concatAllocs cstate . allocateOnSingle opts nl inst) - Cluster.emptyAllocSolution nodes - in return $ Cluster.genericAnnotateSolution show sols - return (solution, Cluster.solutionDescription (group, return solution)) + AllocSol.emptyAllocSolution nodes + in return $ AllocSol.genericAnnotateSolution show sols + return (solution, AllocSol.solutionDescription (group, return solution)) -- | Find an allocation in a suitable group. findMGAllocation :: Alg.AlgorithmOptions @@ -209,19 +210,19 @@ findMGAllocation :: Alg.AlgorithmOptions -> Instance.List -> Instance.Instance -> Int - -> Result (Cluster.GenericAllocSolution Metric) + -> Result (AllocSol.GenericAllocSolution Metric) findMGAllocation opts gl nl il inst count = do let groups_by_idx = ClusterUtils.splitCluster nl il genSol (gdx, (nl', _)) = liftM fst $ findAllocation opts gl nl' gdx inst count sols = map (flip Container.find gl . fst &&& genSol) groups_by_idx goodSols = Cluster.sortMGResults $ Cluster.filterMGResults sols - all_msgs = concatMap Cluster.solutionDescription sols + all_msgs = concatMap AllocSol.solutionDescription sols case goodSols of [] -> fail $ intercalate ", " all_msgs (final_group, final_sol):_ -> let sel_msg = "Selected group: " ++ Group.name final_group - in return $ final_sol { Cluster.asLog = sel_msg : all_msgs } + in return $ final_sol { AllocSol.asLog = sel_msg : all_msgs } -- | Handle allocation requests in the dedicated scenario. runDedicatedAllocation :: Alg.AlgorithmOptions @@ -234,7 +235,7 @@ runDedicatedAllocation opts request = Loader.Allocate inst (Cluster.AllocDetails count (Just gn)) -> do gdx <- Group.idx <$> Container.findByName gl gn (solution, msgs) <- findAllocation opts gl nl gdx inst count - IAlloc.formatAllocate il $ solution { Cluster.asLog = msgs } + IAlloc.formatAllocate il $ solution { AllocSol.asLog = msgs } Loader.Allocate inst (Cluster.AllocDetails count Nothing) -> findMGAllocation opts gl nl il inst count >>= IAlloc.formatAllocate il @@ -248,9 +249,9 @@ runDedicatedAllocation opts request = liftM fst $ findAllocation opts gl nl gdx inst count) maybeGroup - let sol = Cluster.asSolution ares - nl'' = Cluster.extractNl nl' sol - il'' = Cluster.updateIl il' sol + let sol = AllocSol.asSolution ares + nl'' = AllocSol.extractNl nl' sol + il'' = AllocSol.updateIl il' sol return (nl'', il'', (inst, ares):res)) (nl, il, []) insts _ -> fail "Dedicated Allocation only for proper allocation requests" diff --git a/src/Ganeti/HTools/Node.hs b/src/Ganeti/HTools/Node.hs index 55712d1..795054b 100644 --- a/src/Ganeti/HTools/Node.hs +++ b/src/Ganeti/HTools/Node.hs @@ -91,8 +91,6 @@ module Ganeti.HTools.Node , list -- * Misc stuff , AssocList - , GenericAllocElement - , AllocElement , noSecondary , computeGroups , mkNodeGraph @@ -245,14 +243,6 @@ type AssocList = [(T.Ndx, Node)] -- | A simple name for a node map. type List = Container.Container Node --- | A simple name for an allocation element (here just for logistic --- reasons), generic in the type of the metric. -type GenericAllocElement a = (List, Instance.Instance, [Node], a) - --- | A simple name for an allocation element (here just for logistic --- reasons). -type AllocElement = GenericAllocElement T.Score - -- | Constant node index for a non-moveable instance. noSecondary :: T.Ndx noSecondary = -1 diff --git a/test/hs/Test/Ganeti/HTools/Cluster.hs b/test/hs/Test/Ganeti/HTools/Cluster.hs index 2d54c27..61cfd2d 100644 --- a/test/hs/Test/Ganeti/HTools/Cluster.hs +++ b/test/hs/Test/Ganeti/HTools/Cluster.hs @@ -54,6 +54,7 @@ import Ganeti.BasicTypes import qualified Ganeti.HTools.AlgorithmParams as Alg import qualified Ganeti.HTools.Backend.IAlloc as IAlloc import qualified Ganeti.HTools.Cluster as Cluster +import qualified Ganeti.HTools.Cluster.AllocationSolution as AllocSol import qualified Ganeti.HTools.Cluster.Evacuate as Evacuate import qualified Ganeti.HTools.Cluster.Metrics as Metrics import qualified Ganeti.HTools.Cluster.Utils as ClusterUtils @@ -161,7 +162,7 @@ prop_Alloc_sane inst = Cluster.tryAlloc opts nl il inst' of Bad msg -> failTest msg Ok as -> - case Cluster.asSolution as of + case AllocSol.asSolution as of Nothing -> failTest "Failed to allocate, empty solution" Just (xnl, xi, _, cv) -> let il' = Container.add (Instance.idx xi) xi il @@ -218,7 +219,7 @@ genClusterAlloc count node inst = Cluster.tryAlloc opts nl Container.empty inst of Bad msg -> Bad $ "Can't allocate: " ++ msg Ok as -> - case Cluster.asSolution as of + case AllocSol.asSolution as of Nothing -> Bad "Empty solution?" Just (xnl, xi, _, _) -> let xil = Container.add (Instance.idx xi) xi Container.empty @@ -373,9 +374,9 @@ canAllocOn nl reqnodes inst = Cluster.tryAlloc Alg.defaultOptions nl Container.empty inst of Bad msg -> Just $ "Can't allocate: " ++ msg Ok as -> - case Cluster.asSolution as of + case AllocSol.asSolution as of Nothing -> Just $ "No allocation solution; failures: " ++ - show (Cluster.collapseFailures $ Cluster.asFailures as) + show (AllocSol.collapseFailures $ AllocSol.asFailures as) Just _ -> Nothing -- | Checks that allocation obeys minimum and maximum instance -- 2.2.0.rc0.207.ga3a616c
