Commit c42fbe28 authored by Iustin Pop's avatar Iustin Pop Committed by Klaus Aehlig
Browse files

Fix bug in group queries related to node/instance fields



Since we use the primitive string type for group UUIDs, the group
fields have a bug where we pass the group name as filter for node
tests, whereas the nodes themselves use the group UUID. This results
in zero node count, empty node list, and no instances being reported
as assigned to groups.

The patch fixes this and adds a test for the node count. It does some
test generation improvement, and also cleans up whitespace issues in
Test/G/Q/Query.hs (the functions case_queryNode_allfields,
prop_queryGroup_noUnknown and case_queryGroup_allfields are unchanged
but simply have indentation fixed).
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>

Cherry-pick of e7124835

, fixes issue 436
Signed-off-by: default avatarKlaus Aehlig <aehlig@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>

Conflicts:
	test/hs/Test/Ganeti/Objects.hs
	test/hs/Test/Ganeti/Query/Query.hs
parent c54c859b
......@@ -64,20 +64,20 @@ groupFields =
, (FieldDefinition "ndparams" "NDParams" QFTOther "Node parameters",
FieldConfig (\cfg ng -> rsNormal (getGroupNdParams cfg ng)), QffNormal)
, (FieldDefinition "node_cnt" "Nodes" QFTNumber "Number of nodes",
FieldConfig (\cfg -> rsNormal . length . getGroupNodes cfg . groupName),
FieldConfig (\cfg -> rsNormal . length . getGroupNodes cfg . groupUuid),
QffNormal)
, (FieldDefinition "node_list" "NodeList" QFTOther "List of nodes",
FieldConfig (\cfg -> rsNormal . map nodeName .
getGroupNodes cfg . groupName), QffNormal)
getGroupNodes cfg . groupUuid), QffNormal)
, (FieldDefinition "pinst_cnt" "Instances" QFTNumber
"Number of primary instances",
FieldConfig
(\cfg -> rsNormal . length . fst . getGroupInstances cfg . groupName),
(\cfg -> rsNormal . length . fst . getGroupInstances cfg . groupUuid),
QffNormal)
, (FieldDefinition "pinst_list" "InstanceList" QFTOther
"List of primary instances",
FieldConfig (\cfg -> rsNormal . map instName . fst .
getGroupInstances cfg . groupName), QffNormal)
getGroupInstances cfg . groupUuid), QffNormal)
] ++
map buildNdParamField allNDParamFields ++
timeStampFields ++
......
......@@ -193,7 +193,8 @@ genEmptyCluster :: Int -> Gen ConfigData
genEmptyCluster ncount = do
nodes <- vector ncount
version <- arbitrary
let guuid = "00"
grp <- arbitrary
let guuid = groupUuid grp
nodes' = zipWith (\n idx ->
let newname = nodeName n ++ "-" ++ show idx
in (newname, n { nodeGroup = guuid,
......@@ -206,7 +207,6 @@ genEmptyCluster ncount = do
show (map fst nodes'))
else GenericContainer nodemap
continsts = GenericContainer Map.empty
grp <- arbitrary
let contgroups = GenericContainer $ Map.singleton guuid grp
serial <- arbitrary
cluster <- resize 8 arbitrary
......@@ -360,7 +360,7 @@ genNodeGroup = do
-- timestamp fields
ctime <- arbitrary
mtime <- arbitrary
uuid <- arbitrary
uuid <- genFQDN `suchThat` (/= name)
serial <- arbitrary
tags <- Set.fromList <$> genTags
let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams
......
......@@ -36,7 +36,7 @@ import Data.Function (on)
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import Text.JSON (JSValue(..))
import Text.JSON (JSValue(..), showJSON)
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
......@@ -235,6 +235,22 @@ case_queryGroup_allfields = do
(sortBy field_sort . map (\(f, _, _) -> f) $ Map.elems groupFieldsMap)
(sortBy field_sort fdefs)
-- | Check that the node count reported by a group list is sane.
--
-- FIXME: also verify the node list, etc.
prop_queryGroup_nodeCount :: Property
prop_queryGroup_nodeCount =
forAll (choose (0, maxNodes)) $ \nodes ->
forAll (genEmptyCluster nodes) $ \cluster -> monadicIO $
do
QueryResult _ fdata <-
run (query cluster False (Query (ItemTypeOpCode QRGroup)
["node_cnt"] EmptyFilter)) >>= resultProp
stop $ conjoin
[ printTestCase "Invalid node count" $
map (map rentryValue) fdata ==? [[Just (showJSON nodes)]]
]
-- ** Job queries
-- | Tests that querying any existing fields, via either query or
......@@ -317,6 +333,7 @@ testSuite "Query/Query"
, 'prop_queryGroup_Unknown
, 'prop_queryGroup_types
, 'case_queryGroup_allfields
, 'prop_queryGroup_nodeCount
, 'prop_queryJob_noUnknown
, 'prop_queryJob_Unknown
, 'prop_getRequestedNames
......
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