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 |
|