| 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
|