diff --git a/htools/Ganeti/Query/Node.hs b/htools/Ganeti/Query/Node.hs index 965e0ebde131e917b8e7371470049211f29e2f44..cc88b4f7a52ccb015127b1d280329891dc2ff919 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 af13c9cd24b8d3d83a4065fb15607399e99a9b5d..a42cde6a7c76a51a12264e30b92e9d242807a317 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