2012/10/5 Iustin Pop <[email protected]>: > This replicates in the Haskell Query2 implementation the behaviour of > the Python code: if a "simple" filter is passed (one that contains > only Or aggregators and EQ binary ops on the name field), then an > failure is flagged if the given values are not known. > > Our implementation is pretty straightforward, with a few details: > > - we ignore any NumericValues passed, since that inconsistency will be > flagged by the filter compiler > - we return an the non-normalized names from the getRequestedNames > function, and not the fully-normalized ones; this will be done later > in individual query functions > - we test a few of the desired behaviours of the above-mentioned > function > > Signed-off-by: Iustin Pop <[email protected]> > --- > htest/Test/Ganeti/Query/Query.hs | 19 +++++++++++++++++++ > htools/Ganeti/Query/Filter.hs | 14 ++++++++++++++ > htools/Ganeti/Query/Query.hs | 27 +++++++++++++++++++++++++++ > 3 files changed, 60 insertions(+) > > diff --git a/htest/Test/Ganeti/Query/Query.hs > b/htest/Test/Ganeti/Query/Query.hs > index 74258ec..2090cd0 100644 > --- a/htest/Test/Ganeti/Query/Query.hs > +++ b/htest/Test/Ganeti/Query/Query.hs > @@ -210,6 +210,24 @@ case_queryGroup_allfields = do > (sortBy field_sort . map fst $ Map.elems groupFieldsMap) > (sortBy field_sort fdefs) > > + > +-- | Tests that requested names checking behaves as expected. > +prop_getRequestedNames :: Property > +prop_getRequestedNames = > + forAll getName $ \node1 -> > + let chk = getRequestedNames . Query QRNode [] > + q_node1 = QuotedString node1 > + eq_name = EQFilter "name" > + eq_node1 = eq_name q_node1 > + in conjoin [ printTestCase "empty filter" $ chk EmptyFilter ==? [] > + , printTestCase "and filter" $ chk (AndFilter [eq_node1]) ==? [] > + , printTestCase "simple equality" $ chk eq_node1 ==? [node1] > + , printTestCase "non-name field" $ > + chk (EQFilter "foo" q_node1) ==? [] > + , printTestCase "non-simple filter" $ > + chk (OrFilter [ eq_node1 , LTFilter "foo" q_node1]) ==? [] > + ] > + > testSuite "Query/Query" > [ 'prop_queryNode_noUnknown > , 'prop_queryNode_Unknown > @@ -219,4 +237,5 @@ testSuite "Query/Query" > , 'prop_queryGroup_Unknown > , 'prop_queryGroup_types > , 'case_queryGroup_allfields > + , 'prop_getRequestedNames > ] > diff --git a/htools/Ganeti/Query/Filter.hs b/htools/Ganeti/Query/Filter.hs > index 56e6a6a..24ce796 100644 > --- a/htools/Ganeti/Query/Filter.hs > +++ b/htools/Ganeti/Query/Filter.hs > @@ -47,9 +47,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, > MA > module Ganeti.Query.Filter > ( compileFilter > , evaluateFilter > + , requestedNames > ) where > > import Control.Applicative > +import Control.Monad (liftM) > import qualified Data.Map as Map > import Data.Traversable (traverse) > import Text.JSON (JSValue(..), fromJSString) > @@ -171,3 +173,15 @@ tryGetter _ rt item (FieldRuntime getter) = > maybe Nothing (\rt' -> Just $ getter rt' item) rt > tryGetter _ _ _ FieldUnknown = Just $ > ResultEntry RSUnknown Nothing > + > +-- | Computes the requested names, if only names were requested (and > +-- with equality). Otherwise returns 'Nothing'. > +requestedNames :: FilterField -> Filter FilterField -> Maybe [FilterValue] > +requestedNames _ EmptyFilter = Just [] > +requestedNames namefield (OrFilter flts) = > + liftM concat $ mapM (requestedNames namefield) flts > +requestedNames namefield (EQFilter fld val) = > + if namefield == fld > + then Just [val] > + else Nothing > +requestedNames _ _ = Nothing > diff --git a/htools/Ganeti/Query/Query.hs b/htools/Ganeti/Query/Query.hs > index ff7d33d..a17a920 100644 > --- a/htools/Ganeti/Query/Query.hs > +++ b/htools/Ganeti/Query/Query.hs > @@ -48,6 +48,7 @@ module Ganeti.Query.Query > > ( query > , queryFields > + , getRequestedNames > ) where > > import Control.Monad (filterM) > @@ -114,6 +115,32 @@ needsLiveData = any (\getter -> case getter of > FieldRuntime _ -> True > _ -> False) > > +-- | Checks whether we have requested exactly some names. This is a > +-- simple wrapper over 'requestedNames' and 'nameField'. > +needsNames :: Query -> Maybe [FilterValue] > +needsNames (Query kind _ qfilter) = requestedNames (nameField kind) qfilter > + > +-- | Computes the name field for different query types. > +nameField :: ItemType -> FilterField > +nameField QRJob = "id" > +nameField _ = "name" > + > +-- | Extracts all quoted strings from a list, ignoring the > +-- 'NumericValue' entries. > +getAllQuotedStrings :: [FilterValue] -> [String] > +getAllQuotedStrings = > + concatMap extractor > + where extractor (NumericValue _) = [] > + extractor (QuotedString val) = [val] > + > +-- | Checks that we have either requested a valid set of names, or we > +-- have a more complex filter. > +getRequestedNames :: Query -> [String] > +getRequestedNames qry = > + case needsNames qry of > + Just names -> getAllQuotedStrings names > + Nothing -> [] > + > -- | Main query execution function. > query :: ConfigData -- ^ The current configuration > -> Bool -- ^ Whether to collect live data > -- > 1.7.10.4 >
LGTM
