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>

diff --git a/htest/Test/Ganeti/Query/Query.hs b/htest/Test/Ganeti/Query/Query.hs
index 74258ec..2090cd0 100644 (file)
--- 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 (file)
--- 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 7a172ff..6134743 100644 (file)
--- 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