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, 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