Revision ce6a0b53 htools/Ganeti/HTools/IAlloc.hs
b/htools/Ganeti/HTools/IAlloc.hs | ||
---|---|---|
50 | 50 |
import Ganeti.HTools.Types |
51 | 51 |
|
52 | 52 |
-- | Type alias for the result of an IAllocator call. |
53 |
type IAllocResult = (String, JSValue) |
|
53 |
type IAllocResult = (String, JSValue, Node.List)
|
|
54 | 54 |
|
55 | 55 |
-- | Parse the basic specifications of an instance. |
56 | 56 |
-- |
... | ... | |
229 | 229 |
when (null elems) $ fail info |
230 | 230 |
let sols = map (\(_, inst, nl, _) -> Instance.name inst : map Node.name nl) |
231 | 231 |
elems |
232 |
return (info, showJSON sols) |
|
232 |
-- FIXME: head elems is certainly not correct here, since we |
|
233 |
-- don't always concat the elems and lists in the same order; |
|
234 |
-- however, as the old evacuate mode is deprecated, we can leave |
|
235 |
-- it like this for the moment |
|
236 |
(head_nl, _, _, _) = head elems |
|
237 |
return (info, showJSON sols, head_nl) |
|
233 | 238 |
|
234 | 239 |
-- | Convert allocation/relocation results into the result format. |
235 | 240 |
formatAllocate :: Cluster.AllocSolution -> Result IAllocResult |
... | ... | |
237 | 242 |
let info = describeSolution as |
238 | 243 |
case Cluster.asSolutions as of |
239 | 244 |
[] -> fail info |
240 |
(_, _, nodes, _):[] -> return (info, showJSON $ map (Node.name) nodes)
|
|
245 |
(nl, _, nodes, _):[] -> return (info, showJSON $ map (Node.name) nodes, nl)
|
|
241 | 246 |
_ -> fail "Internal error: multiple allocation solutions" |
242 | 247 |
|
243 | 248 |
-- | Convert a node-evacuation/change group result. |
... | ... | |
246 | 251 |
-> Instance.List |
247 | 252 |
-> (Node.List, Instance.List, Cluster.EvacSolution) |
248 | 253 |
-> Result IAllocResult |
249 |
formatNodeEvac gl nl il (_, _, es) =
|
|
254 |
formatNodeEvac gl nl il (fin_nl, _, es) =
|
|
250 | 255 |
let iname = Instance.name . flip Container.find il |
251 | 256 |
nname = Node.name . flip Container.find nl |
252 | 257 |
gname = Group.name . flip Container.find gl |
... | ... | |
257 | 262 |
moved = length mes |
258 | 263 |
info = show failed ++ " instances failed to move and " ++ show moved ++ |
259 | 264 |
" were moved successfully" |
260 |
in Ok (info, showJSON (mes, fes, Cluster.esOpCodes es)) |
|
265 |
in Ok (info, showJSON (mes, fes, Cluster.esOpCodes es), fin_nl)
|
|
261 | 266 |
|
262 | 267 |
-- | Process a request and return new node lists |
263 | 268 |
processRequest :: Request -> Result IAllocResult |
... | ... | |
298 | 303 |
else return r1) |
299 | 304 |
|
300 | 305 |
-- | Main iallocator pipeline. |
301 |
runIAllocator :: Request -> String
|
|
306 |
runIAllocator :: Request -> (Maybe Node.List, String)
|
|
302 | 307 |
runIAllocator request = |
303 |
let (ok, info, result) = |
|
308 |
let (ok, info, result, nl) =
|
|
304 | 309 |
case processRequest request of |
305 |
Ok (msg, r) -> (True, "Request successful: " ++ msg, r) |
|
306 |
Bad msg -> (False, "Request failed: " ++ msg, JSArray []) |
|
307 |
in formatResponse ok info result |
|
310 |
Ok (msg, r, nl) -> (True, "Request successful: " ++ msg, r, |
|
311 |
Just nl) |
|
312 |
Bad msg -> (False, "Request failed: " ++ msg, JSArray [], Nothing) |
|
313 |
rstring = formatResponse ok info result |
|
314 |
in (nl, rstring) |
Also available in: Unified diff