Fix bug in group queries related to node/instance fields
[ganeti-github.git] / test / hs / Test / Ganeti / Query / Query.hs
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 ]