code.grnet.gr Git - ganeti-local/blob - htest/Test/Ganeti/Query/Filter.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.Filter (testQuery_Filter) where
  30
  31 import Test.QuickCheck hiding (Result)
  32 import Test.QuickCheck.Monadic
  33
  34 import qualified Data.Map as Map
  35 import Data.List
  36 import Text.JSON (showJSON)
  37
  38 import Test.Ganeti.TestHelper
  39 import Test.Ganeti.TestCommon
  40 import Test.Ganeti.Objects (genEmptyCluster)
  41
  42 import Ganeti.BasicTypes
  43 import Ganeti.JSON
  44 import Ganeti.Objects
  45 import Ganeti.Query.Filter
  46 import Ganeti.Query.Language
  47 import Ganeti.Query.Query
  48 import Ganeti.Utils (niceSort)
  49
  50 -- * Helpers
  51
  52 -- | Run a query and check that we got a specific response.
  53 checkQueryResults :: ConfigData -> Query -> String
  54                   -> [[ResultEntry]] -> Property
  55 checkQueryResults cfg qr descr expected = monadicIO $ do
  56   result <- run (query cfg False qr) >>= resultProp
  57   stop $ printTestCase ("Inconsistent results in " ++ descr)
  58          (qresData result ==? expected)
  59
  60 -- | Makes a node name query, given a filter.
  61 makeNodeQuery :: Filter FilterField -> Query
  62 makeNodeQuery = Query (ItemTypeOpCode QRNode) ["name"]
  63
  64 -- | Checks if a given operation failed.
  65 expectBadQuery :: ConfigData -> Query -> String -> Property
  66 expectBadQuery cfg qr descr = monadicIO $ do
  67   result <- run (query cfg False qr)
  68   case result of
  69     Bad _ -> return ()
  70     Ok a  -> stop . failTest $ "Expected failure in " ++ descr ++
  71                                " but got " ++ show a
  72
  73 -- | A helper to construct a list of results from an expected names list.
  74 namesToResult :: [String] -> [[ResultEntry]]
  75 namesToResult = map ((:[]) . ResultEntry RSNormal . Just . showJSON)
  76
  77 -- | Generates a cluster and returns its node names too.
  78 genClusterNames :: Int -> Int -> Gen (ConfigData, [String])
  79 genClusterNames min_nodes max_nodes = do
  80   numnodes <- choose (min_nodes, max_nodes)
  81   cfg <- genEmptyCluster numnodes
  82   return (cfg, niceSort . Map.keys . fromContainer $ configNodes cfg)
  83
  84 -- * Test cases
  85
  86 -- | Tests single node filtering: eq should return it, and (lt and gt)
  87 -- should fail.
  88 prop_node_single_filter :: Property
  89 prop_node_single_filter =
  90   forAll (genClusterNames 1 maxNodes) $ \(cfg, allnodes) ->
  91   forAll (elements allnodes) $ \nname ->
  92   let fvalue = QuotedString nname
  93       buildflt n = n "name" fvalue
  94       expsingle = namesToResult [nname]
  95       othernodes = nname `delete` allnodes
  96       expnot = namesToResult othernodes
  97       test_query = checkQueryResults cfg . makeNodeQuery
  98   in conjoin
  99        [ test_query (buildflt EQFilter) "single-name 'EQ' filter" expsingle
 100        , test_query (NotFilter (buildflt EQFilter))
 101          "single-name 'NOT EQ' filter" expnot
 102        , test_query (AndFilter [buildflt LTFilter, buildflt GTFilter])
 103          "single-name 'AND [LT,GT]' filter" []
 104        , test_query (AndFilter [buildflt LEFilter, buildflt GEFilter])
 105          "single-name 'And [LE,GE]' filter" expsingle
 106        ]
 107
 108 -- | Tests node filtering based on name equality: many 'OrFilter'
 109 -- should return all results combined, many 'AndFilter' together
 110 -- should return nothing. Note that we need at least 2 nodes so that
 111 -- the 'AndFilter' case breaks.
 112 prop_node_many_filter :: Property
 113 prop_node_many_filter =
 114   forAll (genClusterNames 2 maxNodes) $ \(cfg, nnames) ->
 115   let eqfilter = map (EQFilter "name" . QuotedString) nnames
 116       alln = namesToResult nnames
 117       test_query = checkQueryResults cfg . makeNodeQuery
 118       num_zero = NumericValue 0
 119   in conjoin
 120      [ test_query (OrFilter eqfilter) "all nodes 'Or' name filter" alln
 121      , test_query (AndFilter eqfilter) "all nodes 'And' name filter" []
 122      -- this next test works only because genEmptyCluster generates a
 123      -- cluster with no instances
 124      , test_query (EQFilter "pinst_cnt" num_zero) "pinst_cnt 'Eq' 0" alln
 125      , test_query (GTFilter "sinst_cnt" num_zero) "sinst_cnt 'GT' 0" []
 126      ]
 127
 128 -- | Tests name ordering consistency: requesting a 'simple filter'
 129 -- results in identical name ordering as the wanted names, requesting
 130 -- a more complex filter results in a niceSort-ed order.
 131 prop_node_name_ordering :: Property
 132 prop_node_name_ordering =
 133   forAll (genClusterNames 2 6) $ \(cfg, nnames) ->
 134   forAll (elements (subsequences nnames)) $ \sorted_nodes ->
 135   forAll (elements (permutations sorted_nodes)) $ \chosen_nodes ->
 136   let orfilter = OrFilter $ map (EQFilter "name" . QuotedString) chosen_nodes
 137       alln = namesToResult chosen_nodes
 138       all_sorted = namesToResult $ niceSort chosen_nodes
 139       test_query = checkQueryResults cfg . makeNodeQuery
 140   in conjoin
 141      [ test_query orfilter "simple filter/requested" alln
 142      , test_query (AndFilter [orfilter]) "complex filter/sorted" all_sorted
 143      ]
 144
 145 -- | Tests node regex filtering. This is a very basic test :(
 146 prop_node_regex_filter :: Property
 147 prop_node_regex_filter =
 148   forAll (genClusterNames 0 maxNodes) $ \(cfg, nnames) ->
 149   case mkRegex ".*"::Result FilterRegex of
 150     Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg
 151     Ok rx ->
 152       checkQueryResults cfg (makeNodeQuery (RegexpFilter "name" rx))
 153         "rows for all nodes regexp filter" $ namesToResult nnames
 154
 155 -- | Tests node regex filtering. This is a very basic test :(
 156 prop_node_bad_filter :: String -> Int -> Property
 157 prop_node_bad_filter rndname rndint =
 158   forAll (genClusterNames 1 maxNodes) $ \(cfg, _) ->
 159   let test_query = expectBadQuery cfg . makeNodeQuery
 160       string_value = QuotedString rndname
 161       numeric_value = NumericValue $ fromIntegral rndint
 162   in case mkRegex ".*"::Result FilterRegex of
 163        Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg
 164        Ok rx ->
 165          conjoin
 166            [ test_query (RegexpFilter "offline" rx)
 167              "regex filter against boolean field"
 168            , test_query (EQFilter "name" numeric_value)
 169              "numeric value eq against string field"
 170            , test_query (TrueFilter "name")
 171              "true filter against string field"
 172            , test_query (EQFilter "offline" string_value)
 173              "quoted string eq against boolean field"
 174            , test_query (ContainsFilter "name" string_value)
 175              "quoted string in non-list field"
 176            , test_query (ContainsFilter "name" numeric_value)
 177              "numeric value in non-list field"
 178            ]
 179
 180 -- | Tests make simple filter.
 181 prop_makeSimpleFilter :: Property
 182 prop_makeSimpleFilter =
 183   forAll (resize 10 $ listOf1 genName) $ \names ->
 184   forAll (resize 10 $ listOf1 arbitrary) $ \ids ->
 185   forAll genName $ \namefield ->
 186   conjoin [ printTestCase "test expected names" $
 187               makeSimpleFilter namefield (map Left names) ==?
 188               OrFilter (map (EQFilter namefield . QuotedString) names)
 189           , printTestCase "test expected IDs" $
 190               makeSimpleFilter namefield (map Right ids) ==?
 191               OrFilter (map (EQFilter namefield . NumericValue) ids)
 192           , printTestCase "test empty names" $
 193               makeSimpleFilter namefield [] ==? EmptyFilter
 194           ]
 195
 196 testSuite "Query/Filter"
 197   [ 'prop_node_single_filter
 198   , 'prop_node_many_filter
 199   , 'prop_node_name_ordering
 200   , 'prop_node_regex_filter
 201   , 'prop_node_bad_filter
 202   , 'prop_makeSimpleFilter
 203   ]