From 6cb1649fbf491356cf30661cf5bb31c8eb4bcd7e Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Tue, 1 Feb 2011 13:57:50 +0100
Subject: [PATCH] Extract node pair generation from tryAlloc
Currently, tryAlloc generates the list of allocation nodes or node
pairs (depending on how many nodes are requested) internally. This
patch moves the generation into a new function genAllocNodes, for both
code cleanup and future performance improvements.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
Ganeti/HTools/Cluster.hs | 47 +++++++++++++++++++++++++---------------
Ganeti/HTools/QC.hs | 6 ++---
2 files changed, 32 insertions(+), 21 deletions(-)
diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index 22be42a48..5f63390ae 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -55,6 +55,7 @@ module Ganeti.HTools.Cluster
, printStats
, iMoveToJob
-- * IAllocator functions
+ , genAllocNodes
, tryAlloc
, tryMGAlloc
, tryReloc
@@ -103,6 +104,13 @@ data AllocSolution = AllocSolution
type AllocResult = (FailStats, Node.List, Instance.List,
[Instance.Instance], [CStats])
+
+-- | A type denoting the valid allocation mode/pairs.
+-- For a one-node allocation, this will be a @Left ['Node.Node']@,
+-- whereas for a two-node allocation, this will be a @Right
+-- [('Node.Node', 'Node.Node')]@.
+type AllocNodes = Either [Node.Node] [(Node.Node, Node.Node)]
+
-- | The empty solution we start with when computing allocations
emptySolution :: AllocSolution
emptySolution = AllocSolution { asFailures = [], asAllocs = 0
@@ -614,19 +622,29 @@ describeSolution as =
annotateSolution :: AllocSolution -> AllocSolution
annotateSolution as = as { asLog = describeSolution as : asLog as }
+-- | Generate the valid node allocation singles or pairs for a new instance.
+genAllocNodes :: Node.List -- ^ The node map
+ -> Int -- ^ The number of nodes required
+ -> Result AllocNodes -- ^ The (monadic) result
+genAllocNodes nl count =
+ let all_nodes = getOnline nl
+ all_pairs = liftM2 (,) all_nodes all_nodes
+ ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y &&
+ Node.group x == Node.group y) all_pairs
+ in case count of
+ 1 -> Ok (Left all_nodes)
+ 2 -> Ok (Right ok_pairs)
+ _ -> Bad "Unsupported number of nodes, only one or two supported"
+
-- | Try to allocate an instance on the cluster.
tryAlloc :: (Monad m) =>
Node.List -- ^ The node list
-> Instance.List -- ^ The instance list
-> Instance.Instance -- ^ The instance to allocate
- -> Int -- ^ Required number of nodes
+ -> AllocNodes -- ^ The allocation targets
-> m AllocSolution -- ^ Possible solution list
-tryAlloc nl _ inst 2 =
- let all_nodes = getOnline nl
- all_pairs = liftM2 (,) all_nodes all_nodes
- ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y &&
- Node.group x == Node.group y) all_pairs
- sols = foldl' (\cstate (p, s) ->
+tryAlloc nl _ inst (Right ok_pairs) =
+ let sols = foldl' (\cstate (p, s) ->
concatAllocs cstate $ allocateOnPair nl inst p s
) emptySolution ok_pairs
@@ -634,19 +652,14 @@ tryAlloc nl _ inst 2 =
then fail "Not enough online nodes"
else return $ annotateSolution sols
-tryAlloc nl _ inst 1 =
- let all_nodes = getOnline nl
- sols = foldl' (\cstate ->
+tryAlloc nl _ inst (Left all_nodes) =
+ let sols = foldl' (\cstate ->
concatAllocs cstate . allocateOnSingle nl inst
) emptySolution all_nodes
in if null all_nodes
then fail "No online nodes"
else return $ annotateSolution sols
-tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \
- \destinations required (" ++ show reqn ++
- "), only two supported"
-
-- | Given a group/result, describe it as a nice (list of) messages
solutionDescription :: Group.List -> (Gdx, Result AllocSolution) -> [String]
solutionDescription gl (groupId, result) =
@@ -690,8 +703,8 @@ tryMGAlloc mggl mgnl mgil inst cnt =
let groups = splitCluster mgnl mgil
-- TODO: currently we consider all groups preferred
sols = map (\(gid, (nl, il)) ->
- (gid, tryAlloc nl il inst cnt)) groups::
- [(Gdx, Result AllocSolution)]
+ (gid, genAllocNodes nl cnt >>= tryAlloc nl il inst))
+ groups::[(Gdx, Result AllocSolution)]
all_msgs = concatMap (solutionDescription mggl) sols
goodSols = filterMGResults mggl sols
sortedSols = sortMGResults mggl goodSols
@@ -834,7 +847,7 @@ iterateAlloc nl il newinst nreq ixes cstats =
newname = printf "new-%d" depth::String
newidx = length (Container.elems il) + depth
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
- in case tryAlloc nl il newi2 nreq of
+ in case genAllocNodes nl nreq >>= tryAlloc nl il newi2 of
Bad s -> Bad s
Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) ->
case sols3 of
diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs
index 5c250c7a0..0a36a0bcf 100644
--- a/Ganeti/HTools/QC.hs
+++ b/Ganeti/HTools/QC.hs
@@ -683,9 +683,8 @@ prop_ClusterAlloc_sane node inst =
==>
let nl = makeSmallCluster node count
il = Container.empty
- rqnodes = 2
inst' = setInstanceSmallerThanNode node inst
- in case Cluster.tryAlloc nl il inst' rqnodes of
+ in case Cluster.genAllocNodes nl 2 >>= Cluster.tryAlloc nl il inst' of
Types.Bad _ -> False
Types.Ok as ->
case Cluster.asSolutions as of
@@ -724,9 +723,8 @@ prop_ClusterAllocEvac node inst =
==>
let nl = makeSmallCluster node count
il = Container.empty
- rqnodes = 2
inst' = setInstanceSmallerThanNode node inst
- in case Cluster.tryAlloc nl il inst' rqnodes of
+ in case Cluster.genAllocNodes nl 2 >>= Cluster.tryAlloc nl il inst' of
Types.Bad _ -> False
Types.Ok as ->
case Cluster.asSolutions as of
--
GitLab