Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Query / Query.hs @ 36162faf

History | View | Annotate | Download (13.7 kB)

1
{-| Implementation of the Ganeti Query2 functionality.
2

    
3
 -}
4

    
5
{-
6

    
7
Copyright (C) 2012, 2013 Google Inc.
8

    
9
This program is free software; you can redistribute it and/or modify
10
it under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2 of the License, or
12
(at your option) any later version.
13

    
14
This program is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17
General Public License for more details.
18

    
19
You should have received a copy of the GNU General Public License
20
along with this program; if not, write to the Free Software
21
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22
02110-1301, USA.
23

    
24
-}
25

    
26
{-
27

    
28
TODO: problems with the current model:
29

    
30
1. There's nothing preventing a result such as ResultEntry RSNormal
31
Nothing, or ResultEntry RSNoData (Just ...); ideally, we would
32
separate the the RSNormal and other types; we would need a new data
33
type for this, though, with JSON encoding/decoding
34

    
35
2. We don't have a way to 'bind' a FieldDefinition's field type
36
(e.q. QFTBool) with the actual value that is returned from a
37
FieldGetter. This means that the various getter functions can return
38
divergent types for the same field when evaluated against multiple
39
items. This is bad; it only works today because we 'hide' everything
40
behind JSValue, but is not nice at all. We should probably remove the
41
separation between FieldDefinition and the FieldGetter, and introduce
42
a new abstract data type, similar to QFT*, that contains the values
43
too.
44

    
45
-}
46

    
47
module Ganeti.Query.Query
48
    ( query
49
    , queryFields
50
    , queryCompat
51
    , getRequestedNames
52
    , nameField
53
    ) where
54

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

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

    
82
-- * Helper functions
83

    
84
-- | Builds an unknown field definition.
85
mkUnknownFDef :: String -> FieldData a b
86
mkUnknownFDef name =
87
  ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
88
  , FieldUnknown
89
  , QffNormal )
90

    
91
-- | Runs a field getter on the existing contexts.
92
execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
93
execGetter _   _ item (FieldSimple getter)  = getter item
94
execGetter cfg _ item (FieldConfig getter)  = getter cfg item
95
execGetter _  rt item (FieldRuntime getter) = getter rt item
96
execGetter _   _ _    FieldUnknown          = rsUnknown
97

    
98
-- * Main query execution
99

    
100
-- | Helper to build the list of requested fields. This transforms the
101
-- list of string fields to a list of field defs and getters, with
102
-- some of them possibly being unknown fields.
103
getSelectedFields :: FieldMap a b  -- ^ Defined fields
104
                  -> [String]      -- ^ Requested fields
105
                  -> FieldList a b -- ^ Selected fields
106
getSelectedFields defined =
107
  map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined)
108

    
109
-- | Check whether list of queried fields contains live fields.
110
needsLiveData :: [FieldGetter a b] -> Bool
111
needsLiveData = any isRuntimeField
112

    
113
-- | Checks whether we have requested exactly some names. This is a
114
-- simple wrapper over 'requestedNames' and 'nameField'.
115
needsNames :: Query -> Maybe [FilterValue]
116
needsNames (Query kind _ qfilter) = requestedNames (nameField kind) qfilter
117

    
118
-- | Computes the name field for different query types.
119
nameField :: ItemType -> FilterField
120
nameField (ItemTypeLuxi QRJob) = "id"
121
nameField (ItemTypeOpCode QRExport) = "node"
122
nameField _ = "name"
123

    
124
-- | Extracts all quoted strings from a list, ignoring the
125
-- 'NumericValue' entries.
126
getAllQuotedStrings :: [FilterValue] -> [String]
127
getAllQuotedStrings =
128
  concatMap extractor
129
    where extractor (NumericValue _)   = []
130
          extractor (QuotedString val) = [val]
131

    
132
-- | Checks that we have either requested a valid set of names, or we
133
-- have a more complex filter.
134
getRequestedNames :: Query -> [String]
135
getRequestedNames qry =
136
  case needsNames qry of
137
    Just names -> getAllQuotedStrings names
138
    Nothing    -> []
139

    
140
-- | Compute the requested job IDs. This is custom since we need to
141
-- handle both strings and integers.
142
getRequestedJobIDs :: Filter FilterField -> Result [JobId]
143
getRequestedJobIDs qfilter =
144
  case requestedNames (nameField (ItemTypeLuxi QRJob)) qfilter of
145
    Nothing -> Ok []
146
    Just [] -> Ok []
147
    Just vals ->
148
      mapM (\e -> case e of
149
                    QuotedString s -> makeJobIdS s
150
                    NumericValue i -> makeJobId $ fromIntegral i
151
           ) vals
152

    
153
-- | Main query execution function.
154
query :: ConfigData   -- ^ The current configuration
155
      -> Bool         -- ^ Whether to collect live data
156
      -> Query        -- ^ The query (item, fields, filter)
157
      -> IO (ErrorResult QueryResult) -- ^ Result
158
query cfg live (Query (ItemTypeLuxi QRJob) fields qfilter) =
159
  queryJobs cfg live fields qfilter
160
query cfg live qry = queryInner cfg live qry $ getRequestedNames qry
161

    
162
-- | Inner query execution function.
163
queryInner :: ConfigData   -- ^ The current configuration
164
           -> Bool         -- ^ Whether to collect live data
165
           -> Query        -- ^ The query (item, fields, filter)
166
           -> [String]     -- ^ Requested names
167
           -> IO (ErrorResult QueryResult) -- ^ Result
168

    
169
queryInner cfg live (Query (ItemTypeOpCode QRNode) fields qfilter) wanted =
170
  runResultT $ do
171
  cfilter <- resultT $ compileFilter Node.fieldsMap qfilter
172
  let selected = getSelectedFields Node.fieldsMap fields
173
      (fdefs, fgetters, _) = unzip3 selected
174
      live' = live && needsLiveData fgetters
175
  nodes <- resultT $ case wanted of
176
             [] -> Ok . niceSortKey nodeName .
177
                   Map.elems . fromContainer $ configNodes cfg
178
             _  -> mapM (getNode cfg) wanted
179
  -- runs first pass of the filter, without a runtime context; this
180
  -- will limit the nodes that we'll contact for runtime data
181
  fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
182
                      nodes
183
  -- here we would run the runtime data gathering, then filter again
184
  -- the nodes, based on existing runtime data
185
  nruntimes <- lift $ Node.collectLiveData live' cfg fnodes
186
  let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters)
187
              nruntimes
188
  return QueryResult { qresFields = fdefs, qresData = fdata }
189

    
190
queryInner cfg _ (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted =
191
  return $ do
192
  cfilter <- compileFilter Group.fieldsMap qfilter
193
  let selected = getSelectedFields Group.fieldsMap fields
194
      (fdefs, fgetters, _) = unzip3 selected
195
  groups <- case wanted of
196
              [] -> Ok . niceSortKey groupName .
197
                    Map.elems . fromContainer $ configNodegroups cfg
198
              _  -> mapM (getGroup cfg) wanted
199
  -- there is no live data for groups, so filtering is much simpler
200
  fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups
201
  let fdata = map (\node ->
202
                     map (execGetter cfg Group.Runtime node) fgetters) fgroups
203
  return QueryResult { qresFields = fdefs, qresData = fdata }
204

    
205
queryInner cfg _ (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted =
206
  return $ do
207
  cfilter <- compileFilter Network.fieldsMap qfilter
208
  let selected = getSelectedFields Network.fieldsMap fields
209
      (fdefs, fgetters, _) = unzip3 selected
210
  networks <- case wanted of
211
                [] -> Ok . niceSortKey (fromNonEmpty . networkName) .
212
                      Map.elems . fromContainer $ configNetworks cfg
213
                _  -> mapM (getNetwork cfg) wanted
214
  fnetworks <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) networks
215
  let fdata = map (\network ->
216
                   map (execGetter cfg Network.Runtime network) fgetters)
217
                   fnetworks
218
  return QueryResult { qresFields = fdefs, qresData = fdata }
219

    
220
queryInner cfg live (Query (ItemTypeOpCode QRExport) fields qfilter) wanted =
221
  runResultT $ do
222
  cfilter <- resultT $ compileFilter Export.fieldsMap qfilter
223
  let selected = getSelectedFields Export.fieldsMap fields
224
      (fdefs, fgetters, _) = unzip3 selected
225
      -- we alwyas have live queries in exports, but we keep this for
226
      -- standard style (in case we add static fields in the future)
227
      live' = live && needsLiveData fgetters
228
  nodes <- resultT $ case wanted of
229
             [] -> Ok . niceSortKey nodeName .
230
                   Map.elems . fromContainer $ configNodes cfg
231
             _  -> mapM (getNode cfg) wanted
232
  -- runs first pass of the filter, without a runtime context; this
233
  -- will limit the nodes that we'll contact for exports
234
  fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
235
                      nodes
236
  -- here we would run the runtime data gathering...
237
  nruntimes <- lift $ Export.collectLiveData live' cfg fnodes
238
  -- ... then filter again the results, based on existing export
239
  -- names, but note that no client sends filters on the export list
240
  -- today, so it's likely a no-oop
241
  let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters)
242
              nruntimes
243
  return QueryResult { qresFields = fdefs, qresData = fdata }
244

    
245
queryInner _ _ (Query qkind _ _) _ =
246
  return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
247

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

    
300
-- | Helper for 'queryFields'.
301
fieldsExtractor :: FieldMap a b -> [FilterField] -> QueryFieldsResult
302
fieldsExtractor fieldsMap fields =
303
  let selected = if null fields
304
                   then map snd $ Map.toAscList fieldsMap
305
                   else getSelectedFields fieldsMap fields
306
  in QueryFieldsResult (map (\(defs, _, _) -> defs) selected)
307

    
308
-- | Query fields call.
309
queryFields :: QueryFields -> ErrorResult QueryFieldsResult
310
queryFields (QueryFields (ItemTypeOpCode QRNode) fields) =
311
  Ok $ fieldsExtractor Node.fieldsMap fields
312

    
313
queryFields (QueryFields (ItemTypeOpCode QRGroup) fields) =
314
  Ok $ fieldsExtractor Group.fieldsMap fields
315

    
316
queryFields (QueryFields (ItemTypeLuxi QRJob) fields) =
317
  Ok $ fieldsExtractor Query.Job.fieldsMap fields
318

    
319
queryFields (QueryFields (ItemTypeOpCode QRExport) fields) =
320
  Ok $ fieldsExtractor Export.fieldsMap fields
321

    
322
queryFields (QueryFields qkind _) =
323
  Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported"
324

    
325
-- | Classic query converter. It gets a standard query result on input
326
-- and computes the classic style results.
327
queryCompat :: QueryResult -> ErrorResult [[J.JSValue]]
328
queryCompat (QueryResult fields qrdata) =
329
  case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
330
    [] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
331
    unknown -> Bad $ OpPrereqError ("Unknown output fields selected: " ++
332
                                    intercalate ", " unknown) ECodeInval