Add support for classic queries

This patch adds support for classic-style queries (before query2) to
the query socket server. The patch is rather trivial, since as in
Python we just piggy-back on the query2 implementation.

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>

htools/Ganeti/Query/Query.hs

@@ -45,16 +45,19 @@ too.
 -}
 
 module Ganeti.Query.Query
-
     ( query
     , queryFields
+    , queryCompat
     , getRequestedNames
+    , nameField
     ) where
 
 import Control.Monad (filterM)
 import Control.Monad.Trans (lift)
+import Data.List (intercalate)
 import Data.Maybe (fromMaybe)
 import qualified Data.Map as Map
+import qualified Text.JSON as J
 
 import Ganeti.BasicTypes
 import Ganeti.Config
@@ -209,3 +212,12 @@ queryFields (QueryFields QRGroup fields) =
 
 queryFields (QueryFields qkind _) =
   Bad $ "QueryFields '" ++ show qkind ++ "' not supported"
+
+-- | Classic query converter. It gets a standard query result on input
+-- and computes the classic style results.
+queryCompat :: QueryResult -> Result [[J.JSValue]]
+queryCompat (QueryResult fields qrdata) =
+  case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
+    [] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
+    unknown -> Bad $ "Unknown output fields selected: " ++
+                     intercalate ", " unknown

htools/Ganeti/Query/Server.hs

@@ -51,11 +51,25 @@ import Ganeti.Logging
 import Ganeti.Luxi
 import qualified Ganeti.Query.Language as Qlang
 import Ganeti.Query.Query
+import Ganeti.Query.Filter (makeSimpleFilter)
 
 -- | A type for functions that can return the configuration when
 -- executed.
 type ConfigReader = IO (Result ConfigData)
 
+-- | Helper for classic queries.
+handleClassicQuery :: ConfigData      -- ^ Cluster config
+                   -> Qlang.ItemType  -- ^ Query type
+                   -> [String]        -- ^ Requested names (empty means all)
+                   -> [String]        -- ^ Requested fields
+                   -> Bool            -- ^ Whether to do sync queries or not
+                   -> IO (Result JSValue)
+handleClassicQuery _ _ _ _ True = return . Bad $ "Sync queries are not allowed"
+handleClassicQuery cfg qkind names fields _ = do
+  let flt = makeSimpleFilter (nameField qkind) names
+  qr <- query cfg True (Qlang.Query qkind fields flt)
+  return $ showJSON <$> (qr >>= queryCompat)
+
 -- | Minimal wrapper to handle the missing config case.
 handleCallWrapper :: Result ConfigData -> LuxiOp -> IO (Result JSValue)
 handleCallWrapper (Bad msg) _ =
@@ -136,6 +150,12 @@ handleCall _ (QueryFields qkind qfields) = do
   let result = queryFields (Qlang.QueryFields qkind qfields)
   return $ J.showJSON <$> result
 
+handleCall cfg (QueryNodes names fields lock) =
+  handleClassicQuery cfg Qlang.QRNode names fields lock
+
+handleCall cfg (QueryGroups names fields lock) =
+  handleClassicQuery cfg Qlang.QRGroup names fields lock
+
 handleCall _ op =
   return . Bad $ "Luxi call '" ++ strOfOp op ++ "' not implemented"