Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Query / Query.hs @ ae960018

History | View | Annotate | Download (12.1 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 4cbe9bda Iustin Pop
    ( query
49 518023a9 Iustin Pop
    , queryFields
50 cd67e337 Iustin Pop
    , queryCompat
51 bc4cdeef Iustin Pop
    , getRequestedNames
52 cd67e337 Iustin Pop
    , nameField
53 4cbe9bda Iustin Pop
    ) where
54 4cbe9bda Iustin Pop
55 a7e484c4 Iustin Pop
import Control.DeepSeq
56 a7e484c4 Iustin Pop
import Control.Monad (filterM, liftM, foldM)
57 7f0fd838 Agata Murawska
import Control.Monad.Trans (lift)
58 cd67e337 Iustin Pop
import Data.List (intercalate)
59 046fe3f5 Iustin Pop
import Data.Maybe (fromMaybe)
60 046fe3f5 Iustin Pop
import qualified Data.Map as Map
61 cd67e337 Iustin Pop
import qualified Text.JSON as J
62 046fe3f5 Iustin Pop
63 4cbe9bda Iustin Pop
import Ganeti.BasicTypes
64 0ec87781 Iustin Pop
import Ganeti.Config
65 a7e484c4 Iustin Pop
import Ganeti.Errors
66 a7e484c4 Iustin Pop
import Ganeti.JQueue
67 f3baf5ef Iustin Pop
import Ganeti.JSON
68 a7e484c4 Iustin Pop
import Ganeti.Objects
69 046fe3f5 Iustin Pop
import Ganeti.Query.Common
70 8a65c02b Iustin Pop
import Ganeti.Query.Filter
71 a7e484c4 Iustin Pop
import qualified Ganeti.Query.Job as Query.Job
72 40246fa0 Agata Murawska
import Ganeti.Query.Group
73 a7e484c4 Iustin Pop
import Ganeti.Query.Language
74 05092772 Helga Velroyen
import Ganeti.Query.Network
75 a7e484c4 Iustin Pop
import Ganeti.Query.Node
76 a7e484c4 Iustin Pop
import Ganeti.Query.Types
77 a7e484c4 Iustin Pop
import Ganeti.Path
78 a7e484c4 Iustin Pop
import Ganeti.Types
79 a41c337e Iustin Pop
import Ganeti.Utils
80 4cbe9bda Iustin Pop
81 046fe3f5 Iustin Pop
-- * Helper functions
82 046fe3f5 Iustin Pop
83 046fe3f5 Iustin Pop
-- | Builds an unknown field definition.
84 046fe3f5 Iustin Pop
mkUnknownFDef :: String -> FieldData a b
85 046fe3f5 Iustin Pop
mkUnknownFDef name =
86 046fe3f5 Iustin Pop
  ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
87 f94a9680 Iustin Pop
  , FieldUnknown
88 f94a9680 Iustin Pop
  , QffNormal )
89 046fe3f5 Iustin Pop
90 046fe3f5 Iustin Pop
-- | Runs a field getter on the existing contexts.
91 046fe3f5 Iustin Pop
execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
92 046fe3f5 Iustin Pop
execGetter _   _ item (FieldSimple getter)  = getter item
93 046fe3f5 Iustin Pop
execGetter cfg _ item (FieldConfig getter)  = getter cfg item
94 046fe3f5 Iustin Pop
execGetter _  rt item (FieldRuntime getter) = getter rt item
95 046fe3f5 Iustin Pop
execGetter _   _ _    FieldUnknown          = rsUnknown
96 046fe3f5 Iustin Pop
97 046fe3f5 Iustin Pop
-- * Main query execution
98 046fe3f5 Iustin Pop
99 046fe3f5 Iustin Pop
-- | Helper to build the list of requested fields. This transforms the
100 046fe3f5 Iustin Pop
-- list of string fields to a list of field defs and getters, with
101 046fe3f5 Iustin Pop
-- some of them possibly being unknown fields.
102 046fe3f5 Iustin Pop
getSelectedFields :: FieldMap a b  -- ^ Defined fields
103 046fe3f5 Iustin Pop
                  -> [String]      -- ^ Requested fields
104 046fe3f5 Iustin Pop
                  -> FieldList a b -- ^ Selected fields
105 046fe3f5 Iustin Pop
getSelectedFields defined =
106 046fe3f5 Iustin Pop
  map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined)
107 046fe3f5 Iustin Pop
108 7f0fd838 Agata Murawska
-- | Check whether list of queried fields contains live fields.
109 7f0fd838 Agata Murawska
needsLiveData :: [FieldGetter a b] -> Bool
110 a2ae14e9 Iustin Pop
needsLiveData = any isRuntimeField
111 7f0fd838 Agata Murawska
112 bc4cdeef Iustin Pop
-- | Checks whether we have requested exactly some names. This is a
113 bc4cdeef Iustin Pop
-- simple wrapper over 'requestedNames' and 'nameField'.
114 bc4cdeef Iustin Pop
needsNames :: Query -> Maybe [FilterValue]
115 bc4cdeef Iustin Pop
needsNames (Query kind _ qfilter) = requestedNames (nameField kind) qfilter
116 bc4cdeef Iustin Pop
117 bc4cdeef Iustin Pop
-- | Computes the name field for different query types.
118 bc4cdeef Iustin Pop
nameField :: ItemType -> FilterField
119 1283cc38 Iustin Pop
nameField (ItemTypeLuxi QRJob) = "id"
120 1283cc38 Iustin Pop
nameField _ = "name"
121 bc4cdeef Iustin Pop
122 bc4cdeef Iustin Pop
-- | Extracts all quoted strings from a list, ignoring the
123 bc4cdeef Iustin Pop
-- 'NumericValue' entries.
124 bc4cdeef Iustin Pop
getAllQuotedStrings :: [FilterValue] -> [String]
125 bc4cdeef Iustin Pop
getAllQuotedStrings =
126 bc4cdeef Iustin Pop
  concatMap extractor
127 bc4cdeef Iustin Pop
    where extractor (NumericValue _)   = []
128 bc4cdeef Iustin Pop
          extractor (QuotedString val) = [val]
129 bc4cdeef Iustin Pop
130 bc4cdeef Iustin Pop
-- | Checks that we have either requested a valid set of names, or we
131 bc4cdeef Iustin Pop
-- have a more complex filter.
132 bc4cdeef Iustin Pop
getRequestedNames :: Query -> [String]
133 bc4cdeef Iustin Pop
getRequestedNames qry =
134 bc4cdeef Iustin Pop
  case needsNames qry of
135 bc4cdeef Iustin Pop
    Just names -> getAllQuotedStrings names
136 bc4cdeef Iustin Pop
    Nothing    -> []
137 bc4cdeef Iustin Pop
138 a7e484c4 Iustin Pop
-- | Compute the requested job IDs. This is custom since we need to
139 a7e484c4 Iustin Pop
-- handle both strings and integers.
140 a7e484c4 Iustin Pop
getRequestedJobIDs :: Filter FilterField -> Result [JobId]
141 a7e484c4 Iustin Pop
getRequestedJobIDs qfilter =
142 a7e484c4 Iustin Pop
  case requestedNames (nameField (ItemTypeLuxi QRJob)) qfilter of
143 a7e484c4 Iustin Pop
    Nothing -> Ok []
144 a7e484c4 Iustin Pop
    Just [] -> Ok []
145 a7e484c4 Iustin Pop
    Just vals ->
146 a7e484c4 Iustin Pop
      mapM (\e -> case e of
147 a7e484c4 Iustin Pop
                    QuotedString s -> makeJobIdS s
148 a7e484c4 Iustin Pop
                    NumericValue i -> makeJobId $ fromIntegral i
149 a7e484c4 Iustin Pop
           ) vals
150 a7e484c4 Iustin Pop
151 4cbe9bda Iustin Pop
-- | Main query execution function.
152 4cbe9bda Iustin Pop
query :: ConfigData   -- ^ The current configuration
153 fa2c927c Agata Murawska
      -> Bool         -- ^ Whether to collect live data
154 4cbe9bda Iustin Pop
      -> Query        -- ^ The query (item, fields, filter)
155 5183e8be Iustin Pop
      -> IO (ErrorResult QueryResult) -- ^ Result
156 a7e484c4 Iustin Pop
query cfg live (Query (ItemTypeLuxi QRJob) fields qfilter) =
157 a7e484c4 Iustin Pop
  queryJobs cfg live fields qfilter
158 a41c337e Iustin Pop
query cfg live qry = queryInner cfg live qry $ getRequestedNames qry
159 046fe3f5 Iustin Pop
160 a41c337e Iustin Pop
-- | Inner query execution function.
161 a41c337e Iustin Pop
queryInner :: ConfigData   -- ^ The current configuration
162 a41c337e Iustin Pop
           -> Bool         -- ^ Whether to collect live data
163 a41c337e Iustin Pop
           -> Query        -- ^ The query (item, fields, filter)
164 a41c337e Iustin Pop
           -> [String]     -- ^ Requested names
165 5183e8be Iustin Pop
           -> IO (ErrorResult QueryResult) -- ^ Result
166 a41c337e Iustin Pop
167 1283cc38 Iustin Pop
queryInner cfg live (Query (ItemTypeOpCode QRNode) fields qfilter) wanted =
168 1283cc38 Iustin Pop
  runResultT $ do
169 7f0fd838 Agata Murawska
  cfilter <- resultT $ compileFilter nodeFieldsMap qfilter
170 046fe3f5 Iustin Pop
  let selected = getSelectedFields nodeFieldsMap fields
171 f94a9680 Iustin Pop
      (fdefs, fgetters, _) = unzip3 selected
172 7f0fd838 Agata Murawska
      live' = live && needsLiveData fgetters
173 a41c337e Iustin Pop
  nodes <- resultT $ case wanted of
174 1fc3812c Iustin Pop
             [] -> Ok . niceSortKey nodeName .
175 1fc3812c Iustin Pop
                   Map.elems . fromContainer $ configNodes cfg
176 a41c337e Iustin Pop
             _  -> mapM (getNode cfg) wanted
177 8a65c02b Iustin Pop
  -- runs first pass of the filter, without a runtime context; this
178 8a65c02b Iustin Pop
  -- will limit the nodes that we'll contact for runtime data
179 5183e8be Iustin Pop
  fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
180 5183e8be Iustin Pop
                      nodes
181 8a65c02b Iustin Pop
  -- here we would run the runtime data gathering, then filter again
182 8a65c02b Iustin Pop
  -- the nodes, based on existing runtime data
183 7f0fd838 Agata Murawska
  nruntimes <- lift $ maybeCollectLiveData live' cfg fnodes
184 7f0fd838 Agata Murawska
  let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters)
185 7f0fd838 Agata Murawska
              nruntimes
186 046fe3f5 Iustin Pop
  return QueryResult { qresFields = fdefs, qresData = fdata }
187 046fe3f5 Iustin Pop
188 1283cc38 Iustin Pop
queryInner cfg _ (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted =
189 1283cc38 Iustin Pop
  return $ do
190 40246fa0 Agata Murawska
  cfilter <- compileFilter groupFieldsMap qfilter
191 40246fa0 Agata Murawska
  let selected = getSelectedFields groupFieldsMap fields
192 f94a9680 Iustin Pop
      (fdefs, fgetters, _) = unzip3 selected
193 a41c337e Iustin Pop
  groups <- case wanted of
194 1fc3812c Iustin Pop
              [] -> Ok . niceSortKey groupName .
195 1fc3812c Iustin Pop
                    Map.elems . fromContainer $ configNodegroups cfg
196 a41c337e Iustin Pop
              _  -> mapM (getGroup cfg) wanted
197 40246fa0 Agata Murawska
  -- there is no live data for groups, so filtering is much simpler
198 40246fa0 Agata Murawska
  fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups
199 40246fa0 Agata Murawska
  let fdata = map (\node ->
200 40246fa0 Agata Murawska
                       map (execGetter cfg GroupRuntime node) fgetters) fgroups
201 05092772 Helga Velroyen
  return QueryResult { qresFields = fdefs, qresData = fdata }
202 05092772 Helga Velroyen
203 05092772 Helga Velroyen
queryInner cfg _ (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted =
204 05092772 Helga Velroyen
  return $ do
205 05092772 Helga Velroyen
  cfilter <- compileFilter networkFieldsMap qfilter
206 05092772 Helga Velroyen
  let selected = getSelectedFields networkFieldsMap fields
207 05092772 Helga Velroyen
      (fdefs, fgetters, _) = unzip3 selected
208 05092772 Helga Velroyen
  networks <- case wanted of
209 05092772 Helga Velroyen
                [] -> Ok . niceSortKey (fromNonEmpty . networkName) .
210 05092772 Helga Velroyen
                      Map.elems . fromContainer $ configNetworks cfg
211 05092772 Helga Velroyen
                _  -> mapM (getNetwork cfg) wanted
212 05092772 Helga Velroyen
  fnetworks <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) networks
213 05092772 Helga Velroyen
  let fdata = map (\network ->
214 05092772 Helga Velroyen
                   map (execGetter cfg NetworkRuntime network) fgetters)
215 05092772 Helga Velroyen
                   fnetworks
216 05092772 Helga Velroyen
  return QueryResult { qresFields = fdefs, qresData = fdata }
217 40246fa0 Agata Murawska
218 a41c337e Iustin Pop
queryInner _ _ (Query qkind _ _) _ =
219 5183e8be Iustin Pop
  return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
220 518023a9 Iustin Pop
221 a7e484c4 Iustin Pop
-- | Query jobs specific query function, needed as we need to accept
222 a7e484c4 Iustin Pop
-- both 'QuotedString' and 'NumericValue' as wanted names.
223 a7e484c4 Iustin Pop
queryJobs :: ConfigData                   -- ^ The current configuration
224 a7e484c4 Iustin Pop
          -> Bool                         -- ^ Whether to collect live data
225 a7e484c4 Iustin Pop
          -> [FilterField]                -- ^ Item
226 a7e484c4 Iustin Pop
          -> Filter FilterField           -- ^ Filter
227 a7e484c4 Iustin Pop
          -> IO (ErrorResult QueryResult) -- ^ Result
228 a7e484c4 Iustin Pop
queryJobs cfg live fields qfilter =
229 a7e484c4 Iustin Pop
  runResultT $ do
230 a7e484c4 Iustin Pop
  rootdir <- lift queueDir
231 a7e484c4 Iustin Pop
  let wanted_names = getRequestedJobIDs qfilter
232 a7e484c4 Iustin Pop
      want_arch = Query.Job.wantArchived fields
233 a7e484c4 Iustin Pop
  rjids <- case wanted_names of
234 a7e484c4 Iustin Pop
             Bad msg -> resultT . Bad $ GenericError msg
235 a7e484c4 Iustin Pop
             Ok [] -> if live
236 a7e484c4 Iustin Pop
                        -- we can check the filesystem for actual jobs
237 a7e484c4 Iustin Pop
                        then lift $ liftM sortJobIDs
238 a7e484c4 Iustin Pop
                             (determineJobDirectories rootdir want_arch >>=
239 a7e484c4 Iustin Pop
                              getJobIDs)
240 a7e484c4 Iustin Pop
                        -- else we shouldn't look at the filesystem...
241 a7e484c4 Iustin Pop
                        else return []
242 a7e484c4 Iustin Pop
             Ok v -> resultT $ Ok v
243 a7e484c4 Iustin Pop
  cfilter <- resultT $ compileFilter Query.Job.fieldsMap qfilter
244 a7e484c4 Iustin Pop
  let selected = getSelectedFields Query.Job.fieldsMap fields
245 a7e484c4 Iustin Pop
      (fdefs, fgetters, _) = unzip3 selected
246 a7e484c4 Iustin Pop
      live' = live && needsLiveData fgetters
247 a7e484c4 Iustin Pop
      disabled_data = Bad "live data disabled"
248 a7e484c4 Iustin Pop
  -- runs first pass of the filter, without a runtime context; this
249 a7e484c4 Iustin Pop
  -- will limit the jobs that we'll load from disk
250 a7e484c4 Iustin Pop
  jids <- resultT $
251 a7e484c4 Iustin Pop
          filterM (\jid -> evaluateFilter cfg Nothing jid cfilter) rjids
252 a7e484c4 Iustin Pop
  -- here we run the runtime data gathering, filtering and evaluation,
253 a7e484c4 Iustin Pop
  -- all in the same step, so that we don't keep jobs in memory longer
254 a7e484c4 Iustin Pop
  -- than we need; we can't be fully lazy due to the multiple monad
255 a7e484c4 Iustin Pop
  -- wrapping across different steps
256 a7e484c4 Iustin Pop
  qdir <- lift queueDir
257 a7e484c4 Iustin Pop
  fdata <- foldM
258 a7e484c4 Iustin Pop
           -- big lambda, but we use many variables from outside it...
259 a7e484c4 Iustin Pop
           (\lst jid -> do
260 a7e484c4 Iustin Pop
              job <- lift $ if live'
261 d45a824b Iustin Pop
                              then loadJobFromDisk qdir True jid
262 a7e484c4 Iustin Pop
                              else return disabled_data
263 a7e484c4 Iustin Pop
              pass <- resultT $ evaluateFilter cfg (Just job) jid cfilter
264 a7e484c4 Iustin Pop
              let nlst = if pass
265 a7e484c4 Iustin Pop
                           then let row = map (execGetter cfg job jid) fgetters
266 a7e484c4 Iustin Pop
                                in rnf row `seq` row:lst
267 a7e484c4 Iustin Pop
                           else lst
268 a7e484c4 Iustin Pop
              -- evaluate nlst (to WHNF), otherwise we're too lazy
269 a7e484c4 Iustin Pop
              return $! nlst
270 a7e484c4 Iustin Pop
           ) [] jids
271 a7e484c4 Iustin Pop
  return QueryResult { qresFields = fdefs, qresData = reverse fdata }
272 a7e484c4 Iustin Pop
273 b04dc242 Iustin Pop
-- | Helper for 'queryFields'.
274 b04dc242 Iustin Pop
fieldsExtractor :: FieldMap a b -> [FilterField] -> QueryFieldsResult
275 b04dc242 Iustin Pop
fieldsExtractor fieldsMap fields =
276 b04dc242 Iustin Pop
  let selected = if null fields
277 b04dc242 Iustin Pop
                   then map snd $ Map.toAscList fieldsMap
278 b04dc242 Iustin Pop
                   else getSelectedFields fieldsMap fields
279 f94a9680 Iustin Pop
  in QueryFieldsResult (map (\(defs, _, _) -> defs) selected)
280 b04dc242 Iustin Pop
281 518023a9 Iustin Pop
-- | Query fields call.
282 5183e8be Iustin Pop
queryFields :: QueryFields -> ErrorResult QueryFieldsResult
283 1283cc38 Iustin Pop
queryFields (QueryFields (ItemTypeOpCode QRNode) fields) =
284 b04dc242 Iustin Pop
  Ok $ fieldsExtractor nodeFieldsMap fields
285 518023a9 Iustin Pop
286 1283cc38 Iustin Pop
queryFields (QueryFields (ItemTypeOpCode QRGroup) fields) =
287 b04dc242 Iustin Pop
  Ok $ fieldsExtractor groupFieldsMap fields
288 40246fa0 Agata Murawska
289 a7e484c4 Iustin Pop
queryFields (QueryFields (ItemTypeLuxi QRJob) fields) =
290 a7e484c4 Iustin Pop
  Ok $ fieldsExtractor Query.Job.fieldsMap fields
291 a7e484c4 Iustin Pop
292 518023a9 Iustin Pop
queryFields (QueryFields qkind _) =
293 5183e8be Iustin Pop
  Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported"
294 cd67e337 Iustin Pop
295 cd67e337 Iustin Pop
-- | Classic query converter. It gets a standard query result on input
296 cd67e337 Iustin Pop
-- and computes the classic style results.
297 5183e8be Iustin Pop
queryCompat :: QueryResult -> ErrorResult [[J.JSValue]]
298 cd67e337 Iustin Pop
queryCompat (QueryResult fields qrdata) =
299 cd67e337 Iustin Pop
  case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
300 cd67e337 Iustin Pop
    [] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
301 5183e8be Iustin Pop
    unknown -> Bad $ OpPrereqError ("Unknown output fields selected: " ++
302 5183e8be Iustin Pop
                                    intercalate ", " unknown) ECodeInval