From 40246fa068e4de08dd719813fc1187de50d328f1 Mon Sep 17 00:00:00 2001
From: Agata Murawska <agatamurawska@google.com>
Date: Thu, 20 Sep 2012 15:16:21 +0200
Subject: [PATCH] NodeGroup query in Haskell
Implementation of nodegroup queries in Haskell. This is not yet
complete as we are missing merged disk parameters and option
want_diskparams is not implemented.
Signed-off-by: Agata Murawska <agatamurawska@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>
---
Makefile.am | 1 +
htools/Ganeti/Query/Group.hs | 87 ++++++++++++++++++++++++++++++++++++
htools/Ganeti/Query/Query.hs | 23 ++++++++++
3 files changed, 111 insertions(+)
create mode 100644 htools/Ganeti/Query/Group.hs
diff --git a/Makefile.am b/Makefile.am
index b1f3ab8c8..644bddf52 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -443,6 +443,7 @@ HS_LIB_SRCS = \
htools/Ganeti/Path.hs \
htools/Ganeti/Query/Common.hs \
htools/Ganeti/Query/Filter.hs \
+ htools/Ganeti/Query/Group.hs \
htools/Ganeti/Query/Language.hs \
htools/Ganeti/Query/Node.hs \
htools/Ganeti/Query/Query.hs \
diff --git a/htools/Ganeti/Query/Group.hs b/htools/Ganeti/Query/Group.hs
new file mode 100644
index 000000000..b76d6c3ea
--- /dev/null
+++ b/htools/Ganeti/Query/Group.hs
@@ -0,0 +1,87 @@
+{-| Implementation of the Ganeti Query2 node group queries.
+
+ -}
+
+{-
+
+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.Group
+ ( GroupRuntime(..)
+ , groupFieldsMap
+ ) where
+
+import qualified Data.Map as Map
+
+import Ganeti.Config
+import Ganeti.Objects
+import Ganeti.Query.Language
+import Ganeti.Query.Common
+import Ganeti.Query.Types
+
+-- | There is no runtime.
+data GroupRuntime = GroupRuntime
+
+groupFields :: FieldList NodeGroup GroupRuntime
+groupFields =
+ [ (FieldDefinition "alloc_policy" "AllocPolicy" QFTText
+ "Allocation policy for group",
+ FieldSimple (rsNormal . groupAllocPolicy))
+ , (FieldDefinition "custom_diskparams" "CustomDiskParameters" QFTOther
+ "Custom disk parameters",
+ FieldSimple (rsNormal . groupDiskparams))
+ , (FieldDefinition "custom_ipolicy" "CustomInstancePolicy" QFTOther
+ "Custom instance policy limitations",
+ FieldSimple (rsNormal . groupIpolicy))
+ , (FieldDefinition "custom_ndparams" "CustomNDParams" QFTOther
+ "Custom node parameters",
+ FieldSimple (rsNormal . groupNdparams))
+ , (FieldDefinition "diskparams" "DiskParameters" QFTOther
+ "Disk parameters (merged)", FieldSimple (\_ -> rsNoData))
+ , (FieldDefinition "ipolicy" "InstancePolicy" QFTOther
+ "Instance policy limitations (merged)",
+ FieldConfig (\cfg ng -> rsNormal (getGroupIpolicy cfg ng)))
+ , (FieldDefinition "name" "Group" QFTText "Group name",
+ FieldSimple (rsNormal . groupName))
+ , (FieldDefinition "ndparams" "NDParams" QFTOther "Node parameters",
+ FieldConfig (\cfg ng -> rsNormal (getGroupNdParams cfg ng)))
+ , (FieldDefinition "node_cnt" "Nodes" QFTNumber "Number of nodes",
+ FieldConfig (\cfg -> rsNormal . length . getGroupNodes cfg . groupName))
+ , (FieldDefinition "node_list" "NodeList" QFTOther "List of nodes",
+ FieldConfig (\cfg -> rsNormal . map nodeName .
+ getGroupNodes cfg . groupName))
+ , (FieldDefinition "pinst_cnt" "Instances" QFTNumber
+ "Number of primary instances",
+ FieldConfig
+ (\cfg -> rsNormal . length . fst . getGroupInstances cfg . groupName))
+ , (FieldDefinition "pinst_list" "InstanceList" QFTOther
+ "List of primary instances",
+ FieldConfig (\cfg -> rsNormal . map instName . fst .
+ getGroupInstances cfg . groupName))
+ ] ++
+ map buildNdParamField allNDParamFields ++
+ timeStampFields ++
+ uuidFields "Group" ++
+ serialFields "Group" ++
+ tagsFields
+
+-- | The group fields map.
+groupFieldsMap :: FieldMap NodeGroup GroupRuntime
+groupFieldsMap = Map.fromList $ map (\v -> (fdefName (fst v), v)) groupFields
diff --git a/htools/Ganeti/Query/Query.hs b/htools/Ganeti/Query/Query.hs
index 5b09c6393..d348be16c 100644
--- a/htools/Ganeti/Query/Query.hs
+++ b/htools/Ganeti/Query/Query.hs
@@ -61,6 +61,7 @@ import Ganeti.Query.Common
import Ganeti.Query.Filter
import Ganeti.Query.Types
import Ganeti.Query.Node
+import Ganeti.Query.Group
import Ganeti.Objects
-- * Helper functions
@@ -109,10 +110,25 @@ query cfg (Query QRNode fields qfilter) = return $ do
fnodes
return QueryResult { qresFields = fdefs, qresData = fdata }
+query cfg (Query QRGroup fields qfilter) = return $ do
+ -- FIXME: want_diskparams is defaulted to false and not taken as parameter
+ -- This is because the type for DiskParams is right now too generic for merges
+ -- (or else I cannot see how to do this with curent implementation)
+ cfilter <- compileFilter groupFieldsMap qfilter
+ let selected = getSelectedFields groupFieldsMap fields
+ (fdefs, fgetters) = unzip selected
+ groups = Map.elems . fromContainer $ configNodegroups cfg
+ -- there is no live data for groups, so filtering is much simpler
+ fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups
+ let fdata = map (\node ->
+ map (execGetter cfg GroupRuntime node) fgetters) fgroups
+ return QueryResult {qresFields = fdefs, qresData = fdata }
+
query _ (Query qkind _ _) =
return . Bad $ "Query '" ++ show qkind ++ "' not supported"
-- | Query fields call.
+-- FIXME: Looks generic enough to use a typeclass
queryFields :: QueryFields -> Result QueryFieldsResult
queryFields (QueryFields QRNode fields) =
let selected = if null fields
@@ -120,5 +136,12 @@ queryFields (QueryFields QRNode fields) =
else getSelectedFields nodeFieldsMap fields
in Ok $ QueryFieldsResult (map fst selected)
+queryFields (QueryFields QRGroup fields) =
+ let selected = if null fields
+ then map snd $ Map.toAscList groupFieldsMap
+ else getSelectedFields groupFieldsMap fields
+ in Ok $ QueryFieldsResult (map fst selected)
+
+
queryFields (QueryFields qkind _) =
Bad $ "QueryFields '" ++ show qkind ++ "' not supported"
--
GitLab