Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (14.7 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
    ) where
57

    
58
import Control.DeepSeq
59
import Control.Monad (filterM, foldM)
60
import Control.Monad.Trans (lift)
61
import Data.List (intercalate)
62
import Data.Maybe (fromMaybe)
63
import qualified Data.Map as Map
64
import qualified Text.JSON as J
65

    
66
import Ganeti.BasicTypes
67
import Ganeti.Config
68
import Ganeti.Errors
69
import Ganeti.JQueue
70
import Ganeti.JSON
71
import Ganeti.Objects
72
import Ganeti.Query.Common
73
import qualified Ganeti.Query.Export as Export
74
import Ganeti.Query.Filter
75
import qualified Ganeti.Query.Instance as Instance
76
import qualified Ganeti.Query.Job as Query.Job
77
import qualified Ganeti.Query.Group as Group
78
import Ganeti.Query.Language
79
import qualified Ganeti.Query.Network as Network
80
import qualified Ganeti.Query.Node as Node
81
import Ganeti.Query.Types
82
import Ganeti.Path
83
import Ganeti.Types
84
import Ganeti.Utils
85

    
86
-- | Collector type
87
data CollectorType a b
88
  = CollectorSimple     (Bool -> ConfigData -> [a] -> IO [(a, b)])
89
  | CollectorFieldAware (Bool -> ConfigData -> [String] -> [a] -> IO [(a, b)])
90

    
91
-- * Helper functions
92

    
93
-- | Builds an unknown field definition.
94
mkUnknownFDef :: String -> FieldData a b
95
mkUnknownFDef name =
96
  ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
97
  , FieldUnknown
98
  , QffNormal )
99

    
100
-- | Runs a field getter on the existing contexts.
101
execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
102
execGetter _   _  item (FieldSimple getter)        = getter item
103
execGetter cfg _  item (FieldConfig getter)        = getter cfg item
104
execGetter _   rt item (FieldRuntime getter)       = getter rt item
105
execGetter cfg rt item (FieldConfigRuntime getter) = getter cfg rt item
106
execGetter _   _  _    FieldUnknown                = rsUnknown
107

    
108
-- * Main query execution
109

    
110
-- | Helper to build the list of requested fields. This transforms the
111
-- list of string fields to a list of field defs and getters, with
112
-- some of them possibly being unknown fields.
113
getSelectedFields :: FieldMap a b  -- ^ Defined fields
114
                  -> [String]      -- ^ Requested fields
115
                  -> FieldList a b -- ^ Selected fields
116
getSelectedFields defined =
117
  map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined)
118

    
119
-- | Check whether list of queried fields contains live fields.
120
needsLiveData :: [FieldGetter a b] -> Bool
121
needsLiveData = any isRuntimeField
122

    
123
-- | Checks whether we have requested exactly some names. This is a
124
-- simple wrapper over 'requestedNames' and 'nameField'.
125
needsNames :: Query -> Maybe [FilterValue]
126
needsNames (Query kind _ qfilter) = requestedNames (nameField kind) qfilter
127

    
128
-- | Computes the name field for different query types.
129
nameField :: ItemType -> FilterField
130
nameField (ItemTypeLuxi QRJob) = "id"
131
nameField (ItemTypeOpCode QRExport) = "node"
132
nameField _ = "name"
133

    
134
-- | Extracts all quoted strings from a list, ignoring the
135
-- 'NumericValue' entries.
136
getAllQuotedStrings :: [FilterValue] -> [String]
137
getAllQuotedStrings =
138
  concatMap extractor
139
    where extractor (NumericValue _)   = []
140
          extractor (QuotedString val) = [val]
141

    
142
-- | Checks that we have either requested a valid set of names, or we
143
-- have a more complex filter.
144
getRequestedNames :: Query -> [String]
145
getRequestedNames qry =
146
  case needsNames qry of
147
    Just names -> getAllQuotedStrings names
148
    Nothing    -> []
149

    
150
-- | Compute the requested job IDs. This is custom since we need to
151
-- handle both strings and integers.
152
getRequestedJobIDs :: Filter FilterField -> Result [JobId]
153
getRequestedJobIDs qfilter =
154
  case requestedNames (nameField (ItemTypeLuxi QRJob)) qfilter of
155
    Nothing -> Ok []
156
    Just [] -> Ok []
157
    Just vals ->
158
      mapM (\e -> case e of
159
                    QuotedString s -> makeJobIdS s
160
                    NumericValue i -> makeJobId $ fromIntegral i
161
           ) vals
162

    
163
-- | Generic query implementation for resources that are backed by
164
-- some configuration objects.
165
--
166
-- Different query types use the same 'genericQuery' function by providing
167
-- a collector function and a field map. The collector function retrieves
168
-- live data, and the field map provides both the requirements and the logic
169
-- necessary to retrieve the data needed for the field.
170
--
171
-- The 'b' type in the specification is the runtime. Every query can gather
172
-- additional live data related to the configuration object using the collector
173
-- to perform RPC calls.
174
--
175
-- The gathered data, or the failure to get it, is expressed through a runtime
176
-- object. The type of a runtime object is determined by every query type for
177
-- itself, and used exclusively by that query.
178
genericQuery :: FieldMap a b       -- ^ Maps field names to field definitions
179
             -> CollectorType a b  -- ^ Collector of live data
180
             -> (a -> String)      -- ^ Object to name function
181
             -> (ConfigData -> Container a) -- ^ Get all objects from config
182
             -> (ConfigData -> String -> ErrorResult a) -- ^ Lookup object
183
             -> ConfigData         -- ^ The config to run the query against
184
             -> Bool               -- ^ Whether the query should be run live
185
             -> [String]           -- ^ List of requested fields
186
             -> Filter FilterField -- ^ Filter field
187
             -> [String]           -- ^ List of requested names
188
             -> IO (ErrorResult QueryResult)
189
genericQuery fieldsMap collector nameFn configFn getFn cfg
190
             live fields qfilter wanted =
191
  runResultT $ do
192
  cfilter <- resultT $ compileFilter fieldsMap qfilter
193
  let selected = getSelectedFields fieldsMap fields
194
      (fdefs, fgetters, _) = unzip3 selected
195
      live' = live && needsLiveData fgetters
196
  objects <- resultT $ case wanted of
197
             [] -> Ok . niceSortKey nameFn .
198
                   Map.elems . fromContainer $ configFn cfg
199
             _  -> mapM (getFn cfg) wanted
200
  -- Run the first pass of the filter, without a runtime context; this will
201
  -- limit the objects that we'll contact for exports
202
  fobjects <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
203
                        objects
204
  -- Gather the runtime data
205
  runtimes <- case collector of
206
    CollectorSimple     collFn -> lift $ collFn live' cfg fobjects
207
    CollectorFieldAware collFn -> lift $ collFn live' cfg fields fobjects
208
  -- Filter the results again, based on the gathered data
209
  let fdata = map (\(obj, runtime) ->
210
                     map (execGetter cfg runtime obj) fgetters)
211
              runtimes
212
  return QueryResult { qresFields = fdefs, qresData = fdata }
213

    
214
-- | Main query execution function.
215
query :: ConfigData   -- ^ The current configuration
216
      -> Bool         -- ^ Whether to collect live data
217
      -> Query        -- ^ The query (item, fields, filter)
218
      -> IO (ErrorResult QueryResult) -- ^ Result
219
query cfg live (Query (ItemTypeLuxi QRJob) fields qfilter) =
220
  queryJobs cfg live fields qfilter
221
query cfg live qry = queryInner cfg live qry $ getRequestedNames qry
222

    
223
-- | Dummy data collection fuction
224
dummyCollectLiveData :: Bool -> ConfigData -> [a] -> IO [(a, NoDataRuntime)]
225
dummyCollectLiveData _ _ = return . map (, NoDataRuntime)
226

    
227
-- | Inner query execution function.
228
queryInner :: ConfigData   -- ^ The current configuration
229
           -> Bool         -- ^ Whether to collect live data
230
           -> Query        -- ^ The query (item, fields, filter)
231
           -> [String]     -- ^ Requested names
232
           -> IO (ErrorResult QueryResult) -- ^ Result
233

    
234
queryInner cfg live (Query (ItemTypeOpCode QRNode) fields qfilter) wanted =
235
  genericQuery Node.fieldsMap (CollectorFieldAware Node.collectLiveData)
236
               nodeName configNodes getNode cfg live fields qfilter wanted
237

    
238
queryInner cfg live (Query (ItemTypeOpCode QRInstance) fields qfilter) wanted =
239
  genericQuery Instance.fieldsMap (CollectorFieldAware Instance.collectLiveData)
240
               instName configInstances getInstance cfg live fields qfilter
241
               wanted
242

    
243
queryInner cfg live (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted =
244
  genericQuery Group.fieldsMap (CollectorSimple dummyCollectLiveData) groupName
245
               configNodegroups getGroup cfg live fields qfilter wanted
246

    
247
queryInner cfg live (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted =
248
  genericQuery Network.fieldsMap (CollectorSimple dummyCollectLiveData)
249
               (fromNonEmpty . networkName)
250
               configNetworks getNetwork cfg live fields qfilter wanted
251

    
252
queryInner cfg live (Query (ItemTypeOpCode QRExport) fields qfilter) wanted =
253
  genericQuery Export.fieldsMap (CollectorSimple Export.collectLiveData)
254
               nodeName configNodes getNode cfg live fields qfilter wanted
255

    
256
queryInner _ _ (Query qkind _ _) _ =
257
  return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
258

    
259
-- | Query jobs specific query function, needed as we need to accept
260
-- both 'QuotedString' and 'NumericValue' as wanted names.
261
queryJobs :: ConfigData                   -- ^ The current configuration
262
          -> Bool                         -- ^ Whether to collect live data
263
          -> [FilterField]                -- ^ Item
264
          -> Filter FilterField           -- ^ Filter
265
          -> IO (ErrorResult QueryResult) -- ^ Result
266
queryJobs cfg live fields qfilter =
267
  runResultT $ do
268
  rootdir <- lift queueDir
269
  let wanted_names = getRequestedJobIDs qfilter
270
      want_arch = Query.Job.wantArchived fields
271
  rjids <- case wanted_names of
272
             Bad msg -> resultT . Bad $ GenericError msg
273
             Ok [] -> if live
274
                        -- we can check the filesystem for actual jobs
275
                        then do
276
                          maybeJobIDs <-
277
                            lift (determineJobDirectories rootdir want_arch
278
                              >>= getJobIDs)
279
                          case maybeJobIDs of
280
                            Left e -> (resultT . Bad) . BlockDeviceError $
281
                              "Unable to fetch the job list: " ++ show e
282
                            Right jobIDs -> resultT . Ok $ sortJobIDs jobIDs
283
                        -- else we shouldn't look at the filesystem...
284
                        else return []
285
             Ok v -> resultT $ Ok v
286
  cfilter <- resultT $ compileFilter Query.Job.fieldsMap qfilter
287
  let selected = getSelectedFields Query.Job.fieldsMap fields
288
      (fdefs, fgetters, _) = unzip3 selected
289
      live' = live && needsLiveData fgetters
290
      disabled_data = Bad "live data disabled"
291
  -- runs first pass of the filter, without a runtime context; this
292
  -- will limit the jobs that we'll load from disk
293
  jids <- resultT $
294
          filterM (\jid -> evaluateFilter cfg Nothing jid cfilter) rjids
295
  -- here we run the runtime data gathering, filtering and evaluation,
296
  -- all in the same step, so that we don't keep jobs in memory longer
297
  -- than we need; we can't be fully lazy due to the multiple monad
298
  -- wrapping across different steps
299
  qdir <- lift queueDir
300
  fdata <- foldM
301
           -- big lambda, but we use many variables from outside it...
302
           (\lst jid -> do
303
              job <- lift $ if live'
304
                              then loadJobFromDisk qdir True jid
305
                              else return disabled_data
306
              pass <- resultT $ evaluateFilter cfg (Just job) jid cfilter
307
              let nlst = if pass
308
                           then let row = map (execGetter cfg job jid) fgetters
309
                                in rnf row `seq` row:lst
310
                           else lst
311
              -- evaluate nlst (to WHNF), otherwise we're too lazy
312
              return $! nlst
313
           ) [] jids
314
  return QueryResult { qresFields = fdefs, qresData = reverse fdata }
315

    
316
-- | Helper for 'queryFields'.
317
fieldsExtractor :: FieldMap a b -> [FilterField] -> QueryFieldsResult
318
fieldsExtractor fieldsMap fields =
319
  let selected = if null fields
320
                   then map snd $ Map.toAscList fieldsMap
321
                   else getSelectedFields fieldsMap fields
322
  in QueryFieldsResult (map (\(defs, _, _) -> defs) selected)
323

    
324
-- | Query fields call.
325
queryFields :: QueryFields -> ErrorResult QueryFieldsResult
326
queryFields (QueryFields (ItemTypeOpCode QRNode) fields) =
327
  Ok $ fieldsExtractor Node.fieldsMap fields
328

    
329
queryFields (QueryFields (ItemTypeOpCode QRGroup) fields) =
330
  Ok $ fieldsExtractor Group.fieldsMap fields
331

    
332
queryFields (QueryFields (ItemTypeOpCode QRNetwork) fields) =
333
  Ok $ fieldsExtractor Network.fieldsMap fields
334

    
335
queryFields (QueryFields (ItemTypeLuxi QRJob) fields) =
336
  Ok $ fieldsExtractor Query.Job.fieldsMap fields
337

    
338
queryFields (QueryFields (ItemTypeOpCode QRExport) fields) =
339
  Ok $ fieldsExtractor Export.fieldsMap fields
340

    
341
queryFields (QueryFields qkind _) =
342
  Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported"
343

    
344
-- | Classic query converter. It gets a standard query result on input
345
-- and computes the classic style results.
346
queryCompat :: QueryResult -> ErrorResult [[J.JSValue]]
347
queryCompat (QueryResult fields qrdata) =
348
  case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
349
    [] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
350
    unknown -> Bad $ OpPrereqError ("Unknown output fields selected: " ++
351
                                    intercalate ", " unknown) ECodeInval