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.
> + , (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.
> + 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.
LGTM after fixing rsNormal/rsNoData above.
thanks!
iustin
