diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 81dd850237..5529607769 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -358,11 +358,18 @@ handleInfo identifier RequestContext{..} = allOrigins = ("Access-Control-Allow-Origin", "*") allowH table = ( HTTP.hAllow - , if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET" + , BS8.intercalate "," $ + ["OPTIONS,GET,HEAD"] + ++ ["POST" | tableInsertable table] + ++ ["PUT" | tableInsertable table && tableUpdatable table && hasPK] + ++ ["PATCH" | tableUpdatable table] + ++ ["DELETE" | tableDeletable table] ) tableMatches table = tableName table == qiName identifier && tableSchema table == qiSchema identifier + hasPK = + not $ null $ tablePKCols ctxDbStructure (qiSchema identifier) (qiName identifier) handleInvoke :: InvokeMethod -> ProcDescription -> RequestContext -> DbHandler Wai.Response handleInvoke invMethod proc context@RequestContext{..} = do diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index 6c10d36e89..4afd1f0f7e 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -118,6 +118,8 @@ decodeTables = <*> column HD.text <*> nullableColumn HD.text <*> column HD.bool + <*> column HD.bool + <*> column HD.bool decodeColumns :: [Table] -> HD.Result [Column] decodeColumns tables = @@ -311,22 +313,40 @@ accessibleTables = relname as table_name, d.description as table_description, ( - c.relkind in ('r', 'v', 'f') - and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8 - -- The function `pg_relation_is_updateable` returns a bitmask where 8 - -- corresponds to `1 << CMD_INSERT` in the PostgreSQL source code, i.e. - -- it's possible to insert into the relation. - or (exists ( - select 1 - from pg_trigger - where + c.relkind IN ('r', 'v','f') + AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8 + OR EXISTS ( + SELECT 1 + FROM pg_trigger + WHERE pg_trigger.tgrelid = c.oid - and (pg_trigger.tgtype::integer & 69) = 69) - -- The trigger type `tgtype` is a bitmask where 69 corresponds to - -- TRIGGER_TYPE_ROW + TRIGGER_TYPE_INSTEAD + TRIGGER_TYPE_INSERT - -- in the PostgreSQL source code. + AND (pg_trigger.tgtype::integer & 69) = 69 ) - ) as insertable + ) AS insertable, + ( + c.relkind IN ('r', 'v','f') + AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 4) = 4 + -- CMD_UPDATE + OR EXISTS ( + SELECT 1 + FROM pg_trigger + WHERE + pg_trigger.tgrelid = c.oid + and (pg_trigger.tgtype::integer & 81) = 81 + ) + ) as updatable, + ( + c.relkind IN ('r', 'v','f') + AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 16) = 16 + -- CMD_DELETE + OR EXISTS ( + SELECT 1 + FROM pg_trigger + WHERE + pg_trigger.tgrelid = c.oid + and (pg_trigger.tgtype::integer & 73) = 73 + ) + ) as deletable from pg_class c join pg_namespace n on n.oid = c.relnamespace @@ -452,21 +472,61 @@ allTables = c.relname AS table_name, NULL AS table_description, ( - c.relkind IN ('r', 'v','f') - AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8 - OR EXISTS ( - SELECT 1 - FROM pg_trigger - WHERE - pg_trigger.tgrelid = c.oid + c.relkind = 'r' + OR ( + c.relkind in ('v','f') + AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8 + -- The function `pg_relation_is_updateable` returns a bitmask where 8 + -- corresponds to `1 << CMD_INSERT` in the PostgreSQL source code, i.e. + -- it's possible to insert into the relation. + OR EXISTS ( + SELECT 1 + FROM pg_trigger + WHERE + pg_trigger.tgrelid = c.oid AND (pg_trigger.tgtype::integer & 69) = 69 + -- The trigger type `tgtype` is a bitmask where 69 corresponds to + -- TRIGGER_TYPE_ROW + TRIGGER_TYPE_INSTEAD + TRIGGER_TYPE_INSERT + -- in the PostgreSQL source code. + ) + ) + ) AS insertable, + ( + c.relkind = 'r' + OR ( + c.relkind in ('v','f') + AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 4) = 4 + -- CMD_UPDATE + OR EXISTS ( + SELECT 1 + FROM pg_trigger + WHERE + pg_trigger.tgrelid = c.oid + and (pg_trigger.tgtype::integer & 81) = 81 + -- TRIGGER_TYPE_ROW + TRIGGER_TYPE_INSTEAD + TRIGGER_TYPE_UPDATE + ) + ) + ) AS updatable, + ( + c.relkind = 'r' + OR ( + c.relkind in ('v','f') + AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 16) = 16 + -- CMD_DELETE + OR EXISTS ( + SELECT 1 + FROM pg_trigger + WHERE + pg_trigger.tgrelid = c.oid + and (pg_trigger.tgtype::integer & 73) = 73 + -- TRIGGER_TYPE_ROW + TRIGGER_TYPE_INSTEAD + TRIGGER_TYPE_DELETE + ) ) - ) AS insertable + ) AS deletable FROM pg_class c JOIN pg_namespace n ON n.oid = c.relnamespace WHERE c.relkind IN ('v','r','m','f') AND n.nspname NOT IN ('pg_catalog', 'information_schema') - GROUP BY table_schema, table_name, insertable ORDER BY table_schema, table_name |] allColumns :: [Table] -> Bool -> H.Statement [Schema] [Column] diff --git a/src/PostgREST/DbStructure/Table.hs b/src/PostgREST/DbStructure/Table.hs index 088ef505dd..973e1fbf93 100644 --- a/src/PostgREST/DbStructure/Table.hs +++ b/src/PostgREST/DbStructure/Table.hs @@ -21,7 +21,10 @@ data Table = Table { tableSchema :: Schema , tableName :: TableName , tableDescription :: Maybe Text + -- The following fields identify what can be done on the table/view, they're not related to the privileges granted to it , tableInsertable :: Bool + , tableUpdatable :: Bool + , tableDeletable :: Bool } deriving (Show, Ord, Generic, JSON.ToJSON) diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs index b839c8322d..b3c547f463 100644 --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -217,7 +217,7 @@ makeRowFilters :: Text -> [Column] -> [(Text, Param)] makeRowFilters tn = fmap (makeRowFilter tn) makePathItem :: (Table, [Column], [Text]) -> (FilePath, PathItem) -makePathItem (t, cs, _) = ("/" ++ T.unpack tn, p $ tableInsertable t) +makePathItem (t, cs, _) = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t || tableDeletable t) where -- Use first line of table description as summary; rest as description (if present) -- We strip leading newlines from description so that users can include a blank line between summary and description diff --git a/test/Feature/OptionsSpec.hs b/test/Feature/OptionsSpec.hs index b4dd89d644..1e8bb969c2 100644 --- a/test/Feature/OptionsSpec.hs +++ b/test/Feature/OptionsSpec.hs @@ -12,15 +12,60 @@ import SpecHelper spec :: SpecWith ((), Application) spec = describe "Allow header" $ do - it "includes read/write verbs for writeable table" $ do - r <- request methodOptions "/items" [] "" - liftIO $ - simpleHeaders r `shouldSatisfy` - matchHeader "Allow" "GET,POST,PATCH,DELETE" - - it "includes read verbs for read-only table" $ do - r <- request methodOptions "/has_count_column" [] "" - liftIO $ - simpleHeaders r `shouldSatisfy` - matchHeader "Allow" "GET" + context "a table" $ do + it "includes read/write verbs for writeable table" $ do + r <- request methodOptions "/items" [] "" + liftIO $ + simpleHeaders r `shouldSatisfy` + matchHeader "Allow" "OPTIONS,GET,HEAD,POST,PUT,PATCH,DELETE" + context "a view" $ do + context "auto updatable" $ do + it "includes read/write verbs for auto updatable views with pk" $ do + r <- request methodOptions "/projects_auto_updatable_view_with_pk" [] "" + liftIO $ + simpleHeaders r `shouldSatisfy` + matchHeader "Allow" "OPTIONS,GET,HEAD,POST,PUT,PATCH,DELETE" + + it "includes read/write verbs for auto updatable views without pk" $ do + r <- request methodOptions "/projects_auto_updatable_view_without_pk" [] "" + liftIO $ + simpleHeaders r `shouldSatisfy` + matchHeader "Allow" "OPTIONS,GET,HEAD,POST,PATCH,DELETE" + + context "non auto updatable" $ do + it "includes read verbs for non auto updatable views" $ do + r <- request methodOptions "/projects_view_without_triggers" [] "" + liftIO $ + simpleHeaders r `shouldSatisfy` + matchHeader "Allow" "OPTIONS,GET,HEAD" + + it "includes read/write verbs for insertable, updatable and deletable views with pk" $ do + r <- request methodOptions "/projects_view_with_all_triggers_with_pk" [] "" + liftIO $ + simpleHeaders r `shouldSatisfy` + matchHeader "Allow" "OPTIONS,GET,HEAD,POST,PUT,PATCH,DELETE" + + it "includes read/write verbs for insertable, updatable and deletable views without pk" $ do + r <- request methodOptions "/projects_view_with_all_triggers_without_pk" [] "" + liftIO $ + simpleHeaders r `shouldSatisfy` + matchHeader "Allow" "OPTIONS,GET,HEAD,POST,PATCH,DELETE" + + it "includes read and insert verbs for insertable views" $ do + r <- request methodOptions "/projects_view_with_insert_trigger" [] "" + liftIO $ + simpleHeaders r `shouldSatisfy` + matchHeader "Allow" "OPTIONS,GET,HEAD,POST" + + it "includes read and update verbs for updatable views" $ do + r <- request methodOptions "/projects_view_with_update_trigger" [] "" + liftIO $ + simpleHeaders r `shouldSatisfy` + matchHeader "Allow" "OPTIONS,GET,HEAD,PATCH" + + it "includes read and delete verbs for deletable views" $ do + r <- request methodOptions "/projects_view_with_delete_trigger" [] "" + liftIO $ + simpleHeaders r `shouldSatisfy` + matchHeader "Allow" "OPTIONS,GET,HEAD,DELETE" diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index 4931a654fc..e321002149 100644 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -1544,6 +1544,73 @@ $$A materialized view for projects Just a test for materialized views$$; +-- Tests for updatable, insertable and deletable views +create view test.projects_auto_updatable_view_with_pk as +select id, name, client_id from test.projects; + +create view test.projects_auto_updatable_view_without_pk as +select name, client_id from test.projects; + +create view test.projects_view_without_triggers as +select distinct id, name, client_id from test.projects; + +create or replace function test.test_for_views_with_triggers() returns trigger as $$ +begin + return null; +end; +$$ language plpgsql; + +create view test.projects_view_with_all_triggers_with_pk as +select distinct id, name, client_id from test.projects; + +create trigger projects_view_with_all_triggers_with_pk_insert + instead of insert on test.projects_view_with_all_triggers_with_pk + for each row execute procedure test_for_views_with_triggers(); + +create trigger projects_view_with_all_triggers_with_pk_update + instead of update on test.projects_view_with_all_triggers_with_pk + for each row execute procedure test_for_views_with_triggers(); + +create trigger projects_view_with_all_triggers_with_pk_delete + instead of delete on test.projects_view_with_all_triggers_with_pk + for each row execute procedure test_for_views_with_triggers(); + +create view test.projects_view_with_all_triggers_without_pk as +select distinct name, client_id from test.projects; + +create trigger projects_view_with_all_triggers_without_pk_insert + instead of insert on test.projects_view_with_all_triggers_without_pk + for each row execute procedure test_for_views_with_triggers(); + +create trigger projects_view_with_all_triggers_without_pk_update + instead of update on test.projects_view_with_all_triggers_without_pk + for each row execute procedure test_for_views_with_triggers(); + +create trigger projects_view_with_all_triggers_without_pk_delete + instead of delete on test.projects_view_with_all_triggers_without_pk + for each row execute procedure test_for_views_with_triggers(); + +create view test.projects_view_with_insert_trigger as +select distinct id, name, client_id from test.projects; + +create trigger projects_view_with_insert_trigger_insert + instead of insert on test.projects_view_with_insert_trigger + for each row execute procedure test_for_views_with_triggers(); + +create view test.projects_view_with_update_trigger as +select distinct id, name, client_id from test.projects; + +create trigger projects_view_with_update_trigger_update + instead of update on test.projects_view_with_update_trigger + for each row execute procedure test_for_views_with_triggers(); + +create view test.projects_view_with_delete_trigger as +select distinct id, name, client_id from test.projects; + +create trigger projects_view_with_delete_trigger_delete + instead of delete on test.projects_view_with_delete_trigger + for each row execute procedure test_for_views_with_triggers(); + create or replace function test."quotedFunction"("user" text, "fullName" text, "SSN" text) returns jsonb AS $$ select format('{"user": "%s", "fullName": "%s", "SSN": "%s"}', "user", "fullName", "SSN")::jsonb;