From 4cbe9bdad69c67c584bc73f43d3e690a4ad83f9b Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Thu, 23 Aug 2012 23:12:30 +0200
Subject: [PATCH] Stub query2 call integration into QueryD
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
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: Iustin Pop <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>
---
Makefile.am | 5 ++-
htools/Ganeti/Qlang.hs | 62 +++++++++++++++++++++++++-----------
htools/Ganeti/Query/Query.hs | 39 +++++++++++++++++++++++
htools/Ganeti/Queryd.hs | 7 +++-
4 files changed, 93 insertions(+), 20 deletions(-)
create mode 100644 htools/Ganeti/Query/Query.hs
diff --git a/Makefile.am b/Makefile.am
index 54f027030..b94c0e3dd 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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
diff --git a/htools/Ganeti/Qlang.hs b/htools/Ganeti/Qlang.hs
index b88a05e63..9ff43e745 100644
--- a/htools/Ganeti/Qlang.hs
+++ b/htools/Ganeti/Qlang.hs
@@ -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 ]
diff --git a/htools/Ganeti/Query/Query.hs b/htools/Ganeti/Query/Query.hs
new file mode 100644
index 000000000..6cf7093cd
--- /dev/null
+++ b/htools/Ganeti/Query/Query.hs
@@ -0,0 +1,39 @@
+{-| 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"
diff --git a/htools/Ganeti/Queryd.hs b/htools/Ganeti/Queryd.hs
index 2e421e73a..72bb2e7fc 100644
--- a/htools/Ganeti/Queryd.hs
+++ b/htools/Ganeti/Queryd.hs
@@ -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"
--
GitLab