1 {-# LANGUAGE Rank2Types #-}
3 {-| Implementation of the Ganeti Query2 filterning.
5 The filtering of results should be done in two phases.
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.
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.
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).
28 Copyright (C) 2012 Google Inc.
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.
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.
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
47 module Ganeti.Query.Filter
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
62 import Ganeti.BasicTypes
65 import Ganeti.Query.Language
66 import Ganeti.Query.Types
69 -- | Compiles a filter based on field names to one based on getters.
70 compileFilter :: FieldMap a b
72 -> ErrorResult (Filter (FieldGetter a b))
74 traverse (\field -> maybe
75 (Bad . ParameterError $ "Can't find field named '" ++
77 (Ok . snd) (field `Map.lookup` fm))
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
86 -> (JSValue -> 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
93 ResultEntry RSNormal (Just fval) -> faction fval
94 ResultEntry RSNormal Nothing ->
96 "Internal error: Getter returned RSNormal/Nothing"
97 _ -> Ok True -- filter has no data to work, accepting it
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"
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
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 ++ "'"
125 -- | Implements the 'RegexpFilter' matching.
126 regexpFilter :: FilterRegex -> JSValue -> ErrorResult Bool
127 regexpFilter re (JSString val) =
128 Ok $! PCRE.match (compiledRegex re) (fromJSString val)
130 Bad . ParameterError $ "Invalid field value used in regexp matching,\
131 \ expecting string but got '" ++ show (pp_value x) ++ "'"
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
139 return $! val `elem` lst'
140 containsFilter (NumericValue val) lst = do
142 return $! val `elem` lst'
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.
148 -- Note: we use explicit recursion to reduce unneeded memory use;
149 -- 'any' and 'all' do not play nice with monadic values, resulting in
150 -- either too much memory use or in too many thunks being created.
151 evaluateFilter :: ConfigData -> Maybe b -> a
152 -> Filter (FieldGetter a b)
154 evaluateFilter _ _ _ EmptyFilter = Ok True
155 evaluateFilter c mb a (AndFilter flts) = helper flts
156 where helper [] = Ok True
158 v <- evaluateFilter c mb a f
162 evaluateFilter c mb a (OrFilter flts) = helper flts
163 where helper [] = Ok False
165 v <- evaluateFilter c mb a f
169 evaluateFilter c mb a (NotFilter flt) =
170 not <$> evaluateFilter c mb a flt
171 evaluateFilter c mb a (TrueFilter getter) =
172 wrapGetter c mb a getter trueFilter
173 evaluateFilter c mb a (EQFilter getter val) =
174 wrapGetter c mb a getter (binOpFilter (==) val)
175 evaluateFilter c mb a (LTFilter getter val) =
176 wrapGetter c mb a getter (binOpFilter (<) val)
177 evaluateFilter c mb a (LEFilter getter val) =
178 wrapGetter c mb a getter (binOpFilter (<=) val)
179 evaluateFilter c mb a (GTFilter getter val) =
180 wrapGetter c mb a getter (binOpFilter (>) val)
181 evaluateFilter c mb a (GEFilter getter val) =
182 wrapGetter c mb a getter (binOpFilter (>=) val)
183 evaluateFilter c mb a (RegexpFilter getter re) =
184 wrapGetter c mb a getter (regexpFilter re)
185 evaluateFilter c mb a (ContainsFilter getter val) =
186 wrapGetter c mb a getter (containsFilter val)
188 -- | Runs a getter with potentially missing runtime context.
189 tryGetter :: ConfigData -> Maybe b -> a -> FieldGetter a b -> Maybe ResultEntry
190 tryGetter _ _ item (FieldSimple getter) = Just $ getter item
191 tryGetter cfg _ item (FieldConfig getter) = Just $ getter cfg item
192 tryGetter _ rt item (FieldRuntime getter) =
193 maybe Nothing (\rt' -> Just $ getter rt' item) rt
194 tryGetter _ _ _ FieldUnknown = Just $
195 ResultEntry RSUnknown Nothing
197 -- | Computes the requested names, if only names were requested (and
198 -- with equality). Otherwise returns 'Nothing'.
199 requestedNames :: FilterField -> Filter FilterField -> Maybe [FilterValue]
200 requestedNames _ EmptyFilter = Just []
201 requestedNames namefield (OrFilter flts) =
202 liftM concat $ mapM (requestedNames namefield) flts
203 requestedNames namefield (EQFilter fld val) =
207 requestedNames _ _ = Nothing
209 -- | Builds a simple filter from a list of names.
210 makeSimpleFilter :: String -> [String] -> Filter FilterField
211 makeSimpleFilter _ [] = EmptyFilter
212 makeSimpleFilter namefield vals =
213 OrFilter $ map (EQFilter namefield . QuotedString) vals