code.grnet.gr Git - ganeti-local/blob - htest/Test/Ganeti/Query/Query.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.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 False (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 False (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 False (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 False (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 False (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 False (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   ]