code.grnet.gr Git - ganeti-local/blob - src/Ganeti/Query/Filter.hs

   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.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 QffTimestamp v =
  83   case v of
  84     JSArray [secs@(JSRational _ _), JSRational _ _] -> return secs
  85     _ -> Bad $ ProgrammerError
  86          "Internal error: Getter returned non-timestamp for QffTimestamp"
  87
  88 -- | Wraps a getter, filter pair. If the getter is 'FieldRuntime' but
  89 -- we don't have a runtime context, we skip the filtering, returning
  90 -- \"pass\". Otherwise, we pass the actual value to the filter.
  91 wrapGetter :: ConfigData
  92            -> Maybe b
  93            -> a
  94            -> (FieldGetter a b, QffMode)
  95            -> (JSValue -> ErrorResult Bool)
  96            -> ErrorResult Bool
  97 wrapGetter cfg b a (getter, qff) faction =
  98   case tryGetter cfg b a getter of
  99     Nothing -> Ok True -- runtime missing, accepting the value
 100     Just v ->
 101       case v of
 102         ResultEntry RSNormal (Just fval) -> qffField qff fval >>= faction
 103         ResultEntry RSNormal Nothing ->
 104           Bad $ ProgrammerError
 105                 "Internal error: Getter returned RSNormal/Nothing"
 106         _ -> Ok True -- filter has no data to work, accepting it
 107
 108 -- | Helper to evaluate a filter getter (and the value it generates) in
 109 -- a boolean context.
 110 trueFilter :: JSValue -> ErrorResult Bool
 111 trueFilter (JSBool x) = Ok $! x
 112 trueFilter v = Bad . ParameterError $
 113                "Unexpected value '" ++ show (pp_value v) ++
 114                "' in boolean context"
 115
 116 -- | A type synonim for a rank-2 comparator function. This is used so
 117 -- that we can pass the usual '<=', '>', '==' functions to 'binOpFilter'
 118 -- and for them to be used in multiple contexts.
 119 type Comparator = (Eq a, Ord a) => a -> a -> Bool
 120
 121 -- | Helper to evaluate a filder getter (and the value it generates)
 122 -- in a boolean context. Note the order of arguments is reversed from
 123 -- the filter definitions (due to the call chain), make sure to
 124 -- compare in the reverse order too!.
 125 binOpFilter :: Comparator -> FilterValue -> JSValue -> ErrorResult Bool
 126 binOpFilter comp (QuotedString y) (JSString x) =
 127   Ok $! fromJSString x `comp` y
 128 binOpFilter comp (NumericValue y) (JSRational _ x) =
 129   Ok $! x `comp` fromIntegral y
 130 binOpFilter _ expr actual =
 131   Bad . ParameterError $ "Invalid types in comparison, trying to compare " ++
 132       show (pp_value actual) ++ " with '" ++ show expr ++ "'"
 133
 134 -- | Implements the 'RegexpFilter' matching.
 135 regexpFilter :: FilterRegex -> JSValue -> ErrorResult Bool
 136 regexpFilter re (JSString val) =
 137   Ok $! PCRE.match (compiledRegex re) (fromJSString val)
 138 regexpFilter _ x =
 139   Bad . ParameterError $ "Invalid field value used in regexp matching,\
 140         \ expecting string but got '" ++ show (pp_value x) ++ "'"
 141
 142 -- | Implements the 'ContainsFilter' matching.
 143 containsFilter :: FilterValue -> JSValue -> ErrorResult Bool
 144 -- note: the next two implementations are the same, but we have to
 145 -- repeat them due to the encapsulation done by FilterValue
 146 containsFilter (QuotedString val) lst = do
 147   lst' <- fromJVal lst
 148   return $! val `elem` lst'
 149 containsFilter (NumericValue val) lst = do
 150   lst' <- fromJVal lst
 151   return $! val `elem` lst'
 152
 153 -- | Verifies if a given item passes a filter. The runtime context
 154 -- might be missing, in which case most of the filters will consider
 155 -- this as passing the filter.
 156 --
 157 -- Note: we use explicit recursion to reduce unneeded memory use;
 158 -- 'any' and 'all' do not play nice with monadic values, resulting in
 159 -- either too much memory use or in too many thunks being created.
 160 evaluateFilter :: ConfigData -> Maybe b -> a
 161                -> Filter (FieldGetter a b, QffMode)
 162                -> ErrorResult Bool
 163 evaluateFilter _ _  _ EmptyFilter = Ok True
 164 evaluateFilter c mb a (AndFilter flts) = helper flts
 165   where helper [] = Ok True
 166         helper (f:fs) = do
 167           v <- evaluateFilter c mb a f
 168           if v
 169             then helper fs
 170             else Ok False
 171 evaluateFilter c mb a (OrFilter flts) = helper flts
 172   where helper [] = Ok False
 173         helper (f:fs) = do
 174           v <- evaluateFilter c mb a f
 175           if v
 176             then Ok True
 177             else helper fs
 178 evaluateFilter c mb a (NotFilter flt)  =
 179   not <$> evaluateFilter c mb a flt
 180 evaluateFilter c mb a (TrueFilter getter)  =
 181   wrapGetter c mb a getter trueFilter
 182 evaluateFilter c mb a (EQFilter getter val) =
 183   wrapGetter c mb a getter (binOpFilter (==) val)
 184 evaluateFilter c mb a (LTFilter getter val) =
 185   wrapGetter c mb a getter (binOpFilter (<) val)
 186 evaluateFilter c mb a (LEFilter getter val) =
 187   wrapGetter c mb a getter (binOpFilter (<=) val)
 188 evaluateFilter c mb a (GTFilter getter val) =
 189   wrapGetter c mb a getter (binOpFilter (>) val)
 190 evaluateFilter c mb a (GEFilter getter val) =
 191   wrapGetter c mb a getter (binOpFilter (>=) val)
 192 evaluateFilter c mb a (RegexpFilter getter re) =
 193   wrapGetter c mb a getter (regexpFilter re)
 194 evaluateFilter c mb a (ContainsFilter getter val) =
 195   wrapGetter c mb a getter (containsFilter val)
 196
 197 -- | Runs a getter with potentially missing runtime context.
 198 tryGetter :: ConfigData -> Maybe b -> a -> FieldGetter a b -> Maybe ResultEntry
 199 tryGetter _   _ item (FieldSimple getter)  = Just $ getter item
 200 tryGetter cfg _ item (FieldConfig getter)  = Just $ getter cfg item
 201 tryGetter _  rt item (FieldRuntime getter) =
 202   maybe Nothing (\rt' -> Just $ getter rt' item) rt
 203 tryGetter _   _ _    FieldUnknown          = Just $
 204                                              ResultEntry RSUnknown Nothing
 205
 206 -- | Computes the requested names, if only names were requested (and
 207 -- with equality). Otherwise returns 'Nothing'.
 208 requestedNames :: FilterField -> Filter FilterField -> Maybe [FilterValue]
 209 requestedNames _ EmptyFilter = Just []
 210 requestedNames namefield (OrFilter flts) =
 211   liftM concat $ mapM (requestedNames namefield) flts
 212 requestedNames namefield (EQFilter fld val) =
 213   if namefield == fld
 214     then Just [val]
 215     else Nothing
 216 requestedNames _ _ = Nothing
 217
 218 -- | Builds a simple filter from a list of names.
 219 makeSimpleFilter :: String -> [Either String Integer] -> Filter FilterField
 220 makeSimpleFilter _ [] = EmptyFilter
 221 makeSimpleFilter namefield vals =
 222   OrFilter $ map (EQFilter namefield . either QuotedString NumericValue) vals