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.Language
  46 import Ganeti.Query.Query
  47
  48 -- * Helpers
  49
  50 -- | Run a query and check that we got a specific response.
  51 checkQueryResults :: ConfigData -> Query -> String
  52                   -> [[ResultEntry]] -> Property
  53 checkQueryResults cfg qr descr expected = monadicIO $ do
  54   result <- run (query cfg qr) >>= resultProp
  55   stop $ printTestCase ("Inconsistent results in " ++ descr)
  56          (qresData result ==? expected)
  57
  58 -- | Makes a node name query, given a filter.
  59 makeNodeQuery :: Filter FilterField -> Query
  60 makeNodeQuery = Query QRNode ["name"]
  61
  62 -- | Checks if a given operation failed.
  63 expectBadQuery :: ConfigData -> Query -> String -> Property
  64 expectBadQuery cfg qr descr = monadicIO $ do
  65   result <- run (query cfg qr)
  66   case result of
  67     Bad _ -> return ()
  68     Ok a  -> stop . failTest $ "Expected failure in " ++ descr ++
  69                                " but got " ++ show a
  70
  71 -- * Test cases
  72
  73 -- | Tests single node filtering: eq should return it, and (lt and gt)
  74 -- should fail.
  75 prop_node_single_filter :: Property
  76 prop_node_single_filter =
  77   forAll (choose (1, maxNodes)) $ \numnodes ->
  78   forAll (genEmptyCluster numnodes) $ \cfg ->
  79   let allnodes = Map.keys . fromContainer $ configNodes cfg in
  80   forAll (elements allnodes) $ \nname ->
  81   let fvalue = QuotedString nname
  82       buildflt n = n "name" fvalue
  83       expsingle = [[ResultEntry RSNormal (Just (showJSON nname))]]
  84       othernodes = nname `delete` allnodes
  85       expnot = map ((:[]) . ResultEntry RSNormal . Just . showJSON) othernodes
  86       test_query = checkQueryResults cfg . makeNodeQuery
  87   in conjoin
  88        [ test_query (buildflt EQFilter) "single-name 'EQ' filter" expsingle
  89        , test_query (NotFilter (buildflt EQFilter))
  90          "single-name 'NOT EQ' filter" expnot
  91        , test_query (AndFilter [buildflt LTFilter, buildflt GTFilter])
  92          "single-name 'AND [LT,GT]' filter" []
  93        , test_query (AndFilter [buildflt LEFilter, buildflt GEFilter])
  94          "single-name 'And [LE,GE]' filter" expsingle
  95        ]
  96
  97 -- | Tests node filtering based on name equality: many 'OrFilter'
  98 -- should return all results combined, many 'AndFilter' together
  99 -- should return nothing. Note that we need at least 2 nodes so that
 100 -- the 'AndFilter' case breaks.
 101 prop_node_many_filter :: Property
 102 prop_node_many_filter =
 103   forAll (choose (2, maxNodes)) $ \numnodes ->
 104   forAll (genEmptyCluster numnodes) $ \cfg ->
 105   let nnames = Map.keys . fromContainer $ configNodes cfg
 106       eqfilter = map (EQFilter "name" . QuotedString) nnames
 107       alln = map ((:[]) . ResultEntry RSNormal . Just . showJSON) nnames
 108       test_query = checkQueryResults cfg . makeNodeQuery
 109       num_zero = NumericValue 0
 110   in conjoin
 111      [ test_query (OrFilter eqfilter) "all nodes 'Or' name filter" alln
 112      , test_query (AndFilter eqfilter) "all nodes 'And' name filter" []
 113      -- this next test works only because genEmptyCluster generates a
 114      -- cluster with no instances
 115      , test_query (EQFilter "pinst_cnt" num_zero) "pinst_cnt 'Eq' 0" alln
 116      , test_query (GTFilter "sinst_cnt" num_zero) "sinst_cnt 'GT' 0" []
 117      ]
 118
 119 -- | Tests node regex filtering. This is a very basic test :(
 120 prop_node_regex_filter :: Property
 121 prop_node_regex_filter =
 122   forAll (choose (0, maxNodes)) $ \numnodes ->
 123   forAll (genEmptyCluster numnodes) $ \cfg ->
 124   let nnames = Map.keys . fromContainer $ configNodes cfg
 125       expected = map ((:[]) . ResultEntry RSNormal . Just . showJSON) nnames
 126       regex = mkRegex ".*"::Result FilterRegex
 127   in case regex of
 128        Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg
 129        Ok rx ->
 130          checkQueryResults cfg (makeNodeQuery (RegexpFilter "name" rx))
 131            "Inconsistent result rows for all nodes regexp filter"
 132            expected
 133
 134 -- | Tests node regex filtering. This is a very basic test :(
 135 prop_node_bad_filter :: String -> Int -> Property
 136 prop_node_bad_filter rndname rndint =
 137   forAll (choose (1, maxNodes)) $ \numnodes ->
 138   forAll (genEmptyCluster numnodes) $ \cfg ->
 139   let regex = mkRegex ".*"::Result FilterRegex
 140       test_query = expectBadQuery cfg . makeNodeQuery
 141       string_value = QuotedString rndname
 142       numeric_value = NumericValue $ fromIntegral rndint
 143   in case regex of
 144        Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg
 145        Ok rx ->
 146          conjoin
 147            [ test_query (RegexpFilter "offline" rx)
 148              "regex filter against boolean field"
 149            , test_query (EQFilter "name" numeric_value)
 150              "numeric value eq against string field"
 151            , test_query (TrueFilter "name")
 152              "true filter against string field"
 153            , test_query (EQFilter "offline" string_value)
 154              "quoted string eq against boolean field"
 155            , test_query (ContainsFilter "name" string_value)
 156              "quoted string in non-list field"
 157            , test_query (ContainsFilter "name" numeric_value)
 158              "numeric value in non-list field"
 159            ]
 160
 161 testSuite "Query/Filter"
 162   [ 'prop_node_single_filter
 163   , 'prop_node_many_filter
 164   , 'prop_node_regex_filter
 165   , 'prop_node_bad_filter
 166   ]