Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Query / Filter.hs @ e78a8c0b

History | View | Annotate | Download (10.7 kB)

1 8a65c02b Iustin Pop
{-# LANGUAGE Rank2Types #-}
2 8a65c02b Iustin Pop
3 8a65c02b Iustin Pop
{-| Implementation of the Ganeti Query2 filterning.
4 8a65c02b Iustin Pop
5 8a65c02b Iustin Pop
The filtering of results should be done in two phases.
6 8a65c02b Iustin Pop
7 8a65c02b Iustin Pop
In the first phase, before contacting any remote nodes for runtime
8 8a65c02b Iustin Pop
data, the filtering should be executed with 'Nothing' for the runtime
9 8a65c02b Iustin Pop
context. This will make all non-runtime filters filter correctly,
10 8a65c02b Iustin Pop
whereas all runtime filters will respond successfully. As described in
11 8a65c02b Iustin Pop
the Python version too, this makes for example /Or/ filters very
12 8a65c02b Iustin Pop
inefficient if they contain runtime fields.
13 8a65c02b Iustin Pop
14 8a65c02b Iustin Pop
Once this first filtering phase has been done, we hopefully eliminated
15 8a65c02b Iustin Pop
some remote nodes out of the list of candidates, we run the remote
16 8a65c02b Iustin Pop
data gathering, and we evaluate the filter again, this time with a
17 8a65c02b Iustin Pop
'Just' runtime context. This will make all filters work correctly.
18 8a65c02b Iustin Pop
19 8a65c02b Iustin Pop
Note that the second run will re-evaluate the config/simple fields,
20 8a65c02b Iustin Pop
without caching; this is not perfect, but we consider config accesses
21 8a65c02b Iustin Pop
very cheap (and the configuration snapshot we have won't change
22 8a65c02b Iustin Pop
between the two runs, hence we will not get inconsistent results).
23 8a65c02b Iustin Pop
24 8a65c02b Iustin Pop
-}
25 8a65c02b Iustin Pop
26 8a65c02b Iustin Pop
{-
27 8a65c02b Iustin Pop
28 91c1a265 Iustin Pop
Copyright (C) 2012, 2013 Google Inc.
29 8a65c02b Iustin Pop
30 8a65c02b Iustin Pop
This program is free software; you can redistribute it and/or modify
31 8a65c02b Iustin Pop
it under the terms of the GNU General Public License as published by
32 8a65c02b Iustin Pop
the Free Software Foundation; either version 2 of the License, or
33 8a65c02b Iustin Pop
(at your option) any later version.
34 8a65c02b Iustin Pop
35 8a65c02b Iustin Pop
This program is distributed in the hope that it will be useful, but
36 8a65c02b Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
37 8a65c02b Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
38 8a65c02b Iustin Pop
General Public License for more details.
39 8a65c02b Iustin Pop
40 8a65c02b Iustin Pop
You should have received a copy of the GNU General Public License
41 8a65c02b Iustin Pop
along with this program; if not, write to the Free Software
42 8a65c02b Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
43 8a65c02b Iustin Pop
02110-1301, USA.
44 8a65c02b Iustin Pop
45 8a65c02b Iustin Pop
-}
46 8a65c02b Iustin Pop
47 8a65c02b Iustin Pop
module Ganeti.Query.Filter
48 8a65c02b Iustin Pop
  ( compileFilter
49 8a65c02b Iustin Pop
  , evaluateFilter
50 bc4cdeef Iustin Pop
  , requestedNames
51 0122b96d Klaus Aehlig
  , FilterConstructor
52 b3d17f52 Iustin Pop
  , makeSimpleFilter
53 0122b96d Klaus Aehlig
  , makeHostnameFilter
54 8a65c02b Iustin Pop
  ) where
55 8a65c02b Iustin Pop
56 8a65c02b Iustin Pop
import Control.Applicative
57 bc4cdeef Iustin Pop
import Control.Monad (liftM)
58 8a65c02b Iustin Pop
import qualified Data.Map as Map
59 0122b96d Klaus Aehlig
import Data.Maybe (fromJust)
60 8a65c02b Iustin Pop
import Data.Traversable (traverse)
61 8a65c02b Iustin Pop
import Text.JSON (JSValue(..), fromJSString)
62 8a65c02b Iustin Pop
import Text.JSON.Pretty (pp_value)
63 01606931 Iustin Pop
import qualified Text.Regex.PCRE as PCRE
64 8a65c02b Iustin Pop
65 8a65c02b Iustin Pop
import Ganeti.BasicTypes
66 5183e8be Iustin Pop
import Ganeti.Errors
67 8a65c02b Iustin Pop
import Ganeti.Objects
68 4cab6703 Iustin Pop
import Ganeti.Query.Language
69 8a65c02b Iustin Pop
import Ganeti.Query.Types
70 f3baf5ef Iustin Pop
import Ganeti.JSON
71 8a65c02b Iustin Pop
72 8a65c02b Iustin Pop
-- | Compiles a filter based on field names to one based on getters.
73 8a65c02b Iustin Pop
compileFilter :: FieldMap a b
74 8a65c02b Iustin Pop
              -> Filter FilterField
75 f94a9680 Iustin Pop
              -> ErrorResult (Filter (FieldGetter a b, QffMode))
76 8a65c02b Iustin Pop
compileFilter fm =
77 5183e8be Iustin Pop
  traverse (\field -> maybe
78 5183e8be Iustin Pop
                      (Bad . ParameterError $ "Can't find field named '" ++
79 5183e8be Iustin Pop
                           field ++ "'")
80 f94a9680 Iustin Pop
                      (\(_, g, q) -> Ok (g, q)) (field `Map.lookup` fm))
81 f94a9680 Iustin Pop
82 f94a9680 Iustin Pop
-- | Processes a field value given a QffMode.
83 f94a9680 Iustin Pop
qffField :: QffMode -> JSValue -> ErrorResult JSValue
84 f94a9680 Iustin Pop
qffField QffNormal    v = Ok v
85 91c1a265 Iustin Pop
qffField QffHostname  v = Ok v
86 f94a9680 Iustin Pop
qffField QffTimestamp v =
87 f94a9680 Iustin Pop
  case v of
88 f94a9680 Iustin Pop
    JSArray [secs@(JSRational _ _), JSRational _ _] -> return secs
89 f94a9680 Iustin Pop
    _ -> Bad $ ProgrammerError
90 f94a9680 Iustin Pop
         "Internal error: Getter returned non-timestamp for QffTimestamp"
91 8a65c02b Iustin Pop
92 8a65c02b Iustin Pop
-- | Wraps a getter, filter pair. If the getter is 'FieldRuntime' but
93 8a65c02b Iustin Pop
-- we don't have a runtime context, we skip the filtering, returning
94 8a65c02b Iustin Pop
-- \"pass\". Otherwise, we pass the actual value to the filter.
95 8a65c02b Iustin Pop
wrapGetter :: ConfigData
96 8a65c02b Iustin Pop
           -> Maybe b
97 8a65c02b Iustin Pop
           -> a
98 f94a9680 Iustin Pop
           -> (FieldGetter a b, QffMode)
99 91c1a265 Iustin Pop
           -> (QffMode -> JSValue -> ErrorResult Bool)
100 5183e8be Iustin Pop
           -> ErrorResult Bool
101 f94a9680 Iustin Pop
wrapGetter cfg b a (getter, qff) faction =
102 8a65c02b Iustin Pop
  case tryGetter cfg b a getter of
103 8a65c02b Iustin Pop
    Nothing -> Ok True -- runtime missing, accepting the value
104 8a65c02b Iustin Pop
    Just v ->
105 8a65c02b Iustin Pop
      case v of
106 91c1a265 Iustin Pop
        ResultEntry RSNormal (Just fval) -> qffField qff fval >>= faction qff
107 8a65c02b Iustin Pop
        ResultEntry RSNormal Nothing ->
108 5183e8be Iustin Pop
          Bad $ ProgrammerError
109 5183e8be Iustin Pop
                "Internal error: Getter returned RSNormal/Nothing"
110 8a65c02b Iustin Pop
        _ -> Ok True -- filter has no data to work, accepting it
111 8a65c02b Iustin Pop
112 91c1a265 Iustin Pop
-- | Wrapper alias over field functions to ignore their first Qff argument.
113 91c1a265 Iustin Pop
ignoreMode :: a -> QffMode -> a
114 91c1a265 Iustin Pop
ignoreMode = const
115 91c1a265 Iustin Pop
116 8a65c02b Iustin Pop
-- | Helper to evaluate a filter getter (and the value it generates) in
117 8a65c02b Iustin Pop
-- a boolean context.
118 5183e8be Iustin Pop
trueFilter :: JSValue -> ErrorResult Bool
119 228ef0f2 Iustin Pop
trueFilter (JSBool x) = Ok $! x
120 5183e8be Iustin Pop
trueFilter v = Bad . ParameterError $
121 5183e8be Iustin Pop
               "Unexpected value '" ++ show (pp_value v) ++
122 8a65c02b Iustin Pop
               "' in boolean context"
123 8a65c02b Iustin Pop
124 8a65c02b Iustin Pop
-- | A type synonim for a rank-2 comparator function. This is used so
125 8a65c02b Iustin Pop
-- that we can pass the usual '<=', '>', '==' functions to 'binOpFilter'
126 8a65c02b Iustin Pop
-- and for them to be used in multiple contexts.
127 8a65c02b Iustin Pop
type Comparator = (Eq a, Ord a) => a -> a -> Bool
128 8a65c02b Iustin Pop
129 91c1a265 Iustin Pop
-- | Equality checker.
130 91c1a265 Iustin Pop
--
131 91c1a265 Iustin Pop
-- This will handle hostnames correctly, if the mode is set to
132 91c1a265 Iustin Pop
-- 'QffHostname'.
133 91c1a265 Iustin Pop
eqFilter :: FilterValue -> QffMode -> JSValue -> ErrorResult Bool
134 91c1a265 Iustin Pop
-- send 'QffNormal' queries to 'binOpFilter'
135 91c1a265 Iustin Pop
eqFilter flv QffNormal    jsv = binOpFilter (==) flv jsv
136 91c1a265 Iustin Pop
-- and 'QffTimestamp' as well
137 91c1a265 Iustin Pop
eqFilter flv QffTimestamp jsv = binOpFilter (==) flv jsv
138 91c1a265 Iustin Pop
-- error out if we set 'QffHostname' on a non-string field
139 91c1a265 Iustin Pop
eqFilter _ QffHostname (JSRational _ _) =
140 91c1a265 Iustin Pop
  Bad . ProgrammerError $ "QffHostname field returned a numeric value"
141 91c1a265 Iustin Pop
-- test strings via 'compareNameComponent'
142 91c1a265 Iustin Pop
eqFilter (QuotedString y) QffHostname (JSString x) =
143 91c1a265 Iustin Pop
  Ok $ goodLookupResult (fromJSString x `compareNameComponent` y)
144 91c1a265 Iustin Pop
-- send all other combinations (all errors) to 'binOpFilter', which
145 91c1a265 Iustin Pop
-- has good error messages
146 91c1a265 Iustin Pop
eqFilter flv _ jsv = binOpFilter (==) flv jsv
147 91c1a265 Iustin Pop
148 8a65c02b Iustin Pop
-- | Helper to evaluate a filder getter (and the value it generates)
149 8a65c02b Iustin Pop
-- in a boolean context. Note the order of arguments is reversed from
150 8a65c02b Iustin Pop
-- the filter definitions (due to the call chain), make sure to
151 8a65c02b Iustin Pop
-- compare in the reverse order too!.
152 5183e8be Iustin Pop
binOpFilter :: Comparator -> FilterValue -> JSValue -> ErrorResult Bool
153 8a65c02b Iustin Pop
binOpFilter comp (QuotedString y) (JSString x) =
154 228ef0f2 Iustin Pop
  Ok $! fromJSString x `comp` y
155 8a65c02b Iustin Pop
binOpFilter comp (NumericValue y) (JSRational _ x) =
156 228ef0f2 Iustin Pop
  Ok $! x `comp` fromIntegral y
157 8a65c02b Iustin Pop
binOpFilter _ expr actual =
158 5183e8be Iustin Pop
  Bad . ParameterError $ "Invalid types in comparison, trying to compare " ++
159 8a65c02b Iustin Pop
      show (pp_value actual) ++ " with '" ++ show expr ++ "'"
160 8a65c02b Iustin Pop
161 8a65c02b Iustin Pop
-- | Implements the 'RegexpFilter' matching.
162 5183e8be Iustin Pop
regexpFilter :: FilterRegex -> JSValue -> ErrorResult Bool
163 01606931 Iustin Pop
regexpFilter re (JSString val) =
164 228ef0f2 Iustin Pop
  Ok $! PCRE.match (compiledRegex re) (fromJSString val)
165 8a65c02b Iustin Pop
regexpFilter _ x =
166 5183e8be Iustin Pop
  Bad . ParameterError $ "Invalid field value used in regexp matching,\
167 8a65c02b Iustin Pop
        \ expecting string but got '" ++ show (pp_value x) ++ "'"
168 8a65c02b Iustin Pop
169 8a65c02b Iustin Pop
-- | Implements the 'ContainsFilter' matching.
170 5183e8be Iustin Pop
containsFilter :: FilterValue -> JSValue -> ErrorResult Bool
171 8a65c02b Iustin Pop
-- note: the next two implementations are the same, but we have to
172 8a65c02b Iustin Pop
-- repeat them due to the encapsulation done by FilterValue
173 8a65c02b Iustin Pop
containsFilter (QuotedString val) lst = do
174 8a65c02b Iustin Pop
  lst' <- fromJVal lst
175 228ef0f2 Iustin Pop
  return $! val `elem` lst'
176 8a65c02b Iustin Pop
containsFilter (NumericValue val) lst = do
177 8a65c02b Iustin Pop
  lst' <- fromJVal lst
178 228ef0f2 Iustin Pop
  return $! val `elem` lst'
179 8a65c02b Iustin Pop
180 8a65c02b Iustin Pop
-- | Verifies if a given item passes a filter. The runtime context
181 8a65c02b Iustin Pop
-- might be missing, in which case most of the filters will consider
182 8a65c02b Iustin Pop
-- this as passing the filter.
183 d277b075 Iustin Pop
--
184 d277b075 Iustin Pop
-- Note: we use explicit recursion to reduce unneeded memory use;
185 d277b075 Iustin Pop
-- 'any' and 'all' do not play nice with monadic values, resulting in
186 d277b075 Iustin Pop
-- either too much memory use or in too many thunks being created.
187 8a65c02b Iustin Pop
evaluateFilter :: ConfigData -> Maybe b -> a
188 f94a9680 Iustin Pop
               -> Filter (FieldGetter a b, QffMode)
189 5183e8be Iustin Pop
               -> ErrorResult Bool
190 8a65c02b Iustin Pop
evaluateFilter _ _  _ EmptyFilter = Ok True
191 d277b075 Iustin Pop
evaluateFilter c mb a (AndFilter flts) = helper flts
192 d277b075 Iustin Pop
  where helper [] = Ok True
193 d277b075 Iustin Pop
        helper (f:fs) = do
194 d277b075 Iustin Pop
          v <- evaluateFilter c mb a f
195 d277b075 Iustin Pop
          if v
196 d277b075 Iustin Pop
            then helper fs
197 d277b075 Iustin Pop
            else Ok False
198 d277b075 Iustin Pop
evaluateFilter c mb a (OrFilter flts) = helper flts
199 d277b075 Iustin Pop
  where helper [] = Ok False
200 d277b075 Iustin Pop
        helper (f:fs) = do
201 d277b075 Iustin Pop
          v <- evaluateFilter c mb a f
202 d277b075 Iustin Pop
          if v
203 d277b075 Iustin Pop
            then Ok True
204 d277b075 Iustin Pop
            else helper fs
205 8a65c02b Iustin Pop
evaluateFilter c mb a (NotFilter flt)  =
206 8a65c02b Iustin Pop
  not <$> evaluateFilter c mb a flt
207 8a65c02b Iustin Pop
evaluateFilter c mb a (TrueFilter getter)  =
208 91c1a265 Iustin Pop
  wrapGetter c mb a getter $ ignoreMode trueFilter
209 8a65c02b Iustin Pop
evaluateFilter c mb a (EQFilter getter val) =
210 91c1a265 Iustin Pop
  wrapGetter c mb a getter (eqFilter val)
211 8a65c02b Iustin Pop
evaluateFilter c mb a (LTFilter getter val) =
212 91c1a265 Iustin Pop
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (<) val)
213 8a65c02b Iustin Pop
evaluateFilter c mb a (LEFilter getter val) =
214 91c1a265 Iustin Pop
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (<=) val)
215 8a65c02b Iustin Pop
evaluateFilter c mb a (GTFilter getter val) =
216 91c1a265 Iustin Pop
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (>) val)
217 8a65c02b Iustin Pop
evaluateFilter c mb a (GEFilter getter val) =
218 91c1a265 Iustin Pop
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (>=) val)
219 8a65c02b Iustin Pop
evaluateFilter c mb a (RegexpFilter getter re) =
220 91c1a265 Iustin Pop
  wrapGetter c mb a getter $ ignoreMode (regexpFilter re)
221 8a65c02b Iustin Pop
evaluateFilter c mb a (ContainsFilter getter val) =
222 91c1a265 Iustin Pop
  wrapGetter c mb a getter $ ignoreMode (containsFilter val)
223 8a65c02b Iustin Pop
224 8a65c02b Iustin Pop
-- | Runs a getter with potentially missing runtime context.
225 8a65c02b Iustin Pop
tryGetter :: ConfigData -> Maybe b -> a -> FieldGetter a b -> Maybe ResultEntry
226 8a65c02b Iustin Pop
tryGetter _   _ item (FieldSimple getter)  = Just $ getter item
227 8a65c02b Iustin Pop
tryGetter cfg _ item (FieldConfig getter)  = Just $ getter cfg item
228 8a65c02b Iustin Pop
tryGetter _  rt item (FieldRuntime getter) =
229 8a65c02b Iustin Pop
  maybe Nothing (\rt' -> Just $ getter rt' item) rt
230 8a65c02b Iustin Pop
tryGetter _   _ _    FieldUnknown          = Just $
231 8a65c02b Iustin Pop
                                             ResultEntry RSUnknown Nothing
232 bc4cdeef Iustin Pop
233 bc4cdeef Iustin Pop
-- | Computes the requested names, if only names were requested (and
234 bc4cdeef Iustin Pop
-- with equality). Otherwise returns 'Nothing'.
235 bc4cdeef Iustin Pop
requestedNames :: FilterField -> Filter FilterField -> Maybe [FilterValue]
236 bc4cdeef Iustin Pop
requestedNames _ EmptyFilter = Just []
237 bc4cdeef Iustin Pop
requestedNames namefield (OrFilter flts) =
238 bc4cdeef Iustin Pop
  liftM concat $ mapM (requestedNames namefield) flts
239 bc4cdeef Iustin Pop
requestedNames namefield (EQFilter fld val) =
240 bc4cdeef Iustin Pop
  if namefield == fld
241 bc4cdeef Iustin Pop
    then Just [val]
242 bc4cdeef Iustin Pop
    else Nothing
243 bc4cdeef Iustin Pop
requestedNames _ _ = Nothing
244 b3d17f52 Iustin Pop
245 0122b96d Klaus Aehlig
246 0122b96d Klaus Aehlig
type FilterConstructor = String -> [Either String Integer] -> Filter FilterField
247 0122b96d Klaus Aehlig
  
248 b3d17f52 Iustin Pop
-- | Builds a simple filter from a list of names.
249 037762a9 Iustin Pop
makeSimpleFilter :: String -> [Either String Integer] -> Filter FilterField
250 b3d17f52 Iustin Pop
makeSimpleFilter _ [] = EmptyFilter
251 b3d17f52 Iustin Pop
makeSimpleFilter namefield vals =
252 037762a9 Iustin Pop
  OrFilter $ map (EQFilter namefield . either QuotedString NumericValue) vals
253 0122b96d Klaus Aehlig
254 0122b96d Klaus Aehlig
-- | List of symbols with a special meaning for regular expressions.
255 0122b96d Klaus Aehlig
reSpecialSymbols :: String
256 0122b96d Klaus Aehlig
reSpecialSymbols = "\\.|()[]"
257 0122b96d Klaus Aehlig
258 0122b96d Klaus Aehlig
-- | Quote symbols that have special meaning in regular expressions.
259 0122b96d Klaus Aehlig
quoteForRegex :: String -> String
260 0122b96d Klaus Aehlig
quoteForRegex s = s >>= \x ->
261 0122b96d Klaus Aehlig
  if x `elem` reSpecialSymbols then ['\\', x] else [x]
262 0122b96d Klaus Aehlig
263 0122b96d Klaus Aehlig
-- | Builds a filter for hostnames from a list of names.
264 0122b96d Klaus Aehlig
makeHostnameFilter :: String -> [Either String Integer] -> Filter FilterField
265 0122b96d Klaus Aehlig
makeHostnameFilter _ [] = EmptyFilter
266 0122b96d Klaus Aehlig
makeHostnameFilter namefield vals = 
267 0122b96d Klaus Aehlig
  OrFilter . flip map vals
268 0122b96d Klaus Aehlig
  $ either  (RegexpFilter namefield . fromJust . mkRegex
269 0122b96d Klaus Aehlig
             . (\ s -> "^(" ++ s ++ "|" ++ s ++ "\\..*)$")
270 0122b96d Klaus Aehlig
             . quoteForRegex)
271 0122b96d Klaus Aehlig
            (EQFilter namefield  . NumericValue)