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