diff --git a/app/Main.hs b/app/Main.hs index 0eac437..4beafd4 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -18,17 +18,6 @@ import System.Exit (exitWith, ExitCode(..)) import Data.List (intercalate) import Data.Char (isSpace) -shift n = take (n*2) $ repeat ' ' -indentBy n = unlines . fmap (shift n ++) . lines - -wrapRules r = intercalate "\n" - [ "service cloud.firestore {" - , " match /databases/{database}/documents {" - , "" - , indentBy 2 r - , " }" - , "}" - ] out output (Left e) = hPutStrLn stderr e out output (Right v) = output v @@ -36,7 +25,7 @@ out output (Right v) = output v generate lang | lang == "typescript" = TSGenerator.generate | lang == "ts" = TSGenerator.generate - | lang == "rules" = fmap wrapRules . RuleGenerator.generate + | lang == "rules" = RuleGenerator.generate True | otherwise = const . Left $ "Specified language \""++lang++"\"not recognized." diff --git a/examples/readme.ward b/examples/readme.ward index 72fee80..c5dd8be 100644 --- a/examples/readme.ward +++ b/examples/readme.ward @@ -1,3 +1,5 @@ +rules_version = '2' + type User = { name: { first: string, last: string }, // inline nested objects friends: string[], // a list of strings (string type not validated) @@ -18,5 +20,5 @@ function isLoggedInUser(userId) { match /users/{userId} is User { // read, write, create, update, list, get and delete conditions are allowed allow read, create, update: if isLoggedInUser(userId); - allow delete: false; + allow delete: isLoggedInUser('admin'); } diff --git a/fireward.cabal b/fireward.cabal index afe2819..540f5dd 100644 --- a/fireward.cabal +++ b/fireward.cabal @@ -47,7 +47,15 @@ test-suite fireward-test , fireward , hspec , QuickCheck - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wno-missing-home-modules + other-modules: ExprParserSpec + , LocSpec + , LogicPrinterSpec + , OptionParserSpec + , ParserSpec + , RuleGeneratorSpec + , RuleParserSpec + , TSGeneratorSpec + ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 source-repository head diff --git a/readme.md b/readme.md index c92a478..b26330a 100644 --- a/readme.md +++ b/readme.md @@ -82,6 +82,8 @@ match /users/{id} is User { ### Complete Example ``` +rules_version = '2' // optional, see https://firebase.google.com/docs/firestore/security/get-started#security_rules_version_2 + type User = { name: { first: string, last: string }, // inline nested objects friends: string[], // a list of strings (string type not validated) diff --git a/src/RuleGenerator.hs b/src/RuleGenerator.hs index 15063ef..d4313cc 100644 --- a/src/RuleGenerator.hs +++ b/src/RuleGenerator.hs @@ -38,15 +38,21 @@ surround b e s = concat [b,s,e] printLoc l c = "line " ++ show (l+1) ++", column "++show (c+1) -- the main exported function. calls the `gen` function internally. -generate :: String -> Either String String -generate source = q tree +generate :: Bool -> String -> Either String String +generate wrap source = q tree where + finalize :: [TopLevel] -> [String] -> String + finalize tops lines = joinLines $ if wrap then optVars tops ++ wrapRules lines else lines + optVar (TopLevelOpt name val) = name ++ " = " ++ val ++ ";" + optVar _ = "" + optVars tops = optVar <$> tops tree :: ParserResult [TopLevel]-- [([TopLevel], String)] tree = parseRules source q :: ParserResult [TopLevel] -> Either String String - q (Right (tops, unparsed, l, c)) = if length unparsed > 0 - then Left ("Could not parse on\n on " ++ printLoc l c) - else Right . trim . joinLines $ gen <$> tops + q (Right (tops, unparsed, l, c)) = + if length unparsed > 0 + then Left ("Could not parse on\n on " ++ printLoc l c) + else Right . finalize tops $ gen <$> tops q (Left (Just (error, l, c))) = Left (error ++ "\n on " ++ printLoc l c) q (Left Nothing) = Left ("Unexpected parser error.") @@ -60,6 +66,22 @@ funcBlock ind (FuncDef name params body) = concat body' = trim . unlines $ (indent (ind + 2) ++) <$> lines body +wrapRules :: [String] -> [String] +wrapRules r = + [ "service cloud.firestore {" + , " match /databases/{database}/documents {" + , "" + ] + ++ indented ++ + [ "" + , " }" + , "}" + ] + where + indented = indentLinesBy2 r :: [String] + indentLinesBy2 = fmap (shift 2 ++) + shift n = take (n*2) $ repeat ' ' + data FuncParam = FuncParam (Maybe String) String -- the main recursive function to generate the type function typeFunc :: String -> [TypeRef] -> String @@ -144,6 +166,7 @@ typeFunc name refs = gen :: TopLevel -> String +gen (TopLevelOpt name val) = "" -- this will be generated after wrapping the code gen (TopLevelFunc def) = funcBlock 0 def gen (TopLevelType name refs) = typeFunc name refs gen (TopLevelPath def) = pathBlock 0 def diff --git a/src/RuleParser.hs b/src/RuleParser.hs index 29eff82..9ce0b0d 100644 --- a/src/RuleParser.hs +++ b/src/RuleParser.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -fwarn-incomplete-patterns #-} module RuleParser ( parseRules , apply @@ -13,6 +12,7 @@ module RuleParser , _funcDef , _funcBody , _string +, _topLevelOptVar , escape , FuncDef (..) , TypeDef (..) @@ -34,6 +34,7 @@ import Combinators data TopLevel = TopLevelType String [TypeRef] | TopLevelPath PathDef | TopLevelFunc FuncDef + | TopLevelOpt String String deriving (Show, Eq) type PathOp = String @@ -71,6 +72,16 @@ data Field = Field - str = "(all - {"})*" -} +_topLevelOptVar = do + name <- token _var + symbol "=" + optional space + val <- require "configuration option value is not provided" $ _string <|> some digit + optional space + optional $ symbol ";" + return $ TopLevelOpt name val + where _var = _concat [ some $ _alpha <|> oneOf "_", many $ _alphaNum <|> oneOf "_" ] "" + _funcBody :: Parser String _funcBody = token $ do let notDone c = c/='}' && c/=';' && c/='"' @@ -202,7 +213,8 @@ _path = do require "expected a closing `}`" $ symbol "}" return $ PathDef parts className body -_topLevel = (TopLevelPath <$> _path) +_topLevel = _topLevelOptVar + <|> (TopLevelPath <$> _path) <|> _topLevelType <|> TopLevelFunc <$> _funcDef diff --git a/src/TSGenerator.hs b/src/TSGenerator.hs index ea85f84..d3ac1c9 100644 --- a/src/TSGenerator.hs +++ b/src/TSGenerator.hs @@ -35,7 +35,7 @@ block ind items = joinLines natives = [ ("int", "number") , ("float", "number") - , ("timestamp", "{seconds: number, nanoseconds: number}|{isEqual: (other: any)=>boolean}") + , ("timestamp", "Date|{seconds: number, nanoseconds: number}|{isEqual: (other: any)=>boolean}") , ("bool", "boolean") , ("null", "null") ] diff --git a/test/RuleGeneratorSpec.hs b/test/RuleGeneratorSpec.hs index e3853f3..aa8b784 100644 --- a/test/RuleGeneratorSpec.hs +++ b/test/RuleGeneratorSpec.hs @@ -28,7 +28,7 @@ showN = repA . show showE (Right x) = "Right " ++ repA x showE (Left x) = "Left " ++ repA x -- showE (Left Nothing) = "Left Nothing" -g = showE . RuleGenerator.generate +g = showE . RuleGenerator.generate False gt z = (\x->trace (showN x) x) (g z) gu = g . trim . unlines r = ("Right " ++) . repA diff --git a/test/RuleParserSpec.hs b/test/RuleParserSpec.hs index eeb3dcb..088df76 100644 --- a/test/RuleParserSpec.hs +++ b/test/RuleParserSpec.hs @@ -238,5 +238,9 @@ spec = do PathBodyFunc (FuncDef "qqq" ["a","b","c"] "123")]) ]) ],"") + describe "_topLevelOptVar" $ do + it "parses" $ + _parse "fff = '2'" `shouldBe` Right ([ TopLevelOpt "fff" "'2'"], "") + diff --git a/test/TSGeneratorSpec.hs b/test/TSGeneratorSpec.hs index f812201..b5ef294 100644 --- a/test/TSGeneratorSpec.hs +++ b/test/TSGeneratorSpec.hs @@ -29,7 +29,7 @@ gt z = (\x->trace (showN x) x) (g z) gu = g . trim . unlines r = ("Right " ++) . repA ru = r . trim . unlines -timestamp = "{seconds: number, nanoseconds: number}|{isEqual: (other: any)=>boolean}" +timestamp = "Date|{seconds: number, nanoseconds: number}|{isEqual: (other: any)=>boolean}" spec :: Spec