root / test / hs / Test / Ganeti / Query / Filter.hs @ 9bf17b50
History | View | Annotate | Download (7.7 kB)
1 |
{-# LANGUAGE TemplateHaskell #-} |
---|---|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
3 |
|
4 |
{-| Unittests for ganeti-htools. |
5 |
|
6 |
-} |
7 |
|
8 |
{- |
9 |
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
11 |
|
12 |
This program is free software; you can redistribute it and/or modify |
13 |
it under the terms of the GNU General Public License as published by |
14 |
the Free Software Foundation; either version 2 of the License, or |
15 |
(at your option) any later version. |
16 |
|
17 |
This program is distributed in the hope that it will be useful, but |
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 |
General Public License for more details. |
21 |
|
22 |
You should have received a copy of the GNU General Public License |
23 |
along with this program; if not, write to the Free Software |
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 |
02110-1301, USA. |
26 |
|
27 |
-} |
28 |
|
29 |
module Test.Ganeti.Query.Filter (testQuery_Filter) where |
30 |
|
31 |
import Test.QuickCheck hiding (Result) |
32 |
import Test.QuickCheck.Monadic |
33 |
|
34 |
import qualified Data.Map as Map |
35 |
import Data.List |
36 |
import Text.JSON (showJSON) |
37 |
|
38 |
import Test.Ganeti.TestHelper |
39 |
import Test.Ganeti.TestCommon |
40 |
import Test.Ganeti.Objects (genEmptyCluster) |
41 |
|
42 |
import Ganeti.BasicTypes |
43 |
import Ganeti.JSON |
44 |
import Ganeti.Objects |
45 |
import Ganeti.Query.Filter |
46 |
import Ganeti.Query.Language |
47 |
import Ganeti.Query.Query |
48 |
import Ganeti.Utils (niceSort) |
49 |
|
50 |
-- * Helpers |
51 |
|
52 |
-- | Run a query and check that we got a specific response. |
53 |
checkQueryResults :: ConfigData -> Query -> String |
54 |
-> [[ResultEntry]] -> Property |
55 |
checkQueryResults cfg qr descr expected = monadicIO $ do |
56 |
result <- run (query cfg False qr) >>= resultProp |
57 |
stop $ printTestCase ("Inconsistent results in " ++ descr) |
58 |
(qresData result ==? expected) |
59 |
|
60 |
-- | Makes a node name query, given a filter. |
61 |
makeNodeQuery :: Filter FilterField -> Query |
62 |
makeNodeQuery = Query (ItemTypeOpCode QRNode) ["name"] |
63 |
|
64 |
-- | Checks if a given operation failed. |
65 |
expectBadQuery :: ConfigData -> Query -> String -> Property |
66 |
expectBadQuery cfg qr descr = monadicIO $ do |
67 |
result <- run (query cfg False qr) |
68 |
case result of |
69 |
Bad _ -> return () |
70 |
Ok a -> stop . failTest $ "Expected failure in " ++ descr ++ |
71 |
" but got " ++ show a |
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 |
|
84 |
-- * Test cases |
85 |
|
86 |
-- | Tests single node filtering: eq should return it, and (lt and gt) |
87 |
-- should fail. |
88 |
prop_node_single_filter :: Property |
89 |
prop_node_single_filter = |
90 |
forAll (genClusterNames 1 maxNodes) $ \(cfg, allnodes) -> |
91 |
forAll (elements allnodes) $ \nname -> |
92 |
let fvalue = QuotedString nname |
93 |
buildflt n = n "name" fvalue |
94 |
expsingle = namesToResult [nname] |
95 |
othernodes = nname `delete` allnodes |
96 |
expnot = namesToResult othernodes |
97 |
test_query = checkQueryResults cfg . makeNodeQuery |
98 |
in conjoin |
99 |
[ test_query (buildflt EQFilter) "single-name 'EQ' filter" expsingle |
100 |
, test_query (NotFilter (buildflt EQFilter)) |
101 |
"single-name 'NOT EQ' filter" expnot |
102 |
, test_query (AndFilter [buildflt LTFilter, buildflt GTFilter]) |
103 |
"single-name 'AND [LT,GT]' filter" [] |
104 |
, test_query (AndFilter [buildflt LEFilter, buildflt GEFilter]) |
105 |
"single-name 'And [LE,GE]' filter" expsingle |
106 |
] |
107 |
|
108 |
-- | Tests node filtering based on name equality: many 'OrFilter' |
109 |
-- should return all results combined, many 'AndFilter' together |
110 |
-- should return nothing. Note that we need at least 2 nodes so that |
111 |
-- the 'AndFilter' case breaks. |
112 |
prop_node_many_filter :: Property |
113 |
prop_node_many_filter = |
114 |
forAll (genClusterNames 2 maxNodes) $ \(cfg, nnames) -> |
115 |
let eqfilter = map (EQFilter "name" . QuotedString) nnames |
116 |
alln = namesToResult nnames |
117 |
test_query = checkQueryResults cfg . makeNodeQuery |
118 |
num_zero = NumericValue 0 |
119 |
in conjoin |
120 |
[ test_query (OrFilter eqfilter) "all nodes 'Or' name filter" alln |
121 |
, test_query (AndFilter eqfilter) "all nodes 'And' name filter" [] |
122 |
-- this next test works only because genEmptyCluster generates a |
123 |
-- cluster with no instances |
124 |
, test_query (EQFilter "pinst_cnt" num_zero) "pinst_cnt 'Eq' 0" alln |
125 |
, test_query (GTFilter "sinst_cnt" num_zero) "sinst_cnt 'GT' 0" [] |
126 |
] |
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 |
|
145 |
-- | Tests node regex filtering. This is a very basic test :( |
146 |
prop_node_regex_filter :: Property |
147 |
prop_node_regex_filter = |
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 |
154 |
|
155 |
-- | Tests node regex filtering. This is a very basic test :( |
156 |
prop_node_bad_filter :: String -> Int -> Property |
157 |
prop_node_bad_filter rndname rndint = |
158 |
forAll (genClusterNames 1 maxNodes) $ \(cfg, _) -> |
159 |
let test_query = expectBadQuery cfg . makeNodeQuery |
160 |
string_value = QuotedString rndname |
161 |
numeric_value = NumericValue $ fromIntegral rndint |
162 |
in case mkRegex ".*"::Result FilterRegex of |
163 |
Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg |
164 |
Ok rx -> |
165 |
conjoin |
166 |
[ test_query (RegexpFilter "offline" rx) |
167 |
"regex filter against boolean field" |
168 |
, test_query (EQFilter "name" numeric_value) |
169 |
"numeric value eq against string field" |
170 |
, test_query (TrueFilter "name") |
171 |
"true filter against string field" |
172 |
, test_query (EQFilter "offline" string_value) |
173 |
"quoted string eq against boolean field" |
174 |
, test_query (ContainsFilter "name" string_value) |
175 |
"quoted string in non-list field" |
176 |
, test_query (ContainsFilter "name" numeric_value) |
177 |
"numeric value in non-list field" |
178 |
] |
179 |
|
180 |
-- | Tests make simple filter. |
181 |
prop_makeSimpleFilter :: Property |
182 |
prop_makeSimpleFilter = |
183 |
forAll (resize 10 $ listOf1 genName) $ \names -> |
184 |
forAll (resize 10 $ listOf1 arbitrary) $ \ids -> |
185 |
forAll genName $ \namefield -> |
186 |
conjoin [ printTestCase "test expected names" $ |
187 |
makeSimpleFilter namefield (map Left names) ==? |
188 |
OrFilter (map (EQFilter namefield . QuotedString) names) |
189 |
, printTestCase "test expected IDs" $ |
190 |
makeSimpleFilter namefield (map Right ids) ==? |
191 |
OrFilter (map (EQFilter namefield . NumericValue) ids) |
192 |
, printTestCase "test empty names" $ |
193 |
makeSimpleFilter namefield [] ==? EmptyFilter |
194 |
] |
195 |
|
196 |
testSuite "Query/Filter" |
197 |
[ 'prop_node_single_filter |
198 |
, 'prop_node_many_filter |
199 |
, 'prop_node_name_ordering |
200 |
, 'prop_node_regex_filter |
201 |
, 'prop_node_bad_filter |
202 |
, 'prop_makeSimpleFilter |
203 |
] |