Added support for 'CREATE POLICY .. FOR ..' sql statements

mpscholten · mpscholten · commit e904b9156dc2 · 2022-02-16T14:19:27.000+01:00
diff --git a/IHP/IDE/CodeGen/MigrationGenerator.hs b/IHP/IDE/CodeGen/MigrationGenerator.hs
@@ -340,11 +340,14 @@ normalizeStatement StatementCreateTable { unsafeGetCreateTable = table } = State
         (normalizedTable, normalizeTableRest) = normalizeTable table
 normalizeStatement AddConstraint { tableName, constraint } = [ AddConstraint { tableName, constraint = normalizeConstraint constraint } ]
 normalizeStatement CreateEnumType { name, values } = [ CreateEnumType { name = Text.toLower name, values = map Text.toLower values } ]
-normalizeStatement CreatePolicy { name, tableName, using, check } = [ CreatePolicy { name, tableName, using = normalizeExpression <$> using, check = normalizeExpression <$> check } ]
+normalizeStatement CreatePolicy { name, action, tableName, using, check } = [ CreatePolicy { name, tableName, using = normalizeExpression <$> using, check = normalizeExpression <$> check, action = normalizePolicyAction action } ]
 normalizeStatement CreateIndex { expressions, .. } = [ CreateIndex { expressions = map normalizeExpression expressions, .. } ]
 normalizeStatement CreateFunction { .. } = [ CreateFunction { orReplace = False, .. } ]
 normalizeStatement otherwise = [otherwise]
 
+normalizePolicyAction (Just PolicyForAll) = Nothing
+normalizePolicyAction otherwise = otherwise
+
 normalizeTable :: CreateTable -> (CreateTable, [Statement])
 normalizeTable table@(CreateTable { .. }) = ( CreateTable { columns = fst normalizedColumns, constraints = normalizedTableConstraints, .. }, (concat $ (snd normalizedColumns)) <> normalizedConstraintsStatements )
     where
diff --git a/IHP/IDE/SchemaDesigner/Compiler.hs b/IHP/IDE/SchemaDesigner/Compiler.hs
@@ -35,7 +35,7 @@ compileStatement Comment { content } = "--" <> content
 compileStatement CreateIndex { indexName, unique, tableName, expressions, whereClause } = "CREATE" <> (if unique then " UNIQUE " else " ") <> "INDEX " <> indexName <> " ON " <> tableName <> " (" <> (intercalate ", " (map compileExpression expressions)) <> ")" <> (case whereClause of Just expression -> " WHERE " <> compileExpression expression; Nothing -> "") <> ";"
 compileStatement CreateFunction { functionName, functionBody, orReplace, returns, language } = "CREATE " <> (if orReplace then "OR REPLACE " else "") <> "FUNCTION " <> functionName <> "() RETURNS " <> compilePostgresType returns <> " AS $$" <> functionBody <> "$$ language " <> language <> ";"
 compileStatement EnableRowLevelSecurity { tableName } = "ALTER TABLE " <> tableName <> " ENABLE ROW LEVEL SECURITY;"
-compileStatement CreatePolicy { name, tableName, using, check } = "CREATE POLICY " <> compileIdentifier name <> " ON " <> compileIdentifier tableName <> maybe "" (\expr -> " USING (" <> compileExpression expr <> ")") using <> maybe "" (\expr -> " WITH CHECK (" <> compileExpression expr <> ")") check <> ";"
+compileStatement CreatePolicy { name, action, tableName, using, check } = "CREATE POLICY " <> compileIdentifier name <> maybe "" (\action -> " FOR " <> compilePolicyAction action) action <> " ON " <> compileIdentifier tableName <> maybe "" (\expr -> " USING (" <> compileExpression expr <> ")") using <> maybe "" (\expr -> " WITH CHECK (" <> compileExpression expr <> ")") check <> ";"
 compileStatement CreateSequence { name } = "CREATE SEQUENCE " <> compileIdentifier name <> ";"
 compileStatement DropConstraint { tableName, constraintName } = "ALTER TABLE " <> compileIdentifier tableName <> " DROP CONSTRAINT " <> compileIdentifier constraintName <> ";"
 compileStatement DropEnumType { name } = "DROP TYPE " <> compileIdentifier name <> ";"
@@ -432,4 +432,11 @@ compileTriggerEvent TriggerOnTruncate = "TRUNCATE"
 
 compileTriggerFor :: TriggerFor -> Text
 compileTriggerFor ForEachRow = "FOR EACH ROW"
-compileTriggerFor ForEachStatement = "FOR EACH STATEMENT"
+compileTriggerFor ForEachStatement = "FOR EACH STATEMENT"
+
+compilePolicyAction :: PolicyAction -> Text
+compilePolicyAction PolicyForAll = "ALL"
+compilePolicyAction PolicyForSelect = "SELECT"
+compilePolicyAction PolicyForInsert = "INSERT"
+compilePolicyAction PolicyForUpdate = "UPDATE"
+compilePolicyAction PolicyForDelete = "DELETE"
diff --git a/IHP/IDE/SchemaDesigner/Parser.hs b/IHP/IDE/SchemaDesigner/Parser.hs
@@ -652,6 +652,7 @@ createPolicy = do
     lexeme "CREATE"
     lexeme "POLICY"
     name <- identifier
+    action <- optional (lexeme "FOR" >> policyAction)
     lexeme "ON"
     tableName <- qualifiedIdentifier
 
@@ -666,8 +667,14 @@ createPolicy = do
 
     char ';'
 
-    pure CreatePolicy { name, tableName, using, check }
+    pure CreatePolicy { name, action, tableName, using, check }
 
+policyAction =
+    (lexeme "ALL" >> pure PolicyForAll)
+    <|> (lexeme "SELECT" >> pure PolicyForSelect)
+    <|> (lexeme "INSERT" >> pure PolicyForInsert)
+    <|> (lexeme "UPDATE" >> pure PolicyForUpdate)
+    <|> (lexeme "DELETE" >> pure PolicyForDelete)
 
 setStatement = do
     lexeme "SET"
diff --git a/IHP/IDE/SchemaDesigner/SchemaOperations.hs b/IHP/IDE/SchemaDesigner/SchemaOperations.hs
@@ -151,7 +151,7 @@ updatePolicy UpdatePolicyOptions { .. } statements =
         statements
         |> map updatePolicy'
     where
-        updatePolicy' policy@CreatePolicy { name = pName, tableName = pTable } | pName == currentName && pTable == tableName = CreatePolicy { tableName, name, using, check }
+        updatePolicy' policy@CreatePolicy { name = pName, action, tableName = pTable } | pName == currentName && pTable == tableName = CreatePolicy { tableName, action, name, using, check }
         updatePolicy' otherwise                                                                                              = otherwise
 
 data AddPolicyOptions = AddPolicyOptions
@@ -164,7 +164,7 @@ data AddPolicyOptions = AddPolicyOptions
 addPolicy :: AddPolicyOptions -> Schema -> Schema
 addPolicy AddPolicyOptions { .. } statements = statements <> createPolicyStatement
     where
-        createPolicyStatement = [ CreatePolicy { tableName, name, using, check } ]
+        createPolicyStatement = [ CreatePolicy { tableName, action = Nothing, name, using, check } ]
 
 data DeletePolicyOptions = DeletePolicyOptions
     { tableName :: !Text
@@ -235,6 +235,7 @@ suggestPolicy :: Schema -> Statement -> Statement
 suggestPolicy schema (StatementCreateTable CreateTable { name = tableName, columns })
     | isJust (find isUserIdColumn columns)  = CreatePolicy
         { name = "Users can manage their " <> tableName
+        , action = Nothing
         , tableName
         , using = Just compareUserId
         , check = Just compareUserId
@@ -252,6 +253,7 @@ suggestPolicy schema (StatementCreateTable CreateTable { name = tableName, colum
             columnWithFKAndRefTableToPolicy :: (Column, Constraint, CreateTable) -> Maybe Statement
             columnWithFKAndRefTableToPolicy (column, ForeignKeyConstraint { referenceColumn }, CreateTable { name = refTableName, columns = refTableColumns }) | isJust (find isUserIdColumn refTableColumns) = Just CreatePolicy
                     { name = "Users can manage the " <> tableName <> " if they can see the " <> tableNameToModelName refTableName
+                    , action = Nothing
                     , tableName
                     , using = Just delegateCheck
                     , check = Just delegateCheck
@@ -304,7 +306,7 @@ suggestPolicy schema (StatementCreateTable CreateTable { name = tableName, colum
                     |> fmap \case
                         StatementCreateTable table -> table
 
-            emptyPolicy = CreatePolicy { name = "", tableName, using = Nothing, check = Nothing }
+            emptyPolicy = CreatePolicy { name = "", action = Nothing, tableName, using = Nothing, check = Nothing }
 
 isUserIdColumn :: Column -> Bool
 isUserIdColumn Column { name = "user_id" } = True
diff --git a/IHP/IDE/SchemaDesigner/Types.hs b/IHP/IDE/SchemaDesigner/Types.hs
@@ -39,7 +39,7 @@ data Statement
     -- | ALTER TABLE tableName ENABLE ROW LEVEL SECURITY;
     | EnableRowLevelSecurity { tableName :: Text }
     -- CREATE POLICY name ON tableName USING using WITH CHECK check;
-    | CreatePolicy { name :: Text, tableName :: Text, using :: Maybe Expression, check :: Maybe Expression }
+    | CreatePolicy { name :: Text, tableName :: Text, action :: Maybe PolicyAction, using :: Maybe Expression, check :: Maybe Expression }
     -- SET name = value;
     | Set { name :: Text, value :: Expression }
     -- SELECT query;
@@ -214,4 +214,12 @@ data TriggerEvent
 data TriggerFor
     = ForEachRow
     | ForEachStatement
+    deriving (Eq, Show)
+
+data PolicyAction
+    = PolicyForAll
+    | PolicyForSelect
+    | PolicyForInsert
+    | PolicyForUpdate
+    | PolicyForDelete
     deriving (Eq, Show)
diff --git a/Test/IDE/SchemaDesigner/ParserSpec.hs b/Test/IDE/SchemaDesigner/ParserSpec.hs
@@ -528,6 +528,7 @@ $$;
         it "should parse 'CREATE POLICY' statements" do
             parseSql "CREATE POLICY \"Users can manage their tasks\" ON tasks USING (user_id = ihp_user_id()) WITH CHECK (user_id = ihp_user_id());" `shouldBe` CreatePolicy
                     { name = "Users can manage their tasks"
+                    , action = Nothing
                     , tableName = "tasks"
                     , using = Just (
                         EqExpression
@@ -718,10 +719,21 @@ COMMENT ON EXTENSION "uuid-ossp" IS 'generate universally unique identifiers (UU
         it "should parse 'DROP POLICY .. ON ..' statements" do
             parseSql "DROP POLICY \"Users can manage their todos\" ON todos;" `shouldBe` DropPolicy { tableName = "todos", policyName = "Users can manage their todos" }
 
+        it "should parse 'CREATE POLICY .. FOR SELECT' statements" do
+            let sql = cs [plain|CREATE POLICY "Messages are public" FOR SELECT ON messages USING (true);|]
+            parseSql sql `shouldBe` CreatePolicy
+                    { name = "Messages are public"
+                    , action = Just PolicyForSelect
+                    , tableName = "messages"
+                    , using = Just (VarExpression "true")
+                    , check = Nothing
+                    }
+
         it "should parse policies with an EXISTS condition" do
             let sql = cs [plain|CREATE POLICY "Users can manage their project's migrations" ON migrations USING (EXISTS (SELECT 1 FROM projects WHERE id = project_id)) WITH CHECK (EXISTS (SELECT 1 FROM projects WHERE id = project_id));|]
             parseSql sql `shouldBe` CreatePolicy
                     { name = "Users can manage their project's migrations"
+                    , action = Nothing
                     , tableName = "migrations"
                     , using = Just (ExistsExpression (SelectExpression (Select {columns = [IntExpression 1], from = VarExpression "projects", alias = Nothing, whereClause = EqExpression (VarExpression "id") (VarExpression "project_id")})))
                     , check = Just (ExistsExpression (SelectExpression (Select {columns = [IntExpression 1], from = VarExpression "projects", alias = Nothing, whereClause = EqExpression (VarExpression "id") (VarExpression "project_id")})))
@@ -731,6 +743,7 @@ COMMENT ON EXTENSION "uuid-ossp" IS 'generate universally unique identifiers (UU
             let sql = cs [plain|CREATE POLICY "Users can manage their project's migrations" ON migrations USING (EXISTS (SELECT 1 FROM public.projects WHERE projects.id = migrations.project_id)) WITH CHECK (EXISTS (SELECT 1 FROM public.projects WHERE projects.id = migrations.project_id));|]
             parseSql sql `shouldBe` CreatePolicy
                     { name = "Users can manage their project's migrations"
+                    , action = Nothing
                     , tableName = "migrations"
                     , using = Just (ExistsExpression (SelectExpression (Select {columns = [IntExpression 1], from = DotExpression (VarExpression "public") "projects", alias = Nothing, whereClause = EqExpression (DotExpression (VarExpression "projects") "id") (DotExpression (VarExpression "migrations") "project_id")})))
                     , check = Just (ExistsExpression (SelectExpression (Select {columns = [IntExpression 1], from = DotExpression (VarExpression "public") "projects", alias = Nothing, whereClause = EqExpression (DotExpression (VarExpression "projects") "id") (DotExpression (VarExpression "migrations") "project_id")})))
@@ -785,6 +798,7 @@ COMMENT ON EXTENSION "uuid-ossp" IS 'generate universally unique identifiers (UU
             |]
             parseSql sql `shouldBe` CreatePolicy
                     { name = "Users can see other users in their company"
+                    , action = Nothing
                     , tableName = "users"
                     , using = Just (EqExpression (VarExpression "company_id") (SelectExpression (Select {columns = [DotExpression (VarExpression "users_1") "company_id"], from = DotExpression (VarExpression "public") "users", alias = Just "users_1", whereClause = EqExpression (DotExpression (VarExpression "users_1") "id") (CallExpression "ihp_user_id" [])})))
                     , check = Nothing
diff --git a/Test/IDE/SchemaDesigner/SchemaOperationsSpec.hs b/Test/IDE/SchemaDesigner/SchemaOperationsSpec.hs
@@ -79,7 +79,7 @@ tests = do
                 (SchemaOperations.disableRowLevelSecurityIfNoPolicies "a" inputSchema) `shouldBe` inputSchema
             
             it "should not do anything if there's a policy" do
-                let policy = CreatePolicy { tableName = "a", name = "p", check = Nothing, using = Nothing }
+                let policy = CreatePolicy { tableName = "a", action = Nothing, name = "p", check = Nothing, using = Nothing }
                 let inputSchema = [tableA, EnableRowLevelSecurity { tableName = "a"}, policy]
 
                 (SchemaOperations.disableRowLevelSecurityIfNoPolicies "a" inputSchema) `shouldBe` inputSchema
@@ -115,6 +115,7 @@ tests = do
                 let schema = [table]
                 let expectedPolicy = CreatePolicy
                         { name = "Users can manage their posts"
+                        , action = Nothing
                         , tableName = "posts"
                         , using = Just (EqExpression (VarExpression "user_id") (CallExpression "ihp_user_id" []))
                         , check = Just (EqExpression (VarExpression "user_id") (CallExpression "ihp_user_id" []))
@@ -135,6 +136,7 @@ tests = do
                 let schema = [table]
                 let expectedPolicy = CreatePolicy
                         { name = ""
+                        , action = Nothing
                         , tableName = "posts"
                         , using = Nothing
                         , check = Nothing
@@ -166,6 +168,7 @@ tests = do
                             ]
                 let expectedPolicy = CreatePolicy
                         { name = "Users can manage the tasks if they can see the TaskList"
+                        , action = Nothing
                         , tableName = "tasks"
                         , using = Just (ExistsExpression (SelectExpression (Select {columns = [IntExpression 1], from = DotExpression (VarExpression "public") "task_lists", alias = Nothing, whereClause = EqExpression (DotExpression (VarExpression "task_lists") "id") (DotExpression (VarExpression "tasks") "task_list_id")})))
                         , check = Just (ExistsExpression (SelectExpression (Select {columns = [IntExpression 1], from = DotExpression (VarExpression "public") "task_lists", alias = Nothing, whereClause = EqExpression (DotExpression (VarExpression "task_lists") "id") (DotExpression (VarExpression "tasks") "task_list_id")})))
