Revision 3e4480e0 Ganeti/HTools/IAlloc.hs
b/Ganeti/HTools/IAlloc.hs | ||
---|---|---|
113 | 113 |
let (kti, il) = assignIndices iobj |
114 | 114 |
-- cluster tags |
115 | 115 |
ctags <- fromObj "cluster_tags" obj |
116 |
(map_n, map_i, ptags, csf) <- mergeData [] [] [] (nl, il, ctags)
|
|
116 |
(map_n, map_i, ptags) <- mergeData [] [] [] (nl, il, ctags) |
|
117 | 117 |
optype <- fromObj "type" request |
118 | 118 |
rqtype <- |
119 | 119 |
case optype of |
... | ... | |
130 | 130 |
ridx <- lookupInstance kti rname |
131 | 131 |
req_nodes <- fromObj "required_nodes" request |
132 | 132 |
ex_nodes <- fromObj "relocate_from" request |
133 |
let ex_nodes' = map (stripSuffix $ length csf) ex_nodes |
|
134 |
ex_idex <- mapM (Container.findByName map_n) ex_nodes' |
|
133 |
ex_idex <- mapM (Container.findByName map_n) ex_nodes |
|
135 | 134 |
return $ Relocate ridx req_nodes (map Node.idx ex_idex) |
136 | 135 |
"multi-evacuate" -> |
137 | 136 |
do |
138 | 137 |
ex_names <- fromObj "evac_nodes" request |
139 |
let ex_names' = map (stripSuffix $ length csf) ex_names |
|
140 |
ex_nodes <- mapM (Container.findByName map_n) ex_names' |
|
138 |
ex_nodes <- mapM (Container.findByName map_n) ex_names |
|
141 | 139 |
let ex_ndx = map Node.idx ex_nodes |
142 | 140 |
return $ Evacuate ex_ndx |
143 | 141 |
other -> fail ("Invalid request type '" ++ other ++ "'") |
144 |
return $ Request rqtype map_n map_i ptags csf
|
|
142 |
return $ Request rqtype map_n map_i ptags |
|
145 | 143 |
|
146 | 144 |
-- | Format the result |
147 |
formatRVal :: String -> RqType -> [Node.AllocElement] -> JSValue
|
|
148 |
formatRVal _ _ [] = JSArray []
|
|
145 |
formatRVal :: RqType -> [Node.AllocElement] -> JSValue |
|
146 |
formatRVal _ [] = JSArray [] |
|
149 | 147 |
|
150 |
formatRVal csf (Evacuate _) elems = |
|
151 |
let sols = map (\(_, inst, nl) -> |
|
152 |
let names = Instance.name inst : map Node.name nl |
|
153 |
in map (++ csf) names) elems |
|
148 |
formatRVal (Evacuate _) elems = |
|
149 |
let sols = map (\(_, inst, nl) -> Instance.name inst : map Node.name nl) |
|
150 |
elems |
|
154 | 151 |
jsols = map (JSArray . map (JSString . toJSString)) sols |
155 | 152 |
in JSArray jsols |
156 | 153 |
|
157 |
formatRVal csf _ elems =
|
|
154 |
formatRVal _ elems = |
|
158 | 155 |
let (_, _, nodes) = head elems |
159 |
nodes' = map ((++ csf) . Node.name) nodes
|
|
156 |
nodes' = map Node.name nodes
|
|
160 | 157 |
in JSArray $ map (JSString . toJSString) nodes' |
161 | 158 |
|
162 | 159 |
-- | Formats the response into a valid IAllocator response message. |
163 | 160 |
formatResponse :: Bool -- ^ Whether the request was successful |
164 | 161 |
-> String -- ^ Information text |
165 |
-> String -- ^ Suffix for nodes and instances |
|
166 | 162 |
-> RqType -- ^ Request type |
167 | 163 |
-> [Node.AllocElement] -- ^ The resulting allocations |
168 | 164 |
-> String -- ^ The JSON-formatted message |
169 |
formatResponse success info csf rq elems =
|
|
165 |
formatResponse success info rq elems = |
|
170 | 166 |
let |
171 | 167 |
e_success = ("success", JSBool success) |
172 | 168 |
e_info = ("info", JSString . toJSString $ info) |
173 |
e_nodes = ("nodes", formatRVal csf rq elems)
|
|
169 |
e_nodes = ("nodes", formatRVal rq elems) |
|
174 | 170 |
in encodeStrict $ makeObj [e_success, e_info, e_nodes] |
Also available in: Unified diff