152 |
152 |
let idata = fromJSObject ilist
|
153 |
153 |
iobj <- mapM (\(x,y) ->
|
154 |
154 |
asJSObject y >>= parseInstance ktn x . fromJSObject) idata
|
155 |
|
let (kti, il) = assignIndices iobj
|
|
155 |
let (_, il) = assignIndices iobj
|
156 |
156 |
-- cluster tags
|
157 |
157 |
ctags <- extrObj "cluster_tags"
|
158 |
158 |
cdata1 <- mergeData [] [] [] [] (ClusterData gl nl il ctags)
|
159 |
159 |
let (msgs, fix_nl) = checkData (cdNodes cdata1) (cdInstances cdata1)
|
160 |
160 |
cdata = cdata1 { cdNodes = fix_nl }
|
161 |
|
map_n = cdNodes cdata
|
162 |
161 |
map_i = cdInstances cdata
|
163 |
162 |
map_g = cdGroups cdata
|
164 |
163 |
optype <- extrReq "type"
|
... | ... | |
171 |
170 |
inew <- parseBaseInstance rname request
|
172 |
171 |
let io = snd inew
|
173 |
172 |
return $ Allocate io req_nodes
|
174 |
|
| optype == C.iallocatorModeReloc ->
|
175 |
|
do
|
176 |
|
rname <- extrReq "name"
|
177 |
|
ridx <- lookupInstance kti rname
|
178 |
|
req_nodes <- extrReq "required_nodes"
|
179 |
|
ex_nodes <- extrReq "relocate_from"
|
180 |
|
ex_idex <- mapM (Container.findByName map_n) ex_nodes
|
181 |
|
return $ Relocate ridx req_nodes (map Node.idx ex_idex)
|
182 |
|
| optype == C.iallocatorModeMevac ->
|
183 |
|
do
|
184 |
|
ex_names <- extrReq "evac_nodes"
|
185 |
|
ex_nodes <- mapM (Container.findByName map_n) ex_names
|
186 |
|
let ex_ndx = map Node.idx ex_nodes
|
187 |
|
return $ Evacuate ex_ndx
|
188 |
173 |
| optype == C.iallocatorModeChgGroup ->
|
189 |
174 |
do
|
190 |
175 |
rl_names <- extrReq "instances"
|
... | ... | |
227 |
212 |
describeSolution :: Cluster.AllocSolution -> String
|
228 |
213 |
describeSolution = intercalate ", " . Cluster.asLog
|
229 |
214 |
|
230 |
|
-- | Convert evacuation results into the result format.
|
231 |
|
formatEvacuate :: Instance.List -> Cluster.AllocSolution -> Result IAllocResult
|
232 |
|
formatEvacuate il as = do
|
233 |
|
let info = describeSolution as
|
234 |
|
elems = Cluster.asSolutions as
|
235 |
|
when (null elems) $ fail info
|
236 |
|
let sols = map (\(_, inst, nl, _) -> Instance.name inst : map Node.name nl)
|
237 |
|
elems
|
238 |
|
-- FIXME: head elems is certainly not correct here, since we
|
239 |
|
-- don't always concat the elems and lists in the same order;
|
240 |
|
-- however, as the old evacuate mode is deprecated, we can leave
|
241 |
|
-- it like this for the moment
|
242 |
|
(head_nl, _, _, _) = head elems
|
243 |
|
il' = foldl' (\ilist (_, inst, _, _) ->
|
244 |
|
Container.add (Instance.idx inst) inst ilist)
|
245 |
|
il elems
|
246 |
|
return (info, showJSON sols, head_nl, il')
|
247 |
|
|
248 |
215 |
-- | Convert allocation/relocation results into the result format.
|
249 |
216 |
formatAllocate :: Instance.List -> Cluster.AllocSolution -> Result IAllocResult
|
250 |
217 |
formatAllocate il as = do
|
... | ... | |
283 |
250 |
in case rqtype of
|
284 |
251 |
Allocate xi reqn ->
|
285 |
252 |
Cluster.tryMGAlloc gl nl il xi reqn >>= formatAllocate il
|
286 |
|
Relocate idx reqn exnodes ->
|
287 |
|
Cluster.tryMGReloc gl nl il idx reqn exnodes >>= formatAllocate il
|
288 |
|
Evacuate exnodes ->
|
289 |
|
Cluster.tryMGEvac gl nl il exnodes >>= formatEvacuate il
|
290 |
253 |
ChangeGroup gdxs idxs ->
|
291 |
254 |
Cluster.tryChangeGroup gl nl il idxs gdxs >>=
|
292 |
255 |
formatNodeEvac gl nl il
|