Revision 478df686 Ganeti/HTools/Cluster.hs
b/Ganeti/HTools/Cluster.hs | ||
---|---|---|
51 | 51 |
-- * IAllocator functions |
52 | 52 |
, tryAlloc |
53 | 53 |
, tryReloc |
54 |
, collapseFailures |
|
54 | 55 |
) where |
55 | 56 |
|
56 | 57 |
import Data.List |
... | ... | |
73 | 74 |
type Placement = (Idx, Ndx, Ndx, Score) |
74 | 75 |
|
75 | 76 |
-- | Allocation\/relocation solution. |
76 |
type AllocSolution = [OpResult (Node.List, Instance.Instance, [Node.Node])] |
|
77 |
type AllocSolution = ([FailMode], Int, Maybe (Score, AllocElement)) |
|
78 |
|
|
79 |
-- | Allocation\/relocation element. |
|
80 |
type AllocElement = (Node.List, Instance.Instance, [Node.Node]) |
|
77 | 81 |
|
78 | 82 |
-- | An instance move definition |
79 | 83 |
data IMove = Failover -- ^ Failover the instance (f) |
... | ... | |
332 | 336 |
|
333 | 337 |
-- | Tries to allocate an instance on one given node. |
334 | 338 |
allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node |
335 |
-> OpResult (Node.List, Instance.Instance, [Node.Node])
|
|
339 |
-> OpResult AllocElement
|
|
336 | 340 |
allocateOnSingle nl inst p = |
337 | 341 |
let new_pdx = Node.idx p |
338 | 342 |
new_inst = Instance.setBoth inst new_pdx Node.noSecondary |
... | ... | |
342 | 346 |
|
343 | 347 |
-- | Tries to allocate an instance on a given pair of nodes. |
344 | 348 |
allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node |
345 |
-> OpResult (Node.List, Instance.Instance, [Node.Node])
|
|
349 |
-> OpResult AllocElement
|
|
346 | 350 |
allocateOnPair nl inst tgt_p tgt_s = |
347 | 351 |
let new_pdx = Node.idx tgt_p |
348 | 352 |
new_sdx = Node.idx tgt_s |
... | ... | |
432 | 436 |
else |
433 | 437 |
best_tbl |
434 | 438 |
|
435 |
-- * Alocation functions |
|
439 |
-- * Allocation functions |
|
440 |
|
|
441 |
-- | Build failure stats out of a list of failures |
|
442 |
collapseFailures :: [FailMode] -> FailStats |
|
443 |
collapseFailures flst = |
|
444 |
map (\k -> (k, length $ filter ((==) k) flst)) [minBound..maxBound] |
|
445 |
|
|
446 |
-- | Update current Allocation solution and failure stats with new |
|
447 |
-- elements |
|
448 |
concatAllocs :: AllocSolution -> OpResult AllocElement -> AllocSolution |
|
449 |
concatAllocs (flst, succ, sols) (OpFail reason) = (reason:flst, succ, sols) |
|
450 |
|
|
451 |
concatAllocs (flst, succ, osols) (OpGood ns@(nl, _, _)) = |
|
452 |
let nscore = compCV nl |
|
453 |
-- Choose the old or new solution, based on the cluster score |
|
454 |
nsols = case osols of |
|
455 |
Nothing -> Just (nscore, ns) |
|
456 |
Just (oscore, _) -> |
|
457 |
if oscore < nscore |
|
458 |
then osols |
|
459 |
else Just (nscore, ns) |
|
460 |
nsuc = succ + 1 |
|
461 |
-- Note: we force evaluation of nsols here in order to keep the |
|
462 |
-- memory profile low - we know that we will need nsols for sure |
|
463 |
-- in the next cycle, so we force evaluation of nsols, since the |
|
464 |
-- foldl' in the caller will only evaluate the tuple, but not the |
|
465 |
-- *elements* of the tuple |
|
466 |
in nsols `seq` nsuc `seq` (flst, nsuc, nsols) |
|
436 | 467 |
|
437 | 468 |
-- | Try to allocate an instance on the cluster. |
438 | 469 |
tryAlloc :: (Monad m) => |
... | ... | |
445 | 476 |
let all_nodes = getOnline nl |
446 | 477 |
all_pairs = liftM2 (,) all_nodes all_nodes |
447 | 478 |
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs |
448 |
sols = map (uncurry $ allocateOnPair nl inst) ok_pairs |
|
479 |
sols = foldl' (\cstate (p, s) -> |
|
480 |
concatAllocs cstate $ allocateOnPair nl inst p s |
|
481 |
) ([], 0, Nothing) ok_pairs |
|
449 | 482 |
in return sols |
450 | 483 |
|
451 | 484 |
tryAlloc nl _ inst 1 = |
452 | 485 |
let all_nodes = getOnline nl |
453 |
sols = map (allocateOnSingle nl inst) all_nodes |
|
486 |
sols = foldl' (\cstate p -> |
|
487 |
concatAllocs cstate $ allocateOnSingle nl inst p |
|
488 |
) ([], 0, Nothing) all_nodes |
|
454 | 489 |
in return sols |
455 | 490 |
|
456 | 491 |
tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \ |
... | ... | |
462 | 497 |
Node.List -- ^ The node list |
463 | 498 |
-> Instance.List -- ^ The instance list |
464 | 499 |
-> Idx -- ^ The index of the instance to move |
465 |
-> Int -- ^ The numver of nodes required
|
|
500 |
-> Int -- ^ The number of nodes required
|
|
466 | 501 |
-> [Ndx] -- ^ Nodes which should not be used |
467 | 502 |
-> m AllocSolution -- ^ Solution list |
468 | 503 |
tryReloc nl il xid 1 ex_idx = |
... | ... | |
471 | 506 |
ex_idx' = Instance.pnode inst:ex_idx |
472 | 507 |
valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes |
473 | 508 |
valid_idxes = map Node.idx valid_nodes |
474 |
sols1 = map (\x -> do |
|
475 |
(mnl, i, _, _) <- applyMove nl inst (ReplaceSecondary x) |
|
476 |
return (mnl, i, [Container.find x nl]) |
|
477 |
) valid_idxes |
|
509 |
sols1 = foldl' (\cstate x -> |
|
510 |
let elem = do |
|
511 |
(mnl, i, _, _) <- |
|
512 |
applyMove nl inst (ReplaceSecondary x) |
|
513 |
return (mnl, i, [Container.find x mnl]) |
|
514 |
in concatAllocs cstate elem |
|
515 |
) ([], 0, Nothing) valid_idxes |
|
478 | 516 |
in return sols1 |
479 | 517 |
|
480 | 518 |
tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \ |
Also available in: Unified diff