Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Query / Query.hs @ cd67e337

History | View | Annotate | Download (8.4 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.Monad (filterM)
56
import Control.Monad.Trans (lift)
57
import Data.List (intercalate)
58
import Data.Maybe (fromMaybe)
59
import qualified Data.Map as Map
60
import qualified Text.JSON as J
61

    
62
import Ganeti.BasicTypes
63
import Ganeti.Config
64
import Ganeti.JSON
65
import Ganeti.Rpc
66
import Ganeti.Query.Language
67
import Ganeti.Query.Common
68
import Ganeti.Query.Filter
69
import Ganeti.Query.Types
70
import Ganeti.Query.Node
71
import Ganeti.Query.Group
72
import Ganeti.Objects
73
import Ganeti.Utils
74

    
75
-- * Helper functions
76

    
77
-- | Builds an unknown field definition.
78
mkUnknownFDef :: String -> FieldData a b
79
mkUnknownFDef name =
80
  ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
81
  , FieldUnknown )
82

    
83
-- | Runs a field getter on the existing contexts.
84
execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
85
execGetter _   _ item (FieldSimple getter)  = getter item
86
execGetter cfg _ item (FieldConfig getter)  = getter cfg item
87
execGetter _  rt item (FieldRuntime getter) = getter rt item
88
execGetter _   _ _    FieldUnknown          = rsUnknown
89

    
90
-- * Main query execution
91

    
92
-- | Helper to build the list of requested fields. This transforms the
93
-- list of string fields to a list of field defs and getters, with
94
-- some of them possibly being unknown fields.
95
getSelectedFields :: FieldMap a b  -- ^ Defined fields
96
                  -> [String]      -- ^ Requested fields
97
                  -> FieldList a b -- ^ Selected fields
98
getSelectedFields defined =
99
  map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined)
100

    
101
-- | Collect live data from RPC query if enabled.
102
-- FIXME: Check which fields we actually need and possibly send empty
103
-- hvs/vgs if no info from hypervisor/volume group respectively
104
-- is required
105
maybeCollectLiveData:: Bool -> ConfigData -> [Node] -> IO [(Node, NodeRuntime)]
106

    
107
maybeCollectLiveData False _ nodes =
108
  return $ zip nodes (repeat $ Left (RpcResultError "Live data disabled"))
109

    
110
maybeCollectLiveData True cfg nodes = do
111
  let vgs = [clusterVolumeGroupName $ configCluster cfg]
112
      hvs = [getDefaultHypervisor cfg]
113
  executeRpcCall nodes (RpcCallNodeInfo vgs hvs)
114

    
115
-- | Check whether list of queried fields contains live fields.
116
needsLiveData :: [FieldGetter a b] -> Bool
117
needsLiveData = any (\getter -> case getter of
118
                     FieldRuntime _ -> True
119
                     _ -> False)
120

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

    
126
-- | Computes the name field for different query types.
127
nameField :: ItemType -> FilterField
128
nameField QRJob = "id"
129
nameField _     = "name"
130

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

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

    
147
-- | Main query execution function.
148
query :: ConfigData   -- ^ The current configuration
149
      -> Bool         -- ^ Whether to collect live data
150
      -> Query        -- ^ The query (item, fields, filter)
151
      -> IO (Result QueryResult) -- ^ Result
152
query cfg live qry = queryInner cfg live qry $ getRequestedNames qry
153

    
154
-- | Inner query execution function.
155
queryInner :: ConfigData   -- ^ The current configuration
156
           -> Bool         -- ^ Whether to collect live data
157
           -> Query        -- ^ The query (item, fields, filter)
158
           -> [String]     -- ^ Requested names
159
           -> IO (Result QueryResult) -- ^ Result
160

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

    
180
queryInner cfg _ (Query QRGroup fields qfilter) wanted = return $ do
181
  cfilter <- compileFilter groupFieldsMap qfilter
182
  let selected = getSelectedFields groupFieldsMap fields
183
      (fdefs, fgetters) = unzip selected
184
  groups <- case wanted of
185
              [] -> Ok . niceSortKey groupName .
186
                    Map.elems . fromContainer $ configNodegroups cfg
187
              _  -> mapM (getGroup cfg) wanted
188
  -- there is no live data for groups, so filtering is much simpler
189
  fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups
190
  let fdata = map (\node ->
191
                       map (execGetter cfg GroupRuntime node) fgetters) fgroups
192
  return QueryResult {qresFields = fdefs, qresData = fdata }
193

    
194
queryInner _ _ (Query qkind _ _) _ =
195
  return . Bad $ "Query '" ++ show qkind ++ "' not supported"
196

    
197
-- | Helper for 'queryFields'.
198
fieldsExtractor :: FieldMap a b -> [FilterField] -> QueryFieldsResult
199
fieldsExtractor fieldsMap fields =
200
  let selected = if null fields
201
                   then map snd $ Map.toAscList fieldsMap
202
                   else getSelectedFields fieldsMap fields
203
  in QueryFieldsResult (map fst selected)
204

    
205
-- | Query fields call.
206
queryFields :: QueryFields -> Result QueryFieldsResult
207
queryFields (QueryFields QRNode fields) =
208
  Ok $ fieldsExtractor nodeFieldsMap fields
209

    
210
queryFields (QueryFields QRGroup fields) =
211
  Ok $ fieldsExtractor groupFieldsMap fields
212

    
213
queryFields (QueryFields qkind _) =
214
  Bad $ "QueryFields '" ++ show qkind ++ "' not supported"
215

    
216
-- | Classic query converter. It gets a standard query result on input
217
-- and computes the classic style results.
218
queryCompat :: QueryResult -> Result [[J.JSValue]]
219
queryCompat (QueryResult fields qrdata) =
220
  case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
221
    [] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
222
    unknown -> Bad $ "Unknown output fields selected: " ++
223
                     intercalate ", " unknown