Revision b0631f10 htools/Ganeti/HTools/Cluster.hs
| b/htools/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 74 | 74 |
) where |
| 75 | 75 |
|
| 76 | 76 |
import qualified Data.IntSet as IntSet |
| 77 |
import Data.Function (on) |
|
| 78 | 77 |
import Data.List |
| 79 | 78 |
import Data.Maybe (fromJust, isNothing) |
| 80 | 79 |
import Data.Ord (comparing) |
| 81 | 80 |
import Text.Printf (printf) |
| 82 |
import Control.Monad |
|
| 83 | 81 |
|
| 84 | 82 |
import qualified Ganeti.HTools.Container as Container |
| 85 | 83 |
import qualified Ganeti.HTools.Instance as Instance |
| ... | ... | |
| 116 | 114 |
|
| 117 | 115 |
-- | A type denoting the valid allocation mode/pairs. |
| 118 | 116 |
-- |
| 119 |
-- For a one-node allocation, this will be a @Left ['Node.Node']@, |
|
| 120 |
-- whereas for a two-node allocation, this will be a @Right |
|
| 121 |
-- [('Node.Node', 'Node.Node')]@.
|
|
| 122 |
type AllocNodes = Either [Ndx] [(Ndx, Ndx)] |
|
| 117 |
-- For a one-node allocation, this will be a @Left ['Ndx']@, whereas |
|
| 118 |
-- for a two-node allocation, this will be a @Right [('Ndx',
|
|
| 119 |
-- ['Ndx'])]@. In the latter case, the list is basically an |
|
| 120 |
-- association list, grouped by primary node and holding the potential |
|
| 121 |
-- secondary nodes in the sub-list. |
|
| 122 |
type AllocNodes = Either [Ndx] [(Ndx, [Ndx])] |
|
| 123 | 123 |
|
| 124 | 124 |
-- | The empty solution we start with when computing allocations. |
| 125 | 125 |
emptyAllocSolution :: AllocSolution |
| ... | ... | |
| 682 | 682 |
flip Container.find gl . Node.group) |
| 683 | 683 |
else id |
| 684 | 684 |
all_nodes = filter_fn $ getOnline nl |
| 685 |
all_pairs = liftM2 (,) all_nodes all_nodes |
|
| 686 |
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y && |
|
| 687 |
Node.group x == Node.group y) all_pairs |
|
| 685 |
all_pairs = [(Node.idx p, |
|
| 686 |
[Node.idx s | s <- all_nodes, |
|
| 687 |
Node.idx p /= Node.idx s, |
|
| 688 |
Node.group p == Node.group s]) | |
|
| 689 |
p <- all_nodes] |
|
| 688 | 690 |
in case count of |
| 689 | 691 |
1 -> Ok (Left (map Node.idx all_nodes)) |
| 690 |
2 -> Ok (Right (map (\(p, s) -> (Node.idx p, Node.idx s)) ok_pairs))
|
|
| 692 |
2 -> Ok (Right (filter (not . null . snd) all_pairs))
|
|
| 691 | 693 |
_ -> Bad "Unsupported number of nodes, only one or two supported" |
| 692 | 694 |
|
| 693 | 695 |
-- | Try to allocate an instance on the cluster. |
| ... | ... | |
| 698 | 700 |
-> AllocNodes -- ^ The allocation targets |
| 699 | 701 |
-> m AllocSolution -- ^ Possible solution list |
| 700 | 702 |
tryAlloc nl _ inst (Right ok_pairs) = |
| 701 |
let pgroups = groupBy ((==) `on` fst) ok_pairs
|
|
| 702 |
psols = parMap rwhnf (foldl' (\cstate (p, s) ->
|
|
| 703 |
concatAllocs cstate $
|
|
| 704 |
allocateOnPair nl inst p s)
|
|
| 705 |
emptyAllocSolution) pgroups
|
|
| 703 |
let psols = parMap rwhnf (\(p, ss) ->
|
|
| 704 |
foldl' (\cstate ->
|
|
| 705 |
concatAllocs cstate .
|
|
| 706 |
allocateOnPair nl inst p)
|
|
| 707 |
emptyAllocSolution ss) ok_pairs
|
|
| 706 | 708 |
sols = foldl' sumAllocs emptyAllocSolution psols |
| 707 | 709 |
in if null ok_pairs -- means we have just one node |
| 708 | 710 |
then fail "Not enough online nodes" |
Also available in: Unified diff