root / test / hs / Test / Ganeti / Query / Query.hs @ c42fbe28
History | View | Annotate | Download (13.9 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.Query (testQuery_Query) where |
30 |
|
31 |
import Test.HUnit (Assertion, assertEqual) |
32 |
import Test.QuickCheck hiding (Result) |
33 |
import Test.QuickCheck.Monadic |
34 |
|
35 |
import Data.Function (on) |
36 |
import Data.List |
37 |
import qualified Data.Map as Map |
38 |
import Data.Maybe |
39 |
import Text.JSON (JSValue(..), showJSON) |
40 |
|
41 |
import Test.Ganeti.TestHelper |
42 |
import Test.Ganeti.TestCommon |
43 |
import Test.Ganeti.Objects (genEmptyCluster) |
44 |
|
45 |
import Ganeti.BasicTypes |
46 |
import Ganeti.Errors |
47 |
import Ganeti.Query.Filter |
48 |
import Ganeti.Query.Group |
49 |
import Ganeti.Query.Language |
50 |
import Ganeti.Query.Node |
51 |
import Ganeti.Query.Query |
52 |
import qualified Ganeti.Query.Job as Job |
53 |
|
54 |
{-# ANN module "HLint: ignore Use camelCase" #-} |
55 |
|
56 |
-- * Helpers |
57 |
|
58 |
-- | Checks if a list of field definitions contains unknown fields. |
59 |
hasUnknownFields :: [FieldDefinition] -> Bool |
60 |
hasUnknownFields = (QFTUnknown `notElem`) . map fdefKind |
61 |
|
62 |
-- * Test cases |
63 |
|
64 |
-- ** Node queries |
65 |
|
66 |
-- | Tests that querying any existing fields, via either query or |
67 |
-- queryFields, will not return unknown fields. |
68 |
prop_queryNode_noUnknown :: Property |
69 |
prop_queryNode_noUnknown = |
70 |
forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster -> |
71 |
forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do |
72 |
QueryResult fdefs fdata <- |
73 |
run (query cluster False (Query (ItemTypeOpCode QRNode) |
74 |
[field] EmptyFilter)) >>= resultProp |
75 |
QueryFieldsResult fdefs' <- |
76 |
resultProp $ queryFields (QueryFields (ItemTypeOpCode QRNode) [field]) |
77 |
stop $ conjoin |
78 |
[ printTestCase ("Got unknown fields via query (" ++ |
79 |
show fdefs ++ ")") (hasUnknownFields fdefs) |
80 |
, printTestCase ("Got unknown result status via query (" ++ |
81 |
show fdata ++ ")") |
82 |
(all (all ((/= RSUnknown) . rentryStatus)) fdata) |
83 |
, printTestCase ("Got unknown fields via query fields (" ++ |
84 |
show fdefs'++ ")") (hasUnknownFields fdefs') |
85 |
] |
86 |
|
87 |
-- | Tests that an unknown field is returned as such. |
88 |
prop_queryNode_Unknown :: Property |
89 |
prop_queryNode_Unknown = |
90 |
forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster -> |
91 |
forAll (arbitrary `suchThat` (`notElem` Map.keys nodeFieldsMap)) |
92 |
$ \field -> monadicIO $ do |
93 |
QueryResult fdefs fdata <- |
94 |
run (query cluster False (Query (ItemTypeOpCode QRNode) |
95 |
[field] EmptyFilter)) >>= resultProp |
96 |
QueryFieldsResult fdefs' <- |
97 |
resultProp $ queryFields (QueryFields (ItemTypeOpCode QRNode) [field]) |
98 |
stop $ conjoin |
99 |
[ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")") |
100 |
(not $ hasUnknownFields fdefs) |
101 |
, printTestCase ("Got /= ResultUnknown result status via query (" ++ |
102 |
show fdata ++ ")") |
103 |
(all (all ((== RSUnknown) . rentryStatus)) fdata) |
104 |
, printTestCase ("Got a Just in a result value (" ++ |
105 |
show fdata ++ ")") |
106 |
(all (all (isNothing . rentryValue)) fdata) |
107 |
, printTestCase ("Got known fields via query fields (" ++ show fdefs' |
108 |
++ ")") (not $ hasUnknownFields fdefs') |
109 |
] |
110 |
|
111 |
-- | Checks that a result type is conforming to a field definition. |
112 |
checkResultType :: FieldDefinition -> ResultEntry -> Property |
113 |
checkResultType _ (ResultEntry RSNormal Nothing) = |
114 |
failTest "Nothing result in RSNormal field" |
115 |
checkResultType _ (ResultEntry _ Nothing) = passTest |
116 |
checkResultType fdef (ResultEntry RSNormal (Just v)) = |
117 |
case (fdefKind fdef, v) of |
118 |
(QFTText , JSString {}) -> passTest |
119 |
(QFTBool , JSBool {}) -> passTest |
120 |
(QFTNumber , JSRational {}) -> passTest |
121 |
(QFTTimestamp , JSRational {}) -> passTest |
122 |
(QFTUnit , JSRational {}) -> passTest |
123 |
(QFTOther , _) -> passTest -- meh, QFT not precise... |
124 |
(kind, _) -> failTest $ "Type mismatch, field definition says " ++ |
125 |
show kind ++ " but returned value is " ++ show v ++ |
126 |
" for field '" ++ fdefName fdef ++ "'" |
127 |
checkResultType _ (ResultEntry r (Just _)) = |
128 |
failTest $ "Just result in " ++ show r ++ " field" |
129 |
|
130 |
-- | Tests that querying any existing fields, the following three |
131 |
-- properties hold: RSNormal corresponds to a Just value, any other |
132 |
-- value corresponds to Nothing, and for a RSNormal and value field, |
133 |
-- the type of the value corresponds to the type of the field as |
134 |
-- declared in the FieldDefinition. |
135 |
prop_queryNode_types :: Property |
136 |
prop_queryNode_types = |
137 |
forAll (choose (0, maxNodes)) $ \numnodes -> |
138 |
forAll (genEmptyCluster numnodes) $ \cfg -> |
139 |
forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do |
140 |
QueryResult fdefs fdata <- |
141 |
run (query cfg False (Query (ItemTypeOpCode QRNode) |
142 |
[field] EmptyFilter)) >>= resultProp |
143 |
stop $ conjoin |
144 |
[ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")") |
145 |
(conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) |
146 |
, printTestCase "Wrong field definitions length" |
147 |
(length fdefs ==? 1) |
148 |
, printTestCase "Wrong field result rows length" |
149 |
(all ((== 1) . length) fdata) |
150 |
, printTestCase "Wrong number of result rows" |
151 |
(length fdata ==? numnodes) |
152 |
] |
153 |
|
154 |
-- | Test that queryFields with empty fields list returns all node fields. |
155 |
case_queryNode_allfields :: Assertion |
156 |
case_queryNode_allfields = do |
157 |
fdefs <- case queryFields (QueryFields (ItemTypeOpCode QRNode) []) of |
158 |
Bad msg -> fail $ "Error in query all fields: " ++ |
159 |
formatError msg |
160 |
Ok (QueryFieldsResult v) -> return v |
161 |
let field_sort = compare `on` fdefName |
162 |
assertEqual "Mismatch in all fields list" |
163 |
(sortBy field_sort . map (\(f, _, _) -> f) $ Map.elems nodeFieldsMap) |
164 |
(sortBy field_sort fdefs) |
165 |
|
166 |
-- ** Group queries |
167 |
|
168 |
prop_queryGroup_noUnknown :: Property |
169 |
prop_queryGroup_noUnknown = |
170 |
forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster -> |
171 |
forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do |
172 |
QueryResult fdefs fdata <- |
173 |
run (query cluster False (Query (ItemTypeOpCode QRGroup) |
174 |
[field] EmptyFilter)) >>= |
175 |
resultProp |
176 |
QueryFieldsResult fdefs' <- |
177 |
resultProp $ queryFields (QueryFields (ItemTypeOpCode QRGroup) [field]) |
178 |
stop $ conjoin |
179 |
[ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")") |
180 |
(hasUnknownFields fdefs) |
181 |
, printTestCase ("Got unknown result status via query (" ++ |
182 |
show fdata ++ ")") |
183 |
(all (all ((/= RSUnknown) . rentryStatus)) fdata) |
184 |
, printTestCase ("Got unknown fields via query fields (" ++ show fdefs' |
185 |
++ ")") (hasUnknownFields fdefs') |
186 |
] |
187 |
|
188 |
prop_queryGroup_Unknown :: Property |
189 |
prop_queryGroup_Unknown = |
190 |
forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster -> |
191 |
forAll (arbitrary `suchThat` (`notElem` Map.keys groupFieldsMap)) |
192 |
$ \field -> monadicIO $ do |
193 |
QueryResult fdefs fdata <- |
194 |
run (query cluster False (Query (ItemTypeOpCode QRGroup) |
195 |
[field] EmptyFilter)) >>= resultProp |
196 |
QueryFieldsResult fdefs' <- |
197 |
resultProp $ queryFields (QueryFields (ItemTypeOpCode QRGroup) [field]) |
198 |
stop $ conjoin |
199 |
[ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")") |
200 |
(not $ hasUnknownFields fdefs) |
201 |
, printTestCase ("Got /= ResultUnknown result status via query (" ++ |
202 |
show fdata ++ ")") |
203 |
(all (all ((== RSUnknown) . rentryStatus)) fdata) |
204 |
, printTestCase ("Got a Just in a result value (" ++ |
205 |
show fdata ++ ")") |
206 |
(all (all (isNothing . rentryValue)) fdata) |
207 |
, printTestCase ("Got known fields via query fields (" ++ show fdefs' |
208 |
++ ")") (not $ hasUnknownFields fdefs') |
209 |
] |
210 |
|
211 |
prop_queryGroup_types :: Property |
212 |
prop_queryGroup_types = |
213 |
forAll (choose (0, maxNodes)) $ \numnodes -> |
214 |
forAll (genEmptyCluster numnodes) $ \cfg -> |
215 |
forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do |
216 |
QueryResult fdefs fdata <- |
217 |
run (query cfg False (Query (ItemTypeOpCode QRGroup) |
218 |
[field] EmptyFilter)) >>= resultProp |
219 |
stop $ conjoin |
220 |
[ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")") |
221 |
(conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) |
222 |
, printTestCase "Wrong field definitions length" (length fdefs ==? 1) |
223 |
, printTestCase "Wrong field result rows length" |
224 |
(all ((== 1) . length) fdata) |
225 |
] |
226 |
|
227 |
case_queryGroup_allfields :: Assertion |
228 |
case_queryGroup_allfields = do |
229 |
fdefs <- case queryFields (QueryFields (ItemTypeOpCode QRGroup) []) of |
230 |
Bad msg -> fail $ "Error in query all fields: " ++ |
231 |
formatError msg |
232 |
Ok (QueryFieldsResult v) -> return v |
233 |
let field_sort = compare `on` fdefName |
234 |
assertEqual "Mismatch in all fields list" |
235 |
(sortBy field_sort . map (\(f, _, _) -> f) $ Map.elems groupFieldsMap) |
236 |
(sortBy field_sort fdefs) |
237 |
|
238 |
-- | Check that the node count reported by a group list is sane. |
239 |
-- |
240 |
-- FIXME: also verify the node list, etc. |
241 |
prop_queryGroup_nodeCount :: Property |
242 |
prop_queryGroup_nodeCount = |
243 |
forAll (choose (0, maxNodes)) $ \nodes -> |
244 |
forAll (genEmptyCluster nodes) $ \cluster -> monadicIO $ |
245 |
do |
246 |
QueryResult _ fdata <- |
247 |
run (query cluster False (Query (ItemTypeOpCode QRGroup) |
248 |
["node_cnt"] EmptyFilter)) >>= resultProp |
249 |
stop $ conjoin |
250 |
[ printTestCase "Invalid node count" $ |
251 |
map (map rentryValue) fdata ==? [[Just (showJSON nodes)]] |
252 |
] |
253 |
|
254 |
-- ** Job queries |
255 |
|
256 |
-- | Tests that querying any existing fields, via either query or |
257 |
-- queryFields, will not return unknown fields. This uses 'undefined' |
258 |
-- for config, as job queries shouldn't use the configuration, and an |
259 |
-- explicit filter as otherwise non-live queries wouldn't return any |
260 |
-- result rows. |
261 |
prop_queryJob_noUnknown :: Property |
262 |
prop_queryJob_noUnknown = |
263 |
forAll (listOf (arbitrary::Gen (Positive Integer))) $ \ids -> |
264 |
forAll (elements (Map.keys Job.fieldsMap)) $ \field -> monadicIO $ do |
265 |
let qtype = ItemTypeLuxi QRJob |
266 |
flt = makeSimpleFilter (nameField qtype) $ |
267 |
map (\(Positive i) -> Right i) ids |
268 |
QueryResult fdefs fdata <- |
269 |
run (query undefined False (Query qtype [field] flt)) >>= resultProp |
270 |
QueryFieldsResult fdefs' <- |
271 |
resultProp $ queryFields (QueryFields qtype [field]) |
272 |
stop $ conjoin |
273 |
[ printTestCase ("Got unknown fields via query (" ++ |
274 |
show fdefs ++ ")") (hasUnknownFields fdefs) |
275 |
, printTestCase ("Got unknown result status via query (" ++ |
276 |
show fdata ++ ")") |
277 |
(all (all ((/= RSUnknown) . rentryStatus)) fdata) |
278 |
, printTestCase ("Got unknown fields via query fields (" ++ |
279 |
show fdefs'++ ")") (hasUnknownFields fdefs') |
280 |
] |
281 |
|
282 |
-- | Tests that an unknown field is returned as such. |
283 |
prop_queryJob_Unknown :: Property |
284 |
prop_queryJob_Unknown = |
285 |
forAll (listOf (arbitrary::Gen (Positive Integer))) $ \ids -> |
286 |
forAll (arbitrary `suchThat` (`notElem` Map.keys Job.fieldsMap)) |
287 |
$ \field -> monadicIO $ do |
288 |
let qtype = ItemTypeLuxi QRJob |
289 |
flt = makeSimpleFilter (nameField qtype) $ |
290 |
map (\(Positive i) -> Right i) ids |
291 |
QueryResult fdefs fdata <- |
292 |
run (query undefined False (Query qtype [field] flt)) >>= resultProp |
293 |
QueryFieldsResult fdefs' <- |
294 |
resultProp $ queryFields (QueryFields qtype [field]) |
295 |
stop $ conjoin |
296 |
[ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")") |
297 |
(not $ hasUnknownFields fdefs) |
298 |
, printTestCase ("Got /= ResultUnknown result status via query (" ++ |
299 |
show fdata ++ ")") |
300 |
(all (all ((== RSUnknown) . rentryStatus)) fdata) |
301 |
, printTestCase ("Got a Just in a result value (" ++ |
302 |
show fdata ++ ")") |
303 |
(all (all (isNothing . rentryValue)) fdata) |
304 |
, printTestCase ("Got known fields via query fields (" ++ show fdefs' |
305 |
++ ")") (not $ hasUnknownFields fdefs') |
306 |
] |
307 |
|
308 |
-- ** Misc other tests |
309 |
|
310 |
-- | Tests that requested names checking behaves as expected. |
311 |
prop_getRequestedNames :: Property |
312 |
prop_getRequestedNames = |
313 |
forAll genName $ \node1 -> |
314 |
let chk = getRequestedNames . Query (ItemTypeOpCode QRNode) [] |
315 |
q_node1 = QuotedString node1 |
316 |
eq_name = EQFilter "name" |
317 |
eq_node1 = eq_name q_node1 |
318 |
in conjoin [ printTestCase "empty filter" $ chk EmptyFilter ==? [] |
319 |
, printTestCase "and filter" $ chk (AndFilter [eq_node1]) ==? [] |
320 |
, printTestCase "simple equality" $ chk eq_node1 ==? [node1] |
321 |
, printTestCase "non-name field" $ |
322 |
chk (EQFilter "foo" q_node1) ==? [] |
323 |
, printTestCase "non-simple filter" $ |
324 |
chk (OrFilter [ eq_node1 , LTFilter "foo" q_node1]) ==? [] |
325 |
] |
326 |
|
327 |
testSuite "Query/Query" |
328 |
[ 'prop_queryNode_noUnknown |
329 |
, 'prop_queryNode_Unknown |
330 |
, 'prop_queryNode_types |
331 |
, 'case_queryNode_allfields |
332 |
, 'prop_queryGroup_noUnknown |
333 |
, 'prop_queryGroup_Unknown |
334 |
, 'prop_queryGroup_types |
335 |
, 'case_queryGroup_allfields |
336 |
, 'prop_queryGroup_nodeCount |
337 |
, 'prop_queryJob_noUnknown |
338 |
, 'prop_queryJob_Unknown |
339 |
, 'prop_getRequestedNames |
340 |
] |