Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / Query / Query.hs @ b54ecf12

History | View | Annotate | Download (15.3 kB)

1
{-# LANGUAGE TemplateHaskell, BangPatterns #-}
2
{-# OPTIONS_GHC -fno-warn-orphans #-}
3

    
4
{-| Unittests for ganeti-htools.
5

    
6
-}
7

    
8
{-
9

    
10
Copyright (C) 2009, 2010, 2011, 2012, 2013 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 qualified Data.Set as Set
40
import Text.JSON (JSValue(..), showJSON)
41

    
42
import Test.Ganeti.TestHelper
43
import Test.Ganeti.TestCommon
44
import Test.Ganeti.Objects (genEmptyCluster)
45

    
46
import Ganeti.BasicTypes
47
import Ganeti.Errors
48
import Ganeti.JSON
49
import Ganeti.Objects
50
import Ganeti.Query.Filter
51
import qualified Ganeti.Query.Group as Group
52
import Ganeti.Query.Language
53
import qualified Ganeti.Query.Node as Node
54
import Ganeti.Query.Query
55
import qualified Ganeti.Query.Job as Job
56
import Ganeti.Utils (sepSplit)
57

    
58
{-# ANN module "HLint: ignore Use camelCase" #-}
59

    
60
-- * Helpers
61

    
62
-- | Checks if a list of field definitions contains unknown fields.
63
hasUnknownFields :: [FieldDefinition] -> Bool
64
hasUnknownFields = (QFTUnknown `notElem`) . map fdefKind
65

    
66
-- * Test cases
67

    
68
-- ** Node queries
69

    
70
-- | Tests that querying any existing fields, via either query or
71
-- queryFields, will not return unknown fields.
72
prop_queryNode_noUnknown :: Property
73
prop_queryNode_noUnknown =
74
  forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
75
  forAll (elements (Map.keys Node.fieldsMap)) $ \field -> monadicIO $ do
76
  QueryResult fdefs fdata <-
77
    run (query cluster False (Query (ItemTypeOpCode QRNode)
78
                              [field] EmptyFilter)) >>= resultProp
79
  QueryFieldsResult fdefs' <-
80
    resultProp $ queryFields (QueryFields (ItemTypeOpCode QRNode) [field])
81
  stop $ conjoin
82
         [ printTestCase ("Got unknown fields via query (" ++
83
                          show fdefs ++ ")") (hasUnknownFields fdefs)
84
         , printTestCase ("Got unknown result status via query (" ++
85
                          show fdata ++ ")")
86
           (all (all ((/= RSUnknown) . rentryStatus)) fdata)
87
         , printTestCase ("Got unknown fields via query fields (" ++
88
                          show fdefs'++ ")") (hasUnknownFields fdefs')
89
         ]
90

    
91
-- | Tests that an unknown field is returned as such.
92
prop_queryNode_Unknown :: Property
93
prop_queryNode_Unknown =
94
  forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
95
  forAll (arbitrary `suchThat` (`notElem` Map.keys Node.fieldsMap))
96
    $ \field -> monadicIO $ do
97
  QueryResult fdefs fdata <-
98
    run (query cluster False (Query (ItemTypeOpCode QRNode)
99
                              [field] EmptyFilter)) >>= resultProp
100
  QueryFieldsResult fdefs' <-
101
    resultProp $ queryFields (QueryFields (ItemTypeOpCode QRNode) [field])
102
  stop $ conjoin
103
         [ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
104
           (not $ hasUnknownFields fdefs)
105
         , printTestCase ("Got /= ResultUnknown result status via query (" ++
106
                          show fdata ++ ")")
107
           (all (all ((== RSUnknown) . rentryStatus)) fdata)
108
         , printTestCase ("Got a Just in a result value (" ++
109
                          show fdata ++ ")")
110
           (all (all (isNothing . rentryValue)) fdata)
111
         , printTestCase ("Got known fields via query fields (" ++ show fdefs'
112
                          ++ ")") (not $ hasUnknownFields fdefs')
113
         ]
114

    
115
-- | Checks that a result type is conforming to a field definition.
116
checkResultType :: FieldDefinition -> ResultEntry -> Property
117
checkResultType _ (ResultEntry RSNormal Nothing) =
118
  failTest "Nothing result in RSNormal field"
119
checkResultType _ (ResultEntry _ Nothing) = passTest
120
checkResultType fdef (ResultEntry RSNormal (Just v)) =
121
  case (fdefKind fdef, v) of
122
    (QFTText      , JSString {})   -> passTest
123
    (QFTBool      , JSBool {})     -> passTest
124
    (QFTNumber    , JSRational {}) -> passTest
125
    (QFTTimestamp , JSRational {}) -> passTest
126
    (QFTUnit      , JSRational {}) -> passTest
127
    (QFTOther     , _)             -> passTest -- meh, QFT not precise...
128
    (kind, _) -> failTest $ "Type mismatch, field definition says " ++
129
                  show kind ++ " but returned value is " ++ show v ++
130
                  " for field '" ++ fdefName fdef ++ "'"
131
checkResultType _ (ResultEntry r (Just _)) =
132
  failTest $ "Just result in " ++ show r ++ " field"
133

    
134
-- | Tests that querying any existing fields, the following three
135
-- properties hold: RSNormal corresponds to a Just value, any other
136
-- value corresponds to Nothing, and for a RSNormal and value field,
137
-- the type of the value corresponds to the type of the field as
138
-- declared in the FieldDefinition.
139
prop_queryNode_types :: Property
140
prop_queryNode_types =
141
  forAll (choose (0, maxNodes)) $ \numnodes ->
142
  forAll (genEmptyCluster numnodes) $ \cfg ->
143
  forAll (elements (Map.keys Node.fieldsMap)) $ \field -> monadicIO $ do
144
  QueryResult fdefs fdata <-
145
    run (query cfg False (Query (ItemTypeOpCode QRNode)
146
                          [field] EmptyFilter)) >>= resultProp
147
  stop $ conjoin
148
         [ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
149
           (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata)
150
         , printTestCase "Wrong field definitions length"
151
           (length fdefs ==? 1)
152
         , printTestCase "Wrong field result rows length"
153
           (all ((== 1) . length) fdata)
154
         , printTestCase "Wrong number of result rows"
155
           (length fdata ==? numnodes)
156
         ]
157

    
158
-- | Test that queryFields with empty fields list returns all node fields.
159
case_queryNode_allfields :: Assertion
160
case_queryNode_allfields = do
161
  fdefs <- case queryFields (QueryFields (ItemTypeOpCode QRNode) []) of
162
             Bad msg -> fail $ "Error in query all fields: " ++
163
                        formatError msg
164
             Ok (QueryFieldsResult v) -> return v
165
  let field_sort = compare `on` fdefName
166
  assertEqual "Mismatch in all fields list"
167
    (sortBy field_sort . map (\(f, _, _) -> f) $ Map.elems Node.fieldsMap)
168
    (sortBy field_sort fdefs)
169

    
170
-- | Check if cluster node names are unique (first elems).
171
areNodeNamesSane :: ConfigData -> Bool
172
areNodeNamesSane cfg =
173
  let fqdns = map nodeName . Map.elems . fromContainer $ configNodes cfg
174
      names = map (head . sepSplit '.') fqdns
175
  in length names == length (nub names)
176

    
177
-- | Check that the nodes reported by a name filter are sane.
178
prop_queryNode_filter :: Property
179
prop_queryNode_filter =
180
  forAll (choose (1, maxNodes)) $ \nodes ->
181
  forAll (genEmptyCluster nodes `suchThat`
182
          areNodeNamesSane) $ \cluster -> monadicIO $ do
183
    let node_list = map nodeName . Map.elems . fromContainer $
184
                    configNodes cluster
185
    count <- pick $ choose (1, nodes)
186
    fqdn_set <- pick . genSetHelper node_list $ Just count
187
    let fqdns = Set.elems fqdn_set
188
        names = map (head . sepSplit '.') fqdns
189
        flt = makeSimpleFilter "name" $ map Left names
190
    QueryResult _ fdata <-
191
      run (query cluster False (Query (ItemTypeOpCode QRNode)
192
                                ["name"] flt)) >>= resultProp
193
    stop $ conjoin
194
      [ printTestCase "Invalid node names" $
195
        map (map rentryValue) fdata ==? map (\f -> [Just (showJSON f)]) fqdns
196
      ]
197

    
198
-- ** Group queries
199

    
200
prop_queryGroup_noUnknown :: Property
201
prop_queryGroup_noUnknown =
202
  forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
203
  forAll (elements (Map.keys Group.fieldsMap)) $ \field -> monadicIO $ do
204
    QueryResult fdefs fdata <-
205
      run (query cluster False (Query (ItemTypeOpCode QRGroup)
206
                                [field] EmptyFilter)) >>=
207
           resultProp
208
    QueryFieldsResult fdefs' <-
209
      resultProp $ queryFields (QueryFields (ItemTypeOpCode QRGroup) [field])
210
    stop $ conjoin
211
     [ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
212
          (hasUnknownFields fdefs)
213
     , printTestCase ("Got unknown result status via query (" ++
214
                      show fdata ++ ")")
215
       (all (all ((/= RSUnknown) . rentryStatus)) fdata)
216
     , printTestCase ("Got unknown fields via query fields (" ++ show fdefs'
217
                      ++ ")") (hasUnknownFields fdefs')
218
     ]
219

    
220
prop_queryGroup_Unknown :: Property
221
prop_queryGroup_Unknown =
222
  forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
223
  forAll (arbitrary `suchThat` (`notElem` Map.keys Group.fieldsMap))
224
    $ \field -> monadicIO $ do
225
  QueryResult fdefs fdata <-
226
    run (query cluster False (Query (ItemTypeOpCode QRGroup)
227
                              [field] EmptyFilter)) >>= resultProp
228
  QueryFieldsResult fdefs' <-
229
    resultProp $ queryFields (QueryFields (ItemTypeOpCode QRGroup) [field])
230
  stop $ conjoin
231
         [ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
232
           (not $ hasUnknownFields fdefs)
233
         , printTestCase ("Got /= ResultUnknown result status via query (" ++
234
                          show fdata ++ ")")
235
           (all (all ((== RSUnknown) . rentryStatus)) fdata)
236
         , printTestCase ("Got a Just in a result value (" ++
237
                          show fdata ++ ")")
238
           (all (all (isNothing . rentryValue)) fdata)
239
         , printTestCase ("Got known fields via query fields (" ++ show fdefs'
240
                          ++ ")") (not $ hasUnknownFields fdefs')
241
         ]
242

    
243
prop_queryGroup_types :: Property
244
prop_queryGroup_types =
245
  forAll (choose (0, maxNodes)) $ \numnodes ->
246
  forAll (genEmptyCluster numnodes) $ \cfg ->
247
  forAll (elements (Map.keys Group.fieldsMap)) $ \field -> monadicIO $ do
248
  QueryResult fdefs fdata <-
249
    run (query cfg False (Query (ItemTypeOpCode QRGroup)
250
                          [field] EmptyFilter)) >>= resultProp
251
  stop $ conjoin
252
         [ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
253
           (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata)
254
         , printTestCase "Wrong field definitions length" (length fdefs ==? 1)
255
         , printTestCase "Wrong field result rows length"
256
           (all ((== 1) . length) fdata)
257
         ]
258

    
259
case_queryGroup_allfields :: Assertion
260
case_queryGroup_allfields = do
261
  fdefs <- case queryFields (QueryFields (ItemTypeOpCode QRGroup) []) of
262
             Bad msg -> fail $ "Error in query all fields: " ++
263
                        formatError msg
264
             Ok (QueryFieldsResult v) -> return v
265
  let field_sort = compare `on` fdefName
266
  assertEqual "Mismatch in all fields list"
267
    (sortBy field_sort . map (\(f, _, _) -> f) $ Map.elems Group.fieldsMap)
268
    (sortBy field_sort fdefs)
269

    
270
-- | Check that the node count reported by a group list is sane.
271
--
272
-- FIXME: also verify the node list, etc.
273
prop_queryGroup_nodeCount :: Property
274
prop_queryGroup_nodeCount =
275
  forAll (choose (0, maxNodes)) $ \nodes ->
276
  forAll (genEmptyCluster nodes) $ \cluster -> monadicIO $
277
  do
278
    QueryResult _ fdata <-
279
      run (query cluster False (Query (ItemTypeOpCode QRGroup)
280
                                ["node_cnt"] EmptyFilter)) >>= resultProp
281
    stop $ conjoin
282
      [ printTestCase "Invalid node count" $
283
        map (map rentryValue) fdata ==? [[Just (showJSON nodes)]]
284
      ]
285

    
286
-- ** Job queries
287

    
288
-- | Tests that querying any existing fields, via either query or
289
-- queryFields, will not return unknown fields. This uses 'undefined'
290
-- for config, as job queries shouldn't use the configuration, and an
291
-- explicit filter as otherwise non-live queries wouldn't return any
292
-- result rows.
293
prop_queryJob_noUnknown :: Property
294
prop_queryJob_noUnknown =
295
  forAll (listOf (arbitrary::Gen (Positive Integer))) $ \ids ->
296
  forAll (elements (Map.keys Job.fieldsMap)) $ \field -> monadicIO $ do
297
  let qtype = ItemTypeLuxi QRJob
298
      flt = makeSimpleFilter (nameField qtype) $
299
            map (\(Positive i) -> Right i) ids
300
  QueryResult fdefs fdata <-
301
    run (query undefined False (Query qtype [field] flt)) >>= resultProp
302
  QueryFieldsResult fdefs' <-
303
    resultProp $ queryFields (QueryFields qtype [field])
304
  stop $ conjoin
305
         [ printTestCase ("Got unknown fields via query (" ++
306
                          show fdefs ++ ")") (hasUnknownFields fdefs)
307
         , printTestCase ("Got unknown result status via query (" ++
308
                          show fdata ++ ")")
309
           (all (all ((/= RSUnknown) . rentryStatus)) fdata)
310
         , printTestCase ("Got unknown fields via query fields (" ++
311
                          show fdefs'++ ")") (hasUnknownFields fdefs')
312
         ]
313

    
314
-- | Tests that an unknown field is returned as such.
315
prop_queryJob_Unknown :: Property
316
prop_queryJob_Unknown =
317
  forAll (listOf (arbitrary::Gen (Positive Integer))) $ \ids ->
318
  forAll (arbitrary `suchThat` (`notElem` Map.keys Job.fieldsMap))
319
    $ \field -> monadicIO $ do
320
  let qtype = ItemTypeLuxi QRJob
321
      flt = makeSimpleFilter (nameField qtype) $
322
            map (\(Positive i) -> Right i) ids
323
  QueryResult fdefs fdata <-
324
    run (query undefined False (Query qtype [field] flt)) >>= resultProp
325
  QueryFieldsResult fdefs' <-
326
    resultProp $ queryFields (QueryFields qtype [field])
327
  stop $ conjoin
328
         [ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
329
           (not $ hasUnknownFields fdefs)
330
         , printTestCase ("Got /= ResultUnknown result status via query (" ++
331
                          show fdata ++ ")")
332
           (all (all ((== RSUnknown) . rentryStatus)) fdata)
333
         , printTestCase ("Got a Just in a result value (" ++
334
                          show fdata ++ ")")
335
           (all (all (isNothing . rentryValue)) fdata)
336
         , printTestCase ("Got known fields via query fields (" ++ show fdefs'
337
                          ++ ")") (not $ hasUnknownFields fdefs')
338
         ]
339

    
340
-- ** Misc other tests
341

    
342
-- | Tests that requested names checking behaves as expected.
343
prop_getRequestedNames :: Property
344
prop_getRequestedNames =
345
  forAll genName $ \node1 ->
346
  let chk = getRequestedNames . Query (ItemTypeOpCode QRNode) []
347
      q_node1 = QuotedString node1
348
      eq_name = EQFilter "name"
349
      eq_node1 = eq_name q_node1
350
  in conjoin [ printTestCase "empty filter" $ chk EmptyFilter ==? []
351
             , printTestCase "and filter" $ chk (AndFilter [eq_node1]) ==? []
352
             , printTestCase "simple equality" $ chk eq_node1 ==? [node1]
353
             , printTestCase "non-name field" $
354
               chk (EQFilter "foo" q_node1) ==? []
355
             , printTestCase "non-simple filter" $
356
               chk (OrFilter [ eq_node1 , LTFilter "foo" q_node1]) ==? []
357
             ]
358

    
359
testSuite "Query/Query"
360
  [ 'prop_queryNode_noUnknown
361
  , 'prop_queryNode_Unknown
362
  , 'prop_queryNode_types
363
  , 'prop_queryNode_filter
364
  , 'case_queryNode_allfields
365
  , 'prop_queryGroup_noUnknown
366
  , 'prop_queryGroup_Unknown
367
  , 'prop_queryGroup_types
368
  , 'case_queryGroup_allfields
369
  , 'prop_queryGroup_nodeCount
370
  , 'prop_queryJob_noUnknown
371
  , 'prop_queryJob_Unknown
372
  , 'prop_getRequestedNames
373
  ]