code.grnet.gr Git - ganeti-local/blob - test/hs/Test/Ganeti/Query/Query.hs

   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   ]