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