Revision 2d52359b htest/Test/Ganeti/Query/Filter.hs
| b/htest/Test/Ganeti/Query/Filter.hs | ||
|---|---|---|
| 70 | 70 |
Ok a -> stop . failTest $ "Expected failure in " ++ descr ++ |
| 71 | 71 |
" but got " ++ show a |
| 72 | 72 |
|
| 73 |
-- | A helper to construct a list of results from an expected names list. |
|
| 74 |
namesToResult :: [String] -> [[ResultEntry]] |
|
| 75 |
namesToResult = map ((:[]) . ResultEntry RSNormal . Just . showJSON) |
|
| 76 |
|
|
| 77 |
-- | Generates a cluster and returns its node names too. |
|
| 78 |
genClusterNames :: Int -> Int -> Gen (ConfigData, [String]) |
|
| 79 |
genClusterNames min_nodes max_nodes = do |
|
| 80 |
numnodes <- choose (min_nodes, max_nodes) |
|
| 81 |
cfg <- genEmptyCluster numnodes |
|
| 82 |
return (cfg, niceSort . Map.keys . fromContainer $ configNodes cfg) |
|
| 83 |
|
|
| 73 | 84 |
-- * Test cases |
| 74 | 85 |
|
| 75 | 86 |
-- | Tests single node filtering: eq should return it, and (lt and gt) |
| 76 | 87 |
-- should fail. |
| 77 | 88 |
prop_node_single_filter :: Property |
| 78 | 89 |
prop_node_single_filter = |
| 79 |
forAll (choose (1, maxNodes)) $ \numnodes -> |
|
| 80 |
forAll (genEmptyCluster numnodes) $ \cfg -> |
|
| 81 |
let allnodes = niceSort . Map.keys . fromContainer $ configNodes cfg in |
|
| 90 |
forAll (genClusterNames 1 maxNodes) $ \(cfg, allnodes) -> |
|
| 82 | 91 |
forAll (elements allnodes) $ \nname -> |
| 83 | 92 |
let fvalue = QuotedString nname |
| 84 | 93 |
buildflt n = n "name" fvalue |
| 85 |
expsingle = [[ResultEntry RSNormal (Just (showJSON nname))]]
|
|
| 94 |
expsingle = namesToResult [nname]
|
|
| 86 | 95 |
othernodes = nname `delete` allnodes |
| 87 |
expnot = map ((:[]) . ResultEntry RSNormal . Just . showJSON) othernodes
|
|
| 96 |
expnot = namesToResult othernodes
|
|
| 88 | 97 |
test_query = checkQueryResults cfg . makeNodeQuery |
| 89 | 98 |
in conjoin |
| 90 | 99 |
[ test_query (buildflt EQFilter) "single-name 'EQ' filter" expsingle |
| ... | ... | |
| 102 | 111 |
-- the 'AndFilter' case breaks. |
| 103 | 112 |
prop_node_many_filter :: Property |
| 104 | 113 |
prop_node_many_filter = |
| 105 |
forAll (choose (2, maxNodes)) $ \numnodes -> |
|
| 106 |
forAll (genEmptyCluster numnodes) $ \cfg -> |
|
| 107 |
let nnames = niceSort . Map.keys . fromContainer $ configNodes cfg |
|
| 108 |
eqfilter = map (EQFilter "name" . QuotedString) nnames |
|
| 109 |
alln = map ((:[]) . ResultEntry RSNormal . Just . showJSON) nnames |
|
| 114 |
forAll (genClusterNames 2 maxNodes) $ \(cfg, nnames) -> |
|
| 115 |
let eqfilter = map (EQFilter "name" . QuotedString) nnames |
|
| 116 |
alln = namesToResult nnames |
|
| 110 | 117 |
test_query = checkQueryResults cfg . makeNodeQuery |
| 111 | 118 |
num_zero = NumericValue 0 |
| 112 | 119 |
in conjoin |
| ... | ... | |
| 118 | 125 |
, test_query (GTFilter "sinst_cnt" num_zero) "sinst_cnt 'GT' 0" [] |
| 119 | 126 |
] |
| 120 | 127 |
|
| 128 |
-- | Tests name ordering consistency: requesting a 'simple filter' |
|
| 129 |
-- results in identical name ordering as the wanted names, requesting |
|
| 130 |
-- a more complex filter results in a niceSort-ed order. |
|
| 131 |
prop_node_name_ordering :: Property |
|
| 132 |
prop_node_name_ordering = |
|
| 133 |
forAll (genClusterNames 2 6) $ \(cfg, nnames) -> |
|
| 134 |
forAll (elements (subsequences nnames)) $ \sorted_nodes -> |
|
| 135 |
forAll (elements (permutations sorted_nodes)) $ \chosen_nodes -> |
|
| 136 |
let orfilter = OrFilter $ map (EQFilter "name" . QuotedString) chosen_nodes |
|
| 137 |
alln = namesToResult chosen_nodes |
|
| 138 |
all_sorted = namesToResult $ niceSort chosen_nodes |
|
| 139 |
test_query = checkQueryResults cfg . makeNodeQuery |
|
| 140 |
in conjoin |
|
| 141 |
[ test_query orfilter "simple filter/requested" alln |
|
| 142 |
, test_query (AndFilter [orfilter]) "complex filter/sorted" all_sorted |
|
| 143 |
] |
|
| 144 |
|
|
| 121 | 145 |
-- | Tests node regex filtering. This is a very basic test :( |
| 122 | 146 |
prop_node_regex_filter :: Property |
| 123 | 147 |
prop_node_regex_filter = |
| 124 |
forAll (choose (0, maxNodes)) $ \numnodes -> |
|
| 125 |
forAll (genEmptyCluster numnodes) $ \cfg -> |
|
| 126 |
let nnames = niceSort . Map.keys . fromContainer $ configNodes cfg |
|
| 127 |
expected = map ((:[]) . ResultEntry RSNormal . Just . showJSON) nnames |
|
| 128 |
regex = mkRegex ".*"::Result FilterRegex |
|
| 129 |
in case regex of |
|
| 130 |
Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg |
|
| 131 |
Ok rx -> |
|
| 132 |
checkQueryResults cfg (makeNodeQuery (RegexpFilter "name" rx)) |
|
| 133 |
"rows for all nodes regexp filter" |
|
| 134 |
expected |
|
| 148 |
forAll (genClusterNames 0 maxNodes) $ \(cfg, nnames) -> |
|
| 149 |
case mkRegex ".*"::Result FilterRegex of |
|
| 150 |
Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg |
|
| 151 |
Ok rx -> |
|
| 152 |
checkQueryResults cfg (makeNodeQuery (RegexpFilter "name" rx)) |
|
| 153 |
"rows for all nodes regexp filter" $ namesToResult nnames |
|
| 135 | 154 |
|
| 136 | 155 |
-- | Tests node regex filtering. This is a very basic test :( |
| 137 | 156 |
prop_node_bad_filter :: String -> Int -> Property |
| 138 | 157 |
prop_node_bad_filter rndname rndint = |
| 139 |
forAll (choose (1, maxNodes)) $ \numnodes -> |
|
| 140 |
forAll (genEmptyCluster numnodes) $ \cfg -> |
|
| 141 |
let regex = mkRegex ".*"::Result FilterRegex |
|
| 142 |
test_query = expectBadQuery cfg . makeNodeQuery |
|
| 158 |
forAll (genClusterNames 1 maxNodes) $ \(cfg, _) -> |
|
| 159 |
let test_query = expectBadQuery cfg . makeNodeQuery |
|
| 143 | 160 |
string_value = QuotedString rndname |
| 144 | 161 |
numeric_value = NumericValue $ fromIntegral rndint |
| 145 |
in case regex of
|
|
| 162 |
in case mkRegex ".*"::Result FilterRegex of
|
|
| 146 | 163 |
Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg |
| 147 | 164 |
Ok rx -> |
| 148 | 165 |
conjoin |
| ... | ... | |
| 175 | 192 |
testSuite "Query/Filter" |
| 176 | 193 |
[ 'prop_node_single_filter |
| 177 | 194 |
, 'prop_node_many_filter |
| 195 |
, 'prop_node_name_ordering |
|
| 178 | 196 |
, 'prop_node_regex_filter |
| 179 | 197 |
, 'prop_node_bad_filter |
| 180 | 198 |
, 'prop_makeSimpleFilter |
Also available in: Unified diff