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:
diff --git a/htools/Ganeti/Query/Group.hs b/htools/Ganeti/Query/Group.hs
index b4fc758..b76d6c3 100644
--- a/htools/Ganeti/Query/Group.hs
+++ b/htools/Ganeti/Query/Group.hs
@@ -53,10 +53,8 @@ groupFields =
, (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)))
+ "Disk parameters (merged)", FieldSimple (\_ -> rsNoData))
, (FieldDefinition "ipolicy" "InstancePolicy" QFTOther
"Instance policy limitations (merged)",
FieldConfig (\cfg ng -> rsNormal (getGroupIpolicy cfg ng)))
diff --git a/htools/Ganeti/Query/Query.hs b/htools/Ganeti/Query/Query.hs
index 8fc4b4a..d348be1 100644
--- a/htools/Ganeti/Query/Query.hs
+++ b/htools/Ganeti/Query/Query.hs
@@ -128,6 +128,7 @@ 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
