Revision d5b2753a src/Ganeti/Query/Query.hs
b/src/Ganeti/Query/Query.hs | ||
---|---|---|
150 | 150 |
NumericValue i -> makeJobId $ fromIntegral i |
151 | 151 |
) vals |
152 | 152 |
|
153 |
-- | Generic query implementation for resources that are backed by |
|
154 |
-- some configuration objects. |
|
155 |
genericQuery :: FieldMap a b -- ^ Field map |
|
156 |
-> (Bool -> ConfigData -> [a] -> IO [(a, b)]) -- ^ Collector |
|
157 |
-> (a -> String) -- ^ Object to name function |
|
158 |
-> (ConfigData -> Container a) -- ^ Get all objects from config |
|
159 |
-> (ConfigData -> String -> ErrorResult a) -- ^ Lookup object |
|
160 |
-> ConfigData -- ^ The config to run the query against |
|
161 |
-> Bool -- ^ Whether the query should be run live |
|
162 |
-> [String] -- ^ List of requested fields |
|
163 |
-> Filter FilterField -- ^ Filter field |
|
164 |
-> [String] -- ^ List of requested names |
|
165 |
-> IO (ErrorResult QueryResult) |
|
166 |
genericQuery fieldsMap collector nameFn configFn getFn cfg |
|
167 |
live fields qfilter wanted = |
|
168 |
runResultT $ do |
|
169 |
cfilter <- resultT $ compileFilter fieldsMap qfilter |
|
170 |
let selected = getSelectedFields fieldsMap fields |
|
171 |
(fdefs, fgetters, _) = unzip3 selected |
|
172 |
live' = live && needsLiveData fgetters |
|
173 |
objects <- resultT $ case wanted of |
|
174 |
[] -> Ok . niceSortKey nameFn . |
|
175 |
Map.elems . fromContainer $ configFn cfg |
|
176 |
_ -> mapM (getFn cfg) wanted |
|
177 |
-- runs first pass of the filter, without a runtime context; this |
|
178 |
-- will limit the objects that we'll contact for exports |
|
179 |
fobjects <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter) |
|
180 |
objects |
|
181 |
-- here run the runtime data gathering... |
|
182 |
runtimes <- lift $ collector live' cfg fobjects |
|
183 |
-- ... then filter again the results, based on gathered runtime data |
|
184 |
let fdata = map (\(obj, runtime) -> |
|
185 |
map (execGetter cfg runtime obj) fgetters) |
|
186 |
runtimes |
|
187 |
return QueryResult { qresFields = fdefs, qresData = fdata } |
|
188 |
|
|
153 | 189 |
-- | Main query execution function. |
154 | 190 |
query :: ConfigData -- ^ The current configuration |
155 | 191 |
-> Bool -- ^ Whether to collect live data |
... | ... | |
167 | 203 |
-> IO (ErrorResult QueryResult) -- ^ Result |
168 | 204 |
|
169 | 205 |
queryInner cfg live (Query (ItemTypeOpCode QRNode) fields qfilter) wanted = |
170 |
runResultT $ do |
|
171 |
cfilter <- resultT $ compileFilter Node.fieldsMap qfilter |
|
172 |
let selected = getSelectedFields Node.fieldsMap fields |
|
173 |
(fdefs, fgetters, _) = unzip3 selected |
|
174 |
live' = live && needsLiveData fgetters |
|
175 |
nodes <- resultT $ case wanted of |
|
176 |
[] -> Ok . niceSortKey nodeName . |
|
177 |
Map.elems . fromContainer $ configNodes cfg |
|
178 |
_ -> mapM (getNode cfg) wanted |
|
179 |
-- runs first pass of the filter, without a runtime context; this |
|
180 |
-- will limit the nodes that we'll contact for runtime data |
|
181 |
fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter) |
|
182 |
nodes |
|
183 |
-- here we would run the runtime data gathering, then filter again |
|
184 |
-- the nodes, based on existing runtime data |
|
185 |
nruntimes <- lift $ Node.collectLiveData live' cfg fnodes |
|
186 |
let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters) |
|
187 |
nruntimes |
|
188 |
return QueryResult { qresFields = fdefs, qresData = fdata } |
|
206 |
genericQuery Node.fieldsMap Node.collectLiveData nodeName configNodes getNode |
|
207 |
cfg live fields qfilter wanted |
|
189 | 208 |
|
190 |
queryInner cfg _ (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted = |
|
191 |
return $ do |
|
192 |
cfilter <- compileFilter Group.fieldsMap qfilter |
|
193 |
let selected = getSelectedFields Group.fieldsMap fields |
|
194 |
(fdefs, fgetters, _) = unzip3 selected |
|
195 |
groups <- case wanted of |
|
196 |
[] -> Ok . niceSortKey groupName . |
|
197 |
Map.elems . fromContainer $ configNodegroups cfg |
|
198 |
_ -> mapM (getGroup cfg) wanted |
|
199 |
-- there is no live data for groups, so filtering is much simpler |
|
200 |
fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups |
|
201 |
let fdata = map (\node -> |
|
202 |
map (execGetter cfg Group.Runtime node) fgetters) fgroups |
|
203 |
return QueryResult { qresFields = fdefs, qresData = fdata } |
|
209 |
queryInner cfg live (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted = |
|
210 |
genericQuery Group.fieldsMap Group.collectLiveData groupName configNodegroups |
|
211 |
getGroup cfg live fields qfilter wanted |
|
204 | 212 |
|
205 |
queryInner cfg _ (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted = |
|
206 |
return $ do |
|
207 |
cfilter <- compileFilter Network.fieldsMap qfilter |
|
208 |
let selected = getSelectedFields Network.fieldsMap fields |
|
209 |
(fdefs, fgetters, _) = unzip3 selected |
|
210 |
networks <- case wanted of |
|
211 |
[] -> Ok . niceSortKey (fromNonEmpty . networkName) . |
|
212 |
Map.elems . fromContainer $ configNetworks cfg |
|
213 |
_ -> mapM (getNetwork cfg) wanted |
|
214 |
fnetworks <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) networks |
|
215 |
let fdata = map (\network -> |
|
216 |
map (execGetter cfg Network.Runtime network) fgetters) |
|
217 |
fnetworks |
|
218 |
return QueryResult { qresFields = fdefs, qresData = fdata } |
|
213 |
queryInner cfg live (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted = |
|
214 |
genericQuery Network.fieldsMap Network.collectLiveData |
|
215 |
(fromNonEmpty . networkName) |
|
216 |
configNetworks getNetwork cfg live fields qfilter wanted |
|
219 | 217 |
|
220 | 218 |
queryInner cfg live (Query (ItemTypeOpCode QRExport) fields qfilter) wanted = |
221 |
runResultT $ do |
|
222 |
cfilter <- resultT $ compileFilter Export.fieldsMap qfilter |
|
223 |
let selected = getSelectedFields Export.fieldsMap fields |
|
224 |
(fdefs, fgetters, _) = unzip3 selected |
|
225 |
-- we alwyas have live queries in exports, but we keep this for |
|
226 |
-- standard style (in case we add static fields in the future) |
|
227 |
live' = live && needsLiveData fgetters |
|
228 |
nodes <- resultT $ case wanted of |
|
229 |
[] -> Ok . niceSortKey nodeName . |
|
230 |
Map.elems . fromContainer $ configNodes cfg |
|
231 |
_ -> mapM (getNode cfg) wanted |
|
232 |
-- runs first pass of the filter, without a runtime context; this |
|
233 |
-- will limit the nodes that we'll contact for exports |
|
234 |
fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter) |
|
235 |
nodes |
|
236 |
-- here we would run the runtime data gathering... |
|
237 |
nruntimes <- lift $ Export.collectLiveData live' cfg fnodes |
|
238 |
-- ... then filter again the results, based on existing export |
|
239 |
-- names, but note that no client sends filters on the export list |
|
240 |
-- today, so it's likely a no-oop |
|
241 |
let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters) |
|
242 |
nruntimes |
|
243 |
return QueryResult { qresFields = fdefs, qresData = fdata } |
|
219 |
genericQuery Export.fieldsMap Export.collectLiveData nodeName configNodes |
|
220 |
getNode cfg live fields qfilter wanted |
|
244 | 221 |
|
245 | 222 |
queryInner _ _ (Query qkind _ _) _ = |
246 | 223 |
return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported" |
Also available in: Unified diff