Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (12.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
-- | Generic query implementation for resources that are backed by
154
-- some configuration objects.
155
genericQuery :: FieldMap a b       -- ^ Field map
156
             -> (Bool -> ConfigData -> [a] -> IO [(a, b)]) -- ^ Collector
157
             -> (a -> String)      -- ^ Object to name function
158
             -> (ConfigData -> Container a) -- ^ Get all objects from config
159
             -> (ConfigData -> String -> ErrorResult a) -- ^ Lookup object
160
             -> ConfigData         -- ^ The config to run the query against
161
             -> Bool               -- ^ Whether the query should be run live
162
             -> [String]           -- ^ List of requested fields
163
             -> Filter FilterField -- ^ Filter field
164
             -> [String]           -- ^ List of requested names
165
             -> IO (ErrorResult QueryResult)
166
genericQuery fieldsMap collector nameFn configFn getFn cfg
167
             live fields qfilter wanted =
168
  runResultT $ do
169
  cfilter <- resultT $ compileFilter fieldsMap qfilter
170
  let selected = getSelectedFields fieldsMap fields
171
      (fdefs, fgetters, _) = unzip3 selected
172
      live' = live && needsLiveData fgetters
173
  objects <- resultT $ case wanted of
174
             [] -> Ok . niceSortKey nameFn .
175
                   Map.elems . fromContainer $ configFn cfg
176
             _  -> mapM (getFn cfg) wanted
177
  -- runs first pass of the filter, without a runtime context; this
178
  -- will limit the objects that we'll contact for exports
179
  fobjects <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
180
                        objects
181
  -- here run the runtime data gathering...
182
  runtimes <- lift $ collector live' cfg fobjects
183
  -- ... then filter again the results, based on gathered runtime data
184
  let fdata = map (\(obj, runtime) ->
185
                     map (execGetter cfg runtime obj) fgetters)
186
              runtimes
187
  return QueryResult { qresFields = fdefs, qresData = fdata }
188

    
189
-- | Main query execution function.
190
query :: ConfigData   -- ^ The current configuration
191
      -> Bool         -- ^ Whether to collect live data
192
      -> Query        -- ^ The query (item, fields, filter)
193
      -> IO (ErrorResult QueryResult) -- ^ Result
194
query cfg live (Query (ItemTypeLuxi QRJob) fields qfilter) =
195
  queryJobs cfg live fields qfilter
196
query cfg live qry = queryInner cfg live qry $ getRequestedNames qry
197

    
198
-- | Inner query execution function.
199
queryInner :: ConfigData   -- ^ The current configuration
200
           -> Bool         -- ^ Whether to collect live data
201
           -> Query        -- ^ The query (item, fields, filter)
202
           -> [String]     -- ^ Requested names
203
           -> IO (ErrorResult QueryResult) -- ^ Result
204

    
205
queryInner cfg live (Query (ItemTypeOpCode QRNode) fields qfilter) wanted =
206
  genericQuery Node.fieldsMap Node.collectLiveData nodeName configNodes getNode
207
               cfg live fields qfilter wanted
208

    
209
queryInner cfg live (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted =
210
  genericQuery Group.fieldsMap Group.collectLiveData groupName configNodegroups
211
               getGroup cfg live fields qfilter wanted
212

    
213
queryInner cfg live (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted =
214
  genericQuery Network.fieldsMap Network.collectLiveData
215
               (fromNonEmpty . networkName)
216
               configNetworks getNetwork cfg live fields qfilter wanted
217

    
218
queryInner cfg live (Query (ItemTypeOpCode QRExport) fields qfilter) wanted =
219
  genericQuery Export.fieldsMap Export.collectLiveData nodeName configNodes
220
               getNode cfg live fields qfilter wanted
221

    
222
queryInner _ _ (Query qkind _ _) _ =
223
  return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
224

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

    
277
-- | Helper for 'queryFields'.
278
fieldsExtractor :: FieldMap a b -> [FilterField] -> QueryFieldsResult
279
fieldsExtractor fieldsMap fields =
280
  let selected = if null fields
281
                   then map snd $ Map.toAscList fieldsMap
282
                   else getSelectedFields fieldsMap fields
283
  in QueryFieldsResult (map (\(defs, _, _) -> defs) selected)
284

    
285
-- | Query fields call.
286
queryFields :: QueryFields -> ErrorResult QueryFieldsResult
287
queryFields (QueryFields (ItemTypeOpCode QRNode) fields) =
288
  Ok $ fieldsExtractor Node.fieldsMap fields
289

    
290
queryFields (QueryFields (ItemTypeOpCode QRGroup) fields) =
291
  Ok $ fieldsExtractor Group.fieldsMap fields
292

    
293
queryFields (QueryFields (ItemTypeOpCode QRNetwork) fields) =
294
  Ok $ fieldsExtractor Network.fieldsMap fields
295

    
296
queryFields (QueryFields (ItemTypeLuxi QRJob) fields) =
297
  Ok $ fieldsExtractor Query.Job.fieldsMap fields
298

    
299
queryFields (QueryFields (ItemTypeOpCode QRExport) fields) =
300
  Ok $ fieldsExtractor Export.fieldsMap fields
301

    
302
queryFields (QueryFields qkind _) =
303
  Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported"
304

    
305
-- | Classic query converter. It gets a standard query result on input
306
-- and computes the classic style results.
307
queryCompat :: QueryResult -> ErrorResult [[J.JSValue]]
308
queryCompat (QueryResult fields qrdata) =
309
  case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
310
    [] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
311
    unknown -> Bad $ OpPrereqError ("Unknown output fields selected: " ++
312
                                    intercalate ", " unknown) ECodeInval