Commit e8a25d62 authored by Iustin Pop's avatar Iustin Pop
Browse files

Implement Query2 filter JSON (de)serialisation



This adds support for encoding/decoding Query2 filters to/from JSON,
in (hopefully) the same format as the Python code generates.

It also adds a simple unit-test to check that this conversion is
idempotent. Of note here is that, since the Filter data type is
recursive, we have to manually ensure that the generator for it
correctly "shrinks" at each step (first version crashed hard my
workstation after eating ~8GB of ram :).

Compared to the current Query2 implementation, the following changes
were done:

- style: shortened some names to match the Python ones (LessEqualThan
  → LE, etc.)
- changed FilterValue from string to an ADT that can encode both
  quoted strings and numeric values, since this is actually what
  qlang.py generates
- added support for EmptyField, which in hindsight it's an obvious
  missing part :)
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAgata Murawska <agatamurawska@google.com>
parent 31d1d442
......@@ -49,6 +49,7 @@ module Ganeti.HTools.QC
, testLUXI
, testSsconf
, testRpc
, testQuery2
) where
import Test.QuickCheck
......@@ -557,6 +558,38 @@ instance Arbitrary Rpc.RpcCallInstanceList where
instance Arbitrary Rpc.RpcCallNodeInfo where
arbitrary = Rpc.RpcCallNodeInfo <$> arbitrary <*> arbitrary
-- | Custom 'Query2.Filter' generator (top-level), which enforces a
-- (sane) limit on the depth of the generated filters.
genFilter :: Gen Query2.Filter
genFilter = choose (0, 10) >>= genFilter'
-- | Custom generator for filters that correctly halves the state of
-- the generators at each recursive step, per the QuickCheck
-- documentation, in order not to run out of memory.
genFilter' :: Int -> Gen Query2.Filter
genFilter' 0 =
oneof [ return Query2.EmptyFilter
, Query2.TrueFilter <$> getName
, Query2.EQFilter <$> getName <*> value
, Query2.LTFilter <$> getName <*> value
, Query2.GTFilter <$> getName <*> value
, Query2.LEFilter <$> getName <*> value
, Query2.GEFilter <$> getName <*> value
, Query2.RegexpFilter <$> getName <*> getName
, Query2.ContainsFilter <$> getName <*> value
]
where value = oneof [ Query2.QuotedString <$> getName
, Query2.NumericValue <$> arbitrary
]
genFilter' n = do
oneof [ Query2.AndFilter <$> vectorOf n'' (genFilter' n')
, Query2.OrFilter <$> vectorOf n'' (genFilter' n')
, Query2.NotFilter <$> genFilter' n'
]
where n' = n `div` 2 -- sub-filter generator size
n'' = max n' 2 -- but we don't want empty or 1-element lists,
-- so use this for and/or filter list length
-- * Actual tests
-- ** Utils tests
......@@ -1954,3 +1987,16 @@ testSuite "Rpc"
, 'prop_Rpc_noffl_request_instlist
, 'prop_Rpc_noffl_request_nodeinfo
]
-- * Query2 tests
-- | Tests that serialisation/deserialisation of filters is
-- idempotent.
prop_Query2_Serialisation :: Property
prop_Query2_Serialisation =
forAll genFilter $ \flt ->
J.readJSON (J.showJSON flt) ==? J.Ok flt
testSuite "Query2"
[ 'prop_Query2_Serialisation
]
......@@ -27,6 +27,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.Query2
( Filter(..)
, FilterValue(..)
, Query(..)
, QueryResult(..)
, QueryFields(..)
......@@ -35,7 +36,9 @@ module Ganeti.Query2
, ResultEntry(..)
) where
import Control.Applicative
import Data.Ratio (numerator, denominator)
import Text.JSON.Pretty (pp_value)
import Text.JSON.Types
import Text.JSON
......@@ -101,23 +104,136 @@ type Fields = [ String ]
-- | Query2 filter expression.
data Filter
= AndFilter [ Filter ] -- ^ & [<expression>, ...]
| OrFilter [ Filter ] -- ^ | [<expression>, ...]
| NotFilter Filter -- ^ ! <expression>
| TrueFilter FilterField -- ^ ? <field>
| EqualFilter FilterField FilterValue -- ^ (=|!=) <field> <value>
| LessThanFilter FilterField FilterValue -- ^ < <field> <value>
| GreaterThanFilter FilterField FilterValue -- ^ > <field> <value>
| LEThanFilter FilterField FilterValue -- ^ <= <field> <value>
| GEThanFilter FilterField FilterValue -- ^ >= <field> <value>
| RegexpFilter FilterField FilterRegexp -- ^ =~ <field> <regexp>
| ContainsFilter FilterField FilterValue -- ^ =[] <list-field> <value>
= EmptyFilter -- ^ No filter at all
| AndFilter [ Filter ] -- ^ & [<expression>, ...]
| OrFilter [ Filter ] -- ^ | [<expression>, ...]
| NotFilter Filter -- ^ ! <expression>
| TrueFilter FilterField -- ^ ? <field>
| EQFilter FilterField FilterValue -- ^ (=|!=) <field> <value>
| LTFilter FilterField FilterValue -- ^ < <field> <value>
| GTFilter FilterField FilterValue -- ^ > <field> <value>
| LEFilter FilterField FilterValue -- ^ <= <field> <value>
| GEFilter FilterField FilterValue -- ^ >= <field> <value>
| RegexpFilter FilterField FilterRegexp -- ^ =~ <field> <regexp>
| ContainsFilter FilterField FilterValue -- ^ =[] <list-field> <value>
deriving (Show, Read, Eq)
-- | Serialiser for the 'Filter' data type.
showFilter :: Filter -> JSValue
showFilter (EmptyFilter) = JSNull
showFilter (AndFilter exprs) =
JSArray $ (showJSON C.qlangOpAnd):(map showJSON exprs)
showFilter (OrFilter exprs) =
JSArray $ (showJSON C.qlangOpOr):(map showJSON exprs)
showFilter (NotFilter flt) =
JSArray [showJSON C.qlangOpNot, showJSON flt]
showFilter (TrueFilter field) =
JSArray [showJSON C.qlangOpTrue, showJSON field]
showFilter (EQFilter field value) =
JSArray [showJSON C.qlangOpEqual, showJSON field, showJSON value]
showFilter (LTFilter field value) =
JSArray [showJSON C.qlangOpLt, showJSON field, showJSON value]
showFilter (GTFilter field value) =
JSArray [showJSON C.qlangOpGt, showJSON field, showJSON value]
showFilter (LEFilter field value) =
JSArray [showJSON C.qlangOpLe, showJSON field, showJSON value]
showFilter (GEFilter field value) =
JSArray [showJSON C.qlangOpGe, showJSON field, showJSON value]
showFilter (RegexpFilter field regexp) =
JSArray [showJSON C.qlangOpRegexp, showJSON field, showJSON regexp]
showFilter (ContainsFilter field value) =
JSArray [showJSON C.qlangOpContains, showJSON field, showJSON value]
-- | Deserializer for the 'Filter' data type.
readFilter :: JSValue -> Result Filter
readFilter JSNull = Ok EmptyFilter
readFilter (JSArray (JSString op:args)) =
readFilterArray (fromJSString op) args
readFilter v =
Error $ "Cannot deserialise filter: expected array [string, args], got " ++
show (pp_value v)
-- | Helper to deserialise an array corresponding to a single filter
-- and return the built filter. Note this looks generic but is (at
-- least currently) only used for the NotFilter.
readFilterArg :: (Filter -> Filter) -- ^ Constructor
-> [JSValue] -- ^ Single argument
-> Result Filter
readFilterArg constr [flt] = constr <$> readJSON flt
readFilterArg _ v = Error $ "Cannot deserialise field, expected [filter]\
\ but got " ++ show (pp_value (showJSON v))
-- | Helper to deserialise an array corresponding to a single field
-- and return the built filter.
readFilterField :: (FilterField -> Filter) -- ^ Constructor
-> [JSValue] -- ^ Single argument
-> Result Filter
readFilterField constr [field] = constr <$> readJSON field
readFilterField _ v = Error $ "Cannot deserialise field, expected [fieldname]\
\ but got " ++ show (pp_value (showJSON v))
-- | Helper to deserialise an array corresponding to a field and
-- value, returning the built filter.
readFilterFieldValue :: (JSON a) =>
(FilterField -> a -> Filter) -- ^ Constructor
-> [JSValue] -- ^ Arguments array
-> Result Filter
readFilterFieldValue constr [field, value] =
constr <$> readJSON field <*> readJSON value
readFilterFieldValue _ v =
Error $ "Cannot deserialise field/value pair, expected [fieldname, value]\
\ but got " ++ show (pp_value (showJSON v))
-- | Inner deserialiser for 'Filter'.
readFilterArray :: String -> [JSValue] -> Result Filter
readFilterArray op args
| op == C.qlangOpAnd = AndFilter <$> mapM readJSON args
| op == C.qlangOpOr = OrFilter <$> mapM readJSON args
| op == C.qlangOpNot = readFilterArg NotFilter args
| op == C.qlangOpTrue = readFilterField TrueFilter args
| op == C.qlangOpEqual = readFilterFieldValue EQFilter args
| op == C.qlangOpLt = readFilterFieldValue LTFilter args
| op == C.qlangOpGt = readFilterFieldValue GTFilter args
| op == C.qlangOpLe = readFilterFieldValue LEFilter args
| op == C.qlangOpGe = readFilterFieldValue GEFilter args
| op == C.qlangOpRegexp = readFilterFieldValue RegexpFilter args
| op == C.qlangOpContains = readFilterFieldValue ContainsFilter args
| otherwise = Error $ "Unknown filter operand '" ++ op ++ "'"
instance JSON Filter where
showJSON = showFilter
readJSON = readFilter
-- | Field name to filter on.
type FilterField = String
-- | Value to compare the field value to, for filtering purposes.
type FilterValue = String
data FilterValue = QuotedString String
| NumericValue Integer
deriving (Read, Show, Eq)
-- | Serialiser for 'FilterValue'. The Python code just sends this to
-- JSON as-is, so we'll do the same.
showFilterValue :: FilterValue -> JSValue
showFilterValue (QuotedString str) = showJSON str
showFilterValue (NumericValue val) = showJSON val
-- | Decoder for 'FilterValue'. We have to see what it contains, since
-- the context doesn't give us hints on what to expect.
readFilterValue :: JSValue -> Result FilterValue
readFilterValue (JSString a) = Ok . QuotedString $ fromJSString a
readFilterValue (JSRational _ x) =
if denominator x /= 1
then Error $ "Cannot deserialise numeric filter value,\
\ expecting integral but\
\ got a fractional value: " ++ show x
else Ok . NumericValue $ numerator x
readFilterValue v = Error $ "Cannot deserialise filter value, expecting\
\ string or integer, got " ++ show (pp_value v)
instance JSON FilterValue where
showJSON = showFilterValue
readJSON = readFilterValue
-- | Regexp to apply to the filter value, for filteriong purposes.
type FilterRegexp = String
......
......@@ -126,6 +126,7 @@ allTests =
, (fast, testJSON)
, (fast, testLUXI)
, (fast, testSsconf)
, (fast, testQuery2)
, (slow, testCluster)
, (fast, testRpc)
]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment