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

Implement compilation of regexes at creation time



This means that the verification of the correctness of the regex is
done once, at the deserialisation/creation time, as in the Python
code. To do this, we have to change the FilterRegex type from an alias
to String to a more complex data type, and we have to create manual
read/show/eq instance (phew!).

Unittests are added which test these instances, since it's the first time I do
this manually.

An additional improvement is that we now check that regex-pcre has
been compiled correctly, per the documentation (otherwise we get
runtime errors).
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent 4cab6703
......@@ -605,7 +605,7 @@ genFilter' 0 =
, Qlang.GTFilter <$> getName <*> value
, Qlang.LEFilter <$> getName <*> value
, Qlang.GEFilter <$> getName <*> value
, Qlang.RegexpFilter <$> getName <*> getName
, Qlang.RegexpFilter <$> getName <*> arbitrary
, Qlang.ContainsFilter <$> getName <*> value
]
where value = oneof [ Qlang.QuotedString <$> getName
......@@ -623,6 +623,9 @@ genFilter' n = do
instance Arbitrary Qlang.ItemType where
arbitrary = elements [minBound..maxBound]
instance Arbitrary Qlang.FilterRegex where
arbitrary = getName >>= Qlang.mkRegex -- a name should be a good regex
-- * Actual tests
-- ** Utils tests
......@@ -2089,8 +2092,15 @@ prop_Qlang_Serialisation =
forAll genFilter $ \flt ->
J.readJSON (J.showJSON flt) ==? J.Ok flt
prop_Qlang_FilterRegex_instances :: Qlang.FilterRegex -> Property
prop_Qlang_FilterRegex_instances rex =
printTestCase "failed JSON encoding"
(J.readJSON (J.showJSON rex) ==? J.Ok rex) .&&.
printTestCase "failed read/show instances" (read (show rex) ==? rex)
testSuite "Qlang"
[ 'prop_Qlang_Serialisation
, 'prop_Qlang_FilterRegex_instances
]
......
......@@ -54,7 +54,7 @@ import qualified Data.Map as Map
import Data.Traversable (traverse)
import Text.JSON (JSValue(..), fromJSString)
import Text.JSON.Pretty (pp_value)
import Text.Regex.PCRE ((=~))
import qualified Text.Regex.PCRE as PCRE
import Ganeti.BasicTypes
import Ganeti.Objects
......@@ -115,8 +115,9 @@ binOpFilter _ expr actual =
show (pp_value actual) ++ " with '" ++ show expr ++ "'"
-- | Implements the 'RegexpFilter' matching.
regexpFilter :: String -> JSValue -> Result Bool
regexpFilter re (JSString val) = Ok $ (fromJSString val) =~ re
regexpFilter :: FilterRegex -> JSValue -> Result Bool
regexpFilter re (JSString val) =
Ok $ PCRE.match (compiledRegex re) (fromJSString val)
regexpFilter _ x =
Bad $ "Invalid field value used in regexp matching,\
\ expecting string but got '" ++ show (pp_value x) ++ "'"
......
......@@ -29,6 +29,10 @@ module Ganeti.Query.Language
( Filter(..)
, FilterField
, FilterValue(..)
, FilterRegex -- note: we don't export the constructor, must use helpers
, mkRegex
, stringRegex
, compiledRegex
, Fields
, Query(..)
, QueryResult(..)
......@@ -53,6 +57,7 @@ import Data.Ratio (numerator, denominator)
import Text.JSON.Pretty (pp_value)
import Text.JSON.Types
import Text.JSON
import qualified Text.Regex.PCRE as PCRE
import qualified Ganeti.Constants as C
import Ganeti.THH
......@@ -123,7 +128,7 @@ data Filter a
| GTFilter a FilterValue -- ^ > <field> <value>
| LEFilter a FilterValue -- ^ <= <field> <value>
| GEFilter a FilterValue -- ^ >= <field> <value>
| RegexpFilter a FilterRegexp -- ^ =~ <field> <regexp>
| RegexpFilter a FilterRegex -- ^ =~ <field> <regexp>
| ContainsFilter a FilterValue -- ^ =[] <list-field> <value>
deriving (Show, Read, Eq)
......@@ -270,8 +275,50 @@ instance JSON FilterValue where
showJSON = showFilterValue
readJSON = readFilterValue
-- | Regexp to apply to the filter value, for filteriong purposes.
type FilterRegexp = String
-- | Regexp to apply to the filter value, for filtering purposes. It
-- holds both the string format, and the \"compiled\" format, so that
-- we don't re-compile the regex at each match attempt.
data FilterRegex = FilterRegex
{ stringRegex :: String -- ^ The string version of the regex
, compiledRegex :: PCRE.Regex -- ^ The compiled regex
}
-- | Builder for 'FilterRegex'. We always attempt to compile the
-- regular expression on the initialisation of the data structure;
-- this might fail, if the RE is not well-formed.
mkRegex :: (Monad m) => String -> m FilterRegex
mkRegex str = do
compiled <- case PCRE.getVersion of
Nothing -> fail "regex-pcre library compiled without\
\ libpcre, regex functionality not available"
_ -> PCRE.makeRegexM str
return $ FilterRegex str compiled
-- | 'Show' instance: we show the constructor plus the string version
-- of the regex.
instance Show FilterRegex where
show (FilterRegex re _) = "mkRegex " ++ show re
-- | 'Read' instance: we manually read \"mkRegex\" followed by a
-- string, and build the 'FilterRegex' using that.
instance Read FilterRegex where
readsPrec _ str = do
("mkRegex", s') <- lex str
(re, s'') <- reads s'
filterre <- mkRegex re
return (filterre, s'')
-- | 'Eq' instance: we only compare the string versions of the regexes.
instance Eq FilterRegex where
(FilterRegex re1 _) == (FilterRegex re2 _) = re1 == re2
-- | 'JSON' instance: like for show and read instances, we work only
-- with the string component.
instance JSON FilterRegex where
showJSON (FilterRegex re _) = showJSON re
readJSON s = do
re <- readJSON s
mkRegex re
-- | Name of a field.
type FieldName = String
......
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