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
