2012/10/5 Iustin Pop <[email protected]>:
> 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 <[email protected]>
> ---
> htools/Ganeti/Query/Query.hs | 14 +++++++++++++-
> htools/Ganeti/Query/Server.hs | 20 ++++++++++++++++++++
> 2 files changed, 33 insertions(+), 1 deletion(-)
>
> diff --git a/htools/Ganeti/Query/Query.hs b/htools/Ganeti/Query/Query.hs
> index 23bdbbd..9dfcfa4 100644
> --- a/htools/Ganeti/Query/Query.hs
> +++ b/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
> @@ -211,3 +214,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
> diff --git a/htools/Ganeti/Query/Server.hs b/htools/Ganeti/Query/Server.hs
> index ca4409c..97ece0b 100644
> --- a/htools/Ganeti/Query/Server.hs
> +++ b/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"
>
> --
> 1.7.10.4
>
LGTM
