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