root / src / Ganeti / Query / Query.hs @ 9faf1c01
History | View | Annotate | Download (15.8 kB)
1 |
{-# LANGUAGE TupleSections #-} |
---|---|
2 |
|
3 |
{-| Implementation of the Ganeti Query2 functionality. |
4 |
|
5 |
-} |
6 |
|
7 |
{- |
8 |
|
9 |
Copyright (C) 2012, 2013 Google Inc. |
10 |
|
11 |
This program is free software; you can redistribute it and/or modify |
12 |
it under the terms of the GNU General Public License as published by |
13 |
the Free Software Foundation; either version 2 of the License, or |
14 |
(at your option) any later version. |
15 |
|
16 |
This program is distributed in the hope that it will be useful, but |
17 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
18 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
19 |
General Public License for more details. |
20 |
|
21 |
You should have received a copy of the GNU General Public License |
22 |
along with this program; if not, write to the Free Software |
23 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
24 |
02110-1301, USA. |
25 |
|
26 |
-} |
27 |
|
28 |
{- |
29 |
|
30 |
TODO: problems with the current model: |
31 |
|
32 |
1. There's nothing preventing a result such as ResultEntry RSNormal |
33 |
Nothing, or ResultEntry RSNoData (Just ...); ideally, we would |
34 |
separate the the RSNormal and other types; we would need a new data |
35 |
type for this, though, with JSON encoding/decoding |
36 |
|
37 |
2. We don't have a way to 'bind' a FieldDefinition's field type |
38 |
(e.q. QFTBool) with the actual value that is returned from a |
39 |
FieldGetter. This means that the various getter functions can return |
40 |
divergent types for the same field when evaluated against multiple |
41 |
items. This is bad; it only works today because we 'hide' everything |
42 |
behind JSValue, but is not nice at all. We should probably remove the |
43 |
separation between FieldDefinition and the FieldGetter, and introduce |
44 |
a new abstract data type, similar to QFT*, that contains the values |
45 |
too. |
46 |
|
47 |
-} |
48 |
|
49 |
module Ganeti.Query.Query |
50 |
( query |
51 |
, queryFields |
52 |
, queryCompat |
53 |
, getRequestedNames |
54 |
, nameField |
55 |
, NoDataRuntime |
56 |
, uuidField |
57 |
) where |
58 |
|
59 |
import Control.DeepSeq |
60 |
import Control.Monad (filterM, foldM, liftM, unless) |
61 |
import Control.Monad.IO.Class |
62 |
import Control.Monad.Trans (lift) |
63 |
import qualified Data.Foldable as Foldable |
64 |
import Data.List (intercalate, nub) |
65 |
import Data.Maybe (fromMaybe) |
66 |
import qualified Data.Map as Map |
67 |
import qualified Text.JSON as J |
68 |
|
69 |
import Ganeti.BasicTypes |
70 |
import Ganeti.Config |
71 |
import Ganeti.Errors |
72 |
import Ganeti.JQueue |
73 |
import Ganeti.JSON |
74 |
import Ganeti.Logging |
75 |
import qualified Ganeti.Luxi as L |
76 |
import Ganeti.Objects |
77 |
import Ganeti.Query.Common |
78 |
import qualified Ganeti.Query.Export as Export |
79 |
import Ganeti.Query.Filter |
80 |
import qualified Ganeti.Query.Instance as Instance |
81 |
import qualified Ganeti.Query.Job as Query.Job |
82 |
import qualified Ganeti.Query.Group as Group |
83 |
import Ganeti.Query.Language |
84 |
import qualified Ganeti.Query.Locks as Locks |
85 |
import qualified Ganeti.Query.Network as Network |
86 |
import qualified Ganeti.Query.Node as Node |
87 |
import Ganeti.Query.Types |
88 |
import Ganeti.Path |
89 |
import Ganeti.Types |
90 |
import Ganeti.Utils |
91 |
|
92 |
-- | Collector type |
93 |
data CollectorType a b |
94 |
= CollectorSimple (Bool -> ConfigData -> [a] -> IO [(a, b)]) |
95 |
| CollectorFieldAware (Bool -> ConfigData -> [String] -> [a] -> IO [(a, b)]) |
96 |
|
97 |
-- * Helper functions |
98 |
|
99 |
-- | Builds an unknown field definition. |
100 |
mkUnknownFDef :: String -> FieldData a b |
101 |
mkUnknownFDef name = |
102 |
( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'") |
103 |
, FieldUnknown |
104 |
, QffNormal ) |
105 |
|
106 |
-- | Runs a field getter on the existing contexts. |
107 |
execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry |
108 |
execGetter _ _ item (FieldSimple getter) = getter item |
109 |
execGetter cfg _ item (FieldConfig getter) = getter cfg item |
110 |
execGetter _ rt item (FieldRuntime getter) = getter rt item |
111 |
execGetter cfg rt item (FieldConfigRuntime getter) = getter cfg rt item |
112 |
execGetter _ _ _ FieldUnknown = rsUnknown |
113 |
|
114 |
-- * Main query execution |
115 |
|
116 |
-- | Helper to build the list of requested fields. This transforms the |
117 |
-- list of string fields to a list of field defs and getters, with |
118 |
-- some of them possibly being unknown fields. |
119 |
getSelectedFields :: FieldMap a b -- ^ Defined fields |
120 |
-> [String] -- ^ Requested fields |
121 |
-> FieldList a b -- ^ Selected fields |
122 |
getSelectedFields defined = |
123 |
map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined) |
124 |
|
125 |
-- | Check whether list of queried fields contains live fields. |
126 |
needsLiveData :: [FieldGetter a b] -> Bool |
127 |
needsLiveData = any isRuntimeField |
128 |
|
129 |
-- | Checks whether we have requested exactly some names. This is a |
130 |
-- simple wrapper over 'requestedNames' and 'nameField'. |
131 |
needsNames :: Query -> Maybe [FilterValue] |
132 |
needsNames (Query kind _ qfilter) = requestedNames (nameField kind) qfilter |
133 |
|
134 |
-- | Computes the name field for different query types. |
135 |
nameField :: ItemType -> FilterField |
136 |
nameField (ItemTypeLuxi QRJob) = "id" |
137 |
nameField (ItemTypeOpCode QRExport) = "node" |
138 |
nameField _ = "name" |
139 |
|
140 |
-- | Computes the uuid field, or the best possible substitute, for different |
141 |
-- query types. |
142 |
uuidField :: ItemType -> FilterField |
143 |
uuidField (ItemTypeLuxi QRJob) = nameField (ItemTypeLuxi QRJob) |
144 |
uuidField (ItemTypeOpCode QRExport) = nameField (ItemTypeOpCode QRExport) |
145 |
uuidField _ = "uuid" |
146 |
|
147 |
-- | Extracts all quoted strings from a list, ignoring the |
148 |
-- 'NumericValue' entries. |
149 |
getAllQuotedStrings :: [FilterValue] -> [String] |
150 |
getAllQuotedStrings = |
151 |
concatMap extractor |
152 |
where extractor (NumericValue _) = [] |
153 |
extractor (QuotedString val) = [val] |
154 |
|
155 |
-- | Checks that we have either requested a valid set of names, or we |
156 |
-- have a more complex filter. |
157 |
getRequestedNames :: Query -> [String] |
158 |
getRequestedNames qry = |
159 |
case needsNames qry of |
160 |
Just names -> getAllQuotedStrings names |
161 |
Nothing -> [] |
162 |
|
163 |
-- | Compute the requested job IDs. This is custom since we need to |
164 |
-- handle both strings and integers. |
165 |
getRequestedJobIDs :: Filter FilterField -> Result [JobId] |
166 |
getRequestedJobIDs qfilter = |
167 |
case requestedNames (nameField (ItemTypeLuxi QRJob)) qfilter of |
168 |
Nothing -> Ok [] |
169 |
Just [] -> Ok [] |
170 |
Just vals -> |
171 |
liftM nub $ |
172 |
mapM (\e -> case e of |
173 |
QuotedString s -> makeJobIdS s |
174 |
NumericValue i -> makeJobId $ fromIntegral i |
175 |
) vals |
176 |
|
177 |
-- | Generic query implementation for resources that are backed by |
178 |
-- some configuration objects. |
179 |
-- |
180 |
-- Different query types use the same 'genericQuery' function by providing |
181 |
-- a collector function and a field map. The collector function retrieves |
182 |
-- live data, and the field map provides both the requirements and the logic |
183 |
-- necessary to retrieve the data needed for the field. |
184 |
-- |
185 |
-- The 'b' type in the specification is the runtime. Every query can gather |
186 |
-- additional live data related to the configuration object using the collector |
187 |
-- to perform RPC calls. |
188 |
-- |
189 |
-- The gathered data, or the failure to get it, is expressed through a runtime |
190 |
-- object. The type of a runtime object is determined by every query type for |
191 |
-- itself, and used exclusively by that query. |
192 |
genericQuery :: FieldMap a b -- ^ Maps field names to field definitions |
193 |
-> CollectorType a b -- ^ Collector of live data |
194 |
-> (a -> String) -- ^ Object to name function |
195 |
-> (ConfigData -> Container a) -- ^ Get all objects from config |
196 |
-> (ConfigData -> String -> ErrorResult a) -- ^ Lookup object |
197 |
-> ConfigData -- ^ The config to run the query against |
198 |
-> Bool -- ^ Whether the query should be run live |
199 |
-> [String] -- ^ List of requested fields |
200 |
-> Filter FilterField -- ^ Filter field |
201 |
-> [String] -- ^ List of requested names |
202 |
-> IO (ErrorResult QueryResult) |
203 |
genericQuery fieldsMap collector nameFn configFn getFn cfg |
204 |
live fields qfilter wanted = |
205 |
runResultT $ do |
206 |
cfilter <- toError $ compileFilter fieldsMap qfilter |
207 |
let selected = getSelectedFields fieldsMap fields |
208 |
(fdefs, fgetters, _) = unzip3 selected |
209 |
live' = live && needsLiveData fgetters |
210 |
objects <- toError $ case wanted of |
211 |
[] -> Ok . niceSortKey nameFn . |
212 |
Foldable.toList $ configFn cfg |
213 |
_ -> mapM (getFn cfg) wanted |
214 |
-- Run the first pass of the filter, without a runtime context; this will |
215 |
-- limit the objects that we'll contact for exports |
216 |
fobjects <- toError $ filterM (\n -> evaluateFilter cfg Nothing n cfilter) |
217 |
objects |
218 |
-- Gather the runtime data |
219 |
runtimes <- case collector of |
220 |
CollectorSimple collFn -> lift $ collFn live' cfg fobjects |
221 |
CollectorFieldAware collFn -> lift $ collFn live' cfg fields fobjects |
222 |
-- Filter the results again, based on the gathered data |
223 |
let fdata = map (\(obj, runtime) -> |
224 |
map (execGetter cfg runtime obj) fgetters) |
225 |
runtimes |
226 |
return QueryResult { qresFields = fdefs, qresData = fdata } |
227 |
|
228 |
-- | Main query execution function. |
229 |
query :: ConfigData -- ^ The current configuration |
230 |
-> Bool -- ^ Whether to collect live data |
231 |
-> Query -- ^ The query (item, fields, filter) |
232 |
-> IO (ErrorResult QueryResult) -- ^ Result |
233 |
query cfg live (Query (ItemTypeLuxi QRJob) fields qfilter) = |
234 |
queryJobs cfg live fields qfilter |
235 |
query _ live (Query (ItemTypeLuxi QRLock) fields qfilter) = runResultT $ do |
236 |
unless live (failError "Locks can only be queried live") |
237 |
cl <- liftIO $ do |
238 |
socketpath <- liftIO defaultMasterSocket |
239 |
logDebug $ "Forwarding live query on locks for " ++ show fields |
240 |
++ ", " ++ show qfilter ++ " to " ++ socketpath |
241 |
liftIO $ L.getLuxiClient socketpath |
242 |
answer <- ResultT $ L.callMethod (L.Query (ItemTypeLuxi QRLock) |
243 |
fields qfilter) cl |
244 |
fromJResultE "Got unparsable answer from masterd: " $ J.readJSON answer |
245 |
|
246 |
query cfg live qry = queryInner cfg live qry $ getRequestedNames qry |
247 |
|
248 |
|
249 |
-- | Dummy data collection fuction |
250 |
dummyCollectLiveData :: Bool -> ConfigData -> [a] -> IO [(a, NoDataRuntime)] |
251 |
dummyCollectLiveData _ _ = return . map (, NoDataRuntime) |
252 |
|
253 |
-- | Inner query execution function. |
254 |
queryInner :: ConfigData -- ^ The current configuration |
255 |
-> Bool -- ^ Whether to collect live data |
256 |
-> Query -- ^ The query (item, fields, filter) |
257 |
-> [String] -- ^ Requested names |
258 |
-> IO (ErrorResult QueryResult) -- ^ Result |
259 |
|
260 |
queryInner cfg live (Query (ItemTypeOpCode QRNode) fields qfilter) wanted = |
261 |
genericQuery Node.fieldsMap (CollectorFieldAware Node.collectLiveData) |
262 |
nodeName configNodes getNode cfg live fields qfilter wanted |
263 |
|
264 |
queryInner cfg live (Query (ItemTypeOpCode QRInstance) fields qfilter) wanted = |
265 |
genericQuery Instance.fieldsMap (CollectorFieldAware Instance.collectLiveData) |
266 |
instName configInstances getInstance cfg live fields qfilter |
267 |
wanted |
268 |
|
269 |
queryInner cfg live (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted = |
270 |
genericQuery Group.fieldsMap (CollectorSimple dummyCollectLiveData) groupName |
271 |
configNodegroups getGroup cfg live fields qfilter wanted |
272 |
|
273 |
queryInner cfg live (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted = |
274 |
genericQuery Network.fieldsMap (CollectorSimple dummyCollectLiveData) |
275 |
(fromNonEmpty . networkName) |
276 |
configNetworks getNetwork cfg live fields qfilter wanted |
277 |
|
278 |
queryInner cfg live (Query (ItemTypeOpCode QRExport) fields qfilter) wanted = |
279 |
genericQuery Export.fieldsMap (CollectorSimple Export.collectLiveData) |
280 |
nodeName configNodes getNode cfg live fields qfilter wanted |
281 |
|
282 |
queryInner _ _ (Query qkind _ _) _ = |
283 |
return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported" |
284 |
|
285 |
-- | Query jobs specific query function, needed as we need to accept |
286 |
-- both 'QuotedString' and 'NumericValue' as wanted names. |
287 |
queryJobs :: ConfigData -- ^ The current configuration |
288 |
-> Bool -- ^ Whether to collect live data |
289 |
-> [FilterField] -- ^ Item |
290 |
-> Filter FilterField -- ^ Filter |
291 |
-> IO (ErrorResult QueryResult) -- ^ Result |
292 |
queryJobs cfg live fields qfilter = runResultT $ do |
293 |
rootdir <- lift queueDir |
294 |
wanted_names <- toErrorStr $ getRequestedJobIDs qfilter |
295 |
rjids <- case wanted_names of |
296 |
[] | live -> do -- we can check the filesystem for actual jobs |
297 |
let want_arch = Query.Job.wantArchived fields |
298 |
jobIDs <- |
299 |
withErrorT (BlockDeviceError . |
300 |
(++) "Unable to fetch the job list: " . show) $ |
301 |
liftIO (determineJobDirectories rootdir want_arch) |
302 |
>>= ResultT . getJobIDs |
303 |
return $ sortJobIDs jobIDs |
304 |
-- else we shouldn't look at the filesystem... |
305 |
v -> return v |
306 |
cfilter <- toError $ compileFilter Query.Job.fieldsMap qfilter |
307 |
let selected = getSelectedFields Query.Job.fieldsMap fields |
308 |
(fdefs, fgetters, _) = unzip3 selected |
309 |
(_, filtergetters, _) = unzip3 . getSelectedFields Query.Job.fieldsMap |
310 |
$ Foldable.toList qfilter |
311 |
live' = live && needsLiveData (fgetters ++ filtergetters) |
312 |
disabled_data = Bad "live data disabled" |
313 |
-- runs first pass of the filter, without a runtime context; this |
314 |
-- will limit the jobs that we'll load from disk |
315 |
jids <- toError $ |
316 |
filterM (\jid -> evaluateFilter cfg Nothing jid cfilter) rjids |
317 |
-- here we run the runtime data gathering, filtering and evaluation, |
318 |
-- all in the same step, so that we don't keep jobs in memory longer |
319 |
-- than we need; we can't be fully lazy due to the multiple monad |
320 |
-- wrapping across different steps |
321 |
qdir <- lift queueDir |
322 |
fdata <- foldM |
323 |
-- big lambda, but we use many variables from outside it... |
324 |
(\lst jid -> do |
325 |
job <- lift $ if live' |
326 |
then loadJobFromDisk qdir True jid |
327 |
else return disabled_data |
328 |
pass <- toError $ evaluateFilter cfg (Just job) jid cfilter |
329 |
let nlst = if pass |
330 |
then let row = map (execGetter cfg job jid) fgetters |
331 |
in rnf row `seq` row:lst |
332 |
else lst |
333 |
-- evaluate nlst (to WHNF), otherwise we're too lazy |
334 |
return $! nlst |
335 |
) [] jids |
336 |
return QueryResult { qresFields = fdefs, qresData = reverse fdata } |
337 |
|
338 |
-- | Helper for 'queryFields'. |
339 |
fieldsExtractor :: FieldMap a b -> [FilterField] -> QueryFieldsResult |
340 |
fieldsExtractor fieldsMap fields = |
341 |
let selected = if null fields |
342 |
then map snd . niceSortKey fst $ Map.toList fieldsMap |
343 |
else getSelectedFields fieldsMap fields |
344 |
in QueryFieldsResult (map (\(defs, _, _) -> defs) selected) |
345 |
|
346 |
-- | Query fields call. |
347 |
queryFields :: QueryFields -> ErrorResult QueryFieldsResult |
348 |
queryFields (QueryFields (ItemTypeOpCode QRNode) fields) = |
349 |
Ok $ fieldsExtractor Node.fieldsMap fields |
350 |
|
351 |
queryFields (QueryFields (ItemTypeOpCode QRGroup) fields) = |
352 |
Ok $ fieldsExtractor Group.fieldsMap fields |
353 |
|
354 |
queryFields (QueryFields (ItemTypeOpCode QRNetwork) fields) = |
355 |
Ok $ fieldsExtractor Network.fieldsMap fields |
356 |
|
357 |
queryFields (QueryFields (ItemTypeLuxi QRJob) fields) = |
358 |
Ok $ fieldsExtractor Query.Job.fieldsMap fields |
359 |
|
360 |
queryFields (QueryFields (ItemTypeOpCode QRExport) fields) = |
361 |
Ok $ fieldsExtractor Export.fieldsMap fields |
362 |
|
363 |
queryFields (QueryFields (ItemTypeOpCode QRInstance) fields) = |
364 |
Ok $ fieldsExtractor Instance.fieldsMap fields |
365 |
|
366 |
queryFields (QueryFields (ItemTypeLuxi QRLock) fields) = |
367 |
Ok $ fieldsExtractor Locks.fieldsMap fields |
368 |
|
369 |
queryFields (QueryFields qkind _) = |
370 |
Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported" |
371 |
|
372 |
-- | Classic query converter. It gets a standard query result on input |
373 |
-- and computes the classic style results. |
374 |
queryCompat :: QueryResult -> ErrorResult [[J.JSValue]] |
375 |
queryCompat (QueryResult fields qrdata) = |
376 |
case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of |
377 |
[] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata |
378 |
unknown -> Bad $ OpPrereqError ("Unknown output fields selected: " ++ |
379 |
intercalate ", " unknown) ECodeInval |