Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Query / Filter.hs @ b3d17f52

History | View | Annotate | Download (7.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
  , 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.Objects
64
import Ganeti.Query.Language
65
import Ganeti.Query.Types
66
import Ganeti.JSON
67

    
68
-- | Compiles a filter based on field names to one based on getters.
69
compileFilter :: FieldMap a b
70
              -> Filter FilterField
71
              -> Result (Filter (FieldGetter a b))
72
compileFilter fm =
73
  traverse (\field -> maybe (Bad $ "Can't find field named '" ++ field ++ "'")
74
                      (Ok . snd) (field `Map.lookup` fm))
75

    
76
-- | Wraps a getter, filter pair. If the getter is 'FieldRuntime' but
77
-- we don't have a runtime context, we skip the filtering, returning
78
-- \"pass\". Otherwise, we pass the actual value to the filter.
79
wrapGetter :: ConfigData
80
           -> Maybe b
81
           -> a
82
           -> FieldGetter a b
83
           -> (JSValue -> Result Bool)
84
           -> Result Bool
85
wrapGetter cfg b a getter faction =
86
  case tryGetter cfg b a getter of
87
    Nothing -> Ok True -- runtime missing, accepting the value
88
    Just v ->
89
      case v of
90
        ResultEntry RSNormal (Just fval) -> faction fval
91
        ResultEntry RSNormal Nothing ->
92
          Bad "Internal error: Getter returned RSNormal/Nothing"
93
        _ -> Ok True -- filter has no data to work, accepting it
94

    
95
-- | Helper to evaluate a filter getter (and the value it generates) in
96
-- a boolean context.
97
trueFilter :: JSValue -> Result Bool
98
trueFilter (JSBool x) = Ok x
99
trueFilter v = Bad $ "Unexpected value '" ++ show (pp_value v) ++
100
               "' in boolean context"
101

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

    
107
-- | Helper to evaluate a filder getter (and the value it generates)
108
-- in a boolean context. Note the order of arguments is reversed from
109
-- the filter definitions (due to the call chain), make sure to
110
-- compare in the reverse order too!.
111
binOpFilter :: Comparator -> FilterValue -> JSValue -> Result Bool
112
binOpFilter comp (QuotedString y) (JSString x) =
113
  Ok $ fromJSString x `comp` y
114
binOpFilter comp (NumericValue y) (JSRational _ x) =
115
  Ok $ x `comp` fromIntegral y
116
binOpFilter _ expr actual =
117
  Bad $ "Invalid types in comparison, trying to compare " ++
118
      show (pp_value actual) ++ " with '" ++ show expr ++ "'"
119

    
120
-- | Implements the 'RegexpFilter' matching.
121
regexpFilter :: FilterRegex -> JSValue -> Result Bool
122
regexpFilter re (JSString val) =
123
  Ok $ PCRE.match (compiledRegex re) (fromJSString val)
124
regexpFilter _ x =
125
  Bad $ "Invalid field value used in regexp matching,\
126
        \ expecting string but got '" ++ show (pp_value x) ++ "'"
127

    
128
-- | Implements the 'ContainsFilter' matching.
129
containsFilter :: FilterValue -> JSValue -> Result Bool
130
-- note: the next two implementations are the same, but we have to
131
-- repeat them due to the encapsulation done by FilterValue
132
containsFilter (QuotedString val) lst = do
133
  lst' <- fromJVal lst
134
  return $ val `elem` lst'
135
containsFilter (NumericValue val) lst = do
136
  lst' <- fromJVal lst
137
  return $ val `elem` lst'
138

    
139
-- | Verifies if a given item passes a filter. The runtime context
140
-- might be missing, in which case most of the filters will consider
141
-- this as passing the filter.
142
evaluateFilter :: ConfigData -> Maybe b -> a
143
               -> Filter (FieldGetter a b)
144
               -> Result Bool
145
evaluateFilter _ _  _ EmptyFilter = Ok True
146
evaluateFilter c mb a (AndFilter flts) =
147
  all id <$> mapM (evaluateFilter c mb a) flts
148
evaluateFilter c mb a (OrFilter flts)  =
149
  any id <$> mapM (evaluateFilter c mb a) flts
150
evaluateFilter c mb a (NotFilter flt)  =
151
  not <$> evaluateFilter c mb a flt
152
evaluateFilter c mb a (TrueFilter getter)  =
153
  wrapGetter c mb a getter trueFilter
154
evaluateFilter c mb a (EQFilter getter val) =
155
  wrapGetter c mb a getter (binOpFilter (==) val)
156
evaluateFilter c mb a (LTFilter getter val) =
157
  wrapGetter c mb a getter (binOpFilter (<) val)
158
evaluateFilter c mb a (LEFilter getter val) =
159
  wrapGetter c mb a getter (binOpFilter (<=) val)
160
evaluateFilter c mb a (GTFilter getter val) =
161
  wrapGetter c mb a getter (binOpFilter (>) val)
162
evaluateFilter c mb a (GEFilter getter val) =
163
  wrapGetter c mb a getter (binOpFilter (>=) val)
164
evaluateFilter c mb a (RegexpFilter getter re) =
165
  wrapGetter c mb a getter (regexpFilter re)
166
evaluateFilter c mb a (ContainsFilter getter val) =
167
  wrapGetter c mb a getter (containsFilter val)
168

    
169
-- | Runs a getter with potentially missing runtime context.
170
tryGetter :: ConfigData -> Maybe b -> a -> FieldGetter a b -> Maybe ResultEntry
171
tryGetter _   _ item (FieldSimple getter)  = Just $ getter item
172
tryGetter cfg _ item (FieldConfig getter)  = Just $ getter cfg item
173
tryGetter _  rt item (FieldRuntime getter) =
174
  maybe Nothing (\rt' -> Just $ getter rt' item) rt
175
tryGetter _   _ _    FieldUnknown          = Just $
176
                                             ResultEntry RSUnknown Nothing
177

    
178
-- | Computes the requested names, if only names were requested (and
179
-- with equality). Otherwise returns 'Nothing'.
180
requestedNames :: FilterField -> Filter FilterField -> Maybe [FilterValue]
181
requestedNames _ EmptyFilter = Just []
182
requestedNames namefield (OrFilter flts) =
183
  liftM concat $ mapM (requestedNames namefield) flts
184
requestedNames namefield (EQFilter fld val) =
185
  if namefield == fld
186
    then Just [val]
187
    else Nothing
188
requestedNames _ _ = Nothing
189

    
190
-- | Builds a simple filter from a list of names.
191
makeSimpleFilter :: String -> [String] -> Filter FilterField
192
makeSimpleFilter _ [] = EmptyFilter
193
makeSimpleFilter namefield vals =
194
  OrFilter $ map (EQFilter namefield . QuotedString) vals