root / htest / Test / Ganeti / Query / Query.hs @ 5183e8be
History | View | Annotate | Download (10.3 kB)
1 | b9bdc10e | Iustin Pop | {-# LANGUAGE TemplateHaskell #-} |
---|---|---|---|
2 | b9bdc10e | Iustin Pop | {-# OPTIONS_GHC -fno-warn-orphans #-} |
3 | b9bdc10e | Iustin Pop | |
4 | b9bdc10e | Iustin Pop | {-| Unittests for ganeti-htools. |
5 | b9bdc10e | Iustin Pop | |
6 | b9bdc10e | Iustin Pop | -} |
7 | b9bdc10e | Iustin Pop | |
8 | b9bdc10e | Iustin Pop | {- |
9 | b9bdc10e | Iustin Pop | |
10 | b9bdc10e | Iustin Pop | Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
11 | b9bdc10e | Iustin Pop | |
12 | b9bdc10e | Iustin Pop | This program is free software; you can redistribute it and/or modify |
13 | b9bdc10e | Iustin Pop | it under the terms of the GNU General Public License as published by |
14 | b9bdc10e | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
15 | b9bdc10e | Iustin Pop | (at your option) any later version. |
16 | b9bdc10e | Iustin Pop | |
17 | b9bdc10e | Iustin Pop | This program is distributed in the hope that it will be useful, but |
18 | b9bdc10e | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | b9bdc10e | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 | b9bdc10e | Iustin Pop | General Public License for more details. |
21 | b9bdc10e | Iustin Pop | |
22 | b9bdc10e | Iustin Pop | You should have received a copy of the GNU General Public License |
23 | b9bdc10e | Iustin Pop | along with this program; if not, write to the Free Software |
24 | b9bdc10e | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 | b9bdc10e | Iustin Pop | 02110-1301, USA. |
26 | b9bdc10e | Iustin Pop | |
27 | b9bdc10e | Iustin Pop | -} |
28 | b9bdc10e | Iustin Pop | |
29 | b9bdc10e | Iustin Pop | module Test.Ganeti.Query.Query (testQuery_Query) where |
30 | b9bdc10e | Iustin Pop | |
31 | b9bdc10e | Iustin Pop | import Test.HUnit (Assertion, assertEqual) |
32 | b9bdc10e | Iustin Pop | import Test.QuickCheck hiding (Result) |
33 | b9bdc10e | Iustin Pop | import Test.QuickCheck.Monadic |
34 | b9bdc10e | Iustin Pop | |
35 | b9bdc10e | Iustin Pop | import Data.Function (on) |
36 | b9bdc10e | Iustin Pop | import Data.List |
37 | b9bdc10e | Iustin Pop | import qualified Data.Map as Map |
38 | b9bdc10e | Iustin Pop | import Data.Maybe |
39 | b9bdc10e | Iustin Pop | import Text.JSON (JSValue(..)) |
40 | b9bdc10e | Iustin Pop | |
41 | b9bdc10e | Iustin Pop | import Test.Ganeti.TestHelper |
42 | b9bdc10e | Iustin Pop | import Test.Ganeti.TestCommon |
43 | b9bdc10e | Iustin Pop | import Test.Ganeti.Objects (genEmptyCluster) |
44 | b9bdc10e | Iustin Pop | |
45 | b9bdc10e | Iustin Pop | import Ganeti.BasicTypes |
46 | 5183e8be | Iustin Pop | import Ganeti.Errors |
47 | a9d6f4e0 | Agata Murawska | import Ganeti.Query.Group |
48 | b9bdc10e | Iustin Pop | import Ganeti.Query.Language |
49 | b9bdc10e | Iustin Pop | import Ganeti.Query.Node |
50 | b9bdc10e | Iustin Pop | import Ganeti.Query.Query |
51 | b9bdc10e | Iustin Pop | |
52 | 5b11f8db | Iustin Pop | {-# ANN module "HLint: ignore Use camelCase" #-} |
53 | 5b11f8db | Iustin Pop | |
54 | b9bdc10e | Iustin Pop | -- * Helpers |
55 | b9bdc10e | Iustin Pop | |
56 | b9bdc10e | Iustin Pop | -- | Checks if a list of field definitions contains unknown fields. |
57 | b9bdc10e | Iustin Pop | hasUnknownFields :: [FieldDefinition] -> Bool |
58 | b9bdc10e | Iustin Pop | hasUnknownFields = (QFTUnknown `notElem`) . map fdefKind |
59 | b9bdc10e | Iustin Pop | |
60 | b9bdc10e | Iustin Pop | -- * Test cases |
61 | b9bdc10e | Iustin Pop | |
62 | b9bdc10e | Iustin Pop | -- | Tests that querying any existing fields, via either query or |
63 | b9bdc10e | Iustin Pop | -- queryFields, will not return unknown fields. |
64 | b9bdc10e | Iustin Pop | prop_queryNode_noUnknown :: Property |
65 | b9bdc10e | Iustin Pop | prop_queryNode_noUnknown = |
66 | b9bdc10e | Iustin Pop | forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster -> |
67 | b9bdc10e | Iustin Pop | forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do |
68 | b9bdc10e | Iustin Pop | QueryResult fdefs fdata <- |
69 | fa2c927c | Agata Murawska | run (query cluster False (Query QRNode [field] EmptyFilter)) >>= resultProp |
70 | b9bdc10e | Iustin Pop | QueryFieldsResult fdefs' <- |
71 | b9bdc10e | Iustin Pop | resultProp $ queryFields (QueryFields QRNode [field]) |
72 | 942a9a6a | Iustin Pop | stop $ conjoin |
73 | 942a9a6a | Iustin Pop | [ printTestCase ("Got unknown fields via query (" ++ |
74 | 942a9a6a | Iustin Pop | show fdefs ++ ")") (hasUnknownFields fdefs) |
75 | 942a9a6a | Iustin Pop | , printTestCase ("Got unknown result status via query (" ++ |
76 | 942a9a6a | Iustin Pop | show fdata ++ ")") |
77 | 942a9a6a | Iustin Pop | (all (all ((/= RSUnknown) . rentryStatus)) fdata) |
78 | 942a9a6a | Iustin Pop | , printTestCase ("Got unknown fields via query fields (" ++ |
79 | 942a9a6a | Iustin Pop | show fdefs'++ ")") (hasUnknownFields fdefs') |
80 | 942a9a6a | Iustin Pop | ] |
81 | b9bdc10e | Iustin Pop | |
82 | b9bdc10e | Iustin Pop | -- | Tests that an unknown field is returned as such. |
83 | b9bdc10e | Iustin Pop | prop_queryNode_Unknown :: Property |
84 | b9bdc10e | Iustin Pop | prop_queryNode_Unknown = |
85 | b9bdc10e | Iustin Pop | forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster -> |
86 | 5b11f8db | Iustin Pop | forAll (arbitrary `suchThat` (`notElem` Map.keys nodeFieldsMap)) |
87 | b9bdc10e | Iustin Pop | $ \field -> monadicIO $ do |
88 | b9bdc10e | Iustin Pop | QueryResult fdefs fdata <- |
89 | fa2c927c | Agata Murawska | run (query cluster False (Query QRNode [field] EmptyFilter)) >>= resultProp |
90 | b9bdc10e | Iustin Pop | QueryFieldsResult fdefs' <- |
91 | b9bdc10e | Iustin Pop | resultProp $ queryFields (QueryFields QRNode [field]) |
92 | 942a9a6a | Iustin Pop | stop $ conjoin |
93 | 942a9a6a | Iustin Pop | [ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")") |
94 | 942a9a6a | Iustin Pop | (not $ hasUnknownFields fdefs) |
95 | 942a9a6a | Iustin Pop | , printTestCase ("Got /= ResultUnknown result status via query (" ++ |
96 | 942a9a6a | Iustin Pop | show fdata ++ ")") |
97 | 942a9a6a | Iustin Pop | (all (all ((== RSUnknown) . rentryStatus)) fdata) |
98 | 942a9a6a | Iustin Pop | , printTestCase ("Got a Just in a result value (" ++ |
99 | 942a9a6a | Iustin Pop | show fdata ++ ")") |
100 | 942a9a6a | Iustin Pop | (all (all (isNothing . rentryValue)) fdata) |
101 | 942a9a6a | Iustin Pop | , printTestCase ("Got known fields via query fields (" ++ show fdefs' |
102 | 942a9a6a | Iustin Pop | ++ ")") (not $ hasUnknownFields fdefs') |
103 | 942a9a6a | Iustin Pop | ] |
104 | b9bdc10e | Iustin Pop | |
105 | b9bdc10e | Iustin Pop | -- | Checks that a result type is conforming to a field definition. |
106 | b9bdc10e | Iustin Pop | checkResultType :: FieldDefinition -> ResultEntry -> Property |
107 | b9bdc10e | Iustin Pop | checkResultType _ (ResultEntry RSNormal Nothing) = |
108 | b9bdc10e | Iustin Pop | failTest "Nothing result in RSNormal field" |
109 | b9bdc10e | Iustin Pop | checkResultType _ (ResultEntry _ Nothing) = passTest |
110 | b9bdc10e | Iustin Pop | checkResultType fdef (ResultEntry RSNormal (Just v)) = |
111 | b9bdc10e | Iustin Pop | case (fdefKind fdef, v) of |
112 | b9bdc10e | Iustin Pop | (QFTText , JSString {}) -> passTest |
113 | b9bdc10e | Iustin Pop | (QFTBool , JSBool {}) -> passTest |
114 | b9bdc10e | Iustin Pop | (QFTNumber , JSRational {}) -> passTest |
115 | b9bdc10e | Iustin Pop | (QFTTimestamp , JSRational {}) -> passTest |
116 | b9bdc10e | Iustin Pop | (QFTUnit , JSRational {}) -> passTest |
117 | b9bdc10e | Iustin Pop | (QFTOther , _) -> passTest -- meh, QFT not precise... |
118 | b9bdc10e | Iustin Pop | (kind, _) -> failTest $ "Type mismatch, field definition says " ++ |
119 | b9bdc10e | Iustin Pop | show kind ++ " but returned value is " ++ show v ++ |
120 | b9bdc10e | Iustin Pop | " for field '" ++ fdefName fdef ++ "'" |
121 | b9bdc10e | Iustin Pop | checkResultType _ (ResultEntry r (Just _)) = |
122 | b9bdc10e | Iustin Pop | failTest $ "Just result in " ++ show r ++ " field" |
123 | b9bdc10e | Iustin Pop | |
124 | b9bdc10e | Iustin Pop | -- | Tests that querying any existing fields, the following three |
125 | b9bdc10e | Iustin Pop | -- properties hold: RSNormal corresponds to a Just value, any other |
126 | b9bdc10e | Iustin Pop | -- value corresponds to Nothing, and for a RSNormal and value field, |
127 | b9bdc10e | Iustin Pop | -- the type of the value corresponds to the type of the field as |
128 | b9bdc10e | Iustin Pop | -- declared in the FieldDefinition. |
129 | b9bdc10e | Iustin Pop | prop_queryNode_types :: Property |
130 | b9bdc10e | Iustin Pop | prop_queryNode_types = |
131 | b9bdc10e | Iustin Pop | forAll (choose (0, maxNodes)) $ \numnodes -> |
132 | b9bdc10e | Iustin Pop | forAll (genEmptyCluster numnodes) $ \cfg -> |
133 | b9bdc10e | Iustin Pop | forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do |
134 | b9bdc10e | Iustin Pop | QueryResult fdefs fdata <- |
135 | fa2c927c | Agata Murawska | run (query cfg False (Query QRNode [field] EmptyFilter)) >>= resultProp |
136 | 942a9a6a | Iustin Pop | stop $ conjoin |
137 | 942a9a6a | Iustin Pop | [ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")") |
138 | 942a9a6a | Iustin Pop | (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) |
139 | 942a9a6a | Iustin Pop | , printTestCase "Wrong field definitions length" |
140 | 942a9a6a | Iustin Pop | (length fdefs ==? 1) |
141 | 942a9a6a | Iustin Pop | , printTestCase "Wrong field result rows length" |
142 | 942a9a6a | Iustin Pop | (all ((== 1) . length) fdata) |
143 | 942a9a6a | Iustin Pop | , printTestCase "Wrong number of result rows" |
144 | b9bdc10e | Iustin Pop | (length fdata ==? numnodes) |
145 | 942a9a6a | Iustin Pop | ] |
146 | b9bdc10e | Iustin Pop | |
147 | b9bdc10e | Iustin Pop | -- | Test that queryFields with empty fields list returns all node fields. |
148 | b9bdc10e | Iustin Pop | case_queryNode_allfields :: Assertion |
149 | b9bdc10e | Iustin Pop | case_queryNode_allfields = do |
150 | b9bdc10e | Iustin Pop | fdefs <- case queryFields (QueryFields QRNode []) of |
151 | 5183e8be | Iustin Pop | Bad msg -> fail $ "Error in query all fields: " ++ |
152 | 5183e8be | Iustin Pop | formatError msg |
153 | b9bdc10e | Iustin Pop | Ok (QueryFieldsResult v) -> return v |
154 | b9bdc10e | Iustin Pop | let field_sort = compare `on` fdefName |
155 | b9bdc10e | Iustin Pop | assertEqual "Mismatch in all fields list" |
156 | b9bdc10e | Iustin Pop | (sortBy field_sort . map fst $ Map.elems nodeFieldsMap) |
157 | b9bdc10e | Iustin Pop | (sortBy field_sort fdefs) |
158 | b9bdc10e | Iustin Pop | |
159 | a9d6f4e0 | Agata Murawska | -- * Same as above, but for group |
160 | a9d6f4e0 | Agata Murawska | |
161 | a9d6f4e0 | Agata Murawska | prop_queryGroup_noUnknown :: Property |
162 | a9d6f4e0 | Agata Murawska | prop_queryGroup_noUnknown = |
163 | a9d6f4e0 | Agata Murawska | forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster -> |
164 | a9d6f4e0 | Agata Murawska | forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do |
165 | a9d6f4e0 | Agata Murawska | QueryResult fdefs fdata <- |
166 | 942a9a6a | Iustin Pop | run (query cluster False (Query QRGroup [field] EmptyFilter)) >>= |
167 | 942a9a6a | Iustin Pop | resultProp |
168 | a9d6f4e0 | Agata Murawska | QueryFieldsResult fdefs' <- |
169 | a9d6f4e0 | Agata Murawska | resultProp $ queryFields (QueryFields QRGroup [field]) |
170 | 942a9a6a | Iustin Pop | stop $ conjoin |
171 | 942a9a6a | Iustin Pop | [ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")") |
172 | 942a9a6a | Iustin Pop | (hasUnknownFields fdefs) |
173 | 942a9a6a | Iustin Pop | , printTestCase ("Got unknown result status via query (" ++ |
174 | 942a9a6a | Iustin Pop | show fdata ++ ")") |
175 | 942a9a6a | Iustin Pop | (all (all ((/= RSUnknown) . rentryStatus)) fdata) |
176 | 942a9a6a | Iustin Pop | , printTestCase ("Got unknown fields via query fields (" ++ show fdefs' |
177 | 942a9a6a | Iustin Pop | ++ ")") (hasUnknownFields fdefs') |
178 | 942a9a6a | Iustin Pop | ] |
179 | a9d6f4e0 | Agata Murawska | |
180 | a9d6f4e0 | Agata Murawska | prop_queryGroup_Unknown :: Property |
181 | a9d6f4e0 | Agata Murawska | prop_queryGroup_Unknown = |
182 | a9d6f4e0 | Agata Murawska | forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster -> |
183 | a9d6f4e0 | Agata Murawska | forAll (arbitrary `suchThat` (`notElem` Map.keys groupFieldsMap)) |
184 | a9d6f4e0 | Agata Murawska | $ \field -> monadicIO $ do |
185 | a9d6f4e0 | Agata Murawska | QueryResult fdefs fdata <- |
186 | fa2c927c | Agata Murawska | run (query cluster False (Query QRGroup [field] EmptyFilter)) >>= resultProp |
187 | a9d6f4e0 | Agata Murawska | QueryFieldsResult fdefs' <- |
188 | a9d6f4e0 | Agata Murawska | resultProp $ queryFields (QueryFields QRGroup [field]) |
189 | 942a9a6a | Iustin Pop | stop $ conjoin |
190 | 942a9a6a | Iustin Pop | [ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")") |
191 | 942a9a6a | Iustin Pop | (not $ hasUnknownFields fdefs) |
192 | 942a9a6a | Iustin Pop | , printTestCase ("Got /= ResultUnknown result status via query (" ++ |
193 | 942a9a6a | Iustin Pop | show fdata ++ ")") |
194 | 942a9a6a | Iustin Pop | (all (all ((== RSUnknown) . rentryStatus)) fdata) |
195 | 942a9a6a | Iustin Pop | , printTestCase ("Got a Just in a result value (" ++ |
196 | 942a9a6a | Iustin Pop | show fdata ++ ")") |
197 | 942a9a6a | Iustin Pop | (all (all (isNothing . rentryValue)) fdata) |
198 | 942a9a6a | Iustin Pop | , printTestCase ("Got known fields via query fields (" ++ show fdefs' |
199 | 942a9a6a | Iustin Pop | ++ ")") (not $ hasUnknownFields fdefs') |
200 | 942a9a6a | Iustin Pop | ] |
201 | a9d6f4e0 | Agata Murawska | |
202 | a9d6f4e0 | Agata Murawska | prop_queryGroup_types :: Property |
203 | a9d6f4e0 | Agata Murawska | prop_queryGroup_types = |
204 | a9d6f4e0 | Agata Murawska | forAll (choose (0, maxNodes)) $ \numnodes -> |
205 | a9d6f4e0 | Agata Murawska | forAll (genEmptyCluster numnodes) $ \cfg -> |
206 | a9d6f4e0 | Agata Murawska | forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do |
207 | a9d6f4e0 | Agata Murawska | QueryResult fdefs fdata <- |
208 | fa2c927c | Agata Murawska | run (query cfg False (Query QRGroup [field] EmptyFilter)) >>= resultProp |
209 | 942a9a6a | Iustin Pop | stop $ conjoin |
210 | 942a9a6a | Iustin Pop | [ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")") |
211 | 942a9a6a | Iustin Pop | (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) |
212 | 942a9a6a | Iustin Pop | , printTestCase "Wrong field definitions length" (length fdefs ==? 1) |
213 | 942a9a6a | Iustin Pop | , printTestCase "Wrong field result rows length" |
214 | a9d6f4e0 | Agata Murawska | (all ((== 1) . length) fdata) |
215 | 942a9a6a | Iustin Pop | ] |
216 | a9d6f4e0 | Agata Murawska | |
217 | a9d6f4e0 | Agata Murawska | case_queryGroup_allfields :: Assertion |
218 | a9d6f4e0 | Agata Murawska | case_queryGroup_allfields = do |
219 | a9d6f4e0 | Agata Murawska | fdefs <- case queryFields (QueryFields QRGroup []) of |
220 | 5183e8be | Iustin Pop | Bad msg -> fail $ "Error in query all fields: " ++ |
221 | 5183e8be | Iustin Pop | formatError msg |
222 | a9d6f4e0 | Agata Murawska | Ok (QueryFieldsResult v) -> return v |
223 | a9d6f4e0 | Agata Murawska | let field_sort = compare `on` fdefName |
224 | a9d6f4e0 | Agata Murawska | assertEqual "Mismatch in all fields list" |
225 | a9d6f4e0 | Agata Murawska | (sortBy field_sort . map fst $ Map.elems groupFieldsMap) |
226 | a9d6f4e0 | Agata Murawska | (sortBy field_sort fdefs) |
227 | a9d6f4e0 | Agata Murawska | |
228 | bc4cdeef | Iustin Pop | |
229 | bc4cdeef | Iustin Pop | -- | Tests that requested names checking behaves as expected. |
230 | bc4cdeef | Iustin Pop | prop_getRequestedNames :: Property |
231 | bc4cdeef | Iustin Pop | prop_getRequestedNames = |
232 | bc4cdeef | Iustin Pop | forAll getName $ \node1 -> |
233 | bc4cdeef | Iustin Pop | let chk = getRequestedNames . Query QRNode [] |
234 | bc4cdeef | Iustin Pop | q_node1 = QuotedString node1 |
235 | bc4cdeef | Iustin Pop | eq_name = EQFilter "name" |
236 | bc4cdeef | Iustin Pop | eq_node1 = eq_name q_node1 |
237 | bc4cdeef | Iustin Pop | in conjoin [ printTestCase "empty filter" $ chk EmptyFilter ==? [] |
238 | bc4cdeef | Iustin Pop | , printTestCase "and filter" $ chk (AndFilter [eq_node1]) ==? [] |
239 | bc4cdeef | Iustin Pop | , printTestCase "simple equality" $ chk eq_node1 ==? [node1] |
240 | bc4cdeef | Iustin Pop | , printTestCase "non-name field" $ |
241 | bc4cdeef | Iustin Pop | chk (EQFilter "foo" q_node1) ==? [] |
242 | bc4cdeef | Iustin Pop | , printTestCase "non-simple filter" $ |
243 | bc4cdeef | Iustin Pop | chk (OrFilter [ eq_node1 , LTFilter "foo" q_node1]) ==? [] |
244 | bc4cdeef | Iustin Pop | ] |
245 | bc4cdeef | Iustin Pop | |
246 | b9bdc10e | Iustin Pop | testSuite "Query/Query" |
247 | b9bdc10e | Iustin Pop | [ 'prop_queryNode_noUnknown |
248 | b9bdc10e | Iustin Pop | , 'prop_queryNode_Unknown |
249 | b9bdc10e | Iustin Pop | , 'prop_queryNode_types |
250 | b9bdc10e | Iustin Pop | , 'case_queryNode_allfields |
251 | a9d6f4e0 | Agata Murawska | , 'prop_queryGroup_noUnknown |
252 | a9d6f4e0 | Agata Murawska | , 'prop_queryGroup_Unknown |
253 | a9d6f4e0 | Agata Murawska | , 'prop_queryGroup_types |
254 | a9d6f4e0 | Agata Murawska | , 'case_queryGroup_allfields |
255 | bc4cdeef | Iustin Pop | , 'prop_getRequestedNames |
256 | b9bdc10e | Iustin Pop | ] |