root / src / Ganeti / Query / Filter.hs @ 178ad717
History | View | Annotate | Download (9.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, 2013 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, QffMode)) |
73 |
compileFilter fm = |
74 |
traverse (\field -> maybe |
75 |
(Bad . ParameterError $ "Can't find field named '" ++ |
76 |
field ++ "'") |
77 |
(\(_, g, q) -> Ok (g, q)) (field `Map.lookup` fm)) |
78 |
|
79 |
-- | Processes a field value given a QffMode. |
80 |
qffField :: QffMode -> JSValue -> ErrorResult JSValue |
81 |
qffField QffNormal v = Ok v |
82 |
qffField QffHostname v = Ok v |
83 |
qffField QffTimestamp v = |
84 |
case v of |
85 |
JSArray [secs@(JSRational _ _), JSRational _ _] -> return secs |
86 |
_ -> Bad $ ProgrammerError |
87 |
"Internal error: Getter returned non-timestamp for QffTimestamp" |
88 |
|
89 |
-- | Wraps a getter, filter pair. If the getter is 'FieldRuntime' but |
90 |
-- we don't have a runtime context, we skip the filtering, returning |
91 |
-- \"pass\". Otherwise, we pass the actual value to the filter. |
92 |
wrapGetter :: ConfigData |
93 |
-> Maybe b |
94 |
-> a |
95 |
-> (FieldGetter a b, QffMode) |
96 |
-> (QffMode -> JSValue -> ErrorResult Bool) |
97 |
-> ErrorResult Bool |
98 |
wrapGetter cfg b a (getter, qff) faction = |
99 |
case tryGetter cfg b a getter of |
100 |
Nothing -> Ok True -- runtime missing, accepting the value |
101 |
Just v -> |
102 |
case v of |
103 |
ResultEntry RSNormal (Just fval) -> qffField qff fval >>= faction qff |
104 |
ResultEntry RSNormal Nothing -> |
105 |
Bad $ ProgrammerError |
106 |
"Internal error: Getter returned RSNormal/Nothing" |
107 |
_ -> Ok True -- filter has no data to work, accepting it |
108 |
|
109 |
-- | Wrapper alias over field functions to ignore their first Qff argument. |
110 |
ignoreMode :: a -> QffMode -> a |
111 |
ignoreMode = const |
112 |
|
113 |
-- | Helper to evaluate a filter getter (and the value it generates) in |
114 |
-- a boolean context. |
115 |
trueFilter :: JSValue -> ErrorResult Bool |
116 |
trueFilter (JSBool x) = Ok $! x |
117 |
trueFilter v = Bad . ParameterError $ |
118 |
"Unexpected value '" ++ show (pp_value v) ++ |
119 |
"' in boolean context" |
120 |
|
121 |
-- | A type synonim for a rank-2 comparator function. This is used so |
122 |
-- that we can pass the usual '<=', '>', '==' functions to 'binOpFilter' |
123 |
-- and for them to be used in multiple contexts. |
124 |
type Comparator = (Eq a, Ord a) => a -> a -> Bool |
125 |
|
126 |
-- | Equality checker. |
127 |
-- |
128 |
-- This will handle hostnames correctly, if the mode is set to |
129 |
-- 'QffHostname'. |
130 |
eqFilter :: FilterValue -> QffMode -> JSValue -> ErrorResult Bool |
131 |
-- send 'QffNormal' queries to 'binOpFilter' |
132 |
eqFilter flv QffNormal jsv = binOpFilter (==) flv jsv |
133 |
-- and 'QffTimestamp' as well |
134 |
eqFilter flv QffTimestamp jsv = binOpFilter (==) flv jsv |
135 |
-- error out if we set 'QffHostname' on a non-string field |
136 |
eqFilter _ QffHostname (JSRational _ _) = |
137 |
Bad . ProgrammerError $ "QffHostname field returned a numeric value" |
138 |
-- test strings via 'compareNameComponent' |
139 |
eqFilter (QuotedString y) QffHostname (JSString x) = |
140 |
Ok $ goodLookupResult (fromJSString x `compareNameComponent` y) |
141 |
-- send all other combinations (all errors) to 'binOpFilter', which |
142 |
-- has good error messages |
143 |
eqFilter flv _ jsv = binOpFilter (==) flv jsv |
144 |
|
145 |
-- | Helper to evaluate a filder getter (and the value it generates) |
146 |
-- in a boolean context. Note the order of arguments is reversed from |
147 |
-- the filter definitions (due to the call chain), make sure to |
148 |
-- compare in the reverse order too!. |
149 |
binOpFilter :: Comparator -> FilterValue -> JSValue -> ErrorResult Bool |
150 |
binOpFilter comp (QuotedString y) (JSString x) = |
151 |
Ok $! fromJSString x `comp` y |
152 |
binOpFilter comp (NumericValue y) (JSRational _ x) = |
153 |
Ok $! x `comp` fromIntegral y |
154 |
binOpFilter _ expr actual = |
155 |
Bad . ParameterError $ "Invalid types in comparison, trying to compare " ++ |
156 |
show (pp_value actual) ++ " with '" ++ show expr ++ "'" |
157 |
|
158 |
-- | Implements the 'RegexpFilter' matching. |
159 |
regexpFilter :: FilterRegex -> JSValue -> ErrorResult Bool |
160 |
regexpFilter re (JSString val) = |
161 |
Ok $! PCRE.match (compiledRegex re) (fromJSString val) |
162 |
regexpFilter _ x = |
163 |
Bad . ParameterError $ "Invalid field value used in regexp matching,\ |
164 |
\ expecting string but got '" ++ show (pp_value x) ++ "'" |
165 |
|
166 |
-- | Implements the 'ContainsFilter' matching. |
167 |
containsFilter :: FilterValue -> JSValue -> ErrorResult Bool |
168 |
-- note: the next two implementations are the same, but we have to |
169 |
-- repeat them due to the encapsulation done by FilterValue |
170 |
containsFilter (QuotedString val) lst = do |
171 |
lst' <- fromJVal lst |
172 |
return $! val `elem` lst' |
173 |
containsFilter (NumericValue val) lst = do |
174 |
lst' <- fromJVal lst |
175 |
return $! val `elem` lst' |
176 |
|
177 |
-- | Verifies if a given item passes a filter. The runtime context |
178 |
-- might be missing, in which case most of the filters will consider |
179 |
-- this as passing the filter. |
180 |
-- |
181 |
-- Note: we use explicit recursion to reduce unneeded memory use; |
182 |
-- 'any' and 'all' do not play nice with monadic values, resulting in |
183 |
-- either too much memory use or in too many thunks being created. |
184 |
evaluateFilter :: ConfigData -> Maybe b -> a |
185 |
-> Filter (FieldGetter a b, QffMode) |
186 |
-> ErrorResult Bool |
187 |
evaluateFilter _ _ _ EmptyFilter = Ok True |
188 |
evaluateFilter c mb a (AndFilter flts) = helper flts |
189 |
where helper [] = Ok True |
190 |
helper (f:fs) = do |
191 |
v <- evaluateFilter c mb a f |
192 |
if v |
193 |
then helper fs |
194 |
else Ok False |
195 |
evaluateFilter c mb a (OrFilter flts) = helper flts |
196 |
where helper [] = Ok False |
197 |
helper (f:fs) = do |
198 |
v <- evaluateFilter c mb a f |
199 |
if v |
200 |
then Ok True |
201 |
else helper fs |
202 |
evaluateFilter c mb a (NotFilter flt) = |
203 |
not <$> evaluateFilter c mb a flt |
204 |
evaluateFilter c mb a (TrueFilter getter) = |
205 |
wrapGetter c mb a getter $ ignoreMode trueFilter |
206 |
evaluateFilter c mb a (EQFilter getter val) = |
207 |
wrapGetter c mb a getter (eqFilter val) |
208 |
evaluateFilter c mb a (LTFilter getter val) = |
209 |
wrapGetter c mb a getter $ ignoreMode (binOpFilter (<) val) |
210 |
evaluateFilter c mb a (LEFilter getter val) = |
211 |
wrapGetter c mb a getter $ ignoreMode (binOpFilter (<=) val) |
212 |
evaluateFilter c mb a (GTFilter getter val) = |
213 |
wrapGetter c mb a getter $ ignoreMode (binOpFilter (>) val) |
214 |
evaluateFilter c mb a (GEFilter getter val) = |
215 |
wrapGetter c mb a getter $ ignoreMode (binOpFilter (>=) val) |
216 |
evaluateFilter c mb a (RegexpFilter getter re) = |
217 |
wrapGetter c mb a getter $ ignoreMode (regexpFilter re) |
218 |
evaluateFilter c mb a (ContainsFilter getter val) = |
219 |
wrapGetter c mb a getter $ ignoreMode (containsFilter val) |
220 |
|
221 |
-- | Runs a getter with potentially missing runtime context. |
222 |
tryGetter :: ConfigData -> Maybe b -> a -> FieldGetter a b -> Maybe ResultEntry |
223 |
tryGetter _ _ item (FieldSimple getter) = Just $ getter item |
224 |
tryGetter cfg _ item (FieldConfig getter) = Just $ getter cfg item |
225 |
tryGetter _ rt item (FieldRuntime getter) = |
226 |
maybe Nothing (\rt' -> Just $ getter rt' item) rt |
227 |
tryGetter cfg rt item (FieldConfigRuntime getter) = |
228 |
maybe Nothing (\rt' -> Just $ getter cfg rt' item) rt |
229 |
tryGetter _ _ _ FieldUnknown = Just $ ResultEntry RSUnknown Nothing |
230 |
|
231 |
-- | Computes the requested names, if only names were requested (and |
232 |
-- with equality). Otherwise returns 'Nothing'. |
233 |
requestedNames :: FilterField -> Filter FilterField -> Maybe [FilterValue] |
234 |
requestedNames _ EmptyFilter = Just [] |
235 |
requestedNames namefield (OrFilter flts) = |
236 |
liftM concat $ mapM (requestedNames namefield) flts |
237 |
requestedNames namefield (EQFilter fld val) = |
238 |
if namefield == fld |
239 |
then Just [val] |
240 |
else Nothing |
241 |
requestedNames _ _ = Nothing |
242 |
|
243 |
-- | Builds a simple filter from a list of names. |
244 |
makeSimpleFilter :: String -> [Either String Integer] -> Filter FilterField |
245 |
makeSimpleFilter _ [] = EmptyFilter |
246 |
makeSimpleFilter namefield vals = |
247 |
OrFilter $ map (EQFilter namefield . either QuotedString NumericValue) vals |