diff --git a/htest/Test/Ganeti/Query/Query.hs b/htest/Test/Ganeti/Query/Query.hs index 74258ec62beb80b8952b7b251eebc035f505668a..2090cd0b49dd2eef0b40da24dd1663ffc3a08b1c 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 56e6a6af0086e0a89068e1b84a4e1b7101d41fc5..24ce79639d14cf76af5e4d44416f226bf2888a7d 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 7a172ff933339c3c424bc365f493210797ac1b50..61347431059abd85ffc39d27961dc18f637843fb 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