Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Query / Query.hs @ 7f0fd838

History | View | Annotate | Download (6.6 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

    
49
    ( query
50
    , queryFields
51
    ) where
52

    
53
import Control.Monad (filterM)
54
import Control.Monad.Trans (lift)
55
import Data.Maybe (fromMaybe)
56
import qualified Data.Map as Map
57

    
58
import Ganeti.BasicTypes
59
import Ganeti.JSON
60
import Ganeti.Rpc
61
import Ganeti.Query.Language
62
import Ganeti.Query.Common
63
import Ganeti.Query.Filter
64
import Ganeti.Query.Types
65
import Ganeti.Query.Node
66
import Ganeti.Query.Group
67
import Ganeti.Objects
68

    
69
-- * Helper functions
70

    
71
-- | Builds an unknown field definition.
72
mkUnknownFDef :: String -> FieldData a b
73
mkUnknownFDef name =
74
  ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
75
  , FieldUnknown )
76

    
77
-- | Runs a field getter on the existing contexts.
78
execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
79
execGetter _   _ item (FieldSimple getter)  = getter item
80
execGetter cfg _ item (FieldConfig getter)  = getter cfg item
81
execGetter _  rt item (FieldRuntime getter) = getter rt item
82
execGetter _   _ _    FieldUnknown          = rsUnknown
83

    
84
-- * Main query execution
85

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

    
95
-- | Collect live data from RPC query if enabled.
96
-- FIXME: Check which fields we actually need and possibly send empty
97
-- hvs/vgs if no info from hypervisor/volume group respectively
98
-- is required
99
maybeCollectLiveData:: Bool -> ConfigData -> [Node] -> IO [(Node, NodeRuntime)]
100

    
101
maybeCollectLiveData False _ nodes =
102
  return $ zip nodes (repeat $ Left (RpcResultError "Live data disabled"))
103

    
104
maybeCollectLiveData True cfg nodes = do
105
  let vgs = [clusterVolumeGroupName $ configCluster cfg]
106
      hvs = clusterEnabledHypervisors $ configCluster cfg
107
  executeRpcCall nodes (RpcCallNodeInfo vgs hvs)
108

    
109
-- | Check whether list of queried fields contains live fields.
110
needsLiveData :: [FieldGetter a b] -> Bool
111
needsLiveData = any (\getter -> case getter of
112
                     FieldRuntime _ -> True
113
                     _ -> False)
114

    
115
-- | Main query execution function.
116
query :: ConfigData   -- ^ The current configuration
117
      -> Bool         -- ^ Whether to collect live data
118
      -> Query        -- ^ The query (item, fields, filter)
119
      -> IO (Result QueryResult) -- ^ Result
120

    
121
query cfg live (Query QRNode fields qfilter) =  runResultT $ do
122
  cfilter <- resultT $ compileFilter nodeFieldsMap qfilter
123
  let selected = getSelectedFields nodeFieldsMap fields
124
      (fdefs, fgetters) = unzip selected
125
      nodes = Map.elems . fromContainer $ configNodes cfg
126
      live' = live && needsLiveData fgetters
127
  -- runs first pass of the filter, without a runtime context; this
128
  -- will limit the nodes that we'll contact for runtime data
129
  fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter) nodes
130
  -- here we would run the runtime data gathering, then filter again
131
  -- the nodes, based on existing runtime data
132
  nruntimes <- lift $ maybeCollectLiveData live' cfg fnodes
133
  let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters)
134
              nruntimes
135
  return QueryResult { qresFields = fdefs, qresData = fdata }
136

    
137
query cfg _ (Query QRGroup fields qfilter) = return $ do
138
  -- FIXME: want_diskparams is defaulted to false and not taken as parameter
139
  -- This is because the type for DiskParams is right now too generic for merges
140
  -- (or else I cannot see how to do this with curent implementation)
141
  cfilter <- compileFilter groupFieldsMap qfilter
142
  let selected = getSelectedFields groupFieldsMap fields
143
      (fdefs, fgetters) = unzip selected
144
      groups = Map.elems . fromContainer $ configNodegroups cfg
145
  -- there is no live data for groups, so filtering is much simpler
146
  fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups
147
  let fdata = map (\node ->
148
                       map (execGetter cfg GroupRuntime node) fgetters) fgroups
149
  return QueryResult {qresFields = fdefs, qresData = fdata }
150

    
151
query _ _ (Query qkind _ _) =
152
  return . Bad $ "Query '" ++ show qkind ++ "' not supported"
153

    
154
-- | Query fields call.
155
-- FIXME: Looks generic enough to use a typeclass
156
queryFields :: QueryFields -> Result QueryFieldsResult
157
queryFields (QueryFields QRNode fields) =
158
  let selected = if null fields
159
                   then map snd $ Map.toAscList nodeFieldsMap
160
                   else getSelectedFields nodeFieldsMap fields
161
  in Ok $ QueryFieldsResult (map fst selected)
162

    
163
queryFields (QueryFields QRGroup fields) =
164
  let selected = if null fields
165
                   then map snd $ Map.toAscList groupFieldsMap
166
                   else getSelectedFields groupFieldsMap fields
167
  in Ok $ QueryFieldsResult (map fst selected)
168

    
169

    
170
queryFields (QueryFields qkind _) =
171
  Bad $ "QueryFields '" ++ show qkind ++ "' not supported"