|
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 |
]
|