root / htools / Ganeti / Query / Filter.hs @ 37904802
History | View | Annotate | Download (7.8 kB)
1 |
{-# LANGUAGE Rank2Types #-} |
---|---|
2 |
|
3 |
{-| Implementation of the Ganeti Query2 filterning. |
4 |
|
5 |
The filtering of results should be done in two phases. |
6 |
|
7 |
In the first phase, before contacting any remote nodes for runtime |
8 |
data, the filtering should be executed with 'Nothing' for the runtime |
9 |
context. This will make all non-runtime filters filter correctly, |
10 |
whereas all runtime filters will respond successfully. As described in |
11 |
the Python version too, this makes for example /Or/ filters very |
12 |
inefficient if they contain runtime fields. |
13 |
|
14 |
Once this first filtering phase has been done, we hopefully eliminated |
15 |
some remote nodes out of the list of candidates, we run the remote |
16 |
data gathering, and we evaluate the filter again, this time with a |
17 |
'Just' runtime context. This will make all filters work correctly. |
18 |
|
19 |
Note that the second run will re-evaluate the config/simple fields, |
20 |
without caching; this is not perfect, but we consider config accesses |
21 |
very cheap (and the configuration snapshot we have won't change |
22 |
between the two runs, hence we will not get inconsistent results). |
23 |
|
24 |
-} |
25 |
|
26 |
{- |
27 |
|
28 |
Copyright (C) 2012 Google Inc. |
29 |
|
30 |
This program is free software; you can redistribute it and/or modify |
31 |
it under the terms of the GNU General Public License as published by |
32 |
the Free Software Foundation; either version 2 of the License, or |
33 |
(at your option) any later version. |
34 |
|
35 |
This program is distributed in the hope that it will be useful, but |
36 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
37 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
38 |
General Public License for more details. |
39 |
|
40 |
You should have received a copy of the GNU General Public License |
41 |
along with this program; if not, write to the Free Software |
42 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
43 |
02110-1301, USA. |
44 |
|
45 |
-} |
46 |
|
47 |
module Ganeti.Query.Filter |
48 |
( compileFilter |
49 |
, evaluateFilter |
50 |
, requestedNames |
51 |
, makeSimpleFilter |
52 |
) where |
53 |
|
54 |
import Control.Applicative |
55 |
import Control.Monad (liftM) |
56 |
import qualified Data.Map as Map |
57 |
import Data.Traversable (traverse) |
58 |
import Text.JSON (JSValue(..), fromJSString) |
59 |
import Text.JSON.Pretty (pp_value) |
60 |
import qualified Text.Regex.PCRE as PCRE |
61 |
|
62 |
import Ganeti.BasicTypes |
63 |
import Ganeti.Errors |
64 |
import Ganeti.Objects |
65 |
import Ganeti.Query.Language |
66 |
import Ganeti.Query.Types |
67 |
import Ganeti.JSON |
68 |
|
69 |
-- | Compiles a filter based on field names to one based on getters. |
70 |
compileFilter :: FieldMap a b |
71 |
-> Filter FilterField |
72 |
-> ErrorResult (Filter (FieldGetter a b)) |
73 |
compileFilter fm = |
74 |
traverse (\field -> maybe |
75 |
(Bad . ParameterError $ "Can't find field named '" ++ |
76 |
field ++ "'") |
77 |
(Ok . snd) (field `Map.lookup` fm)) |
78 |
|
79 |
-- | Wraps a getter, filter pair. If the getter is 'FieldRuntime' but |
80 |
-- we don't have a runtime context, we skip the filtering, returning |
81 |
-- \"pass\". Otherwise, we pass the actual value to the filter. |
82 |
wrapGetter :: ConfigData |
83 |
-> Maybe b |
84 |
-> a |
85 |
-> FieldGetter a b |
86 |
-> (JSValue -> ErrorResult Bool) |
87 |
-> ErrorResult Bool |
88 |
wrapGetter cfg b a getter faction = |
89 |
case tryGetter cfg b a getter of |
90 |
Nothing -> Ok True -- runtime missing, accepting the value |
91 |
Just v -> |
92 |
case v of |
93 |
ResultEntry RSNormal (Just fval) -> faction fval |
94 |
ResultEntry RSNormal Nothing -> |
95 |
Bad $ ProgrammerError |
96 |
"Internal error: Getter returned RSNormal/Nothing" |
97 |
_ -> Ok True -- filter has no data to work, accepting it |
98 |
|
99 |
-- | Helper to evaluate a filter getter (and the value it generates) in |
100 |
-- a boolean context. |
101 |
trueFilter :: JSValue -> ErrorResult Bool |
102 |
trueFilter (JSBool x) = Ok x |
103 |
trueFilter v = Bad . ParameterError $ |
104 |
"Unexpected value '" ++ show (pp_value v) ++ |
105 |
"' in boolean context" |
106 |
|
107 |
-- | A type synonim for a rank-2 comparator function. This is used so |
108 |
-- that we can pass the usual '<=', '>', '==' functions to 'binOpFilter' |
109 |
-- and for them to be used in multiple contexts. |
110 |
type Comparator = (Eq a, Ord a) => a -> a -> Bool |
111 |
|
112 |
-- | Helper to evaluate a filder getter (and the value it generates) |
113 |
-- in a boolean context. Note the order of arguments is reversed from |
114 |
-- the filter definitions (due to the call chain), make sure to |
115 |
-- compare in the reverse order too!. |
116 |
binOpFilter :: Comparator -> FilterValue -> JSValue -> ErrorResult Bool |
117 |
binOpFilter comp (QuotedString y) (JSString x) = |
118 |
Ok $ fromJSString x `comp` y |
119 |
binOpFilter comp (NumericValue y) (JSRational _ x) = |
120 |
Ok $ x `comp` fromIntegral y |
121 |
binOpFilter _ expr actual = |
122 |
Bad . ParameterError $ "Invalid types in comparison, trying to compare " ++ |
123 |
show (pp_value actual) ++ " with '" ++ show expr ++ "'" |
124 |
|
125 |
-- | Implements the 'RegexpFilter' matching. |
126 |
regexpFilter :: FilterRegex -> JSValue -> ErrorResult Bool |
127 |
regexpFilter re (JSString val) = |
128 |
Ok $ PCRE.match (compiledRegex re) (fromJSString val) |
129 |
regexpFilter _ x = |
130 |
Bad . ParameterError $ "Invalid field value used in regexp matching,\ |
131 |
\ expecting string but got '" ++ show (pp_value x) ++ "'" |
132 |
|
133 |
-- | Implements the 'ContainsFilter' matching. |
134 |
containsFilter :: FilterValue -> JSValue -> ErrorResult Bool |
135 |
-- note: the next two implementations are the same, but we have to |
136 |
-- repeat them due to the encapsulation done by FilterValue |
137 |
containsFilter (QuotedString val) lst = do |
138 |
lst' <- fromJVal lst |
139 |
return $ val `elem` lst' |
140 |
containsFilter (NumericValue val) lst = do |
141 |
lst' <- fromJVal lst |
142 |
return $ val `elem` lst' |
143 |
|
144 |
-- | Verifies if a given item passes a filter. The runtime context |
145 |
-- might be missing, in which case most of the filters will consider |
146 |
-- this as passing the filter. |
147 |
evaluateFilter :: ConfigData -> Maybe b -> a |
148 |
-> Filter (FieldGetter a b) |
149 |
-> ErrorResult Bool |
150 |
evaluateFilter _ _ _ EmptyFilter = Ok True |
151 |
evaluateFilter c mb a (AndFilter flts) = |
152 |
all id <$> mapM (evaluateFilter c mb a) flts |
153 |
evaluateFilter c mb a (OrFilter flts) = |
154 |
any id <$> mapM (evaluateFilter c mb a) flts |
155 |
evaluateFilter c mb a (NotFilter flt) = |
156 |
not <$> evaluateFilter c mb a flt |
157 |
evaluateFilter c mb a (TrueFilter getter) = |
158 |
wrapGetter c mb a getter trueFilter |
159 |
evaluateFilter c mb a (EQFilter getter val) = |
160 |
wrapGetter c mb a getter (binOpFilter (==) val) |
161 |
evaluateFilter c mb a (LTFilter getter val) = |
162 |
wrapGetter c mb a getter (binOpFilter (<) val) |
163 |
evaluateFilter c mb a (LEFilter getter val) = |
164 |
wrapGetter c mb a getter (binOpFilter (<=) val) |
165 |
evaluateFilter c mb a (GTFilter getter val) = |
166 |
wrapGetter c mb a getter (binOpFilter (>) val) |
167 |
evaluateFilter c mb a (GEFilter getter val) = |
168 |
wrapGetter c mb a getter (binOpFilter (>=) val) |
169 |
evaluateFilter c mb a (RegexpFilter getter re) = |
170 |
wrapGetter c mb a getter (regexpFilter re) |
171 |
evaluateFilter c mb a (ContainsFilter getter val) = |
172 |
wrapGetter c mb a getter (containsFilter val) |
173 |
|
174 |
-- | Runs a getter with potentially missing runtime context. |
175 |
tryGetter :: ConfigData -> Maybe b -> a -> FieldGetter a b -> Maybe ResultEntry |
176 |
tryGetter _ _ item (FieldSimple getter) = Just $ getter item |
177 |
tryGetter cfg _ item (FieldConfig getter) = Just $ getter cfg item |
178 |
tryGetter _ rt item (FieldRuntime getter) = |
179 |
maybe Nothing (\rt' -> Just $ getter rt' item) rt |
180 |
tryGetter _ _ _ FieldUnknown = Just $ |
181 |
ResultEntry RSUnknown Nothing |
182 |
|
183 |
-- | Computes the requested names, if only names were requested (and |
184 |
-- with equality). Otherwise returns 'Nothing'. |
185 |
requestedNames :: FilterField -> Filter FilterField -> Maybe [FilterValue] |
186 |
requestedNames _ EmptyFilter = Just [] |
187 |
requestedNames namefield (OrFilter flts) = |
188 |
liftM concat $ mapM (requestedNames namefield) flts |
189 |
requestedNames namefield (EQFilter fld val) = |
190 |
if namefield == fld |
191 |
then Just [val] |
192 |
else Nothing |
193 |
requestedNames _ _ = Nothing |
194 |
|
195 |
-- | Builds a simple filter from a list of names. |
196 |
makeSimpleFilter :: String -> [String] -> Filter FilterField |
197 |
makeSimpleFilter _ [] = EmptyFilter |
198 |
makeSimpleFilter namefield vals = |
199 |
OrFilter $ map (EQFilter namefield . QuotedString) vals |