From bc4cdeeffc04064af933f7e6e7b22c71e90ee9b7 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Wed, 3 Oct 2012 00:39:11 +0100
Subject: [PATCH] Add functionality for checking validity of names
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 <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>
---
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 74258ec62..2090cd0b4 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 56e6a6af0..24ce79639 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 7a172ff93..613474310 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)
@@ -113,6 +114,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
--
GitLab