Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Query / Filter.hs @ 7f0fd838

History | View | Annotate | Download (6.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 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
  ) where
51

    
52
import Control.Applicative
53
import qualified Data.Map as Map
54
import Data.Traversable (traverse)
55
import Text.JSON (JSValue(..), fromJSString)
56
import Text.JSON.Pretty (pp_value)
57
import qualified Text.Regex.PCRE as PCRE
58

    
59
import Ganeti.BasicTypes
60
import Ganeti.Objects
61
import Ganeti.Query.Language
62
import Ganeti.Query.Types
63
import Ganeti.JSON
64

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

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

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

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

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

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

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

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

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