Commit 58c0c208 authored by Klaus Aehlig's avatar Klaus Aehlig

Move allocation data structure to a separate module

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: default avatarKlaus Aehlig <aehlig@google.com>
Reviewed-by: default avatarPetr Pudlak <pudlak@google.com>
parent e1aa7721
......@@ -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 \
......
......@@ -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
......
......@@ -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
......
{-| 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)
......@@ -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"
......
......@@ -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
......
......@@ -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
......
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