124 |
124 |
apol <- extract "alloc_policy"
|
125 |
125 |
return (u, Group.create name u apol)
|
126 |
126 |
|
127 |
|
parseTargetGroups :: JSRecord -- ^ The JSON object (request dict)
|
128 |
|
-> Group.List -- ^ The existing groups
|
129 |
|
-> Result [Gdx]
|
130 |
|
parseTargetGroups req map_g = do
|
131 |
|
group_uuids <- fromObjWithDefault req "target_groups" []
|
132 |
|
mapM (liftM Group.idx . Container.findByName map_g) group_uuids
|
133 |
|
|
134 |
127 |
-- | Top-level parser.
|
135 |
128 |
parseData :: String -- ^ The JSON message as received from Ganeti
|
136 |
129 |
-> Result Request -- ^ A (possible valid) request
|
... | ... | |
186 |
179 |
ex_nodes <- mapM (Container.findByName map_n) ex_names
|
187 |
180 |
let ex_ndx = map Node.idx ex_nodes
|
188 |
181 |
return $ Evacuate ex_ndx
|
189 |
|
| optype == C.iallocatorModeMreloc ->
|
|
182 |
| optype == C.iallocatorModeChgGroup ->
|
190 |
183 |
do
|
191 |
184 |
rl_names <- extrReq "instances"
|
192 |
|
rl_insts <- mapM (Container.findByName map_i) rl_names
|
193 |
|
let rl_idx = map Instance.idx rl_insts
|
194 |
|
rl_mode <-
|
195 |
|
case extrReq "reloc_mode" of
|
196 |
|
Ok s | s == C.iallocatorMrelocKeep -> return KeepGroup
|
197 |
|
| s == C.iallocatorMrelocChange ->
|
198 |
|
do
|
199 |
|
tg_groups <- parseTargetGroups request map_g
|
200 |
|
return $ ChangeGroup tg_groups
|
201 |
|
| s == C.iallocatorMrelocAny -> return AnyGroup
|
202 |
|
| otherwise -> Bad $ "Invalid relocate mode " ++ s
|
203 |
|
Bad x -> Bad x
|
204 |
|
return $ MultiReloc rl_idx rl_mode
|
|
185 |
rl_insts <- mapM (liftM Instance.idx .
|
|
186 |
Container.findByName map_i) rl_names
|
|
187 |
gr_uuids <- extrReq "target_groups"
|
|
188 |
gr_idxes <- mapM (liftM Group.idx .
|
|
189 |
Container.findByName map_g) gr_uuids
|
|
190 |
return $ ChangeGroup rl_insts gr_idxes
|
205 |
191 |
| optype == C.iallocatorModeNodeEvac ->
|
206 |
192 |
do
|
207 |
193 |
rl_names <- extrReq "instances"
|
... | ... | |
276 |
262 |
Cluster.tryMGReloc gl nl il idx reqn exnodes >>= formatAllocate
|
277 |
263 |
Evacuate exnodes ->
|
278 |
264 |
Cluster.tryMGEvac gl nl il exnodes >>= formatEvacuate
|
279 |
|
MultiReloc _ _ -> fail "multi-reloc not handled"
|
|
265 |
ChangeGroup _ _ -> fail "Request 'change-group' not implemented"
|
280 |
266 |
NodeEvacuate xi mode ->
|
281 |
267 |
Cluster.tryNodeEvac gl nl il mode xi >>= formatNodeEvac
|
282 |
268 |
|