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 <[email protected]> --- Makefile.am | 1 + htools/Ganeti/Query/Group.hs | 89 ++++++++++++++++++++++++++++++++++++++++++ htools/Ganeti/Query/Query.hs | 22 ++++++++++ 3 files changed, 112 insertions(+), 0 deletions(-) create mode 100644 htools/Ganeti/Query/Group.hs diff --git a/Makefile.am b/Makefile.am index 7ae24ef..1e13fdb 100644 --- a/Makefile.am +++ b/Makefile.am @@ -434,6 +434,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 0000000..b4fc758 --- /dev/null +++ b/htools/Ganeti/Query/Group.hs @@ -0,0 +1,89 @@ +{-| 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)) + -- This is deliberate - I do not think we want to have RSUnknown here + , (FieldDefinition "diskparams" "DiskParameters" QFTOther + "Disk parameters (merged)", + FieldSimple (\ _ -> rsNormal (Nothing:: Maybe DiskParams))) + , (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 5b09c63..8fc4b4a 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,6 +110,20 @@ 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" @@ -120,5 +135,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" -- 1.7.7.3
