Merge pull request #1556 from digitallyinduced/drop-policy-if-droppin…

…g-column

Drop policy if dropping column

IHP/IDE/SchemaDesigner/SchemaOperations.hs

@@ -552,11 +552,43 @@ deleteColumn DeleteColumnOptions { .. } schema =
                 then deleteTriggerIfExists (updatedAtTriggerName tableName)
                 else \schema -> schema
             )
+        |> filter deletePolicyReferencingPolicy
     where
         deleteColumnInTable :: Statement -> Statement
         deleteColumnInTable (StatementCreateTable table@CreateTable { name, columns }) | name == tableName = StatementCreateTable $ table { columns = delete (columns !! columnId) columns}
         deleteColumnInTable statement = statement
 
+        deletePolicyReferencingPolicy :: Statement -> Bool
+        deletePolicyReferencingPolicy CreatePolicy { tableName = policyTable, using, check } | policyTable == tableName = 
+            case (using, check) of
+                (Just using, Nothing) -> not (isRef using)
+                (Nothing, Just check) -> not (isRef check)
+                (Just using, Just check) -> not (isRef using && isRef check)
+            where
+                isRef :: Expression -> Bool
+                isRef (TextExpression {}) = False
+                isRef (VarExpression var) = var == columnName
+                isRef (CallExpression _ args) = foldl' (||) False (map isRef args)
+                isRef (NotEqExpression a b) = isRef a || isRef b
+                isRef (EqExpression a b) = isRef a || isRef b
+                isRef (AndExpression a b) = isRef a || isRef b
+                isRef (IsExpression a b) = isRef a || isRef b
+                isRef (InExpression a b) = isRef a || isRef b
+                isRef (NotExpression a) = isRef a
+                isRef (ExistsExpression a) = isRef a
+                isRef (OrExpression a b) = isRef a || isRef b
+                isRef (LessThanExpression a b) = isRef a || isRef b
+                isRef (LessThanOrEqualToExpression a b) = isRef a || isRef b
+                isRef (GreaterThanExpression a b) = isRef a || isRef b
+                isRef (GreaterThanOrEqualToExpression a b) = isRef a || isRef b
+                isRef (DoubleExpression _) = False
+                isRef (IntExpression _) = False
+                isRef (TypeCastExpression a _) = isRef a
+                isRef (SelectExpression _) = False
+                isRef (DotExpression a _) = isRef a
+                isRef (ConcatenationExpression a b) = isRef a || isRef b
+        deletePolicyReferencingPolicy otherwise = True
+
 -- | Returns True if a CreateIndex statement references a specific column
 --
 -- E.g. given a schema like this:

IHP/IDE/SchemaDesigner/View/Layout.hs

@@ -345,12 +345,12 @@ suggestedColumnsSection tableName indexAndColumns = unless isUsersTable [hsx|
                     <input type="hidden" name="columnType" value="UUID"/>
                     <input type="hidden" name="primaryKey" value={inputValue False}/>
                     <input type="hidden" name="isArray" value={inputValue False}/>
-                    <input type="hidden" name="defaultValue" value="ihp_user_id()"/>
+                    <input type="hidden" name="defaultValue" value={if usesRLS then "ihp_user_id()" :: Text else ""}/>
                     <input type="hidden" name="allowNull" value={inputValue False}/>
                     <input type="hidden" name="isUnique" value={inputValue False}/>
                     <input type="hidden" name="isReference" value={inputValue True}/>
                     <input type="hidden" name="referenceTable" value="users"/>
-                    <input type="hidden" name="autoPolicy" value={inputValue True}/>
+                    <input type="hidden" name="autoPolicy" value={inputValue usesRLS}/>
 
                     <button type="submit" class="btn btn-suggested-table">
                         <table class="table table-sm mb-0">
@@ -368,6 +368,10 @@ suggestedColumnsSection tableName indexAndColumns = unless isUsersTable [hsx|
                 </form>
             |]
 
+        -- TODO: this should be set to True if the Schema.sql contains any RLS related code
+        usesRLS :: Bool
+        usesRLS = False
+
 
 renderColumn :: Column -> Int -> Text -> [Statement] -> Html
 renderColumn Column { name, columnType, defaultValue, notNull, isUnique } id tableName statements = [hsx|

Test/IDE/CodeGeneration/MigrationGenerator.hs

@@ -1204,8 +1204,33 @@ CREATE POLICY "Users can read and edit their own record" ON public.users USING (
                 |]
 
                 diffSchemas targetSchema actualSchema `shouldBe` migration
+
+            it "should delete policies when the column is deleted" do
+                -- https://github.com/digitallyinduced/ihp/issues/1480
+                let targetSchema = sql $ cs [plain|
+                    CREATE TABLE artefacts (
+                        id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
+                        created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL,
+                        updated_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL
+                    );
+                    ALTER TABLE artefacts ENABLE ROW LEVEL SECURITY;
+                |]
+                let actualSchema = sql $ cs [plain|
+                    CREATE TABLE artefacts (
+                        id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
+                        created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL,
+                        updated_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL,
+                        user_id UUID DEFAULT ihp_user_id() NOT NULL
+                    );
+                    ALTER TABLE artefacts ENABLE ROW LEVEL SECURITY;
+                    CREATE POLICY "Users can manage their artefacts" ON artefacts USING (user_id = ihp_user_id()) WITH CHECK (user_id = ihp_user_id());
+                |]
+                let migration = sql [i|
+                    ALTER TABLE artefacts DROP COLUMN user_id;
+                    DROP POLICY "Users can manage their artefacts" ON artefacts;
+                |]
 
-
+                diffSchemas targetSchema actualSchema `shouldBe` migration
 sql :: Text -> [Statement]
 sql code = case Megaparsec.runParser Parser.parseDDL "" code of
     Left parsingFailed -> error (cs $ Megaparsec.errorBundlePretty parsingFailed)

Test/IDE/SchemaDesigner/SchemaOperationsSpec.hs

@@ -409,6 +409,35 @@ tests = do
                         }
 
                 (SchemaOperations.deleteColumn options inputSchema) `shouldBe` expectedSchema
+
+            it "should delete an referenced policy" do
+                let tableAWithUserId = StatementCreateTable CreateTable
+                            { name = "a"
+                            , columns = [
+                                    Column
+                                        { name = "user_id"
+                                        , columnType = PUUID
+                                        , defaultValue = Just (CallExpression "ihp_user_id" [])
+                                        , notNull = True
+                                        , isUnique = False
+                                        , generator = Nothing
+                                        }
+                            ]
+                            , primaryKeyConstraint = PrimaryKeyConstraint []
+                            , constraints = []
+                            }
+                let policy = CreatePolicy { name = "a_policy", tableName = "a", action = Nothing, using = Just (EqExpression (VarExpression "user_id") (CallExpression "ihp_user_id" [])), check = Nothing }
+
+                let inputSchema = [tableAWithUserId, policy]
+                let expectedSchema = [tableA]
+
+                let options = SchemaOperations.DeleteColumnOptions
+                        { tableName = "a"
+                        , columnName = "user_id"
+                        , columnId = 0
+                        }
+
+                (SchemaOperations.deleteColumn options inputSchema) `shouldBe` expectedSchema
         describe "update" do
             it "update a column's name, type, default value and not null" do
                 let tableAWithCreatedAt = StatementCreateTable CreateTable