Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Query / Filter.hs @ 6ab6b19a

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 _   _ _    FieldUnknown          = Just $
228
                                             ResultEntry RSUnknown Nothing
229

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

    
242
-- | Builds a simple filter from a list of names.
243
makeSimpleFilter :: String -> [Either String Integer] -> Filter FilterField
244
makeSimpleFilter _ [] = EmptyFilter
245
makeSimpleFilter namefield vals =
246
  OrFilter $ map (EQFilter namefield . either QuotedString NumericValue) vals