From 7f0fd83893f4f1f76f2128aa25f7ef5932029039 Mon Sep 17 00:00:00 2001
From: Agata Murawska <agatamurawska@google.com>
Date: Wed, 26 Sep 2012 17:21:26 +0200
Subject: [PATCH] Node query now collects live fields

We make use of the parameter added in the previous patch and add
option to add live parameters to the query.

Signed-off-by: Agata Murawska <agatamurawska@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>
---
 htools/Ganeti/Query/Node.hs  |  7 ++++---
 htools/Ganeti/Query/Query.hs | 35 +++++++++++++++++++++++++++++------
 2 files changed, 33 insertions(+), 9 deletions(-)

diff --git a/htools/Ganeti/Query/Node.hs b/htools/Ganeti/Query/Node.hs
index 965e0ebde..cc88b4f7a 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 af13c9cd2..a42cde6a7 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,25 +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.
+-- FIXME: Check which fields we actually need and possibly send empty
+-- hvs/vgs if no info from hypervisor/volume group respectively
+-- is required
+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 = any (\getter -> case getter of
+                     FieldRuntime _ -> True
+                     _ -> False)
+
 -- | 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
-- 
GitLab