The tests we currently have assume, that all the data required for
running the query is available - once we add live data, this will no
longer be the case.

This patch adds boolean parameter to query function, which tells it
whether to ignore live parameters gathering.

Signed-off-by: Agata Murawska <[email protected]>
---
 htest/Test/Ganeti/Query/Filter.hs |    4 ++--
 htest/Test/Ganeti/Query/Query.hs  |   12 ++++++------
 htools/Ganeti/Query/Node.hs       |    7 ++++---
 htools/Ganeti/Query/Query.hs      |   37 +++++++++++++++++++++++++++++--------
 htools/Ganeti/Query/Server.hs     |    2 +-
 5 files changed, 42 insertions(+), 20 deletions(-)

diff --git a/htest/Test/Ganeti/Query/Filter.hs 
b/htest/Test/Ganeti/Query/Filter.hs
index 841173d..1e99297 100644
--- a/htest/Test/Ganeti/Query/Filter.hs
+++ b/htest/Test/Ganeti/Query/Filter.hs
@@ -51,7 +51,7 @@ import Ganeti.Query.Query
 checkQueryResults :: ConfigData -> Query -> String
                   -> [[ResultEntry]] -> Property
 checkQueryResults cfg qr descr expected = monadicIO $ do
-  result <- run (query cfg qr) >>= resultProp
+  result <- run (query cfg False qr) >>= resultProp
   stop $ printTestCase ("Inconsistent results in " ++ descr)
          (qresData result ==? expected)
 
@@ -62,7 +62,7 @@ makeNodeQuery = Query QRNode ["name"]
 -- | Checks if a given operation failed.
 expectBadQuery :: ConfigData -> Query -> String -> Property
 expectBadQuery cfg qr descr = monadicIO $ do
-  result <- run (query cfg qr)
+  result <- run (query cfg False qr)
   case result of
     Bad _ -> return ()
     Ok a  -> stop . failTest $ "Expected failure in " ++ descr ++
diff --git a/htest/Test/Ganeti/Query/Query.hs b/htest/Test/Ganeti/Query/Query.hs
index d2eac1b..74258ec 100644
--- a/htest/Test/Ganeti/Query/Query.hs
+++ b/htest/Test/Ganeti/Query/Query.hs
@@ -65,7 +65,7 @@ prop_queryNode_noUnknown =
   forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
   forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do
   QueryResult fdefs fdata <-
-    run (query cluster (Query QRNode [field] EmptyFilter)) >>= resultProp
+    run (query cluster False (Query QRNode [field] EmptyFilter)) >>= resultProp
   QueryFieldsResult fdefs' <-
     resultProp $ queryFields (QueryFields QRNode [field])
   stop $ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
@@ -83,7 +83,7 @@ prop_queryNode_Unknown =
   forAll (arbitrary `suchThat` (`notElem` Map.keys nodeFieldsMap))
     $ \field -> monadicIO $ do
   QueryResult fdefs fdata <-
-    run (query cluster (Query QRNode [field] EmptyFilter)) >>= resultProp
+    run (query cluster False (Query QRNode [field] EmptyFilter)) >>= resultProp
   QueryFieldsResult fdefs' <-
     resultProp $ queryFields (QueryFields QRNode [field])
   stop $ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
@@ -127,7 +127,7 @@ prop_queryNode_types =
   forAll (genEmptyCluster numnodes) $ \cfg ->
   forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do
   QueryResult fdefs fdata <-
-    run (query cfg (Query QRNode [field] EmptyFilter)) >>= resultProp
+    run (query cfg False (Query QRNode [field] EmptyFilter)) >>= resultProp
   stop $ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
          (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) .&&.
          printTestCase "Wrong field definitions length"
@@ -155,7 +155,7 @@ prop_queryGroup_noUnknown =
   forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
    forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do
    QueryResult fdefs fdata <-
-     run (query cluster (Query QRGroup [field] EmptyFilter)) >>= resultProp
+     run (query cluster False (Query QRGroup [field] EmptyFilter)) >>= 
resultProp
    QueryFieldsResult fdefs' <-
      resultProp $ queryFields (QueryFields QRGroup [field])
    stop $ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
@@ -172,7 +172,7 @@ prop_queryGroup_Unknown =
   forAll (arbitrary `suchThat` (`notElem` Map.keys groupFieldsMap))
     $ \field -> monadicIO $ do
   QueryResult fdefs fdata <-
-    run (query cluster (Query QRGroup [field] EmptyFilter)) >>= resultProp
+    run (query cluster False (Query QRGroup [field] EmptyFilter)) >>= 
resultProp
   QueryFieldsResult fdefs' <-
     resultProp $ queryFields (QueryFields QRGroup [field])
   stop $ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
@@ -192,7 +192,7 @@ prop_queryGroup_types =
   forAll (genEmptyCluster numnodes) $ \cfg ->
   forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do
   QueryResult fdefs fdata <-
-    run (query cfg (Query QRGroup [field] EmptyFilter)) >>= resultProp
+    run (query cfg False (Query QRGroup [field] EmptyFilter)) >>= resultProp
   stop $ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
          (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) .&&.
          printTestCase "Wrong field definitions length"
diff --git a/htools/Ganeti/Query/Node.hs b/htools/Ganeti/Query/Node.hs
index 965e0eb..cc88b4f 100644
--- a/htools/Ganeti/Query/Node.hs
+++ b/htools/Ganeti/Query/Node.hs
@@ -24,7 +24,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 -}
 
 module Ganeti.Query.Node
-  ( NodeRuntime(..)
+  ( NodeRuntime
   , nodeFieldsMap
   ) where
 
@@ -34,12 +34,13 @@ import qualified Data.Map as Map
 
 import Ganeti.Config
 import Ganeti.Objects
+import Ganeti.Rpc
 import Ganeti.Query.Language
 import Ganeti.Query.Common
 import Ganeti.Query.Types
 
--- | Stub data type until we integrate the RPC.
-data NodeRuntime = NodeRuntime
+-- | NodeRuntime is the resulting type for NodeInfo call.
+type NodeRuntime = Either RpcError RpcResultNodeInfo
 
 -- | List of node live fields, all ignored for now (no RPC).
 nodeLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)]
diff --git a/htools/Ganeti/Query/Query.hs b/htools/Ganeti/Query/Query.hs
index 8fc4b4a..865e8fa 100644
--- a/htools/Ganeti/Query/Query.hs
+++ b/htools/Ganeti/Query/Query.hs
@@ -51,11 +51,13 @@ module Ganeti.Query.Query
     ) where
 
 import Control.Monad (filterM)
+import Control.Monad.Trans (lift)
 import Data.Maybe (fromMaybe)
 import qualified Data.Map as Map
 
 import Ganeti.BasicTypes
 import Ganeti.JSON
+import Ganeti.Rpc
 import Ganeti.Query.Language
 import Ganeti.Query.Common
 import Ganeti.Query.Filter
@@ -90,27 +92,46 @@ getSelectedFields :: FieldMap a b  -- ^ Defined fields
 getSelectedFields defined =
   map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined)
 
+-- | Collect live data from RPC query if enabled.
+maybeCollectLiveData:: Bool -> ConfigData -> [Node] -> IO [(Node, NodeRuntime)]
+
+maybeCollectLiveData False _ nodes =
+  return $ zip nodes (repeat $ Left (RpcResultError "Live data disabled"))
+
+maybeCollectLiveData True cfg nodes = do
+  let vgs = [clusterVolumeGroupName $ configCluster cfg]
+      hvs = clusterEnabledHypervisors $ configCluster cfg
+  executeRpcCall nodes (RpcCallNodeInfo vgs hvs)
+
+-- | Check whether list of queried fields contains live fields.
+needsLiveData :: [FieldGetter a b] -> Bool
+needsLiveData [] = False
+needsLiveData (FieldRuntime _:_) = True
+needsLiveData (_:xs) = needsLiveData xs
+
 -- | Main query execution function.
 query :: ConfigData   -- ^ The current configuration
+      -> Bool         -- ^ Whether to collect live data
       -> Query        -- ^ The query (item, fields, filter)
       -> IO (Result QueryResult) -- ^ Result
 
-query cfg (Query QRNode fields qfilter) = return $ do
-  cfilter <- compileFilter nodeFieldsMap qfilter
+query cfg live (Query QRNode fields qfilter) =  runResultT $ do
+  cfilter <- resultT $ compileFilter nodeFieldsMap qfilter
   let selected = getSelectedFields nodeFieldsMap fields
       (fdefs, fgetters) = unzip selected
       nodes = Map.elems . fromContainer $ configNodes cfg
+      live' = live && needsLiveData fgetters
   -- runs first pass of the filter, without a runtime context; this
   -- will limit the nodes that we'll contact for runtime data
-  fnodes <- filterM (\n -> evaluateFilter cfg Nothing n cfilter)
-            nodes
+  fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter) 
nodes
   -- here we would run the runtime data gathering, then filter again
   -- the nodes, based on existing runtime data
-  let fdata = map (\node -> map (execGetter cfg NodeRuntime node) fgetters)
-              fnodes
+  nruntimes <- lift $ maybeCollectLiveData live' cfg fnodes
+  let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters)
+              nruntimes
   return QueryResult { qresFields = fdefs, qresData = fdata }
 
-query cfg (Query QRGroup fields qfilter) = return $ do
+query cfg _ (Query QRGroup fields qfilter) = return $ do
   -- FIXME: want_diskparams is defaulted to false and not taken as parameter
   -- This is because the type for DiskParams is right now too generic for 
merges
   -- (or else I cannot see how to do this with curent implementation)
@@ -124,7 +145,7 @@ query cfg (Query QRGroup fields qfilter) = return $ do
                        map (execGetter cfg GroupRuntime node) fgetters) fgroups
   return QueryResult {qresFields = fdefs, qresData = fdata }
 
-query _ (Query qkind _ _) =
+query _ _ (Query qkind _ _) =
   return . Bad $ "Query '" ++ show qkind ++ "' not supported"
 
 -- | Query fields call.
diff --git a/htools/Ganeti/Query/Server.hs b/htools/Ganeti/Query/Server.hs
index ff940dd..ca4409c 100644
--- a/htools/Ganeti/Query/Server.hs
+++ b/htools/Ganeti/Query/Server.hs
@@ -129,7 +129,7 @@ handleCall cfg (QueryTags kind name) =
   in return (J.showJSON <$> tags)
 
 handleCall cfg (Query qkind qfields qfilter) = do
-  result <- query cfg (Qlang.Query qkind qfields qfilter)
+  result <- query cfg True (Qlang.Query qkind qfields qfilter)
   return $ J.showJSON <$> result
 
 handleCall _ (QueryFields qkind qfields) = do
-- 
1.7.7.3

Reply via email to