Implement Export queries in Haskell

This is a simple query as it has only two fields, however it's the
first query that doesn't have a clear 'base' object and 1:1
correspondence between such objects and the results (groups, nodes and
networks do so).

We keep nodes as the 'base' object, since that's what we want to
filter on for RPC selection, and we have a very simple type as the
runtime type, since we only have one other field. The
'collectLiveData' function is the one that does the expansion from
[node] to [(node, path)], with the help of 'rpcExtractor'.

Also, this patch introduces a slightly different naming structure for
the exported names out of the module, to reduce naming conflicts.

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>

Makefile.am

@@ -540,6 +540,7 @@ HS_LIB_SRCS = \
 	src/Ganeti/OpParams.hs \
 	src/Ganeti/Path.hs \
 	src/Ganeti/Query/Common.hs \
+	src/Ganeti/Query/Export.hs \
 	src/Ganeti/Query/Filter.hs \
 	src/Ganeti/Query/Group.hs \
 	src/Ganeti/Query/Job.hs \

src/Ganeti/Query/Export.hs

+{-| Implementation of the Ganeti Query2 export queries.
+
+ -}
+
+{-
+
+Copyright (C) 2013 Google Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.
+
+-}
+
+module Ganeti.Query.Export
+  ( Runtime
+  , fieldsMap
+  , collectLiveData
+  ) where
+
+import Control.Monad (liftM)
+import qualified Data.Map as Map
+
+import Ganeti.Objects
+import Ganeti.Rpc
+import Ganeti.Query.Language
+import Ganeti.Query.Common
+import Ganeti.Query.Types
+
+-- | The parsed result of the ExportList. This is a bit tricky, in
+-- that we already do parsing of the results in the RPC calls, so the
+-- runtime type is a plain 'ResultEntry', as we have just one type.
+type Runtime = ResultEntry
+
+-- | Small helper for rpc to rs.
+rpcErrToRs :: RpcError -> ResultEntry
+rpcErrToRs err = ResultEntry (rpcErrorToStatus err) Nothing
+
+-- | Helper for extracting fields from RPC result.
+rpcExtractor :: Node -> Either RpcError RpcResultExportList
+             -> [(Node, ResultEntry)]
+rpcExtractor node (Right res) =
+  [(node, rsNormal path) | path <- rpcResExportListExports res]
+rpcExtractor node (Left err)  = [(node, rpcErrToRs err)]
+
+-- | List of all node fields.
+exportFields :: FieldList Node Runtime
+exportFields =
+  [ (FieldDefinition "node" "Node" QFTText "Node name",
+     FieldSimple (rsNormal . nodeName), QffNormal)
+  , (FieldDefinition "export" "Export" QFTText "Export name",
+     FieldRuntime (curry fst), QffNormal)
+  ]
+
+-- | The node fields map.
+fieldsMap :: FieldMap Node Runtime
+fieldsMap =
+  Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) exportFields
+
+-- | Collect live data from RPC query if enabled.
+--
+-- Note that this function is \"funny\": the returned rows will not be
+-- 1:1 with the input, as nodes without exports will be pruned,
+-- whereas nodes with multiple exports will be listed multiple times.
+collectLiveData:: Bool -> ConfigData -> [Node] -> IO [(Node, Runtime)]
+collectLiveData False _ nodes =
+  return [(n, rpcErrToRs $ RpcResultError "Live data disabled") | n <- nodes]
+collectLiveData True _ nodes =
+  concatMap (uncurry rpcExtractor) `liftM`
+    executeRpcCall nodes RpcCallExportList

src/Ganeti/Query/Query.hs

@@ -4,7 +4,7 @@
 
 {-
 
-Copyright (C) 2012 Google Inc.
+Copyright (C) 2012, 2013 Google Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -67,6 +67,7 @@ import Ganeti.JQueue
 import Ganeti.JSON
 import Ganeti.Objects
 import Ganeti.Query.Common
+import qualified Ganeti.Query.Export as Export
 import Ganeti.Query.Filter
 import qualified Ganeti.Query.Job as Query.Job
 import Ganeti.Query.Group
@@ -117,6 +118,7 @@ needsNames (Query kind _ qfilter) = requestedNames (nameField kind) qfilter
 -- | Computes the name field for different query types.
 nameField :: ItemType -> FilterField
 nameField (ItemTypeLuxi QRJob) = "id"
+nameField (ItemTypeOpCode QRExport) = "node"
 nameField _ = "name"
 
 -- | Extracts all quoted strings from a list, ignoring the
@@ -215,6 +217,31 @@ queryInner cfg _ (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted =
                    fnetworks
   return QueryResult { qresFields = fdefs, qresData = fdata }
 
+queryInner cfg live (Query (ItemTypeOpCode QRExport) fields qfilter) wanted =
+  runResultT $ do
+  cfilter <- resultT $ compileFilter Export.fieldsMap qfilter
+  let selected = getSelectedFields Export.fieldsMap fields
+      (fdefs, fgetters, _) = unzip3 selected
+      -- we alwyas have live queries in exports, but we keep this for
+      -- standard style (in case we add static fields in the future)
+      live' = live && needsLiveData fgetters
+  nodes <- resultT $ case wanted of
+             [] -> Ok . niceSortKey nodeName .
+                   Map.elems . fromContainer $ configNodes cfg
+             _  -> mapM (getNode cfg) wanted
+  -- runs first pass of the filter, without a runtime context; this
+  -- will limit the nodes that we'll contact for exports
+  fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
+                      nodes
+  -- here we would run the runtime data gathering...
+  nruntimes <- lift $ Export.collectLiveData live' cfg fnodes
+  -- ... then filter again the results, based on existing export
+  -- names, but note that no client sends filters on the export list
+  -- today, so it's likely a no-oop
+  let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters)
+              nruntimes
+  return QueryResult { qresFields = fdefs, qresData = fdata }
+
 queryInner _ _ (Query qkind _ _) _ =
   return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
 
@@ -289,6 +316,9 @@ queryFields (QueryFields (ItemTypeOpCode QRGroup) fields) =
 queryFields (QueryFields (ItemTypeLuxi QRJob) fields) =
   Ok $ fieldsExtractor Query.Job.fieldsMap fields
 
+queryFields (QueryFields (ItemTypeOpCode QRExport) fields) =
+  Ok $ fieldsExtractor Export.fieldsMap fields
+
 queryFields (QueryFields qkind _) =
   Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported"