On Wed, Sep 26, 2012 at 02:31:09PM +0200, Agata Murawska wrote: > On Wed, Sep 26, 2012 at 9:39 AM, Iustin Pop <[email protected]> wrote: > > On Tue, Sep 25, 2012 at 06:43:47PM +0200, Agata Murawska wrote: > >> 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 > > > > Indeed, but I fear rsNormal is not good - this would fail unittests, I > > think. You need rsNoData. > Ack, fixed (though it didn't fail the tests we have for groups, just FYI ;) ) > > > > >> + , (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) > > > > This should be doable already with Ganeti/Objects/fillDict, which was > > added for this purpose. It's not yet used, so I don't know how well it > > works. Please commit as is for now and we'll see later about migrating > > to that. > Ack > > > > >> + 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) > > > > Hmm, this being identical to the QueryField QRNode one, it smells like a > > type class. Please add a FIXME, this should be generalisable easily. > Ack > > > > > LGTM after fixing rsNormal/rsNoData above. > > > > thanks! > > iustin > > Interdiff:
LGTM. FYI, I believe that "\_ -> foo" can usually be replaced by "const foo" (but I'm not sure 100% if ghc won't complain). iustin
