Store keys as ByteStrings
[ganeti-github.git] / test / hs / 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 All rights reserved.
12
13 Redistribution and use in source and binary forms, with or without
14 modification, are permitted provided that the following conditions are
15 met:
16
17 1. Redistributions of source code must retain the above copyright notice,
18 this list of conditions and the following disclaimer.
19
20 2. Redistributions in binary form must reproduce the above copyright
21 notice, this list of conditions and the following disclaimer in the
22 documentation and/or other materials provided with the distribution.
23
24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
25 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
26 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
27 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
28 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
29 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
30 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
31 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
32 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
33 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
34 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
35
36 -}
37
38 module Test.Ganeti.Query.Filter (testQuery_Filter) where
39
40 import Test.QuickCheck hiding (Result)
41 import Test.QuickCheck.Monadic
42
43 import qualified Data.ByteString.UTF8 as UTF8
44 import qualified Data.Map as Map
45 import Data.List
46 import Text.JSON (showJSON)
47
48 import Test.Ganeti.TestHelper
49 import Test.Ganeti.TestCommon
50 import Test.Ganeti.Objects (genEmptyCluster)
51
52 import Ganeti.BasicTypes
53 import Ganeti.JSON
54 import Ganeti.Objects
55 import Ganeti.Query.Filter
56 import Ganeti.Query.Language
57 import Ganeti.Query.Query
58 import Ganeti.Utils (niceSort)
59
60 -- * Helpers
61
62 -- | Run a query and check that we got a specific response.
63 checkQueryResults :: ConfigData -> Query -> String
64 -> [[ResultEntry]] -> Property
65 checkQueryResults cfg qr descr expected = monadicIO $ do
66 result <- run (query cfg False qr) >>= resultProp
67 stop $ counterexample ("Inconsistent results in " ++ descr)
68 (qresData result ==? expected)
69
70 -- | Makes a node name query, given a filter.
71 makeNodeQuery :: Filter FilterField -> Query
72 makeNodeQuery = Query (ItemTypeOpCode QRNode) ["name"]
73
74 -- | Checks if a given operation failed.
75 expectBadQuery :: ConfigData -> Query -> String -> Property
76 expectBadQuery cfg qr descr = monadicIO $ do
77 result <- run (query cfg False qr)
78 case result of
79 Bad _ -> return ()
80 Ok a -> stop . failTest $ "Expected failure in " ++ descr ++
81 " but got " ++ show a
82
83 -- | A helper to construct a list of results from an expected names list.
84 namesToResult :: [String] -> [[ResultEntry]]
85 namesToResult = map ((:[]) . ResultEntry RSNormal . Just . showJSON)
86
87 -- | Generates a cluster and returns its node names too.
88 genClusterNames :: Int -> Int -> Gen (ConfigData, [String])
89 genClusterNames min_nodes max_nodes = do
90 numnodes <- choose (min_nodes, max_nodes)
91 cfg <- genEmptyCluster numnodes
92 return (cfg , niceSort . map UTF8.toString . Map.keys . fromContainer
93 $ configNodes cfg)
94
95 -- * Test cases
96
97 -- | Tests single node filtering: eq should return it, and (lt and gt)
98 -- should fail.
99 prop_node_single_filter :: Property
100 prop_node_single_filter =
101 forAll (genClusterNames 1 maxNodes) $ \(cfg, allnodes) ->
102 forAll (elements allnodes) $ \nname ->
103 let fvalue = QuotedString nname
104 buildflt n = n "name" fvalue
105 expsingle = namesToResult [nname]
106 othernodes = nname `delete` allnodes
107 expnot = namesToResult othernodes
108 test_query = checkQueryResults cfg . makeNodeQuery
109 in conjoin
110 [ test_query (buildflt EQFilter) "single-name 'EQ' filter" expsingle
111 , test_query (NotFilter (buildflt EQFilter))
112 "single-name 'NOT EQ' filter" expnot
113 , test_query (AndFilter [buildflt LTFilter, buildflt GTFilter])
114 "single-name 'AND [LT,GT]' filter" []
115 , test_query (AndFilter [buildflt LEFilter, buildflt GEFilter])
116 "single-name 'And [LE,GE]' filter" expsingle
117 ]
118
119 -- | Tests node filtering based on name equality: many 'OrFilter'
120 -- should return all results combined, many 'AndFilter' together
121 -- should return nothing. Note that we need at least 2 nodes so that
122 -- the 'AndFilter' case breaks.
123 prop_node_many_filter :: Property
124 prop_node_many_filter =
125 forAll (genClusterNames 2 maxNodes) $ \(cfg, nnames) ->
126 let eqfilter = map (EQFilter "name" . QuotedString) nnames
127 alln = namesToResult nnames
128 test_query = checkQueryResults cfg . makeNodeQuery
129 num_zero = NumericValue 0
130 in conjoin
131 [ test_query (OrFilter eqfilter) "all nodes 'Or' name filter" alln
132 , test_query (AndFilter eqfilter) "all nodes 'And' name filter" []
133 -- this next test works only because genEmptyCluster generates a
134 -- cluster with no instances
135 , test_query (EQFilter "pinst_cnt" num_zero) "pinst_cnt 'Eq' 0" alln
136 , test_query (GTFilter "sinst_cnt" num_zero) "sinst_cnt 'GT' 0" []
137 ]
138
139 -- | Tests name ordering consistency: requesting a 'simple filter'
140 -- results in identical name ordering as the wanted names, requesting
141 -- a more complex filter results in a niceSort-ed order.
142 prop_node_name_ordering :: Property
143 prop_node_name_ordering =
144 forAll (genClusterNames 2 6) $ \(cfg, nnames) ->
145 forAll (elements (subsequences nnames)) $ \sorted_nodes ->
146 forAll (elements (permutations sorted_nodes)) $ \chosen_nodes ->
147 let orfilter = OrFilter $ map (EQFilter "name" . QuotedString) chosen_nodes
148 alln = namesToResult chosen_nodes
149 all_sorted = namesToResult $ niceSort chosen_nodes
150 test_query = checkQueryResults cfg . makeNodeQuery
151 in conjoin
152 [ test_query orfilter "simple filter/requested" alln
153 , test_query (AndFilter [orfilter]) "complex filter/sorted" all_sorted
154 ]
155
156 -- | Tests node regex filtering. This is a very basic test :(
157 prop_node_regex_filter :: Property
158 prop_node_regex_filter =
159 forAll (genClusterNames 0 maxNodes) $ \(cfg, nnames) ->
160 case mkRegex ".*"::Result FilterRegex of
161 Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg
162 Ok rx ->
163 checkQueryResults cfg (makeNodeQuery (RegexpFilter "name" rx))
164 "rows for all nodes regexp filter" $ namesToResult nnames
165
166 -- | Tests node regex filtering. This is a very basic test :(
167 prop_node_bad_filter :: String -> Int -> Property
168 prop_node_bad_filter rndname rndint =
169 forAll (genClusterNames 1 maxNodes) $ \(cfg, _) ->
170 let test_query = expectBadQuery cfg . makeNodeQuery
171 string_value = QuotedString rndname
172 numeric_value = NumericValue $ fromIntegral rndint
173 in case mkRegex ".*"::Result FilterRegex of
174 Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg
175 Ok rx ->
176 conjoin
177 [ test_query (RegexpFilter "offline" rx)
178 "regex filter against boolean field"
179 , test_query (EQFilter "name" numeric_value)
180 "numeric value eq against string field"
181 , test_query (TrueFilter "name")
182 "true filter against string field"
183 , test_query (EQFilter "offline" string_value)
184 "quoted string eq against boolean field"
185 , test_query (ContainsFilter "name" string_value)
186 "quoted string in non-list field"
187 , test_query (ContainsFilter "name" numeric_value)
188 "numeric value in non-list field"
189 ]
190
191 -- | Tests make simple filter.
192 prop_makeSimpleFilter :: Property
193 prop_makeSimpleFilter =
194 forAll (resize 10 $ listOf1 genName) $ \names ->
195 forAll (resize 10 $ listOf1 arbitrary) $ \ids ->
196 forAll genName $ \namefield ->
197 conjoin [ counterexample "test expected names" $
198 makeSimpleFilter namefield (map Left names) ==?
199 OrFilter (map (EQFilter namefield . QuotedString) names)
200 , counterexample "test expected IDs" $
201 makeSimpleFilter namefield (map Right ids) ==?
202 OrFilter (map (EQFilter namefield . NumericValue) ids)
203 , counterexample "test empty names" $
204 makeSimpleFilter namefield [] ==? EmptyFilter
205 ]
206
207 testSuite "Query/Filter"
208 [ 'prop_node_single_filter
209 , 'prop_node_many_filter
210 , 'prop_node_name_ordering
211 , 'prop_node_regex_filter
212 , 'prop_node_bad_filter
213 , 'prop_makeSimpleFilter
214 ]