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