root / htools / Ganeti / Query / Query.hs @ b04dc242
History | View | Annotate | Download (7.9 kB)
1 | 4cbe9bda | Iustin Pop | {-| Implementation of the Ganeti Query2 functionality. |
---|---|---|---|
2 | 4cbe9bda | Iustin Pop | |
3 | 4cbe9bda | Iustin Pop | -} |
4 | 4cbe9bda | Iustin Pop | |
5 | 4cbe9bda | Iustin Pop | {- |
6 | 4cbe9bda | Iustin Pop | |
7 | 4cbe9bda | Iustin Pop | Copyright (C) 2012 Google Inc. |
8 | 4cbe9bda | Iustin Pop | |
9 | 4cbe9bda | Iustin Pop | This program is free software; you can redistribute it and/or modify |
10 | 4cbe9bda | Iustin Pop | it under the terms of the GNU General Public License as published by |
11 | 4cbe9bda | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
12 | 4cbe9bda | Iustin Pop | (at your option) any later version. |
13 | 4cbe9bda | Iustin Pop | |
14 | 4cbe9bda | Iustin Pop | This program is distributed in the hope that it will be useful, but |
15 | 4cbe9bda | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
16 | 4cbe9bda | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 | 4cbe9bda | Iustin Pop | General Public License for more details. |
18 | 4cbe9bda | Iustin Pop | |
19 | 4cbe9bda | Iustin Pop | You should have received a copy of the GNU General Public License |
20 | 4cbe9bda | Iustin Pop | along with this program; if not, write to the Free Software |
21 | 4cbe9bda | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 | 4cbe9bda | Iustin Pop | 02110-1301, USA. |
23 | 4cbe9bda | Iustin Pop | |
24 | 4cbe9bda | Iustin Pop | -} |
25 | 4cbe9bda | Iustin Pop | |
26 | 8a65c02b | Iustin Pop | {- |
27 | 8a65c02b | Iustin Pop | |
28 | 8a65c02b | Iustin Pop | TODO: problems with the current model: |
29 | 8a65c02b | Iustin Pop | |
30 | 8a65c02b | Iustin Pop | 1. There's nothing preventing a result such as ResultEntry RSNormal |
31 | 8a65c02b | Iustin Pop | Nothing, or ResultEntry RSNoData (Just ...); ideally, we would |
32 | 8a65c02b | Iustin Pop | separate the the RSNormal and other types; we would need a new data |
33 | 8a65c02b | Iustin Pop | type for this, though, with JSON encoding/decoding |
34 | 8a65c02b | Iustin Pop | |
35 | 8a65c02b | Iustin Pop | 2. We don't have a way to 'bind' a FieldDefinition's field type |
36 | 8a65c02b | Iustin Pop | (e.q. QFTBool) with the actual value that is returned from a |
37 | 8a65c02b | Iustin Pop | FieldGetter. This means that the various getter functions can return |
38 | 8a65c02b | Iustin Pop | divergent types for the same field when evaluated against multiple |
39 | 8a65c02b | Iustin Pop | items. This is bad; it only works today because we 'hide' everything |
40 | 8a65c02b | Iustin Pop | behind JSValue, but is not nice at all. We should probably remove the |
41 | 8a65c02b | Iustin Pop | separation between FieldDefinition and the FieldGetter, and introduce |
42 | 8a65c02b | Iustin Pop | a new abstract data type, similar to QFT*, that contains the values |
43 | 8a65c02b | Iustin Pop | too. |
44 | 8a65c02b | Iustin Pop | |
45 | 8a65c02b | Iustin Pop | -} |
46 | 8a65c02b | Iustin Pop | |
47 | 4cbe9bda | Iustin Pop | module Ganeti.Query.Query |
48 | 8a65c02b | Iustin Pop | |
49 | 4cbe9bda | Iustin Pop | ( query |
50 | 518023a9 | Iustin Pop | , queryFields |
51 | bc4cdeef | Iustin Pop | , getRequestedNames |
52 | 4cbe9bda | Iustin Pop | ) where |
53 | 4cbe9bda | Iustin Pop | |
54 | 8a65c02b | Iustin Pop | import Control.Monad (filterM) |
55 | 7f0fd838 | Agata Murawska | import Control.Monad.Trans (lift) |
56 | 046fe3f5 | Iustin Pop | import Data.Maybe (fromMaybe) |
57 | 046fe3f5 | Iustin Pop | import qualified Data.Map as Map |
58 | 046fe3f5 | Iustin Pop | |
59 | 4cbe9bda | Iustin Pop | import Ganeti.BasicTypes |
60 | 0ec87781 | Iustin Pop | import Ganeti.Config |
61 | f3baf5ef | Iustin Pop | import Ganeti.JSON |
62 | 7f0fd838 | Agata Murawska | import Ganeti.Rpc |
63 | 4cab6703 | Iustin Pop | import Ganeti.Query.Language |
64 | 046fe3f5 | Iustin Pop | import Ganeti.Query.Common |
65 | 8a65c02b | Iustin Pop | import Ganeti.Query.Filter |
66 | 046fe3f5 | Iustin Pop | import Ganeti.Query.Types |
67 | 046fe3f5 | Iustin Pop | import Ganeti.Query.Node |
68 | 40246fa0 | Agata Murawska | import Ganeti.Query.Group |
69 | 4cbe9bda | Iustin Pop | import Ganeti.Objects |
70 | a41c337e | Iustin Pop | import Ganeti.Utils |
71 | 4cbe9bda | Iustin Pop | |
72 | 046fe3f5 | Iustin Pop | -- * Helper functions |
73 | 046fe3f5 | Iustin Pop | |
74 | 046fe3f5 | Iustin Pop | -- | Builds an unknown field definition. |
75 | 046fe3f5 | Iustin Pop | mkUnknownFDef :: String -> FieldData a b |
76 | 046fe3f5 | Iustin Pop | mkUnknownFDef name = |
77 | 046fe3f5 | Iustin Pop | ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'") |
78 | 046fe3f5 | Iustin Pop | , FieldUnknown ) |
79 | 046fe3f5 | Iustin Pop | |
80 | 046fe3f5 | Iustin Pop | -- | Runs a field getter on the existing contexts. |
81 | 046fe3f5 | Iustin Pop | execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry |
82 | 046fe3f5 | Iustin Pop | execGetter _ _ item (FieldSimple getter) = getter item |
83 | 046fe3f5 | Iustin Pop | execGetter cfg _ item (FieldConfig getter) = getter cfg item |
84 | 046fe3f5 | Iustin Pop | execGetter _ rt item (FieldRuntime getter) = getter rt item |
85 | 046fe3f5 | Iustin Pop | execGetter _ _ _ FieldUnknown = rsUnknown |
86 | 046fe3f5 | Iustin Pop | |
87 | 046fe3f5 | Iustin Pop | -- * Main query execution |
88 | 046fe3f5 | Iustin Pop | |
89 | 046fe3f5 | Iustin Pop | -- | Helper to build the list of requested fields. This transforms the |
90 | 046fe3f5 | Iustin Pop | -- list of string fields to a list of field defs and getters, with |
91 | 046fe3f5 | Iustin Pop | -- some of them possibly being unknown fields. |
92 | 046fe3f5 | Iustin Pop | getSelectedFields :: FieldMap a b -- ^ Defined fields |
93 | 046fe3f5 | Iustin Pop | -> [String] -- ^ Requested fields |
94 | 046fe3f5 | Iustin Pop | -> FieldList a b -- ^ Selected fields |
95 | 046fe3f5 | Iustin Pop | getSelectedFields defined = |
96 | 046fe3f5 | Iustin Pop | map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined) |
97 | 046fe3f5 | Iustin Pop | |
98 | 7f0fd838 | Agata Murawska | -- | Collect live data from RPC query if enabled. |
99 | 7f0fd838 | Agata Murawska | -- FIXME: Check which fields we actually need and possibly send empty |
100 | 7f0fd838 | Agata Murawska | -- hvs/vgs if no info from hypervisor/volume group respectively |
101 | 7f0fd838 | Agata Murawska | -- is required |
102 | 7f0fd838 | Agata Murawska | maybeCollectLiveData:: Bool -> ConfigData -> [Node] -> IO [(Node, NodeRuntime)] |
103 | 7f0fd838 | Agata Murawska | |
104 | 7f0fd838 | Agata Murawska | maybeCollectLiveData False _ nodes = |
105 | 7f0fd838 | Agata Murawska | return $ zip nodes (repeat $ Left (RpcResultError "Live data disabled")) |
106 | 7f0fd838 | Agata Murawska | |
107 | 7f0fd838 | Agata Murawska | maybeCollectLiveData True cfg nodes = do |
108 | 7f0fd838 | Agata Murawska | let vgs = [clusterVolumeGroupName $ configCluster cfg] |
109 | 0ec87781 | Iustin Pop | hvs = [getDefaultHypervisor cfg] |
110 | 7f0fd838 | Agata Murawska | executeRpcCall nodes (RpcCallNodeInfo vgs hvs) |
111 | 7f0fd838 | Agata Murawska | |
112 | 7f0fd838 | Agata Murawska | -- | Check whether list of queried fields contains live fields. |
113 | 7f0fd838 | Agata Murawska | needsLiveData :: [FieldGetter a b] -> Bool |
114 | 7f0fd838 | Agata Murawska | needsLiveData = any (\getter -> case getter of |
115 | 7f0fd838 | Agata Murawska | FieldRuntime _ -> True |
116 | 7f0fd838 | Agata Murawska | _ -> False) |
117 | 7f0fd838 | Agata Murawska | |
118 | bc4cdeef | Iustin Pop | -- | Checks whether we have requested exactly some names. This is a |
119 | bc4cdeef | Iustin Pop | -- simple wrapper over 'requestedNames' and 'nameField'. |
120 | bc4cdeef | Iustin Pop | needsNames :: Query -> Maybe [FilterValue] |
121 | bc4cdeef | Iustin Pop | needsNames (Query kind _ qfilter) = requestedNames (nameField kind) qfilter |
122 | bc4cdeef | Iustin Pop | |
123 | bc4cdeef | Iustin Pop | -- | Computes the name field for different query types. |
124 | bc4cdeef | Iustin Pop | nameField :: ItemType -> FilterField |
125 | bc4cdeef | Iustin Pop | nameField QRJob = "id" |
126 | bc4cdeef | Iustin Pop | nameField _ = "name" |
127 | bc4cdeef | Iustin Pop | |
128 | bc4cdeef | Iustin Pop | -- | Extracts all quoted strings from a list, ignoring the |
129 | bc4cdeef | Iustin Pop | -- 'NumericValue' entries. |
130 | bc4cdeef | Iustin Pop | getAllQuotedStrings :: [FilterValue] -> [String] |
131 | bc4cdeef | Iustin Pop | getAllQuotedStrings = |
132 | bc4cdeef | Iustin Pop | concatMap extractor |
133 | bc4cdeef | Iustin Pop | where extractor (NumericValue _) = [] |
134 | bc4cdeef | Iustin Pop | extractor (QuotedString val) = [val] |
135 | bc4cdeef | Iustin Pop | |
136 | bc4cdeef | Iustin Pop | -- | Checks that we have either requested a valid set of names, or we |
137 | bc4cdeef | Iustin Pop | -- have a more complex filter. |
138 | bc4cdeef | Iustin Pop | getRequestedNames :: Query -> [String] |
139 | bc4cdeef | Iustin Pop | getRequestedNames qry = |
140 | bc4cdeef | Iustin Pop | case needsNames qry of |
141 | bc4cdeef | Iustin Pop | Just names -> getAllQuotedStrings names |
142 | bc4cdeef | Iustin Pop | Nothing -> [] |
143 | bc4cdeef | Iustin Pop | |
144 | 4cbe9bda | Iustin Pop | -- | Main query execution function. |
145 | 4cbe9bda | Iustin Pop | query :: ConfigData -- ^ The current configuration |
146 | fa2c927c | Agata Murawska | -> Bool -- ^ Whether to collect live data |
147 | 4cbe9bda | Iustin Pop | -> Query -- ^ The query (item, fields, filter) |
148 | 4cbe9bda | Iustin Pop | -> IO (Result QueryResult) -- ^ Result |
149 | a41c337e | Iustin Pop | query cfg live qry = queryInner cfg live qry $ getRequestedNames qry |
150 | 046fe3f5 | Iustin Pop | |
151 | a41c337e | Iustin Pop | -- | Inner query execution function. |
152 | a41c337e | Iustin Pop | queryInner :: ConfigData -- ^ The current configuration |
153 | a41c337e | Iustin Pop | -> Bool -- ^ Whether to collect live data |
154 | a41c337e | Iustin Pop | -> Query -- ^ The query (item, fields, filter) |
155 | a41c337e | Iustin Pop | -> [String] -- ^ Requested names |
156 | a41c337e | Iustin Pop | -> IO (Result QueryResult) -- ^ Result |
157 | a41c337e | Iustin Pop | |
158 | a41c337e | Iustin Pop | queryInner cfg live (Query QRNode fields qfilter) wanted = runResultT $ do |
159 | 7f0fd838 | Agata Murawska | cfilter <- resultT $ compileFilter nodeFieldsMap qfilter |
160 | 046fe3f5 | Iustin Pop | let selected = getSelectedFields nodeFieldsMap fields |
161 | 046fe3f5 | Iustin Pop | (fdefs, fgetters) = unzip selected |
162 | 7f0fd838 | Agata Murawska | live' = live && needsLiveData fgetters |
163 | a41c337e | Iustin Pop | nodes <- resultT $ case wanted of |
164 | 1fc3812c | Iustin Pop | [] -> Ok . niceSortKey nodeName . |
165 | 1fc3812c | Iustin Pop | Map.elems . fromContainer $ configNodes cfg |
166 | a41c337e | Iustin Pop | _ -> mapM (getNode cfg) wanted |
167 | 8a65c02b | Iustin Pop | -- runs first pass of the filter, without a runtime context; this |
168 | 8a65c02b | Iustin Pop | -- will limit the nodes that we'll contact for runtime data |
169 | 7f0fd838 | Agata Murawska | fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter) nodes |
170 | 8a65c02b | Iustin Pop | -- here we would run the runtime data gathering, then filter again |
171 | 8a65c02b | Iustin Pop | -- the nodes, based on existing runtime data |
172 | 7f0fd838 | Agata Murawska | nruntimes <- lift $ maybeCollectLiveData live' cfg fnodes |
173 | 7f0fd838 | Agata Murawska | let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters) |
174 | 7f0fd838 | Agata Murawska | nruntimes |
175 | 046fe3f5 | Iustin Pop | return QueryResult { qresFields = fdefs, qresData = fdata } |
176 | 046fe3f5 | Iustin Pop | |
177 | a41c337e | Iustin Pop | queryInner cfg _ (Query QRGroup fields qfilter) wanted = return $ do |
178 | 40246fa0 | Agata Murawska | cfilter <- compileFilter groupFieldsMap qfilter |
179 | 40246fa0 | Agata Murawska | let selected = getSelectedFields groupFieldsMap fields |
180 | 40246fa0 | Agata Murawska | (fdefs, fgetters) = unzip selected |
181 | a41c337e | Iustin Pop | groups <- case wanted of |
182 | 1fc3812c | Iustin Pop | [] -> Ok . niceSortKey groupName . |
183 | 1fc3812c | Iustin Pop | Map.elems . fromContainer $ configNodegroups cfg |
184 | a41c337e | Iustin Pop | _ -> mapM (getGroup cfg) wanted |
185 | 40246fa0 | Agata Murawska | -- there is no live data for groups, so filtering is much simpler |
186 | 40246fa0 | Agata Murawska | fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups |
187 | 40246fa0 | Agata Murawska | let fdata = map (\node -> |
188 | 40246fa0 | Agata Murawska | map (execGetter cfg GroupRuntime node) fgetters) fgroups |
189 | 40246fa0 | Agata Murawska | return QueryResult {qresFields = fdefs, qresData = fdata } |
190 | 40246fa0 | Agata Murawska | |
191 | a41c337e | Iustin Pop | queryInner _ _ (Query qkind _ _) _ = |
192 | 4cbe9bda | Iustin Pop | return . Bad $ "Query '" ++ show qkind ++ "' not supported" |
193 | 518023a9 | Iustin Pop | |
194 | b04dc242 | Iustin Pop | -- | Helper for 'queryFields'. |
195 | b04dc242 | Iustin Pop | fieldsExtractor :: FieldMap a b -> [FilterField] -> QueryFieldsResult |
196 | b04dc242 | Iustin Pop | fieldsExtractor fieldsMap fields = |
197 | b04dc242 | Iustin Pop | let selected = if null fields |
198 | b04dc242 | Iustin Pop | then map snd $ Map.toAscList fieldsMap |
199 | b04dc242 | Iustin Pop | else getSelectedFields fieldsMap fields |
200 | b04dc242 | Iustin Pop | in QueryFieldsResult (map fst selected) |
201 | b04dc242 | Iustin Pop | |
202 | 518023a9 | Iustin Pop | -- | Query fields call. |
203 | 518023a9 | Iustin Pop | queryFields :: QueryFields -> Result QueryFieldsResult |
204 | 518023a9 | Iustin Pop | queryFields (QueryFields QRNode fields) = |
205 | b04dc242 | Iustin Pop | Ok $ fieldsExtractor nodeFieldsMap fields |
206 | 518023a9 | Iustin Pop | |
207 | 40246fa0 | Agata Murawska | queryFields (QueryFields QRGroup fields) = |
208 | b04dc242 | Iustin Pop | Ok $ fieldsExtractor groupFieldsMap fields |
209 | 40246fa0 | Agata Murawska | |
210 | 518023a9 | Iustin Pop | queryFields (QueryFields qkind _) = |
211 | 518023a9 | Iustin Pop | Bad $ "QueryFields '" ++ show qkind ++ "' not supported" |