Revision 8880d889 Ganeti/HTools/Cluster.hs
| b/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 76 | 76 |
type Placement = (Idx, Ndx, Ndx, Score) |
| 77 | 77 |
|
| 78 | 78 |
-- | Allocation\/relocation solution. |
| 79 |
type AllocSolution = [(OpResult Node.List, Instance.Instance, [Node.Node])]
|
|
| 79 |
type AllocSolution = [OpResult (Node.List, Instance.Instance, [Node.Node])]
|
|
| 80 | 80 |
|
| 81 | 81 |
-- | An instance move definition |
| 82 | 82 |
data IMove = Failover -- ^ Failover the instance (f) |
| ... | ... | |
| 244 | 244 |
|
| 245 | 245 |
-- | Applies an instance move to a given node list and instance. |
| 246 | 246 |
applyMove :: Node.List -> Instance.Instance |
| 247 |
-> IMove -> (OpResult Node.List, Instance.Instance, Ndx, Ndx)
|
|
| 247 |
-> IMove -> OpResult (Node.List, Instance.Instance, Ndx, Ndx)
|
|
| 248 | 248 |
-- Failover (f) |
| 249 | 249 |
applyMove nl inst Failover = |
| 250 | 250 |
let old_pdx = Instance.pnode inst |
| ... | ... | |
| 256 | 256 |
new_nl = do -- Maybe monad |
| 257 | 257 |
new_p <- Node.addPri int_s inst |
| 258 | 258 |
new_s <- Node.addSec int_p inst old_sdx |
| 259 |
return $ Container.addTwo old_pdx new_s old_sdx new_p nl |
|
| 260 |
in (new_nl, Instance.setBoth inst old_sdx old_pdx, old_sdx, old_pdx) |
|
| 259 |
let new_inst = Instance.setBoth inst old_sdx old_pdx |
|
| 260 |
return (Container.addTwo old_pdx new_s old_sdx new_p nl, |
|
| 261 |
new_inst, old_sdx, old_pdx) |
|
| 262 |
in new_nl |
|
| 261 | 263 |
|
| 262 | 264 |
-- Replace the primary (f:, r:np, f) |
| 263 | 265 |
applyMove nl inst (ReplacePrimary new_pdx) = |
| ... | ... | |
| 275 | 277 |
let tmp_s' = Node.removePri tmp_s inst |
| 276 | 278 |
new_p <- Node.addPri tgt_n inst |
| 277 | 279 |
new_s <- Node.addSec tmp_s' inst new_pdx |
| 278 |
return . Container.add new_pdx new_p $ |
|
| 279 |
Container.addTwo old_pdx int_p old_sdx new_s nl |
|
| 280 |
in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx) |
|
| 280 |
let new_inst = Instance.setPri inst new_pdx |
|
| 281 |
return (Container.add new_pdx new_p $ |
|
| 282 |
Container.addTwo old_pdx int_p old_sdx new_s nl, |
|
| 283 |
new_inst, new_pdx, old_sdx) |
|
| 284 |
in new_nl |
|
| 281 | 285 |
|
| 282 | 286 |
-- Replace the secondary (r:ns) |
| 283 | 287 |
applyMove nl inst (ReplaceSecondary new_sdx) = |
| ... | ... | |
| 286 | 290 |
old_s = Container.find old_sdx nl |
| 287 | 291 |
tgt_n = Container.find new_sdx nl |
| 288 | 292 |
int_s = Node.removeSec old_s inst |
| 293 |
new_inst = Instance.setSec inst new_sdx |
|
| 289 | 294 |
new_nl = Node.addSec tgt_n inst old_pdx >>= |
| 290 |
\new_s -> return $ Container.addTwo new_sdx |
|
| 291 |
new_s old_sdx int_s nl |
|
| 292 |
in (new_nl, Instance.setSec inst new_sdx, old_pdx, new_sdx) |
|
| 295 |
\new_s -> return (Container.addTwo new_sdx |
|
| 296 |
new_s old_sdx int_s nl, |
|
| 297 |
new_inst, old_pdx, new_sdx) |
|
| 298 |
in new_nl |
|
| 293 | 299 |
|
| 294 | 300 |
-- Replace the secondary and failover (r:np, f) |
| 295 | 301 |
applyMove nl inst (ReplaceAndFailover new_pdx) = |
| ... | ... | |
| 303 | 309 |
new_nl = do -- Maybe monad |
| 304 | 310 |
new_p <- Node.addPri tgt_n inst |
| 305 | 311 |
new_s <- Node.addSec int_p inst new_pdx |
| 306 |
return . Container.add new_pdx new_p $ |
|
| 307 |
Container.addTwo old_pdx new_s old_sdx int_s nl |
|
| 308 |
in (new_nl, Instance.setBoth inst new_pdx old_pdx, new_pdx, old_pdx) |
|
| 312 |
let new_inst = Instance.setBoth inst new_pdx old_pdx |
|
| 313 |
return (Container.add new_pdx new_p $ |
|
| 314 |
Container.addTwo old_pdx new_s old_sdx int_s nl, |
|
| 315 |
new_inst, new_pdx, old_pdx) |
|
| 316 |
in new_nl |
|
| 309 | 317 |
|
| 310 | 318 |
-- Failver and replace the secondary (f, r:ns) |
| 311 | 319 |
applyMove nl inst (FailoverAndReplace new_sdx) = |
| ... | ... | |
| 319 | 327 |
new_nl = do -- Maybe monad |
| 320 | 328 |
new_p <- Node.addPri int_s inst |
| 321 | 329 |
new_s <- Node.addSec tgt_n inst old_sdx |
| 322 |
return . Container.add new_sdx new_s $ |
|
| 323 |
Container.addTwo old_sdx new_p old_pdx int_p nl |
|
| 324 |
in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx) |
|
| 330 |
let new_inst = Instance.setBoth inst old_sdx new_sdx |
|
| 331 |
return (Container.add new_sdx new_s $ |
|
| 332 |
Container.addTwo old_sdx new_p old_pdx int_p nl, |
|
| 333 |
new_inst, old_sdx, new_sdx) |
|
| 334 |
in new_nl |
|
| 325 | 335 |
|
| 326 | 336 |
-- | Tries to allocate an instance on one given node. |
| 327 | 337 |
allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node |
| 328 |
-> (OpResult Node.List, Instance.Instance)
|
|
| 338 |
-> OpResult (Node.List, Instance.Instance)
|
|
| 329 | 339 |
allocateOnSingle nl inst p = |
| 330 | 340 |
let new_pdx = Node.idx p |
| 341 |
new_inst = Instance.setBoth inst new_pdx Node.noSecondary |
|
| 331 | 342 |
new_nl = Node.addPri p inst >>= \new_p -> |
| 332 |
return $ Container.add new_pdx new_p nl
|
|
| 333 |
in (new_nl, Instance.setBoth inst new_pdx Node.noSecondary)
|
|
| 343 |
return (Container.add new_pdx new_p nl, new_inst)
|
|
| 344 |
in new_nl
|
|
| 334 | 345 |
|
| 335 | 346 |
-- | Tries to allocate an instance on a given pair of nodes. |
| 336 | 347 |
allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node |
| 337 |
-> (OpResult Node.List, Instance.Instance)
|
|
| 348 |
-> OpResult (Node.List, Instance.Instance)
|
|
| 338 | 349 |
allocateOnPair nl inst tgt_p tgt_s = |
| 339 | 350 |
let new_pdx = Node.idx tgt_p |
| 340 | 351 |
new_sdx = Node.idx tgt_s |
| 341 | 352 |
new_nl = do -- Maybe monad |
| 342 | 353 |
new_p <- Node.addPri tgt_p inst |
| 343 | 354 |
new_s <- Node.addSec tgt_s inst new_pdx |
| 344 |
return $ Container.addTwo new_pdx new_p new_sdx new_s nl |
|
| 345 |
in (new_nl, Instance.setBoth inst new_pdx new_sdx) |
|
| 355 |
let new_inst = Instance.setBoth inst new_pdx new_sdx |
|
| 356 |
return (Container.addTwo new_pdx new_p new_sdx new_s nl, new_inst) |
|
| 357 |
in new_nl |
|
| 346 | 358 |
|
| 347 | 359 |
-- | Tries to perform an instance move and returns the best table |
| 348 | 360 |
-- between the original one and the new one. |
| ... | ... | |
| 354 | 366 |
checkSingleStep ini_tbl target cur_tbl move = |
| 355 | 367 |
let |
| 356 | 368 |
Table ini_nl ini_il _ ini_plc = ini_tbl |
| 357 |
(tmp_nl, new_inst, pri_idx, sec_idx) = applyMove ini_nl target move
|
|
| 369 |
tmp_resu = applyMove ini_nl target move
|
|
| 358 | 370 |
in |
| 359 |
case tmp_nl of
|
|
| 371 |
case tmp_resu of
|
|
| 360 | 372 |
OpFail _ -> cur_tbl |
| 361 |
OpGood upd_nl ->
|
|
| 373 |
OpGood (upd_nl, new_inst, pri_idx, sec_idx) ->
|
|
| 362 | 374 |
let tgt_idx = Instance.idx target |
| 363 | 375 |
upd_cvar = compCV upd_nl |
| 364 | 376 |
upd_il = Container.add tgt_idx new_inst ini_il |
| ... | ... | |
| 435 | 447 |
let all_nodes = getOnline nl |
| 436 | 448 |
all_pairs = liftM2 (,) all_nodes all_nodes |
| 437 | 449 |
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs |
| 438 |
sols = map (\(p, s) -> let (mnl, i) = allocateOnPair nl inst p s |
|
| 439 |
in (mnl, i, [p, s])) |
|
| 450 |
sols = map (\(p, s) -> do |
|
| 451 |
(mnl, i) <- allocateOnPair nl inst p s |
|
| 452 |
return (mnl, i, [p, s])) |
|
| 440 | 453 |
ok_pairs |
| 441 | 454 |
in return sols |
| 442 | 455 |
|
| 443 | 456 |
tryAlloc nl _ inst 1 = |
| 444 | 457 |
let all_nodes = getOnline nl |
| 445 |
sols = map (\p -> let (mnl, i) = allocateOnSingle nl inst p |
|
| 446 |
in (mnl, i, [p])) |
|
| 458 |
sols = map (\p -> do |
|
| 459 |
(mnl, i) <- allocateOnSingle nl inst p |
|
| 460 |
return (mnl, i, [p])) |
|
| 447 | 461 |
all_nodes |
| 448 | 462 |
in return sols |
| 449 | 463 |
|
| ... | ... | |
| 465 | 479 |
ex_idx' = Instance.pnode inst:ex_idx |
| 466 | 480 |
valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes |
| 467 | 481 |
valid_idxes = map Node.idx valid_nodes |
| 468 |
sols1 = map (\x -> let (mnl, i, _, _) =
|
|
| 469 |
applyMove nl inst (ReplaceSecondary x)
|
|
| 470 |
in (mnl, i, [Container.find x nl])
|
|
| 482 |
sols1 = map (\x -> do
|
|
| 483 |
(mnl, i, _, _) <- applyMove nl inst (ReplaceSecondary x)
|
|
| 484 |
return (mnl, i, [Container.find x nl])
|
|
| 471 | 485 |
) valid_idxes |
| 472 | 486 |
in return sols1 |
| 473 | 487 |
|
Also available in: Unified diff