Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (10.7 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
  , 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 QffHostname  v = Ok v
86
qffField QffTimestamp v =
87
  case v of
88
    JSArray [secs@(JSRational _ _), JSRational _ _] -> return secs
89
    _ -> Bad $ ProgrammerError
90
         "Internal error: Getter returned non-timestamp for QffTimestamp"
91

    
92
-- | Wraps a getter, filter pair. If the getter is 'FieldRuntime' but
93
-- we don't have a runtime context, we skip the filtering, returning
94
-- \"pass\". Otherwise, we pass the actual value to the filter.
95
wrapGetter :: ConfigData
96
           -> Maybe b
97
           -> a
98
           -> (FieldGetter a b, QffMode)
99
           -> (QffMode -> JSValue -> ErrorResult Bool)
100
           -> ErrorResult Bool
101
wrapGetter cfg b a (getter, qff) faction =
102
  case tryGetter cfg b a getter of
103
    Nothing -> Ok True -- runtime missing, accepting the value
104
    Just v ->
105
      case v of
106
        ResultEntry RSNormal (Just fval) -> qffField qff fval >>= faction qff
107
        ResultEntry RSNormal Nothing ->
108
          Bad $ ProgrammerError
109
                "Internal error: Getter returned RSNormal/Nothing"
110
        _ -> Ok True -- filter has no data to work, accepting it
111

    
112
-- | Wrapper alias over field functions to ignore their first Qff argument.
113
ignoreMode :: a -> QffMode -> a
114
ignoreMode = const
115

    
116
-- | Helper to evaluate a filter getter (and the value it generates) in
117
-- a boolean context.
118
trueFilter :: JSValue -> ErrorResult Bool
119
trueFilter (JSBool x) = Ok $! x
120
trueFilter v = Bad . ParameterError $
121
               "Unexpected value '" ++ show (pp_value v) ++
122
               "' in boolean context"
123

    
124
-- | A type synonim for a rank-2 comparator function. This is used so
125
-- that we can pass the usual '<=', '>', '==' functions to 'binOpFilter'
126
-- and for them to be used in multiple contexts.
127
type Comparator = (Eq a, Ord a) => a -> a -> Bool
128

    
129
-- | Equality checker.
130
--
131
-- This will handle hostnames correctly, if the mode is set to
132
-- 'QffHostname'.
133
eqFilter :: FilterValue -> QffMode -> JSValue -> ErrorResult Bool
134
-- send 'QffNormal' queries to 'binOpFilter'
135
eqFilter flv QffNormal    jsv = binOpFilter (==) flv jsv
136
-- and 'QffTimestamp' as well
137
eqFilter flv QffTimestamp jsv = binOpFilter (==) flv jsv
138
-- error out if we set 'QffHostname' on a non-string field
139
eqFilter _ QffHostname (JSRational _ _) =
140
  Bad . ProgrammerError $ "QffHostname field returned a numeric value"
141
-- test strings via 'compareNameComponent'
142
eqFilter (QuotedString y) QffHostname (JSString x) =
143
  Ok $ goodLookupResult (fromJSString x `compareNameComponent` y)
144
-- send all other combinations (all errors) to 'binOpFilter', which
145
-- has good error messages
146
eqFilter flv _ jsv = binOpFilter (==) flv jsv
147

    
148
-- | Helper to evaluate a filder getter (and the value it generates)
149
-- in a boolean context. Note the order of arguments is reversed from
150
-- the filter definitions (due to the call chain), make sure to
151
-- compare in the reverse order too!.
152
binOpFilter :: Comparator -> FilterValue -> JSValue -> ErrorResult Bool
153
binOpFilter comp (QuotedString y) (JSString x) =
154
  Ok $! fromJSString x `comp` y
155
binOpFilter comp (NumericValue y) (JSRational _ x) =
156
  Ok $! x `comp` fromIntegral y
157
binOpFilter _ expr actual =
158
  Bad . ParameterError $ "Invalid types in comparison, trying to compare " ++
159
      show (pp_value actual) ++ " with '" ++ show expr ++ "'"
160

    
161
-- | Implements the 'RegexpFilter' matching.
162
regexpFilter :: FilterRegex -> JSValue -> ErrorResult Bool
163
regexpFilter re (JSString val) =
164
  Ok $! PCRE.match (compiledRegex re) (fromJSString val)
165
regexpFilter _ x =
166
  Bad . ParameterError $ "Invalid field value used in regexp matching,\
167
        \ expecting string but got '" ++ show (pp_value x) ++ "'"
168

    
169
-- | Implements the 'ContainsFilter' matching.
170
containsFilter :: FilterValue -> JSValue -> ErrorResult Bool
171
-- note: the next two implementations are the same, but we have to
172
-- repeat them due to the encapsulation done by FilterValue
173
containsFilter (QuotedString val) lst = do
174
  lst' <- fromJVal lst
175
  return $! val `elem` lst'
176
containsFilter (NumericValue val) lst = do
177
  lst' <- fromJVal lst
178
  return $! val `elem` lst'
179

    
180
-- | Verifies if a given item passes a filter. The runtime context
181
-- might be missing, in which case most of the filters will consider
182
-- this as passing the filter.
183
--
184
-- Note: we use explicit recursion to reduce unneeded memory use;
185
-- 'any' and 'all' do not play nice with monadic values, resulting in
186
-- either too much memory use or in too many thunks being created.
187
evaluateFilter :: ConfigData -> Maybe b -> a
188
               -> Filter (FieldGetter a b, QffMode)
189
               -> ErrorResult Bool
190
evaluateFilter _ _  _ EmptyFilter = Ok True
191
evaluateFilter c mb a (AndFilter flts) = helper flts
192
  where helper [] = Ok True
193
        helper (f:fs) = do
194
          v <- evaluateFilter c mb a f
195
          if v
196
            then helper fs
197
            else Ok False
198
evaluateFilter c mb a (OrFilter flts) = helper flts
199
  where helper [] = Ok False
200
        helper (f:fs) = do
201
          v <- evaluateFilter c mb a f
202
          if v
203
            then Ok True
204
            else helper fs
205
evaluateFilter c mb a (NotFilter flt)  =
206
  not <$> evaluateFilter c mb a flt
207
evaluateFilter c mb a (TrueFilter getter)  =
208
  wrapGetter c mb a getter $ ignoreMode trueFilter
209
evaluateFilter c mb a (EQFilter getter val) =
210
  wrapGetter c mb a getter (eqFilter val)
211
evaluateFilter c mb a (LTFilter getter val) =
212
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (<) val)
213
evaluateFilter c mb a (LEFilter getter val) =
214
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (<=) val)
215
evaluateFilter c mb a (GTFilter getter val) =
216
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (>) val)
217
evaluateFilter c mb a (GEFilter getter val) =
218
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (>=) val)
219
evaluateFilter c mb a (RegexpFilter getter re) =
220
  wrapGetter c mb a getter $ ignoreMode (regexpFilter re)
221
evaluateFilter c mb a (ContainsFilter getter val) =
222
  wrapGetter c mb a getter $ ignoreMode (containsFilter val)
223

    
224
-- | Runs a getter with potentially missing runtime context.
225
tryGetter :: ConfigData -> Maybe b -> a -> FieldGetter a b -> Maybe ResultEntry
226
tryGetter _   _ item (FieldSimple getter)  = Just $ getter item
227
tryGetter cfg _ item (FieldConfig getter)  = Just $ getter cfg item
228
tryGetter _  rt item (FieldRuntime getter) =
229
  maybe Nothing (\rt' -> Just $ getter rt' item) rt
230
tryGetter _   _ _    FieldUnknown          = Just $
231
                                             ResultEntry RSUnknown Nothing
232

    
233
-- | Computes the requested names, if only names were requested (and
234
-- with equality). Otherwise returns 'Nothing'.
235
requestedNames :: FilterField -> Filter FilterField -> Maybe [FilterValue]
236
requestedNames _ EmptyFilter = Just []
237
requestedNames namefield (OrFilter flts) =
238
  liftM concat $ mapM (requestedNames namefield) flts
239
requestedNames namefield (EQFilter fld val) =
240
  if namefield == fld
241
    then Just [val]
242
    else Nothing
243
requestedNames _ _ = Nothing
244

    
245

    
246
type FilterConstructor = String -> [Either String Integer] -> Filter FilterField
247
  
248
-- | Builds a simple filter from a list of names.
249
makeSimpleFilter :: String -> [Either String Integer] -> Filter FilterField
250
makeSimpleFilter _ [] = EmptyFilter
251
makeSimpleFilter namefield vals =
252
  OrFilter $ map (EQFilter namefield . either QuotedString NumericValue) vals
253

    
254
-- | List of symbols with a special meaning for regular expressions.
255
reSpecialSymbols :: String
256
reSpecialSymbols = "\\.|()[]"
257

    
258
-- | Quote symbols that have special meaning in regular expressions.
259
quoteForRegex :: String -> String
260
quoteForRegex s = s >>= \x ->
261
  if x `elem` reSpecialSymbols then ['\\', x] else [x]
262

    
263
-- | Builds a filter for hostnames from a list of names.
264
makeHostnameFilter :: String -> [Either String Integer] -> Filter FilterField
265
makeHostnameFilter _ [] = EmptyFilter
266
makeHostnameFilter namefield vals = 
267
  OrFilter . flip map vals
268
  $ either  (RegexpFilter namefield . fromJust . mkRegex
269
             . (\ s -> "^(" ++ s ++ "|" ++ s ++ "\\..*)$")
270
             . quoteForRegex)
271
            (EQFilter namefield  . NumericValue)