Commit 4cbe9bda authored by Iustin Pop's avatar Iustin Pop
Browse files

Stub query2 call integration into QueryD

This patch corrects the definitions in Qlang.hs to match what Python
expects on the wire; this means replacing some manual data type
definitions with 'buildObject' so that we get serialisation (and field
names) for free, adding (manually) JSON instances for types which are
not represented as objects in JSON, etc. Due to more TH usage, I had
to shift some definitions around, since TH breaks the "define in any
order" property (

).

After that, we simply add a call into the stub Query/Query.hs module
which, for all queries, responds with "query not supported". The
reason for the deep directory structure is because I want to separate
the functionality into multiple submodules, for smaller module size
and readability.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAgata Murawska <agatamurawska@google.com>
parent 9abbb084
......@@ -58,7 +58,8 @@ HTOOLS_DIRS = \
htools/Ganeti \
htools/Ganeti/Confd \
htools/Ganeti/HTools \
htools/Ganeti/HTools/Program
htools/Ganeti/HTools/Program \
htools/Ganeti/Query
DIRS = \
autotools \
......@@ -415,6 +416,7 @@ HS_LIB_SRCS = \
htools/Ganeti/OpCodes.hs \
htools/Ganeti/Rpc.hs \
htools/Ganeti/Qlang.hs \
htools/Ganeti/Query/Query.hs \
htools/Ganeti/Queryd.hs \
htools/Ganeti/Runtime.hs \
htools/Ganeti/Ssconf.hs \
......@@ -1464,6 +1466,7 @@ hs-apidoc: $(HS_BUILT_SRCS)
rm -rf $(APIDOC_HS_DIR)/*
@mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/HTools/Program
@mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/Confd
@mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/Query
$(HSCOLOUR) -print-css > $(APIDOC_HS_DIR)/Ganeti/hscolour.css
$(LN_S) ../hscolour.css $(APIDOC_HS_DIR)/Ganeti/HTools/hscolour.css
$(LN_S) ../hscolour.css $(APIDOC_HS_DIR)/Ganeti/Confd/hscolour.css
......
......@@ -28,12 +28,15 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.Qlang
( Filter(..)
, FilterValue(..)
, Fields
, Query(..)
, QueryResult(..)
, QueryFields(..)
, QueryFieldsResult(..)
, FieldType(..)
, FieldDefinition(..)
, ResultEntry(..)
, ResultStatus(..)
, ItemType(..)
, checkRS
) where
......@@ -46,6 +49,7 @@ import Text.JSON
import qualified Ganeti.Constants as C
import Ganeti.THH
import Ganeti.HTools.JSON
-- * THH declarations, that require ordering.
......@@ -93,21 +97,6 @@ $(declareSADT "ItemType"
])
$(makeJSONInstance ''ItemType)
-- * Main Qlang queries and responses.
-- | Query2 query.
data Query = Query ItemType Fields (Maybe Filter)
-- | Query2 result.
data QueryResult = QueryResult [ FieldDefinition ] [ ResultEntry ]
-- | Query2 Fields query.
-- (to get supported fields names, descriptions, and types)
data QueryFields = QueryFields ItemType Fields
-- | Query2 Fields result.
data QueryFieldsResult = QueryFieldsResult [ FieldDefinition ]
-- * Sub data types for query2 queries and responses.
-- | List of requested fields.
......@@ -249,9 +238,6 @@ instance JSON FilterValue where
-- | Regexp to apply to the filter value, for filteriong purposes.
type FilterRegexp = String
-- | Definition of a field.
data FieldDefinition = FieldDefinition FieldName FieldTitle FieldType FieldDoc
-- | Name of a field.
type FieldName = String
-- | Title of a field, when represented in tabular format.
......@@ -259,9 +245,49 @@ type FieldTitle = String
-- | Human redable description of a field.
type FieldDoc = String
-- | Definition of a field.
$(buildObject "FieldDefinition" "fdef"
[ simpleField "name" [t| FieldName |] -- FIXME: the name has restrictions
, simpleField "title" [t| FieldTitle |]
, simpleField "kind" [t| FieldType |]
, simpleField "doc" [t| FieldDoc |]
])
--- | Single field entry result.
data ResultEntry = ResultEntry ResultStatus (Maybe ResultValue)
deriving (Show, Read, Eq)
instance JSON ResultEntry where
showJSON (ResultEntry rs rv) =
showJSON (showJSON rs, maybe JSNull showJSON rv)
readJSON v = do
(rs, rv) <- readJSON v
rv' <- case rv of
JSNull -> return Nothing
x -> readJSON x
return $ ResultEntry rs rv'
-- | The type of one result row.
type ResultRow = [ ResultEntry ]
-- | Value of a field, in json encoding.
-- (its type will be depending on ResultStatus and FieldType)
type ResultValue = JSValue
-- * Main Qlang queries and responses.
-- | Query2 query.
data Query = Query ItemType Fields Filter
-- | Query2 result.
$(buildObject "QueryResult" "qres"
[ simpleField "fields" [t| [ FieldDefinition ] |]
, simpleField "data" [t| [ ResultRow ] |]
])
-- | Query2 Fields query.
-- (to get supported fields names, descriptions, and types)
data QueryFields = QueryFields ItemType Fields
-- | Query2 Fields result.
data QueryFieldsResult = QueryFieldsResult [ FieldDefinition ]
{-| Implementation of the Ganeti Query2 functionality.
-}
{-
Copyright (C) 2012 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.Query
( query
) where
import Ganeti.BasicTypes
import Ganeti.Qlang
import Ganeti.Objects
-- | Main query execution function.
query :: ConfigData -- ^ The current configuration
-> Query -- ^ The query (item, fields, filter)
-> IO (Result QueryResult) -- ^ Result
query _ (Query qkind _ _) =
return . Bad $ "Query '" ++ show qkind ++ "' not supported"
......@@ -48,7 +48,8 @@ import qualified Ganeti.Config as Config
import Ganeti.BasicTypes
import Ganeti.Logging
import Ganeti.Luxi
import qualified Ganeti.Qlang as Qlang
import Ganeti.Query.Query
-- | A type for functions that can return the configuration when
-- executed.
......@@ -126,6 +127,10 @@ handleCall cfg (QueryTags kind name) =
TagInstance -> instTags <$> Config.getInstance cfg name
in return (J.showJSON <$> tags)
handleCall cfg (Query qkind qfields qfilter) = do
result <- query cfg (Qlang.Query qkind qfields qfilter)
return $ J.showJSON <$> result
handleCall _ op =
return . Bad $ "Luxi call '" ++ strOfOp op ++ "' not implemented"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment