Revision a947a583 src/Ganeti/HTools/Program/Hroller.hs
b/src/Ganeti/HTools/Program/Hroller.hs | ||
---|---|---|
108 | 108 |
locateInstances idxs ndxs conf = |
109 | 109 |
foldM (\ cf idx -> locateInstance idx ndxs cf) conf idxs |
110 | 110 |
|
111 |
-- | Greedily move the non-redundant instances away from a list of nodes. |
|
112 |
-- The arguments are the list of nodes to be cleared, a list of nodes the |
|
113 |
-- instances can be moved to, and an initial configuration. Returned is a |
|
114 |
-- list of nodes that can be cleared simultaneously and the configuration |
|
115 |
-- after these nodes are cleared. |
|
116 |
clearNodes :: [Ndx] -> [Ndx] -> (Node.List, Instance.List) |
|
117 |
-> Result ([Ndx], (Node.List, Instance.List)) |
|
118 |
clearNodes [] _ conf = return ([], conf) |
|
119 |
clearNodes (ndx:ndxs) targets conf@(nl, _) = |
|
111 |
|
|
112 |
-- | Greedily clear a node of a kind of instances by a given relocation method. |
|
113 |
-- The arguments are a function providing the list of instances to be cleared, |
|
114 |
-- the relocation function, the list of nodes to be cleared, a list of nodes |
|
115 |
-- that can be relocated to, and the initial configuration. Returned is a list |
|
116 |
-- of nodes that can be cleared simultaneously and the configuration after |
|
117 |
-- clearing these nodes. |
|
118 |
greedyClearNodes :: ((Node.List, Instance.List) -> Ndx -> [Idx]) |
|
119 |
-> ([Idx] -> [Ndx] -> (Node.List, Instance.List) |
|
120 |
-> Result (Node.List, Instance.List)) |
|
121 |
-> [Ndx] -> [Ndx] -> (Node.List, Instance.List) |
|
122 |
-> Result ([Ndx], (Node.List, Instance.List)) |
|
123 |
greedyClearNodes _ _ [] _ conf = return ([], conf) |
|
124 |
greedyClearNodes getInstances relocate (ndx:ndxs) targets conf@(nl, _) = |
|
120 | 125 |
withFirst `mplus` withoutFirst where |
121 | 126 |
withFirst = do |
122 | 127 |
let othernodes = delete ndx targets |
123 | 128 |
grp = Node.group $ Container.find ndx nl |
124 | 129 |
othernodesSameGroup = |
125 | 130 |
filter ((==) grp . Node.group . flip Container.find nl) othernodes |
126 |
conf' <- locateInstances (nonRedundant conf ndx) othernodesSameGroup conf |
|
127 |
(ndxs', conf'') <- clearNodes ndxs othernodes conf' |
|
131 |
conf' <- relocate (getInstances conf ndx) othernodesSameGroup conf |
|
132 |
(ndxs', conf'') <- greedyClearNodes getInstances relocate |
|
133 |
ndxs othernodes conf' |
|
128 | 134 |
return (ndx:ndxs', conf'') |
129 |
withoutFirst = clearNodes ndxs targets conf |
|
135 |
withoutFirst = greedyClearNodes getInstances relocate ndxs targets conf |
|
136 |
|
|
137 |
-- | Greedily move the non-redundant instances away from a list of nodes. |
|
138 |
-- Returns a list of ndoes that can be cleared simultaneously and the |
|
139 |
-- configuration after clearing these nodes. |
|
140 |
clearNodes :: [Ndx] -> [Ndx] -> (Node.List, Instance.List) |
|
141 |
-> Result ([Ndx], (Node.List, Instance.List)) |
|
142 |
clearNodes = greedyClearNodes nonRedundant locateInstances |
|
130 | 143 |
|
131 | 144 |
-- | Parition a list of nodes into chunks according cluster capacity. |
132 | 145 |
partitionNonRedundant :: [Ndx] -> [Ndx] -> (Node.List, Instance.List) |
Also available in: Unified diff