Synnefo » snf-ganeti

{-# LANGUAGE TemplateHaskell #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-| Unittests for ganeti-htools.

-}

{-

Copyright (C) 2009, 2010, 2011, 2012 Google Inc.

This program is free software; you can redistribute it and/or modify

it under the terms of the GNU General Public License as published by

the Free Software Foundation; either version 2 of the License, or

(at your option) any later version.

This program is distributed in the hope that it will be useful, but

WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

General Public License for more details.

You should have received a copy of the GNU General Public License

along with this program; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA

02110-1301, USA.

-}

module Test.Ganeti.Query.Filter (testQuery_Filter) where

import Test.QuickCheck hiding (Result)

import Test.QuickCheck.Monadic

import qualified Data.Map as Map

import Data.List

import Text.JSON (showJSON)

import Test.Ganeti.TestHelper

import Test.Ganeti.TestCommon

import Test.Ganeti.Objects (genEmptyCluster)

import Ganeti.BasicTypes

import Ganeti.JSON

import Ganeti.Objects

import Ganeti.Query.Filter

import Ganeti.Query.Language

import Ganeti.Query.Query

import Ganeti.Utils (niceSort)

-- * Helpers

-- | Run a query and check that we got a specific response.

checkQueryResults :: ConfigData -> Query -> String

                  -> [[ResultEntry]] -> Property

checkQueryResults cfg qr descr expected = monadicIO $ do

  result <- run (query cfg False qr) >>= resultProp

  stop $ printTestCase ("Inconsistent results in " ++ descr)

         (qresData result ==? expected)

-- | Makes a node name query, given a filter.

makeNodeQuery :: Filter FilterField -> Query

makeNodeQuery = Query (ItemTypeOpCode QRNode) ["name"]

-- | Checks if a given operation failed.

expectBadQuery :: ConfigData -> Query -> String -> Property

expectBadQuery cfg qr descr = monadicIO $ do

  result <- run (query cfg False qr)

  case result of

    Bad _ -> return ()

    Ok a  -> stop . failTest $ "Expected failure in " ++ descr ++

                               " but got " ++ show a

-- | A helper to construct a list of results from an expected names list.

namesToResult :: [String] -> [[ResultEntry]]

namesToResult = map ((:[]) . ResultEntry RSNormal . Just . showJSON)

-- | Generates a cluster and returns its node names too.

genClusterNames :: Int -> Int -> Gen (ConfigData, [String])

genClusterNames min_nodes max_nodes = do

  numnodes <- choose (min_nodes, max_nodes)

  cfg <- genEmptyCluster numnodes

  return (cfg, niceSort . Map.keys . fromContainer $ configNodes cfg)

-- * Test cases

-- | Tests single node filtering: eq should return it, and (lt and gt)

-- should fail.

prop_node_single_filter :: Property

prop_node_single_filter =

  forAll (genClusterNames 1 maxNodes) $ \(cfg, allnodes) ->

  forAll (elements allnodes) $ \nname ->

  let fvalue = QuotedString nname

      buildflt n = n "name" fvalue

      expsingle = namesToResult [nname]

      othernodes = nname `delete` allnodes

      expnot = namesToResult othernodes

      test_query = checkQueryResults cfg . makeNodeQuery

  in conjoin

       [ test_query (buildflt EQFilter) "single-name 'EQ' filter" expsingle

       , test_query (NotFilter (buildflt EQFilter))

         "single-name 'NOT EQ' filter" expnot

       , test_query (AndFilter [buildflt LTFilter, buildflt GTFilter])

         "single-name 'AND [LT,GT]' filter" []

       , test_query (AndFilter [buildflt LEFilter, buildflt GEFilter])

         "single-name 'And [LE,GE]' filter" expsingle

       ]

-- | Tests node filtering based on name equality: many 'OrFilter'

-- should return all results combined, many 'AndFilter' together

-- should return nothing. Note that we need at least 2 nodes so that

-- the 'AndFilter' case breaks.

prop_node_many_filter :: Property

prop_node_many_filter =

  forAll (genClusterNames 2 maxNodes) $ \(cfg, nnames) ->

  let eqfilter = map (EQFilter "name" . QuotedString) nnames

      alln = namesToResult nnames

      test_query = checkQueryResults cfg . makeNodeQuery

      num_zero = NumericValue 0

  in conjoin

     [ test_query (OrFilter eqfilter) "all nodes 'Or' name filter" alln

     , test_query (AndFilter eqfilter) "all nodes 'And' name filter" []

     -- this next test works only because genEmptyCluster generates a

     -- cluster with no instances

     , test_query (EQFilter "pinst_cnt" num_zero) "pinst_cnt 'Eq' 0" alln

     , test_query (GTFilter "sinst_cnt" num_zero) "sinst_cnt 'GT' 0" []

     ]

-- | Tests name ordering consistency: requesting a 'simple filter'

-- results in identical name ordering as the wanted names, requesting

-- a more complex filter results in a niceSort-ed order.

prop_node_name_ordering :: Property

prop_node_name_ordering =

  forAll (genClusterNames 2 6) $ \(cfg, nnames) ->

  forAll (elements (subsequences nnames)) $ \sorted_nodes ->

  forAll (elements (permutations sorted_nodes)) $ \chosen_nodes ->

  let orfilter = OrFilter $ map (EQFilter "name" . QuotedString) chosen_nodes

      alln = namesToResult chosen_nodes

      all_sorted = namesToResult $ niceSort chosen_nodes

      test_query = checkQueryResults cfg . makeNodeQuery

  in conjoin

     [ test_query orfilter "simple filter/requested" alln

     , test_query (AndFilter [orfilter]) "complex filter/sorted" all_sorted

     ]

-- | Tests node regex filtering. This is a very basic test :(

prop_node_regex_filter :: Property

prop_node_regex_filter =

  forAll (genClusterNames 0 maxNodes) $ \(cfg, nnames) ->

  case mkRegex ".*"::Result FilterRegex of

    Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg

    Ok rx ->

      checkQueryResults cfg (makeNodeQuery (RegexpFilter "name" rx))

        "rows for all nodes regexp filter" $ namesToResult nnames

-- | Tests node regex filtering. This is a very basic test :(

prop_node_bad_filter :: String -> Int -> Property

prop_node_bad_filter rndname rndint =

  forAll (genClusterNames 1 maxNodes) $ \(cfg, _) ->

  let test_query = expectBadQuery cfg . makeNodeQuery

      string_value = QuotedString rndname

      numeric_value = NumericValue $ fromIntegral rndint

  in case mkRegex ".*"::Result FilterRegex of

       Bad msg -> failTest $ "Can't build regex?! Error: " ++ msg

       Ok rx ->

         conjoin

           [ test_query (RegexpFilter "offline" rx)

             "regex filter against boolean field"

           , test_query (EQFilter "name" numeric_value)

             "numeric value eq against string field"

           , test_query (TrueFilter "name")

             "true filter against string field"

           , test_query (EQFilter "offline" string_value)

             "quoted string eq against boolean field"

           , test_query (ContainsFilter "name" string_value)

             "quoted string in non-list field"

           , test_query (ContainsFilter "name" numeric_value)

             "numeric value in non-list field"

           ]

-- | Tests make simple filter.

prop_makeSimpleFilter :: Property

prop_makeSimpleFilter =

  forAll (resize 10 $ listOf1 genName) $ \names ->

  forAll (resize 10 $ listOf1 arbitrary) $ \ids ->

  forAll genName $ \namefield ->

  conjoin [ printTestCase "test expected names" $

              makeSimpleFilter namefield (map Left names) ==?

              OrFilter (map (EQFilter namefield . QuotedString) names)

          , printTestCase "test expected IDs" $

              makeSimpleFilter namefield (map Right ids) ==?

              OrFilter (map (EQFilter namefield . NumericValue) ids)

          , printTestCase "test empty names" $

              makeSimpleFilter namefield [] ==? EmptyFilter

          ]

testSuite "Query/Filter"

  [ 'prop_node_single_filter

  , 'prop_node_many_filter

  , 'prop_node_name_ordering

  , 'prop_node_regex_filter

  , 'prop_node_bad_filter

  , 'prop_makeSimpleFilter

  ]