root / htools / Ganeti / Query / Query.hs @ f3baf5ef
History | View | Annotate | Download (4.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 |
|
49 |
( query |
50 |
, queryFields |
51 |
) where |
52 |
|
53 |
import Control.Monad (filterM) |
54 |
import Data.Maybe (fromMaybe) |
55 |
import qualified Data.Map as Map |
56 |
|
57 |
import Ganeti.BasicTypes |
58 |
import Ganeti.JSON |
59 |
import Ganeti.Query.Language |
60 |
import Ganeti.Query.Common |
61 |
import Ganeti.Query.Filter |
62 |
import Ganeti.Query.Types |
63 |
import Ganeti.Query.Node |
64 |
import Ganeti.Objects |
65 |
|
66 |
-- * Helper functions |
67 |
|
68 |
-- | Builds an unknown field definition. |
69 |
mkUnknownFDef :: String -> FieldData a b |
70 |
mkUnknownFDef name = |
71 |
( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'") |
72 |
, FieldUnknown ) |
73 |
|
74 |
-- | Runs a field getter on the existing contexts. |
75 |
execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry |
76 |
execGetter _ _ item (FieldSimple getter) = getter item |
77 |
execGetter cfg _ item (FieldConfig getter) = getter cfg item |
78 |
execGetter _ rt item (FieldRuntime getter) = getter rt item |
79 |
execGetter _ _ _ FieldUnknown = rsUnknown |
80 |
|
81 |
-- * Main query execution |
82 |
|
83 |
-- | Helper to build the list of requested fields. This transforms the |
84 |
-- list of string fields to a list of field defs and getters, with |
85 |
-- some of them possibly being unknown fields. |
86 |
getSelectedFields :: FieldMap a b -- ^ Defined fields |
87 |
-> [String] -- ^ Requested fields |
88 |
-> FieldList a b -- ^ Selected fields |
89 |
getSelectedFields defined = |
90 |
map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined) |
91 |
|
92 |
-- | Main query execution function. |
93 |
query :: ConfigData -- ^ The current configuration |
94 |
-> Query -- ^ The query (item, fields, filter) |
95 |
-> IO (Result QueryResult) -- ^ Result |
96 |
|
97 |
query cfg (Query QRNode fields qfilter) = return $ do |
98 |
cfilter <- compileFilter nodeFieldsMap qfilter |
99 |
let selected = getSelectedFields nodeFieldsMap fields |
100 |
(fdefs, fgetters) = unzip selected |
101 |
nodes = Map.elems . fromContainer $ configNodes cfg |
102 |
-- runs first pass of the filter, without a runtime context; this |
103 |
-- will limit the nodes that we'll contact for runtime data |
104 |
fnodes <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) |
105 |
nodes |
106 |
-- here we would run the runtime data gathering, then filter again |
107 |
-- the nodes, based on existing runtime data |
108 |
let fdata = map (\node -> map (execGetter cfg NodeRuntime node) fgetters) |
109 |
fnodes |
110 |
return QueryResult { qresFields = fdefs, qresData = fdata } |
111 |
|
112 |
query _ (Query qkind _ _) = |
113 |
return . Bad $ "Query '" ++ show qkind ++ "' not supported" |
114 |
|
115 |
-- | Query fields call. |
116 |
queryFields :: QueryFields -> Result QueryFieldsResult |
117 |
queryFields (QueryFields QRNode fields) = |
118 |
let selected = if null fields |
119 |
then map snd $ Map.toAscList nodeFieldsMap |
120 |
else getSelectedFields nodeFieldsMap fields |
121 |
in Ok $ QueryFieldsResult (map fst selected) |
122 |
|
123 |
queryFields (QueryFields qkind _) = |
124 |
Bad $ "QueryFields '" ++ show qkind ++ "' not supported" |