Revision a7e484c4 htest/Test/Ganeti/Query/Query.hs
| b/htest/Test/Ganeti/Query/Query.hs | ||
|---|---|---|
| 44 | 44 |
|
| 45 | 45 |
import Ganeti.BasicTypes |
| 46 | 46 |
import Ganeti.Errors |
| 47 |
import Ganeti.Query.Filter |
|
| 47 | 48 |
import Ganeti.Query.Group |
| 48 | 49 |
import Ganeti.Query.Language |
| 49 | 50 |
import Ganeti.Query.Node |
| 50 | 51 |
import Ganeti.Query.Query |
| 52 |
import qualified Ganeti.Query.Job as Job |
|
| 51 | 53 |
|
| 52 | 54 |
{-# ANN module "HLint: ignore Use camelCase" #-}
|
| 53 | 55 |
|
| ... | ... | |
| 59 | 61 |
|
| 60 | 62 |
-- * Test cases |
| 61 | 63 |
|
| 64 |
-- ** Node queries |
|
| 65 |
|
|
| 62 | 66 |
-- | Tests that querying any existing fields, via either query or |
| 63 | 67 |
-- queryFields, will not return unknown fields. |
| 64 | 68 |
prop_queryNode_noUnknown :: Property |
| ... | ... | |
| 159 | 163 |
(sortBy field_sort . map (\(f, _, _) -> f) $ Map.elems nodeFieldsMap) |
| 160 | 164 |
(sortBy field_sort fdefs) |
| 161 | 165 |
|
| 162 |
-- * Same as above, but for group
|
|
| 166 |
-- ** Group queries
|
|
| 163 | 167 |
|
| 164 | 168 |
prop_queryGroup_noUnknown :: Property |
| 165 | 169 |
prop_queryGroup_noUnknown = |
| ... | ... | |
| 231 | 235 |
(sortBy field_sort . map (\(f, _, _) -> f) $ Map.elems groupFieldsMap) |
| 232 | 236 |
(sortBy field_sort fdefs) |
| 233 | 237 |
|
| 238 |
-- ** Job queries |
|
| 239 |
|
|
| 240 |
-- | Tests that querying any existing fields, via either query or |
|
| 241 |
-- queryFields, will not return unknown fields. This uses 'undefined' |
|
| 242 |
-- for config, as job queries shouldn't use the configuration, and an |
|
| 243 |
-- explicit filter as otherwise non-live queries wouldn't return any |
|
| 244 |
-- result rows. |
|
| 245 |
prop_queryJob_noUnknown :: Property |
|
| 246 |
prop_queryJob_noUnknown = |
|
| 247 |
forAll (listOf (arbitrary::Gen (Positive Integer))) $ \ids -> |
|
| 248 |
forAll (elements (Map.keys Job.fieldsMap)) $ \field -> monadicIO $ do |
|
| 249 |
let qtype = ItemTypeLuxi QRJob |
|
| 250 |
flt = makeSimpleFilter (nameField qtype) $ |
|
| 251 |
map (\(Positive i) -> Right i) ids |
|
| 252 |
QueryResult fdefs fdata <- |
|
| 253 |
run (query undefined False (Query qtype [field] flt)) >>= resultProp |
|
| 254 |
QueryFieldsResult fdefs' <- |
|
| 255 |
resultProp $ queryFields (QueryFields qtype [field]) |
|
| 256 |
stop $ conjoin |
|
| 257 |
[ printTestCase ("Got unknown fields via query (" ++
|
|
| 258 |
show fdefs ++ ")") (hasUnknownFields fdefs) |
|
| 259 |
, printTestCase ("Got unknown result status via query (" ++
|
|
| 260 |
show fdata ++ ")") |
|
| 261 |
(all (all ((/= RSUnknown) . rentryStatus)) fdata) |
|
| 262 |
, printTestCase ("Got unknown fields via query fields (" ++
|
|
| 263 |
show fdefs'++ ")") (hasUnknownFields fdefs') |
|
| 264 |
] |
|
| 265 |
|
|
| 266 |
-- | Tests that an unknown field is returned as such. |
|
| 267 |
prop_queryJob_Unknown :: Property |
|
| 268 |
prop_queryJob_Unknown = |
|
| 269 |
forAll (listOf (arbitrary::Gen (Positive Integer))) $ \ids -> |
|
| 270 |
forAll (arbitrary `suchThat` (`notElem` Map.keys Job.fieldsMap)) |
|
| 271 |
$ \field -> monadicIO $ do |
|
| 272 |
let qtype = ItemTypeLuxi QRJob |
|
| 273 |
flt = makeSimpleFilter (nameField qtype) $ |
|
| 274 |
map (\(Positive i) -> Right i) ids |
|
| 275 |
QueryResult fdefs fdata <- |
|
| 276 |
run (query undefined False (Query qtype [field] flt)) >>= resultProp |
|
| 277 |
QueryFieldsResult fdefs' <- |
|
| 278 |
resultProp $ queryFields (QueryFields qtype [field]) |
|
| 279 |
stop $ conjoin |
|
| 280 |
[ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
|
|
| 281 |
(not $ hasUnknownFields fdefs) |
|
| 282 |
, printTestCase ("Got /= ResultUnknown result status via query (" ++
|
|
| 283 |
show fdata ++ ")") |
|
| 284 |
(all (all ((== RSUnknown) . rentryStatus)) fdata) |
|
| 285 |
, printTestCase ("Got a Just in a result value (" ++
|
|
| 286 |
show fdata ++ ")") |
|
| 287 |
(all (all (isNothing . rentryValue)) fdata) |
|
| 288 |
, printTestCase ("Got known fields via query fields (" ++ show fdefs'
|
|
| 289 |
++ ")") (not $ hasUnknownFields fdefs') |
|
| 290 |
] |
|
| 291 |
|
|
| 292 |
-- ** Misc other tests |
|
| 234 | 293 |
|
| 235 | 294 |
-- | Tests that requested names checking behaves as expected. |
| 236 | 295 |
prop_getRequestedNames :: Property |
| ... | ... | |
| 258 | 317 |
, 'prop_queryGroup_Unknown |
| 259 | 318 |
, 'prop_queryGroup_types |
| 260 | 319 |
, 'case_queryGroup_allfields |
| 320 |
, 'prop_queryJob_noUnknown |
|
| 321 |
, 'prop_queryJob_Unknown |
|
| 261 | 322 |
, 'prop_getRequestedNames |
| 262 | 323 |
] |
Also available in: Unified diff