Commit 40246fa0 authored by Agata Murawska's avatar Agata Murawska

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: default avatarAgata Murawska <>
Reviewed-by: default avatarIustin Pop <>
parent e5cb098c
......@@ -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 \
{-| 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
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",
(\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" ++
-- | The group fields map.
groupFieldsMap :: FieldMap NodeGroup GroupRuntime
groupFieldsMap = Map.fromList $ map (\v -> (fdefName (fst v), v)) groupFields
......@@ -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
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"
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment