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