Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (12.1 kB)

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

    
3
 -}
4

    
5
{-
6

    
7
Copyright (C) 2012 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 Ganeti.Query.Filter
71
import qualified Ganeti.Query.Job as Query.Job
72
import Ganeti.Query.Group
73
import Ganeti.Query.Language
74
import Ganeti.Query.Network
75
import Ganeti.Query.Node
76
import Ganeti.Query.Types
77
import Ganeti.Path
78
import Ganeti.Types
79
import Ganeti.Utils
80

    
81
-- * Helper functions
82

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

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

    
97
-- * Main query execution
98

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

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

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

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

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

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

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

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

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

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

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

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

    
218
queryInner _ _ (Query qkind _ _) _ =
219
  return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
220

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

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

    
281
-- | Query fields call.
282
queryFields :: QueryFields -> ErrorResult QueryFieldsResult
283
queryFields (QueryFields (ItemTypeOpCode QRNode) fields) =
284
  Ok $ fieldsExtractor nodeFieldsMap fields
285

    
286
queryFields (QueryFields (ItemTypeOpCode QRGroup) fields) =
287
  Ok $ fieldsExtractor groupFieldsMap fields
288

    
289
queryFields (QueryFields (ItemTypeLuxi QRJob) fields) =
290
  Ok $ fieldsExtractor Query.Job.fieldsMap fields
291

    
292
queryFields (QueryFields qkind _) =
293
  Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported"
294

    
295
-- | Classic query converter. It gets a standard query result on input
296
-- and computes the classic style results.
297
queryCompat :: QueryResult -> ErrorResult [[J.JSValue]]
298
queryCompat (QueryResult fields qrdata) =
299
  case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
300
    [] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
301
    unknown -> Bad $ OpPrereqError ("Unknown output fields selected: " ++
302
                                    intercalate ", " unknown) ECodeInval