Statistics
| Branch: | Tag: | Revision:

root / htest / Test / Ganeti / Query / Query.hs @ a9d6f4e0

History | View | Annotate | Download (9.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.Query (testQuery_Query) where
30

    
31
import Test.HUnit (Assertion, assertEqual)
32
import Test.QuickCheck hiding (Result)
33
import Test.QuickCheck.Monadic
34

    
35
import Data.Function (on)
36
import Data.List
37
import qualified Data.Map as Map
38
import Data.Maybe
39
import Text.JSON (JSValue(..))
40

    
41
import Test.Ganeti.TestHelper
42
import Test.Ganeti.TestCommon
43
import Test.Ganeti.Objects (genEmptyCluster)
44

    
45
import Ganeti.BasicTypes
46
import Ganeti.Query.Group
47
import Ganeti.Query.Language
48
import Ganeti.Query.Node
49
import Ganeti.Query.Query
50

    
51
{-# ANN module "HLint: ignore Use camelCase" #-}
52

    
53
-- * Helpers
54

    
55
-- | Checks if a list of field definitions contains unknown fields.
56
hasUnknownFields :: [FieldDefinition] -> Bool
57
hasUnknownFields = (QFTUnknown `notElem`) . map fdefKind
58

    
59
-- * Test cases
60

    
61
-- | Tests that querying any existing fields, via either query or
62
-- queryFields, will not return unknown fields.
63
prop_queryNode_noUnknown :: Property
64
prop_queryNode_noUnknown =
65
  forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
66
  forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do
67
  QueryResult fdefs fdata <-
68
    run (query cluster (Query QRNode [field] EmptyFilter)) >>= resultProp
69
  QueryFieldsResult fdefs' <-
70
    resultProp $ queryFields (QueryFields QRNode [field])
71
  stop $ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
72
         (hasUnknownFields fdefs) .&&.
73
         printTestCase ("Got unknown result status via query (" ++
74
                        show fdata ++ ")")
75
           (all (all ((/= RSUnknown) . rentryStatus)) fdata) .&&.
76
         printTestCase ("Got unknown fields via query fields (" ++ show fdefs'
77
                        ++ ")") (hasUnknownFields fdefs')
78

    
79
-- | Tests that an unknown field is returned as such.
80
prop_queryNode_Unknown :: Property
81
prop_queryNode_Unknown =
82
  forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
83
  forAll (arbitrary `suchThat` (`notElem` Map.keys nodeFieldsMap))
84
    $ \field -> monadicIO $ do
85
  QueryResult fdefs fdata <-
86
    run (query cluster (Query QRNode [field] EmptyFilter)) >>= resultProp
87
  QueryFieldsResult fdefs' <-
88
    resultProp $ queryFields (QueryFields QRNode [field])
89
  stop $ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
90
         (not $ hasUnknownFields fdefs) .&&.
91
         printTestCase ("Got /= ResultUnknown result status via query (" ++
92
                        show fdata ++ ")")
93
           (all (all ((== RSUnknown) . rentryStatus)) fdata) .&&.
94
         printTestCase ("Got a Just in a result value (" ++
95
                        show fdata ++ ")")
96
           (all (all (isNothing . rentryValue)) fdata) .&&.
97
         printTestCase ("Got known fields via query fields (" ++ show fdefs'
98
                        ++ ")") (not $ hasUnknownFields fdefs')
99

    
100
-- | Checks that a result type is conforming to a field definition.
101
checkResultType :: FieldDefinition -> ResultEntry -> Property
102
checkResultType _ (ResultEntry RSNormal Nothing) =
103
  failTest "Nothing result in RSNormal field"
104
checkResultType _ (ResultEntry _ Nothing) = passTest
105
checkResultType fdef (ResultEntry RSNormal (Just v)) =
106
  case (fdefKind fdef, v) of
107
    (QFTText      , JSString {})   -> passTest
108
    (QFTBool      , JSBool {})     -> passTest
109
    (QFTNumber    , JSRational {}) -> passTest
110
    (QFTTimestamp , JSRational {}) -> passTest
111
    (QFTUnit      , JSRational {}) -> passTest
112
    (QFTOther     , _)             -> passTest -- meh, QFT not precise...
113
    (kind, _) -> failTest $ "Type mismatch, field definition says " ++
114
                  show kind ++ " but returned value is " ++ show v ++
115
                  " for field '" ++ fdefName fdef ++ "'"
116
checkResultType _ (ResultEntry r (Just _)) =
117
  failTest $ "Just result in " ++ show r ++ " field"
118

    
119
-- | Tests that querying any existing fields, the following three
120
-- properties hold: RSNormal corresponds to a Just value, any other
121
-- value corresponds to Nothing, and for a RSNormal and value field,
122
-- the type of the value corresponds to the type of the field as
123
-- declared in the FieldDefinition.
124
prop_queryNode_types :: Property
125
prop_queryNode_types =
126
  forAll (choose (0, maxNodes)) $ \numnodes ->
127
  forAll (genEmptyCluster numnodes) $ \cfg ->
128
  forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do
129
  QueryResult fdefs fdata <-
130
    run (query cfg (Query QRNode [field] EmptyFilter)) >>= resultProp
131
  stop $ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
132
         (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) .&&.
133
         printTestCase "Wrong field definitions length"
134
           (length fdefs ==? 1) .&&.
135
         printTestCase "Wrong field result rows length"
136
           (all ((== 1) . length) fdata) .&&.
137
         printTestCase "Wrong number of result rows"
138
           (length fdata ==? numnodes)
139

    
140
-- | Test that queryFields with empty fields list returns all node fields.
141
case_queryNode_allfields :: Assertion
142
case_queryNode_allfields = do
143
   fdefs <- case queryFields (QueryFields QRNode []) of
144
              Bad msg -> fail $ "Error in query all fields: " ++ msg
145
              Ok (QueryFieldsResult v) -> return v
146
   let field_sort = compare `on` fdefName
147
   assertEqual "Mismatch in all fields list"
148
     (sortBy field_sort . map fst $ Map.elems nodeFieldsMap)
149
     (sortBy field_sort fdefs)
150

    
151
-- * Same as above, but for group
152

    
153
prop_queryGroup_noUnknown :: Property
154
prop_queryGroup_noUnknown =
155
  forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
156
   forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do
157
   QueryResult fdefs fdata <-
158
     run (query cluster (Query QRGroup [field] EmptyFilter)) >>= resultProp
159
   QueryFieldsResult fdefs' <-
160
     resultProp $ queryFields (QueryFields QRGroup [field])
161
   stop $ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
162
         (hasUnknownFields fdefs) .&&.
163
          printTestCase ("Got unknown result status via query (" ++
164
                         show fdata ++ ")")
165
           (all (all ((/= RSUnknown) . rentryStatus)) fdata) .&&.
166
          printTestCase ("Got unknown fields via query fields (" ++ show fdefs'
167
                        ++ ")") (hasUnknownFields fdefs')
168

    
169
prop_queryGroup_Unknown :: Property
170
prop_queryGroup_Unknown =
171
  forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
172
  forAll (arbitrary `suchThat` (`notElem` Map.keys groupFieldsMap))
173
    $ \field -> monadicIO $ do
174
  QueryResult fdefs fdata <-
175
    run (query cluster (Query QRGroup [field] EmptyFilter)) >>= resultProp
176
  QueryFieldsResult fdefs' <-
177
    resultProp $ queryFields (QueryFields QRGroup [field])
178
  stop $ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
179
         (not $ hasUnknownFields fdefs) .&&.
180
         printTestCase ("Got /= ResultUnknown result status via query (" ++
181
                        show fdata ++ ")")
182
           (all (all ((== RSUnknown) . rentryStatus)) fdata) .&&.
183
         printTestCase ("Got a Just in a result value (" ++
184
                        show fdata ++ ")")
185
           (all (all (isNothing . rentryValue)) fdata) .&&.
186
         printTestCase ("Got known fields via query fields (" ++ show fdefs'
187
                        ++ ")") (not $ hasUnknownFields fdefs')
188

    
189
prop_queryGroup_types :: Property
190
prop_queryGroup_types =
191
  forAll (choose (0, maxNodes)) $ \numnodes ->
192
  forAll (genEmptyCluster numnodes) $ \cfg ->
193
  forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do
194
  QueryResult fdefs fdata <-
195
    run (query cfg (Query QRGroup [field] EmptyFilter)) >>= resultProp
196
  stop $ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
197
         (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) .&&.
198
         printTestCase "Wrong field definitions length"
199
           (length fdefs ==? 1) .&&.
200
         printTestCase "Wrong field result rows length"
201
           (all ((== 1) . length) fdata)
202

    
203
case_queryGroup_allfields :: Assertion
204
case_queryGroup_allfields = do
205
   fdefs <- case queryFields (QueryFields QRGroup []) of
206
              Bad msg -> fail $ "Error in query all fields: " ++ msg
207
              Ok (QueryFieldsResult v) -> return v
208
   let field_sort = compare `on` fdefName
209
   assertEqual "Mismatch in all fields list"
210
     (sortBy field_sort . map fst $ Map.elems groupFieldsMap)
211
     (sortBy field_sort fdefs)
212

    
213
testSuite "Query/Query"
214
  [ 'prop_queryNode_noUnknown
215
  , 'prop_queryNode_Unknown
216
  , 'prop_queryNode_types
217
  , 'case_queryNode_allfields
218
  , 'prop_queryGroup_noUnknown
219
  , 'prop_queryGroup_Unknown
220
  , 'prop_queryGroup_types
221
  , 'case_queryGroup_allfields
222
  ]