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