Compare commits

..
363 Commits
Author SHA1 Message Date
Laurence Isla a4e00ffdf6 bump version to 12.0.2 2023-12-20 18:21:19 -05:00
steve-chavezandLaurence Isla cd62e39cd1 fix: empty row on handler function
Closes https://github.com/PostgREST/postgrest/issues/3126
2023-12-20 16:33:34 -05:00
steve-chavezandLaurence Isla ec0f99c686 fix: aggregates not working for all schemas
Closes https://github.com/PostgREST/postgrest/issues/3124
2023-12-20 16:33:31 -05:00
Laurence Isla b2cd365866 chore: add new sponsor 2023-12-20 16:29:37 -05:00
dependabot[bot]andLaurence Isla fcc330311f build(deps): bump actions/upload-artifact from 3 to 4 (#3123) 2023-12-20 16:29:37 -05:00
dependabot[bot]andLaurence Isla e557161b84 build(deps): bump dawidd6/action-download-artifact from 2 to 3 (#3122) 2023-12-20 16:29:37 -05:00
dependabot[bot]andLaurence Isla 962268fd6b build(deps): bump actions/download-artifact from 3 to 4 (#3121) 2023-12-20 16:29:37 -05:00
Laurence Isla cd38da56d5 bump version to 12.0.1 2023-12-12 19:20:47 -05:00
steve-chavezandLaurence Isla 229a4e4cd6 fix: any handler sets a default application/json
Now it sets application/octet-stream as the generic type.
2023-12-12 18:46:40 -05:00
Laurence Isla c3f7440e33 fix: add jwt_cache_max_lifetime as an in-database configuration option (#3102) 2023-12-12 18:46:40 -05:00
Laurence Isla 4e03ee252b chore: add new sponsor 2023-12-12 18:46:40 -05:00
Andrei DziahelandLaurence Isla 0ac4d0d0a9 fix: replace json parser error with generic msg (#3090) 2023-12-12 18:46:40 -05:00
Andrei DziahelandLaurence Isla ceda77c5de ci: cancel in-progress loadtests for PRs as well 2023-12-12 18:46:40 -05:00
Andrei DziahelandLaurence Isla a6e4a0078b ci: test only head of branch 2023-12-12 18:46:40 -05:00
Laurence Isla 15f4157cc5 changelog: move missplaced unreleased fix (#3094) 2023-12-12 18:46:40 -05:00
Laurence Isla 50ea1999b2 fix: allow using special characters in json keys (#3081)
* increase memory size test
2023-12-12 18:46:40 -05:00
Andrei DziahelandLaurence Isla c92f16a2cb ci: similar jobs use a single cache for Nix stores
Jobs that use the setup-nix action will share a single cache, which is created by a previous warm up Job.
2023-12-12 18:46:40 -05:00
dependabot[bot]andLaurence Isla 1cebc03313 build(deps): bump cachix/cachix-action in /.github/actions/setup-nix (#3085) 2023-12-12 18:46:40 -05:00
steve-chavez 00580bc8cb bump version to 12.0.0 2023-12-01 19:18:07 -05:00
steve-chavez 9fe11249f9 feat: custom SQL handler for the "*/*" media type 2023-11-28 23:14:38 -05:00
Laurence IslaandGitHub 7640de34e2 refactor: use a data type instead of Map for Server Timing 2023-11-28 18:26:56 -05:00
Andrei DziahelandSteve Chavez 31ce39ba36 ci: cabal+GHC: tweak caching
Makes it to cache only relevant directories, adds `dist-newstyle` to prevent needless rebuilding even harder and shortens cache key name by supplying `hashFiles`multiple arguments
2023-11-28 12:48:57 -05:00
Laurence IslaandGitHub ca5eb64deb chore: fix server-timing metric order and doctest 2023-11-28 12:45:39 -05:00
Andrei DziahelandSteve Chavez a72241ad4e ci: fixes job caches not producing after recent cabal upgrade
Recent cabal adopted XDG guidelines and stores data
across multiple directories under $HOME.
Creating ~/.cabal manually returns old behavior and allows caching single directory again.
2023-11-28 11:52:52 -05:00
steve-chavez b080f59bac test: server timing on root and options method 2023-11-28 10:25:25 -05:00
steve-chavez 558e9d40e8 changelog: join server-timing entries 2023-11-28 10:25:25 -05:00
steve-chavez 958339b8d3 chore: change server timing render to response
"render" is a loaded term than might be thought as the generation
of a full HTML page. While for this phase we only process the status
and the headers.

Changing it to "response" so is not misleading at least. Users can check the
docs for clarification.
2023-11-28 10:25:25 -05:00
steve-chavez 3d56f8435d chore: delete dead error codes 2023-11-28 10:25:25 -05:00
Laurence IslaandSteve Chavez dfa875c8c7 fix: do not log internal db errors like 'acquisition timeout' when log-level=crit 2023-11-27 23:06:40 -05:00
Laurence IslaandSteve Chavez 33891e3a73 feat: log all internal database errors to stderr 2023-11-27 23:06:40 -05:00
Laurence IslaandSteve Chavez 8483459d59 chore: add missing --example for server-timing-enabled 2023-11-24 17:41:16 -05:00
Laurence IslaandSteve Chavez b538ab9823 feat: add timing for the api request parse 2023-11-24 16:29:25 -05:00
Laurence IslaandSteve Chavez 850b15fe13 fix: change timing name from 'query' to 'transaction' 2023-11-24 16:29:25 -05:00
Andrei DziahelandGitHub df97a5071f Display an actual TCP port app is bound to (#3034) 2023-11-23 18:17:16 -05:00
Tim AbdullaandGitHub 1c60b50e2e Add aggregate functions (#2925)
The aggregate functions SUM(), MAX(), MIN(), AVG(), and COUNT() are now supported.
2023-11-23 14:03:03 -05:00
Andrei DziahelandGitHub c3301a1653 feat: implement server-timing-enabled config parameter (#3064) 2023-11-22 17:57:50 -05:00
Andrei DziahelandGitHub abcb21c69a ci: cache Nix store with cache-nix-action (#2992)
* ci: try nix-community/cache-nix-action

* ci: add cache-id param to setup-nix action

* ci: tidy up cache keys for non-nix jobs

* ci: merge-nix-caches-linux job

* ci: merge caches other way around

* ci: reduce number of caches

Should prevent disk overflow

* ci: change cache id prefix for merge

* ci: comment out cache merging job

* ci: revert cache id prefix

* ci: setup-nix: use latest cache-nix-action

Among others, makes action logs look more tidy (see https://github.com/nix-community/cache-nix-action/commit/17d19d3d8be918757589635bc1a6830be0b129d2)

* ci: use test-pg cache key for loadtest
2023-11-21 18:56:23 -05:00
steve-chavez f7bf2157f3 feat: apply super settings on impersonated roles
If they have GRANT SET ON PARAMETER <setting> TO authenticator
2023-11-21 10:54:56 -05:00
Taimoor ZaeemandGitHub 125f10a60f feat: add statement_timeout set on functions (#3056) 2023-11-17 12:36:51 -05:00
Taimoor ZaeemandGitHub 3c1a7f2641 feat: add timezone in Prefer header (#3024)
* increase reloading timeout in io-tests
* increase memory test by 1M
2023-11-13 14:16:27 -05:00
omahsandGitHub f10d4139fe nix: fix typos in README 2023-11-08 11:43:42 -05:00
Laurence IslaandSteve Chavez 99b705d44f chore: remove former sponsors 2023-11-07 16:25:47 -05:00
Laurence IslaandGitHub 379d9d6298 chore: add Neon as sponsor 2023-11-06 20:02:58 -05:00
Laurence IslaandSteve Chavez 2c35257eec chore: add prefix info to the PR template 2023-11-03 19:42:06 -05:00
steve-chavez ed90774f53 test: query the empty string 2023-11-03 12:58:54 -05:00
Laurence Isla 96ca177c31 transaction-scoped settings are now shown clearly in the postgres logs 2023-11-02 15:50:22 -05:00
Laurence Isla 226400a5bc break:remove the db-use-legacy-gucs config
BREAKING CHANGE

All PostgreSQL versions will use JSON GUCs for headers, cookies and JWT claims.
2023-11-02 15:50:22 -05:00
Laurence IslaandGitHub b235227119 allow all origins when server-cors-allowed-origins is an empty string 2023-10-27 21:30:56 -05:00
Taimoor ZaeemandGitHub 5c9c7f4ff4 fix: HTTP status responses for upserts
* PUT returns 201 instead of 200 when rows are inserted
* POST with "Prefer: resolution=merge-duplicates" returns 200 instead of 201 when no rows are inserted
2023-10-26 20:49:20 -05:00
steve-chavez 82b38341bf feat: sql handlers for custom media types
* test text/html and drop HtmlRawOutputSpec.hs
* all tests passing, removed all pendingWith
* make functions compatible with pg <= 12
* move custom media types tests to own spec
* anyelement aggregate
* apply aggregates without a final function
* overriding works
* overriding anyelement with particular agg
* cannot override vendored media types
* plan spec works with custom aggregate
* renamed media types to make clear which ones are overridable
* correct content negotiation with same weight
* text/tab-separated-values media type
* text/csv with BOM plus content-disposition header
2023-10-26 09:04:02 -05:00
steve-chavez 4a90e9fbd9 break: db-root-spec default app/openapi+json media
BREAKING CHANGE

Can be done later with custom media types
2023-10-26 09:04:02 -05:00
steve-chavez 14d030b96c break: remove binary field logic, raw-media-types
BREAKING CHANGE

Can be done later with custom media types
2023-10-26 09:04:02 -05:00
Wolfgang Walther 6920a88dc0 nix: Fix postgrest-release on rel-branches pushing to the right branch 2023-10-25 19:09:21 +02:00
Wolfgang Walther 966f8df33f changelog: update to 11.2.2 2023-10-25 19:08:04 +02:00
Wolfgang Walther 98bd1de1cd nix: Allow running postgrest-release on rel- branches 2023-10-25 16:29:03 +02:00
Taimoor ZaeemandGitHub d94286c185 feat: add config to specify CORS origins (#2986) 2023-10-24 09:38:25 -05:00
Taimoor ZaeemandGitHub 618f93dec1 test: fix typos in batch upsert tests 2023-10-21 16:29:43 -05:00
Laurence IslaandGitHub 317619bf62 fix: regression by reverting fix that returned 206 when first-pos=length in Range header 2023-10-21 16:28:08 -05:00
steve-chavez eb238ad678 test: DRY scache/config sleep in io tests
Also increase schema cache sleep to 0.2 as 0.1 tends to fail in CI.
2023-10-20 17:53:54 -05:00
steve-chavez 54786a6c04 fix: unnecessary count() on RPC returning single 2023-10-19 15:54:22 -05:00
steve-chavez 00f3cb3746 test: prove RPC returning single always gives 1 2023-10-19 15:54:22 -05:00
Andrei DziahelandGitHub e977032847 build: add cabal.project.freeze (#3004) 2023-10-19 09:26:46 -05:00
Taimoor ZaeemandGitHub f10b4c3268 test: add tests for batch upserts (#3005) 2023-10-13 09:47:26 -03:00
Andrei DziahelandGitHub dc01c748ae feat: add more perf counters to Server-Timing (#2983) 2023-10-12 09:55:30 -03:00
Laurence IslaandGitHub 056c748c5f refactor: DRY and enforce error format 2023-10-10 11:42:36 -05:00
Kam Ting HoiandGitHub 818387f24e fix: range request with 0 rows and 0 offset return status 416 (#2991) 2023-10-07 00:10:17 -03:00
steve-chavez a9d6c318fd nix: instructions for static binary 2023-10-06 19:54:05 -03:00
steve-chavez 2aa58164ab refactor: move errors to ApiRequestError 2023-10-06 01:16:45 -03:00
steve-chavez df08d7f3ff refactor: rename JSONParseError to PGRSTParseError
The error name is too generic otherwise.
2023-10-06 01:16:45 -03:00
steve-chavez 3dd292be46 refactor: DRY application/json on Error.hs
Small refactor to help with:

https://github.com/PostgREST/postgrest/issues/2901
2023-10-06 01:16:45 -03:00
steve-chavez 0703f27d2b changelog: update to 11.2.1 2023-10-04 12:12:30 -03:00
Laurence IslaandGitHub af0e369c65 fix: regression that rejects URI connection strings with certain unescaped characters in the password 2023-10-03 10:57:21 -05:00
Laurence IslaandGitHub 910950dbac fix: RPCs not embedding correctly when using overloaded functions for computed relationships 2023-10-02 16:00:33 -05:00
Andrei DziahelandSteve Chavez 4c44782d15 refactor: complete purifying Response module 2023-09-30 09:35:50 -03:00
steve-chavez 3b1eb51744 ci: fix MacOS CI 2023-09-29 19:50:15 -03:00
steve-chavez cf7ee67dfe fix: arrow filter on RPC returning TABLE+composite 2023-09-28 20:26:38 -03:00
steve-chavez 290d90609b fix: unnecessary set default_transaction_isolation 2023-09-27 17:48:48 -03:00
Taimoor ZaeemandSteve Chavez 3c1cdd434a feat: add handling=strict/lenient for Prefer header 2023-09-27 15:00:52 -03:00
steve-chavez 2825ac059e refactor: make Response module pure 2023-09-27 11:50:22 -03:00
Taimoor ZaeemandGitHub a6e3eda5b2 feat: implement JWT caching (#2928) 2023-09-25 14:46:55 -03:00
Laurence IslaandSteve Chavez 90e3a5e29f Add test option for PostgreSQL 16 2023-09-21 15:38:46 -03:00
Andrei DziahelandSteve Chavez add4dfeed5 ci: loadtest PRs against latest releases
Leveraging the previously-improved postgrest-loadtest-against
introduces loadtesting PRS against latest release as well.
2023-09-21 14:08:53 -03:00
Andrei DziahelandSteve Chavez fca039a54d nix:postgrest-loadtest-against multiple branches
Improve postgrest-loadtest-against script to accept multiple refs
to perform loadtests against *all* of them
2023-09-21 14:08:53 -03:00
Laurence IslaandSteve Chavez 1b4dae5a7a Add missing changelog entries 2023-09-19 00:15:48 -03:00
Laurence IslaandGitHub 37a3f818dd fix: error when requesting "Prefer: count=<type>" with null filters on embedded resources 2023-09-16 15:02:59 -05:00
Andrei DziahelandSteve Chavez c3169b7dc2 ci: less strict conditions for loadtest inmain 2023-09-15 16:35:20 -03:00
Taimoor ZaeemandSteve Chavez d64b71cbf0 refactor: rename test module NullsStrip.hs to NullsStripSpec.hs 2023-09-15 14:39:12 -03:00
Taimoor ZaeemandSteve Chavez c195eece65 feat: add Server-Timing header with JWT duration 2023-09-15 14:39:12 -03:00
Laurence IslaandGitHub fa182c216e fix: bug when Null Filtering on embedded resources
When doing Null Filtering, the to-one embed resources were not included if they had a NULL value in any of the selected fields.
2023-09-14 21:30:48 -05:00
Andrei DziahelandSteve Chavez 30474c424c ci: loadtest commits to main against latest release
Introduces loadtest job for main branch
that runs loadtest against latest release
2023-09-14 17:10:48 -03:00
Laurence IslaandGitHub 2888f351d1 Remove former sponsor 2023-09-12 22:41:39 -05:00
steve-chavez 8d3c9f8435 refactor: move media type logic to Plan module 2023-09-12 19:24:26 -03:00
steve-chavez d8a91453d1 fix: inconsistent Preference-Applied
* Don't apply `tx=commit` if the transaction doesn't commit
* Apply `count=exact`
* Also simplifies the Preference-Applied logic, removing the need for
  some functions.
2023-09-12 13:52:49 -03:00
dependabot[bot]andGitHub 3f5e840baf build(deps): bump cachix/install-nix-action (#2935) 2023-09-11 03:00:29 -03:00
dependabot[bot]andGitHub 2358b6670f build(deps): bump actions/checkout from 3 to 4 (#2936) 2023-09-11 02:34:35 -03:00
Taimoor ZaeemandSteve Chavez 8eed576826 fix: range request with first position same as length return status 206 2023-09-04 15:50:00 -03:00
Taimoor ZaeemandGitHub 07fef25591 feat: allow full response control when raising exceptions 2023-09-01 14:02:03 -05:00
Taimoor ZaeemandSteve Chavez 7dc6e2b899 fix: duplicate headers in response 2023-08-25 13:52:50 -05:00
Taimoor ZaeemandGitHub 57fa2719dd feat: add db-pool-automatic-recovery configuration to disable connection retrying 2023-08-23 21:08:04 -05:00
Diogo BiazusandGitHub b8b3145c5c fix: schema cache and configuration reloading with NOTIFY not working on Windows 2023-08-21 10:25:44 -05:00
steve-chavez 531a183b44 nix: postgrest-coverage notice 2023-08-17 13:43:48 -05:00
steve-chavez 739f056b0a nix: add postgrest-repl command 2023-08-17 13:43:48 -05:00
Steve Chavez 32b77cae6c Revert "nix: Update nixpkgs to 2023-08-04"
This reverts commit 2434724edd.
2023-08-15 23:55:35 -05:00
Taimoor ZaeemandSteve Chavez 2434724edd nix: Update nixpkgs to 2023-08-04 2023-08-14 15:00:20 -05:00
Taimoor ZaeemandSteve Chavez 87d6a0d0fe fix: application/vnd.pgrst.array not accepted as a valid mediatype 2023-08-11 12:41:04 -05:00
steve-chavez c820efb64a bump version to 11.2.0 2023-08-10 08:51:58 -05:00
steve-chavez e30bf53afa deprecate: target embedding disambiguation 2023-08-10 08:14:23 -05:00
steve-chavez 5ce020d5bc fix: impersonated role applying superuser settings 2023-08-09 20:05:22 -05:00
Taimoor ZaeemandGitHub fbf9bf21c2 feat: add optional nulls=stripped parameter for mediatypes applicatio… (#2894) 2023-08-09 18:49:22 -05:00
Taimoor ZaeemandSteve Chavez d490bf09fd feat: add Preference-Applied header in response for Prefer: return=representation/minimal/headers-only 2023-08-05 02:21:50 -05:00
Laurence IslaandGitHub aa53623aac fix: error when a function returns RECORD or SETOF RECORD 2023-08-03 20:09:55 -05:00
steve-chavez 0fce7ca361 refactor: Response rm Paths_postgrest dependency
This allows using doctests on the Response.hs module
2023-08-02 16:28:48 -05:00
Taimoor ZaeemandGitHub d0a71de2da chore: improve details field of the singular error response (#2876) 2023-08-01 19:37:54 -05:00
Laurence IslaandGitHub 40c2bcd4a1 fix: paramaters of type character and bit not ignoring length
- Fixes the error "value too long for type character(1)" when the char length of the parameter was bigger than one.
2023-07-31 18:36:37 -05:00
dependabot[bot]andGitHub 0dc67bed0b build(deps): bump LouisBrunner/checks-action from 1.6.1 to 1.6.2 (#2883) 2023-07-31 00:17:36 -05:00
steve-chavez 2d00d7d248 fix: null filtering on embed when column=relation 2023-07-27 22:43:13 -05:00
Taimoor ZaeemandGitHub 2977d09779 chore: maintenance to the Nix development and build guide 2023-07-26 20:28:59 -05:00
Laurence IslaandGitHub 630e0a1691 fix: character and bit columns with fixed length not inserting/updating properly
Fixes the error "value too long for type character(1)" when the char length of the column was bigger than one.
2023-07-21 11:30:01 -05:00
steve-chavez 28d5278d62 fix: use index on jsonb/jsonb arrow filter/order 2023-07-12 14:51:21 -05:00
steve-chavez e332f038ef fix: HEAD unnecessarily executing aggregates 2023-07-10 15:05:51 -05:00
steve-chavez 905fcb05cc refactor: add ResultAggregate type 2023-07-10 15:05:51 -05:00
Laurence IslaandGitHub 774d015eb5 feat: add the --version CLI option to print the version information 2023-07-07 18:19:02 -05:00
Laurence IslaandGitHub e752224f14 feat: show PostgREST version in the logs 2023-07-07 10:28:27 -05:00
steve-chavez add10bd10c test: doctest for addNullEmbedFilters 2023-07-06 16:52:46 -05:00
steve-chavez 52d3026133 refactor: remove unneeded FilterNullEmbed 2023-07-06 16:52:46 -05:00
Laurence IslaandGitHub 5cdafb23e7 ci: fix ARM docker containers not stopping immediately 2023-07-06 11:20:32 -05:00
steve-chavez 20b06efabe chore: show on ReadPlan and MediaType 2023-07-05 17:35:54 -05:00
Laurence IslaandGitHub 7508230760 feat: allow to verify the PostgREST version through SQL 2023-07-03 18:31:32 -05:00
steve-chavez a17dd41d6b fix: Prefer: missing=default with DOMAIN defaults 2023-06-30 17:46:16 -05:00
Alexander LjungbergandSteve Chavez 0a1564ba5a feat: data representations allow custom parsing and formatting of API fields.
See PR #2523. Most notable code changes:

- Load data representation casts into schema cache.
- Data representations for reads, filters, inserts, updates, views, over joins.
- `CoercibleField` represents name references in queries where coercion may be needed.
- `ResolverContext` help facilitate field resolution during planning.
- Planner 'resolves' names in the API query and pairs them with any implicit conversions to be used in the query builder stage.
- Tests for all of the above.
- More consistent naming (TypedX -> CoercibleX).

New: unit tests for more data representation use cases; helpful as examples as well.

New: update CHANGELOG with data representations feature description.

Fixed failing idempotence test.

New: replace date formatter test with one that does something.

Fixup: inadvertent CHANGELOG change after rebase.

Cleanup: `tfName` -> `cfName` and related.

Document what IRType means.

Formatting.

New: use a subquery to interpret `IN` literals requiring data rep transformation.

- With the previous method, very long queries such as `ANY (ARRAY[test.color('000100'), test.color('CAFE12'), test.color('01E240'), ...` could be generated. Consider the case where the parser function name is 45 characters and there's a hundred literals. That's 4.5kB of SQL just for the function name alone!
- New version uses `unnest`: `ANY (SELECT test.color(unnest('{000100,CAFE12,01E240,...}'::text[]))` to produce a much shorter query.
- This is likely to be more performant and either way much more readable and debuggable in the logs.
2023-06-29 15:01:58 -05:00
steve-chavez 078c6ec08c refactor: remove SqlFragment and use SQL.Snippet 2023-06-22 21:46:16 -05:00
Laurence IslaandGitHub 83cf15fb7e ci: specify GHC_VERSION for ARM build on CI config
* change cabal version from recommended to latest
2023-06-21 16:54:15 -05:00
steve-chavez 40dc46ed2e fix: compilation on Ubuntu, GHC 9.0.2 compat 2023-06-21 16:22:30 -05:00
steve-chavez d9261fa674 ci: check against GHC 9.0.2 2023-06-21 16:22:30 -05:00
steve-chavez 856d450775 refactor: stricter plan media type 2023-06-20 19:12:17 -05:00
Laurence IslaandGitHub c1a8661ab3 ci: Update dependabot to look for dependencies in nested folder
- Bump cachix/install-nix-action from 21 to 22

- Add actions/setup-nix to dependabot dependencies
2023-06-19 12:33:42 -05:00
steve-chavez aa15f4782e refactor: remove MTPlanAttrs to doctest 2023-06-18 15:27:25 -05:00
steve-chavez 77cd9387d4 Revert "refactor: plan media type"
This reverts commit 3cd3a3f8c6.
2023-06-18 15:27:25 -05:00
steve-chavez 3cd3a3f8c6 refactor: plan media type 2023-06-17 23:00:32 -05:00
steve-chavez 78821a8fe7 refactor: clarify content negotiation 2023-06-16 17:36:44 -05:00
steve-chavez 5c372df487 refactor: asJsonF/asJsonSingleF Routine param 2023-06-16 17:36:44 -05:00
steve-chavez fad47324c3 fix: OPTIONS not accepting all available media 2023-06-13 22:00:21 -05:00
dependabot[bot]andGitHub 11a9849152 build(deps): bump LouisBrunner/checks-action from 1.6.0 to 1.6.1 (#2817) 2023-06-12 10:34:48 -05:00
steve-chavez 1f13e43abe bump version to 11.1.0 2023-06-07 19:03:31 -05:00
steve-chavez fac797c766 changelog: clarify 2781 2023-06-07 18:28:01 -05:00
steve-chavez 07cb0b582e feat: recover on pg_terminate_backend 2023-06-06 14:41:37 -05:00
steve-chavez d54a2f48de refactor: move checkIsFatal to AppState 2023-06-06 14:41:37 -05:00
steve-chavez bcce7b1c53 fix: stop retrying on "no password supplied" 2023-06-06 14:41:37 -05:00
steve-chavez 8d1961ce07 refactor: cache the isolation level 2023-06-06 14:41:37 -05:00
steve-chavez 9a19dff83e refactor: move debounceLogAcquisitionTimeout
Move it to AppState
2023-06-06 14:41:37 -05:00
steve-chavez 54b9a0b8b3 test: fix hello function for pg 9.6 2023-06-02 17:45:25 -05:00
steve-chavez 9a3d453bf4 test: remove big_schema.sql from io tests
It was unused(test skipped) and made the scache reload slower, causing
test failure on CI.
2023-06-02 17:45:25 -05:00
steve-chavez 4f6c466031 nix: postgrest-run uses similar config to tests
Otherwise manual tests can be deceiving
2023-06-02 17:45:25 -05:00
Steve ChavezandGitHub a852b766eb Fix dropping schema cache reload notifications
* test: bad schema reload
* refactor: DRY using the "extra" lib
* refactor: move worker funtions inside AppState
* Also rename Workers.hs to Admin.hs
2023-06-02 12:22:17 -05:00
steve-chavez 14be3fb671 feat: add pre-config function
Allows using the in-database configuration without SUPERUSER
2023-05-28 10:21:13 -05:00
steve-chavez 8a3686d86b refactor: whitelist in-db config settings 2023-05-28 10:21:13 -05:00
steve-chavez 009250006e feat: add db-pool-timeout alias
For db-pool-max-idletime
2023-05-22 18:34:18 -03:00
steve-chavez 38ad8c04e1 nix: withTmpDb set search_path to test
It gets repetitive to set the search_path every time you go in the test
db with psql.
2023-05-22 13:46:24 -03:00
dependabot[bot]andGitHub 54cbf147e3 build(deps): bump codecov/codecov-action from 3.1.3 to 3.1.4 (#2794) 2023-05-22 11:34:18 -05:00
RobertandGitHub f9f0f79fa9 feat: use hasql-pool-0.10, add db-pool-max-idletime (#2786)
- new option db-pool-max-idletime limits the maximal idle time of a
  postgresql connection, defaults to 30 seconds
- this essentially restores the db-pool-timeout option from versions
  <=10, with more specific name
2023-05-16 23:00:40 +02:00
steve-chavez a867d79c42 nix: withTmpDb psql notice can't mutate the db
Use the postgres role instead of the authenticator on the notice
2023-05-05 20:03:09 -03:00
steve-chavez 4197d2f739 bump version to 11.0.1 2023-04-27 21:30:40 -05:00
steve-chavez c10ba8e214 fix: skew of 30 seconds for JWT validation 2023-04-27 21:06:06 -05:00
steve-chavez 887948d259 fix: missing=default error msg on generated column 2023-04-27 19:27:09 -05:00
steve-chavez c63786733a fix: no schema privilege for schema cache
This was due to the usage of pg_get_serial_sequence
2023-04-27 19:27:09 -05:00
steve-chavez 4fe696dd96 nix: PGRST_DB_ANON_ROLE default for postgrest-run
Makes manually testing a feature easier
2023-04-27 19:27:09 -05:00
steve-chavez 67936b343f test: prove that authenticator is not a superuser 2023-04-27 19:27:09 -05:00
steve-chavez b0e395f495 nix: no SUPERUSER for connection role
Change :USER to :PGUSER in SQL scripts
2023-04-27 19:27:09 -05:00
dependabot[bot]andGitHub 3b55a27ef3 build(deps): bump codecov/codecov-action from 3.1.2 to 3.1.3 (#2765) 2023-04-24 11:21:49 -05:00
dependabot[bot]andGitHub 43da81c30c build(deps): bump codecov/codecov-action from 3.1.1 to 3.1.2 (#2757) 2023-04-18 12:25:50 -05:00
steve-chavez dd2f5511d8 bump version to 11.0.0 2023-04-16 14:22:38 -05:00
steve-chavez 49c349c846 chore: CHANGELOG to include release 10.2.0 2023-04-16 12:18:10 -05:00
steve-chavez aaf77902f6 feat: isolation level for roles/functions 2023-04-15 18:05:04 -05:00
steve-chavez 4c555cbd5d refactor: authRole to ByteString 2023-04-15 18:05:04 -05:00
steve-chavez 3e53796120 correct missing=default with GENERATED BY column 2023-04-14 22:12:34 -05:00
Laurence IslaandGitHub 0a2b7064c7 fix: PATCH requests not recognizing embedded filters
- Already fixed in #2618
- Adds tests and CHANGELOG
2023-04-14 16:42:55 -05:00
steve-chavez ce378e6b3a refactor: clarify Scalar type
It now contains the type of the scalar. This way we can discriminate the
void type in a more obvious way.
2023-04-13 18:17:43 -05:00
steve-chavez feadf59bb3 refactor: rename Proc module to Routine
Assuming that functions=procedures is wrong since pg11, which introduced
real stored procedures.
2023-04-13 18:17:43 -05:00
Laurence IslaandGitHub ad7d80a430 ci: clean files from arm server only on build failure/cancel for a version release 2023-04-13 16:29:26 -05:00
steve-chavez e572d1d1a2 feat: configurable role settings 2023-04-10 14:27:08 -05:00
steve-chavez c06237cc56 fix: db settings and pg version query not prepared 2023-04-10 14:27:08 -05:00
steve-chavez c656a870f4 bump version to 10.2.0.20230407 2023-04-07 14:02:14 -05:00
steve-chavez 1b625cb77a feat: any/all modifiers for operators
Only for the eq,like,ilike,gt,gte,lt,lte,match,imatch operators
2023-04-07 13:10:57 -05:00
Robert Vollmert 394bd22148 feat: use hasql-pool-0.9, add db-pool-max-lifetime (fixes #2638)
- db-pool-acquisition-timeout is no longer optional, defaults to 10s
- new option db-pool-max-lifetime limits the maximal lifetime of a
  postgresql connection, defaults to 30m
2023-04-06 22:40:22 +02:00
Robert Vollmert 963416ae29 test: stabilize log probe in test_pool_acquisition_timeout
There's two lines of log output, and their order is not deterministic.
2023-04-06 22:40:22 +02:00
Laurence IslaandGitHub d3b10e7b2a feat: Allow filtering by IS DISTINCT FROM using the isdistinct operator 2023-04-06 13:02:03 -05:00
Steve ChavezandGitHub acf62320ef RPC returning table alias now works for pg 11/12 (#2737)
The new LATERAL query used for calling the function, introduced on
https://github.com/PostgREST/postgrest/pull/2677, failed on functions
that returned a domain like `CREATE DOMAIN projects_domain AS projects`.

Work around that by changing the query conditionally, by
obtaining a bool that represents the composite alias on the SchemaCache
and only do this on pg 11 and 12.
2023-04-05 15:34:41 -05:00
steve-chavez 16f2849724 refactor: wrap proc logic in asJsonF
* add explicit logic for returning setof scalars
2023-04-04 19:55:10 -05:00
steve-chavez d945e8c06a refactor: remove Maybe from RetType for Proc type 2023-04-04 19:55:10 -05:00
steve-chavez bc1fb67df0 drop: Prefer: params=multiple-objects on RPC
BREAKING CHANGE

A function with a JSON array or object parameter should be used instead
2023-04-04 19:55:10 -05:00
Wolfgang Walther 1442e02f5f chore: Allow seed-cachix job to keep running when part of the matrix fail 2023-04-04 18:52:52 +02:00
Wolfgang WaltherandWolfgang Walther 68d2d834ba nix: Update nixpkgs to 2023-03-25 2023-04-04 18:51:34 +02:00
Steve ChavezandGitHub eb777cf823 Update BACKERS.md 2023-04-03 11:09:19 -05:00
Laurence IslaandGitHub 1aed55be68 Ignore the Range header when the method is different than GET
fix: bug when using Range header on PATCH/DELETE
  - Fix the "message": "syntax error at or near \"RETURNING\"" error
  - Fix doing a limited update/delete when an order query parameter was present

breaking: The Range header is now only considered on GET requests and is ignored for any other method
  - Other methods should use the `limit/offset` query parameters for sub-ranges
  - PUT requests no longer return an error when this header is present
2023-04-03 10:40:25 -05:00
steve-chavez 032f07f3f0 refactor: remove character varying casting 2023-03-29 13:17:15 -05:00
steve-chavez 7629eff51d undefined-keys=apply-defaults to missing=default 2023-03-29 05:33:38 -05:00
steve-chavez 46fd856fc6 test: tidy inlining plan test 2023-03-29 05:33:38 -05:00
Laurence IslaandGitHub caaa9a3944 ci: Update ARM build script to use GHC 9.2.4 2023-03-24 20:23:43 -05:00
Steve ChavezandGitHub 439a96c578 feat: undefined json keys as defaults w/ Prefer:undefined-keys 2023-03-22 02:44:14 -05:00
Robert Vollmert e731241b97 test: optionally build postgrest with cabal in postgrest-loadtest
By default, postgrest-with-pgrst builds postgrest as a nix package,
which means that source changes cause a full rebuild. With this
change, running the loadtest as

PGRST_BUILD_CABAL=1 postgrest-loadtest

rebuilds directly using cabal, like postgrest-build. Note that
results between nix and cabal builds aren't necessarily comparable
due to differing build parameters.
2023-03-20 15:00:11 +01:00
Robert Vollmert 216dc833fd test: add optional latency to postgrest-loadtest
This pipes data between client/postgrest and between
postgrest/database through a proxy that adds delay
(github.com/robx/slocat).
2023-03-20 15:00:11 +01:00
Robert Vollmert a8e02f766b perf: Allow preparing pre-request SQL statement
This will prepare the pre-request statement (if prepared statements
are enabled) with a possible minor performance benefit -- the load
test is not entirely conclusive.
2023-03-20 13:40:43 +01:00
steve-chavez cae1c67b00 refactor: add iPreferences to ApiRequest
It avoids adding a new iPrefer.. to the ApiRequest every time a
preference is added.
2023-03-09 14:40:32 -05:00
Steve ChavezandGitHub b05ea14122 nix: add notices for postgrest-with-* commands (#2697)
For knowing where to connect and how to get logs
2023-03-07 12:42:41 -05:00
Steve ChavezandGitHub 666114f81d refactor: remove SchemaCache from ApiRequest (#2695) 2023-03-06 13:22:35 -05:00
Steve ChavezandGitHub 3e99995e6a feat: make db-root-spec stable (#2694) 2023-03-01 12:23:19 -05:00
steve-chavez 8213c58452 ci: pin Nix version to avoid error
To 2.13.3
2023-02-28 17:30:54 -05:00
steve-chavez ee036f8397 feat: add server-trace-header config for tracing 2023-02-28 17:30:54 -05:00
steve-chavez 5b6421d03a test: fix sporadic failure on PlanSpec 2023-02-28 17:30:54 -05:00
dependabot[bot]andSteve Chavez ba00cb98f4 build(deps): bump actions/upload-artifact from 2.3.1 to 3.1.2
Bumps [actions/upload-artifact](https://github.com/actions/upload-artifact) from 2.3.1 to 3.1.2.
- [Release notes](https://github.com/actions/upload-artifact/releases)
- [Commits](https://github.com/actions/upload-artifact/compare/v2.3.1...v3)

---
updated-dependencies:
- dependency-name: actions/upload-artifact
  dependency-type: direct:production
  update-type: version-update:semver-major
...

Signed-off-by: dependabot[bot] <support@github.com>
2023-02-27 12:00:46 -05:00
dependabot[bot]andSteve Chavez 6184921edc build(deps): bump actions/checkout from 2.4.0 to 3.3.0
Bumps [actions/checkout](https://github.com/actions/checkout) from 2.4.0 to 3.3.0.
- [Release notes](https://github.com/actions/checkout/releases)
- [Changelog](https://github.com/actions/checkout/blob/main/CHANGELOG.md)
- [Commits](https://github.com/actions/checkout/compare/v2.4.0...v3)

---
updated-dependencies:
- dependency-name: actions/checkout
  dependency-type: direct:production
  update-type: version-update:semver-major
...

Signed-off-by: dependabot[bot] <support@github.com>
2023-02-27 10:59:38 -05:00
Robert Vollmert 9e0ea113fb refactor: split pre-request function out of setPgLocals 2023-02-27 15:12:32 +01:00
steve-chavez 0d5d209bfb perf: use LATERAL instead of CTE for json body
* add pgbench test for INSERT and RPC
* use LATERAL for RPC and INSERT
* add tests for inlining
2023-02-25 15:01:06 -05:00
steve-chavez 253f2bf537 ci: remove GHC 8.10.7 2023-02-25 14:19:52 -05:00
steve-chavez 2a2889020a nix: fix PGTZ on postgrest-with-* commands 2023-02-20 17:23:11 -05:00
Steve ChavezandGitHub 6a79de67ce fix: log to stderr on AcquisitionTimeoutUsageError (#2667)
* refactor: remove uneeded type on checkIsFatal
* dry with a logPgrstError function
2023-02-17 17:38:31 -05:00
steve-chavez c49932d3a8 nix: UTC by default for postgrest-with-postgresql 2023-02-14 21:30:45 -05:00
RobertandGitHub 95d71281d6 refactor: fix inaccurate variable name (#2662) 2023-02-14 17:09:48 +01:00
steve-chavez a1e2fe308f bump version to 10.2.0.20230209 2023-02-09 17:18:31 -05:00
steve-chavez a9d66d1dac ci: fix ghcup 2023-02-09 16:46:27 -05:00
steve-chavez f4135bb3ff nix: correct postgrest-release pre 2023-02-09 16:46:27 -05:00
steve-chavez d7868235d8 refactor: add getRanges func to ApiRequest 2023-02-09 16:46:27 -05:00
Laurence IslaandGitHub 60f4446fd8 Change inaccurate error codes to new ones
- Code for column is not found is PGRST204
- Code for timed out when acquiring connection to db is PGRST003
2023-02-09 14:57:51 -05:00
Laurence IslaandGitHub c893ac15dc Add the missing 'get' path item for RPCs to the OpenAPI output 2023-02-09 12:04:41 -05:00
dependabot[bot]andSteve Chavez ecada119f8 build(deps): bump LouisBrunner/checks-action from 1.5.0 to 1.6.0
Bumps [LouisBrunner/checks-action](https://github.com/LouisBrunner/checks-action) from 1.5.0 to 1.6.0.
- [Release notes](https://github.com/LouisBrunner/checks-action/releases)
- [Commits](https://github.com/LouisBrunner/checks-action/compare/v1.5.0...v1.6.0)

---
updated-dependencies:
- dependency-name: LouisBrunner/checks-action
  dependency-type: direct:production
  update-type: version-update:semver-minor
...

Signed-off-by: dependabot[bot] <support@github.com>
2023-02-06 09:21:31 -05:00
steve-chavez 57e32ca0a3 bump version to 10.2.0.20230203 2023-02-03 21:16:43 -05:00
Laurence IslaandGitHub eb3f7c696a Fix release date for v10.1.2 in CHANGELOG 2023-02-02 14:50:42 -05:00
Laurence IslaandSteve Chavez 09249f97ab Update CHANGELOG to include release 10.1.2 2023-02-02 14:40:34 -05:00
Laurence IslaandGitHub 754282c385 Add missing fixes to the changelog 2023-02-01 22:15:43 -05:00
steve-chavez 52ba757ebe nix: postgrest-release bumps pre minor 2023-01-31 19:11:45 -05:00
steve-chavez 7aadaa44e8 refactor: remove Target from infoResponse 2023-01-30 00:23:24 -05:00
steve-chavez 0139cd8261 refactor: move txMode to Plan 2023-01-30 00:23:24 -05:00
steve-chavez 7874bee879 fix: NOTIFY pgrst not reoading the catalog cache 2023-01-28 10:30:29 -05:00
RobertandGitHub 12ad7d0585 test: fix result path for load test (#2628) 2023-01-25 08:56:52 +01:00
AnthonyFisiandGitHub 9065ed65fa feat: customizable OpenAPI title 2023-01-21 19:34:55 -05:00
Tuan LeandSteve Chavez 8aa79086d2 fix: consider authentication failure as a fatal error 2023-01-20 13:51:28 -05:00
Laurence IslaandGitHub 775c006806 fix: FK pointing to VIEW instead of TABLE in OpenAPI output 2023-01-20 09:37:15 -05:00
steve-chavez be6c30a0fb refactor: dry RPC param parsing 2023-01-18 12:26:13 -05:00
RobertandGitHub 8f80cd1469 Update nixpkgs, dependencies (#2612)
* relax upper bounds on HTTP, hspec, lens-aeson, optparse-applicative (fixes #2580)
* upgrade stackage snapshot to latest LTS, with GHC 9.2.5
* bump nixpkgs to 2023-01-12
* fix complaints due to updated linters
2023-01-16 17:12:54 +01:00
RobertandGitHub 5fd6b3956e ci: Add workflow to seed cachix (#2615)
Fixes #2609.
2023-01-16 16:56:48 +01:00
RobertandGitHub f353711ed2 ci: build with nix on macos (and push to cachix) (#2610)
The idea is to ensure the macos nix build works, and to
build a cache in cachix to help local development on macos.
2023-01-12 11:45:10 +01:00
Robert Vollmert 0a56d6ce88 ci: authenticate GitHub API request (fixes #2607) 2023-01-10 18:45:50 +01:00
Alexander LjungbergandGitHub 43ad6d6aa0 feat: validate ?columns mutation targets based on schema cache (#2542)
This returns an error for trying to update or insert into invalid columns, without hitting the database. This change also switches from `json_populate_recordset` for these operations `json_to_recordset` which should make no functional difference except allowing future flexibility.
2023-01-07 22:08:30 -05:00
RobertandGitHub 5a0f83ecb8 bump postgresql-libpq (#2599)
For https://github.com/PostgREST/postgresql-libpq/pull/2.
2022-12-30 15:40:17 +01:00
Laurence IslaandGitHub 4ddd5b4a76 Add upsert headers for POST requests to the OpenAPI output 2022-12-27 16:16:41 -05:00
Laurence IslaandGitHub 1f69757835 fix: Add required OpenAPI items object when the paramater is an array 2022-12-20 12:30:28 -05:00
steve-chavez e0df95844b bump version to 10.1.1.20221215 2022-12-15 23:06:32 -05:00
Laurence IslaandGitHub 5a660e0cbe Add suggestions with fuzzy text search when no relationship is found (#2583) 2022-12-15 18:33:15 -05:00
steve-chavez 566c6fe53f correct bad null filter restriction
When embedding using the column name.

Also make related order similarly strict to avoid the same kind of issues.
2022-12-15 18:02:25 -05:00
steve-chavez d93bb95d83 bump version to 10.1.1.20221212 2022-12-12 17:34:46 -05:00
steve-chavez 3773cce246 feat: null filters on embedded resources 2022-12-12 17:14:54 -05:00
steve-chavez 52c011f896 refactor: remove Bool from readPlanToQuery 2022-12-12 17:14:54 -05:00
steve-chavez 81cd9d4b15 refactor: delete unused TestTypes 2022-12-12 13:31:02 -05:00
steve-chavez 781fa592ca refactor: delete QueryCost, instead use PlanSpec 2022-12-12 13:31:02 -05:00
steve-chavez 1065021348 refactor: add planCost and planHdr for tests 2022-12-12 13:31:02 -05:00
Laurence IslaandGitHub aecc53d8f9 fix: clarify error messages for functions
Move explanation on single unnamed parameters to the error details
2022-12-09 14:34:38 -05:00
steve-chavez a5465e20d0 correct spread embed to '...' 2022-12-05 19:38:32 -05:00
Laurence IslaandGitHub 9e567216e9 feat: hint function names/parameters on error 2022-12-01 17:17:45 -05:00
Steve ChavezandGitHub 5e9dba5292 feat: Allow embedding without selecting any column (#2574) 2022-11-25 18:37:57 -05:00
steve-chavez f7009635d6 test: move failed order parsing to doctest 2022-11-24 09:03:35 -05:00
steve-chavez e5c77385ae test: move failed or/and parsing to doctest 2022-11-24 09:03:35 -05:00
steve-chavez 3103060f4b test: move failed json parsing to doctest 2022-11-24 09:03:35 -05:00
steve-chavez 315b01ebf7 test: spread embed includes junction cols 2022-11-18 18:11:14 -05:00
steve-chavez 25f65065f4 test: spread embed disambiguates recursive m2m 2022-11-18 18:11:14 -05:00
steve-chavez 60c0c11c1d test: spread embed disambiguates 2 fks on junction 2022-11-18 18:11:14 -05:00
steve-chavez cb99270a8f fix: bad M2M embed on RPC 2022-11-18 17:49:24 -05:00
steve-chavez cca0b5ae66 messages: better error for related order 2022-11-16 21:26:16 -05:00
steve-chavez 2aa0e091bb feat: add spread embeds 2022-11-16 21:26:16 -05:00
steve-chavez 78d45b4e32 feat: add related orders 2022-11-08 17:28:50 -05:00
steve-chavez ef42d1c87f test: add doctest for pOrderTerm 2022-11-08 17:28:50 -05:00
steve-chavez aaa4fbc370 bump version to 10.1.1 2022-11-08 12:51:16 -05:00
Robert VollmertandWolfgang Walther 5e65b2afaf fix: bump hasql-pool to 0.8.0.6
This update ensures that connections aren't lost if they throw
an exception. Compare #2558.
2022-11-05 15:48:52 +01:00
steve-chavez 3408998629 bump version to 10.1.0.20221104 2022-11-04 18:47:48 -05:00
Laurence IslaandGitHub b8c5d212ea fix: Fatal error when requesting limit=0 and db-max-rows is set (#2560) 2022-11-04 18:14:16 -05:00
c8e4f38984 feat: Build against libpq 15
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
Co-authored-by: Wolfgang Walther <walther@technowledgy.de>
2022-11-02 08:25:07 +01:00
Wolfgang WaltherandWolfgang Walther 44dd73adcc fix: Embedding views with partial FK references broken
This is a regression introduced in d2719420f4.

Fixes #2548

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-31 18:15:06 +01:00
steve-chavez b2935ef799 bump version to 10.1.0 2022-10-28 18:09:19 -05:00
steve-chavez 0b1f8358c6 nix: postgrest-release modifies CHANGELOG 2022-10-28 17:52:58 -05:00
Wolfgang WaltherandWolfgang Walther 2c31c64325 fix: Detect all relationships when multiple view columns reference the same table column
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-28 18:12:58 +02:00
Wolfgang Walther 425ab70ec7 fix: Make UPSERT work with PostgreSQL 15
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-28 16:18:42 +02:00
Wolfgang Walther 2cce82bdd5 chore: Upgrade nixpkgs to 2022-10-28
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-28 14:27:56 +02:00
Robert VollmertandWolfgang Walther 800873ed91 try applying same override to openssl_1_1 as openssl 2022-10-28 10:49:04 +02:00
Robert VollmertandWolfgang Walther b702c5fbe4 pytest_xdist -> pytest-xdist 2022-10-28 10:49:04 +02:00
Robert VollmertandWolfgang Walther cfd0ee35d3 bump haskell dependency versions 2022-10-28 10:49:04 +02:00
Robert VollmertandWolfgang Walther 31cd0bbff4 bash_5 -> bash 2022-10-28 10:49:04 +02:00
Robert VollmertandWolfgang Walther 78ec8a095a bump nixpkgs again, hoping this fixes things 2022-10-28 10:49:04 +02:00
Robert VollmertandWolfgang Walther 39959fa330 fix nixpkgs-ugprade to use correct /bin/date 2022-10-28 10:49:04 +02:00
Robert VollmertandWolfgang Walther fc3a01fabe further bump, simplify hackage overrides 2022-10-28 10:49:04 +02:00
Robert VollmertandWolfgang Walther 03b810ffa5 allow/use lens 5.2 2022-10-28 10:49:04 +02:00
Robert VollmertandWolfgang Walther 177ec4df85 downgrade postgis 2022-10-28 10:49:04 +02:00
Robert VollmertandWolfgang Walther dbf645b899 upgrade nix wip 2022-10-28 10:49:04 +02:00
Wolfgang WaltherandWolfgang Walther e274706088 fix: Ignore leading and trailing spaces in column names, fts languages and casts
Fixes #2285

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 21:54:44 +02:00
Wolfgang WaltherandWolfgang Walther da632ac7d3 refactor: pIdentifierChar -> pIdentifier
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 21:54:44 +02:00
Wolfgang WaltherandWolfgang Walther b78b096ae4 fix: Stricter query string parsing - no empty fts lang
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 21:54:44 +02:00
Wolfgang WaltherandWolfgang Walther bbbc308b6f fix: Stricter query string parsing - no empty casts
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 21:54:44 +02:00
Wolfgang WaltherandWolfgang Walther ecf54bef43 test: Add basic doctests for pFieldName
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 21:54:44 +02:00
Wolfgang WaltherandWolfgang Walther 8c0d187044 fix: Stricter query string parsing - no hints or join types in regular fields
Fixes #2362

Reference #2475

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 21:54:44 +02:00
Wolfgang WaltherandWolfgang Walther ae8625a7b6 fix: Stricter query string parsing - no jsonpath in embedding
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 21:54:44 +02:00
Wolfgang WaltherandWolfgang Walther 7c7a04a27e test: Add doctests for pFieldForest
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 21:54:44 +02:00
Wolfgang WaltherandWolfgang Walther 2289defe4b refactor: Use stronger typing for SelectItem parser
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 21:54:44 +02:00
Wolfgang WaltherandWolfgang Walther 772d3c4e01 chore: Update cachix actions
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 21:54:30 +02:00
steve-chavez 45e7aac218 fix: embedding computed with normal relationship 2022-10-27 13:49:53 -05:00
steve-chavez 5d126bf0a3 refactor: all aliasing in addRels 2022-10-27 13:49:53 -05:00
Wolfgang WaltherandWolfgang Walther f9f572a5d2 fix: Treat non-setof computed relationships as M2O/O2M
Fixes #2481

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 19:50:38 +02:00
Wolfgang WaltherandWolfgang Walther 88b5966a44 nix: Remove deprecation warning for dockerTools.buildImage { contents }
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 19:29:26 +02:00
Wolfgang WaltherandWolfgang Walther 3d2880d40a fix: Return status code 200 when PATCHing without changing rows
This partially reverts #1257 / #1272 / 553531711b where the 404 was introduced.

A 406 error is still returned when requesting a single object via accept header.

Returning an error when no rows are changed can be introduced through a different syntax again, see the discussion in #2164.

Fixes #2343

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 19:28:06 +02:00
Wolfgang WaltherandWolfgang Walther 958e052de5 chore: Clean up CHANGELOG
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 17:39:04 +02:00
Wolfgang WaltherandWolfgang Walther 793acd276a test: Non-existing config options should not break anything
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-27 17:39:04 +02:00
Wolfgang Walther 9be6747b66 fix: Prevent infinite recursion with self-referencing views
Fixes #2283

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-26 21:33:30 +02:00
Wolfgang Walther 3bee6b1e27 fix: Fix regression in openapi output with mode follow-privileges
This was introduced in d5b92a433a. Before
this change, the OpenApi output would have <pk/> annotations for views,
too. After this change, they got lost for mode follow-privileges, because
the pks are refined in haskell code, but the request only fetches all
the tables again, but not the view dependencies.

This fix changes follow-privileges to only fetch a list of accessible
tables, which is then used to filter the tables in the schema cache.

Fixes #2356

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-26 21:29:58 +02:00
Wolfgang WaltherandWolfgang Walther 6fe1617348 fix: Expose PKs from all tables in a view
Fixes a regression in d2719420f4.

Resolves #2458

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-24 16:49:32 +02:00
Wolfgang WaltherandWolfgang Walther 2158f3d039 fix: Embed views with different column ordering correctly
This fixes a regression introduced in d2719420f4.

The order of relColumns in the schema cache is now consistently matching the order of columns in foreign key definitions.

Resolves #2518

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-24 16:49:32 +02:00
Wolfgang WaltherandWolfgang Walther ca338ae401 test: Remove unused no_pk_view from fixtures
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-24 16:49:32 +02:00
Wolfgang WaltherandWolfgang Walther 5135fea797 test: grant privileges on all test tables by default
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-10-24 16:49:32 +02:00
dependabot[bot]andSteve Chavez df538bfd98 build(deps): bump LouisBrunner/checks-action from 1.3.1 to 1.5.0
Bumps [LouisBrunner/checks-action](https://github.com/LouisBrunner/checks-action) from 1.3.1 to 1.5.0.
- [Release notes](https://github.com/LouisBrunner/checks-action/releases)
- [Commits](https://github.com/LouisBrunner/checks-action/compare/v1.3.1...v1.5.0)

---
updated-dependencies:
- dependency-name: LouisBrunner/checks-action
  dependency-type: direct:production
  update-type: version-update:semver-minor
...

Signed-off-by: dependabot[bot] <support@github.com>
2022-10-24 09:37:56 -05:00
steve-chavez 7ace8ace49 fix: aliasing on computed rels 2022-10-19 19:49:43 -05:00
steve-chavez c8b39c6cde refactor: aliasing logic to addRels
* also shorten query builder alias logic
2022-10-19 19:49:43 -05:00
steve-chavez 5f5a0c7764 refactor: simplify join conditions logic 2022-10-19 19:49:43 -05:00
steve-chavez 922da4520f refactor: clarify ReadPlan fields 2022-10-19 19:49:43 -05:00
Felix YanandSteve Chavez 64e047e5d7 Allow aeson 2.1
Builds fine and all tests pass.
2022-10-14 13:44:39 -05:00
steve-chavez efecf007e8 bump version to 10.0.0.20221011 2022-10-11 11:42:40 -05:00
Felix YanandSteve Chavez b81e15d0c5 Allow vector 0.13
Builds fine and all tests pass.
2022-10-10 17:47:48 -05:00
Steve ChavezandGitHub 0fbb116dd2 add basic ARCHITECTURE.md (#2503)
* refactor: move ApiRequest a top-level module
* refactor: rename DbStructure to SchemaCache
* refactor: GucHeader inside Response
* refactor: admin app to Workers
2022-10-10 11:24:45 -05:00
steve-chavez e4b98d51be fix: resource embedding opens empty transaction
This required untangling logic from App.hs.
Building/rejecting a plan no longer consumes a pool connection.

* Added io test for failed resource embedding not consuming connection
* optionalrollback to Query.hs and Response.hs
* delete Middleware module
* remove plan logic from App.hs
* remove RequestContext
* remove pkCols logic from App.hs
* remove proc logic from App.hs
* remove config logic from handleRequest
2022-10-07 18:52:57 -05:00
steve-chavez d37e14c4db refactor: readTotal into ResultSet 2022-10-07 18:52:57 -05:00
Felix YanandSteve Chavez cfaeff8a5a Allow jose 0.10
Builds fine and all tests pass.
2022-10-05 18:22:32 -05:00
steve-chavez 6398dd2b32 refactor: add plan module
* rename/add plan dirs
* add read plan func/data
* add call plan func/data
* add mutate plan func/data
2022-10-04 16:13:34 -05:00
steve-chavez 11385bbd9f refactor: move binaryField to ApiRequest 2022-10-01 11:05:49 -05:00
steve-chavez 858e4405ec refactor: getSchema in ApiRequest 2022-10-01 11:05:49 -05:00
steve-chavez 46307ca64a refactor: getMediaType in ApiRequest 2022-10-01 11:05:49 -05:00
steve-chavez fd67c8480c refactor: OpenAPI as Response submodule
* body after dbstructure
* rename runPgLocals to setPgLocals
2022-10-01 11:05:49 -05:00
steve-chavez f54dc2e20e refactor: runPgLocals to Query.hs
* unmmiddleware runPgLocals
2022-09-26 17:28:08 -05:00
steve-chavez e356783cc9 refactor: add Query.hs module
* add readQuery
* add createQuery
* update query
* single upsert query
* delete query
* invoke query
* open api query
2022-09-26 17:28:08 -05:00
steve-chavez b5080fa2d7 refactor: untangle query logic from request logic 2022-09-26 17:28:08 -05:00
dependabot[bot]andSteve Chavez e564ed6e3e build(deps): bump codecov/codecov-action from 3.1.0 to 3.1.1
Bumps [codecov/codecov-action](https://github.com/codecov/codecov-action) from 3.1.0 to 3.1.1.
- [Release notes](https://github.com/codecov/codecov-action/releases)
- [Changelog](https://github.com/codecov/codecov-action/blob/master/CHANGELOG.md)
- [Commits](https://github.com/codecov/codecov-action/compare/v3.1.0...v3.1.1)

---
updated-dependencies:
- dependency-name: codecov/codecov-action
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>
2022-09-26 12:12:12 -05:00
steve-chavez 8d369a2195 refactor: add Response.hs module
* add response updateResponse
* add singleUpsertResponse
* add delete/invoke response
* add open api response
* add info response
* remove ApiRequest from profileHeader
* contentTypeHeaders only needs ApiRequest
2022-09-25 13:53:11 -05:00
steve-chavez 92e28bd902 refactor: untangle query logic from response logic
* untangle failNotSingular
* untangle failsChangesOffLimits
* untangle readTotal
2022-09-25 13:53:11 -05:00
steve-chavez c27e7be028 refactor: move guc headers/status decoding to App 2022-09-25 13:53:11 -05:00
Wolfgang WaltherandSteve Chavez 9d3bbc736b nix: Add hint how to derive docker image
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-09-20 16:39:37 -05:00
Robert Vollmert 38ecaa44db encode json body in binary, using modified hasql dep
- switch from "unknown" parameter in text format to a "json" parameter in
  binary format (no dependency update required)
- use a lazy bytestring "json" encoder (via updated hasql)
2022-09-19 20:49:11 +02:00
Robert Vollmert efd65ff1f4 nix: add update-nix-fetchgit to shell 2022-09-19 20:49:11 +02:00
Laurence IslaandGitHub d5e662567b fix: add error body when Prefer: count=exact is used and offset is out of bounds
* Adds error body when Prefer: count=exact is used and offset is out of bounds

* Adds details to differentiate between negative limits, lower boundaries greater than upper boundaries and out of bound ranges
2022-09-15 18:39:37 -05:00
Laurence IslaandGitHub 334f500f7c fix: make computed relationships work when the schema name has special characters 2022-09-15 11:07:57 -05:00
dependabot[bot]andSteve Chavez bb52fb9b0e build(deps): bump LouisBrunner/checks-action from 1.2.0 to 1.3.1
Bumps [LouisBrunner/checks-action](https://github.com/LouisBrunner/checks-action) from 1.2.0 to 1.3.1.
- [Release notes](https://github.com/LouisBrunner/checks-action/releases)
- [Commits](https://github.com/LouisBrunner/checks-action/compare/v1.2.0...v1.3.1)

---
updated-dependencies:
- dependency-name: LouisBrunner/checks-action
  dependency-type: direct:production
  update-type: version-update:semver-minor
...

Signed-off-by: dependabot[bot] <support@github.com>
2022-09-07 11:02:48 -05:00
Robert Vollmert 74ee6cd674 fix naming of stack builds (they don't test) 2022-09-05 23:27:41 +02:00
Robert Vollmert 524c6a7c2c postgresql-libpq: use PostgREST fork with reduced copies
This pulls in the change from https://github.com/PostgREST/postgresql-libpq/pull/1.
2022-09-05 23:27:41 +02:00
Robert Vollmert c9f7504d09 ci: edit stack.yaml.lock trivially to invalidate macOS cache 2022-09-05 17:57:50 +02:00
Robert Vollmert ba1fcfd1e3 feat: introduce pool acquisition timeout (fixes #2348)
The configuration option db-pool-acquisition-timeout
specifies the time in seconds to wait for the pool to
free up a connection slot. Otherwise, a 504 error is
returned. By default, there is no timeout.
2022-08-31 19:54:34 +02:00
Robert Vollmert 554db21f49 tests: fix 'no_pool_connections_available' (fixes #2456) 2022-08-31 19:13:53 +02:00
Robert Vollmert ebc34561fa tests: show that 'no_pool_connections_available' is broken 2022-08-31 19:13:53 +02:00
Robert Vollmert 5ae9a2b1cf tests: split test_io.py 2022-08-31 19:13:53 +02:00
Robert Vollmert e2aa227597 upgrade to hasql-1.6, hasql-pool-0.8.0.2
- hasql-pool-0.8
  * 'release' now flushes the pool, and no longer destroys it;
    'PoolIsReleasedUsageError' is gone compared to our fork
  * now supports an acquisition timeout, which we don't use
    yet
  * lower bound on 0.8.0.2 to fix a Windows build issue
- hasql-1.6
  introduces a position parameter to ServerError, which we
  ignore
2022-08-30 20:59:26 +02:00
Robert Vollmert 81f42d4b8a changelog: repair unreleased section 2022-08-29 17:01:45 +02:00
Robert Vollmert 90eaaefe12 upgrade to fork of hasql-pool 0.7.2 (fixes #2401)
This version of hasql-pool is a simplified rewrite that doesn't use
the resource-pool package. The major API changes are that idle
connections are no longer timed out (and the corresponding setting
is gone), and that `release` makes the pool unusable, where it used
to remain usable and only flushed idle connections.

We depend on a PostgREST fork of 0.7.2 that gives us reliable
flushing, compare https://github.com/PostgREST/hasql-pool/pull/1

- hasql-pool 0.7 removes timing out of idle connections, so
  this change removes the db-pool-timeout option.
  Given that we were typically running with very high
  timeout settings, I don't anticipate the lack of timeout
  to introduce new issues, though we might want to consider
  introducing some retry-logic down the line when we
  encounter connection failures.
- See https://github.com/PostgREST/postgrest/issues/2422 for a
  discussion on depending on a forked dependency. Besides adding
  the dependency to the nix overlay, we're also adding it to
  stack.yaml and a new cabal.project to allow stack/cabal users
  to build the project.
2022-08-29 14:55:09 +02:00
Robert Vollmert cdce929159 refactor: more accurate naming and documentation for connectionStatus 2022-08-29 14:55:09 +02:00
Robert Vollmert 79b865ba79 refactor: rename releasePool to flushPool and document its intended behaviour
Also fix documentation of AppState pool field.
2022-08-29 14:55:09 +02:00
Robert Vollmert 8e96e3b3ae ci: install git for cirrus to allow git repo dependencies 2022-08-29 14:55:09 +02:00
Robert Vollmert 0595e564da tests: update app settings test
The original test no longer makes sense once we drop pool timeouts
with the hasql-pool upgrade.

To somehow test that new connections have the settings, convert it
to flush the pool instead.
2022-08-29 14:55:09 +02:00
Robert Vollmert 9bb0bc1750 tests: validate that requests survive SIGUSR1 2022-08-29 14:55:09 +02:00
Laurence IslaandGitHub 950070ce4e Deprectate bulk-call 2022-08-26 12:09:47 -05:00
Robert Vollmert 3b290d524c Add a CI check for building with Cabal
The idea is that this ensures
1. that it's easy for contributers to hack on PostgREST without
   getting nix set up
2. we see things break more easily outside the very controlled nix
   environment (e.g. it would be easy to add a GHC 9.4.2 build here)
2022-08-24 23:50:00 +02:00
Robert Vollmert 906fac2dd6 Consistently use the same checkout action 2022-08-24 23:50:00 +02:00
Felix YanandSteve Chavez 377944502d Correct typos in QueryParams.hs 2022-08-20 16:52:34 -05:00
172 changed files with 14568 additions and 6247 deletions
+1 -1
View File
@@ -3,7 +3,7 @@ freebsd_instance:
build_task:
name: Build FreeBSD (Stack)
install_script: pkg install -y postgresql13-client hs-stack
install_script: pkg install -y postgresql13-client hs-stack git
stack_cache:
folders: /.stack
+12
View File
@@ -3,4 +3,16 @@ When submitting a new feature or fix:
- Add a new entry to the CHANGELOG - https://github.com/PostgREST/postgrest/blob/main/CHANGELOG.md#unreleased
- If relevant, update the docs - https://github.com/PostgREST/postgrest-docs
- Use a prefix for the PR title or commits, e.g. "fix: description of the fix".
+ `fix`, bug fixes
+ `feat`, new features added
+ `perf`, performance improvements
+ `nix`, related to the Nix development environment
+ `ci`, related to the Continuous Integration modules
+ `test`, related to the testing modules
+ `refactor`, refactoring code
+ `deprecate`, deprecating a feature
+ `chore`, maintenance (changelog, build process, etc.)
+ Other prefixes may be used if necessary
- If there's a breaking change, add `BREAKING CHANGE` and an explanation to your commit message
-->
+13 -2
View File
@@ -7,12 +7,23 @@ inputs:
description: Token to pass to cachix
tools:
description: Tools to install with nix-env -iA <tools>
cache-id:
description: Cache id to use for cache-nix-action
default: "default"
runs:
using: composite
steps:
- uses: cachix/install-nix-action@v16
- uses: cachix/cachix-action@v10
- uses: nixbuild/nix-quick-install-action@v26
with:
nix_version: '2.13.6'
- name: Restore and cache Nix store
uses: nix-community/cache-nix-action@v4.0.3
with:
key: cache-nix-${{ runner.os }}-id-${{ inputs.cache-id }}-${{ hashFiles('nix/**/*.nix', '.github/actions/setup-nix/*') }}
restore-keys: |
cache-nix-${{ runner.os }}-common-
- uses: cachix/cachix-action@v13
with:
name: postgrest
authToken: ${{ inputs.authToken }}
+9 -4
View File
@@ -1,6 +1,11 @@
version: 2
updates:
- package-ecosystem: github-actions
directory: /
schedule:
interval: weekly
- package-ecosystem: github-actions
directory: /
schedule:
interval: weekly
- package-ecosystem: github-actions
directory: /.github/actions/setup-nix
schedule:
interval: weekly
+4 -3
View File
@@ -7,12 +7,13 @@ set -euo pipefail
# https://docs.github.com/en/rest/reference/checks#list-check-suites-for-a-git-reference
cirrus_artifact_name=bin
gh_auth_header="Authorization: Bearer $GITHUB_TOKEN"
gh_accept_header="Accept: application/vnd.github.v3+json"
get_gh_check_runs_url() {
gh_checks_list_url="https://api.github.com/repos/$GITHUB_REPOSITORY/commits/$GITHUB_COMMIT/check-suites"
>&2 echo "Getting list of check-suites from $gh_checks_list_url ..."
curl --fail -H "$gh_accept_header" "$gh_checks_list_url" \
curl --fail -H "$gh_auth_header" -H "$gh_accept_header" "$gh_checks_list_url" \
| jq -r '.check_suites[] | select(.app.slug == "cirrus-ci") | .check_runs_url'
}
@@ -21,7 +22,7 @@ wait_for_cirrusci() {
>&2 echo "Waiting to CirrusCI run to complete (two hours maximum)..."
for _ in $(seq 1 120); do
echo "Checking for CirrusCI task status at $gh_check_runs_url ..."
status=$(curl --fail "$gh_check_runs_url" | jq -r '.check_runs[] | .status')
status=$(curl --fail -H "$gh_auth_header" "$gh_check_runs_url" | jq -r '.check_runs[] | .status')
if [ "$status" == "completed" ]; then
break
else
@@ -37,7 +38,7 @@ wait_for_cirrusci() {
get_cirrus_taskid() {
gh_check_runs_url="$(get_gh_check_runs_url)"
>&2 echo "Getting the CirrusCI task id from $gh_check_runs_url ..."
curl --fail -H "$gh_accept_header" "$gh_check_runs_url" \
curl --fail -H "$gh_auth_header" -H "$gh_accept_header" "$gh_check_runs_url" \
| jq -r '.check_runs[] | .external_id'
}
+11 -6
View File
@@ -4,11 +4,15 @@
[ -z "$1" ] && { echo "Missing 1st argument: PostgREST github commit SHA"; exit 1; }
[ -z "$2" ] && { echo "Missing 2nd argument: Build environment directory name"; exit 1; }
[ -z "$3" ] && { echo "Missing 3rd argument: GHC version"; exit 1; }
PGRST_GITHUB_COMMIT="$1"
SCRIPT_DIR="$2"
DOCKER_BUILD_DIR="$SCRIPT_DIR/docker-env"
# latest is a shortcut documented on https://www.haskell.org/ghcup/guide/#tags-and-shortcuts
CABAL_VERSION="latest"
GHC_VERSION="$3"
install_packages() {
sudo apt-get update -y
@@ -26,13 +30,14 @@ install_ghcup() {
install_cabal() {
ghcup upgrade
ghcup install cabal 3.6.0.0
ghcup set cabal 3.6.0.0
ghcup install cabal $CABAL_VERSION
ghcup set cabal $CABAL_VERSION
}
install_ghc() {
ghcup install ghc 8.10.7
ghcup set ghc 8.10.7
ghcup upgrade
ghcup install ghc $GHC_VERSION
ghcup set ghc $GHC_VERSION
}
install_packages
@@ -41,8 +46,8 @@ install_packages
[ -f ~/.ghcup/env ] && source ~/.ghcup/env
ghcup --version || install_ghcup
cabal --version || install_cabal
ghc --version || install_ghc
ghcup set cabal $CABAL_VERSION || install_cabal
ghcup set ghc $GHC_VERSION || install_ghc
cd ~/$SCRIPT_DIR
+3 -1
View File
@@ -13,4 +13,6 @@ EXPOSE 3000
USER 1000
CMD postgrest
# Use the array form to avoid running the command using bash, which does not handle `SIGTERM` properly.
# See https://docs.docker.com/compose/faq/#why-do-my-services-take-10-seconds-to-recreate-or-stop
CMD ["postgrest"]
+78
View File
@@ -0,0 +1,78 @@
name: Cachix
# This workflow serves to
# - keep cachix up to date with the main branch
# - incrementally update cachix for large dependency
# updates, e.g. after running postgrest-nixpkgs-upgrade,
# which can cause the main CI workflow to time out
on:
workflow_dispatch:
push:
branches:
- main
- rel-*
tags:
- v*
jobs:
Seed-Cachix:
strategy:
fail-fast: false
matrix:
include:
- os: Linux
runs-on: ubuntu-latest
- os: MacOS
runs-on: macos-latest
name: Seed ${{ matrix.os }}
runs-on: ${{ matrix.runs-on }}
steps:
- uses: actions/checkout@v4
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
- name: Install cachix tooling
run: |
nix-env -f default.nix -iA devTools.pushCachix.bin
postgrest-push-cachix
- name: Seed dynamic postgrest build
run: |
nix-build -A postgrestPackage
postgrest-push-cachix
- name: Seed style tools
run: |
nix-build -A style
postgrest-push-cachix
- name: Seed test tools
run: |
nix-build -A tests
postgrest-push-cachix
- name: Seed static toolchain
if: matrix.os == 'Linux'
run: |
nix-build -A packagesStatic.haskellPackages.hello
postgrest-push-cachix
- name: Seed static postgresql build (for libpq)
if: matrix.os == 'Linux'
run: |
nix-build -A packagesStatic.pkgs.postgresql
postgrest-push-cachix
- name: Seed static postgrest build
if: matrix.os == 'Linux'
run: |
nix-build -A postgrestStatic
postgrest-push-cachix
- name: Build and push everything to Cachix
run: |
nix-build
postgrest-push-cachix
+153 -59
View File
@@ -11,17 +11,39 @@ on:
branches:
- main
- rel-*
concurrency:
group: ${{ github.workflow }}-${{ github.ref }}
# Terminate all previous runs of the same workflow and branch/tag, except for main and release branches/tags
cancel-in-progress: "${{ !(github.ref == 'refs/heads/main' || startsWith(github.ref, 'refs/tags/v') || startsWith(github.ref, 'refs/heads/rel-')) }}"
jobs:
Prepopulate-Nix-Cache-Linux:
name: Prepopulate Nix cache for Linux runners
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v4
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
cache-id: common
- name: Put all tools to store to be cached afterwards
run: |
# shellcheck disable=SC2046
nix-store -v --realize $( nix-instantiate default.nix )
shell: bash
Lint-Style:
name: Lint & check code style
runs-on: ubuntu-latest
needs: [Prepopulate-Nix-Cache-Linux]
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
tools: style
cache-id: common
- name: Run linter (check locally with `nix-shell --run postgrest-lint`)
run: postgrest-lint
- name: Run style check (auto-format with `nix-shell --run postgrest-style`)
@@ -31,22 +53,24 @@ jobs:
Test-Nix:
name: Test (Nix)
runs-on: ubuntu-latest
needs: [Prepopulate-Nix-Cache-Linux]
defaults:
run:
# Hack for enabling color output, see:
# https://github.com/actions/runner/issues/241#issuecomment-842566950
shell: script -qec "bash --noprofile --norc -eo pipefail {0}"
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
tools: tests
cache-id: common
- name: Run coverage (IO tests and Spec tests against PostgreSQL 14)
- name: Run coverage (IO tests and Spec tests against PostgreSQL 15)
run: postgrest-coverage
- name: Upload coverage to codecov
uses: codecov/codecov-action@v3.1.0
uses: codecov/codecov-action@v3.1.4
with:
files: ./coverage/codecov.json
@@ -63,20 +87,24 @@ jobs:
strategy:
fail-fast: false
matrix:
pgVersion: [9.6, 10, 11, 12, 13, 14]
pgVersion: [9.6, 10, 11, 12, 13, 14, 15, 16]
name: Test PG ${{ matrix.pgVersion }} (Nix)
runs-on: ubuntu-latest
needs: [Prepopulate-Nix-Cache-Linux]
defaults:
run:
# Hack for enabling color output, see:
# https://github.com/actions/runner/issues/241#issuecomment-842566950
shell: script -qec "bash --noprofile --norc -eo pipefail {0}"
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
tools: tests withTools
# It seems like they are installing the same set of derivations, so we can assign them the same cache id.
# This would decrease the amount of caches dowloaded on merge cache step and will prevent disk space issues.
cache-id: common
- name: Run spec tests
if: always()
@@ -84,22 +112,20 @@ jobs:
- name: Run IO tests
if: always()
run: postgrest-with-postgresql-${{ matrix.pgVersion }} -f test/io/fixtures.sql postgrest-test-io
- name: Run query cost tests
if: always()
run: postgrest-with-postgresql-${{ matrix.pgVersion }} postgrest-test-querycost
run: postgrest-with-postgresql-${{ matrix.pgVersion }} -f test/io/fixtures.sql postgrest-test-io -vv
Test-Memory-Nix:
name: Test memory (Nix)
runs-on: ubuntu-latest
needs: [Prepopulate-Nix-Cache-Linux]
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
tools: memory
cache-id: common
- name: Run memory tests
run: postgrest-test-memory
@@ -107,20 +133,21 @@ jobs:
Build-Static-Nix:
name: Build Linux static (Nix)
runs-on: ubuntu-latest
needs: [Prepopulate-Nix-Cache-Linux]
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
tools: tests
cache-id: common
- name: Build static executable
run: nix-build -A postgrestStatic
- name: Check static executable
run: postgrest-check-static result/bin/postgrest
- name: Save built executable as artifact
uses: actions/upload-artifact@v3
uses: actions/upload-artifact@v4
with:
name: postgrest-linux-static-x64
path: result/bin/postgrest
@@ -129,18 +156,23 @@ jobs:
- name: Build Docker image
run: nix-build -A docker.image --out-link postgrest-docker.tar.gz
- name: Save built Docker image as artifact
uses: actions/upload-artifact@v3
uses: actions/upload-artifact@v4
with:
name: postgrest-docker-x64
path: postgrest-docker.tar.gz
if-no-files-found: error
- name: Build and push everything to Cachix (main branch only)
if: ${{ github.ref == 'refs/heads/main' }}
Build-Macos-Nix:
name: Build MacOS (Nix)
runs-on: macos-latest
steps:
- uses: actions/checkout@v4
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
- name: Build everything
run: |
nix-build
nix-env -f default.nix -iA devTools
postgrest-push-cachix
Build-Stack:
@@ -148,14 +180,14 @@ jobs:
fail-fast: false
matrix:
include:
- name: Linux & test
- name: Linux
runs-on: ubuntu-latest
cache: |
~/.stack
.stack-work
artifact: postgrest-ubuntu-x64
- name: MacOS & test
- name: MacOS
runs-on: macos-latest
cache: |
~/.stack
@@ -174,19 +206,19 @@ jobs:
name: Build ${{ matrix.name }} (Stack)
runs-on: ${{ matrix.runs-on }}
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4
- name: Stack working files cache
uses: actions/cache@v3
with:
path: ${{ matrix.cache }}
key: ${{ runner.os }}-${{ hashFiles('stack.yaml.lock') }}
key: cache-stack-${{ runner.os }}-${{ hashFiles('stack.yaml.lock') }}
- name: Install dependencies
if: ${{ matrix.deps }}
run: ${{ matrix.deps }}
- name: Build with Stack
run: stack build --local-bin-path result --copy-bins
- name: Save built executable as artifact
uses: actions/upload-artifact@v3
uses: actions/upload-artifact@v4
with:
name: ${{ matrix.artifact }}
path: |
@@ -198,32 +230,75 @@ jobs:
name: Get FreeBSD build from CirrusCI
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4
- name: Get FreeBSD executable from CirrusCI
env:
# GITHUB_SHA does weird things for pull request, so we roll our own:
GITHUB_COMMIT: ${{github.event.pull_request.head.sha || github.sha}}
GITHUB_COMMIT: ${{ github.event.pull_request.head.sha || github.sha }}
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
run: .github/get_cirrusci_freebsd
- name: Save executable as artifact
uses: actions/upload-artifact@v3
uses: actions/upload-artifact@v4
with:
name: postgrest-freebsd-x64
path: postgrest
if-no-files-found: error
Build-Cabal:
strategy:
matrix:
ghc: ['9.0.2', '9.2.4']
fail-fast: false
name: Build Linux (Cabal, GHC ${{ matrix.ghc }})
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v4
- name: Workaround runner image issue
# https://github.com/actions/runner-images/issues/7061
run: sudo chown -R "$USER" /usr/local/.ghcup
- name: ghcup
run: |
ghcup install ghc ${{ matrix.ghc }}
ghcup set ghc ${{ matrix.ghc }}
- name: Copy cabal.project & fix caching
run: |
mkdir ~/.cabal
cp cabal.project.non-nix cabal.project
- name: Cache
uses: actions/cache@v3
with:
path: |
~/.cabal/packages
~/.cabal/store
dist-newstyle
key: cache-cabal-${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('**/*.cabal', '**/cabal.project') }}
restore-keys: |
cache-cabal-${{ runner.os }}-${{ matrix.ghc }}-
- name: Install dependencies
run: |
cabal update
cabal build --only-dependencies --enable-tests --enable-benchmarks
- name: Build
run: cabal build --enable-tests --enable-benchmarks all
Build-Cabal-Arm:
name: Build aarch64 (Cabal)
strategy:
matrix:
ghc: ['9.2.4']
fail-fast: false
name: Build aarch64 (Cabal, GHC ${{ matrix.ghc }})
if: ${{ github.ref == 'refs/heads/main' || startsWith(github.ref, 'refs/tags/v') || startsWith(github.ref, 'refs/heads/rel-') }}
runs-on: ubuntu-latest
outputs:
remotepath: ${{ steps.Remote-Dir.outputs.remotepath }}
env:
GITHUB_COMMIT: ${{ github.sha }}
GHC_VERSION: ${{ matrix.ghc }}
steps:
- uses: actions/checkout@v2.4.0
- uses: actions/checkout@v4
- id: Remote-Dir
name: Unique directory name for the remote build
run: echo "::set-output name=remotepath::postgrest-build-$(uuidgen)"
run: echo "remotepath=postgrest-build-$(uuidgen)" >> "$GITHUB_OUTPUT"
- name: Copy script files to the remote server
uses: appleboy/scp-action@master
with:
@@ -245,8 +320,8 @@ jobs:
fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
command_timeout: 120m
script_stop: true
envs: GITHUB_COMMIT,REMOTE_DIR
script: bash ~/$REMOTE_DIR/build.sh "$GITHUB_COMMIT" "$REMOTE_DIR"
envs: GITHUB_COMMIT,REMOTE_DIR,GHC_VERSION
script: bash ~/$REMOTE_DIR/build.sh "$GITHUB_COMMIT" "$REMOTE_DIR" "GHC_VERSION"
- name: Download binaries from remote server
uses: nicklasfrahm/scp-action@main
with:
@@ -260,7 +335,7 @@ jobs:
- name: Extract downloaded binaries
run: tar -xvf result.tar.xz && rm result.tar.xz
- name: Save aarch64 executable as artifact
uses: actions/upload-artifact@v2.3.1
uses: actions/upload-artifact@v4
with:
name: postgrest-ubuntu-aarch64
path: result/postgrest
@@ -284,7 +359,7 @@ jobs:
version: ${{ steps.Identify-Version.outputs.version }}
isprerelease: ${{ steps.Identify-Version.outputs.isprerelease }}
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4
- id: Identify-Version
name: Identify the version to be released
run: |
@@ -296,14 +371,14 @@ jobs:
exit 1
else
echo "Version to be released is $cabal_version"
echo "::set-output name=version::$cabal_version"
echo "version=$cabal_version" >> "$GITHUB_OUTPUT"
fi
if [[ "$cabal_version" != *.*.*.* ]]; then
echo "Version is for a full release (version does not have four components)"
else
echo "Version is for a pre-release (version has four components, e.g., 1.1.1.1)"
echo "::set-output name=isprerelease::1"
echo "isprerelease=1" >> "$GITHUB_OUTPUT"
fi
- name: Identify changes from CHANGELOG.md
run: |
@@ -321,7 +396,7 @@ jobs:
echo "Relevant extract from CHANGELOG.md:"
cat CHANGES.md
- name: Save CHANGES.md as artifact
uses: actions/upload-artifact@v3
uses: actions/upload-artifact@v4
with:
name: release-changes
path: CHANGES.md
@@ -337,9 +412,9 @@ jobs:
env:
VERSION: ${{ needs.Prepare-Release.outputs.version }}
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4
- name: Download all artifacts
uses: actions/download-artifact@v3
uses: actions/download-artifact@v4
with:
path: artifacts
- name: Create release bundle with archives for all builds
@@ -370,7 +445,7 @@ jobs:
artifacts/postgrest-windows-x64/postgrest.exe
- name: Save release bundle
uses: actions/upload-artifact@v3
uses: actions/upload-artifact@v4
with:
name: release-bundle
path: release-bundle
@@ -394,7 +469,6 @@ jobs:
name: Release on Docker Hub
runs-on: ubuntu-latest
needs:
- Build-Cabal-Arm
- Prepare-Release
env:
GITHUB_COMMIT: ${{ github.sha }}
@@ -404,13 +478,13 @@ jobs:
VERSION: ${{ needs.Prepare-Release.outputs.version }}
ISPRERELEASE: ${{ needs.Prepare-Release.outputs.isprerelease }}
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
tools: release
- name: Download Docker image
uses: actions/download-artifact@v3
uses: actions/download-artifact@v4
with:
name: postgrest-docker-x64
- name: Publish images on Docker Hub
@@ -429,18 +503,6 @@ jobs:
else
echo "Skipping pushing to 'latest' tag for v$VERSION pre-release..."
fi
- name: Publish images for ARM builds on Docker Hub
uses: appleboy/ssh-action@master
env:
REMOTE_DIR: ${{ needs.Build-Cabal-Arm.outputs.remotepath }}
with:
host: ${{ secrets.SSH_ARM_HOST }}
username: ubuntu
key: ${{ secrets.SSH_ARM_PRIVATE_KEY }}
fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
script_stop: true
envs: GITHUB_COMMIT,DOCKER_REPO,DOCKER_USER,DOCKER_PASS,REMOTE_DIR,VERSION,ISPRERELEASE
script: bash ~/$REMOTE_DIR/docker-publish.sh "$GITHUB_COMMIT" "$DOCKER_REPO" "$DOCKER_USER" "$DOCKER_PASS" "$REMOTE_DIR" "$VERSION" "$ISPRERELEASE"
# TODO: Enable dockerhub description update again, once a solution for the permission problem is found:
# https://github.com/docker/hub-feedback/issues/1927
# - name: Update descriptions on Docker Hub
@@ -454,17 +516,49 @@ jobs:
# echo "Skipping updating description for pre-release..."
# fi
Release-Docker-Arm:
name: Release Arm Builds on Docker Hub
runs-on: ubuntu-latest
needs:
- Build-Cabal-Arm
- Prepare-Release
- Release-Docker
env:
GITHUB_COMMIT: ${{ github.sha }}
DOCKER_REPO: postgrest
DOCKER_USER: stevechavez
DOCKER_PASS: ${{ secrets.DOCKER_PASS }}
VERSION: ${{ needs.Prepare-Release.outputs.version }}
ISPRERELEASE: ${{ needs.Prepare-Release.outputs.isprerelease }}
steps:
- uses: actions/checkout@v4
- name: Publish images for ARM builds on Docker Hub
uses: appleboy/ssh-action@master
env:
REMOTE_DIR: ${{ needs.Build-Cabal-Arm.outputs.remotepath }}
with:
host: ${{ secrets.SSH_ARM_HOST }}
username: ubuntu
key: ${{ secrets.SSH_ARM_PRIVATE_KEY }}
fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
script_stop: true
envs: GITHUB_COMMIT,DOCKER_REPO,DOCKER_USER,DOCKER_PASS,REMOTE_DIR,VERSION,ISPRERELEASE
script: bash ~/$REMOTE_DIR/docker-publish.sh "$GITHUB_COMMIT" "$DOCKER_REPO" "$DOCKER_USER" "$DOCKER_PASS" "$REMOTE_DIR" "$VERSION" "$ISPRERELEASE"
Clean-Arm-Server:
name: Remove copied files from server
needs:
- Build-Cabal-Arm
- Release-Docker
if: ${{ always() && (github.ref == 'refs/heads/main' || startsWith(github.ref, 'refs/tags/v') || startsWith(github.ref, 'refs/heads/rel-')) }}
- Release-Docker-Arm
if: success() ||
needs.Build-Cabal-Arm.result == 'failure' ||
needs.Build-Cabal-Arm.result == 'cancelled' ||
(needs.Build-Cabal-Arm.result == 'success' && !startsWith(github.ref, 'refs/tags/v'))
runs-on: ubuntu-latest
env:
REMOTE_DIR: ${{ needs.Build-Cabal-Arm.outputs.remotepath }}
steps:
- uses: actions/checkout@v2.4.0
- uses: actions/checkout@v4
- name: Remove uploaded files from server
uses: appleboy/ssh-action@master
with:
+43 -5
View File
@@ -11,24 +11,62 @@ on:
- main
jobs:
Loadtest-Nix:
name: Loadtest (Nix)
Loadtest-PR-Nix:
name: Loadtest PR (Nix)
if: ${{ github.event_name == 'pull_request' }}
runs-on: ubuntu-latest
concurrency:
group: ${{ github.workflow }}-${{ github.ref }}
cancel-in-progress: true
steps:
- uses: actions/checkout@v3
- uses: actions/checkout@v4
with:
fetch-depth: 0
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
tools: loadtest
cache-id: test-loadtest
- uses: actions-ecosystem/action-get-latest-tag@v1
id: get-latest-tag
with:
semver_only: true
- name: Run loadtest
run: |
postgrest-loadtest-against main
postgrest-loadtest-against main ${{ steps.get-latest-tag.outputs.tag }}
postgrest-loadtest-report > loadtest/loadtest.md
- name: Upload report
uses: actions/upload-artifact@v3
uses: actions/upload-artifact@v4
with:
name: loadtest.md
path: loadtest/loadtest.md
if-no-files-found: error
Loadtest-Merge-Nix:
name: Loadtest Merge (Nix)
if: ${{ github.event_name == 'push' }}
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v4
with:
fetch-depth: 0
- uses: actions-ecosystem/action-get-latest-tag@v1
id: get-latest-tag
with:
semver_only: true
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
tools: loadtest
cache-id: test-loadtest
- name: Run loadtest
run: |
postgrest-loadtest-against ${{ steps.get-latest-tag.outputs.tag }}
postgrest-loadtest-report > loadtest/loadtest.md
- name: Upload report
uses: actions/upload-artifact@v4
with:
name: loadtest.md
path: loadtest/loadtest.md
if-no-files-found: error
+2 -2
View File
@@ -15,14 +15,14 @@ jobs:
if: ${{ github.event.workflow_run.conclusion == 'success' }}
steps:
- name: Download from Artifacts
uses: dawidd6/action-download-artifact@v2
uses: dawidd6/action-download-artifact@v3
with:
workflow: ${{ github.event.workflow.name }}
run_id: ${{github.event.workflow_run.id }}
name: loadtest.md
path: artifacts
- name: Upload to GitHub Checks
uses: LouisBrunner/checks-action@v1.2.0
uses: LouisBrunner/checks-action@v1.6.2
with:
token: ${{ secrets.GITHUB_TOKEN }}
sha: ${{ github.event.workflow_run.head_sha }}
+68
View File
@@ -0,0 +1,68 @@
# Architecture
This document describes the high-level architecture of PostgREST.
## Bird's Eye View
```haskell
postgrest :: Request -> Either Error SQLStatement -> Response
```
On the highest level, PostgREST processes an HTTP request, if it's accepted it builds a SQL statement for it, executes it, and produces a response.
## Code Map
This section talks briefly about various important modules.
The starting point of the program is `main/Main.hs`, which calls `src/PostgREST/CLI.hs` which then calls `src/PostgREST/App.hs`.
`App.hs` is then in charge of composing the different modules.
### ApiRequest.hs
PostgREST operates over two types of resources: database relations(tables or views) and database functions; providing different representations(depending on the media type)
for them.
This module is in charge of representing the operation over an `ApiRequest` type. It parses the URL querystring following PostgREST syntax, the request headers, and the request body
(if possible it avoids parsing the body and sends it directly to the db).
A request might be rejected at this level if it's invalid, e.g. providing an unknown media type to PostgREST or using an unknown HTTP method.
### Plan.hs
Using the Schema Cache, this module enables more complex functionality(like resource embedding) by enriching the ApiRequest. It generates Plan types(`ReadPlan`, `MutatePlan`)
that then will be used to generate a SQL statement.
A request might be rejected at this level if it's invalid, e.g. by doing resource embedding on a nonexistent resource.
An OPTIONS request doesn't require a plan to be generated.
### Query.hs
This module constructs single SQL statements that can be parametrized and prepared. Only at this stage a PostgreSQL connection from the pool is used.
A query might fail(and be rollbacked) at this level if it doesn't comply to certain conditions, e.g. by not returning a single row when a ``Accept: application/vnd.pgrst.object`` header is specified.
An OPTIONS request doesn't require a query to be executed.
### Response.hs
This module constructs the HTTP response body with the right headers.
It builds the OpenAPI response using the schema cache.
### Auth.hs
This module provides functions to deal with JWT authorization.
### SchemaCache.hs
This queries the PostgreSQL system catalogs and caches the metadata into a SchemaCache type,
### AppState.hs
The state of the App which is kept across requests.
This spawns threads which are used to execute concurrent jobs.
Jobs include connection recover and a listener for the PostgreSQL LISTEN command.
+37 -20
View File
@@ -4,40 +4,40 @@ PostgREST ongoing development is only possible thanks to our Sponsors and Backer
## Sponsors
<table>
<table align="center">
<tbody>
<tr>
<td align="center" valign="middle">
<a href="https://www.cybertec-postgresql.com/en/?utm_source=postgrest.org&utm_medium=referral&utm_campaign=postgrest" target="_blank">
<img width="222px" src="static/cybertec-new.png">
<img width="296px" src="static/cybertec-new.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://www.2ndquadrant.com/en/?utm_campaign=External%20Websites&utm_source=PostgREST&utm_medium=Logo" target="_blank">
<img width="296px" src="static/2ndquadrant.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://tryretool.com/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/retool.png">
</a>
</td>
</tr>
<tr></tr>
<tr>
<td align="center" valign="middle">
<a href="https://gnuhost.eu/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/gnuhost.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://supabase.io?utm_source=postgrest%20backers&utm_medium=open%20source%20partner&utm_campaign=postgrest%20backers%20github&utm_term=homepage" target="_blank">
<img width="296px" src="static/supabase.png">
<a href="https://neon.tech/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/neon.jpg">
</a>
</td>
</tr>
<tr></tr>
<tr>
<td align="center" valign="middle">
<a href="https://code.build/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/code-build.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://oblivious.ai/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/oblivious.jpg">
<a href="https://supabase.io?utm_source=postgrest%20backers&utm_medium=open%20source%20partner&utm_campaign=postgrest%20backers%20github&utm_term=homepage" target="_blank">
<img width="296px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/supabase.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://tembo.io/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/tembo.png">
</a>
</td>
</tr>
@@ -46,12 +46,14 @@ PostgREST ongoing development is only possible thanks to our Sponsors and Backer
## Lead Backers
- [Roboflow](https://github.com/roboflow)
- Evans Fernandes
- [Jan Sommer](https://github.com/nerfpops)
- [Franz Gusenbauer](https://www.igutech.at/)
## Backers
- Zac Miller
- Tsingson Qin
- Michel Pelletier
- Jay Hannah
@@ -73,7 +75,22 @@ PostgREST ongoing development is only possible thanks to our Sponsors and Backer
<tr>
<td align="center" valign="middle">
<a href="https://www.timescale.com?utm_campaign=postgrest&utm_source=sponsor&utm_medium=referral&utm_content=github" target="_blank">
<img width="222px" src="static/timescaledb.png">
<img width="222px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/timescaledb.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://tryretool.com/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img max-width="222px" height="88" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/retool.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://www.2ndquadrant.com/en/?utm_campaign=External%20Websites&utm_source=PostgREST&utm_medium=Logo" target="_blank">
<img width="222px" src="static/2ndquadrant.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://oblivious.ai/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="222px" src="static/oblivious.jpg">
</a>
</td>
</tr>
+275
View File
@@ -5,6 +5,280 @@ This project adheres to [Semantic Versioning](http://semver.org/).
## Unreleased
## [12.0.2] - 2023-12-20
### Fixed
- #3124, Fix table's media type handlers not working for all schemas - @steve-chavez
- #3126, Fix empty row on media type handler function - @steve-chavez
## [12.0.1] - 2023-12-12
### Fixed
- #3054, Fix not allowing special characters in JSON keys - @laurenceisla
- #2344, Replace JSON parser error with a clearer generic message - @develop7
- #3100, Add missing in-database configuration option for `jwt-cache-max-lifetime` - @laurenceisla
- #3089, The any media type handler now sets `Content-Type: application/octet-stream` by default instead of `Content-Type: application/json` - @steve-chavez
## [12.0.0] - 2023-12-01
### Added
- #1614, Add `db-pool-automatic-recovery` configuration to disable connection retrying - @taimoorzaeem
- #2492, Allow full response control when raising exceptions - @taimoorzaeem, @laurenceisla
- #2771, #2983, #3062, #3055 Add `Server-Timing` response header - @taimoorzaeem, @develop7, @laurenceisla
- #2698, Add config `jwt-cache-max-lifetime` and implement JWT caching - @taimoorzaeem
- #2943, Add `handling=strict/lenient` for Prefer header - @taimoorzaeem
- #2441, Add config `server-cors-allowed-origins` to specify CORS origins - @taimoorzaeem
- #2825, SQL handlers for custom media types - @steve-chavez
+ Solves #1548, #2699, #2763, #2170, #1462, #1102, #1374, #2901
- #2799, Add timezone in Prefer header - @taimoorzaeem
- #3001, Add `statement_timeout` set on functions - @taimoorzaeem
- #3045, Apply superuser settings on impersonated roles if they have PostgreSQL 15 `GRANT SET ON PARAMETER` privilege - @steve-chavez
- #915, Add support for aggregate functions - @timabdulla
+ The aggregate functions SUM(), MAX(), MIN(), AVG(), and COUNT() are now supported.
+ It's disabled by default, you can enable it with `db-aggregates-enabled`.
- #3057, Log all internal database errors to stderr - @laurenceisla
### Fixed
- #3015, Fix unnecessary count() on RPC returning single - @steve-chavez
- #1070, Fix HTTP status responses for upserts - @taimoorzaeem
+ `PUT` returns `201` instead of `200` when rows are inserted
+ `POST` with `Prefer: resolution=merge-duplicates` returns `200` instead of `201` when no rows are inserted
- #3019, Transaction-Scoped Settings are now shown clearly in the Postgres logs - @laurenceisla
+ Shows `set_config('pgrst.setting_name', $1)` instead of `setconfig($1, $2)`
+ Does not apply to role settings and `app.settings.*`
- #2420, Fix bogus message when listening on port 0 - @develop7
- #3067, Fix Acquision Timeout errors logging to stderr when `log-level=crit` - @laurenceisla
### Changed
- Removed [raw-media-types config](https://postgrest.org/en/v11.1/references/configuration.html#raw-media-types) - @steve-chavez
- Removed `application/octet-stream`, `text/plain`, `text/xml` [builtin support for scalar results](https://postgrest.org/en/v11.1/references/api/resource_representation.html#scalar-function-response-format) - @steve-chavez
- Removed default `application/openapi+json` media type for [db-root-spec](https://postgrest.org/en/v11.1/references/configuration.html#db-root-spec) - @steve-chavez
- Removed [db-use-legacy-gucs](https://postgrest.org/en/v11.2/references/configuration.html#db-use-legacy-gucs) - @laurenceisla
## [11.2.2] - 2023-10-25
### Fixed
- #2824, Fix regression by reverting fix that returned 206 when first position = length in a `Range` header - @laurenceisla, @strengthless
## [11.2.1] - 2023-10-03
### Fixed
- #2899, Fix `application/vnd.pgrst.array` not accepted as a valid mediatype - @taimoorzaeem
- #2524, Fix schema cache and configuration reloading with `NOTIFY` not working on Windows - @diogob, @laurenceisla
- #2915, Fix duplicate headers in response - @taimoorzaeem
- #2824, Fix range request with first position same as length return status 206 - @taimoorzaeem
- #2939, Fix wrong `Preference-Applied` with `Prefer: tx=commit` when transaction is rollbacked - @steve-chavez
- #2939, Fix `count=exact` not being included in `Preference-Applied` - @steve-chavez
- #2800, Fix not including to-one embed resources that had a `NULL` value in any of the selected fields when doing null filtering on them - @laurenceisla
- #2846, Fix error when requesting `Prefer: count=<type>` and doing null filtering on embedded resources - @laurenceisla
- #2959, Fix setting `default_transaction_isolation` unnecessarily - @steve-chavez
- #2929, Fix arrow filtering on RPC returning dynamic TABLE with composite type - @steve-chavez
- #2963, Fix RPCs not embedding correctly when using overloaded functions for computed relationships - @laurenceisla
- #2970, Fix regression that rejects URI connection strings with certain unescaped characters in the password - @laurenceisla, @steve-chavez
## [11.2.0] - 2023-08-10
### Added
- #2523, Data representations - @aljungberg
+ Allows for flexible API output formatting and input parsing on a per-column type basis using regular SQL functions configured in the database
+ Enables greater flexibility in the form and shape of your APIs, both for output and input, making PostgREST a more versatile general-purpose API server
+ Examples include base64 encode/decode your binary data (like a `bytea` column containing an image), choose whether to present a timestamp column as seconds since the Unix epoch or as an ISO 8601 string, or represent fixed precision decimals as strings, not doubles, to preserve precision
+ ...and accept the same in `POST/PUT/PATCH` by configuring the reverse transformation(s)
+ Other use-cases include custom representation of enums, arrays, nested objects, CSS hex colour strings, gzip compressed fields, metric to imperial conversions, and much more
+ Works when using the `select` parameter to select only a subset of columns, embedding through complex joins, renaming fields, with views and computed columns
+ Works when filtering on a formatted column without extra indexes by parsing to the canonical representation
+ Works for data `RETURNING` operations, such as requesting the full body in a POST/PUT/PATCH with `Prefer: return=representation`
+ Works for batch updates and inserts
+ Completely optional, define the functions in the database and they will be used automatically everywhere
+ Data representations preserve the ability to write to the original column and require no extra storage or complex triggers (compared to using `GENERATED ALWAYS` columns)
+ Note: data representations require Postgres 10 (Postgres 11 if using `IN` predicates); data representations are not implemented for RPC
- #2647, Allow to verify the PostgREST version in SQL: `select distinct application_name from pg_stat_activity`. - @laurenceisla
- #2856, Add the `--version` CLI option that prints the version information - @laurenceisla
- #1655, Improve `details` field of the singular error response - @taimoorzaeem
- #740, Add `Preference-Applied` in response for `Prefer: return=representation/headers-only/minimal` - @taimoorzaeem
- #1601, Add optional `nulls=stripped` parameter for mediatypes `application/vnd.pgrst.array+json` and `application/vnd.pgrst.object+json` - @taimoorzaeem
### Fixed
- #2821, Fix OPTIONS not accepting all available media types - @steve-chavez
- #2834, Fix compilation on Ubuntu by being compatible with GHC 9.0.2 - @steve-chavez
- #2840, Fix `Prefer: missing=default` with DOMAIN default values - @steve-chavez
- #2849, Fix HEAD unnecessarily executing aggregates - @steve-chavez
- #2594, Fix unused index on jsonb/jsonb arrow filter and order (``/bets?data->>contractId=eq.1`` and ``/bets?order=data->>contractId``) - @steve-chavez
- #2861, Fix character and bit columns with fixed length not inserting/updating properly - @laurenceisla
+ Fixes the error "value too long for type character(1)" when the char length of the column was bigger than one.
- #2862, Fix null filtering on embedded resource when using a column name equal to the relation name - @steve-chavez
- #1586, Fix function parameters of type character and bit not ignoring length - @laurenceisla
+ Fixes the error "value too long for type character(1)" when the char length of the parameter was bigger than one.
- #2881, Fix error when a function returns `RECORD` or `SET OF RECORD` - @laurenceisla
- #2896, Fix applying superuser settings for impersonated role - @steve-chavez
### Deprecated
- #2863, Deprecate resource embedding target disambiguation - @steve-chavez
+ The `/table?select=*,other!fk(*)` must be used to disambiguate
+ The server aids in choosing the `!fk` by sending a `hint` on the error whenever an ambiguous request happens.
## [11.1.0] - 2023-06-07
### Added
- #2786, Limit idle postgresql connection lifetime - @robx
+ New option `db-pool-max-idletime` (default 30s).
+ This is equivalent to the old option `db-pool-timeout` of PostgREST 10.0.0.
+ A config alias for `db-pool-timeout` is included.
- #2703, Add pre-config function - @steve-chavez
+ New config option `db-pre-config`(empty by default)
+ Allows using the in-database configuration without SUPERUSER
- #2781, When `db-channel-enabled` is false, start automatic connection recovery on a new request when pool connections are closed with `pg_terminate_backend` - @steve-chavez
+ Mitigates the lack of LISTEN/NOTIFY for schema cache reloading on read replicas.
### Fixed
- #2791, Fix dropping schema cache reload notifications - @steve-chavez
- #2801, Stop retrying connection when "no password supplied" - @steve-chavez
## [11.0.1] - 2023-04-27
### Fixed
- #2762, Fixes "permission denied for schema" error during schema cache load - @steve-chavez
- #2756, Fix bad error message on generated columns when using `Prefer: missing=default` - @steve-chavez
- #1139, Allow a 30 second skew for JWT validation - @steve-chavez
+ It used to be 1 second, which was too strict
## [11.0.0] - 2023-04-16
### Added
- #1414, Add related orders - @steve-chavez
+ On a many-to-one or one-to-one relationship, you can order a parent by a child column `/projects?select=*,clients(*)&order=clients(name).desc.nullsfirst`
- #1233, #1907, #2566, Allow spreading embedded resources - @steve-chavez
+ On a many-to-one or one-to-one relationship, you can unnest a json object with `/projects?select=*,...clients(client_name:name)`
+ Allows including the join table columns when resource embedding
+ Allows disambiguating a recursive m2m embed
+ Allows disambiguating an embed that has a many-to-many relationship using two foreign keys on a junction
- #2340, Allow embedding without selecting any column - @steve-chavez
- #2563, Allow `is.null` or `not.is.null` on an embedded resource - @steve-chavez
+ Offers a more flexible replacement for `!inner`, e.g. `/projects?select=*,clients(*)&clients=not.is.null`
+ Allows doing an anti join, e.g. `/projects?select=*,clients(*)&clients=is.null`
+ Allows using or across related tables conditions
- #1100, Customizable OpenAPI title - @AnthonyFisi
- #2506, Add `server-trace-header` for tracing HTTP requests. - @steve-chavez
+ When the client sends the request header specified in the config it will be included in the response headers.
- #2694, Make `db-root-spec` stable. - @steve-chavez
+ This can be used to override the OpenAPI spec with a custom database function
- #1567, On bulk inserts, missing values can get the column DEFAULT by using the `Prefer: missing=default` header - @steve-chavez
- #2501, Allow filtering by`IS DISTINCT FROM` using the `isdistinct` operator, e.g. `/people?alias=isdistinct.foo`
- #1569, Allow `any/all` modifiers on the `eq,like,ilike,gt,gte,lt,lte,match,imatch` operators, e.g. `/tbl?id=eq(any).{1,2,3}` - @steve-chavez
- This converts the input into an array type
- #2561, Configurable role settings - @steve-chavez
- Database roles that are members of the connection role get their settings applied, e.g. doing
`ALTER ROLE anon SET statement_timeout TO '5s'` will result in that `statement_timeout` getting applied for that role.
- Works when switching roles when a JWT is sent
- Settings can be reloaded with `NOTIFY pgrst, 'reload config'`.
- #2468, Configurable transaction isolation level with `default_transaction_isolation` - @steve-chavez
- Can be set per function `create function .. set default_transaction_isolation = 'repeatable read'`
- Or per role `alter role .. set default_transaction_isolation = 'serializable'`
### Fixed
- #2651, Add the missing `get` path item for RPCs to the OpenAPI output - @laurenceisla
- #2648, Fix inaccurate error codes with new ones - @laurenceisla
+ `PGRST204`: Column is not found
+ `PGRST003`: Timed out when acquiring connection to db
- #1652, Fix function call with arguments not inlining - @steve-chavez
- #2705, Fix bug when using the `Range` header on `PATCH/DELETE` - @laurenceisla
+ Fix the`"message": "syntax error at or near \"RETURNING\""` error
+ Fix doing a limited update/delete when an `order` query parameter was present
- #2742, Fix db settings and pg version queries not getting prepared - @steve-chavez
- #2618, Fix `PATCH` requests not recognizing embedded filters and using the top-level resource instead - @steve-chavez
### Changed
- #2705, The `Range` header is now only considered on `GET` requests and is ignored for any other method - @laurenceisla
+ Other methods should use the `limit/offset` query parameters for sub-ranges
+ `PUT` requests no longer return an error when this header is present (using `limit/offset` still triggers the error)
- #2733, Remove bulk RPC call with the `Prefer: params=multiple-objects` header. A function with a JSON array or object parameter should be used instead.
## [10.2.0] - 2023-04-12
### Added
- #2663, Limit maximal postgresql connection lifetime - @robx
+ New option `db-pool-max-lifetime` (default 30m)
+ `db-pool-acquisition-timeout` is no longer optional and defaults to 10s
+ Fixes postgresql resource leak with long-lived connections (#2638)
### Fixed
- #2667, Fix `db-pool-acquisition-timeout` not logging to stderr when the timeout is reached - @steve-chavez
## [10.1.2] - 2023-02-01
### Fixed
- #2565, Fix bad M2M embedding on RPC - @steve-chavez
- #2575, Replace misleading error message when no function is found with a hint containing functions/parameters names suggestions - @laurenceisla
- #2582, Move explanation about "single parameters" from the `message` to the `details` in the error output - @laurenceisla
- #2569, Replace misleading error message when no relationship is found with a hint containing parent/child names suggestions - @laurenceisla
- #1405, Add the required OpenAPI items object when the parameter is an array - @laurenceisla
- #2592, Add upsert headers for POST requests to the OpenAPI output - @laurenceisla
- #2623, Fix FK pointing to VIEW instead of TABLE in OpenAPI output - @laurenceisla
- #2622, Consider any PostgreSQL authentication failure as fatal and exit immediately - @michivi
- #2620, Fix `NOTIFY pgrst` not reloading the db connections catalog cache - @steve-chavez
## [10.1.1] - 2022-11-08
### Fixed
- #2548, Fix regression when embedding views with partial references to multi column FKs - @wolfgangwalther
- #2558, Fix regression when requesting limit=0 and `db-max-row` is set - @laurenceisla
- #2542, Return a clear error without hitting the database when trying to update or insert an unknown column with `?columns` - @aljungberg
## [10.1.0] - 2022-10-28
### Added
- #2348, Add `db-pool-acquisition-timeout` configuration option, time in seconds to wait to acquire a connection. - @robx
### Fixed
- #2261, #2349, #2467, Reduce allocations communication with PostgreSQL, particularly for request bodies. - @robx
- #2401, #2444, Fix SIGUSR1 to fully flush connections pool. - @robx
- #2428, Fix opening an empty transaction on failed resource embedding - @steve-chavez
- #2455, Fix embedding the same table multiple times - @steve-chavez
- #2518, Fix a regression when embedding views where base tables have a different column order for FK columns - @wolfgangwalther
- #2458, Fix a regression with the location header when inserting into views with PKs from multiple tables - @wolfgangwalther
- #2356, Fix a regression in openapi output with mode follow-privileges - @wolfgangwalther
- #2283, Fix infinite recursion when loading schema cache with self-referencing view - @wolfgangwalther
- #2343, Return status code 200 for PATCH requests which don't affect any rows - @wolfgangwalther
- #2481, Treat computed relationships not marked SETOF as M2O/O2O relationship - @wolfgangwalther
- #2534, Fix embedding a computed relationship with a normal relationship - @steve-chavez
- #2362, Fix error message when [] is used inside select - @wolfgangwalther
- #2475, Disallow !inner on computed columns - @wolfgangwalther
- #2285, Ignore leading and trailing spaces in column names when parsing the query string - @wolfgangwalther
- #2545, Fix UPSERT with PostgreSQL 15 - @wolfgangwalther
- #2459, Fix embedding views with multiple references to the same base column - @wolfgangwalther
### Changed
- #2444, Removed `db-pool-timeout` option, because this was removed upstream in hasql-pool. - @robx
- #2343, PATCH requests that don't affect any rows no longer return 404 - @wolfgangwalther
- #2537, Stricter parsing of query string. Instead of silently ignoring, the parser now throws on invalid syntax like json paths for embeddings, hints for regular columns, empty casts or fts languages, etc. - @wolfgangwalther
### Deprecated
- #1385, Deprecate bulk-calls when including the `Prefer: params=multiple-objects` in the request. A function with a JSON array or object parameter should be used instead for a better performance.
## [10.0.0] - 2022-08-18
### Added
@@ -70,6 +344,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
- #2410, Fix loop crash error on startup in Postgres 15 beta 3. Log: "UNION types \"char\" and text cannot be matched". - @yevon
- #2397, Fix race conditions managing database connection helper - @robx
- #2269, Allow `limit=0` in the request query to return an empty array - @gautam1168, @laurenceisla
- #2401, Ensure database connections can't outlive SIGUSR1 - @robx
### Changed
+19 -19
View File
@@ -15,40 +15,40 @@ API than you are likely to write from scratch.
## Sponsors
<table>
<table align="center">
<tbody>
<tr>
<td align="center" valign="middle">
<a href="https://www.cybertec-postgresql.com/en/?utm_source=postgrest.org&utm_medium=referral&utm_campaign=postgrest" target="_blank">
<img width="222px" src="static/cybertec-new.png">
<img width="296px" src="static/cybertec-new.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://www.2ndquadrant.com/en/?utm_campaign=External%20Websites&utm_source=PostgREST&utm_medium=Logo" target="_blank">
<img width="296px" src="static/2ndquadrant.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://tryretool.com/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/retool.png">
</a>
</td>
</tr>
<tr></tr>
<tr>
<td align="center" valign="middle">
<a href="https://gnuhost.eu/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/gnuhost.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://supabase.io?utm_source=postgrest%20backers&utm_medium=open%20source%20partner&utm_campaign=postgrest%20backers%20github&utm_term=homepage" target="_blank">
<img width="296px" src="static/supabase.png">
<a href="https://neon.tech/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/neon.jpg">
</a>
</td>
</tr>
<tr></tr>
<tr>
<td align="center" valign="middle">
<a href="https://code.build/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/code-build.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://oblivious.ai/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/oblivious.jpg">
<a href="https://supabase.io?utm_source=postgrest%20backers&utm_medium=open%20source%20partner&utm_campaign=postgrest%20backers%20github&utm_term=homepage" target="_blank">
<img width="296px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/supabase.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://tembo.io/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="static/tembo.png">
</a>
</td>
</tr>
+1
View File
@@ -0,0 +1 @@
index-state: hackage.haskell.org 2023-10-13T13:54:33Z
+20
View File
@@ -0,0 +1,20 @@
-- Settings to allow building with plain cabal. If this was
-- named just cabal.project, it would interfere with the default
-- nix build.
packages: .
-- Example of depending on a forked repository (the same dependency
-- would be mentioned in nix/overlays/haskell-packages.nix and
-- stack.yaml, and should refer to a main branch commit of the
-- repository.
--
-- source-repository-package
-- type: git
-- location: https://github.com/PostgREST/hasql-pool.git
-- tag: 4d462c4d47d762effefc7de6c85eaed55f144f1d
source-repository-package
type: git
location: https://github.com/PostgREST/postgresql-libpq.git
tag: 890a0a16cf57dd401420fdc6c7d576fb696003bc
+34 -12
View File
@@ -36,10 +36,12 @@ let
allOverlays.build-toolbox
allOverlays.checked-shell-script
allOverlays.gitignore
allOverlays.postgresql-default
allOverlays.postgis
(allOverlays.postgresql-default { inherit patches; })
allOverlays.postgresql-legacy
allOverlays.postgresql-future
(allOverlays.haskell-packages { inherit compiler; })
allOverlays.slocat
];
# Evaluated expression of the Nixpkgs repository.
@@ -48,6 +50,20 @@ let
postgresqlVersions =
[
{
name = "postgresql-16";
postgresql = pkgs.postgresql_16.withPackages (p: [
p.postgis
(p.pg_safeupdate.overrideAttrs (old: {
installPhase = ''
mkdir -p $out/bin
cp safeupdate.dylib safeupdate.so || true
install -D safeupdate.so -t $out/lib
'';
}))
]);
}
{ name = "postgresql-15"; postgresql = pkgs.postgresql_15.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
{ name = "postgresql-14"; postgresql = pkgs.postgresql_14.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
{ name = "postgresql-13"; postgresql = pkgs.postgresql_13.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
{ name = "postgresql-12"; postgresql = pkgs.postgresql_12.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
@@ -63,11 +79,17 @@ let
postgrest =
pkgs.haskell.packages."${compiler}".callCabal2nix name src { };
# Function that derives a fully static Haskell package based on
# Functionality that derives a fully static Haskell package based on
# nh2/static-haskell-nix
staticHaskellPackage =
import nix/static-haskell-package.nix { inherit nixpkgs system compiler patches allOverlays; };
# Static executable.
postgrestStatic =
lib.justStaticExecutables (lib.dontCheck (staticHaskellPackage name src).package);
packagesStatic = (staticHaskellPackage name src).survey;
# Options passed to cabal in dev tools and tests
devCabalOptions =
"-f dev --test-show-detail=direct";
@@ -92,10 +114,6 @@ rec {
postgrestPackage =
lib.dontCheck postgrest;
# Static executable.
postgrestStatic =
lib.justStaticExecutables (lib.dontCheck (staticHaskellPackage name src));
# Profiled dynamic executable.
postgrestProfiled =
lib.enableExecutableProfiling (
@@ -117,14 +135,13 @@ rec {
cabalTools =
pkgs.callPackage nix/tools/cabalTools.nix { inherit devCabalOptions postgrest; };
withTools =
pkgs.callPackage nix/tools/withTools.nix { inherit cabalTools devCabalOptions postgresqlVersions postgrest; };
# Development tools.
devTools =
pkgs.callPackage nix/tools/devTools.nix { inherit tests style devCabalOptions hsie withTools; };
# Docker images and loading script.
docker =
pkgs.callPackage nix/tools/docker { postgrest = postgrestStatic; };
# Load testing tools.
loadtest =
pkgs.callPackage nix/tools/loadtest.nix { inherit withTools; };
@@ -153,7 +170,12 @@ rec {
inherit (pkgs.haskell.packages."${compiler}") hpc-codecov;
inherit (pkgs.haskell.packages."${compiler}") weeder;
};
} // pkgs.lib.optionalAttrs pkgs.stdenv.isLinux rec {
# Static executable.
inherit postgrestStatic;
inherit packagesStatic;
withTools =
pkgs.callPackage nix/tools/withTools.nix { inherit devCabalOptions postgresqlVersions postgrest; };
# Docker images and loading script.
docker =
pkgs.callPackage nix/tools/docker { postgrest = postgrestStatic; };
}
+1 -22
View File
@@ -1,37 +1,16 @@
{-# LANGUAGE CPP #-}
module Main (main) where
import System.IO (BufferMode (..), hSetBuffering)
import qualified PostgREST.App as App
import qualified PostgREST.CLI as CLI
import Protolude
#ifndef mingw32_HOST_OS
import qualified PostgREST.Unix as Unix
#endif
main :: IO ()
main = do
setBuffering
opts <- CLI.readCLIShowHelp
CLI.main installSignalHandlers runAppInSocket opts
installSignalHandlers :: App.SignalHandlerInstaller
#ifndef mingw32_HOST_OS
installSignalHandlers = Unix.installSignalHandlers
#else
installSignalHandlers _ = pass
#endif
runAppInSocket :: Maybe App.SocketRunner
#ifndef mingw32_HOST_OS
runAppInSocket = Just Unix.runAppWithSocket
#else
runAppInSocket = Nothing
#endif
CLI.main opts
setBuffering :: IO ()
setBuffering = do
+57 -42
View File
@@ -5,24 +5,14 @@ for developing, testing and building PostgREST.
## Getting started with Nix
You'll need to [get Nix](https://nixos.org/download.html). The installer will
create your Nix store in the `/nix/` directory, where all build artifacts and
their dependencies will be stored. It will also link the Nix executables like
`nix-env`, `nix-build` and `nix-shell` into your PATH. Nix will manage all
other PostgREST dependencies from here on out. To clean up older build
artifacts from the `/nix/store`, you can run `nix-collect-garbage`.
If you are on a system that does not support nix, for example Windows, you can
run the nix development environment in a docker container. Inside the `nix/`
directory run `docker-compose run --rm nix` to start the docker container. This
will set up the binary cache and launch `nix-shell` automatically.
You'll need to [get Nix](https://nixos.org/download.html). Follow the recommended installation for your operating system from the official download website.
## Building PostgREST
To build PostgREST from your local checkout of the repository, run:
```bash
nix-build --attr postgrestPackage
$ nix-build --attr postgrestPackage
```
@@ -32,6 +22,15 @@ build the `postgrestPackage` attribute from the Nix expression it finds in our
`default.nix` (see below for details). Nix will take care of getting the right
GHC version and all the build dependencies.
You can also build a statically linked binary with:
```bash
$ nix-build --attr postgrestStatic
$ ldd result/bin/postgrest
$ not a dynamic executable
```
## Binary cache
We recommend that you use the PostgREST binary cache on
@@ -39,10 +38,10 @@ We recommend that you use the PostgREST binary cache on
```bash
# Install cachix:
nix-env -iA cachix -f https://cachix.org/api/v1/install
$ nix-env -iA cachix -f https://cachix.org/api/v1/install
# Set cachix up to use the PostgREST binary cache:
cachix use postgrest
$ cachix use postgrest
```
@@ -56,7 +55,7 @@ following command will put you into a new shell that has GHC and Cabal on the
PATH:
```bash
nix-shell
$ nix-shell
```
@@ -92,7 +91,7 @@ Some additional modules like `memory`, `docker` and `release`
have large dependencies that would need to be built before the shell becomes
available, which could take an especially long time if the cachix binary cache
is not used. You can activate those by passing a flag to `nix-shell` with
`nix-shell --arg <module> true`. This will make the respective utilites available:
`nix-shell --arg <module> true`. This will make the respective utilities available:
```bash
$ nix-shell --arg memory true
@@ -114,7 +113,7 @@ postgrest-test-memory
Note that `postgrest-test-memory` is now also available.
To run one-off commands, you can also use `nix-shell --run <command>`, which
will lauch the Nix shell, run that one command and exit. Note that the tab
will launch the Nix shell, run that one command and exit. Note that the tab
completion will not work with `nix-shell --run`, as Nix has yet to evaluate
our Nix expressions to see which utilities are available.
@@ -146,10 +145,10 @@ Note: Once inside nix-shell, the utilities work from any directory inside
the PostgREST repo. Paths are resolved relative to the repo root:
```bash
$ cd src
[nix-shell]$ cd src
# Even though the current directory is ./src, the config path must still start
# from the repo root:
$ postgrest-run test/io/configs/simple.conf
[nix-shell]$ postgrest-run test/io/configs/simple.conf
```
## Testing
@@ -177,21 +176,21 @@ run with `postgrest-test-io`. The test runner under the hood is
```bash
# Filter the tests to run by name, including all that contain 'config':
postgrest-test-io -k config
[nix-shell]$ postgrest-test-io -k config
# Run tests in parallel using xdist, specifying the number of processes:
postgrest-test-io -n auto
postgrest-test-io -n 8
[nix-shell]$ postgrest-test-io -n auto
[nix-shell]$ postgrest-test-io -n 8
```
The memory tests check that we don't surpass a memory threshold for big request bodies.
```bash
# Build the dependencies needed for the memory test
nix-shell --arg memory true
$ nix-shell --arg memory true
# Run the memory test
postgrest-test-memory
[nix-shell]$ postgrest-test-memory
```
The loadtests ensure that performance doesn't drop on a change. Underlyingly they use
@@ -199,38 +198,37 @@ The loadtests ensure that performance doesn't drop on a change. Underlyingly the
```bash
# Run the loadtests on the latest commit(HEAD)
postgrest-loadtest
[nix-shell]$ postgrest-loadtest
# You can loadtest comparing to a different branch
postgrest-loadtest-against master
[nix-shell]$ postgrest-loadtest-against master
# You can simulate latency client/postgrest and postgrest/database
[nix-shell]$ PGRST_DELAY=5ms PGDELAY=5ms postgrest-loadtest
# You can build postgrest directly with cabal for faster iteration
[nix-shell]$ PGRST_BUILD_CABAL=1 postgrest-loadtest
# Produce a markdown report to be used on CI
postgrest-loadtest-report
```
Our query cost tests ensure that our generated queries don't surpass a threshold EXPLAIN cost.
```bash
postgrest-test-querycost
[nix-shell]$ postgrest-loadtest-report
```
doctests for some of our modules are also available:
```bash
postgrest-test-doctest
[nix-shell]$ postgrest-test-doctest
```
## Code coverage
Code coverage is available under the `postgrest-coverage` command. This will produce a `./coverage` directory that can be visualized with a simple http server.
Code coverage is available under the `postgrest-coverage` command. This will produce a `./coverage` directory that can be visualized on a browser.
```bash
# Will run all the tests and produce a coverage dir
postgrest-coverage
[nix-shell]$ postgrest-coverage
...
# Visualize the output
cd coverage
python -mSimpleHTTPServer 8080
postgrest-coverage: To see the results, visit file://$(pwd)/coverage/check/hpc_index.html
```
## Linting and styling code
@@ -248,11 +246,11 @@ $ nix-shell --run postgrest-style
```
There is also `postgrest-style-check` that exits with a non-zero exit code if
the check resulted in any uncommited changes. It's mostly useful for CI.
the check resulted in any uncommitted changes. It's mostly useful for CI.
## General development tools
Tools like `postgrest-build`, `postgrest-run` etc. are simple wrappers around
Tools like `postgrest-build`, `postgrest-run`, `postgrest-repl` etc. are simple wrappers around
`cabal` and should do what you expect. `postgrest-check` runs most checks that will
also run in CI, with the exception of the IO and Memory checks that need to be run
separately.
@@ -266,6 +264,23 @@ run against the latest PostgreSQL version by default.
file is changed. For example, `postgrest-watch postgrest-with-all postgrest-test-spec`
will re-run the full spec test suite against all PostgreSQL versions on every change.
## REPL
You can use `postgrest-repl` to manually inspect the PostgREST modules.
```bash
$ postgrest-repl
ghci> import PostgREST.<tab>
PostgREST.Admin PostgREST.Config.Database PostgREST.Plan.MutatePlan PostgREST.Response.OpenAPI
PostgREST.ApiRequest PostgREST.Config.JSPath PostgREST.Plan.ReadPlan PostgREST.SchemaCache
...
ghci> import PostgREST.MediaType
ghci> decodeMediaType "application/json"
MTApplicationJSON
```
## Tour
The following is not required for working on PostgREST with Nix, but it will
@@ -294,7 +309,7 @@ version.
### `shell.nix`
[`shell.nix`](../shell.nix) defines an environment in which PostgREST can be
built and developed. It extends the build enviroment from our `postgrest`
built and developed. It extends the build environment from our `postgrest`
attribute with useful utilities that will be put on the PATH in `nix-shell`.
### `nix/overlays`
+1 -1
View File
@@ -74,7 +74,7 @@ required to avoid build timeouts in CI.
You'll need to set the `CACHIX_SIGNING_KEY` before proceeding, e.g. by creating
a file containing `export CACHIX_SIGNING_KEY=...` and sourcing that file, which
avoids having the secret in you shell history.
avoids having the secret in your shell history.
To push all new artifacts to Cachix, run:
+3 -3
View File
@@ -1,6 +1,6 @@
# Pinned version of Nixpkgs, generated with postgrest-nixpkgs-upgrade.
{
date = "2022-08-09";
rev = "9f15d6c3a74d2778c6e1af67947c95f100dc6fd2";
tarballHash = "14axdmi3kb6rlib39ik42yq907bm66x6vzswm5w1rsnw9vzgm31a";
date = "2023-03-25";
rev = "dbf5322e93bcc6cfc52268367a8ad21c09d76fea";
tarballHash = "0lwk4v9dkvd28xpqch0b0jrac4xl9lwm6snrnzx8k5lby72kmkng";
}
@@ -2,7 +2,7 @@
# directly, or use the .bin attribute to get the script in a bin/ directory,
# to be used in a path for example.
{ argbash
, bash_5
, bash
, coreutils
, git
, lib
@@ -77,7 +77,7 @@ let
text =
''
#!${bash_5}/bin/bash
#!${bash}/bin/bash
source ${argsParser}
set -euo pipefail
''
+2
View File
@@ -3,7 +3,9 @@
checked-shell-script = import ./checked-shell-script;
gitignore = import ./gitignore.nix;
haskell-packages = import ./haskell-packages.nix;
postgis = import ./postgis.nix;
postgresql-default = import ./postgresql-default.nix;
postgresql-legacy = import ./postgresql-legacy.nix;
postgresql-future = import ./postgresql-future.nix;
slocat = import ./slocat.nix;
}
+31 -6
View File
@@ -13,13 +13,10 @@ let
# {
# pkg = "protolude";
# ver = "0.3.0";
# sha256 = "0iwh4wsjhb7pms88lw1afhdal9f86nrrkkvv65f9wxbd1b159n72";
# sha256 = "<sha256>";
# }
# { };
#
# To get the sha256:
# nix-prefetch-url --unpack https://hackage.haskell.org/package/protolude-0.3.0/protolude-0.3.0.tar.gz
# To temporarily pin unreleased versions from GitHub:
# <name> =
# prev.callCabal2nixWithOptions "<name>" (super.fetchFromGitHub {
@@ -29,8 +26,36 @@ let
# sha256 = "<sha256>";
# }) "--subpath=<subpath>" {};
#
# To get the sha256:
# nix-prefetch-url --unpack https://github.com/<owner>/<repo>/archive/<commit>.tar.gz
# To fill in the sha256:
# update-nix-fetchgit nix/overlays/haskell-packages.nix
postgresql-libpq = lib.dontCheck
(prev.callCabal2nix "postgresql-libpq"
(super.fetchFromGitHub {
owner = "PostgREST";
repo = "postgresql-libpq";
rev = "890a0a16cf57dd401420fdc6c7d576fb696003bc"; # master
sha256 = "1wmyhldk0k14y8whp1p4akrkqxf5snh8qsbm7fv5f7kz95nyffd0";
})
{ });
hasql-notifications = lib.dontCheck
(prev.callHackageDirect
{
pkg = "hasql-notifications";
ver = "0.2.0.6";
sha256 = "sha256-7PyFlB2B70njudOjaX6tk1m77ol9vnF5fI0LF86kVAI=";
}
{ });
hasql-pool = lib.dontCheck
(prev.callHackageDirect
{
pkg = "hasql-pool";
ver = "0.10";
sha256 = "sha256-kHzoqtNV9BFWnn1h560JRqMooQRwxokVKgDRBexamNI=";
}
{ });
} // extraOverrides final prev;
in
{
+27
View File
@@ -0,0 +1,27 @@
final: prev:
let
postgis_3_2_3 = rec {
version = "3.2.3";
src = final.fetchurl {
url = "https://download.osgeo.org/postgis/source/postgis-${version}.tar.gz";
sha256 = "sha256-G02LXHVuWrpZ77wYM7Iu/k1lYneO7KVvpJf+susTZow=";
};
};
in
{
postgresql_11 = prev.postgresql_11.override { this = final.postgresql_11; } // {
pkgs = prev.postgresql_11.pkgs // {
postgis = prev.postgresql_11.pkgs.postgis.overrideAttrs (_: postgis_3_2_3);
};
};
postgresql_10 = prev.postgresql_10.override { this = final.postgresql_11; } // {
pkgs = prev.postgresql_10.pkgs // {
postgis = prev.postgresql_10.pkgs.postgis.overrideAttrs (_: postgis_3_2_3);
};
};
postgresql_9_6 = prev.postgresql_9_6.override { this = final.postgresql_11; } // {
pkgs = prev.postgresql_9_6.pkgs // {
postgis = prev.postgresql_9_6.pkgs.postgis.overrideAttrs (_: postgis_3_2_3);
};
};
}
+5 -2
View File
@@ -1,5 +1,8 @@
self: super:
{ patches }: self: super:
# Overlay that sets the default version of PostgreSQL.
with patches;
{
postgresql = super.postgresql_14;
postgresql = super.postgresql_15.overrideAttrs ({ patches ? [ ], ... }: {
patches = patches ++ [ postgresql-atexit ];
});
}
+12 -12
View File
@@ -4,16 +4,16 @@ self: super:
{
## Example for including a postgresql version from a specific nixpks commit:
##
# postgresql_14 =
# let
# rev = "76b1e16c6659ccef7187ca69b287525fea133244";
# tarballHash = "1vsahpcx80k2bgslspb0sa6j4bmhdx77sw6la455drqcrqhdqj6a";
#
# pinnedPkgs =
# builtins.fetchTarball {
# url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
# sha256 = tarballHash;
# };
# in
# (import pinnedPkgs { }).pkgs.postgresql_14;
postgresql_16 =
let
rev = "5148520bfab61f99fd25fb9ff7bfbb50dad3c9db";
tarballHash = "1dfjmz65h8z4lk845724vypzmf3dbgsdndjpj8ydlhx6c7rpcq3p";
pinnedPkgs =
builtins.fetchTarball {
url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
sha256 = tarballHash;
};
in
(import pinnedPkgs { }).pkgs.postgresql_16;
}
+15
View File
@@ -16,4 +16,19 @@ self: super:
};
in
(import pinnedPkgs { }).pkgs.postgresql_9_6;
# PostgreSQL 10 was removed from Nixpkgs with
# https://github.com/NixOS/nixpkgs/commit/aa1483114bb329fee7e1266100b8d8921ed4723f
# We pin its parent commit to get the last version that was available.
postgresql_10 =
let
rev = "79661ba7e2fb96ebefbb537458a5bbae9dc5bd1a";
tarballHash = "0rn796pfn4sg90ai9fdnwmr10a2s835p1arazzgz46h6s5cxvq97";
pinnedPkgs =
builtins.fetchTarball {
url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
sha256 = tarballHash;
};
in
(import pinnedPkgs { }).pkgs.postgresql_10;
}
+13
View File
@@ -0,0 +1,13 @@
final: prev:
{
slocat = prev.buildGoModule {
name = "slocat";
src = prev.fetchFromGitHub {
owner = "robx";
repo = "slocat";
rev = "52e7512c6029fd00483e41ccce260a3b4b9b3b64";
sha256 = "sha256-qn6luuh5wqREu3s8RfuMCP5PKdS2WdwPrujRYTpfzQ8=";
};
vendorSha256 = "sha256-pQpattmS9VmO3ZIQUFn66az8GSmB4IvYhTTCFn6SUmo=";
};
}
+4
View File
@@ -22,4 +22,8 @@
./static-haskell-nix-ncurses.patch;
static-haskell-nix-ghc-bignum =
./static-haskell-nix-ghc-bignum.patch;
static-haskell-nix-openssl =
./static-haskell-nix-openssl.patch;
postgresql-atexit =
./postgresql-atexit.patch;
}
+11
View File
@@ -0,0 +1,11 @@
--- a/src/interfaces/libpq/Makefile
+++ b/src/interfaces/libpq/Makefile
@@ -118,7 +118,7 @@ backend_src = $(top_srcdir)/src/backend
libpq-refs-stamp: $(shlib)
ifneq ($(enable_coverage), yes)
ifeq (,$(filter aix solaris,$(PORTNAME)))
- @if nm -A -u $< 2>/dev/null | grep -v __cxa_atexit | grep exit; then \
+ @if nm -A -u $< 2>/dev/null | grep " exit"; then \
echo 'libpq must not be calling any function which invokes exit'; exit 1; \
fi
endif
@@ -0,0 +1,12 @@
diff --git a/survey/default.nix b/survey/default.nix
index cf1bd31..9d34753 100644
--- a/survey/default.nix
+++ b/survey/default.nix
@@ -736,6 +736,7 @@ let
openblas = previous.openblas.override { enableStatic = true; };
openssl = previous.openssl.override { static = true; };
+ openssl_1_1 = previous.openssl_1_1.override { static = true; };
libsass = previous.libsass.overrideAttrs (old: { dontDisableStatic = true; });
+6 -2
View File
@@ -19,6 +19,7 @@ let
[
patches.static-haskell-nix-ncurses
patches.static-haskell-nix-ghc-bignum
patches.static-haskell-nix-openssl
];
extraOverrides =
@@ -34,7 +35,7 @@ let
overlays =
[
allOverlays.postgresql-future
allOverlays.postgresql-default
(allOverlays.postgresql-default { inherit patches; })
(allOverlays.haskell-packages { inherit compiler extraOverrides; })
# Disable failing tests for postgresql on musl that should have no impact
# on the libpq that we need (collate.icu.utf8 and foreign regression
@@ -58,4 +59,7 @@ let
survey =
import "${patched-static-haskell-nix}/survey" { inherit normalPkgs compiler defaultCabalPackageVersionComingWithGhc; };
in
survey.haskellPackages."${name}"
{
inherit survey;
package = survey.haskellPackages."${name}";
}
+25 -2
View File
@@ -37,16 +37,38 @@ let
checkedShellScript
{
name = "postgrest-run";
docs = "Run PostgREST after buidling it interactively with cabal-install";
args = [ "ARG_LEFTOVERS([PostgREST arguments])" ];
docs = "Run PostgREST after building it interactively with cabal-install";
args =
[
"ARG_USE_ENV([PGRST_DB_ANON_ROLE], [postgrest_test_anonymous], [PostgREST anonymous role])"
"ARG_USE_ENV([PGRST_DB_POOL], [1], [PostgREST pool size])"
"ARG_USE_ENV([PGRST_DB_POOL_ACQUISITION_TIMEOUT], [1], [PostgREST pool size])"
"ARG_LEFTOVERS([PostgREST arguments])"
];
inRootDir = true;
withEnv = postgrest.env;
}
''
export PGRST_DB_ANON_ROLE
export PGRST_DB_POOL
export PGRST_DB_POOL_ACQUISITION_TIMEOUT
exec ${cabal-install}/bin/cabal v2-run ${devCabalOptions} --verbose=0 -- \
postgrest "''${_arg_leftovers[@]}"
'';
repl =
checkedShellScript
{
name = "postgrest-repl";
docs = "Interact with PostgREST modules using the cabal repl";
args = [ "ARG_LEFTOVERS([cabal v2-repl arguments])" ];
inRootDir = true;
withEnv = postgrest.env;
}
''
exec ${cabal-install}/bin/cabal v2-repl "''${_arg_leftovers[@]}"
'';
in
buildToolbox
{
@@ -55,5 +77,6 @@ buildToolbox
build
clean
run
repl
];
}
+2 -1
View File
@@ -77,7 +77,6 @@ let
}
''
${tests}/bin/postgrest-test-spec
${tests}/bin/postgrest-test-querycost
${tests}/bin/postgrest-test-doctests
${tests}/bin/postgrest-test-io
${style}/bin/postgrest-lint
@@ -165,6 +164,7 @@ let
# The following unsets all GIT_ variables.
unset "''${!GIT_@}"
# shellcheck disable=SC2317
function restore () {
ref="$(git stash list --format=format:%gD --grep "$1" -n1)"
# this will avoid merge conflicts when applying the stash
@@ -304,4 +304,5 @@ buildToolbox
hsieGraphModules
hsieGraphSymbols
];
extra = { inherit pushCachix; };
}
+15
View File
@@ -93,3 +93,18 @@ Image efficiency score: 100 %
Count Total Space Path
```
# Deriving from the optimized image
Since the docker image is minimal, it does not contain a shell or other utilities.
To derive a non-minimal image, you can do the following:
```Dockerfile
# derive from any base image you want
FROM alpine:latest
# copy PostgREST over
COPY --from=postgrest/postgrest /bin/postgrest /bin
# add your other stuff
```
+1 -1
View File
@@ -8,7 +8,7 @@ let
dockerTools.buildImage {
name = "postgrest";
tag = "latest";
contents = postgrest;
copyToRoot = postgrest;
# Set the current time as the image creation date. This makes the build
# non-reproducible, but that should not be an issue for us.
+15 -9
View File
@@ -56,11 +56,14 @@ let
export PGRST_LOG_LEVEL="crit"
mkdir -p "$(dirname "$_arg_output")"
abs_output="$(realpath "$_arg_output")"
# shellcheck disable=SC2145
${withTools.withPg} --fixtures "$_arg_testdir"/fixtures.sql \
${withTools.withSlowPg} \
${withTools.withPgrst} \
sh -c "cd \"$_arg_testdir\" && ${runner} -targets targets.http -output \"$_arg_output\" \"''${_arg_leftovers[@]}\""
${withTools.withSlowPgrst} \
sh -c "cd \"$_arg_testdir\" && ${runner} -targets targets.http -output \"$abs_output\" \"''${_arg_leftovers[@]}\""
${vegeta}/bin/vegeta report -type=text "$_arg_output"
'';
@@ -73,13 +76,12 @@ let
inherit name;
docs =
''
Run the vegeta loadtest twice:
- once on the <target> branch
Run the vegeta loadtest against every target branch and HEAD:
- once on the every <target-#> branch
- once in the current worktree
'';
args = [
"ARG_POSITIONAL_SINGLE([target], [Commit-ish reference to compare with])"
"ARG_LEFTOVERS([additional vegeta arguments])"
"ARG_POSITIONAL_INF([target], [Commit-ish reference to compare with], 1)"
];
positionalCompletion =
''
@@ -90,9 +92,11 @@ let
inRootDir = true;
}
''
for tgt in "''${_arg_target[@]}"; do
cat << EOF
Running loadtest on "$_arg_target"...
Running loadtest on "$tgt"...
EOF
@@ -101,21 +105,23 @@ let
# Save the results in the current working tree, too,
# otherwise they'd be lost in the temporary working tree
# created by withTools.withGit.
${withTools.withGit} "$_arg_target" ${loadtest} --output "$PWD/loadtest/$_arg_target.bin" --testdir "$PWD/test/load" "''${_arg_leftovers[@]}"
${withTools.withGit} "$tgt" ${loadtest} --output "$PWD/loadtest/$tgt.bin" --testdir "$PWD/test/load"
cat << EOF
Done running on "$_arg_target".
Done running on "$tgt".
EOF
done
cat << EOF
Running loadtest on HEAD...
EOF
${loadtest} --output "$PWD/loadtest/head.bin" --testdir "$PWD/test/load" "''${_arg_leftovers[@]}"
${loadtest} --output "$PWD/loadtest/head.bin" --testdir "$PWD/test/load"
cat << EOF
+2 -1
View File
@@ -1,5 +1,6 @@
{ buildToolbox
, checkedShellScript
, coreutils
, curl
, jq
, nix
@@ -33,7 +34,7 @@ let
commitHash="$(${curl}/bin/curl "${refUrl}" -H "${githubV3Header}" | ${jq}/bin/jq -r .object.sha)"
tarballUrl="${tarballUrlBase}$commitHash.tar.gz"
tarballHash="$(${nix}/bin/nix-prefetch-url --unpack "$tarballUrl")"
currentDate="$(date --iso)"
currentDate="$(${coreutils}/bin/date --iso)"
cat > nix/nixpkgs-version.nix << EOF
# Pinned version of Nixpkgs, generated with ${name}.
+21 -11
View File
@@ -40,7 +40,7 @@ let
)"
repo_url="https://hub.docker.com/v2/repositories/$DOCKER_REPO/postgrest/"
echo "Patching both descriptions at $repo_url ..."
echo "Patching both descriptions at $repo_url ..."
${curl}/bin/curl --fail -X PATCH "$repo_url" \
-H "Authorization: JWT $token" \
--data-urlencode description@${description} \
@@ -51,13 +51,13 @@ let
checkedShellScript
{
name = "postgrest-release";
docs = "Patch postgrest.cabal, tag and push all in one go.";
docs = "Patch postgrest.cabal, CHANGELOG.md, tag and push all in one go.";
args = [ "ARG_POSITIONAL_SINGLE([version], [Version to release], [pre])" ];
inRootDir = true;
}
''
trap "echo You need to be on the main branch to proceed. Exiting ..." ERR
[ "$(git rev-parse --abbrev-ref HEAD)" == "main" ]
trap "echo You need to be on the main branch or a release branch to proceed. Exiting ..." ERR
[[ "$(git rev-parse --abbrev-ref HEAD)" =~ ^main$|^rel- ]]
trap "" ERR
trap "echo You have uncommitted changes in postgrest.cabal. Exiting ..." ERR
@@ -69,15 +69,18 @@ let
IFS=. read -r major minor patch pre <<< "$current_version"
echo "Current version is $current_version"
bump_pre="$major.$minor.$patch.$(date '+%Y%m%d')"
today_date="$(date '+%Y%m%d')"
today_date_for_changelog="$(date '+%Y-%m-%d')"
bump_pre="$major.$minor.$patch.$today_date"
bump_pre_minor="$major.$((minor+1)).0.$today_date"
bump_patch="$major.$minor.$((patch+1))"
bump_minor="$major.$((minor+1)).0"
bump_major="$((major+1)).0.0"
PS3="Please select the new version: "
select new_version in "$bump_pre" "$bump_patch" "$bump_minor" "$bump_major"; do
select new_version in "$bump_pre" "$bump_pre_minor" "$bump_patch" "$bump_minor" "$bump_major"; do
case "$REPLY" in
1|2|3|4)
1|2|3|4|5)
echo "Selected $new_version"
break
;;
@@ -92,24 +95,31 @@ let
echo "Committing ..."
git add postgrest.cabal > /dev/null
if [[ "$new_version" != "$bump_pre" && "$new_version" != "$bump_pre_minor" ]]; then
echo "Updating CHANGELOG.md ..."
sed -i -E "s/Unreleased/&\n\n## [$new_version] - $today_date_for_changelog/" CHANGELOG.md > /dev/null
git add CHANGELOG.md > /dev/null
fi
git commit -m "bump version to $new_version" > /dev/null
echo "Tagging ..."
git tag "v$new_version" > /dev/null
trap "Couldn't find remote. Please push manually ..." ERR
trap "echo Remote not found. Please push manually ..." ERR
remote="$(git remote -v | grep PostgREST/postgrest | grep push | cut -f1)"
trap "" ERR
push="git push --atomic $remote main v$new_version"
push="git push --atomic $remote $(git rev-parse --abbrev-ref HEAD) v$new_version"
echo "To push both the branch and the new tag, the following will be run:"
echo
echo "$push"
echo
read -r -p 'Proceed? (y/N) ' REPLY
case "$REPLY" in
case "$REPLY" in
y|Y)
$push
;;
@@ -12,30 +12,30 @@ write from scratch.
## Sponsors
<table>
<table align="center">
<tbody>
<tr>
<td align="center" valign="middle">
<a href="https://www.cybertec-postgresql.com/en/?utm_source=postgrest.org&utm_medium=referral&utm_campaign=postgrest" target="_blank">
<img width="222px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/cybertec-new.png">
<img width="296px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/cybertec-new.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://www.2ndquadrant.com/en/?utm_campaign=External%20Websites&utm_source=PostgREST&utm_medium=Logo" target="_blank">
<img width="296px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/2ndquadrant.png">
<a href="https://gnuhost.eu/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/gnuhost.png">
</a>
</td>
<td align="center" valign="middle">
<a href="https://tryretool.com/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/retool.png">
<a href="https://neon.tech/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/neon.jpg">
</a>
</td>
</tr>
<tr></tr>
<tr>
<td align="center" valign="middle">
<a href="https://gnuhost.eu/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/gnuhost.png">
<a href="https://code.build/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/code-build.png">
</a>
</td>
<td align="center" valign="middle">
@@ -44,8 +44,8 @@ write from scratch.
</a>
</td>
<td align="center" valign="middle">
<a href="https://oblivious.ai/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/oblivious.jpg">
<a href="https://tembo.io/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
<img width="296px" src="https://raw.githubusercontent.com/PostgREST/postgrest/main/static/tembo.png">
</a>
</td>
</tr>
@@ -58,13 +58,13 @@ To learn how to use this container, see the [PostgREST Docker
documentation](https://postgrest.org/en/stable/install.html#docker).
You can configure the PostgREST image by setting
[enviroment variables](https://postgrest.org/en/stable/configuration.html).
[environment variables](https://postgrest.org/en/stable/configuration.html).
# How this image is built
The image is built from scratch using
[Nix](https://nixos.org/nixpkgs/manual/#sec-pkgs-dockerTools) instead of a
`Dockerfile`, which yields a higly secure and optimized image. This is also why
`Dockerfile`, which yields a highly secure and optimized image. This is also why
no commands are listed in the image history. See the [PostgREST
respository](https://github.com/PostgREST/postgrest/tree/main/nix/tools/docker) for
details on the build process and how to inspect the image.
+6 -22
View File
@@ -32,18 +32,6 @@ let
test:spec -- "''${_arg_leftovers[@]}"
'';
testQuerycost =
checkedShellScript
{
name = "postgrest-test-querycost";
docs = "Run the Haskell test suite for query costs";
inRootDir = true;
withEnv = postgrest.env;
}
''
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
'';
testDoctests =
checkedShellScript
{
@@ -80,7 +68,7 @@ let
python3.withPackages (ps: [
ps.pyjwt
ps.pytest
ps.pytest_xdist
ps.pytest-xdist
ps.pyyaml
ps.requests
ps.requests-unixsocket
@@ -105,7 +93,7 @@ let
checkedShellScript
{
name = "postgrest-dump-schema";
docs = "Dump the loaded schema's DbStructure as a yaml file.";
docs = "Dump the loaded schema's SchemaCache as a yaml file.";
inRootDir = true;
withEnv = postgrest.env;
withPath = [ jq ];
@@ -140,7 +128,7 @@ let
rm -rf coverage/*
# build once before running all the tests
${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec test:querycost
${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec
(
trap 'echo Found dead code: Check file list above.' ERR ;
@@ -155,14 +143,11 @@ let
HPCTIXFILE="$tmpdir"/spec.tix \
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec
HPCTIXFILE="$tmpdir"/querycost.tix \
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
# Note: No coverage for doctests, as doctests leverage GHCi and GHCi does not support hpc
# collect all the tix files
${ghc}/bin/hpc sum --union --exclude=Paths_postgrest --output="$tmpdir"/tests.tix \
"$tmpdir"/io*.tix "$tmpdir"/spec.tix "$tmpdir"/querycost.tix
"$tmpdir"/io*.tix "$tmpdir"/spec.tix
# prepare the overlay
${ghc}/bin/hpc overlay --output="$tmpdir"/overlay.tix test/coverage.overlay
@@ -179,7 +164,7 @@ let
${ghc}/bin/hpc markup --highlight-covered --destdir=coverage/overlay "$tmpdir"/overlay.tix || true
${ghc}/bin/hpc markup --highlight-covered --destdir=coverage/check "$tmpdir"/check.tix || true
echo "ERROR: Something is covered by both the tests and the overlay:"
echo "file://$(pwd)/coverage/check/hpc_index.html"
echo "postgrest-coverage: To see the results, visit file://$(pwd)/coverage/check/hpc_index.html"
exit 1
else
# copy the result .tix file to the coverage/ dir to make it available to postgrest-coverage-draft-overlay, too
@@ -189,7 +174,7 @@ let
# create html and stdout reports
${ghc}/bin/hpc markup --destdir=coverage coverage/postgrest.tix
echo "file://$(pwd)/coverage/hpc_index.html"
echo "postgrest-coverage: To see the results, visit file://$(pwd)/coverage/hpc_index.html"
${ghc}/bin/hpc report coverage/postgrest.tix "''${_arg_leftovers[@]}"
fi
''
@@ -234,7 +219,6 @@ buildToolbox
tools =
[
testSpec
testQuerycost
testDoctests
testSpecIdempotence
testIO
+121 -15
View File
@@ -1,6 +1,7 @@
{ bash-completion
, buildToolbox
, cabal-install
, cabalTools
, checkedShellScript
, curl
, devCabalOptions
@@ -8,15 +9,20 @@
, lib
, postgresqlVersions
, postgrest
, slocat
, writeText
}:
let
withTmpDb =
{ name, postgresql }:
let
commandName = "postgrest-with-${name}";
superuserRole = "postgres";
in
checkedShellScript
{
name = "postgrest-with-${name}";
docs = "Run the given command in a temporary database with ${name}";
name = commandName;
docs = "Run the given command in a temporary database with ${name}. If you wish to mutate the database, login with the '${superuserRole}' role.";
args =
[
"ARG_OPTIONAL_SINGLE([fixtures], [f], [SQL file to load fixtures from], [test/spec/fixtures/load.sql])"
@@ -25,6 +31,8 @@ let
"ARG_USE_ENV([PGUSER], [postgrest_test_authenticator], [Authenticator PG role])"
"ARG_USE_ENV([PGDATABASE], [postgres], [PG database name])"
"ARG_USE_ENV([PGRST_DB_SCHEMAS], [test], [Schema to expose])"
"ARG_USE_ENV([PGTZ], [utc], [Timezone to use])"
"ARG_USE_ENV([PGOPTIONS], [-c search_path=public,test], [PG options to use])"
];
positionalCompletion = "_command";
inRootDir = true;
@@ -53,18 +61,26 @@ let
export PGUSER
export PGDATABASE
export PGRST_DB_SCHEMAS
export PGTZ
export PGOPTIONS
HBA_FILE="$tmpdir/pg_hba.conf"
echo "local $PGDATABASE some_protected_user password" > "$HBA_FILE"
echo "local $PGDATABASE all trust" >> "$HBA_FILE"
log "Initializing database cluster..."
# We try to make the database cluster as independent as possible from the host
# by specifying the timezone, locale and encoding.
PGTZ=UTC initdb --no-locale --encoding=UTF8 --nosync -U "$PGUSER" --auth=trust \
# initdb -U creates a superuser(man initdb)
TZ=$PGTZ initdb --no-locale --encoding=UTF8 --nosync -U "${superuserRole}" --auth=trust \
>> "$setuplog"
log "Starting the database cluster..."
# Instead of listening on a local port, we will listen on a unix domain socket.
pg_ctl -l "$tmpdir/db.log" -w start -o "-F -c listen_addresses=\"\" -k $PGHOST -c log_statement=\"all\"" \
pg_ctl -l "$tmpdir/db.log" -w start -o "-F -c listen_addresses=\"\" -c hba_file=$HBA_FILE -k $PGHOST -c log_statement=\"all\" " \
>> "$setuplog"
# shellcheck disable=SC2317
stop () {
log "Stopping the database cluster..."
pg_ctl stop -m i >> "$setuplog"
@@ -72,10 +88,17 @@ let
}
trap stop EXIT
log "Loading fixtures..."
psql -v ON_ERROR_STOP=1 -f "$_arg_fixtures" >> "$setuplog"
log "Creating a minimally privileged $PGUSER connection role..."
createuser "$PGUSER" -U "${superuserRole}" --host="$tmpdir/socket" --no-createdb --no-inherit --no-superuser --no-createrole --no-replication --login
log "Loading fixtures under the ${superuserRole} role..."
psql -U "${superuserRole}" -v PGUSER="$PGUSER" -v ON_ERROR_STOP=1 -f "$_arg_fixtures" >> "$setuplog"
log "Done. Running command..."
echo "${commandName}: You can connect with: psql 'postgres:///$PGDATABASE?host=$tmpdir/socket' -U ${superuserRole}"
echo "${commandName}: You can tail the logs with: tail -f $tmpdir/db.log"
("$_arg_command" "''${_arg_leftovers[@]}")
'';
@@ -125,6 +148,81 @@ let
withPg = builtins.head withPgVersions;
withSlowPg =
checkedShellScript
{
name = "postgrest-with-slow-pg";
docs = "Run the given command with simulated high latency postgresql";
args =
[
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
"ARG_LEFTOVERS([command arguments])"
"ARG_USE_ENV([PGHOST], [], [PG host (socket name)])"
"ARG_USE_ENV([PGDELAY], [0ms], [extra PG latency (duration)])"
];
positionalCompletion = "_command";
inRootDir = true;
redirectTixFiles = false;
withTmpDir = true;
}
''
delay="''${PGDELAY:-0ms}"
echo "delaying data to/from postgres by $delay"
REALPGHOST="$PGHOST"
export PGHOST="$tmpdir/socket"
mkdir -p "$PGHOST"
${slocat}/bin/slocat -delay "$delay" -src "$PGHOST/.s.PGSQL.5432" -dst "$REALPGHOST/.s.PGSQL.5432" &
SLOCAT_PID=$!
# shellcheck disable=SC2317
stop_slocat() {
kill "$SLOCAT_PID" || true
wait "$SLOCAT_PID" || true
}
trap stop_slocat EXIT
sleep 1 # should wait for socket file to appear instead
("$_arg_command" "''${_arg_leftovers[@]}")
'';
withSlowPgrst =
checkedShellScript
{
name = "postgrest-with-slow-postgrest";
docs = "Run the given command with simulated high latency postgrest";
args =
[
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
"ARG_LEFTOVERS([command arguments])"
"ARG_USE_ENV([PGRST_SERVER_UNIX_SOCKET], [], [PostgREST host (socket name)])"
"ARG_USE_ENV([PGRST_DELAY], [0ms], [extra PostgREST latency (duration)])"
];
positionalCompletion = "_command";
inRootDir = true;
redirectTixFiles = false;
withTmpDir = true;
}
''
delay="''${PGRST_DELAY:-0ms}"
echo "delaying data to/from PostgREST by $delay"
REAL_PGRST_SERVER_UNIX_SOCKET="$PGRST_SERVER_UNIX_SOCKET"
export PGRST_SERVER_UNIX_SOCKET="$tmpdir/postgrest.socket"
${slocat}/bin/slocat -delay "$delay" -src "$PGRST_SERVER_UNIX_SOCKET" -dst "$REAL_PGRST_SERVER_UNIX_SOCKET" &
SLOCAT_PID=$!
# shellcheck disable=SC2317
stop_slocat() {
kill "$SLOCAT_PID" || true
wait "$SLOCAT_PID" || true
}
trap stop_slocat EXIT
sleep 1 # should wait for socket file to appear instead
("$_arg_command" "''${_arg_leftovers[@]}")
'';
withGit =
let
name = "postgrest-with-git";
@@ -245,17 +343,25 @@ let
export PGRST_SERVER_UNIX_SOCKET="$tmpdir"/postgrest.socket
rm -f result
echo -n "Building postgrest... "
nix-build -A postgrestPackage > "$tmpdir"/build.log 2>&1 || {
echo "failed, output:"
cat "$tmpdir"/build.log
exit 1
}
if [ -z "''${PGRST_BUILD_CABAL:-}" ]; then
echo -n "Building postgrest (nix)... "
nix-build -A postgrestPackage > "$tmpdir"/build.log 2>&1 || {
echo "failed, output:"
cat "$tmpdir"/build.log
exit 1
}
PGRST_CMD=./result/bin/postgrest
else
echo -n "Building postgrest (cabal)... "
postgrest-build
PGRST_CMD=postgrest-run
fi
echo "done."
echo -n "Starting postgrest... "
./result/bin/postgrest ${legacyConfig} > "$tmpdir"/run.log 2>&1 &
$PGRST_CMD ${legacyConfig} > "$tmpdir"/run.log 2>&1 &
pid=$!
# shellcheck disable=SC2317
cleanup() {
kill "$pid" || true
}
@@ -275,7 +381,7 @@ in
buildToolbox
{
name = "postgrest-with";
tools = [ withPgAll withGit withPgrst ] ++ withPgVersions;
tools = [ withPgAll withGit withPgrst withSlowPg withSlowPgrst ] ++ withPgVersions;
# make withTools available for other nix files
extra = { inherit withGit withPg withPgAll withPgrst; };
extra = { inherit withGit withPg withPgAll withPgrst withSlowPg withSlowPgrst; };
}
+60 -81
View File
@@ -1,5 +1,5 @@
name: postgrest
version: 10.0.0
version: 12.0.2
synopsis: REST API for any Postgres database
description: Reads the schema of a PostgreSQL database and creates RESTful routes
for tables, views, and functions, supporting all HTTP methods that security
@@ -34,8 +34,8 @@ library
default-extensions: OverloadedStrings
NoImplicitPrelude
hs-source-dirs: src
exposed-modules: PostgREST.App
PostgREST.Admin
exposed-modules: PostgREST.Admin
PostgREST.App
PostgREST.AppState
PostgREST.Auth
PostgREST.CLI
@@ -45,73 +45,86 @@ library
PostgREST.Config.PgVersion
PostgREST.Config.Proxy
PostgREST.Cors
PostgREST.DbStructure
PostgREST.DbStructure.Identifiers
PostgREST.DbStructure.Proc
PostgREST.DbStructure.Relationship
PostgREST.DbStructure.Table
PostgREST.SchemaCache
PostgREST.SchemaCache.Identifiers
PostgREST.SchemaCache.Routine
PostgREST.SchemaCache.Relationship
PostgREST.SchemaCache.Representations
PostgREST.SchemaCache.Table
PostgREST.Error
PostgREST.GucHeader
PostgREST.Logger
PostgREST.Middleware
PostgREST.MediaType
PostgREST.OpenAPI
PostgREST.Query
PostgREST.Query.QueryBuilder
PostgREST.Query.SqlFragment
PostgREST.Query.Statements
PostgREST.Plan
PostgREST.Plan.CallPlan
PostgREST.Plan.MutatePlan
PostgREST.Plan.ReadPlan
PostgREST.Plan.Types
PostgREST.RangeQuery
PostgREST.Request.ApiRequest
PostgREST.Request.DbRequestBuilder
PostgREST.Request.MutateQuery
PostgREST.Request.Preferences
PostgREST.Request.QueryParams
PostgREST.Request.ReadQuery
PostgREST.Request.Types
PostgREST.Unix
PostgREST.ApiRequest
PostgREST.ApiRequest.Preferences
PostgREST.ApiRequest.QueryParams
PostgREST.ApiRequest.Types
PostgREST.Response
PostgREST.Response.OpenAPI
PostgREST.Response.GucHeader
PostgREST.Response.Performance
PostgREST.Version
PostgREST.Workers
other-modules: Paths_postgrest
build-depends: base >= 4.9 && < 4.17
, HTTP >= 4000.3.7 && < 4000.4
, HTTP >= 4000.3.7 && < 4000.5
, Ranged-sets >= 0.3 && < 0.5
, aeson >= 2.0.3 && < 2.1
, aeson >= 2.0.3 && < 2.2
, auto-update >= 0.1.4 && < 0.2
, base64-bytestring >= 1 && < 1.3
, bytestring >= 0.10.8 && < 0.12
, cache >= 0.1.3 && < 0.2.0
, case-insensitive >= 1.2 && < 1.3
, cassava >= 0.4.5 && < 0.6
, clock >= 0.8.3 && < 0.9.0
, configurator-pg >= 0.2 && < 0.3
, containers >= 0.5.7 && < 0.7
, contravariant-extras >= 0.3.3 && < 0.4
, cookie >= 0.4.2 && < 0.5
, directory >= 1.2.6 && < 1.4
, either >= 4.4.1 && < 5.1
, extra >= 1.7.0 && < 2.0
, fuzzyset >= 0.2.3
, gitrev >= 1.2 && < 1.4
, hasql >= 1.4 && < 1.6
, hasql >= 1.6.1.1 && < 1.7
, hasql-dynamic-statements >= 0.3.1 && < 0.4
, hasql-notifications >= 0.1 && < 0.3
, hasql-pool >= 0.5 && < 0.6
, hasql-notifications >= 0.2.0.6 && < 0.3
, hasql-pool >= 0.10 && < 0.11
, hasql-transaction >= 1.0.1 && < 1.1
, heredoc >= 0.2 && < 0.3
, http-types >= 0.12.2 && < 0.13
, insert-ordered-containers >= 0.2.2 && < 0.3
, interpolatedstring-perl6 >= 1 && < 1.1
, jose >= 0.8.5.1 && < 0.10
, lens >= 4.14 && < 5.2
, lens-aeson >= 1.0.1 && < 1.2
, jose >= 0.8.5.1 && < 0.11
, lens >= 4.14 && < 5.3
, lens-aeson >= 1.0.1 && < 1.3
, mtl >= 2.2.2 && < 2.3
, network >= 2.6 && < 3.2
, network-uri >= 2.6.1 && < 2.8
, optparse-applicative >= 0.13 && < 0.17
, optparse-applicative >= 0.13 && < 0.18
, parsec >= 3.1.11 && < 3.2
, protolude >= 0.3.1 && < 0.4
, regex-tdfa >= 1.2.2 && < 1.4
, retry >= 0.7.4 && < 0.10
, scientific >= 0.3.4 && < 0.4
, streaming-commons >= 0.1.1 && < 0.3
, swagger2 >= 2.4 && < 2.9
, text >= 1.2.2 && < 1.3
, time >= 1.6 && < 1.12
, timeit >= 2.0 && < 2.1
, unordered-containers >= 0.2.8 && < 0.3
, unix-compat >= 0.5.4 && < 0.6
, vault >= 0.3.1.5 && < 0.4
, vector >= 0.11 && < 0.13
, vector >= 0.11 && < 0.14
, wai >= 3.2.1 && < 3.3
, wai-cors >= 0.2.5 && < 0.3
, wai-extra >= 3.1.8 && < 3.2
@@ -139,9 +152,6 @@ library
if !os(windows)
build-depends:
unix
, directory >= 1.2.6 && < 1.4
exposed-modules:
PostgREST.Unix
executable postgrest
default-language: Haskell2010
@@ -183,7 +193,8 @@ test-suite spec
Feature.ConcurrentSpec
Feature.CorsSpec
Feature.ExtraSearchPathSpec
Feature.LegacyGucsSpec
Feature.NoSuperuserSpec
Feature.ObservabilitySpec
Feature.OpenApi.DisabledOpenApiSpec
Feature.OpenApi.IgnorePrivOpenApiSpec
Feature.OpenApi.OpenApiSpec
@@ -191,34 +202,39 @@ test-suite spec
Feature.OpenApi.RootSpec
Feature.OpenApi.SecurityOpenApiSpec
Feature.OptionsSpec
Feature.Query.AggregateFunctionsSpec
Feature.Query.AndOrParamsSpec
Feature.Query.ComputedRelsSpec
Feature.Query.CustomMediaSpec
Feature.Query.DeleteSpec
Feature.Query.EmbedDisambiguationSpec
Feature.Query.EmbedInnerJoinSpec
Feature.Query.PlanSpec
Feature.Query.HtmlRawOutputSpec
Feature.Query.ErrorSpec
Feature.Query.InsertSpec
Feature.Query.JsonOperatorSpec
Feature.Query.MultipleSchemaSpec
Feature.Query.ErrorSpec
Feature.Query.NullsStripSpec
Feature.Query.PgSafeUpdateSpec
Feature.Query.PlanSpec
Feature.Query.PostGISSpec
Feature.Query.PreferencesSpec
Feature.Query.QueryLimitedSpec
Feature.Query.QuerySpec
Feature.Query.RangeSpec
Feature.Query.RawOutputTypesSpec
Feature.Query.RelatedQueriesSpec
Feature.Query.RpcSpec
Feature.Query.ServerTimingSpec
Feature.Query.SingularSpec
Feature.Query.SpreadQueriesSpec
Feature.Query.UnicodeSpec
Feature.Query.UpdateSpec
Feature.Query.UpsertSpec
Feature.RollbackSpec
Feature.RpcPreRequestGucsSpec
SpecHelper
TestTypes
build-depends: base >= 4.9 && < 4.17
, aeson >= 2.0.3 && < 2.1
, aeson >= 2.0.3 && < 2.2
, aeson-qq >= 0.8.1 && < 0.9
, async >= 2.1.1 && < 2.3
, auto-update >= 0.1.4 && < 0.2
@@ -226,69 +242,32 @@ test-suite spec
, bytestring >= 0.10.8 && < 0.12
, case-insensitive >= 1.2 && < 1.3
, containers >= 0.5.7 && < 0.7
, hasql-pool >= 0.5 && < 0.6
, hasql-pool >= 0.10 && < 0.11
, hasql-transaction >= 1.0.1 && < 1.1
, heredoc >= 0.2 && < 0.3
, hspec >= 2.3 && < 2.9
, hspec >= 2.3 && < 2.10
, hspec-wai >= 0.10 && < 0.12
, hspec-wai-json >= 0.10 && < 0.12
, http-types >= 0.12.3 && < 0.13
, lens >= 4.14 && < 5.2
, lens-aeson >= 1.0.1 && < 1.2
, lens >= 4.14 && < 5.3
, lens-aeson >= 1.0.1 && < 1.3
, monad-control >= 1.0.1 && < 1.1
, postgrest
, process >= 1.4.2 && < 1.7
, protolude >= 0.3.1 && < 0.4
, regex-tdfa >= 1.2.2 && < 1.4
, scientific >= 0.3.4 && < 0.4
, text >= 1.2.2 && < 1.3
, transformers-base >= 0.4.4 && < 0.5
, wai >= 3.2.1 && < 3.3
, wai-extra >= 3.0.19 && < 3.2
ghc-options: -O0 -Werror -Wall -fwarn-identities
ghc-options: -threaded -O0 -Werror -Wall -fwarn-identities
-fno-spec-constr -optP-Wno-nonportable-include-path
-fno-warn-missing-signatures
-fwrite-ide-info
-- https://github.com/PostgREST/postgrest/issues/387
-with-rtsopts=-K33K
test-suite querycost
type: exitcode-stdio-1.0
default-language: Haskell2010
default-extensions: OverloadedStrings
QuasiQuotes
NoImplicitPrelude
hs-source-dirs: test/spec
main-is: QueryCost.hs
other-modules: SpecHelper
build-depends: base >= 4.9 && < 4.17
, aeson >= 2.0.3 && < 2.1
, base64-bytestring >= 1 && < 1.3
, bytestring >= 0.10.8 && < 0.12
, case-insensitive >= 1.2 && < 1.3
, containers >= 0.5.7 && < 0.7
, contravariant >= 1.4 && < 1.6
, hasql >= 1.4 && < 1.6
, hasql-dynamic-statements >= 0.3.1 && < 0.4
, hasql-pool >= 0.5 && < 0.6
, hasql-transaction >= 1.0.1 && < 1.1
, heredoc >= 0.2 && < 0.3
, hspec >= 2.3 && < 2.9
, hspec-wai >= 0.10 && < 0.12
, hspec-wai-json >= 0.10 && < 0.12
, http-types >= 0.12.3 && < 0.13
, lens >= 4.14 && < 5.2
, lens-aeson >= 1.0.1 && < 1.2
, postgrest
, process >= 1.4.2 && < 1.7
, protolude >= 0.3.1 && < 0.4
, regex-tdfa >= 1.2.2 && < 1.4
, wai-extra >= 3.0.19 && < 3.2
ghc-options: -O0 -Werror -Wall -fwarn-identities
-fno-spec-constr -optP-Wno-nonportable-include-path
-fwrite-ide-info
-- https://github.com/PostgREST/postgrest/issues/387
-with-rtsopts=-K1K
test-suite doctests
type: exitcode-stdio-1.0
default-language: Haskell2010
+1
View File
@@ -40,6 +40,7 @@ lib.overrideDerivation postgrest.env (
pkgs.cabal2nix
pkgs.git
pkgs.postgresql
pkgs.update-nix-fetchgit
postgrest.hsie.bin
]
++ toolboxes;
+35 -45
View File
@@ -1,32 +1,44 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
module PostgREST.Admin
( postgrestAdmin
( runAdmin
) where
import qualified Data.Text as T
import qualified Hasql.Session as SQL
import qualified Network.HTTP.Types.Status as HTTP
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import Control.Monad.Extra (whenJust)
import Network.Socket
import Network.Socket.ByteString
import qualified Network.HTTP.Types.Status as HTTP
import qualified Network.Wai as Wai
import qualified Hasql.Session as SQL
import PostgREST.AppState (AppState)
import PostgREST.Config (AppConfig (..))
import qualified PostgREST.AppState as AppState
import PostgREST.Config (AppConfig (..))
import Protolude
import Protolude.Partial (fromJust)
runAdmin :: AppConfig -> AppState -> Warp.Settings -> IO ()
runAdmin conf@AppConfig{configAdminServerPort} appState settings =
whenJust (AppState.getSocketAdmin appState) $ \adminSocket -> do
AppState.logWithZTime appState $ "Admin server listening on port " <> show (fromIntegral (fromJust configAdminServerPort) :: Integer)
void . forkIO $ Warp.runSettingsSocket settings adminSocket adminApp
where
adminApp = admin appState conf
-- | PostgREST admin application
postgrestAdmin :: AppState.AppState -> AppConfig -> Wai.Application
postgrestAdmin appState appConfig req respond = do
isMainAppReachable <- any isRight <$> reachMainApp appConfig
isSchemaCacheLoaded <- isJust <$> AppState.getDbStructure appState
admin :: AppState.AppState -> AppConfig -> Wai.Application
admin appState appConfig req respond = do
isMainAppReachable <- isRight <$> reachMainApp (AppState.getSocketREST appState)
isSchemaCacheLoaded <- isJust <$> AppState.getSchemaCache appState
isConnectionUp <-
if configDbChannelEnabled appConfig
then AppState.getIsListenerOn appState
else isRight <$> AppState.usePool appState (SQL.sql "SELECT 1")
else isRight <$> AppState.usePool appState appConfig (SQL.sql "SELECT 1")
case Wai.pathInfo req of
["ready"] ->
@@ -38,37 +50,15 @@ postgrestAdmin appState appConfig req respond = do
-- Try to connect to the main app socket
-- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections
-- The code for resolving the "*4", "!4", "*6", "!6", "*" special values is taken from
-- https://hackage.haskell.org/package/streaming-commons-0.2.2.4/docs/src/Data.Streaming.Network.html#bindPortGenEx
reachMainApp :: AppConfig -> IO [Either IOException ()]
reachMainApp AppConfig{..} =
case configServerUnixSocket of
Just path -> do
sock <- socket AF_UNIX Stream 0
(:[]) <$> try (do
connect sock $ SockAddrUnix path
withSocketsDo $ bracket (pure sock) close sendEmpty)
Nothing -> do
let
host | configServerHost `elem` ["*4", "!4", "*6", "!6", "*"] = Nothing
| otherwise = Just configServerHost
filterAddrs xs =
case configServerHost of
"*4" -> ipv4Addrs xs ++ ipv6Addrs xs
"!4" -> ipv4Addrs xs
"*6" -> ipv6Addrs xs ++ ipv4Addrs xs
"!6" -> ipv6Addrs xs
_ -> xs
ipv4Addrs = filter ((/=) AF_INET6 . addrFamily)
ipv6Addrs = filter ((==) AF_INET6 . addrFamily)
addrs <- getAddrInfo (Just $ defaultHints { addrSocketType = Stream }) (T.unpack <$> host) (Just . show $ configServerPort)
tryAddr `traverse` filterAddrs addrs
reachMainApp :: Socket -> IO (Either IOException ())
reachMainApp appSock = do
sockAddr <- getSocketName appSock
sock <- socket (addrFamily sockAddr) Stream defaultProtocol
try $ do
connect sock sockAddr
withSocketsDo $ bracket (pure sock) close sendEmpty
where
sendEmpty sock = void $ send sock mempty
tryAddr :: AddrInfo -> IO (Either IOException ())
tryAddr addr = do
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
try $ do
connect sock $ addrAddress addr
withSocketsDo $ bracket (pure sock) close sendEmpty
addrFamily (SockAddrInet _ _) = AF_INET
addrFamily (SockAddrInet6 {}) = AF_INET6
addrFamily (SockAddrUnix _) = AF_UNIX
+340
View File
@@ -0,0 +1,340 @@
{-|
Module : PostgREST.Request.ApiRequest
Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.ApiRequest
( ApiRequest(..)
, InvokeMethod(..)
, Mutation(..)
, MediaType(..)
, Action(..)
, Target(..)
, Payload(..)
, userApiRequest
) where
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.CaseInsensitive as CI
import qualified Data.Csv as CSV
import qualified Data.HashMap.Strict as HM
import qualified Data.List.NonEmpty as NonEmptyList
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text.Encoding as T
import qualified Data.Vector as V
import Data.Either.Combinators (mapBoth)
import Control.Arrow ((***))
import Data.Aeson.Types (emptyArray, emptyObject)
import Data.List (lookup)
import Data.Ranged.Ranges (emptyRange, rangeIntersection,
rangeIsEmpty)
import Network.HTTP.Types.Header (RequestHeaders, hCookie)
import Network.HTTP.Types.URI (parseSimpleQuery)
import Network.Wai (Request (..))
import Network.Wai.Parse (parseHttpAccept)
import Web.Cookie (parseCookies)
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
import PostgREST.ApiRequest.Types (ApiRequestError (..),
RangeError (..))
import PostgREST.Config (AppConfig (..),
OpenAPIMode (..))
import PostgREST.MediaType (MediaType (..))
import PostgREST.RangeQuery (NonnegRange, allRange,
convertToLimitZeroRange,
hasLimitZero,
rangeRequested)
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema)
import qualified PostgREST.ApiRequest.Preferences as Preferences
import qualified PostgREST.ApiRequest.QueryParams as QueryParams
import qualified PostgREST.MediaType as MediaType
import Protolude
type RequestBody = LBS.ByteString
data Payload
= ProcessedJSON -- ^ Cached attributes of a JSON payload
{ payRaw :: LBS.ByteString
-- ^ This is the raw ByteString that comes from the request body. We
-- cache this instead of an Aeson Value because it was detected that for
-- large payloads the encoding had high memory usage, see
-- https://github.com/PostgREST/postgrest/pull/1005 for more details
, payKeys :: S.Set Text
-- ^ Keys of the object or if it's an array these keys are guaranteed to
-- be the same across all its objects
}
| ProcessedUrlEncoded { payArray :: [(Text, Text)], payKeys :: S.Set Text }
| RawJSON { payRaw :: LBS.ByteString }
| RawPay { payRaw :: LBS.ByteString }
data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
data Mutation = MutationCreate | MutationDelete | MutationSingleUpsert | MutationUpdate deriving Eq
-- | Types of things a user wants to do to tables/views/procs
data Action
= ActionMutate Mutation
| ActionRead {isHead :: Bool}
| ActionInvoke InvokeMethod
| ActionInfo
| ActionInspect {isHead :: Bool}
deriving Eq
-- | The path info that will be mapped to a target (used to handle validations and errors before defining the Target)
data PathInfo
= PathInfo
{ pathName :: Text
, pathIsProc :: Bool
, pathIsDefSpec :: Bool
, pathIsRootSpec :: Bool
}
-- | The target db object of a user action
data Target = TargetIdent QualifiedIdentifier
| TargetProc{tProc :: QualifiedIdentifier, tpIsRootSpec :: Bool}
| TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/"
{-|
Describes what the user wants to do. This data type is a
translation of the raw elements of an HTTP request into domain
specific language. There is no guarantee that the intent is
sensible, it is up to a later stage of processing to determine
if it is an action we are able to perform.
-}
data ApiRequest = ApiRequest {
iAction :: Action -- ^ Similar but not identical to HTTP method, e.g. Create/Invoke both POST
, iRange :: HM.HashMap Text NonnegRange -- ^ Requested range of rows within response
, iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level
, iTarget :: Target -- ^ The target, be it calling a proc or accessing a table
, iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions
, iPreferences :: Preferences.Preferences -- ^ Prefer header values
, iQueryParams :: QueryParams.QueryParams
, iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload
, iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers
, iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies
, iPath :: ByteString -- ^ Raw request path
, iMethod :: ByteString -- ^ Raw request method
, iSchema :: Schema -- ^ The request schema. Can vary depending on profile headers.
, iNegotiatedByProfile :: Bool -- ^ If schema was was chosen according to the profile spec https://www.w3.org/TR/dx-prof-conneg/
, iAcceptMediaType :: [MediaType] -- ^ The resolved media types in the Accept, considering quality(q) factors
, iContentMediaType :: MediaType -- ^ The media type in the Content-Type header
}
-- | Examines HTTP request and translates it into user intent.
userApiRequest :: AppConfig -> Request -> RequestBody -> SchemaCache -> Either ApiRequestError ApiRequest
userApiRequest conf req reqBody sCache = do
pInfo@PathInfo{..} <- getPathInfo conf $ pathInfo req
act <- getAction pInfo method
qPrms <- first QueryParamError $ QueryParams.parse (pathIsProc && act `elem` [ActionInvoke InvGet, ActionInvoke InvHead]) $ rawQueryString req
(schema, negotiatedByProfile) <- getSchema conf hdrs method
(topLevelRange, ranges) <- getRanges method qPrms hdrs
(payload, columns) <- getPayload reqBody contentMediaType qPrms act pInfo
return $ ApiRequest {
iAction = act
, iTarget = if | pathIsProc -> TargetProc (QualifiedIdentifier schema pathName) pathIsRootSpec
| pathIsDefSpec -> TargetDefaultSpec schema
| otherwise -> TargetIdent $ QualifiedIdentifier schema pathName
, iRange = ranges
, iTopLevelRange = topLevelRange
, iPayload = payload
, iPreferences = Preferences.fromHeaders (configDbTxAllowOverride conf) (dbTimezones sCache) hdrs
, iQueryParams = qPrms
, iColumns = columns
, iHeaders = iHdrs
, iCookies = iCkies
, iPath = rawPathInfo req
, iMethod = method
, iSchema = schema
, iNegotiatedByProfile = negotiatedByProfile
, iAcceptMediaType = maybe [MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
, iContentMediaType = contentMediaType
}
where
method = requestMethod req
hdrs = requestHeaders req
lookupHeader = flip lookup hdrs
iHdrs = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
iCkies = maybe [] parseCookies $ lookupHeader "Cookie"
contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type"
getPathInfo :: AppConfig -> [Text] -> Either ApiRequestError PathInfo
getPathInfo AppConfig{configOpenApiMode, configDbRootSpec} path =
case path of
[] -> case configDbRootSpec of
Just (QualifiedIdentifier _ pathName) -> Right $ PathInfo pathName True False True
Nothing | configOpenApiMode == OADisabled -> Left NotFound
| otherwise -> Right $ PathInfo mempty False True False
[table] -> Right $ PathInfo table False False False
["rpc", pName] -> Right $ PathInfo pName True False False
_ -> Left NotFound
getAction :: PathInfo -> ByteString -> Either ApiRequestError Action
getAction PathInfo{pathIsProc, pathIsDefSpec} method =
if pathIsProc && method `notElem` ["HEAD", "GET", "POST", "OPTIONS"]
then Left $ InvalidRpcMethod method
else case method of
-- The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response
-- From https://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html#sec9.4
"HEAD" | pathIsDefSpec -> Right $ ActionInspect{isHead=True}
| pathIsProc -> Right $ ActionInvoke InvHead
| otherwise -> Right $ ActionRead{isHead=True}
"GET" | pathIsDefSpec -> Right $ ActionInspect{isHead=False}
| pathIsProc -> Right $ ActionInvoke InvGet
| otherwise -> Right $ ActionRead{isHead=False}
"POST" | pathIsProc -> Right $ ActionInvoke InvPost
| otherwise -> Right $ ActionMutate MutationCreate
"PATCH" -> Right $ ActionMutate MutationUpdate
"PUT" -> Right $ ActionMutate MutationSingleUpsert
"DELETE" -> Right $ ActionMutate MutationDelete
"OPTIONS" -> Right ActionInfo
_ -> Left $ UnsupportedMethod method
getSchema :: AppConfig -> RequestHeaders -> ByteString -> Either ApiRequestError (Schema, Bool)
getSchema AppConfig{configDbSchemas} hdrs method = do
case profile of
Just p | p `notElem` configDbSchemas -> Left $ UnacceptableSchema $ toList configDbSchemas
| otherwise -> Right (p, True)
Nothing -> Right (defaultSchema, length configDbSchemas /= 1) -- if we have many schemas, assume the default schema was negotiated
where
defaultSchema = NonEmptyList.head configDbSchemas
profile = case method of
-- POST/PATCH/PUT/DELETE don't use the same header as per the spec
"DELETE" -> contentProfile
"PATCH" -> contentProfile
"POST" -> contentProfile
"PUT" -> contentProfile
_ -> acceptProfile
contentProfile = T.decodeUtf8 <$> lookupHeader "Content-Profile"
acceptProfile = T.decodeUtf8 <$> lookupHeader "Accept-Profile"
lookupHeader = flip lookup hdrs
getRanges :: ByteString -> QueryParams -> RequestHeaders -> Either ApiRequestError (NonnegRange, HM.HashMap Text NonnegRange)
getRanges method QueryParams{qsOrder,qsRanges} hdrs
| isInvalidRange = Left $ InvalidRange (if rangeIsEmpty headerRange then LowerGTUpper else NegativeLimit)
| method `elem` ["PATCH", "DELETE"] && not (null qsRanges) && null qsOrder = Left LimitNoOrderError
| method == "PUT" && topLevelRange /= allRange = Left PutLimitNotAllowedError
| otherwise = Right (topLevelRange, ranges)
where
-- According to the RFC (https://www.rfc-editor.org/rfc/rfc9110.html#name-range),
-- the Range header must be ignored for all methods other than GET
headerRange = if method == "GET" then rangeRequested hdrs else allRange
limitRange = fromMaybe allRange (HM.lookup "limit" qsRanges)
headerAndLimitRange = rangeIntersection headerRange limitRange
-- Bypass all the ranges and send only the limit zero range (0 <= x <= -1) if
-- limit=0 is present in the query params (not allowed for the Range header)
ranges = HM.insert "limit" (convertToLimitZeroRange limitRange headerAndLimitRange) qsRanges
-- The only emptyRange allowed is the limit zero range
isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange)
topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows
getPayload :: RequestBody -> MediaType -> QueryParams.QueryParams -> Action -> PathInfo -> Either ApiRequestError (Maybe Payload, S.Set FieldName)
getPayload reqBody contentMediaType QueryParams{qsColumns} action PathInfo{pathIsProc}= do
checkedPayload <- if shouldParsePayload then payload else Right Nothing
let cols = case (checkedPayload, columns) of
(Just ProcessedJSON{payKeys}, _) -> payKeys
(Just ProcessedUrlEncoded{payKeys}, _) -> payKeys
(Just RawJSON{}, Just cls) -> cls
_ -> S.empty
return (checkedPayload, cols)
where
payload :: Either ApiRequestError (Maybe Payload)
payload = mapBoth InvalidBody Just $ case (contentMediaType, pathIsProc) of
(MTApplicationJSON, _) ->
if isJust columns
then Right $ RawJSON reqBody
else note "All object keys must match" . payloadAttributes reqBody
=<< if LBS.null reqBody && pathIsProc
then Right emptyObject
else first BS.pack $
-- Drop parsing error message in favor of generic one (https://github.com/PostgREST/postgrest/issues/2344)
maybe (Left "Empty or invalid json") Right $ JSON.decode reqBody
(MTTextCSV, _) -> do
json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
(MTUrlEncoded, isProc) -> do
let params = (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
if isProc
then Right $ ProcessedUrlEncoded params (S.fromList $ fst <$> params)
else
let paramsMap = HM.fromList $ (identity *** JSON.String) <$> params in
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (HM.keys paramsMap)
(MTTextPlain, True) -> Right $ RawPay reqBody
(MTTextXML, True) -> Right $ RawPay reqBody
(MTOctetStream, True) -> Right $ RawPay reqBody
(ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct
shouldParsePayload = case (action, contentMediaType) of
(ActionMutate MutationCreate, _) -> True
(ActionInvoke InvPost, _) -> True
(ActionMutate MutationSingleUpsert, _) -> True
(ActionMutate MutationUpdate, _) -> True
_ -> False
columns = case action of
ActionMutate MutationCreate -> qsColumns
ActionMutate MutationUpdate -> qsColumns
ActionInvoke InvPost -> qsColumns
_ -> Nothing
type CsvData = V.Vector (M.Map Text LBS.ByteString)
{-|
Converts CSV like
a,b
1,hi
2,bye
into a JSON array like
[ {"a": "1", "b": "hi"}, {"a": 2, "b": "bye"} ]
The reason for its odd signature is so that it can compose
directly with CSV.decodeByName
-}
csvToJson :: (CSV.Header, CsvData) -> JSON.Value
csvToJson (_, vals) =
JSON.Array $ V.map rowToJsonObj vals
where
rowToJsonObj = JSON.Object . KM.fromMapText .
M.map (\str ->
if str == "NULL"
then JSON.Null
else JSON.String . T.decodeUtf8 $ LBS.toStrict str
)
payloadAttributes :: RequestBody -> JSON.Value -> Maybe Payload
payloadAttributes raw json =
-- Test that Array contains only Objects having the same keys
case json of
JSON.Array arr ->
case arr V.!? 0 of
Just (JSON.Object o) ->
let canonicalKeys = S.fromList $ K.toText <$> KM.keys o
areKeysUniform = all (\case
JSON.Object x -> S.fromList (K.toText <$> KM.keys x) == canonicalKeys
_ -> False) arr in
if areKeysUniform
then Just $ ProcessedJSON raw canonicalKeys
else Nothing
Just _ -> Nothing
Nothing -> Just emptyPJArray
JSON.Object o -> Just $ ProcessedJSON raw (S.fromList $ K.toText <$> KM.keys o)
-- truncate everything else to an empty array.
_ -> Just emptyPJArray
where
emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty
@@ -1,28 +1,35 @@
-- |
-- Module: PostgREST.Request.Preferences
-- Module: PostgREST.ApiRequest.Preferences
-- Description: Track client preferences to be employed when processing requests
--
-- Track client prefences set in HTTP 'Prefer' headers according to RFC7240[1].
--
-- [1] https://datatracker.ietf.org/doc/html/rfc7240
--
module PostgREST.Request.Preferences
{-# LANGUAGE NamedFieldPuns #-}
module PostgREST.ApiRequest.Preferences
( Preferences(..)
, PreferCount(..)
, PreferHandling(..)
, PreferMissing(..)
, PreferParameters(..)
, PreferRepresentation(..)
, PreferResolution(..)
, PreferTransaction(..)
, PreferTimezone(..)
, fromHeaders
, ToAppliedHeader(..)
, shouldCount
, prefAppliedHeader
) where
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as Map
import qualified Data.Set as S
import qualified Network.HTTP.Types.Header as HTTP
import Protolude
import PostgREST.Config.Database (TimezoneNames)
import Protolude
-- $setup
-- Setup for doctests
@@ -32,6 +39,9 @@ import Protolude
-- >>> deriving instance Show PreferParameters
-- >>> deriving instance Show PreferCount
-- >>> deriving instance Show PreferTransaction
-- >>> deriving instance Show PreferMissing
-- >>> deriving instance Show PreferHandling
-- >>> deriving instance Show PreferTimezone
-- >>> deriving instance Show Preferences
-- | Preferences recognized by the application.
@@ -42,77 +52,110 @@ data Preferences
, preferParameters :: Maybe PreferParameters
, preferCount :: Maybe PreferCount
, preferTransaction :: Maybe PreferTransaction
, preferMissing :: Maybe PreferMissing
, preferHandling :: Maybe PreferHandling
, preferTimezone :: Maybe PreferTimezone
, invalidPrefs :: [ByteString]
}
-- |
-- Parse HTTP headers based on RFC7240[1] to identify preferences.
--
-- One header with comma-separated values can be used to set multiple preferences:
-- >>> let sc = S.fromList ["America/Los_Angeles"]
--
-- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates, count=exact")]
-- One header with comma-separated values can be used to set multiple preferences:
-- >>> pPrint $ fromHeaders True sc [("Prefer", "resolution=ignore-duplicates, count=exact, timezone=America/Los_Angeles")]
-- Preferences
-- { preferResolution = Just IgnoreDuplicates
-- , preferRepresentation = Nothing
-- , preferParameters = Nothing
-- , preferCount = Just ExactCount
-- , preferTransaction = Nothing
-- , preferMissing = Nothing
-- , preferHandling = Nothing
-- , preferTimezone = Just
-- ( PreferTimezone "America/Los_Angeles" )
-- , invalidPrefs = []
-- }
--
-- Multiple headers can also be used:
--
-- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates"), ("Prefer", "count=exact")]
-- >>> pPrint $ fromHeaders True sc [("Prefer", "resolution=ignore-duplicates"), ("Prefer", "count=exact"), ("Prefer", "missing=null"), ("Prefer", "handling=lenient"), ("Prefer", "invalid")]
-- Preferences
-- { preferResolution = Just IgnoreDuplicates
-- , preferRepresentation = Nothing
-- , preferParameters = Nothing
-- , preferCount = Just ExactCount
-- , preferTransaction = Nothing
-- , preferMissing = Just ApplyNulls
-- , preferHandling = Just Lenient
-- , preferTimezone = Nothing
-- , invalidPrefs = [ "invalid" ]
-- }
--
-- If a preference is set more than once, only the first is used:
--
-- >>> preferTransaction $ fromHeaders [("Prefer", "tx=commit, tx=rollback")]
-- >>> preferTransaction $ fromHeaders True sc [("Prefer", "tx=commit, tx=rollback")]
-- Just Commit
--
-- This is also the case across multiple headers:
--
-- >>> :{
-- preferResolution . fromHeaders $
-- preferResolution . fromHeaders True sc $
-- [ ("Prefer", "resolution=ignore-duplicates")
-- , ("Prefer", "resolution=merge-duplicates")
-- ]
-- :}
-- Just IgnoreDuplicates
--
-- Preferences not recognized by the application are ignored:
--
-- >>> preferResolution $ fromHeaders [("Prefer", "resolution=foo")]
-- Nothing
--
-- Preferences can be separated by arbitrary amounts of space, lower-case header is also recognized:
--
-- >>> pPrint $ fromHeaders [("prefer", "count=exact, tx=commit ,return=minimal")]
-- >>> pPrint $ fromHeaders True sc [("prefer", "count=exact, tx=commit ,return=representation , missing=default, handling=strict, anything")]
-- Preferences
-- { preferResolution = Nothing
-- , preferRepresentation = Just None
-- , preferRepresentation = Just Full
-- , preferParameters = Nothing
-- , preferCount = Just ExactCount
-- , preferTransaction = Just Commit
-- , preferMissing = Just ApplyDefaults
-- , preferHandling = Just Strict
-- , preferTimezone = Nothing
-- , invalidPrefs = [ "anything" ]
-- }
--
fromHeaders :: [HTTP.Header] -> Preferences
fromHeaders headers =
fromHeaders :: Bool -> TimezoneNames -> [HTTP.Header] -> Preferences
fromHeaders allowTxDbOverride acceptedTzNames headers =
Preferences
{ preferResolution = parsePrefs [MergeDuplicates, IgnoreDuplicates]
{ preferResolution = parsePrefs [MergeDuplicates, IgnoreDuplicates]
, preferRepresentation = parsePrefs [Full, None, HeadersOnly]
, preferParameters = parsePrefs [SingleObject, MultipleObjects]
, preferCount = parsePrefs [ExactCount, PlannedCount, EstimatedCount]
, preferTransaction = parsePrefs [Commit, Rollback]
, preferParameters = parsePrefs [SingleObject]
, preferCount = parsePrefs [ExactCount, PlannedCount, EstimatedCount]
, preferTransaction = if allowTxDbOverride then parsePrefs [Commit, Rollback] else Nothing
, preferMissing = parsePrefs [ApplyDefaults, ApplyNulls]
, preferHandling = parsePrefs [Strict, Lenient]
, preferTimezone = if isTimezonePrefAccepted then PreferTimezone <$> timezonePref else Nothing
, invalidPrefs = filter checkPrefs prefs
}
where
mapToHeadVal :: ToHeaderValue a => [a] -> [ByteString]
mapToHeadVal = map toHeaderValue
acceptedPrefs = mapToHeadVal [MergeDuplicates, IgnoreDuplicates] ++
mapToHeadVal [Full, None, HeadersOnly] ++
mapToHeadVal [SingleObject] ++
mapToHeadVal [ExactCount, PlannedCount, EstimatedCount] ++
mapToHeadVal [Commit, Rollback] ++
mapToHeadVal [ApplyDefaults, ApplyNulls] ++
mapToHeadVal [Strict, Lenient]
prefHeaders = filter ((==) HTTP.hPrefer . fst) headers
prefs = fmap BS.strip . concatMap (BS.split ',' . snd) $ prefHeaders
timezonePref = listToMaybe $ mapMaybe (BS.stripPrefix "timezone=") prefs
isTimezonePrefAccepted = (S.member <$> timezonePref <*> pure acceptedTzNames) == Just True
checkPrefs p = p `notElem` acceptedPrefs && not isTimezonePrefAccepted
parsePrefs :: ToHeaderValue a => [a] -> Maybe a
parsePrefs vals =
head $ mapMaybe (flip Map.lookup $ prefMap vals) prefs
@@ -120,6 +163,24 @@ fromHeaders headers =
prefMap :: ToHeaderValue a => [a] -> Map.Map ByteString a
prefMap = Map.fromList . fmap (\pref -> (toHeaderValue pref, pref))
prefAppliedHeader :: Preferences -> Maybe HTTP.Header
prefAppliedHeader Preferences {preferResolution, preferRepresentation, preferParameters, preferCount, preferTransaction, preferMissing, preferHandling, preferTimezone } =
if null prefsVals
then Nothing
else Just (HTTP.hPreferenceApplied, combined)
where
combined = BS.intercalate ", " prefsVals
prefsVals = catMaybes [
toHeaderValue <$> preferResolution
, toHeaderValue <$> preferMissing
, toHeaderValue <$> preferRepresentation
, toHeaderValue <$> preferParameters
, toHeaderValue <$> preferCount
, toHeaderValue <$> preferTransaction
, toHeaderValue <$> preferHandling
, toHeaderValue <$> preferTimezone
]
-- |
-- Convert a preference into the value that we look for in the 'Prefer' headers.
--
@@ -129,27 +190,16 @@ fromHeaders headers =
class ToHeaderValue a where
toHeaderValue :: a -> ByteString
-- |
-- Header to indicate that a preference has been applied.
--
-- >>> toAppliedHeader MergeDuplicates
-- ("Preference-Applied","resolution=merge-duplicates")
--
class ToHeaderValue a => ToAppliedHeader a where
toAppliedHeader :: a -> HTTP.Header
toAppliedHeader x = (HTTP.hPreferenceApplied, toHeaderValue x)
-- | How to handle duplicate values.
data PreferResolution
= MergeDuplicates
| IgnoreDuplicates
deriving Eq
instance ToHeaderValue PreferResolution where
toHeaderValue MergeDuplicates = "resolution=merge-duplicates"
toHeaderValue IgnoreDuplicates = "resolution=ignore-duplicates"
instance ToAppliedHeader PreferResolution
-- |
-- How to return the mutated data.
--
@@ -168,12 +218,10 @@ instance ToHeaderValue PreferRepresentation where
-- | How to pass parameters to stored procedures.
data PreferParameters
= SingleObject -- ^ Pass all parameters as a single json object to a stored procedure.
| MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure.
deriving Eq
instance ToHeaderValue PreferParameters where
toHeaderValue SingleObject = "params=single-object"
toHeaderValue MultipleObjects = "params=multiple-objects"
-- | How to determine the count of (expected) results
data PreferCount
@@ -187,6 +235,10 @@ instance ToHeaderValue PreferCount where
toHeaderValue PlannedCount = "count=planned"
toHeaderValue EstimatedCount = "count=estimated"
shouldCount :: Maybe PreferCount -> Bool
shouldCount prefCount =
prefCount == Just ExactCount || prefCount == Just EstimatedCount
-- | Whether to commit or roll back transactions.
data PreferTransaction
= Commit -- ^ Commit transaction - the default.
@@ -197,4 +249,32 @@ instance ToHeaderValue PreferTransaction where
toHeaderValue Commit = "tx=commit"
toHeaderValue Rollback = "tx=rollback"
instance ToAppliedHeader PreferTransaction
-- |
-- How to handle the insertion/update when the keys specified in ?columns are not present
-- in the json body.
data PreferMissing
= ApplyDefaults -- ^ Use the default column value for missing values.
| ApplyNulls -- ^ Use the null value for missing values.
deriving Eq
instance ToHeaderValue PreferMissing where
toHeaderValue ApplyDefaults = "missing=default"
toHeaderValue ApplyNulls = "missing=null"
-- |
-- Handling of unrecognised preferences
data PreferHandling
= Strict -- ^ Throw error on unrecognised preferences
| Lenient -- ^ Ignore unrecognised preferences
deriving Eq
instance ToHeaderValue PreferHandling where
toHeaderValue Strict = "handling=strict"
toHeaderValue Lenient = "handling=lenient"
-- |
-- Change timezone
newtype PreferTimezone = PreferTimezone ByteString
instance ToHeaderValue PreferTimezone where
toHeaderValue (PreferTimezone tz) = "timezone=" <> tz
+862
View File
@@ -0,0 +1,862 @@
-- |
-- Module : PostgREST.ApiRequest.QueryParams
-- Description : Parser for PostgREST Query parameters
--
-- This module is in charge of parsing all the querystring values in an url, e.g.
-- the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`.
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
module PostgREST.ApiRequest.QueryParams
( parse
, QueryParams(..)
, pRequestRange
) where
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashMap.Strict as HM
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Base as HTTP
import qualified Network.HTTP.Types.URI as HTTP
import qualified Text.ParserCombinators.Parsec as P
import Control.Arrow ((***))
import Data.Either.Combinators (mapLeft)
import Data.List (init, last)
import Data.Ranged.Boundaries (Boundary (..))
import Data.Ranged.Ranges (Range (..))
import Data.Tree (Tree (..))
import Text.Parsec.Error (errorMessages,
showErrorMessages)
import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser,
anyChar, between, char, choice,
digit, eof, errorPos, letter,
lookAhead, many1, noneOf,
notFollowedBy, oneOf,
optionMaybe, sepBy, sepBy1,
string, try, (<?>))
import PostgREST.RangeQuery (NonnegRange, allRange,
rangeGeq, rangeLimit,
rangeOffset, restrictRange)
import PostgREST.SchemaCache.Identifiers (FieldName)
import PostgREST.ApiRequest.Types (AggregateFunction (..),
EmbedParam (..), EmbedPath, Field,
Filter (..), FtsOperator (..),
Hint, JoinType (..),
JsonOperand (..),
JsonOperation (..), JsonPath,
ListVal, LogicOperator (..),
LogicTree (..), OpExpr (..),
OpQuantifier (..), Operation (..),
OrderDirection (..),
OrderNulls (..), OrderTerm (..),
QPError (..), QuantOperator (..),
SelectItem (..),
SimpleOperator (..), SingleVal,
TrileanVal (..))
import Protolude hiding (Sum, try)
data QueryParams =
QueryParams
{ qsCanonical :: ByteString
-- ^ Canonical representation of the query params, sorted alphabetically
, qsParams :: [(Text, Text)]
-- ^ Parameters for RPC calls
, qsRanges :: HM.HashMap Text (Range Integer)
-- ^ Ranges derived from &limit and &offset params
, qsOrder :: [(EmbedPath, [OrderTerm])]
-- ^ &order parameters for each level
, qsLogic :: [(EmbedPath, LogicTree)]
-- ^ &and and &or parameters used for complex boolean logic
, qsColumns :: Maybe (S.Set FieldName)
-- ^ &columns parameter and payload
, qsSelect :: [Tree SelectItem]
-- ^ &select parameter used to shape the response
, qsFilters :: [(EmbedPath, Filter)]
-- ^ Filters on the result from e.g. &id=e.10
, qsFiltersRoot :: [Filter]
-- ^ Subset of the filters that apply on the root table. These are used on UPDATE/DELETE.
, qsFiltersNotRoot :: [(EmbedPath, Filter)]
-- ^ Subset of the filters that do not apply on the root table
, qsFilterFields :: S.Set FieldName
-- ^ Set of fields that filters apply to
, qsOnConflict :: Maybe [FieldName]
-- ^ &on_conflict parameter used to upsert on specific unique keys
}
-- |
-- Parse query parameters from a query string like "id=eq.1&select=name".
--
-- The canonical representation of the query string has parameters sorted alphabetically:
--
-- >>> qsCanonical <$> parse True "a=1&c=3&b=2&d"
-- Right "a=1&b=2&c=3&d="
--
-- 'select' is a reserved parameter that selects the fields to be returned:
--
-- >>> qsSelect <$> parse False "select=name,location"
-- Right [Node {rootLabel = SelectField {selField = ("name",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SelectField {selField = ("location",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing}, subForest = []}]
--
-- Filters are parameters whose value contains an operator, separated by a '.' from its value:
--
-- >>> qsFilters <$> parse False "a.b=eq.0"
-- Right [(["a"],Filter {field = ("b",[]), opExpr = OpExpr False (OpQuant OpEqual Nothing "0")})]
--
-- If the operator specified in a filter does not exist, parsing the query string fails:
--
-- >>> qsFilters <$> parse False "a.b=noop.0"
-- Left (QPError "\"failed to parse filter (noop.0)\" (line 1, column 1)" "unexpected \"o\" expecting \"not\" or operator (eq, gt, ...)")
parse :: Bool -> ByteString -> Either QPError QueryParams
parse isRpcGet qs = do
rOrd <- pRequestOrder `traverse` order
rLogic <- pRequestLogicTree `traverse` logic
rCols <- pRequestColumns columns
rSel <- pRequestSelect select
(rFlts, params) <- L.partition hasOp <$> pRequestFilter isRpcGet `traverse` filters
(rFltsRoot, rFltsNotRoot) <- pure $ L.partition hasRootFilter rFlts
rOnConflict <- pRequestOnConflict `traverse` onConflict
let rFltsFields = S.fromList (fst <$> filters)
params' = mapMaybe (\case {(_, Filter (fld, _) (NoOpExpr v)) -> Just (fld,v); _ -> Nothing}) params
rFltsRoot' = snd <$> rFltsRoot
return $ QueryParams canonical params' ranges rOrd rLogic rCols rSel rFlts rFltsRoot' rFltsNotRoot rFltsFields rOnConflict
where
hasRootFilter, hasOp :: (EmbedPath, Filter) -> Bool
hasRootFilter ([], _) = True
hasRootFilter _ = False
hasOp (_, Filter (_, _) (NoOpExpr _)) = False
hasOp _ = True
logic = filter (endingIn ["and", "or"] . fst) nonemptyParams
select = fromMaybe "*" $ lookupParam "select"
onConflict = lookupParam "on_conflict"
columns = lookupParam "columns"
order = filter (endingIn ["order"] . fst) nonemptyParams
limits = filter (endingIn ["limit"] . fst) nonemptyParams
-- Replace .offset ending with .limit to be able to match those params later in a map
offsets = first (replaceLast "limit") <$> filter (endingIn ["offset"] . fst) nonemptyParams
lookupParam :: Text -> Maybe Text
lookupParam needle = toS <$> join (L.lookup needle qParams)
nonemptyParams = mapMaybe (\(k, v) -> (k,) <$> v) qParams
qString = HTTP.parseQueryReplacePlus True qs
qParams = [(T.decodeUtf8 k, T.decodeUtf8 <$> v)|(k,v) <- qString]
canonical =
BS.pack $ HTTP.urlEncodeVars
. L.sortOn fst
. map (join (***) BS.unpack . second (fromMaybe mempty))
$ qString
endingIn:: [Text] -> Text -> Bool
endingIn xx key = lastWord `elem` xx
where lastWord = L.last $ T.split (== '.') key
filters = filter (isFilter . fst) nonemptyParams
isFilter k = not (endingIn reservedEmbeddable k) && notElem k reserved
reserved = ["select", "columns", "on_conflict"]
reservedEmbeddable = ["order", "limit", "offset", "and", "or"]
replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) <> [x]
ranges :: HM.HashMap Text (Range Integer)
ranges = HM.unionWith f limitParams offsetParams
where
f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
where
l = fromMaybe 0 $ rangeLimit rl
o = rangeOffset ro
limitParams =
HM.fromList [(k, restrictRange (readMaybe v) allRange) | (k,v) <- limits]
offsetParams =
HM.fromList [(k, maybe allRange rangeGeq (readMaybe v)) | (k,v) <- offsets]
simpleOperator :: Parser SimpleOperator
simpleOperator =
try (string "neq" $> OpNotEqual) <|>
try (string "cs" $> OpContains) <|>
try (string "cd" $> OpContained) <|>
try (string "ov" $> OpOverlap) <|>
try (string "sl" $> OpStrictlyLeft) <|>
try (string "sr" $> OpStrictlyRight) <|>
try (string "nxr" $> OpNotExtendsRight) <|>
try (string "nxl" $> OpNotExtendsLeft) <|>
try (string "adj" $> OpAdjacent) <?>
"unknown single value operator"
quantOperator :: Parser QuantOperator
quantOperator =
try (string "eq" $> OpEqual) <|>
try (string "gte" $> OpGreaterThanEqual) <|>
try (string "gt" $> OpGreaterThan) <|>
try (string "lte" $> OpLessThanEqual) <|>
try (string "lt" $> OpLessThan) <|>
try (string "like" $> OpLike) <|>
try (string "ilike" $> OpILike) <|>
try (string "match" $> OpMatch) <|>
try (string "imatch" $> OpIMatch) <?>
"unknown single value operator"
pRequestSelect :: Text -> Either QPError [Tree SelectItem]
pRequestSelect selStr =
mapError $ P.parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
pRequestOnConflict :: Text -> Either QPError [FieldName]
pRequestOnConflict oncStr =
mapError $ P.parse pColumns ("failed to parse on_conflict parameter (" <> toS oncStr <> ")") (toS oncStr)
-- |
-- Parse `id=eq.1`(id, eq.1) into (EmbedPath, Filter)
--
-- >>> pRequestFilter False ("id", "eq.1")
-- Right ([],Filter {field = ("id",[]), opExpr = OpExpr False (OpQuant OpEqual Nothing "1")})
--
-- >>> pRequestFilter False ("id", "val")
-- Left (QPError "\"failed to parse filter (val)\" (line 1, column 1)" "unexpected \"v\" expecting \"not\" or operator (eq, gt, ...)")
--
-- >>> pRequestFilter True ("id", "val")
-- Right ([],Filter {field = ("id",[]), opExpr = NoOpExpr "val"})
pRequestFilter :: Bool -> (Text, Text) -> Either QPError (EmbedPath, Filter)
pRequestFilter isRpcGet (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
where
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
oper = P.parse parseFlt ("failed to parse filter (" ++ toS v ++ ")") $ toS v
parseFlt = if isRpcGet
then pOpExpr pSingleVal <|> pure (NoOpExpr v)
else pOpExpr pSingleVal
path = fst <$> treePath
fld = snd <$> treePath
pRequestOrder :: (Text, Text) -> Either QPError (EmbedPath, [OrderTerm])
pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
where
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
path = fst <$> treePath
ord' = P.parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
pRequestRange :: (Text, NonnegRange) -> Either QPError (EmbedPath, NonnegRange)
pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
where
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
path = fst <$> treePath
pRequestLogicTree :: (Text, Text) -> Either QPError (EmbedPath, LogicTree)
pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
where
path = P.parse pLogicPath ("failed to parse logic path (" ++ toS k ++ ")") $ toS k
embedPath = fst <$> path
logicTree = do
op <- snd <$> path
-- Concat op and v to make pLogicTree argument regular,
-- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
P.parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
pRequestColumns :: Maybe Text -> Either QPError (Maybe (S.Set FieldName))
pRequestColumns colStr =
case colStr of
Just str ->
mapError $ Just . S.fromList <$> P.parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str)
_ -> Right Nothing
ws :: Parser Text
ws = toS <$> many (oneOf " \t")
lexeme :: Parser a -> Parser a
lexeme p = ws *> p <* ws
pTreePath :: Parser (EmbedPath, Field)
pTreePath = do
p <- pFieldName `sepBy1` pDelimiter
jp <- P.option [] pJsonPath
return (init p, (last p, jp))
-- |
-- Parse select= into a Forest of SelectItems
--
-- >>> P.parse pFieldForest "" "id"
-- Right [Node {rootLabel = SelectField {selField = ("id",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing}, subForest = []}]
--
-- >>> P.parse pFieldForest "" "client(id)"
-- Right [Node {rootLabel = SelectRelation {selRelation = "client", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("id",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing}, subForest = []}]}]
--
-- >>> P.parse pFieldForest "" "*,client(*,nested(*))"
-- Right [Node {rootLabel = SelectField {selField = ("*",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SelectRelation {selRelation = "client", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("*",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SelectRelation {selRelation = "nested", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("*",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing}, subForest = []}]}]}]
--
-- >>> P.parse pFieldForest "" "*,...client(*),other(*)"
-- Right [Node {rootLabel = SelectField {selField = ("*",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SpreadRelation {selRelation = "client", selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("*",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing}, subForest = []}]},Node {rootLabel = SelectRelation {selRelation = "other", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("*",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing}, subForest = []}]}]
--
-- >>> P.parse pFieldForest "" ""
-- Right []
--
-- >>> P.parse pFieldForest "" "id,clients(name[])"
-- Left (line 1, column 16):
-- unexpected '['
-- expecting letter, digit, "-", "->>", "->", "::", ".", ")", "," or end of input
--
-- >>> P.parse pFieldForest "" "data->>-78xy"
-- Left (line 1, column 11):
-- unexpected 'x'
-- expecting digit, "->", "::", ".", "," or end of input
pFieldForest :: Parser [Tree SelectItem]
pFieldForest = pFieldTree `sepBy` lexeme (char ',')
where
pFieldTree = Node <$> try pSpreadRelationSelect <*> between (char '(') (char ')') pFieldForest <|>
Node <$> try pRelationSelect <*> between (char '(') (char ')') pFieldForest <|>
Node <$> pFieldSelect <*> pure []
-- |
-- Parse field names
--
-- >>> P.parse pFieldName "" "identifier"
-- Right "identifier"
--
-- >>> P.parse pFieldName "" "identifier with spaces"
-- Right "identifier with spaces"
--
-- >>> P.parse pFieldName "" "identifier-with-dashes"
-- Right "identifier-with-dashes"
--
-- >>> P.parse pFieldName "" "123"
-- Right "123"
--
-- >>> P.parse pFieldName "" "_"
-- Right "_"
--
-- >>> P.parse pFieldName "" "$"
-- Right "$"
--
-- >>> P.parse pFieldName "" ":"
-- Left (line 1, column 1):
-- unexpected ":"
-- expecting field name (* or [a..z0..9_$])
--
-- >>> P.parse pFieldName "" "\":\""
-- Right ":"
--
-- >>> P.parse pFieldName "" " no leading or trailing spaces "
-- Right "no leading or trailing spaces"
--
-- >>> P.parse pFieldName "" "\" leading and trailing spaces \""
-- Right " leading and trailing spaces "
pFieldName :: Parser Text
pFieldName =
pQuotedValue <|>
sepByDash pIdentifier <?>
"field name (* or [a..z0..9_$])"
sepByDash :: Parser Text -> Parser Text
sepByDash fieldIdent =
T.intercalate "-" . map toS <$> (fieldIdent `sepBy1` dash)
where
isDash :: GenParser Char st ()
isDash = try ( char '-' >> notFollowedBy (char '>') )
dash :: Parser Char
dash = isDash $> '-'
-- |
-- Parse json operators in select, order and filters
--
-- >>> P.parse pJsonPath "" "->text"
-- Right [JArrow {jOp = JKey {jVal = "text"}}]
--
-- >>> P.parse pJsonPath "" "->!@#$%^&*_a"
-- Right [JArrow {jOp = JKey {jVal = "!@#$%^&*_a"}}]
--
-- >>> P.parse pJsonPath "" "->1"
-- Right [JArrow {jOp = JIdx {jVal = "+1"}}]
--
-- >>> P.parse pJsonPath "" "->>text"
-- Right [J2Arrow {jOp = JKey {jVal = "text"}}]
--
-- >>> P.parse pJsonPath "" "->>!@#$%^&*_a"
-- Right [J2Arrow {jOp = JKey {jVal = "!@#$%^&*_a"}}]
--
-- >>> P.parse pJsonPath "" "->>1"
-- Right [J2Arrow {jOp = JIdx {jVal = "+1"}}]
--
-- >>> P.parse pJsonPath "" "->0,other"
-- Right [JArrow {jOp = JIdx {jVal = "+0"}}]
--
-- >>> P.parse pJsonPath "" "->0.desc"
-- Right [JArrow {jOp = JIdx {jVal = "+0"}}]
--
-- Fails on badly formed negatives
--
-- >>> P.parse pJsonPath "" "->>-78xy"
-- Left (line 1, column 7):
-- unexpected 'x'
-- expecting digit, "->", "::", ".", "," or end of input
--
-- >>> P.parse pJsonPath "" "->>--34"
-- Left (line 1, column 5):
-- unexpected "-"
-- expecting digit
--
-- >>> P.parse pJsonPath "" "->>-xy-4"
-- Left (line 1, column 5):
-- unexpected "x"
-- expecting digit
pJsonPath :: Parser JsonPath
pJsonPath = many pJsonOperation
where
pJsonOperation :: Parser JsonOperation
pJsonOperation = pJsonArrow <*> pJsonOperand
pJsonArrow =
try (string "->>" $> J2Arrow) <|>
try (string "->" $> JArrow)
pJsonOperand =
let pJKey = JKey . toS <$> pJsonKeyName
pJIdx = JIdx . toS <$> ((:) <$> P.option '+' (char '-') <*> many1 digit) <* pEnd
pEnd = try (void $ lookAhead (string "->")) <|>
try (void $ lookAhead (string "::")) <|>
try (void $ lookAhead (string ".")) <|>
try (void $ lookAhead (string ",")) <|>
try eof in
try pJIdx <|> try pJKey
pJsonKeyName :: Parser Text
pJsonKeyName =
pQuotedValue <|>
sepByDash pJsonKeyIdentifier <?>
"any non reserved character different from: .,>()"
pJsonKeyIdentifier :: Parser Text
pJsonKeyIdentifier = T.strip . toS <$> many1 (noneOf "(-:.,>)")
pField :: Parser Field
pField = lexeme $ (,) <$> pFieldName <*> P.option [] pJsonPath
aliasSeparator :: Parser ()
aliasSeparator = char ':' >> notFollowedBy (char ':')
-- |
-- Parse regular fields in select
--
-- >>> P.parse pRelationSelect "" "rel(*)"
-- Right (SelectRelation {selRelation = "rel", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing})
--
-- >>> P.parse pRelationSelect "" "alias:rel(*)"
-- Right (SelectRelation {selRelation = "rel", selAlias = Just "alias", selHint = Nothing, selJoinType = Nothing})
--
-- >>> P.parse pRelationSelect "" "rel!hint(*)"
-- Right (SelectRelation {selRelation = "rel", selAlias = Nothing, selHint = Just "hint", selJoinType = Nothing})
--
-- >>> P.parse pRelationSelect "" "rel!inner(*)"
-- Right (SelectRelation {selRelation = "rel", selAlias = Nothing, selHint = Nothing, selJoinType = Just JTInner})
--
-- >>> P.parse pRelationSelect "" "rel!hint!inner(*)"
-- Right (SelectRelation {selRelation = "rel", selAlias = Nothing, selHint = Just "hint", selJoinType = Just JTInner})
--
-- >>> P.parse pRelationSelect "" "alias:rel!inner!hint(*)"
-- Right (SelectRelation {selRelation = "rel", selAlias = Just "alias", selHint = Just "hint", selJoinType = Just JTInner})
--
-- >>> P.parse pRelationSelect "" "rel->jsonpath(*)"
-- Left (line 1, column 6):
-- unexpected '>'
--
-- >>> P.parse pRelationSelect "" "rel->jsonpath!hint(*)"
-- Left (line 1, column 6):
-- unexpected '>'
pRelationSelect :: Parser SelectItem
pRelationSelect = lexeme $ do
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
name <- pFieldName
guard (name /= "count")
(hint, jType) <- pEmbedParams
try (void $ lookAhead (string "("))
return $ SelectRelation name alias hint jType
-- |
-- Parse regular fields in select
--
-- >>> P.parse pFieldSelect "" "name"
-- Right (SelectField {selField = ("name",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing})
--
-- >>> P.parse pFieldSelect "" "name->jsonpath"
-- Right (SelectField {selField = ("name",[JArrow {jOp = JKey {jVal = "jsonpath"}}]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing})
--
-- >>> P.parse pFieldSelect "" "name::cast"
-- Right (SelectField {selField = ("name",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Just "cast", selAlias = Nothing})
--
-- >>> P.parse pFieldSelect "" "alias:name"
-- Right (SelectField {selField = ("name",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Just "alias"})
--
-- >>> P.parse pFieldSelect "" "alias:name->jsonpath::cast"
-- Right (SelectField {selField = ("name",[JArrow {jOp = JKey {jVal = "jsonpath"}}]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Just "cast", selAlias = Just "alias"})
--
-- >>> P.parse pFieldSelect "" "alias:name->!@#$%^&*_a::cast"
-- Right (SelectField {selField = ("name",[JArrow {jOp = JKey {jVal = "!@#$%^&*_a"}}]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Just "cast", selAlias = Just "alias"})
--
-- >>> P.parse pFieldSelect "" "*"
-- Right (SelectField {selField = ("*",[]), selAggregateFunction = Nothing, selAggregateCast = Nothing, selCast = Nothing, selAlias = Nothing})
--
-- >>> P.parse pFieldSelect "" "name!hint"
-- Left (line 1, column 5):
-- unexpected '!'
-- expecting letter, digit, "-", "->>", "->", "::", ".", ")", "," or end of input
--
-- >>> P.parse pFieldSelect "" "*!hint"
-- Left (line 1, column 2):
-- unexpected '!'
-- expecting ")", "," or end of input
--
-- >>> P.parse pFieldSelect "" "name::"
-- Left (line 1, column 7):
-- unexpected end of input
-- expecting letter or digit
pFieldSelect :: Parser SelectItem
pFieldSelect = lexeme $ try (do
s <- pStar
pEnd
return $ SelectField (s, []) Nothing Nothing Nothing Nothing)
<|> try (do
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
_ <- string "count()"
aggCast' <- optionMaybe (string "::" *> pIdentifier)
pEnd
return $ SelectField ("*", []) (Just Count) (toS <$> aggCast') Nothing alias)
<|> do
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
fld <- pField
cast' <- optionMaybe (string "::" *> pIdentifier)
agg <- optionMaybe (try (char '.' *> pAggregation <* string "()"))
aggCast' <- optionMaybe (string "::" *> pIdentifier)
pEnd
return $ SelectField fld agg (toS <$> aggCast') (toS <$> cast') alias
where
pEnd = try (void $ lookAhead (string ")")) <|>
try (void $ lookAhead (string ",")) <|>
try eof
pStar = string "*" $> "*"
pAggregation = choice
[ string "sum" $> Sum
, string "avg" $> Avg
, string "count" $> Count
-- Using 'try' for "min" and "max" to allow backtracking.
-- This is necessary because both start with the same character 'm',
-- and without 'try', a partial match on "max" would prevent "min" from being tried.
, try (string "max") $> Max
, try (string "min") $> Min
]
-- |
-- Parse spread relations in select
--
-- >>> P.parse pSpreadRelationSelect "" "...rel(*)"
-- Right (SpreadRelation {selRelation = "rel", selHint = Nothing, selJoinType = Nothing})
--
-- >>> P.parse pSpreadRelationSelect "" "...rel!hint!inner(*)"
-- Right (SpreadRelation {selRelation = "rel", selHint = Just "hint", selJoinType = Just JTInner})
--
-- >>> P.parse pSpreadRelationSelect "" "rel(*)"
-- Left (line 1, column 1):
-- unexpected "r"
-- expecting "..."
--
-- >>> P.parse pSpreadRelationSelect "" "alias:...rel(*)"
-- Left (line 1, column 1):
-- unexpected "a"
-- expecting "..."
--
-- >>> P.parse pSpreadRelationSelect "" "...rel->jsonpath(*)"
-- Left (line 1, column 9):
-- unexpected '>'
pSpreadRelationSelect :: Parser SelectItem
pSpreadRelationSelect = lexeme $ do
name <- string "..." >> pFieldName
(hint, jType) <- pEmbedParams
try (void $ lookAhead (string "("))
return $ SpreadRelation name hint jType
pEmbedParams :: Parser (Maybe Hint, Maybe JoinType)
pEmbedParams = do
prm1 <- optionMaybe pEmbedParam
prm2 <- optionMaybe pEmbedParam
return (embedParamHint prm1 <|> embedParamHint prm2, embedParamJoin prm1 <|> embedParamJoin prm2)
where
pEmbedParam :: Parser EmbedParam
pEmbedParam =
char '!' *> (
try (string "left" $> EPJoinType JTLeft) <|>
try (string "inner" $> EPJoinType JTInner) <|>
try (EPHint <$> pFieldName))
embedParamHint prm = case prm of
Just (EPHint hint) -> Just hint
_ -> Nothing
embedParamJoin prm = case prm of
Just (EPJoinType jt) -> Just jt
_ -> Nothing
-- |
-- Parse operator expression used in horizontal filtering
--
-- >>> P.parse (pOpExpr pSingleVal) "" "fts().value"
-- Left (line 1, column 5):
-- unexpected ")"
-- expecting operator (eq, gt, ...)
--
-- >>> P.parse (pOpExpr pSingleVal) "" "eq(any).value"
-- Right (OpExpr False (OpQuant OpEqual (Just QuantAny) "value"))
--
-- >>> P.parse (pOpExpr pSingleVal) "" "eq(all).value"
-- Right (OpExpr False (OpQuant OpEqual (Just QuantAll) "value"))
--
-- >>> P.parse (pOpExpr pSingleVal) "" "not.eq(all).value"
-- Right (OpExpr True (OpQuant OpEqual (Just QuantAll) "value"))
--
-- >>> P.parse (pOpExpr pSingleVal) "" "eq().value"
-- Left (line 1, column 4):
-- unexpected ")"
-- expecting operator (eq, gt, ...)
--
-- >>> P.parse (pOpExpr pSingleVal) "" "is().value"
-- Left (line 1, column 3):
-- unexpected "("
-- expecting operator (eq, gt, ...)
--
-- >>> P.parse (pOpExpr pSingleVal) "" "in().value"
-- Left (line 1, column 3):
-- unexpected "("
-- expecting operator (eq, gt, ...)
pOpExpr :: Parser SingleVal -> Parser OpExpr
pOpExpr pSVal = do
boolExpr <- try (string "not" *> pDelimiter $> True) <|> pure False
OpExpr boolExpr <$> pOperation
where
pOperation :: Parser Operation
pOperation = pIn <|> pIs <|> pIsDist <|> try pFts <|> try pSimpleOp <|> try pQuantOp <?> "operator (eq, gt, ...)"
pIn = In <$> (try (string "in" *> pDelimiter) *> pListVal)
pIs = Is <$> (try (string "is" *> pDelimiter) *> pTriVal)
pIsDist = IsDistinctFrom <$> (try (string "isdistinct" *> pDelimiter) *> pSVal)
pSimpleOp = do
op <- simpleOperator
pDelimiter *> (Op op <$> pSVal)
pQuantOp = do
op <- quantOperator
quant <- optionMaybe $ try (between (char '(') (char ')') (try (string "any" $> QuantAny) <|> string "all" $> QuantAll))
pDelimiter *> (OpQuant op quant <$> pSVal)
pTriVal = try (ciString "null" $> TriNull)
<|> try (ciString "unknown" $> TriUnknown)
<|> try (ciString "true" $> TriTrue)
<|> try (ciString "false" $> TriFalse)
<?> "null or trilean value (unknown, true, false)"
pFts = do
op <- try (string "fts" $> FilterFts)
<|> try (string "plfts" $> FilterFtsPlain)
<|> try (string "phfts" $> FilterFtsPhrase)
<|> try (string "wfts" $> FilterFtsWebsearch)
lang <- optionMaybe $ try (between (char '(') (char ')') pIdentifier)
pDelimiter >> Fts op (toS <$> lang) <$> pSVal
-- case insensitive char and string
ciChar :: Char -> GenParser Char state Char
ciChar c = char c <|> char (toUpper c)
ciString :: [Char] -> GenParser Char state [Char]
ciString = traverse ciChar
pSingleVal :: Parser SingleVal
pSingleVal = toS <$> many anyChar
pListVal :: Parser ListVal
pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
pListElement :: Parser Text
pListElement = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)"))
pQuotedValue :: Parser Text
pQuotedValue = toS <$> (char '"' *> many pCharsOrSlashed <* char '"')
where
pCharsOrSlashed = noneOf "\\\"" <|> (char '\\' *> anyChar)
pDelimiter :: Parser Char
pDelimiter = char '.' <?> "delimiter (.)"
-- |
-- Parses the elements in the order query parameter
--
-- >>> P.parse pOrder "" "name.desc.nullsfirst"
-- Right [OrderTerm {otTerm = ("name",[]), otDirection = Just OrderDesc, otNullOrder = Just OrderNullsFirst}]
--
-- >>> P.parse pOrder "" "json_col->key.asc.nullslast"
-- Right [OrderTerm {otTerm = ("json_col",[JArrow {jOp = JKey {jVal = "key"}}]), otDirection = Just OrderAsc, otNullOrder = Just OrderNullsLast}]
--
-- >>> P.parse pOrder "" "json_col->!@#$%^&*_a.asc.nullslast"
-- Right [OrderTerm {otTerm = ("json_col",[JArrow {jOp = JKey {jVal = "!@#$%^&*_a"}}]), otDirection = Just OrderAsc, otNullOrder = Just OrderNullsLast}]
--
-- >>> P.parse pOrder "" "clients(json_col->key).desc.nullsfirst"
-- Right [OrderRelationTerm {otRelation = "clients", otRelTerm = ("json_col",[JArrow {jOp = JKey {jVal = "key"}}]), otDirection = Just OrderDesc, otNullOrder = Just OrderNullsFirst}]
--
-- >>> P.parse pOrder "" "clients(json_col->!@#$%^&*_a).desc.nullsfirst"
-- Right [OrderRelationTerm {otRelation = "clients", otRelTerm = ("json_col",[JArrow {jOp = JKey {jVal = "!@#$%^&*_a"}}]), otDirection = Just OrderDesc, otNullOrder = Just OrderNullsFirst}]
--
-- >>> P.parse pOrder "" "clients(name,id)"
-- Left (line 1, column 8):
-- unexpected '('
-- expecting letter, digit, "-", "->>", "->", delimiter (.), "," or end of input
--
-- >>> P.parse pOrder "" "name,clients(name),id"
-- Right [OrderTerm {otTerm = ("name",[]), otDirection = Nothing, otNullOrder = Nothing},OrderRelationTerm {otRelation = "clients", otRelTerm = ("name",[]), otDirection = Nothing, otNullOrder = Nothing},OrderTerm {otTerm = ("id",[]), otDirection = Nothing, otNullOrder = Nothing}]
--
-- >>> P.parse pOrder "" "id.ac"
-- Left (line 1, column 4):
-- unexpected "c"
-- expecting "asc", "desc", "nullsfirst" or "nullslast"
--
-- >>> P.parse pOrder "" "id.descc"
-- Left (line 1, column 8):
-- unexpected 'c'
-- expecting delimiter (.), "," or end of input
--
-- >>> P.parse pOrder "" "id.nulsfist"
-- Left (line 1, column 4):
-- unexpected "n"
-- expecting "asc", "desc", "nullsfirst" or "nullslast"
--
-- >>> P.parse pOrder "" "id.nullslasttt"
-- Left (line 1, column 13):
-- unexpected 't'
-- expecting "," or end of input
--
-- >>> P.parse pOrder "" "id.smth34"
-- Left (line 1, column 4):
-- unexpected "s"
-- expecting "asc", "desc", "nullsfirst" or "nullslast"
--
-- >>> P.parse pOrder "" "id.asc.nlsfst"
-- Left (line 1, column 8):
-- unexpected "l"
-- expecting "nullsfirst" or "nullslast"
--
-- >>> P.parse pOrder "" "id.asc.nullslasttt"
-- Left (line 1, column 17):
-- unexpected 't'
-- expecting "," or end of input
--
-- >>> P.parse pOrder "" "id.asc.smth34"
-- Left (line 1, column 8):
-- unexpected "s"
-- expecting "nullsfirst" or "nullslast"
pOrder :: Parser [OrderTerm]
pOrder = lexeme (try pOrderRelationTerm <|> pOrderTerm) `sepBy1` char ','
where
pOrderTerm = do
fld <- pField
dir <- optionMaybe pOrdDir
nls <- optionMaybe pNulls <* pEnd <|>
pEnd $> Nothing
return $ OrderTerm fld dir nls
pOrderRelationTerm = do
nam <- pFieldName
fld <- between (char '(') (char ')') pField
dir <- optionMaybe pOrdDir
nls <- optionMaybe pNulls <* pEnd <|> pEnd $> Nothing
return $ OrderRelationTerm nam fld dir nls
pNulls :: Parser OrderNulls
pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|>
try (pDelimiter *> string "nullslast" $> OrderNullsLast)
pOrdDir :: Parser OrderDirection
pOrdDir = try (pDelimiter *> string "asc" $> OrderAsc) <|>
try (pDelimiter *> string "desc" $> OrderDesc)
pEnd = try (void $ lookAhead (char ',')) <|> try eof
-- |
-- Parses the elements inside or/and
--
-- >>> P.parse pLogicTree "" "or()"
-- Left (line 1, column 4):
-- unexpected ")"
-- expecting field name (* or [a..z0..9_$]), negation operator (not) or logic operator (and, or)
--
-- >>> P.parse pLogicTree "" "or(id.in.1,2,id.eq.3)"
-- Left (line 1, column 10):
-- unexpected "1"
-- expecting "("
--
-- >>> P.parse pLogicTree "" "or)("
-- Left (line 1, column 3):
-- unexpected ")"
-- expecting "("
--
-- >>> P.parse pLogicTree "" "and(ord(id.eq.1,id.eq.1),id.eq.2)"
-- Left (line 1, column 7):
-- unexpected "d"
-- expecting "("
--
-- >>> P.parse pLogicTree "" "or(id.eq.1,not.xor(id.eq.2,id.eq.3))"
-- Left (line 1, column 16):
-- unexpected "x"
-- expecting logic operator (and, or)
pLogicTree :: Parser LogicTree
pLogicTree = Stmnt <$> try pLogicFilter
<|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')'))
where
pLogicFilter :: Parser Filter
pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
pNot :: Parser Bool
pNot = try (string "not" *> pDelimiter $> True)
<|> pure False
<?> "negation operator (not)"
pLogicOp :: Parser LogicOperator
pLogicOp = try (string "and" $> And)
<|> string "or" $> Or
<?> "logic operator (and, or)"
pLogicSingleVal :: Parser SingleVal
pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
where
pPgArray :: Parser Text
pPgArray = do
a <- string "{"
b <- many (noneOf "{}")
c <- string "}"
pure (toS $ a ++ b ++ c)
pLogicPath :: Parser (EmbedPath, Text)
pLogicPath = do
path <- pFieldName `sepBy1` pDelimiter
let op = last path
notOp = "not." <> op
return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
pColumns :: Parser [FieldName]
pColumns = pFieldName `sepBy1` lexeme (char ',')
pIdentifier :: Parser Text
pIdentifier = T.strip . toS <$> many1 pIdentifierChar
pIdentifierChar :: Parser Char
pIdentifierChar = letter <|> digit <|> oneOf "_ $"
mapError :: Either ParseError a -> Either QPError a
mapError = mapLeft translateError
where
translateError e =
QPError message details
where
message = show $ errorPos e
details = T.strip $ T.replace "\n" " " $ toS
$ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
@@ -1,6 +1,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
module PostgREST.Request.Types
( Alias
module PostgREST.ApiRequest.Types
( AggregateFunction(..)
, Alias
, Cast
, Depth
, EmbedParam(..)
@@ -9,10 +10,6 @@ module PostgREST.Request.Types
, Field
, Filter(..)
, Hint
, CallQuery(..)
, CallParams(..)
, CallRequest
, JoinCondition(..)
, JoinType(..)
, JsonOperand(..)
, JsonOperation(..)
@@ -23,96 +20,127 @@ module PostgREST.Request.Types
, NodeName
, OpExpr(..)
, Operation (..)
, OpQuantifier(..)
, OrderDirection(..)
, OrderNulls(..)
, OrderTerm(..)
, QPError(..)
, RangeError(..)
, SingleVal
, TrileanVal(..)
, SimpleOperator(..)
, QuantOperator(..)
, FtsOperator(..)
, SelectItem(..)
) where
import qualified Data.ByteString.Lazy as LBS
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcParam (..))
import PostgREST.DbStructure.Relationship (Relationship)
import PostgREST.MediaType (MediaType (..))
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.SchemaCache.Relationship (Relationship,
RelationshipsMap)
import PostgREST.SchemaCache.Routine (Routine (..))
import Protolude
-- | The value in `/tbl?select=alias:field.aggregateFunction()::cast`
data SelectItem
= SelectField
{ selField :: Field
, selAggregateFunction :: Maybe AggregateFunction
, selAggregateCast :: Maybe Cast
, selCast :: Maybe Cast
, selAlias :: Maybe Alias
}
-- | The value in `/tbl?select=alias:another_tbl(*)`
| SelectRelation
{ selRelation :: FieldName
, selAlias :: Maybe Alias
, selHint :: Maybe Hint
, selJoinType :: Maybe JoinType
}
-- | The value in `/tbl?select=...another_tbl(*)`
| SpreadRelation
{ selRelation :: FieldName
, selHint :: Maybe Hint
, selJoinType :: Maybe JoinType
}
deriving (Eq, Show)
data ApiRequestError
= AmbiguousRelBetween Text Text [Relationship]
| AmbiguousRpc [ProcDescription]
= AggregatesNotAllowed
| AmbiguousRelBetween Text Text [Relationship]
| AmbiguousRpc [Routine]
| MediaTypeError [ByteString]
| InvalidBody ByteString
| InvalidFilters
| InvalidRange
| InvalidPreferences [ByteString]
| InvalidRange RangeError
| InvalidRpcMethod ByteString
| LimitNoOrderError
| NotFound
| NoRelBetween Text Text Text
| NoRpc Text Text [Text] Bool MediaType Bool
| NoRelBetween Text Text (Maybe Text) Text RelationshipsMap
| NoRpc Text Text [Text] Bool MediaType Bool [QualifiedIdentifier] [Routine]
| NotEmbedded Text
| ParseRequestError Text Text
| PutRangeNotAllowedError
| PutLimitNotAllowedError
| QueryParamError QPError
| RelatedOrderNotToOne Text Text
| SpreadNotToOne Text Text
| UnacceptableFilter Text
| UnacceptableSchema [Text]
| UnsupportedMethod ByteString
| ColumnNotFound Text Text
| GucHeadersError
| GucStatusError
| OffLimitsChangesError Int64 Integer
| PutMatchingPkError
| SingularityError Integer
| PGRSTParseError
deriving Show
data QPError = QPError Text Text
type CallRequest = CallQuery
deriving Show
data RangeError
= NegativeLimit
| LowerGTUpper
| OutOfBounds Text Text
deriving Show
type NodeName = Text
type Depth = Integer
data JoinCondition =
JoinCondition
(QualifiedIdentifier, FieldName)
(QualifiedIdentifier, FieldName)
deriving (Eq)
data OrderTerm = OrderTerm
{ otTerm :: Field
, otDirection :: Maybe OrderDirection
, otNullOrder :: Maybe OrderNulls
}
deriving (Eq)
data OrderTerm
= OrderTerm
{ otTerm :: Field
, otDirection :: Maybe OrderDirection
, otNullOrder :: Maybe OrderNulls
}
| OrderRelationTerm
{ otRelation :: FieldName
, otRelTerm :: Field
, otDirection :: Maybe OrderDirection
, otNullOrder :: Maybe OrderNulls
}
deriving (Eq, Show)
data OrderDirection
= OrderAsc
| OrderDesc
deriving (Eq)
deriving (Eq, Show)
data OrderNulls
= OrderNullsFirst
| OrderNullsLast
deriving (Eq)
data CallQuery = FunctionCall
{ funCQi :: QualifiedIdentifier
, funCParams :: CallParams
, funCArgs :: Maybe LBS.ByteString
, funCScalar :: Bool
, funCMultipleCall :: Bool
, funCReturning :: [FieldName]
}
data CallParams
= KeyParams [ProcParam] -- ^ Call with key params: func(a := val1, b:= val2)
| OnePosParam ProcParam -- ^ Call with positional params(only one supported): func(val)
deriving (Eq, Show)
type Field = (FieldName, JsonPath)
type Cast = Text
type Alias = Text
type Hint = Text
data AggregateFunction = Sum | Avg | Max | Min | Count
deriving (Show, Eq)
data EmbedParam
-- | Disambiguates an embedding operation when there's multiple relationships
-- between two tables. Can be the name of a foreign key constraint, column
@@ -123,7 +151,7 @@ data EmbedParam
data JoinType
= JTInner
| JTLeft
deriving Eq
deriving (Eq, Show)
-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path
-- ["clients", "projects"]
@@ -137,7 +165,7 @@ type JsonPath = [JsonOperation]
data JsonOperation
= JArrow { jOp :: JsonOperand }
| J2Arrow { jOp :: JsonOperand }
deriving (Eq)
deriving (Eq, Show, Ord)
-- | Represents the key(`->'key'`) or index(`->'1`::int`), the index is Text
-- because we reuse our escaping functons and let pg do the casting with
@@ -145,7 +173,7 @@ data JsonOperation
data JsonOperand
= JKey { jVal :: Text }
| JIdx { jVal :: Text }
deriving (Eq)
deriving (Eq, Show, Ord)
-- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
--
@@ -157,29 +185,36 @@ data JsonOperand
data LogicTree
= Expr Bool LogicOperator [LogicTree]
| Stmnt Filter
deriving (Eq)
deriving (Eq, Show)
data LogicOperator
= And
| Or
deriving Eq
deriving (Eq, Show)
data Filter = Filter
data Filter
= Filter
{ field :: Field
, opExpr :: OpExpr
}
deriving (Eq)
deriving (Eq, Show)
data OpExpr =
OpExpr Bool Operation
deriving (Eq)
data OpExpr
= OpExpr Bool Operation
| NoOpExpr Text
deriving (Eq, Show)
data OpQuantifier = QuantAny | QuantAll
deriving (Eq, Show)
data Operation
= Op SimpleOperator SingleVal
| OpQuant QuantOperator (Maybe OpQuantifier) SingleVal
| In ListVal
| Is TrileanVal
| IsDistinctFrom SingleVal
| Fts FtsOperator (Maybe Language) SingleVal
deriving (Eq)
deriving (Eq, Show)
type Language = Text
@@ -195,17 +230,23 @@ data TrileanVal
| TriFalse
| TriNull
| TriUnknown
deriving Eq
deriving (Eq, Show)
data SimpleOperator
-- Operators that are quantifiable, i.e. they can be used with the any/all modifiers
data QuantOperator
= OpEqual
| OpGreaterThanEqual
| OpGreaterThan
| OpLessThanEqual
| OpLessThan
| OpNotEqual
| OpLike
| OpILike
| OpMatch
| OpIMatch
deriving (Eq, Show)
data SimpleOperator
= OpNotEqual
| OpContains
| OpContained
| OpOverlap
@@ -214,14 +255,13 @@ data SimpleOperator
| OpNotExtendsRight
| OpNotExtendsLeft
| OpAdjacent
| OpMatch
| OpIMatch
deriving Eq
deriving (Eq, Show)
--
-- | Operators for full text search operators
data FtsOperator
= FilterFts
| FilterFtsPlain
| FilterFtsPhrase
| FilterFtsWebsearch
deriving Eq
deriving (Eq, Show)
+172 -567
View File
@@ -9,137 +9,83 @@ Some of its functionality includes:
- Producing HTTP Headers according to RFCs.
- Content Negotiation
-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.App
( SignalHandlerInstaller
, SocketRunner
, postgrest
( postgrest
, run
) where
import Control.Monad.Except (liftEither)
import Data.Either.Combinators (mapLeft)
import Data.List (union)
import Data.Maybe (fromJust)
import Data.String (IsString (..))
import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
setServerName)
import System.Posix.Types (FileMode)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S
import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
import qualified Hasql.Transaction as SQL
import qualified Hasql.Transaction.Sessions as SQL
import qualified Network.HTTP.Types.Header as HTTP
import qualified Network.HTTP.Types.Status as HTTP
import qualified Network.HTTP.Types.URI as HTTP
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified Data.HashMap.Strict as HM
import qualified Data.Text.Encoding as T
import qualified Hasql.Transaction.Sessions as SQL
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified PostgREST.Admin as Admin
import qualified PostgREST.AppState as AppState
import qualified PostgREST.Auth as Auth
import qualified PostgREST.Cors as Cors
import qualified PostgREST.DbStructure as DbStructure
import qualified PostgREST.Error as Error
import qualified PostgREST.Logger as Logger
import qualified PostgREST.Middleware as Middleware
import qualified PostgREST.OpenAPI as OpenAPI
import qualified PostgREST.Query.QueryBuilder as QueryBuilder
import qualified PostgREST.Query.Statements as Statements
import qualified PostgREST.RangeQuery as RangeQuery
import qualified PostgREST.Request.ApiRequest as ApiRequest
import qualified PostgREST.Request.DbRequestBuilder as ReqBuilder
import qualified PostgREST.Request.Types as ApiRequestTypes
import qualified PostgREST.Admin as Admin
import qualified PostgREST.ApiRequest as ApiRequest
import qualified PostgREST.ApiRequest.Types as ApiRequestTypes
import qualified PostgREST.AppState as AppState
import qualified PostgREST.Auth as Auth
import qualified PostgREST.Cors as Cors
import qualified PostgREST.Error as Error
import qualified PostgREST.Logger as Logger
import qualified PostgREST.Plan as Plan
import qualified PostgREST.Query as Query
import qualified PostgREST.Response as Response
import qualified PostgREST.Unix as Unix (installSignalHandlers)
import PostgREST.AppState (AppState)
import PostgREST.Auth (AuthResult (..))
import PostgREST.Config (AppConfig (..),
LogLevel (..),
OpenAPIMode (..))
import PostgREST.Config.PgVersion (PgVersion (..))
import PostgREST.DbStructure (DbStructure (..))
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema)
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcVolatility (..))
import PostgREST.DbStructure.Table (Table (..))
import PostgREST.Error (Error)
import PostgREST.GucHeader (GucHeader,
addHeadersIfNotIncluded,
unwrapGucHeader)
import PostgREST.MediaType (MTPlanAttrs (..),
MediaType (..))
import PostgREST.Query.Statements (ResultSet (..))
import PostgREST.Request.ApiRequest (Action (..),
ApiRequest (..),
InvokeMethod (..),
Mutation (..), Target (..))
import PostgREST.Request.Preferences (PreferCount (..),
PreferParameters (..),
PreferRepresentation (..),
toAppliedHeader)
import PostgREST.Request.QueryParams (QueryParams (..))
import PostgREST.Request.ReadQuery (ReadRequest, fstFieldNames)
import PostgREST.Version (prettyVersion)
import PostgREST.Workers (connectionWorker, listener)
import PostgREST.ApiRequest (Action (..), ApiRequest (..),
Mutation (..), Target (..))
import PostgREST.AppState (AppState)
import PostgREST.Auth (AuthResult (..))
import PostgREST.Config (AppConfig (..))
import PostgREST.Config.PgVersion (PgVersion (..))
import PostgREST.Error (Error)
import PostgREST.Query (DbHandler)
import PostgREST.Response.Performance (ServerTiming (..),
serverTimingHeader)
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Routine (Routine (..))
import PostgREST.Version (docsVersion, prettyVersion)
import qualified PostgREST.DbStructure.Proc as Proc
import qualified PostgREST.MediaType as MediaType
import Protolude hiding (Handler)
data RequestContext = RequestContext
{ ctxConfig :: AppConfig
, ctxDbStructure :: DbStructure
, ctxApiRequest :: ApiRequest
, ctxPgVersion :: PgVersion
}
import qualified Data.ByteString.Char8 as BS
import qualified Data.List as L
import qualified Network.HTTP.Types as HTTP
import qualified Network.Socket as NS
import Protolude hiding (Handler)
import System.TimeIt (timeItT)
type Handler = ExceptT Error
type DbHandler = Handler SQL.Transaction
type SignalHandlerInstaller = AppState -> IO()
type SocketRunner = Warp.Settings -> Wai.Application -> FileMode -> FilePath -> IO()
run :: SignalHandlerInstaller -> Maybe SocketRunner -> AppState -> IO ()
run installHandlers maybeRunWithSocket appState = do
run :: AppState -> IO ()
run appState = do
conf@AppConfig{..} <- AppState.getConfig appState
connectionWorker appState -- Loads the initial DbStructure
installHandlers appState
AppState.connectionWorker appState -- Loads the initial SchemaCache
Unix.installSignalHandlers (AppState.getMainThreadId appState) (AppState.connectionWorker appState) (AppState.reReadConfig False appState)
-- reload schema cache + config on NOTIFY
when configDbChannelEnabled $ listener appState
AppState.runListener conf appState
let app = postgrest configLogLevel appState (connectionWorker appState)
adminApp = Admin.postgrestAdmin appState conf
Admin.runAdmin conf appState $ serverSettings conf
whenJust configAdminServerPort $ \adminPort -> do
AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort
void . forkIO $ Warp.runSettings (serverSettings conf & setPort adminPort) adminApp
let app = postgrest conf appState (AppState.connectionWorker appState)
case configServerUnixSocket of
Just socket ->
-- run the postgrest application with user defined socket. Only for UNIX systems
case maybeRunWithSocket of
Just runWithSocket -> do
AppState.logWithZTime appState $ "Listening on unix socket " <> show socket
runWithSocket (serverSettings conf) app configServerUnixSocketMode socket
Nothing ->
panic "Cannot run with unix socket on non-unix platforms."
Nothing ->
do
AppState.logWithZTime appState $ "Listening on port " <> show configServerPort
Warp.runSettings (serverSettings conf) app
where
whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
whenJust mg f = maybe (pure ()) f mg
what <- case configServerUnixSocket of
Just path -> pure $ "unix socket " <> show path
Nothing -> do
port <- NS.socketPort $ AppState.getSocketREST appState
pure $ "port " <> show port
AppState.logWithZTime appState $ "Listening on " <> what
Warp.runSettingsSocket (serverSettings conf) (AppState.getSocketREST appState) app
serverSettings :: AppConfig -> Warp.Settings
serverSettings AppConfig{..} =
@@ -149,78 +95,67 @@ serverSettings AppConfig{..} =
& setServerName ("postgrest/" <> prettyVersion)
-- | PostgREST application
postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application
postgrest logLevel appState connWorker =
Cors.middleware .
postgrest :: AppConfig -> AppState.AppState -> IO () -> Wai.Application
postgrest conf appState connWorker =
traceHeaderMiddleware conf .
Cors.middleware (configServerCorsAllowedOrigins conf) .
Auth.middleware appState .
Logger.middleware logLevel $
Logger.middleware (configLogLevel conf) $
-- fromJust can be used, because the auth middleware will **always** add
-- some AuthResult to the vault.
\req respond -> case fromJust $ Auth.getResult req of
Left err -> respond $ Error.errorResponseFor err
Right authResult -> do
conf <- AppState.getConfig appState
maybeDbStructure <- AppState.getDbStructure appState
appConf <- AppState.getConfig appState -- the config must be read again because it can reload
maybeSchemaCache <- AppState.getSchemaCache appState
pgVer <- AppState.getPgVersion appState
jsonDbS <- AppState.getJsonDbS appState
let
eitherResponse :: IO (Either Error Wai.Response)
eitherResponse =
runExceptT $ postgrestResponse appState conf maybeDbStructure jsonDbS pgVer authResult req
runExceptT $ postgrestResponse appState appConf maybeSchemaCache pgVer authResult req
response <- either Error.errorResponseFor identity <$> eitherResponse
-- Launch the connWorker when the connection is down. The postgrest
-- function can respond successfully (with a stale schema cache) before
-- the connWorker is done.
let isPGAway = Wai.responseStatus response == HTTP.status503
when isPGAway connWorker
resp <- addRetryHint isPGAway appState response
when (isServiceUnavailable response) connWorker
resp <- do
delay <- AppState.getRetryNextIn appState
return $ addRetryHint delay response
respond resp
addRetryHint :: Bool -> AppState -> Wai.Response -> IO Wai.Response
addRetryHint shouldAdd appState response = do
delay <- AppState.getRetryNextIn appState
let h = ("Retry-After", BS.pack $ show delay)
return $ Wai.mapResponseHeaders (\hs -> if shouldAdd then h:hs else hs) response
postgrestResponse
:: AppState.AppState
-> AppConfig
-> Maybe DbStructure
-> ByteString
-> Maybe SchemaCache
-> PgVersion
-> AuthResult
-> Wai.Request
-> Handler IO Wai.Response
postgrestResponse appState conf@AppConfig{..} maybeDbStructure jsonDbS pgVer AuthResult{..} req = do
body <- lift $ Wai.strictRequestBody req
dbStructure <-
case maybeDbStructure of
Just dbStructure ->
return dbStructure
postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@AuthResult{..} req = do
sCache <-
case maybeSchemaCache of
Just sCache ->
return sCache
Nothing ->
throwError Error.NoSchemaCacheError
apiRequest <-
liftEither . mapLeft Error.ApiRequestError $
ApiRequest.userApiRequest conf dbStructure req body
body <- lift $ Wai.strictRequestBody req
let ctx apiReq = RequestContext conf dbStructure apiReq pgVer
(parseTime, apiRequest) <-
calcTiming configServerTimingEnabled $
liftEither . mapLeft Error.ApiRequestError $
ApiRequest.userApiRequest conf req body sCache
if iAction apiRequest == ActionInfo then
handleInfo (iTarget apiRequest) (ctx apiRequest)
else
runDbHandler appState (txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements .
Middleware.optionalRollback conf apiRequest $
Middleware.runPgLocals conf authClaims authRole (handleRequest . ctx) apiRequest jsonDbS pgVer
let jwtTime = if configServerTimingEnabled then Auth.getJwtDur req else Nothing
handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache jwtTime parseTime
runDbHandler :: AppState.AppState -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
runDbHandler appState mode authenticated prepared handler = do
dbResp <-
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
lift . AppState.usePool appState . transaction SQL.ReadCommitted mode $ runExceptT handler
runDbHandler :: AppState.AppState -> AppConfig -> SQL.IsolationLevel -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
runDbHandler appState config isoLvl mode authenticated prepared handler = do
dbResp <- lift $ do
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
AppState.usePool appState config . transaction isoLvl mode $ runExceptT handler
resp <-
liftEither . mapLeft Error.PgErr $
@@ -228,433 +163,103 @@ runDbHandler appState mode authenticated prepared handler = do
liftEither resp
handleRequest :: RequestContext -> DbHandler Wai.Response
handleRequest context@(RequestContext _ _ ApiRequest{..} _) =
handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache -> Maybe Double -> Maybe Double -> Handler IO Wai.Response
handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache jwtTime parseTime =
case (iAction, iTarget) of
(ActionRead headersOnly, TargetIdent identifier) ->
handleRead headersOnly identifier context
(ActionMutate MutationCreate, TargetIdent identifier) ->
handleCreate identifier context
(ActionMutate MutationUpdate, TargetIdent identifier) ->
handleUpdate identifier context
(ActionMutate MutationSingleUpsert, TargetIdent identifier) ->
handleSingleUpsert identifier context
(ActionMutate MutationDelete, TargetIdent identifier) ->
handleDelete identifier context
(ActionInvoke invMethod, TargetProc proc _) ->
handleInvoke invMethod proc context
(ActionInspect headersOnly, TargetDefaultSpec tSchema) ->
handleOpenApi headersOnly tSchema context
(ActionRead headersOnly, TargetIdent identifier) -> do
(planTime', wrPlan) <- withTiming $ liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq
(txTime', resultSet) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq
(respTime', pgrst) <- withTiming $ liftEither $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst
(ActionMutate MutationCreate, TargetIdent identifier) -> do
(planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache
(txTime', resultSet) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf
(respTime', pgrst) <- withTiming $ liftEither $ Response.createResponse identifier mrPlan apiReq resultSet
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst
(ActionMutate MutationUpdate, TargetIdent identifier) -> do
(planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache
(txTime', resultSet) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf
(respTime', pgrst) <- withTiming $ liftEither $ Response.updateResponse mrPlan apiReq resultSet
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst
(ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do
(planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache
(txTime', resultSet) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf
(respTime', pgrst) <- withTiming $ liftEither $ Response.singleUpsertResponse mrPlan apiReq resultSet
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst
(ActionMutate MutationDelete, TargetIdent identifier) -> do
(planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache
(txTime', resultSet) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf
(respTime', pgrst) <- withTiming $ liftEither $ Response.deleteResponse mrPlan apiReq resultSet
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst
(ActionInvoke invMethod, TargetProc identifier _) -> do
(planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod
(txTime', resultSet) <- withTiming $ runQuery (fromMaybe roleIsoLvl $ pdIsoLvl (Plan.crProc cPlan)) (pdTimeout $ Plan.crProc cPlan) (Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer
(respTime', pgrst) <- withTiming $ liftEither $ Response.invokeResponse cPlan invMethod (Plan.crProc cPlan) apiReq resultSet
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst
(ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
(planTime', iPlan) <- withTiming $ liftEither $ Plan.inspectPlan apiReq
(txTime', oaiResult) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.ipTxmode iPlan) $ Query.openApiQuery sCache pgVer conf tSchema
(respTime', pgrst) <- withTiming $ liftEither $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst
(ActionInfo, TargetIdent identifier) -> do
(respTime', pgrst) <- withTiming $ liftEither $ Response.infoIdentResponse identifier sCache
return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst
(ActionInfo, TargetProc identifier _) -> do
(planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead
(respTime', pgrst) <- withTiming $ liftEither $ Response.infoProcResponse (Plan.crProc cPlan)
return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' Nothing respTime') pgrst
(ActionInfo, TargetDefaultSpec _) -> do
(respTime', pgrst) <- withTiming $ liftEither Response.infoRootResponse
return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst
_ ->
-- This is unreachable as the ApiRequest.hs rejects it before
-- TODO Refactor the Action/Target types to remove this line
throwError $ Error.ApiRequestError ApiRequestTypes.NotFound
handleRead :: Bool -> QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleRead headersOnly identifier context@RequestContext{..} = do
req <- readRequest identifier context
bField <- binaryField context req
let
ApiRequest{..} = ctxApiRequest
AppConfig{..} = ctxConfig
countQuery = QueryBuilder.readRequestToCountQuery req
resultSet <-
lift . SQL.statement mempty $
Statements.prepareRead
(QueryBuilder.readRequestToQuery req)
(if iPreferCount == Just EstimatedCount then
-- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
else
countQuery
)
(shouldCount iPreferCount)
iAcceptMediaType
bField
configDbPreparedStatements
case resultSet of
RSStandard{..} -> do
total <- readTotal ctxConfig ctxApiRequest rsTableTotal countQuery
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
let
(status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal total
headers =
[ contentRange
, ( "Content-Location"
, "/"
<> toUtf8 (qiName identifier)
<> if BS.null (qsCanonical iQueryParams) then mempty else "?" <> qsCanonical iQueryParams
)
]
++ contentTypeHeaders context
failNotSingular iAcceptMediaType rsQueryTotal . response status headers $
if headersOnly then mempty else LBS.fromStrict rsBody
RSPlan plan ->
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
readTotal :: AppConfig -> ApiRequest -> Maybe Int64 -> SQL.Snippet -> DbHandler (Maybe Int64)
readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery =
case iPreferCount of
Just PlannedCount ->
explain
Just EstimatedCount ->
if tableTotal > (fromIntegral <$> configDbMaxRows) then
max tableTotal <$> explain
else
return tableTotal
_ ->
return tableTotal
where
explain =
lift . SQL.statement mempty . Statements.preparePlanRows countQuery $
configDbPreparedStatements
roleSettings = fromMaybe mempty (HM.lookup authRole $ configRoleSettings conf)
roleIsoLvl = HM.findWithDefault SQL.ReadCommitted authRole $ configRoleIsoLvl conf
runQuery isoLvl timeout mode query =
runDbHandler appState conf isoLvl mode authenticated prepared $ do
Query.setPgLocals conf authClaims authRole (HM.toList roleSettings) apiReq timeout
Query.runPreReq conf
query
handleCreate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
let
ApiRequest{..} = ctxApiRequest
pkCols = if iPreferRepresentation /= None || isJust iPreferResolution
then maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
else mempty
pgrstResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response
pgrstResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled conf])) bod
resultSet <- writeQuery MutationCreate identifier True pkCols context
withTiming = calcTiming $ configServerTimingEnabled conf
case resultSet of
RSStandard{..} -> do
calcTiming :: Bool -> Handler IO a -> Handler IO (Maybe Double, a)
calcTiming timingEnabled f = if timingEnabled
then do
(t, r) <- timeItT f
pure (Just t, r)
else do
r <- f
pure (Nothing, r)
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
traceHeaderMiddleware :: AppConfig -> Wai.Middleware
traceHeaderMiddleware AppConfig{configServerTraceHeader} app req respond =
case configServerTraceHeader of
Nothing -> app req respond
Just hdr ->
let hdrVal = L.lookup hdr $ Wai.requestHeaders req in
app req (respond . Wai.mapResponseHeaders ([(hdr, fromMaybe mempty hdrVal)] ++))
let
headers =
catMaybes
[ if null rsLocation then
Nothing
else
Just
( HTTP.hLocation
, "/"
<> toUtf8 qiName
<> HTTP.renderSimpleQuery True rsLocation
)
, Just . RangeQuery.contentRangeH 1 0 $
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
, if null pkCols && isNothing (qsOnConflict iQueryParams) then
Nothing
else
toAppliedHeader <$> iPreferResolution
]
addRetryHint :: Int -> Wai.Response -> Wai.Response
addRetryHint delay response = do
let h = ("Retry-After", BS.pack $ show delay)
Wai.mapResponseHeaders (\hs -> if isServiceUnavailable response then h:hs else hs) response
failNotSingular iAcceptMediaType rsQueryTotal $
if iPreferRepresentation == Full then
response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict rsBody)
else
response HTTP.status201 headers mempty
RSPlan plan ->
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
resultSet <- writeQuery MutationUpdate identifier False mempty context
case resultSet of
RSStandard{..} -> do
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
let
fullRepr = iPreferRepresentation == Full
updateIsNoOp = S.null iColumns
status
| rsQueryTotal == 0 && not updateIsNoOp = HTTP.status404
| fullRepr = HTTP.status200
| otherwise = HTTP.status204
contentRangeHeader =
RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<<
failNotSingular iAcceptMediaType rsQueryTotal (
if fullRepr then
response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict rsBody)
else
response status [contentRangeHeader] mempty)
RSPlan plan ->
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response
handleSingleUpsert identifier context@(RequestContext _ ctxDbStructure ApiRequest{..} _) = do
let pkCols = maybe mempty tablePKCols $ HM.lookup identifier $ dbTables ctxDbStructure
resultSet <- writeQuery MutationSingleUpsert identifier False pkCols context
case resultSet of
RSStandard {..} -> do
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
-- Makes sure the querystring pk matches the payload pk
-- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
-- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.
-- If this condition is not satisfied then nothing is inserted,
-- check the WHERE for INSERT in QueryBuilder.hs to see how it's done
when (rsQueryTotal /= 1) $ do
lift SQL.condemn
throwError Error.PutMatchingPkError
return $
if iPreferRepresentation == Full then
response HTTP.status200 (contentTypeHeaders context) (LBS.fromStrict rsBody)
else
response HTTP.status204 [] mempty
RSPlan plan ->
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do
resultSet <- writeQuery MutationDelete identifier False mempty context
case resultSet of
RSStandard {..} -> do
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
let
contentRangeHeader =
RangeQuery.contentRangeH 1 0 $
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<<
failNotSingular iAcceptMediaType rsQueryTotal (
if iPreferRepresentation == Full then
response HTTP.status200
(contentTypeHeaders context ++ [contentRangeHeader])
(LBS.fromStrict rsBody)
else
response HTTP.status204 [contentRangeHeader] mempty)
RSPlan plan ->
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
handleInfo :: Monad m => Target -> RequestContext -> Handler m Wai.Response
handleInfo target RequestContext{..} =
case target of
TargetIdent identifier ->
case HM.lookup identifier (dbTables ctxDbStructure) of
Just tbl -> infoResponse $ allowH tbl
Nothing -> throwError $ Error.ApiRequestError ApiRequestTypes.NotFound
TargetProc pd _
| pdVolatility pd == Volatile -> infoResponse "OPTIONS,POST"
| otherwise -> infoResponse "OPTIONS,GET,HEAD,POST"
TargetDefaultSpec _ -> infoResponse "OPTIONS,GET,HEAD"
where
infoResponse allowHeader = return $ Wai.responseLBS HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty
allOrigins = ("Access-Control-Allow-Origin", "*")
allowH table =
let hasPK = not . null $ tablePKCols table in
BS.intercalate "," $
["OPTIONS,GET,HEAD"] ++
["POST" | tableInsertable table] ++
["PUT" | tableInsertable table && tableUpdatable table && hasPK] ++
["PATCH" | tableUpdatable table] ++
["DELETE" | tableDeletable table]
handleInvoke :: InvokeMethod -> ProcDescription -> RequestContext -> DbHandler Wai.Response
handleInvoke invMethod proc context@RequestContext{..} = do
let
ApiRequest{..} = ctxApiRequest
identifier =
QualifiedIdentifier
(pdSchema proc)
(fromMaybe (pdName proc) $ Proc.procTableName proc)
req <- readRequest identifier context
bField <- binaryField context req
let callReq = ReqBuilder.callRequest proc ctxApiRequest req
resultSet <-
lift . SQL.statement mempty $
Statements.prepareCall
(Proc.procReturnsScalar proc)
(Proc.procReturnsSingle proc)
(QueryBuilder.requestToCallProcQuery callReq)
(QueryBuilder.readRequestToQuery req)
(QueryBuilder.readRequestToCountQuery req)
(shouldCount iPreferCount)
iAcceptMediaType
(iPreferParameters == Just MultipleObjects)
bField
(configDbPreparedStatements ctxConfig)
case resultSet of
RSStandard {..} -> do
response <- liftEither $ gucResponse <$> rsGucStatus <*> rsGucHeaders
let
(status, contentRange) =
RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
failNotSingular iAcceptMediaType rsQueryTotal $
if Proc.procReturnsVoid proc then
response HTTP.status204 [contentRange] mempty
else
response status
(contentTypeHeaders context ++ [contentRange])
(if invMethod == InvHead then mempty else LBS.fromStrict rsBody)
RSPlan plan ->
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response
handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest ctxPgVersion) = do
body <-
lift $ case configOpenApiMode of
OAFollowPriv ->
OpenAPI.encode conf dbStructure
<$> SQL.statement [tSchema] (DbStructure.accessibleTables ctxPgVersion configDbPreparedStatements)
<*> SQL.statement tSchema (DbStructure.accessibleProcs ctxPgVersion configDbPreparedStatements)
<*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
OAIgnorePriv ->
OpenAPI.encode conf dbStructure
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbTables dbStructure)
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure)
<$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
OADisabled ->
pure mempty
return $
Wai.responseLBS HTTP.status200
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader apiRequest))
(if headersOnly then mempty else body)
txMode :: ApiRequest -> SQL.Mode
txMode ApiRequest{..} =
case (iAction, iTarget) of
(ActionRead _, _) ->
SQL.Read
(ActionInfo, _) ->
SQL.Read
(ActionInspect _, _) ->
SQL.Read
(ActionInvoke InvGet, _) ->
SQL.Read
(ActionInvoke InvHead, _) ->
SQL.Read
(ActionInvoke InvPost, TargetProc ProcDescription{pdVolatility=Stable} _) ->
SQL.Read
(ActionInvoke InvPost, TargetProc ProcDescription{pdVolatility=Immutable} _) ->
SQL.Read
_ ->
SQL.Write
writeQuery :: Mutation -> QualifiedIdentifier -> Bool -> [Text] -> RequestContext -> DbHandler ResultSet
writeQuery mutation identifier@QualifiedIdentifier{..} isInsert pkCols context@RequestContext{..} = do
readReq <- readRequest identifier context
mutateReq <-
liftEither $
ReqBuilder.mutateRequest mutation qiSchema qiName ctxApiRequest
pkCols
readReq
lift . SQL.statement mempty $
Statements.prepareWrite
(QueryBuilder.readRequestToQuery readReq)
(QueryBuilder.mutateRequestToQuery mutateReq)
isInsert
(iAcceptMediaType ctxApiRequest)
(iPreferRepresentation ctxApiRequest)
pkCols
(configDbPreparedStatements ctxConfig)
-- | Response with headers and status overridden from GUCs.
gucResponse
:: Maybe HTTP.Status
-> [GucHeader]
-> HTTP.Status
-> [HTTP.Header]
-> LBS.ByteString
-> Wai.Response
gucResponse gucStatus gucHeaders status headers =
Wai.responseLBS (fromMaybe status gucStatus) $
addHeadersIfNotIncluded headers (map unwrapGucHeader gucHeaders)
-- |
-- Fail a response if a single JSON object was requested and not exactly one
-- was found.
failNotSingular :: MediaType -> Int64 -> Wai.Response -> DbHandler Wai.Response
failNotSingular mediaType queryTotal response =
if mediaType == MTSingularJSON && queryTotal /= 1 then
do
lift SQL.condemn
throwError $ Error.singularityError queryTotal
else
return response
failChangesOffLimits :: Maybe Integer -> Int64 -> Wai.Response -> DbHandler Wai.Response
failChangesOffLimits (Just maxChanges) queryTotal response =
if queryTotal > fromIntegral maxChanges
then do
lift SQL.condemn
throwError $ Error.OffLimitsChangesError queryTotal maxChanges
else
return response
failChangesOffLimits _ _ response = return response
shouldCount :: Maybe PreferCount -> Bool
shouldCount preferCount =
preferCount == Just ExactCount || preferCount == Just EstimatedCount
returnsScalar :: ApiRequest.Target -> Bool
returnsScalar (TargetProc proc _) = Proc.procReturnsScalar proc
returnsScalar _ = False
readRequest :: Monad m => QualifiedIdentifier -> RequestContext -> Handler m ReadRequest
readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure apiRequest _) =
liftEither $
ReqBuilder.readRequest qiSchema qiName configDbMaxRows
(dbRelationships dbStructure)
apiRequest
contentTypeHeaders :: RequestContext -> [HTTP.Header]
contentTypeHeaders RequestContext{..} =
MediaType.toContentType (iAcceptMediaType ctxApiRequest) : maybeToList (profileHeader ctxApiRequest)
-- | If raw(binary) output is requested, check that MediaType is one of the
-- admitted rawMediaTypes and that`?select=...` contains only one field other
-- than `*`
binaryField :: Monad m => RequestContext -> ReadRequest -> Handler m (Maybe FieldName)
binaryField RequestContext{..} readReq
| returnsScalar (iTarget ctxApiRequest) && isRawMediaType =
return $ Just "pgrst_scalar"
| isRawMediaType =
let
fldNames = fstFieldNames readReq
fieldName = headMay fldNames
in
if length fldNames == 1 && fieldName /= Just "*" then
return fieldName
else
throwError $ Error.BinaryFieldError mediaType
| otherwise =
return Nothing
where
mediaType = iAcceptMediaType ctxApiRequest
isRawMediaType = mediaType `elem` configRawMediaTypes ctxConfig `union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan mediaType
isRawPlan mt = case mt of
MTPlan (MTPlanAttrs (Just MTOctetStream) _ _) -> True
MTPlan (MTPlanAttrs (Just MTTextPlain) _ _) -> True
MTPlan (MTPlanAttrs (Just MTTextXML) _ _) -> True
_ -> False
profileHeader :: ApiRequest -> Maybe HTTP.Header
profileHeader ApiRequest{..} =
(,) "Content-Profile" <$> (toUtf8 <$> iProfile)
isServiceUnavailable :: Wai.Response -> Bool
isServiceUnavailable response = Wai.responseStatus response == HTTP.status503
+452 -55
View File
@@ -1,87 +1,134 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.AppState
( AppState
, AuthResult(..)
, destroy
, getConfig
, getDbStructure
, getSchemaCache
, getIsListenerOn
, getJsonDbS
, getMainThreadId
, getPgVersion
, getRetryNextIn
, getTime
, getWorkerSem
, getJwtCache
, getSocketREST
, getSocketAdmin
, init
, initSockets
, initWithPool
, logWithZTime
, putConfig
, putDbStructure
, putIsListenerOn
, putJsonDbS
, putSchemaCache
, putPgVersion
, putRetryNextIn
, releasePool
, signalListener
, usePool
, waitListener
, loadSchemaCache
, reReadConfig
, connectionWorker
, runListener
) where
import qualified Hasql.Pool as SQL
import qualified Hasql.Session as SQL
import qualified Data.Aeson as JSON
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Cache as C
import Data.Either.Combinators (whenLeft)
import qualified Data.Text as T (unpack)
import qualified Data.Text.Encoding as T
import Hasql.Connection (acquire)
import qualified Hasql.Notifications as SQL
import qualified Hasql.Pool as SQL
import qualified Hasql.Session as SQL
import qualified Hasql.Transaction.Sessions as SQL
import qualified Network.HTTP.Types.Status as HTTP
import qualified Network.Socket as NS
import qualified PostgREST.Error as Error
import PostgREST.Version (prettyVersion)
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
updateAction)
import Control.Debounce
import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
retrying, rsPreviousDelay)
import Data.IORef (IORef, atomicWriteIORef, newIORef,
readIORef)
import Data.Time (ZonedTime, defaultTimeLocale, formatTime,
getZonedTime)
import Data.Time.Clock (UTCTime, getCurrentTime)
import PostgREST.Config (AppConfig (..))
import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
import PostgREST.DbStructure (DbStructure)
import PostgREST.Config (AppConfig (..),
LogLevel (..),
addFallbackAppName,
readAppConfig)
import PostgREST.Config.Database (queryDbSettings,
queryPgVersion,
queryRoleSettings)
import PostgREST.Config.PgVersion (PgVersion (..),
minimumPgVersion)
import PostgREST.SchemaCache (SchemaCache,
querySchemaCache)
import PostgREST.SchemaCache.Identifiers (dumpQi)
import PostgREST.Unix (createAndBindDomainSocket)
import Data.Streaming.Network (bindPortTCP, bindRandomPortTCP)
import Data.String (IsString (..))
import Protolude
data AuthResult = AuthResult
{ authClaims :: KM.KeyMap JSON.Value
, authRole :: BS.ByteString
}
data AppState = AppState
{ statePool :: SQL.Pool -- | Connection pool, either a 'Connection' or a 'ConnectionError'
, statePgVersion :: IORef PgVersion
-- | Database connection pool
{ statePool :: SQL.Pool
-- | Database server version, will be updated by the connectionWorker
, statePgVersion :: IORef PgVersion
-- | No schema cache at the start. Will be filled in by the connectionWorker
, stateDbStructure :: IORef (Maybe DbStructure)
-- | Cached DbStructure in json
, stateJsonDbS :: IORef ByteString
-- | Binary semaphore to make sure just one connectionWorker can run at a time
, stateWorkerSem :: MVar ()
, stateSchemaCache :: IORef (Maybe SchemaCache)
-- | starts the connection worker with a debounce
, debouncedConnectionWorker :: IO ()
-- | Binary semaphore used to sync the listener(NOTIFY reload) with the connectionWorker.
, stateListener :: MVar ()
, stateListener :: MVar ()
-- | State of the LISTEN channel, used for the admin server checks
, stateIsListenerOn :: IORef Bool
, stateIsListenerOn :: IORef Bool
-- | Config that can change at runtime
, stateConf :: IORef AppConfig
, stateConf :: IORef AppConfig
-- | Time used for verifying JWT expiration
, stateGetTime :: IO UTCTime
, stateGetTime :: IO UTCTime
-- | Time with time zone used for worker logs
, stateGetZTime :: IO ZonedTime
, stateGetZTime :: IO ZonedTime
-- | Used for killing the main thread in case a subthread fails
, stateMainThreadId :: ThreadId
, stateMainThreadId :: ThreadId
-- | Keeps track of when the next retry for connecting to database is scheduled
, stateRetryNextIn :: IORef Int
, stateRetryNextIn :: IORef Int
-- | Logs a pool error with a debounce
, debounceLogAcquisitionTimeout :: IO ()
-- | JWT Cache
, jwtCache :: C.Cache ByteString AuthResult
-- | Network socket for REST API
, stateSocketREST :: NS.Socket
-- | Network socket for the admin UI
, stateSocketAdmin :: Maybe NS.Socket
}
type AppSockets = (NS.Socket, Maybe NS.Socket)
init :: AppConfig -> IO AppState
init conf = do
newPool <- initPool conf
initWithPool newPool conf
pool <- initPool conf
(sock, adminSock) <- initSockets conf
state' <- initWithPool (sock, adminSock) pool conf
pure state' { stateSocketREST = sock, stateSocketAdmin = adminSock }
initWithPool :: SQL.Pool -> AppConfig -> IO AppState
initWithPool newPool conf =
AppState newPool
initWithPool :: AppSockets -> SQL.Pool -> AppConfig -> IO AppState
initWithPool (sock, adminSock) pool conf = do
appState <- AppState pool
<$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step
<*> newIORef Nothing
<*> newIORef mempty
<*> newEmptyMVar
<*> pure (pure ())
<*> newEmptyMVar
<*> newIORef False
<*> newIORef conf
@@ -89,19 +136,98 @@ initWithPool newPool conf =
<*> mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
<*> myThreadId
<*> newIORef 0
<*> pure (pure ())
<*> C.newCache Nothing
<*> pure sock
<*> pure adminSock
debLogTimeout <-
let oneSecond = 1000000 in
mkDebounce defaultDebounceSettings
{ debounceAction = logPgrstError appState SQL.AcquisitionTimeoutUsageError
, debounceFreq = 5*oneSecond
, debounceEdge = leadingEdge -- logs at the start and the end
}
debWorker <-
let decisecond = 100000 in
mkDebounce defaultDebounceSettings
{ debounceAction = internalConnectionWorker appState
, debounceFreq = decisecond
, debounceEdge = leadingEdge -- runs the worker at the start and the end
}
return appState { debounceLogAcquisitionTimeout = debLogTimeout, debouncedConnectionWorker = debWorker }
destroy :: AppState -> IO ()
destroy = releasePool
destroy = destroyPool
initSockets :: AppConfig -> IO AppSockets
initSockets AppConfig{..} = do
let
cfg'usp = configServerUnixSocket
cfg'uspm = configServerUnixSocketMode
cfg'host = configServerHost
cfg'port = configServerPort
cfg'adminport = configAdminServerPort
sock <- case cfg'usp of
-- I'm not using `streaming-commons`' bindPath function here because it's not defined for Windows,
-- but we need to have runtime error if we try to use it in Windows, not compile time error
Just path -> createAndBindDomainSocket path cfg'uspm
Nothing -> do
(_, sock) <-
if cfg'port /= 0
then do
sock <- bindPortTCP cfg'port (fromString $ T.unpack cfg'host)
pure (cfg'port, sock)
else do
-- explicitly bind to a random port, returning bound port number
(num, sock) <- bindRandomPortTCP (fromString $ T.unpack cfg'host)
pure (num, sock)
pure sock
adminSock <- case cfg'adminport of
Just adminPort -> do
adminSock <- bindPortTCP adminPort (fromString $ T.unpack cfg'host)
pure $ Just adminSock
Nothing -> pure Nothing
pure (sock, adminSock)
initPool :: AppConfig -> IO SQL.Pool
initPool AppConfig{..} =
SQL.acquire (configDbPoolSize, configDbPoolTimeout, toUtf8 configDbUri)
SQL.acquire
configDbPoolSize
(fromIntegral configDbPoolAcquisitionTimeout)
(fromIntegral configDbPoolMaxLifetime)
(fromIntegral configDbPoolMaxIdletime)
(toUtf8 $ addFallbackAppName prettyVersion configDbUri)
usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a)
usePool AppState{..} = SQL.use statePool
-- | Run an action with a database connection.
usePool :: AppState -> AppConfig -> SQL.Session a -> IO (Either SQL.UsageError a)
usePool appState@AppState{..} AppConfig{configLogLevel} x = do
res <- SQL.use statePool x
releasePool :: AppState -> IO ()
releasePool AppState{..} = SQL.release statePool
when (configLogLevel > LogCrit) $ do
whenLeft res (\case
SQL.AcquisitionTimeoutUsageError -> debounceLogAcquisitionTimeout -- this can happen rapidly for many requests, so we debounce
error
-- TODO We're using the 500 HTTP status for getting all internal db errors but there's no response here. We need a new intermediate type to not rely on the HTTP status.
| Error.status (Error.PgError False error) >= HTTP.status500 -> logPgrstError appState error
| otherwise -> pure ())
return res
-- | Flush the connection pool so that any future use of the pool will
-- use connections freshly established after this call.
flushPool :: AppState -> IO ()
flushPool AppState{..} = SQL.release statePool
-- | Destroy the pool on shutdown.
destroyPool :: AppState -> IO ()
destroyPool AppState{..} = SQL.release statePool
getPgVersion :: AppState -> IO PgVersion
getPgVersion = readIORef . statePgVersion
@@ -109,20 +235,14 @@ getPgVersion = readIORef . statePgVersion
putPgVersion :: AppState -> PgVersion -> IO ()
putPgVersion = atomicWriteIORef . statePgVersion
getDbStructure :: AppState -> IO (Maybe DbStructure)
getDbStructure = readIORef . stateDbStructure
getSchemaCache :: AppState -> IO (Maybe SchemaCache)
getSchemaCache = readIORef . stateSchemaCache
putDbStructure :: AppState -> Maybe DbStructure -> IO ()
putDbStructure appState = atomicWriteIORef (stateDbStructure appState)
putSchemaCache :: AppState -> Maybe SchemaCache -> IO ()
putSchemaCache appState = atomicWriteIORef (stateSchemaCache appState)
getJsonDbS :: AppState -> IO ByteString
getJsonDbS = readIORef . stateJsonDbS
putJsonDbS :: AppState -> ByteString -> IO ()
putJsonDbS appState = atomicWriteIORef (stateJsonDbS appState)
getWorkerSem :: AppState -> MVar ()
getWorkerSem = stateWorkerSem
connectionWorker :: AppState -> IO ()
connectionWorker = debouncedConnectionWorker
getRetryNextIn :: AppState -> IO Int
getRetryNextIn = readIORef . stateRetryNextIn
@@ -139,12 +259,24 @@ putConfig = atomicWriteIORef . stateConf
getTime :: AppState -> IO UTCTime
getTime = stateGetTime
getJwtCache :: AppState -> C.Cache ByteString AuthResult
getJwtCache = jwtCache
getSocketREST :: AppState -> NS.Socket
getSocketREST = stateSocketREST
getSocketAdmin :: AppState -> Maybe NS.Socket
getSocketAdmin = stateSocketAdmin
-- | Log to stderr with local time
logWithZTime :: AppState -> Text -> IO ()
logWithZTime appState txt = do
zTime <- stateGetZTime appState
hPutStrLn stderr $ toS (formatTime defaultTimeLocale "%d/%b/%Y:%T %z: " zTime) <> txt
logPgrstError :: AppState -> SQL.UsageError -> IO ()
logPgrstError appState e = logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ Error.errorPayload $ Error.PgError False e
getMainThreadId :: AppState -> ThreadId
getMainThreadId = stateMainThreadId
@@ -164,3 +296,268 @@ getIsListenerOn = readIORef . stateIsListenerOn
putIsListenerOn :: AppState -> Bool -> IO ()
putIsListenerOn = atomicWriteIORef . stateIsListenerOn
-- | Schema cache status
data SCacheStatus
= SCLoaded
| SCOnRetry
| SCFatalFail
-- | Load the SchemaCache by using a connection from the pool.
loadSchemaCache :: AppState -> IO SCacheStatus
loadSchemaCache appState = do
conf@AppConfig{..} <- getConfig appState
result <-
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
usePool appState conf . transaction SQL.ReadCommitted SQL.Read $
querySchemaCache conf
case result of
Left e -> do
case checkIsFatal e of
Just hint -> do
logWithZTime appState "A fatal error ocurred when loading the schema cache"
logPgrstError appState e
logWithZTime appState hint
return SCFatalFail
Nothing -> do
putSchemaCache appState Nothing
logWithZTime appState "An error ocurred when loading the schema cache"
logPgrstError appState e
return SCOnRetry
Right sCache -> do
putSchemaCache appState (Just sCache)
logWithZTime appState "Schema cache loaded"
return SCLoaded
-- | Current database connection status data ConnectionStatus
data ConnectionStatus
= NotConnected
| Connected PgVersion
| FatalConnectionError Text
deriving (Eq)
-- | The purpose of this worker is to obtain a healthy connection to pg and an
-- up-to-date schema cache(SchemaCache). This method is meant to be called
-- multiple times by the same thread, but does nothing if the previous
-- invocation has not terminated. In all cases this method does not halt the
-- calling thread, the work is performed in a separate thread.
--
-- Background thread that does the following :
-- 1. Tries to connect to pg server and will keep trying until success.
-- 2. Checks if the pg version is supported and if it's not it kills the main
-- program.
-- 3. Obtains the sCache. If this fails, it goes back to 1.
internalConnectionWorker :: AppState -> IO ()
internalConnectionWorker appState = work
where
work = do
config@AppConfig{..} <- getConfig appState
logWithZTime appState $ "Starting PostgREST " <> T.decodeUtf8 prettyVersion <> "..."
logWithZTime appState "Attempting to connect to the database..."
connected <- establishConnection appState config
case connected of
FatalConnectionError reason ->
-- Fatal error when connecting
logWithZTime appState reason >> killThread (getMainThreadId appState)
NotConnected ->
-- Unreachable because establishConnection will keep trying to connect, unless disable-recovery is turned on
unless configDbPoolAutomaticRecovery
$ logWithZTime appState "Automatic recovery disabled, exiting." >> killThread (getMainThreadId appState)
Connected actualPgVersion -> do
-- Procede with initialization
putPgVersion appState actualPgVersion
when configDbChannelEnabled $
signalListener appState
logWithZTime appState "Connection successful"
-- this could be fail because the connection drops, but the loadSchemaCache will pick the error and retry again
-- We cannot retry after it fails immediately, because db-pre-config could have user errors. We just log the error and continue.
when configDbConfig $ reReadConfig False appState
scStatus <- loadSchemaCache appState
case scStatus of
SCLoaded ->
-- do nothing and proceed if the load was successful
return ()
SCOnRetry ->
-- retry reloading the schema cache
work
SCFatalFail ->
-- die if our schema cache query has an error
killThread $ getMainThreadId appState
-- | Repeatedly flush the pool, and check if a connection from the
-- pool allows access to the PostgreSQL database.
--
-- Releasing the pool is key for rapid recovery. Otherwise, the pool
-- timeout would have to be reached for new healthy connections to be acquired.
-- Which might not happen if the server is busy with requests. No idle
-- connection, no pool timeout.
--
-- The connection tries are capped, but if the connection times out no error is
-- thrown, just 'False' is returned.
establishConnection :: AppState -> AppConfig -> IO ConnectionStatus
establishConnection appState config =
retrying retrySettings shouldRetry $
const $ flushPool appState >> getConnectionStatus
where
retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds
delayMicroseconds = 32000000 -- 32 seconds
backoffMicroseconds = 1000000 -- 1 second
getConnectionStatus :: IO ConnectionStatus
getConnectionStatus = do
pgVersion <- usePool appState config $ queryPgVersion False -- No need to prepare the query here, as the connection might not be established
case pgVersion of
Left e -> do
logPgrstError appState e
case checkIsFatal e of
Just reason ->
return $ FatalConnectionError reason
Nothing ->
return NotConnected
Right version ->
if version < minimumPgVersion then
return . FatalConnectionError $
"Cannot run in this PostgreSQL version, PostgREST needs at least "
<> pgvName minimumPgVersion
else
return . Connected $ version
shouldRetry :: RetryStatus -> ConnectionStatus -> IO Bool
shouldRetry rs isConnSucc = do
AppConfig{..} <- getConfig appState
let
delay = fromMaybe 0 (rsPreviousDelay rs) `div` backoffMicroseconds
itShould = NotConnected == isConnSucc && configDbPoolAutomaticRecovery
when itShould . logWithZTime appState $
"Attempting to reconnect to the database in "
<> (show delay::Text)
<> " seconds..."
when itShould $ putRetryNextIn appState delay
return itShould
-- | Re-reads the config plus config options from the db
reReadConfig :: Bool -> AppState -> IO ()
reReadConfig startingUp appState = do
config@AppConfig{..} <- getConfig appState
pgVer <- getPgVersion appState
dbSettings <-
if configDbConfig then do
qDbSettings <- usePool appState config $ queryDbSettings (dumpQi <$> configDbPreConfig) configDbPreparedStatements
case qDbSettings of
Left e -> do
logWithZTime appState
"An error ocurred when trying to query database settings for the config parameters"
case checkIsFatal e of
Just hint -> do
logPgrstError appState e
logWithZTime appState hint
killThread (getMainThreadId appState)
Nothing -> do
logPgrstError appState e
pure mempty
Right x -> pure x
else
pure mempty
(roleSettings, roleIsolationLvl) <-
if configDbConfig then do
rSettings <- usePool appState config $ queryRoleSettings pgVer configDbPreparedStatements
case rSettings of
Left e -> do
logWithZTime appState "An error ocurred when trying to query the role settings"
logPgrstError appState e
pure (mempty, mempty)
Right x -> pure x
else
pure mempty
readAppConfig dbSettings configFilePath (Just configDbUri) roleSettings roleIsolationLvl >>= \case
Left err ->
if startingUp then
panic err -- die on invalid config if the program is starting up
else
logWithZTime appState $ "Failed reloading config: " <> err
Right newConf -> do
putConfig appState newConf
if startingUp then
pass
else
logWithZTime appState "Config reloaded"
runListener :: AppConfig -> AppState -> IO ()
runListener AppConfig{configDbChannelEnabled} appState =
when configDbChannelEnabled $ listener appState
-- | Starts a dedicated pg connection to LISTEN for notifications. When a
-- NOTIFY <db-channel> - with an empty payload - is done, it refills the schema
-- cache. It uses the connectionWorker in case the LISTEN connection dies.
listener :: AppState -> IO ()
listener appState = do
AppConfig{..} <- getConfig appState
let dbChannel = toS configDbChannel
-- The listener has to wait for a signal from the connectionWorker.
-- This is because when the connection to the db is lost, the listener also
-- tries to recover the connection, but not with the same pace as the connectionWorker.
-- Not waiting makes stderr quickly fill with connection retries messages from the listener.
waitListener appState
-- forkFinally allows to detect if the thread dies
void . flip forkFinally (handleFinally dbChannel configDbPoolAutomaticRecovery) $ do
dbOrError <- acquire $ toUtf8 (addFallbackAppName prettyVersion configDbUri)
case dbOrError of
Right db -> do
logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel"
putIsListenerOn appState True
SQL.listen db $ SQL.toPgIdentifier dbChannel
SQL.waitForNotifications handleNotification db
_ ->
die $ "Could not listen for notifications on the " <> dbChannel <> " channel"
where
handleFinally _ False _ =
logWithZTime appState "Automatic recovery disabled, exiting." >> killThread (getMainThreadId appState)
handleFinally dbChannel True _ = do
-- if the thread dies, we try to recover
logWithZTime appState $ "Retrying listening for notifications on the " <> dbChannel <> " channel.."
putIsListenerOn appState False
-- assume the pool connection was also lost, call the connection worker
connectionWorker appState
-- retry the listener
listener appState
handleNotification _ msg
| BS.null msg = cacheReloader
| msg == "reload schema" = cacheReloader
| msg == "reload config" = reReadConfig False appState
| otherwise = pure () -- Do nothing if anything else than an empty message is sent
cacheReloader =
-- reloads the schema cache + restarts pool connections
-- it's necessary to restart the pg connections because they cache the pg catalog(see #2620)
connectionWorker appState
checkIsFatal :: SQL.UsageError -> Maybe Text
checkIsFatal (SQL.ConnectionUsageError e)
| isAuthFailureMessage = Just $ toS failureMessage
| otherwise = Nothing
where isAuthFailureMessage =
("FATAL: password authentication failed" `isInfixOf` failureMessage) ||
("no password supplied" `isInfixOf` failureMessage)
failureMessage = BS.unpack $ fromMaybe mempty e
checkIsFatal(SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError serverError)))
= case serverError of
-- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal.
SQL.ServerError "42601" _ _ _ _
-> Just "Hint: This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues"
-- Check for a "prepared statement <name> already exists" error (Code 42P05: duplicate_prepared_statement).
-- This would mean that a connection pooler in transaction mode is being used
-- while prepared statements are enabled in the PostgREST configuration,
-- both of which are incompatible with each other.
SQL.ServerError "42P05" _ _ _ _
-> Just "Hint: If you are using connection poolers in transaction mode, try setting db-prepared-statements to false."
-- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation).
-- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.
SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _ _
-> Just "Hint: Connection poolers in statement mode are not supported."
_ -> Nothing
checkIsFatal _ = Nothing
+66 -19
View File
@@ -14,6 +14,7 @@ very simple authentication system inside the PostgreSQL database.
module PostgREST.Auth
( AuthResult (..)
, getResult
, getJwtDur
, getRole
, middleware
) where
@@ -23,8 +24,10 @@ import qualified Data.Aeson as JSON
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Types as JSON
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Text.Encoding as T
import qualified Data.Cache as C
import qualified Data.Scientific as Sci
import qualified Data.Vault.Lazy as Vault
import qualified Data.Vector as V
import qualified Network.HTTP.Types.Header as HTTP
@@ -35,21 +38,20 @@ import Control.Lens (set)
import Control.Monad.Except (liftEither)
import Data.Either.Combinators (mapLeft)
import Data.List (lookup)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock (UTCTime, nominalDiffTimeToSeconds)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import System.Clock (TimeSpec (..))
import System.IO.Unsafe (unsafePerformIO)
import System.TimeIt (timeItT)
import PostgREST.AppState (AppState, getConfig, getTime)
import PostgREST.AppState (AppState, AuthResult (..), getConfig,
getJwtCache, getTime)
import PostgREST.Config (AppConfig (..), JSPath, JSPathExp (..))
import PostgREST.Error (Error (..))
import Protolude
data AuthResult = AuthResult
{ authClaims :: KM.KeyMap JSON.Value
, authRole :: Text
}
-- | Receives the JWT secret and audience (from config) and a JWT and returns a
-- JSON object of JWT claims.
parseToken :: Monad m =>
@@ -63,7 +65,7 @@ parseToken AppConfig{..} token time = do
liftEither . mapLeft jwtClaimsError $ JSON.toJSON <$> eitherClaims
where
validation =
JWT.defaultJWTValidationSettings audienceCheck & set JWT.allowedSkew 1
JWT.defaultJWTValidationSettings audienceCheck & set JWT.allowedSkew 30
audienceCheck :: JWT.StringOrURI -> Bool
audienceCheck = maybe (const True) (==) configJwtAudience
@@ -79,7 +81,7 @@ parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
role <- liftEither . maybeToRight JwtTokenRequired $
unquoted <$> walkJSPath (Just jclaims) configJwtRoleClaimKey <|> configDbAnonRole
return AuthResult
{ authClaims = mclaims & KM.insert "role" (JSON.toJSON role)
{ authClaims = mclaims & KM.insert "role" (JSON.toJSON $ decodeUtf8 role)
, authRole = role
}
where
@@ -89,9 +91,9 @@ parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest
walkJSPath _ _ = Nothing
unquoted :: JSON.Value -> Text
unquoted (JSON.String t) = t
unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
unquoted :: JSON.Value -> BS.ByteString
unquoted (JSON.String t) = encodeUtf8 t
unquoted v = LBS.toStrict $ JSON.encode v
-- impossible case - just added to please -Wincomplete-patterns
parseClaims _ _ = return AuthResult { authClaims = KM.empty, authRole = mempty }
@@ -102,14 +104,52 @@ middleware appState app req respond = do
conf <- getConfig appState
time <- getTime appState
let token = fromMaybe "" $ Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req)
authResult <- runExceptT $
parseToken conf (LBS.fromStrict token) time >>=
parseClaims conf
let token = fromMaybe "" $ Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req)
parseJwt = runExceptT $ parseToken conf (LBS.fromStrict token) time >>= parseClaims conf
-- If DbPlanEnabled -> calculate JWT validation time
-- If JwtCacheMaxLifetime -> cache JWT validation result
req' <- case (configServerTimingEnabled conf, configJwtCacheMaxLifetime conf) of
(True, 0) -> do
(dur, authResult) <- timeItT parseJwt
return $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult & Vault.insert jwtDurKey dur }
(True, maxLifetime) -> do
(dur, authResult) <- timeItT $ getJWTFromCache appState token maxLifetime parseJwt time
return $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult & Vault.insert jwtDurKey dur }
(False, 0) -> do
authResult <- parseJwt
return $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
(False, maxLifetime) -> do
authResult <- getJWTFromCache appState token maxLifetime parseJwt time
return $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
let req' = req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
app req' respond
-- | Used to retrieve and insert JWT to JWT Cache
getJWTFromCache :: AppState -> ByteString -> Int -> IO (Either Error AuthResult) -> UTCTime -> IO (Either Error AuthResult)
getJWTFromCache appState token maxLifetime parseJwt utc = do
checkCache <- C.lookup (getJwtCache appState) token
authResult <- maybe parseJwt (pure . Right) checkCache
case (authResult,checkCache) of
(Right res, Nothing) -> C.insert' (getJwtCache appState) (getTimeSpec res maxLifetime utc) token res
_ -> pure ()
return authResult
-- Used to extract JWT exp claim and add to JWT Cache
getTimeSpec :: AuthResult -> Int -> UTCTime -> Maybe TimeSpec
getTimeSpec res maxLifetime utc = do
let expireJSON = KM.lookup "exp" (authClaims res)
utcToSecs = floor . nominalDiffTimeToSeconds . utcTimeToPOSIXSeconds
sciToInt = fromMaybe 0 . Sci.toBoundedInteger
case expireJSON of
Just (JSON.Number seconds) -> Just $ TimeSpec (sciToInt seconds - utcToSecs utc) 0
_ -> Just $ TimeSpec (fromIntegral maxLifetime :: Int64) 0
authResultKey :: Vault.Key (Either Error AuthResult)
authResultKey = unsafePerformIO Vault.newKey
{-# NOINLINE authResultKey #-}
@@ -117,5 +157,12 @@ authResultKey = unsafePerformIO Vault.newKey
getResult :: Wai.Request -> Maybe (Either Error AuthResult)
getResult = Vault.lookup authResultKey . Wai.vault
getRole :: Wai.Request -> Maybe Text
jwtDurKey :: Vault.Key Double
jwtDurKey = unsafePerformIO Vault.newKey
{-# NOINLINE jwtDurKey #-}
getJwtDur :: Wai.Request -> Maybe Double
getJwtDur = Vault.lookup jwtDurKey . Wai.vault
getRole :: Wai.Request -> Maybe BS.ByteString
getRole req = authRole <$> (rightToMaybe =<< getResult req)
+40 -24
View File
@@ -19,9 +19,8 @@ import Text.Heredoc (str)
import PostgREST.AppState (AppState)
import PostgREST.Config (AppConfig (..))
import PostgREST.DbStructure (queryDbStructure)
import PostgREST.SchemaCache (querySchemaCache)
import PostgREST.Version (prettyVersion)
import PostgREST.Workers (reReadConfig)
import qualified PostgREST.App as App
import qualified PostgREST.AppState as AppState
@@ -30,10 +29,10 @@ import qualified PostgREST.Config as Config
import Protolude hiding (hPutStrLn)
main :: App.SignalHandlerInstaller -> Maybe App.SocketRunner -> CLI -> IO ()
main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
main :: CLI -> IO ()
main CLI{cliCommand, cliPath} = do
conf@AppConfig{..} <-
either panic identity <$> Config.readAppConfig mempty cliPath Nothing
either panic identity <$> Config.readAppConfig mempty cliPath Nothing mempty mempty
-- Per https://github.com/PostgREST/postgrest/issues/268, we want to
-- explicitly close the connections to PostgreSQL on shutdown.
@@ -43,28 +42,25 @@ main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
AppState.destroy
(\appState -> case cliCommand of
CmdDumpConfig -> do
when configDbConfig $ reReadConfig True appState
when configDbConfig $ AppState.reReadConfig True appState
putStr . Config.toText =<< AppState.getConfig appState
CmdDumpSchema -> putStrLn =<< dumpSchema appState
CmdRun -> App.run installSignalHandlers runAppWithSocket appState)
CmdRun -> App.run appState)
-- | Dump DbStructure schema to JSON
-- | Dump SchemaCache schema to JSON
dumpSchema :: AppState -> IO LBS.ByteString
dumpSchema appState = do
AppConfig{..} <- AppState.getConfig appState
conf@AppConfig{..} <- AppState.getConfig appState
result <-
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
AppState.usePool appState $
AppState.usePool appState conf $
transaction SQL.ReadCommitted SQL.Read $
queryDbStructure
(toList configDbSchemas)
configDbExtraSearchPath
configDbPreparedStatements
querySchemaCache conf
case result of
Left e -> do
hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
exitFailure
Right dbStructure -> return $ JSON.encode dbStructure
Right sCache -> return $ JSON.encode sCache
-- | Command line interface options
data CLI = CLI
@@ -84,7 +80,7 @@ readCLIShowHelp =
where
prefs = O.prefs $ O.showHelpOnError <> O.showHelpOnEmpty
opts = O.info parser $ O.fullDesc <> progDesc
parser = O.helper <*> exampleParser <*> cliParser
parser = O.helper <*> versionFlag <*> exampleParser <*> cliParser
progDesc =
O.progDesc $
@@ -92,6 +88,12 @@ readCLIShowHelp =
<> BS.unpack prettyVersion
<> " / create a REST API to an existing Postgres database"
versionFlag =
O.infoOption ("PostgREST " <> BS.unpack prettyVersion) $
O.long "version"
<> O.short 'v'
<> O.help "Show the version information"
exampleParser =
O.infoOption exampleConfigFile $
O.long "example"
@@ -136,6 +138,9 @@ exampleConfigFile =
|## Enable in-database configuration
|db-config = true
|
|## Function for in-database configuration
|## db-pre-config = "postgrest.pre_config"
|
|## Extra schemas to add to the search_path of every request
|db-extra-search-path = "public"
|
@@ -148,8 +153,17 @@ exampleConfigFile =
|## Number of open connections in the pool
|db-pool = 10
|
|## Time to live, in seconds, for an idle database pool connection
|db-pool-timeout = 3600
|## Time in seconds to wait to acquire a slot from the connection pool
|# db-pool-acquisition-timeout = 10
|
|## Time in seconds after which to recycle pool connections
|# db-pool-max-lifetime = 1800
|
|## Time in seconds after which to recycle unused pool connections
|# db-pool-max-idletime = 30
|
|## Allow automatic database connection retrying
|# db-pool-automatic-recovery = true
|
|## Stored proc to exec immediately after auth
|# db-pre-request = "stored_proc_name"
@@ -177,10 +191,6 @@ exampleConfigFile =
|## https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING
|db-uri = "postgresql://"
|
|## Determine if GUC request settings for headers, cookies and jwt claims use the legacy names (string with dashes, invalid starting from PostgreSQL v14) with text values instead of the new names (string without dashes, valid on all PostgreSQL versions) with json values.
|## For PostgreSQL v14 and up, this setting will be ignored.
|db-use-legacy-gucs = true
|
|# jwt-aud = "your_audience_claim"
|
|## Jspath to the role claim key
@@ -191,6 +201,9 @@ exampleConfigFile =
|# jwt-secret = "secret_with_at_least_32_characters"
|jwt-secret-is-base64 = false
|
|## Enables and set JWT Cache max lifetime, disables caching with 0
|# jwt-cache-max-lifetime = 0
|
|## Logging level, the admitted values are: crit, error, warn and info.
|log-level = "error"
|
@@ -201,12 +214,15 @@ exampleConfigFile =
|## Base url for the OpenAPI output
|openapi-server-proxy-uri = ""
|
|## Content types to produce raw output
|# raw-media-types="image/png, image/jpg"
|## Configurable CORS origins
|# server-cors-allowed-origins = ""
|
|server-host = "!4"
|server-port = 3000
|
|## Allow getting the request-response timing information through the `Server-Timing` header
|server-timing-enabled = false
|
|## Unix socket location
|## if specified it takes precedence over server-port
|# server-unix-socket = "/tmp/pgrst.sock"
+130 -59
View File
@@ -24,6 +24,7 @@ module PostgREST.Config
, readPGRSTEnvironment
, toURI
, parseSecret
, addFallbackAppName
) where
import qualified Crypto.JOSE.Types as JOSE
@@ -32,6 +33,7 @@ import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as LBS
import qualified Data.CaseInsensitive as CI
import qualified Data.Configurator as C
import qualified Data.Map.Strict as M
import qualified Data.Text as T
@@ -46,60 +48,74 @@ import Data.List (lookup)
import Data.List.NonEmpty (fromList, toList)
import Data.Maybe (fromJust)
import Data.Scientific (floatingOrInteger)
import Data.Time.Clock (NominalDiffTime)
import Network.URI (escapeURIString,
isUnescapedInURIComponent, parseURI,
uriQuery)
import Numeric (readOct, showOct)
import System.Environment (getEnvironment)
import System.Posix.Types (FileMode)
import PostgREST.Config.Database (RoleIsolationLvl,
RoleSettings)
import PostgREST.Config.JSPath (JSPath, JSPathExp (..),
dumpJSPath, pRoleClaimKey)
import PostgREST.Config.Proxy (Proxy (..),
isMalformedProxyUri, toURI)
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi,
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier, dumpQi,
toQi)
import PostgREST.MediaType (MediaType (..), toMime)
import Protolude hiding (Proxy, toList)
data AppConfig = AppConfig
{ configAppSettings :: [(Text, Text)]
, configDbAnonRole :: Maybe Text
, configDbChannel :: Text
, configDbChannelEnabled :: Bool
, configDbExtraSearchPath :: [Text]
, configDbMaxRows :: Maybe Integer
, configDbPlanEnabled :: Bool
, configDbPoolSize :: Int
, configDbPoolTimeout :: NominalDiffTime
, configDbPreRequest :: Maybe QualifiedIdentifier
, configDbPreparedStatements :: Bool
, configDbRootSpec :: Maybe QualifiedIdentifier
, configDbSchemas :: NonEmpty Text
, configDbConfig :: Bool
, configDbTxAllowOverride :: Bool
, configDbTxRollbackAll :: Bool
, configDbUri :: Text
, configDbUseLegacyGucs :: Bool
, configFilePath :: Maybe FilePath
, configJWKS :: Maybe JWKSet
, configJwtAudience :: Maybe StringOrURI
, configJwtRoleClaimKey :: JSPath
, configJwtSecret :: Maybe BS.ByteString
, configJwtSecretIsBase64 :: Bool
, configLogLevel :: LogLevel
, configOpenApiMode :: OpenAPIMode
, configOpenApiSecurityActive :: Bool
, configOpenApiServerProxyUri :: Maybe Text
, configRawMediaTypes :: [MediaType]
, configServerHost :: Text
, configServerPort :: Int
, configServerUnixSocket :: Maybe FilePath
, configServerUnixSocketMode :: FileMode
, configAdminServerPort :: Maybe Int
{ configAppSettings :: [(Text, Text)]
, configDbAggregates :: Bool
, configDbAnonRole :: Maybe BS.ByteString
, configDbChannel :: Text
, configDbChannelEnabled :: Bool
, configDbExtraSearchPath :: [Text]
, configDbMaxRows :: Maybe Integer
, configDbPlanEnabled :: Bool
, configDbPoolSize :: Int
, configDbPoolAcquisitionTimeout :: Int
, configDbPoolMaxLifetime :: Int
, configDbPoolMaxIdletime :: Int
, configDbPoolAutomaticRecovery :: Bool
, configDbPreRequest :: Maybe QualifiedIdentifier
, configDbPreparedStatements :: Bool
, configDbRootSpec :: Maybe QualifiedIdentifier
, configDbSchemas :: NonEmpty Text
, configDbConfig :: Bool
, configDbPreConfig :: Maybe QualifiedIdentifier
, configDbTxAllowOverride :: Bool
, configDbTxRollbackAll :: Bool
, configDbUri :: Text
, configFilePath :: Maybe FilePath
, configJWKS :: Maybe JWKSet
, configJwtAudience :: Maybe StringOrURI
, configJwtRoleClaimKey :: JSPath
, configJwtSecret :: Maybe BS.ByteString
, configJwtSecretIsBase64 :: Bool
, configJwtCacheMaxLifetime :: Int
, configLogLevel :: LogLevel
, configOpenApiMode :: OpenAPIMode
, configOpenApiSecurityActive :: Bool
, configOpenApiServerProxyUri :: Maybe Text
, configServerCorsAllowedOrigins :: Maybe [Text]
, configServerHost :: Text
, configServerPort :: Int
, configServerTraceHeader :: Maybe (CI.CI BS.ByteString)
, configServerTimingEnabled :: Bool
, configServerUnixSocket :: Maybe FilePath
, configServerUnixSocketMode :: FileMode
, configAdminServerPort :: Maybe Int
, configRoleSettings :: RoleSettings
, configRoleIsoLvl :: RoleIsolationLvl
, configInternalSCSleep :: Maybe Int32
}
data LogLevel = LogCrit | LogError | LogWarn | LogInfo
deriving (Eq, Ord)
dumpLogLevel :: LogLevel -> Text
dumpLogLevel = \case
@@ -124,33 +140,40 @@ toText conf =
where
-- apply conf to all pgrst settings
pgrstSettings = (\(k, v) -> (k, v conf)) <$>
[("db-anon-role", q . fromMaybe "" . configDbAnonRole)
[("db-aggregates-enabled", T.toLower . show . configDbAggregates)
,("db-anon-role", q . T.decodeUtf8 . fromMaybe "" . configDbAnonRole)
,("db-channel", q . configDbChannel)
,("db-channel-enabled", T.toLower . show . configDbChannelEnabled)
,("db-extra-search-path", q . T.intercalate "," . configDbExtraSearchPath)
,("db-max-rows", maybe "\"\"" show . configDbMaxRows)
,("db-plan-enabled", T.toLower . show . configDbPlanEnabled)
,("db-pool", show . configDbPoolSize)
,("db-pool-timeout", show . floor . configDbPoolTimeout)
,("db-pool-acquisition-timeout", show . configDbPoolAcquisitionTimeout)
,("db-pool-max-lifetime", show . configDbPoolMaxLifetime)
,("db-pool-max-idletime", show . configDbPoolMaxIdletime)
,("db-pool-automatic-recovery", T.toLower . show . configDbPoolAutomaticRecovery)
,("db-pre-request", q . maybe mempty dumpQi . configDbPreRequest)
,("db-prepared-statements", T.toLower . show . configDbPreparedStatements)
,("db-root-spec", q . maybe mempty dumpQi . configDbRootSpec)
,("db-schemas", q . T.intercalate "," . toList . configDbSchemas)
,("db-config", T.toLower . show . configDbConfig)
,("db-pre-config", q . maybe mempty dumpQi . configDbPreConfig)
,("db-tx-end", q . showTxEnd)
,("db-uri", q . configDbUri)
,("db-use-legacy-gucs", T.toLower . show . configDbUseLegacyGucs)
,("jwt-aud", T.decodeUtf8 . LBS.toStrict . JSON.encode . maybe "" toJSON . configJwtAudience)
,("jwt-role-claim-key", q . T.intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey)
,("jwt-secret", q . T.decodeUtf8 . showJwtSecret)
,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)
,("jwt-cache-max-lifetime", show . configJwtCacheMaxLifetime)
,("log-level", q . dumpLogLevel . configLogLevel)
,("openapi-mode", q . dumpOpenApiMode . configOpenApiMode)
,("openapi-security-active", T.toLower . show . configOpenApiSecurityActive)
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
,("raw-media-types", q . T.decodeUtf8 . BS.intercalate "," . fmap toMime . configRawMediaTypes)
,("server-cors-allowed-origins", q . maybe "" (T.intercalate ",") . configServerCorsAllowedOrigins)
,("server-host", q . configServerHost)
,("server-port", show . configServerPort)
,("server-trace-header", q . T.decodeUtf8 . maybe mempty CI.original . configServerTraceHeader)
,("server-timing-enabled", T.toLower . show . configServerTimingEnabled)
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
,("server-unix-socket-mode", q . T.pack . showSocketMode)
,("admin-server-port", maybe "\"\"" show . configAdminServerPort)
@@ -187,13 +210,13 @@ instance JustIfMaybe a (Maybe a) where
-- | Reads and parses the config and overrides its parameters from env vars,
-- files or db settings.
readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> IO (Either Text AppConfig)
readAppConfig dbSettings optPath prevDbUri = do
readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> RoleSettings -> RoleIsolationLvl -> IO (Either Text AppConfig)
readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl = do
env <- readPGRSTEnvironment
-- if no filename provided, start with an empty map to read config from environment
conf <- maybe (return $ Right M.empty) loadConfig optPath
case C.runParser (parser optPath env dbSettings) =<< mapLeft show conf of
case C.runParser (parser optPath env dbSettings roleSettings roleIsolationLvl) =<< mapLeft show conf of
Left err ->
return . Left $ "Error in config " <> err
Right parsedConfig ->
@@ -208,11 +231,12 @@ readAppConfig dbSettings optPath prevDbUri = do
decodeJWKS <$>
(decodeSecret =<< readSecretFile =<< readDbUriFile prevDbUri parsedConfig)
parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> C.Parser C.Config AppConfig
parser optPath env dbSettings =
parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> RoleSettings -> RoleIsolationLvl -> C.Parser C.Config AppConfig
parser optPath env dbSettings roleSettings roleIsolationLvl =
AppConfig
<$> parseAppSettings "app.settings"
<*> optString "db-anon-role"
<*> (fromMaybe False <$> optBool "db-aggregates-enabled")
<*> (fmap encodeUtf8 <$> optString "db-anon-role")
<*> (fromMaybe "pgrst" <$> optString "db-channel")
<*> (fromMaybe True <$> optBool "db-channel-enabled")
<*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path")
@@ -220,7 +244,11 @@ parser optPath env dbSettings =
(optInt "max-rows")
<*> (fromMaybe False <$> optBool "db-plan-enabled")
<*> (fromMaybe 10 <$> optInt "db-pool")
<*> (fromIntegral . fromMaybe 3600 <$> optInt "db-pool-timeout")
<*> (fromMaybe 10 <$> optInt "db-pool-acquisition-timeout")
<*> (fromMaybe 1800 <$> optInt "db-pool-max-lifetime")
<*> (fromMaybe 30 <$> optWithAlias (optInt "db-pool-timeout")
(optInt "db-pool-max-idletime"))
<*> (fromMaybe True <$> optBool "db-pool-automatic-recovery")
<*> (fmap toQi <$> optWithAlias (optString "db-pre-request")
(optString "pre-request"))
<*> (fromMaybe True <$> optBool "db-prepared-statements")
@@ -229,10 +257,10 @@ parser optPath env dbSettings =
<*> (fromList . maybe ["public"] splitOnCommas <$> optWithAlias (optValue "db-schemas")
(optValue "db-schema"))
<*> (fromMaybe True <$> optBool "db-config")
<*> (fmap toQi <$> optString "db-pre-config")
<*> parseTxEnd "db-tx-end" snd
<*> parseTxEnd "db-tx-end" fst
<*> (fromMaybe "postgresql://" <$> optString "db-uri")
<*> (fromMaybe True <$> optBool "db-use-legacy-gucs")
<*> pure optPath
<*> pure Nothing
<*> parseJwtAudience "jwt-aud"
@@ -241,16 +269,22 @@ parser optPath env dbSettings =
<*> (fromMaybe False <$> optWithAlias
(optBool "jwt-secret-is-base64")
(optBool "secret-is-base64"))
<*> (fromMaybe 0 <$> optInt "jwt-cache-max-lifetime")
<*> parseLogLevel "log-level"
<*> parseOpenAPIMode "openapi-mode"
<*> (fromMaybe False <$> optBool "openapi-security-active")
<*> parseOpenAPIServerProxyURI "openapi-server-proxy-uri"
<*> (maybe [] (fmap (MTOther . encodeUtf8) . splitOnCommas) <$> optValue "raw-media-types")
<*> parseCORSAllowedOrigins "server-cors-allowed-origins"
<*> (fromMaybe "!4" <$> optString "server-host")
<*> (fromMaybe 3000 <$> optInt "server-port")
<*> (fmap (CI.mk . encodeUtf8) <$> optString "server-trace-header")
<*> (fromMaybe False <$> optBool "server-timing-enabled")
<*> (fmap T.unpack <$> optString "server-unix-socket")
<*> parseSocketFileMode "server-unix-socket-mode"
<*> optInt "admin-server-port"
<*> pure roleSettings
<*> pure roleIsolationLvl
<*> optInt "internal-schema-cache-sleep"
where
parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)]
parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value
@@ -323,6 +357,11 @@ parser optPath env dbSettings =
Nothing -> pure [JSPKey "role"]
Just rck -> either (fail . show) pure $ pRoleClaimKey rck
parseCORSAllowedOrigins k =
optString k >>= \case
Nothing -> pure Nothing
Just orig -> pure $ Just (T.strip <$> T.splitOn "," orig)
optWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a)
optWithAlias orig alias =
orig >>= \case
@@ -345,20 +384,14 @@ parser optPath env dbSettings =
(C.Key -> C.Parser C.Value a -> C.Parser C.Config b) ->
C.Key -> (C.Value -> a) -> C.Parser C.Config b
overrideFromDbOrEnvironment necessity key coercion =
case reloadableDbSetting <|> M.lookup envVarName env of
case dbConf <|> M.lookup envVarName env of
Just dbOrEnvVal -> pure $ justIfMaybe $ coercion $ C.String dbOrEnvVal
Nothing -> necessity key (coercion <$> C.value)
Nothing -> necessity key (coercion <$> C.value)
where
dashToUnderscore '-' = '_'
dashToUnderscore c = c
envVarName = "PGRST_" <> (toUpper . dashToUnderscore <$> toS key)
reloadableDbSetting =
let dbSettingName = T.pack $ dashToUnderscore <$> toS key in
if dbSettingName `notElem` [
"server_host", "server_port", "server_unix_socket", "server_unix_socket_mode", "admin_server_port", "log_level",
"db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_pool_timeout", "db_config"]
then lookup dbSettingName dbSettings
else Nothing
dbConf = lookup (T.pack $ dashToUnderscore <$> toS key) dbSettings
coerceText :: C.Value -> Text
coerceText (C.String s) = s
@@ -445,3 +478,41 @@ type Environment = M.Map [Char] Text
readPGRSTEnvironment :: IO Environment
readPGRSTEnvironment =
M.map T.pack . M.fromList . filter (isPrefixOf "PGRST_" . fst) <$> getEnvironment
-- | Adds a `fallback_application_name` value to the connection string. This allows querying the PostgREST version on pg_stat_activity.
--
-- >>> let ver = "11.1.0 (5a04ec7)"::ByteString
-- >>> let strangeVer = "11'1&0@#$%,.:\"[]{}?+^()=asdfqwer"::ByteString
--
-- >>> addFallbackAppName ver "postgres://user:pass@host:5432/postgres"
-- "postgres://user:pass@host:5432/postgres?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
--
-- >>> addFallbackAppName ver "postgres://user:pass@host:5432/postgres?"
-- "postgres://user:pass@host:5432/postgres?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
--
-- >>> addFallbackAppName ver "postgres:///postgres?host=server&port=5432"
-- "postgres:///postgres?host=server&port=5432&fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
--
-- >>> addFallbackAppName ver "postgresql://"
-- "postgresql://?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
--
-- >>> addFallbackAppName strangeVer "postgres:///postgres?host=server&port=5432"
-- "postgres:///postgres?host=server&port=5432&fallback_application_name=PostgREST%2011%271%260%40%23%24%25%2C.%3A%22%5B%5D%7B%7D%3F%2B%5E%28%29%3Dasdfqwer"
--
-- >>> addFallbackAppName ver "postgres://user:invalid_chars[]#@host:5432/postgres"
-- "postgres://user:invalid_chars[]#@host:5432/postgres"
--
-- >>> addFallbackAppName ver "invalid_uri1=val1 invalid_uri2=val2"
-- "invalid_uri1=val1 invalid_uri2=val2"
addFallbackAppName :: ByteString -> Text -> Text
addFallbackAppName version dbUri = dbUri <>
case uriQuery <$> parseURI (toS dbUri) of
-- Does not add the application name to key=val connection strings or invalid URIs
Nothing -> mempty
Just "" -> "?" <> uriFmt
Just "?" -> uriFmt
_ -> "&" <> uriFmt
where
uriFmt = pKeyWord <> toS (escapeURIString isUnescapedInURIComponent $ toS pgrstVer)
pKeyWord = "fallback_application_name="
pgrstVer = "PostgREST " <> T.decodeUtf8 version
+166 -28
View File
@@ -4,9 +4,18 @@ module PostgREST.Config.Database
( pgVersionStatement
, queryDbSettings
, queryPgVersion
, queryRoleSettings
, RoleSettings
, RoleIsolationLvl
, TimezoneNames
, toIsolationLevel
) where
import PostgREST.Config.PgVersion (PgVersion (..))
import Control.Arrow ((***))
import PostgREST.Config.PgVersion (PgVersion (..), pgVersion150)
import qualified Data.HashMap.Strict as HM
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
@@ -15,51 +24,180 @@ import qualified Hasql.Statement as SQL
import qualified Hasql.Transaction as SQL
import qualified Hasql.Transaction.Sessions as SQL
import Text.InterpolatedString.Perl6 (q)
import Text.InterpolatedString.Perl6 (q, qc)
import Protolude
queryPgVersion :: Session PgVersion
queryPgVersion = statement mempty pgVersionStatement
type RoleSettings = (HM.HashMap ByteString (HM.HashMap ByteString ByteString))
type RoleIsolationLvl = HM.HashMap ByteString SQL.IsolationLevel
type TimezoneNames = Set ByteString -- cache timezone names for prefer timezone=
pgVersionStatement :: SQL.Statement () PgVersion
pgVersionStatement = SQL.Statement sql HE.noParams versionRow False
toIsolationLevel :: (Eq a, IsString a) => a -> SQL.IsolationLevel
toIsolationLevel a = case a of
"repeatable read" -> SQL.RepeatableRead
"serializable" -> SQL.Serializable
_ -> SQL.ReadCommitted
prefix :: Text
prefix = "pgrst."
-- | In-db settings names
dbSettingsNames :: [Text]
dbSettingsNames =
(prefix <>) <$>
["db_aggregates_enabled"
,"db_anon_role"
,"db_pre_config"
,"db_extra_search_path"
,"db_max_rows"
,"db_plan_enabled"
,"db_pre_request"
,"db_prepared_statements"
,"db_root_spec"
,"db_schemas"
,"db_tx_end"
,"jwt_aud"
,"jwt_role_claim_key"
,"jwt_secret"
,"jwt_secret_is_base64"
,"jwt_cache_max_lifetime"
,"openapi_mode"
,"openapi_security_active"
,"openapi_server_proxy_uri"
,"raw_media_types"
,"server_trace_header"
,"server_timing_enabled"
]
queryPgVersion :: Bool -> Session PgVersion
queryPgVersion prepared = statement mempty $ pgVersionStatement prepared
pgVersionStatement :: Bool -> SQL.Statement () PgVersion
pgVersionStatement = SQL.Statement sql HE.noParams versionRow
where
sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text
queryDbSettings :: Bool -> Session [(Text, Text)]
queryDbSettings prepared =
-- | Query the in-database configuration. The settings have the following priorities:
--
-- 1. Role + with database-specific settings:
-- ALTER ROLE authenticator IN DATABASE postgres SET <prefix>jwt_aud = 'val';
-- 2. Role + with settings:
-- ALTER ROLE authenticator SET <prefix>jwt_aud = 'overridden';
-- 3. pre-config function:
-- CREATE FUNCTION pre_config() .. PERFORM set_config(<prefix>jwt_aud, 'pre_config_aud'..)
--
-- The example above will result in <prefix>jwt_aud = 'val'
-- A setting on the database only will have no effect: ALTER DATABASE postgres SET <prefix>jwt_aud = 'xx'
queryDbSettings :: Maybe Text -> Bool -> Session [(Text, Text)]
queryDbSettings preConfFunc prepared =
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty dbSettingsStatement
-- | Get db settings from the connection role. Global settings will be overridden by database specific settings.
dbSettingsStatement :: SQL.Statement () [(Text, Text)]
dbSettingsStatement = SQL.Statement sql HE.noParams decodeSettings False
transaction SQL.ReadCommitted SQL.Read $ SQL.statement dbSettingsNames $ SQL.Statement sql (arrayParam HE.text) decodeSettings prepared
where
sql = [q|
sql = [qc|
WITH
role_setting (database, setting) AS (
SELECT setdatabase,
unnest(setconfig)
FROM pg_catalog.pg_db_role_setting
WHERE setrole = CURRENT_USER::regrole::oid
AND setdatabase IN (0, (SELECT oid FROM pg_catalog.pg_database WHERE datname = CURRENT_CATALOG))
role_setting AS (
SELECT setdatabase as database,
unnest(setconfig) as setting
FROM pg_catalog.pg_db_role_setting
WHERE setrole = CURRENT_USER::regrole::oid
AND setdatabase IN (0, (SELECT oid FROM pg_catalog.pg_database WHERE datname = CURRENT_CATALOG))
),
kv_settings (database, k, v) AS (
kv_settings AS (
SELECT database,
substr(setting, 1, strpos(setting, '=') - 1),
substr(setting, strpos(setting, '=') + 1)
FROM role_setting
WHERE setting LIKE 'pgrst.%'
substr(setting, 1, strpos(setting, '=') - 1) as k,
substr(setting, strpos(setting, '=') + 1) as v
FROM role_setting
{preConfigF}
)
SELECT DISTINCT ON (key)
replace(k, 'pgrst.', '') AS key,
replace(k, '{prefix}', '') AS key,
v AS value
FROM kv_settings
ORDER BY key, database DESC;
FROM kv_settings
WHERE k = ANY($1) AND v IS NOT NULL
ORDER BY key, database DESC NULLS LAST;
|]
preConfigF = case preConfFunc of
Nothing -> mempty
Just func -> [qc|
UNION
SELECT
null as database,
x as k,
current_setting(x, true) as v
FROM unnest($1) x
JOIN {func}() _ ON TRUE
|]::Text
decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text
queryRoleSettings :: PgVersion -> Bool -> Session (RoleSettings, RoleIsolationLvl)
queryRoleSettings pgVer prepared =
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ SQL.Statement sql HE.noParams (processRows <$> rows) prepared
where
sql = [q|
with
role_setting as (
select r.rolname, unnest(r.rolconfig) as setting
from pg_auth_members m
join pg_roles r on r.oid = m.roleid
where member = current_user::regrole::oid
),
kv_settings AS (
SELECT
rolname,
substr(setting, 1, strpos(setting, '=') - 1) as key,
lower(substr(setting, strpos(setting, '=') + 1)) as value
FROM role_setting
),
iso_setting AS (
SELECT rolname, value
FROM kv_settings
WHERE key = 'default_transaction_isolation'
)
select
kv.rolname,
i.value as iso_lvl,
coalesce(array_agg(row(kv.key, kv.value)) filter (where key <> 'default_transaction_isolation'), '{}') as role_settings
from kv_settings kv
join pg_settings ps on ps.name = kv.key |] <>
(if pgVer >= pgVersion150
then "and (ps.context = 'user' or has_parameter_privilege(current_user::regrole::oid, ps.name, 'set')) "
else "and ps.context = 'user' ") <> [q|
left join iso_setting i on i.rolname = kv.rolname
group by kv.rolname, i.value;
|]
processRows :: [(Text, Maybe Text, [(Text, Text)])] -> (RoleSettings, RoleIsolationLvl)
processRows rs =
let
rowsWRoleSettings = [ (x, z) | (x, _, z) <- rs ]
rowsWIsolation = [ (x, y) | (x, Just y, _) <- rs ]
in
( HM.fromList $ bimap encodeUtf8 (HM.fromList . ((encodeUtf8 *** encodeUtf8) <$>)) <$> rowsWRoleSettings
, HM.fromList $ (encodeUtf8 *** toIsolationLevel) <$> rowsWIsolation
)
rows :: HD.Result [(Text, Maybe Text, [(Text, Text)])]
rows = HD.rowList $ (,,) <$> column HD.text <*> nullableColumn HD.text <*> compositeArrayColumn ((,) <$> compositeField HD.text <*> compositeField HD.text)
column :: HD.Value a -> HD.Row a
column = HD.column . HD.nonNullable
nullableColumn :: HD.Value a -> HD.Row (Maybe a)
nullableColumn = HD.column . HD.nullable
compositeField :: HD.Value a -> HD.Composite a
compositeField = HD.field . HD.nonNullable
compositeArrayColumn :: HD.Composite a -> HD.Row [a]
compositeArrayColumn = arrayColumn . HD.composite
arrayColumn :: HD.Value a -> HD.Row [a]
arrayColumn = column . HD.listArray . HD.nonNullable
param :: HE.Value a -> HE.Params a
param = HE.param . HE.nonNullable
arrayParam :: HE.Value a -> HE.Params [a]
arrayParam = param . HE.foldableArray . HE.nonNullable
+4
View File
@@ -13,6 +13,7 @@ module PostgREST.Config.PgVersion
, pgVersion121
, pgVersion130
, pgVersion140
, pgVersion150
) where
import qualified Data.Aeson as JSON
@@ -62,3 +63,6 @@ pgVersion130 = PgVersion 130000 "13.0"
pgVersion140 :: PgVersion
pgVersion140 = PgVersion 140000 "14.0"
pgVersion150 :: PgVersion
pgVersion150 = PgVersion 150000 "15.0"
+10 -6
View File
@@ -2,10 +2,14 @@
Module : PostgREST.Cors
Description : Wai Middleware to set cors policy.
-}
{-# LANGUAGE TupleSections #-}
module PostgREST.Cors (middleware) where
import qualified Data.ByteString.Char8 as BS
import qualified Data.CaseInsensitive as CI
import qualified Data.Text.Encoding as T
import qualified Network.Wai as Wai
import qualified Network.Wai.Middleware.Cors as Wai
@@ -13,15 +17,15 @@ import Data.List (lookup)
import Protolude
middleware :: Wai.Middleware
middleware = Wai.cors corsPolicy
middleware :: Maybe [Text] -> Wai.Middleware
middleware corsAllowedOrigins = Wai.cors $ corsPolicy corsAllowedOrigins
-- | CORS policy to be used in by Wai Cors middleware
corsPolicy :: Wai.Request -> Maybe Wai.CorsResourcePolicy
corsPolicy req = case lookup "origin" headers of
Just origin ->
corsPolicy :: Maybe [Text] -> Wai.Request -> Maybe Wai.CorsResourcePolicy
corsPolicy corsAllowedOrigins req = case lookup "origin" headers of
Just _ ->
Just Wai.CorsResourcePolicy
{ Wai.corsOrigins = Just ([origin], True)
{ Wai.corsOrigins = (, True) . map T.encodeUtf8 <$> corsAllowedOrigins
, Wai.corsMethods = ["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"]
, Wai.corsRequestHeaders = "Authorization" : accHeaders
, Wai.corsExposedHeaders = Just
-91
View File
@@ -1,91 +0,0 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module PostgREST.DbStructure.Proc
( PgType(..)
, ProcDescription(..)
, ProcParam(..)
, ProcVolatility(..)
, ProcsMap
, RetType(..)
, procReturnsScalar
, procReturnsSingle
, procReturnsVoid
, procTableName
) where
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
Schema, TableName)
import Protolude
data PgType
= Scalar
| Composite QualifiedIdentifier
deriving (Eq, Ord, Generic, JSON.ToJSON)
data RetType
= Single PgType
| SetOf PgType
deriving (Eq, Ord, Generic, JSON.ToJSON)
data ProcVolatility
= Volatile
| Stable
| Immutable
deriving (Eq, Ord, Generic, JSON.ToJSON)
data ProcDescription = ProcDescription
{ pdSchema :: Schema
, pdName :: Text
, pdDescription :: Maybe Text
, pdParams :: [ProcParam]
, pdReturnType :: Maybe RetType
, pdVolatility :: ProcVolatility
, pdHasVariadic :: Bool
}
deriving (Eq, Generic, JSON.ToJSON)
data ProcParam = ProcParam
{ ppName :: Text
, ppType :: Text
, ppReq :: Bool
, ppVar :: Bool
}
deriving (Eq, Ord, Generic, JSON.ToJSON)
-- Order by least number of params in the case of overloaded functions
instance Ord ProcDescription where
ProcDescription schema1 name1 des1 prms1 rt1 vol1 hasVar1 `compare` ProcDescription schema2 name2 des2 prms2 rt2 vol2 hasVar2
| schema1 == schema2 && name1 == name2 && length prms1 < length prms2 = LT
| schema2 == schema2 && name1 == name2 && length prms1 > length prms2 = GT
| otherwise = (schema1, name1, des1, prms1, rt1, vol1, hasVar1) `compare` (schema2, name2, des2, prms2, rt2, vol2, hasVar2)
-- | A map of all procs, all of which can be overloaded(one entry will have more than one ProcDescription).
-- | It uses a HashMap for a faster lookup.
type ProcsMap = HM.HashMap QualifiedIdentifier [ProcDescription]
procReturnsScalar :: ProcDescription -> Bool
procReturnsScalar proc = case proc of
ProcDescription{pdReturnType = Just (Single Scalar)} -> True
ProcDescription{pdReturnType = Just (SetOf Scalar)} -> True
_ -> False
procReturnsSingle :: ProcDescription -> Bool
procReturnsSingle proc = case proc of
ProcDescription{pdReturnType = Just (Single _)} -> True
_ -> False
procReturnsVoid :: ProcDescription -> Bool
procReturnsVoid proc = case proc of
ProcDescription{pdReturnType = Nothing} -> True
_ -> False
procTableName :: ProcDescription -> Maybe TableName
procTableName proc = case pdReturnType proc of
Just (SetOf (Composite qi)) -> Just $ qiName qi
Just (Single (Composite qi)) -> Just $ qiName qi
_ -> Nothing
+402 -239
View File
@@ -11,12 +11,15 @@ module PostgREST.Error
, PgError(..)
, Error(..)
, errorPayload
, checkIsFatal
, singularityError
, status
) where
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
import qualified Data.CaseInsensitive as CI
import qualified Data.FuzzySet as Fuzzy
import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Internal as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
@@ -24,22 +27,25 @@ import qualified Hasql.Pool as SQL
import qualified Hasql.Session as SQL
import qualified Network.HTTP.Types.Status as HTTP
import Data.Aeson ((.=))
import Data.Aeson ((.:), (.:?), (.=))
import Network.Wai (Response, responseLBS)
import Network.HTTP.Types.Header (Header)
import PostgREST.MediaType (MediaType (..))
import qualified PostgREST.MediaType as MediaType
import PostgREST.Request.Types (ApiRequestError (..),
QPError (..))
import PostgREST.ApiRequest.Types (ApiRequestError (..),
QPError (..),
RangeError (..))
import PostgREST.MediaType (MediaType (..))
import qualified PostgREST.MediaType as MediaType
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcParam (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
Schema)
import PostgREST.SchemaCache.Relationship (Cardinality (..),
Junction (..),
Relationship (..))
Relationship (..),
RelationshipsMap)
import PostgREST.SchemaCache.Routine (Routine (..),
RoutineParam (..))
import Protolude
@@ -51,124 +57,289 @@ class (JSON.ToJSON a) => PgrstError a where
errorPayload = JSON.encode
errorResponseFor :: a -> Response
errorResponseFor err = responseLBS (status err) (headers err) $ errorPayload err
errorResponseFor err =
let baseHeader = MediaType.toContentType MTApplicationJSON in
responseLBS (status err) (baseHeader : headers err) $ errorPayload err
instance PgrstError ApiRequestError where
status AggregatesNotAllowed{} = HTTP.status400
status AmbiguousRelBetween{} = HTTP.status300
status AmbiguousRpc{} = HTTP.status300
status MediaTypeError{} = HTTP.status415
status InvalidBody{} = HTTP.status400
status InvalidFilters = HTTP.status405
status InvalidPreferences{} = HTTP.status400
status InvalidRpcMethod{} = HTTP.status405
status InvalidRange = HTTP.status416
status InvalidRange{} = HTTP.status416
status NotFound = HTTP.status404
status NoRelBetween{} = HTTP.status400
status NoRpc{} = HTTP.status404
status NotEmbedded{} = HTTP.status400
status ParseRequestError{} = HTTP.status400
status PutRangeNotAllowedError = HTTP.status400
status PutLimitNotAllowedError = HTTP.status400
status QueryParamError{} = HTTP.status400
status RelatedOrderNotToOne{} = HTTP.status400
status SpreadNotToOne{} = HTTP.status400
status UnacceptableFilter{} = HTTP.status400
status UnacceptableSchema{} = HTTP.status406
status UnsupportedMethod{} = HTTP.status405
status LimitNoOrderError = HTTP.status400
status ColumnNotFound{} = HTTP.status400
status GucHeadersError = HTTP.status500
status GucStatusError = HTTP.status500
status OffLimitsChangesError{} = HTTP.status400
status PutMatchingPkError = HTTP.status400
status SingularityError{} = HTTP.status406
status PGRSTParseError = HTTP.status500
headers _ = [MediaType.toContentType MTApplicationJSON]
headers SingularityError{} = [MediaType.toContentType $ MTVndSingularJSON False]
headers _ = mempty
toJsonPgrstError :: ErrorCode -> Text -> Maybe JSON.Value -> Maybe JSON.Value -> JSON.Value
toJsonPgrstError code msg details hint = JSON.object [
"code" .= code
, "message" .= msg
, "details" .= details
, "hint" .= hint
]
instance JSON.ToJSON ApiRequestError where
toJSON (QueryParamError (QPError message details)) = JSON.object [
"code" .= ApiRequestErrorCode00,
"message" .= message,
"details" .= details,
"hint" .= JSON.Null]
toJSON (InvalidRpcMethod method) = JSON.object [
"code" .= ApiRequestErrorCode01,
"message" .= ("Cannot use the " <> T.decodeUtf8 method <> " method on RPC"),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (InvalidBody errorMessage) = JSON.object [
"code" .= ApiRequestErrorCode02,
"message" .= T.decodeUtf8 errorMessage,
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON InvalidRange = JSON.object [
"code" .= ApiRequestErrorCode03,
"message" .= ("HTTP Range error" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (ParseRequestError message details) = JSON.object [
"code" .= ApiRequestErrorCode04,
"message" .= message,
"details" .= details,
"hint" .= JSON.Null]
toJSON InvalidFilters = JSON.object [
"code" .= ApiRequestErrorCode05,
"message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (UnacceptableSchema schemas) = JSON.object [
"code" .= ApiRequestErrorCode06,
"message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (MediaTypeError cts) = JSON.object [
"code" .= ApiRequestErrorCode07,
"message" .= ("None of these media types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts)),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (QueryParamError (QPError message details)) = toJsonPgrstError
ApiRequestErrorCode00 message (Just (JSON.String details)) Nothing
toJSON (InvalidRpcMethod method) = toJsonPgrstError
ApiRequestErrorCode01 ("Cannot use the " <> T.decodeUtf8 method <> " method on RPC") Nothing Nothing
toJSON (InvalidBody errorMessage) = toJsonPgrstError
ApiRequestErrorCode02 (T.decodeUtf8 errorMessage) Nothing Nothing
toJSON (InvalidRange rangeError) = toJsonPgrstError
ApiRequestErrorCode03
"Requested range not satisfiable"
(Just $ case rangeError of
NegativeLimit -> "Limit should be greater than or equal to zero."
LowerGTUpper -> "The lower boundary must be lower than or equal to the upper boundary in the Range header."
OutOfBounds lower total -> JSON.String $ "An offset of " <> lower <> " was requested, but there are only " <> total <> " rows.")
Nothing
toJSON InvalidFilters = toJsonPgrstError
ApiRequestErrorCode05 "Filters must include all and only primary key columns with 'eq' operators" Nothing Nothing
toJSON (UnacceptableSchema schemas) = toJsonPgrstError
ApiRequestErrorCode06 ("The schema must be one of the following: " <> T.intercalate ", " schemas) Nothing Nothing
toJSON (MediaTypeError cts) = toJsonPgrstError
ApiRequestErrorCode07 ("None of these media types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts)) Nothing Nothing
toJSON NotFound = JSON.object []
toJSON (NotEmbedded resource) = JSON.object [
"code" .= ApiRequestErrorCode08,
"message" .= ("Cannot apply filter because '" <> resource <> "' is not an embedded resource in this request" :: Text),
"details" .= JSON.Null,
"hint" .= ("Verify that '" <> resource <> "' is included in the 'select' query parameter." :: Text)]
toJSON LimitNoOrderError = JSON.object [
"code" .= ApiRequestErrorCode09,
"message" .= ("A 'limit' was applied without an explicit 'order'":: Text),
"details" .= JSON.Null,
"hint" .= ("Apply an 'order' using unique column(s)" :: Text)]
toJSON (NotEmbedded resource) = toJsonPgrstError
ApiRequestErrorCode08
("'" <> resource <> "' is not an embedded resource in this request")
Nothing
(Just $ JSON.String $ "Verify that '" <> resource <> "' is included in the 'select' query parameter.")
toJSON PutRangeNotAllowedError = JSON.object [
"code" .= ApiRequestErrorCode14,
"message" .= ("Range header and limit/offset querystring parameters are not allowed for PUT" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON LimitNoOrderError = toJsonPgrstError
ApiRequestErrorCode09 "A 'limit' was applied without an explicit 'order'" Nothing (Just "Apply an 'order' using unique column(s)")
toJSON (UnsupportedMethod method) = JSON.object [
"code" .= ApiRequestErrorCode17,
"message" .= ("Unsupported HTTP method: " <> T.decodeUtf8 method),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (OffLimitsChangesError n maxs) = toJsonPgrstError
ApiRequestErrorCode10
"The maximum number of rows allowed to change was surpassed"
(Just $ JSON.String $ T.unwords ["Results contain", show n, "rows changed but the maximum number allowed is", show maxs])
Nothing
toJSON (NoRelBetween parent child schema) = JSON.object [
"code" .= SchemaCacheErrorCode00,
"message" .= ("Could not find a relationship between '" <> parent <> "' and '" <> child <> "' in the schema cache" :: Text),
"details" .= JSON.Null,
"hint" .= ("Verify that '" <> parent <> "' and '" <> child <> "' exist in the schema '" <> schema <> "' and that there is a foreign key relationship between them. If a new relationship was created, try reloading the schema cache." :: Text)]
toJSON (AmbiguousRelBetween parent child rels) = JSON.object [
"code" .= SchemaCacheErrorCode01,
"message" .= ("Could not embed because more than one relationship was found for '" <> parent <> "' and '" <> child <> "'" :: Text),
"details" .= (compressedRel <$> rels),
"hint" .= ("Try changing '" <> child <> "' to one of the following: " <> relHint rels <> ". Find the desired relationship in the 'details' key." :: Text)]
toJSON (NoRpc schema procName argumentKeys hasPreferSingleObject contentType isInvPost) =
let prms = "(" <> T.intercalate ", " argumentKeys <> ")" in JSON.object [
"code" .= SchemaCacheErrorCode02,
"message" .= ("Could not find the " <> schema <> "." <> procName <>
toJSON GucHeadersError = toJsonPgrstError
ApiRequestErrorCode11 "response.headers guc must be a JSON array composed of objects with a single key and a string value" Nothing Nothing
toJSON GucStatusError = toJsonPgrstError
ApiRequestErrorCode12 "response.status guc must be a valid status code" Nothing Nothing
toJSON PutLimitNotAllowedError = toJsonPgrstError
ApiRequestErrorCode14 "limit/offset querystring parameters are not allowed for PUT" Nothing Nothing
toJSON PutMatchingPkError = toJsonPgrstError
ApiRequestErrorCode15 "Payload values do not match URL in primary key column(s)" Nothing Nothing
toJSON (SingularityError n) = toJsonPgrstError
ApiRequestErrorCode16
"JSON object requested, multiple (or no) rows returned"
(Just $ JSON.String $ T.unwords ["The result contains", show n, "rows"])
Nothing
toJSON (UnsupportedMethod method) = toJsonPgrstError
ApiRequestErrorCode17 ("Unsupported HTTP method: " <> T.decodeUtf8 method) Nothing Nothing
toJSON (RelatedOrderNotToOne origin target) = toJsonPgrstError
ApiRequestErrorCode18
("A related order on '" <> target <> "' is not possible")
(Just $ JSON.String $ "'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship")
Nothing
toJSON (SpreadNotToOne origin target) = toJsonPgrstError
ApiRequestErrorCode19
("A spread operation on '" <> target <> "' is not possible")
(Just $ JSON.String $ "'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship")
Nothing
toJSON (UnacceptableFilter target) = toJsonPgrstError
ApiRequestErrorCode20
("Bad operator on the '" <> target <> "' embedded resource")
(Just "Only is null or not is null filters are allowed on embedded resources")
Nothing
toJSON PGRSTParseError = toJsonPgrstError
ApiRequestErrorCode21 "The message and detail field of RAISE 'PGRST' error expects JSON" Nothing Nothing
toJSON (InvalidPreferences prefs) = toJsonPgrstError
ApiRequestErrorCode22
"Invalid preferences given with handling=strict"
(Just $ JSON.String $ T.decodeUtf8 ("Invalid preferences: " <> BS.intercalate ", " prefs))
Nothing
toJSON AggregatesNotAllowed = toJsonPgrstError
ApiRequestErrorCode23 "Use of aggregate functions is not allowed" Nothing Nothing
toJSON (NoRelBetween parent child embedHint schema allRels) = toJsonPgrstError
SchemaCacheErrorCode00
("Could not find a relationship between '" <> parent <> "' and '" <> child <> "' in the schema cache")
(Just $ JSON.String $ "Searched for a foreign key relationship between '" <> parent <> "' and '" <> child <> maybe mempty ("' using the hint '" <>) embedHint <> "' in the schema '" <> schema <> "', but no matches were found.")
(JSON.String <$> noRelBetweenHint parent child schema allRels)
toJSON (AmbiguousRelBetween parent child rels) = toJsonPgrstError
SchemaCacheErrorCode01
("Could not embed because more than one relationship was found for '" <> parent <> "' and '" <> child <> "'")
(Just $ JSON.toJSONList (compressedRel <$> rels))
(Just $ JSON.String $ "Try changing '" <> child <> "' to one of the following: " <> relHint rels <> ". Find the desired relationship in the 'details' key.")
toJSON (NoRpc schema procName argumentKeys hasPreferSingleObject contentType isInvPost allProcs overloadedProcs) =
let func = schema <> "." <> procName
prms = T.intercalate ", " argumentKeys
prmsMsg = "(" <> prms <> ")"
prmsDet = " with parameter" <> (if length argumentKeys > 1 then "s " else " ") <> prms
fmtPrms p = if null argumentKeys then " without parameters" else p
onlySingleParams = hasPreferSingleObject || (isInvPost && contentType `elem` [MTTextPlain, MTTextXML, MTOctetStream])
in toJsonPgrstError
SchemaCacheErrorCode02
("Could not find the function " <> func <> (if onlySingleParams then "" else fmtPrms prmsMsg) <> " in the schema cache")
(Just $ JSON.String $ "Searched for the function " <> func <>
(case (hasPreferSingleObject, isInvPost, contentType) of
(True, _, _) -> " function with a single json or jsonb parameter"
(_, True, MTTextPlain) -> " function with a single unnamed text parameter"
(_, True, MTTextXML) -> " function with a single unnamed xml parameter"
(_, True, MTOctetStream) -> " function with a single unnamed bytea parameter"
(_, True, MTApplicationJSON) -> prms <> " function or the " <> schema <> "." <> procName <>" function with a single unnamed json or jsonb parameter"
_ -> prms <> " function") <>
" in the schema cache"),
"details" .= JSON.Null,
"hint" .= ("If a new function was created in the database with this name and parameters, try reloading the schema cache." :: Text)]
toJSON (AmbiguousRpc procs) = JSON.object [
"code" .= SchemaCacheErrorCode03,
"message" .= ("Could not choose the best candidate function between: " <> T.intercalate ", " [pdSchema p <> "." <> pdName p <> "(" <> T.intercalate ", " [ppName a <> " => " <> ppType a | a <- pdParams p] <> ")" | p <- procs]),
"details" .= JSON.Null,
"hint" .= ("Try renaming the parameters or the function itself in the database so function overloading can be resolved" :: Text)]
(True, _, _) -> " with a single json/jsonb parameter"
(_, True, MTTextPlain) -> " with a single unnamed text parameter"
(_, True, MTTextXML) -> " with a single unnamed xml parameter"
(_, True, MTOctetStream) -> " with a single unnamed bytea parameter"
(_, True, MTApplicationJSON) -> fmtPrms prmsDet <> " or with a single unnamed json/jsonb parameter"
_ -> fmtPrms prmsDet) <>
", but no matches were found in the schema cache.")
-- The hint will be null in the case of single unnamed parameter functions
(if onlySingleParams
then Nothing
else JSON.String <$> noRpcHint schema procName argumentKeys allProcs overloadedProcs)
toJSON (AmbiguousRpc procs) = toJsonPgrstError
SchemaCacheErrorCode03
("Could not choose the best candidate function between: " <> T.intercalate ", " [pdSchema p <> "." <> pdName p <> "(" <> T.intercalate ", " [ppName a <> " => " <> ppType a | a <- pdParams p] <> ")" | p <- procs])
Nothing
(Just "Try renaming the parameters or the function itself in the database so function overloading can be resolved")
toJSON (ColumnNotFound relName colName) = toJsonPgrstError
SchemaCacheErrorCode04 ("Column '" <> colName <> "' of relation '" <> relName <> "' does not exist") Nothing Nothing
-- |
-- If no relationship is found then:
--
-- Looks for parent suggestions if parent not found
-- Looks for child suggestions if parent is found but child is not
-- Gives no suggestions if both are found (it means that there is a problem with the embed hint)
--
-- >>> :set -Wno-missing-fields
-- >>> let qi t = QualifiedIdentifier "api" t
-- >>> let rel ft = Relationship{relForeignTable = qi ft}
-- >>> let rels = HM.fromList [((qi "films", "api"), [rel "directors", rel "roles", rel "actors"])]
--
-- >>> noRelBetweenHint "film" "directors" "api" rels
-- Just "Perhaps you meant 'films' instead of 'film'."
--
-- >>> noRelBetweenHint "films" "role" "api" rels
-- Just "Perhaps you meant 'roles' instead of 'role'."
--
-- >>> noRelBetweenHint "films" "role" "api" rels
-- Just "Perhaps you meant 'roles' instead of 'role'."
--
-- >>> noRelBetweenHint "films" "actors" "api" rels
-- Nothing
--
-- >>> noRelBetweenHint "noclosealternative" "roles" "api" rels
-- Nothing
--
-- >>> noRelBetweenHint "films" "noclosealternative" "api" rels
-- Nothing
--
-- >>> noRelBetweenHint "films" "noclosealternative" "noclosealternative" rels
-- Nothing
--
noRelBetweenHint :: Text -> Text -> Schema -> RelationshipsMap -> Maybe Text
noRelBetweenHint parent child schema allRels = ("Perhaps you meant '" <>) <$>
if isJust findParent
then (<> "' instead of '" <> child <> "'.") <$> suggestChild
else (<> "' instead of '" <> parent <> "'.") <$> suggestParent
where
findParent = HM.lookup (QualifiedIdentifier schema parent, schema) allRels
fuzzySetOfParents = Fuzzy.fromList [qiName (fst p) | p <- HM.keys allRels, snd p == schema]
fuzzySetOfChildren = Fuzzy.fromList [qiName (relForeignTable c) | c <- fromMaybe [] findParent]
suggestParent = Fuzzy.getOne fuzzySetOfParents parent
-- Do not give suggestion if the child is found in the relations (weight = 1.0)
suggestChild = headMay [snd k | k <- Fuzzy.get fuzzySetOfChildren child, fst k < 1.0]
-- |
-- If no function is found with the given name, it does a fuzzy search to all the functions
-- in the same schema and shows the best match as hint.
--
-- >>> :set -Wno-missing-fields
-- >>> let procs = [(QualifiedIdentifier "api" "test"), (QualifiedIdentifier "api" "another"), (QualifiedIdentifier "private" "other")]
--
-- >>> noRpcHint "api" "testt" ["val", "param", "name"] procs []
-- Just "Perhaps you meant to call the function api.test"
--
-- >>> noRpcHint "api" "other" [] procs []
-- Just "Perhaps you meant to call the function api.another"
--
-- >>> noRpcHint "api" "noclosealternative" [] procs []
-- Nothing
--
-- If a function is found with the given name, but no params match, then it does a fuzzy search
-- to all the overloaded functions' params using the form "param1, param2, param3, ..."
-- and shows the best match as hint.
--
-- >>> let procsDesc = [Function {pdParams = [RoutineParam {ppName="val"}, RoutineParam {ppName="param"}, RoutineParam {ppName="name"}]}, Function {pdParams = [RoutineParam {ppName="id"}, RoutineParam {ppName="attr"}]}]
--
-- >>> noRpcHint "api" "test" ["vall", "pqaram", "nam"] procs procsDesc
-- Just "Perhaps you meant to call the function api.test(name, param, val)"
--
-- >>> noRpcHint "api" "test" ["val", "param"] procs procsDesc
-- Just "Perhaps you meant to call the function api.test(name, param, val)"
--
-- >>> noRpcHint "api" "test" ["id", "attrs"] procs procsDesc
-- Just "Perhaps you meant to call the function api.test(attr, id)"
--
-- >>> noRpcHint "api" "test" ["id"] procs procsDesc
-- Just "Perhaps you meant to call the function api.test(attr, id)"
--
-- >>> noRpcHint "api" "test" ["noclosealternative"] procs procsDesc
-- Nothing
--
noRpcHint :: Text -> Text -> [Text] -> [QualifiedIdentifier] -> [Routine] -> Maybe Text
noRpcHint schema procName params allProcs overloadedProcs =
fmap (("Perhaps you meant to call the function " <> schema <> ".") <>) possibleProcs
where
fuzzySetOfProcs = Fuzzy.fromList [qiName k | k <- allProcs, qiSchema k == schema]
fuzzySetOfParams = Fuzzy.fromList $ listToText <$> [[ppName prm | prm <- pdParams ov] | ov <- overloadedProcs]
-- Cannot do a fuzzy search like: Fuzzy.getOne [[Text]] [Text], where [[Text]] is the list of params for each
-- overloaded function and [Text] the given params. This converts those lists to text to make fuzzy search possible.
-- E.g. ["val", "param", "name"] into "(name, param, val)"
listToText = ("(" <>) . (<> ")") . T.intercalate ", " . sort
possibleProcs
| null overloadedProcs = Fuzzy.getOne fuzzySetOfProcs procName
| otherwise = (procName <>) <$> Fuzzy.getOne fuzzySetOfParams (listToText params)
compressedRel :: Relationship -> JSON.Value
-- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed
@@ -182,7 +353,7 @@ compressedRel Relationship{..} =
: case relCardinality of
M2M Junction{..} -> [
"cardinality" .= ("many-to-many" :: Text)
, "relationship" .= (qiName junTable <> " using " <> junConstraint1 <> fmtEls (snd <$> junColumns1) <> " and " <> junConstraint2 <> fmtEls (snd <$> junColumns2))
, "relationship" .= (qiName junTable <> " using " <> junConstraint1 <> fmtEls (snd <$> junColsSource) <> " and " <> junConstraint2 <> fmtEls (snd <$> junColsTarget))
]
M2O cons relColumns -> [
"cardinality" .= ("many-to-one" :: Text)
@@ -216,50 +387,68 @@ type Authenticated = Bool
instance PgrstError PgError where
status (PgError authed usageError) = pgErrorStatus authed usageError
headers (PgError _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError (SQL.ServerError "PGRST" m d _ _p))))) =
case (parseMessage m, parseDetails d) of
(Just _, Just r) -> headers PGRSTParseError ++ map intoHeader (M.toList $ getHeaders r)
_ -> headers PGRSTParseError
where
intoHeader (k,v) = (CI.mk $ T.encodeUtf8 k, T.encodeUtf8 v)
headers err =
if status err == HTTP.status401
then [MediaType.toContentType MTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
else [MediaType.toContentType MTApplicationJSON]
then [("WWW-Authenticate", "Bearer") :: Header]
else mempty
instance JSON.ToJSON PgError where
toJSON (PgError _ usageError) = JSON.toJSON usageError
instance JSON.ToJSON SQL.UsageError where
toJSON (SQL.ConnectionError e) = JSON.object [
"code" .= ConnectionErrorCode00,
"message" .= ("Database connection error. Retrying the connection." :: Text),
"details" .= (T.decodeUtf8With T.lenientDecode $ fromMaybe "" e :: Text),
"hint" .= JSON.Null]
toJSON (SQL.SessionError e) = JSON.toJSON e -- SQL.Error
toJSON (SQL.ConnectionUsageError e) = toJsonPgrstError
ConnectionErrorCode00
"Database connection error. Retrying the connection."
(Just $ JSON.String $ T.decodeUtf8With T.lenientDecode $ fromMaybe "" e)
Nothing
toJSON (SQL.SessionUsageError e) = JSON.toJSON e -- SQL.Error
toJSON SQL.AcquisitionTimeoutUsageError = toJsonPgrstError
ConnectionErrorCode03 "Timed out acquiring connection from connection pool." Nothing Nothing
instance JSON.ToJSON SQL.QueryError where
toJSON (SQL.QueryError _ _ e) = JSON.toJSON e
instance JSON.ToJSON SQL.CommandError where
toJSON (SQL.ResultError (SQL.ServerError c m d h)) = JSON.object [
"code" .= (T.decodeUtf8 c :: Text),
"message" .= (T.decodeUtf8 m :: Text),
"details" .= (fmap T.decodeUtf8 d :: Maybe Text),
"hint" .= (fmap T.decodeUtf8 h :: Maybe Text)]
-- Special error raised with code PGRST, to allow full response control
toJSON (SQL.ResultError (SQL.ServerError "PGRST" m d _ _p)) =
case (parseMessage m, parseDetails d) of
(Just r, Just _) -> JSON.object [
"code" .= getCode r,
"message" .= getMessage r,
"details" .= checkMaybe (getDetails r),
"hint" .= checkMaybe (getHint r)]
_ -> JSON.toJSON PGRSTParseError
where
checkMaybe = maybe JSON.Null JSON.String
toJSON (SQL.ResultError resultError) = JSON.object [
"code" .= InternalErrorCode00,
"message" .= (show resultError :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (SQL.ResultError (SQL.ServerError c m d h _p)) = JSON.object [
"code" .= (T.decodeUtf8 c :: Text),
"message" .= (T.decodeUtf8 m :: Text),
"details" .= (fmap T.decodeUtf8 d :: Maybe Text),
"hint" .= (fmap T.decodeUtf8 h :: Maybe Text)]
toJSON (SQL.ClientError d) = JSON.object [
"code" .= ConnectionErrorCode01,
"message" .= ("Database client error. Retrying the connection." :: Text),
"details" .= (fmap T.decodeUtf8 d :: Maybe Text),
"hint" .= JSON.Null]
toJSON (SQL.ResultError resultError) = toJsonPgrstError
InternalErrorCode00 (show resultError) Nothing Nothing
toJSON (SQL.ClientError d) = toJsonPgrstError
ConnectionErrorCode01 "Database client error. Retrying the connection." (JSON.String <$> fmap T.decodeUtf8 d) Nothing
pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status
pgErrorStatus _ (SQL.ConnectionError _) = HTTP.status503
pgErrorStatus _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503
pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rError))) =
pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503
pgErrorStatus _ SQL.AcquisitionTimeoutUsageError = HTTP.status504
pgErrorStatus _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503
pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) =
case rError of
(SQL.ServerError c m _ _) ->
(SQL.ServerError c m d _ _) ->
case BS.unpack c of
'0':'8':_ -> HTTP.status503 -- pg connection err
'0':'9':_ -> HTTP.status500 -- triggered action exception
@@ -278,6 +467,7 @@ pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rErr
'5':'3':_ -> HTTP.status503 -- insufficient resources
'5':'4':_ -> HTTP.status413 -- too complex
'5':'5':_ -> HTTP.status500 -- obj not on prereq state
'5':'7':'P':'0':'1':_ -> HTTP.status503 -- terminating connection due to administrator command
'5':'7':_ -> HTTP.status500 -- operator intervention
'5':'8':_ -> HTTP.status500 -- system error
'F':'0':_ -> HTTP.status500 -- conf file error
@@ -291,126 +481,49 @@ pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rErr
"42P01" -> HTTP.status404 -- undefined table
"42501" -> if authed then HTTP.status403 else HTTP.status401 -- insufficient privilege
'P':'T':n -> fromMaybe HTTP.status500 (HTTP.mkStatus <$> readMaybe n <*> pure m)
"PGRST" ->
case (parseMessage m, parseDetails d) of
(Just _, Just r) -> maybe (toEnum $ getStatus r) (HTTP.mkStatus (getStatus r) . T.encodeUtf8) (getStatusText r)
_ -> status PGRSTParseError
_ -> HTTP.status400
_ -> HTTP.status500
checkIsFatal :: PgError -> Maybe Text
checkIsFatal (PgError _ (SQL.ConnectionError e))
| isAuthFailureMessage = Just $ toS failureMessage
| otherwise = Nothing
where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` failureMessage
failureMessage = BS.unpack $ fromMaybe mempty e
checkIsFatal (PgError _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError serverError))))
= case serverError of
-- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal.
SQL.ServerError "42601" _ _ _
-> Just "Hint: This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues"
-- Check for a "prepared statement <name> already exists" error (Code 42P05: duplicate_prepared_statement).
-- This would mean that a connection pooler in transaction mode is being used
-- while prepared statements are enabled in the PostgREST configuration,
-- both of which are incompatible with each other.
SQL.ServerError "42P05" _ _ _
-> Just "Hint: If you are using connection poolers in transaction mode, try setting db-prepared-statements to false."
-- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation).
-- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.
SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _
-> Just "Hint: Connection poolers in statement mode are not supported."
_ -> Nothing
checkIsFatal _ = Nothing
data Error
= ApiRequestError ApiRequestError
| BinaryFieldError MediaType
| GucHeadersError
| GucStatusError
| JwtTokenInvalid Text
| JwtTokenMissing
| JwtTokenRequired
| NoSchemaCacheError
| OffLimitsChangesError Int64 Integer
| PgErr PgError
| PutMatchingPkError
| SingularityError Integer
instance PgrstError Error where
status (ApiRequestError err) = status err
status BinaryFieldError{} = HTTP.status406
status GucHeadersError = HTTP.status500
status GucStatusError = HTTP.status500
status JwtTokenInvalid{} = HTTP.unauthorized401
status JwtTokenMissing = HTTP.status500
status JwtTokenRequired = HTTP.unauthorized401
status NoSchemaCacheError = HTTP.status503
status OffLimitsChangesError{} = HTTP.status400
status (PgErr err) = status err
status PutMatchingPkError = HTTP.status400
status SingularityError{} = HTTP.status406
status (ApiRequestError err) = status err
status JwtTokenInvalid{} = HTTP.unauthorized401
status JwtTokenMissing = HTTP.status500
status JwtTokenRequired = HTTP.unauthorized401
status NoSchemaCacheError = HTTP.status503
status (PgErr err) = status err
headers (ApiRequestError err) = headers err
headers (JwtTokenInvalid m) = [MediaType.toContentType MTApplicationJSON, invalidTokenHeader m]
headers JwtTokenRequired = [MediaType.toContentType MTApplicationJSON, requiredTokenHeader]
headers (PgErr err) = headers err
headers SingularityError{} = [MediaType.toContentType MTSingularJSON]
headers _ = [MediaType.toContentType MTApplicationJSON]
headers (ApiRequestError err) = headers err
headers (JwtTokenInvalid m) = [invalidTokenHeader m]
headers JwtTokenRequired = [requiredTokenHeader]
headers (PgErr err) = headers err
headers _ = mempty
instance JSON.ToJSON Error where
toJSON NoSchemaCacheError = JSON.object [
"code" .= ConnectionErrorCode02,
"message" .= ("Could not query the database for the schema cache. Retrying." :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON NoSchemaCacheError = toJsonPgrstError
ConnectionErrorCode02 "Could not query the database for the schema cache. Retrying." Nothing Nothing
toJSON JwtTokenMissing = JSON.object [
"code" .= JWTErrorCode00,
"message" .= ("Server lacks JWT secret" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (JwtTokenInvalid message) = JSON.object [
"code" .= JWTErrorCode01,
"message" .= (message :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON JwtTokenRequired = JSON.object [
"code" .= JWTErrorCode02,
"message" .= ("Anonymous access is disabled" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON JwtTokenMissing = toJsonPgrstError
JWTErrorCode00 "Server lacks JWT secret" Nothing Nothing
toJSON (OffLimitsChangesError n maxs) = JSON.object [
"code" .= ApiRequestErrorCode10,
"message" .= ("The maximum number of rows allowed to change was surpassed" :: Text),
"details" .= T.unwords ["Results contain", show n, "rows changed but the maximum number allowed is", show maxs],
"hint" .= JSON.Null]
toJSON (JwtTokenInvalid message) = toJsonPgrstError
JWTErrorCode01 message Nothing Nothing
toJSON GucHeadersError = JSON.object [
"code" .= ApiRequestErrorCode11,
"message" .= ("response.headers guc must be a JSON array composed of objects with a single key and a string value" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON GucStatusError = JSON.object [
"code" .= ApiRequestErrorCode12,
"message" .= ("response.status guc must be a valid status code" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (BinaryFieldError ct) = JSON.object [
"code" .= ApiRequestErrorCode13,
"message" .= ((T.decodeUtf8 (MediaType.toMime ct) <> " requested but more than one column was selected") :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON PutMatchingPkError = JSON.object [
"code" .= ApiRequestErrorCode15,
"message" .= ("Payload values do not match URL in primary key column(s)" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (SingularityError n) = JSON.object [
"code" .= ApiRequestErrorCode16,
"message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
"details" .= T.unwords ["Results contain", show n, "rows,", T.decodeUtf8 (MediaType.toMime MTSingularJSON), "requires 1 row"],
"hint" .= JSON.Null]
toJSON JwtTokenRequired = toJsonPgrstError
JWTErrorCode02 "Anonymous access is disabled" Nothing Nothing
toJSON (PgErr err) = JSON.toJSON err
toJSON (ApiRequestError err) = JSON.toJSON err
@@ -422,8 +535,44 @@ invalidTokenHeader m =
requiredTokenHeader :: Header
requiredTokenHeader = ("WWW-Authenticate", "Bearer")
singularityError :: (Integral a) => a -> Error
singularityError = SingularityError . toInteger
-- For parsing byteString to JSON Object, used for allowing full response control
data PgRaiseErrMessage = PgRaiseErrMessage {
getCode :: Text,
getMessage :: Text,
getDetails :: Maybe Text,
getHint :: Maybe Text
}
data PgRaiseErrDetails = PgRaiseErrDetails {
getStatus :: Int,
getStatusText :: Maybe Text,
getHeaders :: Map Text Text
}
instance JSON.FromJSON PgRaiseErrMessage where
parseJSON (JSON.Object m) =
PgRaiseErrMessage
<$> m .: "code"
<*> m .: "message"
<*> m .:? "details"
<*> m .:? "hint"
parseJSON _ = mzero
instance JSON.FromJSON PgRaiseErrDetails where
parseJSON (JSON.Object d) =
PgRaiseErrDetails
<$> d .: "status"
<*> d .:? "status_text"
<*> d .: "headers"
parseJSON _ = mzero
parseMessage :: ByteString -> Maybe PgRaiseErrMessage
parseMessage = JSON.decodeStrict
parseDetails :: Maybe ByteString -> Maybe PgRaiseErrDetails
parseDetails d = JSON.decodeStrict =<< d
-- Error codes are grouped by common modules or characteristics
data ErrorCode
@@ -431,12 +580,13 @@ data ErrorCode
= ConnectionErrorCode00
| ConnectionErrorCode01
| ConnectionErrorCode02
| ConnectionErrorCode03
-- API Request errors
| ApiRequestErrorCode00
| ApiRequestErrorCode01
| ApiRequestErrorCode02
| ApiRequestErrorCode03
| ApiRequestErrorCode04
-- | ApiRequestErrorCode04 -- no longer used (used to be mapped to ParseRequestError)
| ApiRequestErrorCode05
| ApiRequestErrorCode06
| ApiRequestErrorCode07
@@ -444,17 +594,24 @@ data ErrorCode
| ApiRequestErrorCode09
| ApiRequestErrorCode10
| ApiRequestErrorCode11
-- | ApiRequestErrorCode13 -- no longer used (used to be mapped to BinaryFieldError)
| ApiRequestErrorCode12
| ApiRequestErrorCode13
| ApiRequestErrorCode14
| ApiRequestErrorCode15
| ApiRequestErrorCode16
| ApiRequestErrorCode17
| ApiRequestErrorCode18
| ApiRequestErrorCode19
| ApiRequestErrorCode20
| ApiRequestErrorCode21
| ApiRequestErrorCode22
| ApiRequestErrorCode23
-- Schema Cache errors
| SchemaCacheErrorCode00
| SchemaCacheErrorCode01
| SchemaCacheErrorCode02
| SchemaCacheErrorCode03
| SchemaCacheErrorCode04
-- JWT authentication errors
| JWTErrorCode00
| JWTErrorCode01
@@ -472,12 +629,12 @@ buildErrorCode code = "PGRST" <> case code of
ConnectionErrorCode00 -> "000"
ConnectionErrorCode01 -> "001"
ConnectionErrorCode02 -> "002"
ConnectionErrorCode03 -> "003"
ApiRequestErrorCode00 -> "100"
ApiRequestErrorCode01 -> "101"
ApiRequestErrorCode02 -> "102"
ApiRequestErrorCode03 -> "103"
ApiRequestErrorCode04 -> "104"
ApiRequestErrorCode05 -> "105"
ApiRequestErrorCode06 -> "106"
ApiRequestErrorCode07 -> "107"
@@ -486,16 +643,22 @@ buildErrorCode code = "PGRST" <> case code of
ApiRequestErrorCode10 -> "110"
ApiRequestErrorCode11 -> "111"
ApiRequestErrorCode12 -> "112"
ApiRequestErrorCode13 -> "113"
ApiRequestErrorCode14 -> "114"
ApiRequestErrorCode15 -> "115"
ApiRequestErrorCode16 -> "116"
ApiRequestErrorCode17 -> "117"
ApiRequestErrorCode18 -> "118"
ApiRequestErrorCode19 -> "119"
ApiRequestErrorCode20 -> "120"
ApiRequestErrorCode21 -> "121"
ApiRequestErrorCode22 -> "122"
ApiRequestErrorCode23 -> "123"
SchemaCacheErrorCode00 -> "200"
SchemaCacheErrorCode01 -> "201"
SchemaCacheErrorCode02 -> "202"
SchemaCacheErrorCode03 -> "203"
SchemaCacheErrorCode04 -> "204"
JWTErrorCode00 -> "300"
JWTErrorCode01 -> "301"
+1 -1
View File
@@ -26,5 +26,5 @@ middleware logLevel = case logLevel of
{ Wai.outputFormat = Wai.ApacheWithSettings $
Wai.defaultApacheSettings
& Wai.setApacheRequestFilter (\_ res -> filterStatus $ Wai.responseStatus res)
& Wai.setApacheUserGetter (fmap encodeUtf8 . Auth.getRole)
& Wai.setApacheUserGetter Auth.getRole
}
+98 -63
View File
@@ -1,19 +1,17 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
module PostgREST.MediaType
( MediaType(..)
, MTPlanOption (..)
, MTPlanFormat (..)
, MTPlanAttrs(..)
, MTVndPlanOption (..)
, MTVndPlanFormat (..)
, toContentType
, toMime
, decodeMediaType
, getMediaType
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (c2w)
import Data.Maybe (fromJust)
import Network.HTTP.Types.Header (Header, hContentType)
@@ -22,7 +20,6 @@ import Protolude
-- | Enumeration of currently supported media types
data MediaType
= MTApplicationJSON
| MTSingularJSON
| MTGeoJSON
| MTTextCSV
| MTTextPlain
@@ -32,18 +29,23 @@ data MediaType
| MTOctetStream
| MTAny
| MTOther ByteString
| MTPlan MTPlanAttrs
deriving Eq
-- vendored media types
| MTVndArrayJSONStrip
| MTVndSingularJSON Bool
-- TODO MTVndPlan should only have its options as [Text]. Its ResultAggregate should have the typed attributes.
| MTVndPlan MediaType MTVndPlanFormat [MTVndPlanOption]
deriving (Eq, Show, Generic)
instance Hashable MediaType
data MTPlanAttrs = MTPlanAttrs (Maybe MediaType) MTPlanFormat [MTPlanOption]
instance Eq MTPlanAttrs where
MTPlanAttrs {} == MTPlanAttrs {} = True -- we don't care about the attributes when comparing two MTPlan media types
data MTPlanOption
data MTVndPlanOption
= PlanAnalyze | PlanVerbose | PlanSettings | PlanBuffers | PlanWAL
deriving (Eq, Show, Generic)
instance Hashable MTVndPlanOption
data MTPlanFormat
data MTVndPlanFormat
= PlanJSON | PlanText
deriving (Eq, Show, Generic)
instance Hashable MTVndPlanFormat
-- | Convert MediaType to a Content-Type HTTP Header
toContentType :: MediaType -> Header
@@ -56,69 +58,102 @@ toContentType ct = (hContentType, toMime ct <> charset)
-- | Convert from MediaType to a ByteString representing the mime type
toMime :: MediaType -> ByteString
toMime MTApplicationJSON = "application/json"
toMime MTGeoJSON = "application/geo+json"
toMime MTTextCSV = "text/csv"
toMime MTTextPlain = "text/plain"
toMime MTTextXML = "text/xml"
toMime MTOpenAPI = "application/openapi+json"
toMime MTSingularJSON = "application/vnd.pgrst.object+json"
toMime MTUrlEncoded = "application/x-www-form-urlencoded"
toMime MTOctetStream = "application/octet-stream"
toMime MTAny = "*/*"
toMime (MTOther ct) = ct
toMime (MTPlan (MTPlanAttrs mt fmt opts)) =
toMime MTApplicationJSON = "application/json"
toMime MTVndArrayJSONStrip = "application/vnd.pgrst.array+json;nulls=stripped"
toMime MTGeoJSON = "application/geo+json"
toMime MTTextCSV = "text/csv"
toMime MTTextPlain = "text/plain"
toMime MTTextXML = "text/xml"
toMime MTOpenAPI = "application/openapi+json"
toMime (MTVndSingularJSON True) = "application/vnd.pgrst.object+json;nulls=stripped"
toMime (MTVndSingularJSON False) = "application/vnd.pgrst.object+json"
toMime MTUrlEncoded = "application/x-www-form-urlencoded"
toMime MTOctetStream = "application/octet-stream"
toMime MTAny = "*/*"
toMime (MTOther ct) = ct
toMime (MTVndPlan mt fmt opts) =
"application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
(if isNothing mt then mempty else "; for=\"" <> toMime (fromJust mt) <> "\"") <>
("; for=\"" <> toMime mt <> "\"") <>
(if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts))
toMimePlanOption :: MTPlanOption -> ByteString
toMimePlanOption :: MTVndPlanOption -> ByteString
toMimePlanOption PlanAnalyze = "analyze"
toMimePlanOption PlanVerbose = "verbose"
toMimePlanOption PlanSettings = "settings"
toMimePlanOption PlanBuffers = "buffers"
toMimePlanOption PlanWAL = "wal"
toMimePlanFormat :: MTPlanFormat -> ByteString
toMimePlanFormat :: MTVndPlanFormat -> ByteString
toMimePlanFormat PlanJSON = "json"
toMimePlanFormat PlanText = "text"
-- | Convert from ByteString to MediaType. Warning: discards MIME parameters
-- | Convert from ByteString to MediaType.
--
-- >>> decodeMediaType "application/json"
-- MTApplicationJSON
--
-- >>> decodeMediaType "application/vnd.pgrst.plan;"
-- MTVndPlan MTApplicationJSON PlanText []
--
-- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"application/json\""
-- MTVndPlan MTApplicationJSON PlanText []
--
-- >>> decodeMediaType "application/vnd.pgrst.plan+json;for=\"text/csv\""
-- MTVndPlan MTTextCSV PlanJSON []
--
-- >>> decodeMediaType "application/vnd.pgrst.array+json;nulls=stripped"
-- MTVndArrayJSONStrip
--
-- >>> decodeMediaType "application/vnd.pgrst.array+json"
-- MTApplicationJSON
--
-- >>> decodeMediaType "application/vnd.pgrst.object+json;nulls=stripped"
-- MTVndSingularJSON True
--
-- >>> decodeMediaType "application/vnd.pgrst.object+json"
-- MTVndSingularJSON False
decodeMediaType :: BS.ByteString -> MediaType
decodeMediaType mt =
case BS.split (BS.c2w ';') mt of
"application/json":_ -> MTApplicationJSON
"application/geo+json":_ -> MTGeoJSON
"text/csv":_ -> MTTextCSV
"text/plain":_ -> MTTextPlain
"text/xml":_ -> MTTextXML
"application/openapi+json":_ -> MTOpenAPI
"application/vnd.pgrst.object+json":_ -> MTSingularJSON
"application/vnd.pgrst.object":_ -> MTSingularJSON
"application/x-www-form-urlencoded":_ -> MTUrlEncoded
"application/octet-stream":_ -> MTOctetStream
"application/vnd.pgrst.plan":rest -> getPlan PlanText rest
"application/vnd.pgrst.plan+text":rest -> getPlan PlanText rest
"application/vnd.pgrst.plan+json":rest -> getPlan PlanJSON rest
"*/*":_ -> MTAny
other:_ -> MTOther other
_ -> MTAny
"application/json":_ -> MTApplicationJSON
"application/geo+json":_ -> MTGeoJSON
"text/csv":_ -> MTTextCSV
"text/plain":_ -> MTTextPlain
"text/xml":_ -> MTTextXML
"application/openapi+json":_ -> MTOpenAPI
"application/x-www-form-urlencoded":_ -> MTUrlEncoded
"application/octet-stream":_ -> MTOctetStream
"application/vnd.pgrst.plan":rest -> getPlan PlanText rest
"application/vnd.pgrst.plan+text":rest -> getPlan PlanText rest
"application/vnd.pgrst.plan+json":rest -> getPlan PlanJSON rest
"application/vnd.pgrst.object+json":rest -> checkSingularNullStrip rest
"application/vnd.pgrst.object":rest -> checkSingularNullStrip rest
"application/vnd.pgrst.array+json":rest -> checkArrayNullStrip rest
"application/vnd.pgrst.array":rest -> checkArrayNullStrip rest
"*/*":_ -> MTAny
other:_ -> MTOther other
_ -> MTAny
where
getPlan fmt rest =
let
opts = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest)
inOpts str = str `elem` opts
mtFor = decodeMediaType . dropAround (== BS.c2w '"') <$> (BS.stripPrefix "for=" =<< find (BS.isPrefixOf "for=") rest)
dropAround p = BS.dropWhile p . BS.dropWhileEnd p in
MTPlan $ MTPlanAttrs mtFor fmt $
[PlanAnalyze | inOpts "analyze" ] ++
[PlanVerbose | inOpts "verbose" ] ++
[PlanSettings | inOpts "settings"] ++
[PlanBuffers | inOpts "buffers" ] ++
[PlanWAL | inOpts "wal" ]
checkArrayNullStrip ["nulls=stripped"] = MTVndArrayJSONStrip
checkArrayNullStrip _ = MTApplicationJSON
getMediaType :: MediaType -> MediaType
getMediaType mt = case mt of
MTPlan (MTPlanAttrs (Just mType) _ _) -> mType
MTPlan (MTPlanAttrs Nothing _ _) -> MTApplicationJSON
other -> other
checkSingularNullStrip ["nulls=stripped"] = MTVndSingularJSON True
checkSingularNullStrip _ = MTVndSingularJSON False
getPlan fmt rest =
let
opts = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest)
inOpts str = str `elem` opts
dropAround p = BS.dropWhile p . BS.dropWhileEnd p
mtFor = fromMaybe MTApplicationJSON $ do
foundFor <- find (BS.isPrefixOf "for=") rest
strippedFor <- BS.stripPrefix "for=" foundFor
pure . decodeMediaType $ dropAround (== BS.c2w '"') strippedFor
in
MTVndPlan mtFor fmt $
[PlanAnalyze | inOpts "analyze" ] ++
[PlanVerbose | inOpts "verbose" ] ++
[PlanSettings | inOpts "settings"] ++
[PlanBuffers | inOpts "buffers" ] ++
[PlanWAL | inOpts "wal" ]
-122
View File
@@ -1,122 +0,0 @@
{-|
Module : PostgREST.Middleware
Description : Sets CORS policy. Also the PostgreSQL GUCs, role, search_path and pre-request function.
-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Middleware
( runPgLocals
, optionalRollback
) where
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.HashMap.Strict as HM
import qualified Data.Text.Encoding as T
import qualified Hasql.Decoders as HD
import qualified Hasql.DynamicStatements.Snippet as SQL hiding (sql)
import qualified Hasql.DynamicStatements.Statement as SQL
import qualified Hasql.Transaction as SQL
import qualified Network.Wai as Wai
import Control.Arrow ((***))
import Data.Scientific (FPFormat (..), formatScientific, isInteger)
import PostgREST.Config (AppConfig (..))
import PostgREST.Config.PgVersion (PgVersion (..), pgVersion140)
import PostgREST.Error (Error, errorResponseFor)
import PostgREST.GucHeader (addHeadersIfNotIncluded)
import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet,
pgFmtIdentList, unknownEncoder)
import PostgREST.Request.ApiRequest (ApiRequest (..), Target (..))
import PostgREST.Request.Preferences
import Protolude
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
runPgLocals :: AppConfig -> KM.KeyMap JSON.Value -> Text ->
(ApiRequest -> ExceptT Error SQL.Transaction Wai.Response) ->
ApiRequest -> ByteString -> PgVersion -> ExceptT Error SQL.Transaction Wai.Response
runPgLocals conf claims role app req jsonDbS actualPgVersion = do
lift $ SQL.statement mempty $ SQL.dynamicallyParameterized
("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql ++ specSql))
HD.noResult (configDbPreparedStatements conf)
lift $ traverse_ SQL.sql preReqSql
app req
where
methodSql = setConfigLocal mempty ("request.method", iMethod req)
pathSql = setConfigLocal mempty ("request.path", iPath req)
headersSql = if usesLegacyGucs
then setConfigLocal "request.header." <$> iHeaders req
else setConfigLocalJson "request.headers" (iHeaders req)
cookiesSql = if usesLegacyGucs
then setConfigLocal "request.cookie." <$> iCookies req
else setConfigLocalJson "request.cookies" (iCookies req)
claimsSql = if usesLegacyGucs
then setConfigLocal "request.jwt.claim." <$> [(toUtf8 $ K.toText c, toUtf8 $ unquoted v) | (c,v) <- KM.toList claims]
else [setConfigLocal mempty ("request.jwt.claims", LBS.toStrict $ JSON.encode claims)]
roleSql = [setConfigLocal mempty ("role", toUtf8 role)]
appSettingsSql = setConfigLocal mempty <$> (join bimap toUtf8 <$> configAppSettings conf)
searchPathSql =
let schemas = pgFmtIdentList (iSchema req : configDbExtraSearchPath conf) in
setConfigLocal mempty ("search_path", schemas)
preReqSql = (\f -> "select " <> fromQi f <> "();") <$> configDbPreRequest conf
specSql = case iTarget req of
TargetProc{tpIsRootSpec=True} -> [setConfigLocal mempty ("request.spec", jsonDbS)]
_ -> mempty
usesLegacyGucs = configDbUseLegacyGucs conf && actualPgVersion < pgVersion140
unquoted :: JSON.Value -> Text
unquoted (JSON.String t) = t
unquoted (JSON.Number n) =
toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
unquoted (JSON.Bool b) = show b
unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
-- | Set a transaction to eventually roll back if requested and set respective
-- headers on the response.
optionalRollback
:: AppConfig
-> ApiRequest
-> ExceptT Error SQL.Transaction Wai.Response
-> ExceptT Error SQL.Transaction Wai.Response
optionalRollback AppConfig{..} ApiRequest{..} transaction = do
resp <- catchError transaction $ return . errorResponseFor
when (shouldRollback || (configDbTxRollbackAll && not shouldCommit)) $ lift do
SQL.sql "SET CONSTRAINTS ALL IMMEDIATE"
SQL.condemn
return $ Wai.mapResponseHeaders preferenceApplied resp
where
shouldCommit =
configDbTxAllowOverride && iPreferTransaction == Just Commit
shouldRollback =
configDbTxAllowOverride && iPreferTransaction == Just Rollback
preferenceApplied
| shouldCommit =
addHeadersIfNotIncluded
[toAppliedHeader Commit]
| shouldRollback =
addHeadersIfNotIncluded
[toAppliedHeader Rollback]
| otherwise =
identity
-- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
setConfigLocal :: ByteString -> (ByteString, ByteString) -> SQL.Snippet
setConfigLocal prefix (k, v) =
"set_config(" <> unknownEncoder (prefix <> k) <> ", " <> unknownEncoder v <> ", true)"
-- | Starting from PostgreSQL v14, some characters are not allowed for config names (mostly affecting headers with "-").
-- | A JSON format string is used to avoid this problem. See https://github.com/PostgREST/postgrest/issues/1857
setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [SQL.Snippet]
setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)]
where
gucJsonVal :: [(ByteString, ByteString)] -> ByteString
gucJsonVal = LBS.toStrict . JSON.encode . HM.fromList . arrayByteStringToText
arrayByteStringToText :: [(ByteString, ByteString)] -> [(Text,Text)]
arrayByteStringToText keyVal = (T.decodeUtf8 *** T.decodeUtf8) <$> keyVal
File diff suppressed because it is too large Load Diff
+57
View File
@@ -0,0 +1,57 @@
{-# LANGUAGE NamedFieldPuns #-}
module PostgREST.Plan.CallPlan
( CallPlan(..)
, CallParams(..)
, jsonRpcParams
)
where
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.SchemaCache.Routine (Routine (..),
RoutineParam (..))
import Protolude
data CallPlan = FunctionCall
{ funCQi :: QualifiedIdentifier
, funCParams :: CallParams
, funCArgs :: Maybe LBS.ByteString
, funCScalar :: Bool
, funCSetOfScalar :: Bool
, funCRetCompositeAlias :: Bool
, funCReturning :: [FieldName]
}
data CallParams
= KeyParams [RoutineParam] -- ^ Call with key params: func(a := val1, b:= val2)
| OnePosParam RoutineParam -- ^ Call with positional params(only one supported): func(val)
-- | Convert rpc params `/rpc/func?a=val1&b=val2` to json `{"a": "val1", "b": "val2"}
jsonRpcParams :: Routine -> [(Text, Text)] -> LBS.ByteString
jsonRpcParams proc prms =
if not $ pdHasVariadic proc then -- if proc has no variadic param, save steps and directly convert to json
JSON.encode $ HM.fromList $ second JSON.toJSON <$> prms
else
let paramsMap = HM.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
JSON.encode paramsMap
where
mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue
mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a
mergeParams v _ = v -- repeated params for non-variadic parameters are not merged
toRpcParamValue :: Routine -> (Text, Text) -> (Text, RpcParamValue)
toRpcParamValue proc (k, v) | prmIsVariadic k = (k, Variadic [v])
| otherwise = (k, Fixed v)
where
prmIsVariadic prm = isJust $ find (\RoutineParam{ppName, ppVar} -> ppName == prm && ppVar) $ pdParams proc
-- | RPC query param value `/rpc/func?v=<value>`, used for VARIADIC functions on form-urlencoded POST and GETs
-- | It can be fixed `?v=1` or repeated `?v=1&v=2&v=3.
data RpcParamValue = Fixed Text | Variadic [Text]
instance JSON.ToJSON RpcParamValue where
toJSON (Fixed v) = JSON.toJSON v
toJSON (Variadic v) = JSON.toJSON v
+46
View File
@@ -0,0 +1,46 @@
module PostgREST.Plan.MutatePlan
( MutatePlan(..)
)
where
import qualified Data.ByteString.Lazy as LBS
import PostgREST.ApiRequest.Preferences (PreferResolution)
import PostgREST.Plan.Types (CoercibleField,
CoercibleLogicTree,
CoercibleOrderTerm)
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier)
import Protolude
data MutatePlan
= Insert
{ in_ :: QualifiedIdentifier
, insCols :: [CoercibleField]
, insBody :: Maybe LBS.ByteString
, onConflict :: Maybe (PreferResolution, [FieldName])
, where_ :: [CoercibleLogicTree]
, returning :: [FieldName]
, insPkCols :: [FieldName]
, applyDefs :: Bool
}
| Update
{ in_ :: QualifiedIdentifier
, updCols :: [CoercibleField]
, updBody :: Maybe LBS.ByteString
, where_ :: [CoercibleLogicTree]
, mutRange :: NonnegRange
, mutOrder :: [CoercibleOrderTerm]
, returning :: [FieldName]
, applyDefs :: Bool
}
| Delete
{ in_ :: QualifiedIdentifier
, where_ :: [CoercibleLogicTree]
, mutRange :: NonnegRange
, mutOrder :: [CoercibleOrderTerm]
, returning :: [FieldName]
}
+50
View File
@@ -0,0 +1,50 @@
module PostgREST.Plan.ReadPlan
( ReadPlanTree
, ReadPlan(..)
, JoinCondition(..)
) where
import Data.Tree (Tree (..))
import PostgREST.ApiRequest.Types (Alias, Depth, Hint,
JoinType, NodeName)
import PostgREST.Plan.Types (CoercibleLogicTree,
CoercibleOrderTerm,
CoercibleSelectField (..),
RelSelectField (..))
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.SchemaCache.Relationship (Relationship)
import Protolude
type ReadPlanTree = Tree ReadPlan
data JoinCondition =
JoinCondition
(QualifiedIdentifier, FieldName)
(QualifiedIdentifier, FieldName)
deriving (Eq, Show)
data ReadPlan = ReadPlan
{ select :: [CoercibleSelectField]
, from :: QualifiedIdentifier
, fromAlias :: Maybe Alias
, where_ :: [CoercibleLogicTree]
, order :: [CoercibleOrderTerm]
, range_ :: NonnegRange
, relName :: NodeName
, relToParent :: Maybe Relationship
, relJoinConds :: [JoinCondition]
, relAlias :: Maybe Alias
, relAggAlias :: Alias
, relHint :: Maybe Hint
, relJoinType :: Maybe JoinType
, relIsSpread :: Bool
, relSelect :: [RelSelectField]
, depth :: Depth
-- ^ used for aliasing
}
deriving (Eq, Show)
+106
View File
@@ -0,0 +1,106 @@
module PostgREST.Plan.Types
( CoercibleField(..)
, CoercibleSelectField(..)
, unknownField
, CoercibleLogicTree(..)
, CoercibleFilter(..)
, TransformerProc
, CoercibleOrderTerm(..)
, RelSelectField(..)
, RelJsonEmbedMode(..)
, SpreadSelectField(..)
) where
import PostgREST.ApiRequest.Types (AggregateFunction, Alias, Cast,
Field, JsonPath, LogicOperator,
OpExpr, OrderDirection, OrderNulls)
import PostgREST.SchemaCache.Identifiers (FieldName)
import Protolude
type TransformerProc = Text
-- | A CoercibleField pairs the name of a query element with any type coercion information we need for some specific use case.
-- |
-- | As suggested by the name, it's often a reference to a field in a table but really it can be any nameable element (function parameter, calculation with an alias, etc) with a knowable type.
-- |
-- | In the simplest case, it allows us to parse JSON payloads with `json_to_recordset`, for which we need to know both the name and the type of each thing we'd like to extract. At a higher level, CoercibleField generalises to reflect that any value we work with in a query may need type specific handling.
-- |
-- | CoercibleField is the foundation for the Data Representations feature. This feature allow user-definable mappings between database types so that the same data can be presented or interpreted in various ways as needed. Sometimes the way Postgres coerces data implicitly isn't right for the job. Different mappings might be appropriate for different situations: parsing a filter from a query string requires one function (text -> field type) while parsing a payload from JSON takes another (json -> field type). And the reverse, outputting a field as JSON, requires yet a third (field type -> json). CoercibleField is that "job specific" reference to an element paired with the type we desire for that particular purpose and the function we'll use to get there, if any.
-- |
-- | In the planning phase, we "resolve" generic named elements into these specialised CoercibleFields. Again this is context specific: two different CoercibleFields both representing the exact same table column in the database, even in the same query, might have two different target types and mapping functions. For example, one might represent a column in a filter, and another the very same column in an output role to be sent in the response body.
-- |
-- | The type value is allowed to be the empty string. The analog here is soft type checking in programming languages: sometimes we don't need a variable to have a specified type and things will work anyhow. So the empty type variant is valid when we don't know and *don't need to know* about the specific type in some context. Note that this variation should not be used if it guarantees failure: in that case you should instead raise an error at the planning stage and bail out. For example, we can't parse JSON with `json_to_recordset` without knowing the types of each recipient field, and so error out. Using the empty string for the type would be incorrect and futile. On the other hand we use the empty type for RPC calls since type resolution isn't implemented for RPC, but it's fine because the query still works with Postgres' implicit coercion. In the future, hopefully we will support data representations across the board and then the empty type may be permanently retired.
data CoercibleField = CoercibleField
{ cfName :: FieldName
, cfJsonPath :: JsonPath
, cfToJson :: Bool
, cfIRType :: Text -- ^ The native Postgres type of the field, the intermediate (IR) type before mapping.
, cfTransform :: Maybe TransformerProc -- ^ The optional mapping from irType -> targetType.
, cfDefault :: Maybe Text
} deriving (Eq, Show)
unknownField :: FieldName -> JsonPath -> CoercibleField
unknownField name path = CoercibleField name path False "" Nothing Nothing
-- | Like an API request LogicTree, but with coercible field information.
data CoercibleLogicTree
= CoercibleExpr Bool LogicOperator [CoercibleLogicTree]
| CoercibleStmnt CoercibleFilter
deriving (Eq, Show)
data CoercibleFilter = CoercibleFilter
{ field :: CoercibleField
, opExpr :: OpExpr
}
| CoercibleFilterNullEmbed Bool FieldName
deriving (Eq, Show)
data CoercibleOrderTerm
= CoercibleOrderTerm
{ coField :: CoercibleField
, coDirection :: Maybe OrderDirection
, coNullOrder :: Maybe OrderNulls
}
| CoercibleOrderRelationTerm
{ coRelation :: FieldName
, coRelTerm :: Field
, coDirection :: Maybe OrderDirection
, coNullOrder :: Maybe OrderNulls
}
deriving (Eq, Show)
data CoercibleSelectField = CoercibleSelectField
{ csField :: CoercibleField
, csAggFunction :: Maybe AggregateFunction
, csAggCast :: Maybe Cast
, csCast :: Maybe Cast
, csAlias :: Maybe Alias
}
deriving (Eq, Show)
data RelJsonEmbedMode = JsonObject | JsonArray
deriving (Show, Eq)
data RelSelectField
= JsonEmbed
{ rsSelName :: FieldName
, rsAggAlias :: Alias
, rsEmbedMode :: RelJsonEmbedMode
, rsEmptyEmbed :: Bool
}
| Spread
{ rsSpreadSel :: [SpreadSelectField]
, rsAggAlias :: Alias
}
deriving (Eq, Show)
data SpreadSelectField =
SpreadSelectField
{ ssSelName :: FieldName
, ssSelAggFunction :: Maybe AggregateFunction
, ssSelAggCast :: Maybe Cast
, ssSelAlias :: Maybe Alias
}
deriving (Eq, Show)
+267
View File
@@ -0,0 +1,267 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Query
( createQuery
, deleteQuery
, invokeQuery
, openApiQuery
, readQuery
, singleUpsertQuery
, updateQuery
, setPgLocals
, runPreReq
, DbHandler
) where
import qualified Data.Aeson as JSON
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S
import qualified Hasql.Decoders as HD
import qualified Hasql.DynamicStatements.Snippet as SQL (Snippet)
import qualified Hasql.DynamicStatements.Statement as SQL
import qualified Hasql.Transaction as SQL
import qualified PostgREST.ApiRequest.Types as ApiRequestTypes
import qualified PostgREST.Error as Error
import qualified PostgREST.Query.QueryBuilder as QueryBuilder
import qualified PostgREST.Query.Statements as Statements
import qualified PostgREST.RangeQuery as RangeQuery
import qualified PostgREST.SchemaCache as SchemaCache
import PostgREST.ApiRequest (ApiRequest (..))
import PostgREST.ApiRequest.Preferences (PreferCount (..),
PreferTimezone (..),
PreferTransaction (..),
Preferences (..),
shouldCount)
import PostgREST.Config (AppConfig (..),
OpenAPIMode (..))
import PostgREST.Config.PgVersion (PgVersion (..))
import PostgREST.Error (Error)
import PostgREST.MediaType (MediaType (..))
import PostgREST.Plan (CallReadPlan (..),
MutateReadPlan (..),
WrappedReadPlan (..))
import PostgREST.Plan.MutatePlan (MutatePlan (..))
import PostgREST.Query.SqlFragment (escapeIdentList, fromQi,
intercalateSnippet,
setConfigWithConstantName,
setConfigWithConstantNameJSON,
setConfigWithDynamicName)
import PostgREST.Query.Statements (ResultSet (..))
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
Schema)
import PostgREST.SchemaCache.Routine (Routine (..), RoutineMap)
import PostgREST.SchemaCache.Table (TablesMap)
import Protolude hiding (Handler)
type DbHandler = ExceptT Error SQL.Transaction
readQuery :: WrappedReadPlan -> AppConfig -> ApiRequest -> DbHandler ResultSet
readQuery WrappedReadPlan{..} conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} = do
let countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan
resultSet <-
lift . SQL.statement mempty $
Statements.prepareRead
wrIdent
(QueryBuilder.readPlanToQuery wrReadPlan)
(if preferCount == Just EstimatedCount then
-- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
else
countQuery
)
(shouldCount preferCount)
wrMedia
wrHandler
configDbPreparedStatements
failNotSingular wrMedia resultSet
optionalRollback conf apiReq
resultSetWTotal conf apiReq resultSet countQuery
resultSetWTotal :: AppConfig -> ApiRequest -> ResultSet -> SQL.Snippet -> DbHandler ResultSet
resultSetWTotal _ _ rs@RSPlan{} _ = return rs
resultSetWTotal AppConfig{..} ApiRequest{iPreferences=Preferences{..}} rs@RSStandard{rsTableTotal=tableTotal} countQuery =
case preferCount of
Just PlannedCount -> do
total <- explain
return rs{rsTableTotal=total}
Just EstimatedCount ->
if tableTotal > (fromIntegral <$> configDbMaxRows) then do
total <- max tableTotal <$> explain
return rs{rsTableTotal=total}
else
return rs
Just ExactCount ->
return rs
Nothing ->
return rs
where
explain =
lift . SQL.statement mempty . Statements.preparePlanRows countQuery $
configDbPreparedStatements
createQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
createQuery mrPlan@MutateReadPlan{mrMedia} apiReq conf = do
resultSet <- writeQuery mrPlan apiReq conf
failNotSingular mrMedia resultSet
optionalRollback conf apiReq
pure resultSet
updateQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
updateQuery mrPlan@MutateReadPlan{mrMedia} apiReq@ApiRequest{..} conf = do
resultSet <- writeQuery mrPlan apiReq conf
failNotSingular mrMedia resultSet
failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
optionalRollback conf apiReq
pure resultSet
singleUpsertQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
singleUpsertQuery mrPlan apiReq conf = do
resultSet <- writeQuery mrPlan apiReq conf
failPut resultSet
optionalRollback conf apiReq
pure resultSet
-- Makes sure the querystring pk matches the payload pk
-- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
-- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.
-- If this condition is not satisfied then nothing is inserted,
-- check the WHERE for INSERT in QueryBuilder.hs to see how it's done
failPut :: ResultSet -> DbHandler ()
failPut RSPlan{} = pure ()
failPut RSStandard{rsQueryTotal=queryTotal} =
when (queryTotal /= 1) $ do
lift SQL.condemn
throwError $ Error.ApiRequestError ApiRequestTypes.PutMatchingPkError
deleteQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
deleteQuery mrPlan@MutateReadPlan{mrMedia} apiReq@ApiRequest{..} conf = do
resultSet <- writeQuery mrPlan apiReq conf
failNotSingular mrMedia resultSet
failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
optionalRollback conf apiReq
pure resultSet
invokeQuery :: Routine -> CallReadPlan -> ApiRequest -> AppConfig -> PgVersion -> DbHandler ResultSet
invokeQuery rout CallReadPlan{..} apiReq@ApiRequest{iPreferences=Preferences{..}} conf@AppConfig{..} pgVer = do
resultSet <-
lift . SQL.statement mempty $
Statements.prepareCall
crIdent
rout
(QueryBuilder.callPlanToQuery crCallPlan pgVer)
(QueryBuilder.readPlanToQuery crReadPlan)
(QueryBuilder.readPlanToCountQuery crReadPlan)
(shouldCount preferCount)
crMedia
crHandler
configDbPreparedStatements
optionalRollback conf apiReq
failNotSingular crMedia resultSet
pure resultSet
openApiQuery :: SchemaCache -> PgVersion -> AppConfig -> Schema -> DbHandler (Maybe (TablesMap, RoutineMap, Maybe Text))
openApiQuery sCache pgVer AppConfig{..} tSchema =
lift $ case configOpenApiMode of
OAFollowPriv -> do
tableAccess <- SQL.statement [tSchema] (SchemaCache.accessibleTables pgVer configDbPreparedStatements)
Just <$> ((,,)
(HM.filterWithKey (\qi _ -> S.member qi tableAccess) $ SchemaCache.dbTables sCache)
<$> SQL.statement tSchema (SchemaCache.accessibleFuncs pgVer configDbPreparedStatements)
<*> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
OAIgnorePriv ->
Just <$> ((,,)
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ SchemaCache.dbTables sCache)
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ SchemaCache.dbRoutines sCache)
<$> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
OADisabled ->
pure Nothing
writeQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
writeQuery MutateReadPlan{..} ApiRequest{iPreferences=Preferences{..}} conf =
let
(isPut, isInsert, pkCols) = case mrMutatePlan of {Insert{where_,insPkCols} -> ((not . null) where_, True, insPkCols); _ -> (False,False, mempty);}
in
lift . SQL.statement mempty $
Statements.prepareWrite
mrIdent
(QueryBuilder.readPlanToQuery mrReadPlan)
(QueryBuilder.mutatePlanToQuery mrMutatePlan)
isInsert
isPut
mrMedia
mrHandler
preferRepresentation
preferResolution
pkCols
(configDbPreparedStatements conf)
-- |
-- Fail a response if a single JSON object was requested and not exactly one
-- was found.
failNotSingular :: MediaType -> ResultSet -> DbHandler ()
failNotSingular _ RSPlan{} = pure ()
failNotSingular mediaType RSStandard{rsQueryTotal=queryTotal} =
when (elem mediaType [MTVndSingularJSON True, MTVndSingularJSON False] && queryTotal /= 1) $ do
lift SQL.condemn
throwError $ Error.ApiRequestError . ApiRequestTypes.SingularityError $ toInteger queryTotal
failsChangesOffLimits :: Maybe Integer -> ResultSet -> DbHandler ()
failsChangesOffLimits _ RSPlan{} = pure ()
failsChangesOffLimits Nothing _ = pure ()
failsChangesOffLimits (Just maxChanges) RSStandard{rsQueryTotal=queryTotal} =
when (queryTotal > fromIntegral maxChanges) $ do
lift SQL.condemn
throwError $ Error.ApiRequestError $ ApiRequestTypes.OffLimitsChangesError queryTotal maxChanges
-- | Set a transaction to roll back if requested
optionalRollback :: AppConfig -> ApiRequest -> DbHandler ()
optionalRollback AppConfig{..} ApiRequest{iPreferences=Preferences{..}} = do
lift $ when (shouldRollback || (configDbTxRollbackAll && not shouldCommit)) $ do
SQL.sql "SET CONSTRAINTS ALL IMMEDIATE"
SQL.condemn
where
shouldCommit =
preferTransaction == Just Commit
shouldRollback =
preferTransaction == Just Rollback
-- | Set transaction scoped settings
setPgLocals :: AppConfig -> KM.KeyMap JSON.Value -> BS.ByteString -> [(ByteString, ByteString)] ->
ApiRequest -> Maybe Text -> DbHandler ()
setPgLocals AppConfig{..} claims role roleSettings ApiRequest{..} tout = lift $
SQL.statement mempty $ SQL.dynamicallyParameterized
-- To ensure `GRANT SET ON PARAMETER <superuser_setting> TO authenticator` works, the role settings must be set before the impersonated role.
-- Otherwise the GRANT SET would have to be applied to the impersonated role. See https://github.com/PostgREST/postgrest/issues/3045
("select " <> intercalateSnippet ", " (searchPathSql : roleSettingsSql ++ roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ timezoneSql ++ timeoutSql ++ appSettingsSql))
HD.noResult configDbPreparedStatements
where
methodSql = setConfigWithConstantName ("request.method", iMethod)
pathSql = setConfigWithConstantName ("request.path", iPath)
headersSql = setConfigWithConstantNameJSON "request.headers" iHeaders
cookiesSql = setConfigWithConstantNameJSON "request.cookies" iCookies
claimsSql = [setConfigWithConstantName ("request.jwt.claims", LBS.toStrict $ JSON.encode claims)]
roleSql = [setConfigWithConstantName ("role", role)]
roleSettingsSql = setConfigWithDynamicName <$> roleSettings
appSettingsSql = setConfigWithDynamicName <$> (join bimap toUtf8 <$> configAppSettings)
timezoneSql = maybe mempty (\(PreferTimezone tz) -> [setConfigWithConstantName ("timezone", tz)]) $ preferTimezone iPreferences
timeoutSql = maybe mempty ((\t -> [setConfigWithConstantName ("statement_timeout", t)]) . encodeUtf8) tout
searchPathSql =
let schemas = escapeIdentList (iSchema : configDbExtraSearchPath) in
setConfigWithConstantName ("search_path", schemas)
-- | Runs the pre-request function.
runPreReq :: AppConfig -> DbHandler ()
runPreReq conf = lift $ traverse_ (SQL.statement mempty . stmt) (configDbPreRequest conf)
where
stmt req = SQL.dynamicallyParameterized
("select " <> fromQi req <> "()")
HD.noResult
(configDbPreparedStatements conf)
+163 -149
View File
@@ -5,215 +5,215 @@ Module : PostgREST.Query.QueryBuilder
Description : PostgREST SQL queries generating functions.
This module provides functions to consume data types that
represent database queries (e.g. ReadRequest, MutateRequest) and SqlFragment
represent database queries (e.g. ReadPlanTree, MutatePlan) and SqlFragment
to produce SqlQuery type outputs.
-}
module PostgREST.Query.QueryBuilder
( readRequestToQuery
, mutateRequestToQuery
, readRequestToCountQuery
, requestToCallProcQuery
( readPlanToQuery
, mutatePlanToQuery
, readPlanToCountQuery
, callPlanToQuery
, limitedQuery
) where
import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S
import qualified Hasql.DynamicStatements.Snippet as SQL
import Data.Tree (Tree (..))
import Data.Maybe (fromJust)
import Data.Tree (Tree (..))
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
import PostgREST.DbStructure.Proc (ProcParam (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
import PostgREST.ApiRequest.Preferences (PreferResolution (..))
import PostgREST.Config.PgVersion (PgVersion, pgVersion110,
pgVersion130)
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
import PostgREST.SchemaCache.Relationship (Cardinality (..),
Junction (..),
Relationship (..))
import PostgREST.Request.Preferences (PreferResolution (..))
import PostgREST.SchemaCache.Routine (RoutineParam (..))
import PostgREST.ApiRequest.Types
import PostgREST.Plan.CallPlan
import PostgREST.Plan.MutatePlan
import PostgREST.Plan.ReadPlan
import PostgREST.Plan.Types
import PostgREST.Query.SqlFragment
import PostgREST.RangeQuery (allRange)
import PostgREST.Request.MutateQuery
import PostgREST.Request.ReadQuery
import PostgREST.Request.Types
import PostgREST.RangeQuery (allRange)
import Protolude
readRequestToQuery :: ReadRequest -> SQL.Snippet
readRequestToQuery (Node (Select colSelects mainQi tblAlias logicForest joinConditions_ ordts range, (_, rel, _, _, _, _)) forest) =
readPlanToQuery :: ReadPlanTree -> SQL.Snippet
readPlanToQuery node@(Node ReadPlan{select,from=mainQi,fromAlias,where_=logicForest,order, range_=readRange, relToParent, relJoinConds, relSelect} forest) =
"SELECT " <>
intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <> " " <>
intercalateSnippet ", " ((pgFmtSelectItem qi <$> (if null select && null forest then defSelect else select)) ++ joinsSelects) <> " " <>
fromFrag <> " " <>
intercalateSnippet " " joins <> " " <>
(if null logicForest && null joinConditions_
(if null logicForest && null relJoinConds
then mempty
else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_)) <> " " <>
orderF qi ordts <> " " <>
limitOffsetF range
else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition relJoinConds)) <> " " <>
groupF qi select relSelect <> " " <>
orderF qi order <> " " <>
limitOffsetF readRange
where
fromFrag = fromF rel mainQi tblAlias
qi = getQualifiedIdentifier rel mainQi tblAlias
(selects, joins) = foldr getSelectsJoins ([],[]) forest
fromFrag = fromF relToParent mainQi fromAlias
qi = getQualifiedIdentifier relToParent mainQi fromAlias
-- gets all the columns in case of an empty select, ignoring/obtaining these columns is done at the aggregation stage
defSelect = [CoercibleSelectField (unknownField "*" []) Nothing Nothing Nothing Nothing]
joins = getJoins node
joinsSelects = getJoinSelects node
getSelectsJoins :: ReadRequest -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])
getSelectsJoins (Node (_, (_, Nothing, _, _, _, _)) _) _ = ([], [])
getSelectsJoins rr@(Node (_, (name, Just rel, alias, _, joinType, _)) _) (selects,joins) =
getJoinSelects :: ReadPlanTree -> [SQL.Snippet]
getJoinSelects (Node ReadPlan{relSelect} _) =
mapMaybe relSelectToSnippet relSelect
where
relSelectToSnippet :: RelSelectField -> Maybe SQL.Snippet
relSelectToSnippet fld =
let aggAlias = pgFmtIdent $ rsAggAlias fld
in
case fld of
JsonEmbed{rsEmptyEmbed = True} ->
Nothing
JsonEmbed{rsSelName, rsEmbedMode = JsonObject} ->
Just $ "row_to_json(" <> aggAlias <> ".*)::jsonb AS " <> pgFmtIdent rsSelName
JsonEmbed{rsSelName, rsEmbedMode = JsonArray} ->
Just $ "COALESCE( " <> aggAlias <> "." <> aggAlias <> ", '[]') AS " <> pgFmtIdent rsSelName
Spread{rsSpreadSel, rsAggAlias} ->
Just $ intercalateSnippet ", " (pgFmtSpreadSelectItem rsAggAlias <$> rsSpreadSel)
getJoins :: ReadPlanTree -> [SQL.Snippet]
getJoins (Node _ []) = []
getJoins (Node ReadPlan{relSelect} forest) =
map (\fld ->
let alias = rsAggAlias fld
matchingNode = fromJust $ find (\(Node ReadPlan{relAggAlias} _) -> alias == relAggAlias) forest
in getJoin fld matchingNode
) relSelect
getJoin :: RelSelectField -> ReadPlanTree -> SQL.Snippet
getJoin fld node@(Node ReadPlan{relJoinType} _) =
let
subquery = readRequestToQuery rr
aliasOrName = fromMaybe name alias
locTblName = qiName (relTable rel) <> "_" <> aliasOrName
localTableName = pgFmtIdent locTblName
internalTableName = pgFmtIdent $ "_" <> locTblName
correlatedSubquery sub al cond =
(if joinType == Just JTInner then "INNER" else "LEFT") <> " JOIN LATERAL ( " <> sub <> " ) AS " <> SQL.sql al <> " ON " <> cond
isToOne = case rel of
Relationship{relCardinality=M2O _ _} -> True
Relationship{relCardinality=O2O _ _} -> True
ComputedRelationship{relToOne=True} -> True
_ -> False
(sel, joi) = if isToOne
then
( SQL.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)
, correlatedSubquery subquery localTableName "TRUE")
else
( SQL.sql $ "COALESCE( " <> localTableName <> "." <> internalTableName <> ", '[]') AS " <> pgFmtIdent aliasOrName
, correlatedSubquery (
"SELECT json_agg(" <> SQL.sql internalTableName <> ") AS " <> SQL.sql internalTableName <>
"FROM (" <> subquery <> " ) AS " <> SQL.sql internalTableName
) localTableName $ if joinType == Just JTInner then SQL.sql localTableName <> " IS NOT NULL" else "TRUE")
(if relJoinType == Just JTInner then "INNER" else "LEFT") <> " JOIN LATERAL ( " <> sub <> " ) AS " <> al <> " ON " <> cond
subquery = readPlanToQuery node
aggAlias = pgFmtIdent $ rsAggAlias fld
in
(sel:selects, joi:joins)
case fld of
JsonEmbed{rsEmbedMode = JsonObject} ->
correlatedSubquery subquery aggAlias "TRUE"
Spread{} ->
correlatedSubquery subquery aggAlias "TRUE"
JsonEmbed{rsEmbedMode = JsonArray} ->
let
subq = "SELECT json_agg(" <> aggAlias <> ")::jsonb AS " <> aggAlias <> " FROM (" <> subquery <> " ) AS " <> aggAlias
condition = if relJoinType == Just JTInner then aggAlias <> " IS NOT NULL" else "TRUE"
in correlatedSubquery subq aggAlias condition
mutateRequestToQuery :: MutateRequest -> SQL.Snippet
mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) =
"WITH " <> normalizedBody body <> " " <>
"INSERT INTO " <> SQL.sql (fromQi mainQi) <> SQL.sql (if S.null iCols then " " else "(" <> cols <> ") ") <>
"SELECT " <> SQL.sql cols <> " " <>
SQL.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <>
mutatePlanToQuery :: MutatePlan -> SQL.Snippet
mutatePlanToQuery (Insert mainQi iCols body onConflct putConditions returnings _ applyDefaults) =
"INSERT INTO " <> fromQi mainQi <> (if null iCols then " " else "(" <> cols <> ") ") <>
fromJsonBodyF body iCols True False applyDefaults <>
-- Only used for PUT
(if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) <>
SQL.sql (BS.unwords [
maybe "" (\(oncDo, oncCols) ->
if null oncCols then
mempty
else
"ON CONFLICT(" <> BS.intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
IgnoreDuplicates ->
"DO NOTHING"
MergeDuplicates ->
if S.null iCols
then "DO NOTHING"
else "DO UPDATE SET " <> BS.intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols)
) onConflct,
(if null putConditions then mempty else "WHERE " <> addConfigPgrstInserted True <> " AND " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "pgrst_body") <$> putConditions)) <>
(if null putConditions && mergeDups then "WHERE " <> addConfigPgrstInserted True else mempty) <>
maybe mempty (\(oncDo, oncCols) ->
if null oncCols then
mempty
else
" ON CONFLICT(" <> intercalateSnippet ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
IgnoreDuplicates ->
"DO NOTHING"
MergeDuplicates ->
if null iCols
then "DO NOTHING"
else "DO UPDATE SET " <> intercalateSnippet ", " ((pgFmtIdent . cfName) <> const " = EXCLUDED." <> (pgFmtIdent . cfName) <$> iCols) <> (if null putConditions && not mergeDups then mempty else "WHERE " <> addConfigPgrstInserted False)
) onConflct <> " " <>
returningF mainQi returnings
])
where
cols = BS.intercalate ", " $ pgFmtIdent <$> S.toList iCols
cols = intercalateSnippet ", " $ pgFmtIdent . cfName <$> iCols
mergeDups = case onConflct of {Just (MergeDuplicates,_) -> True; _ -> False;}
-- An update without a limit is always filtered with a WHERE
mutateRequestToQuery (Update mainQi uCols body logicForest range ordts returnings)
| S.null uCols =
mutatePlanToQuery (Update mainQi uCols body logicForest range ordts returnings applyDefaults)
| null uCols =
-- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
-- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select=
-- the select has to be based on "returnings" to make computed overloaded functions not throw
SQL.sql $ "SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false"
"SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false"
| range == allRange =
"WITH " <> normalizedBody body <> " " <>
"UPDATE " <> mainTbl <> " SET " <> SQL.sql nonRangeCols <> " " <>
"FROM (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " )) _ " <>
"UPDATE " <> mainTbl <> " SET " <> nonRangeCols <> " " <>
fromJsonBodyF body uCols False False applyDefaults <>
whereLogic <> " " <>
SQL.sql (returningF mainQi returnings)
returningF mainQi returnings
| otherwise =
"WITH " <> normalizedBody body <> ", " <>
"pgrst_update_body AS (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " ) LIMIT 1), " <>
"WITH " <>
"pgrst_update_body AS (" <> fromJsonBodyF body uCols True True applyDefaults <> "), " <>
"pgrst_affected_rows AS (" <>
"SELECT " <> SQL.sql rangeIdF <> " FROM " <> mainTbl <>
"SELECT " <> rangeIdF <> " FROM " <> mainTbl <>
whereLogic <> " " <>
orderF mainQi ordts <> " " <>
limitOffsetF range <>
") " <>
"UPDATE " <> mainTbl <> " SET " <> SQL.sql rangeCols <>
"UPDATE " <> mainTbl <> " SET " <> rangeCols <>
"FROM pgrst_affected_rows " <>
"WHERE " <> SQL.sql whereRangeIdF <> " " <>
SQL.sql (returningF mainQi returnings)
"WHERE " <> whereRangeIdF <> " " <>
returningF mainQi returnings
where
whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)
mainTbl = SQL.sql (fromQi mainQi)
emptyBodyReturnedColumns = if null returnings then "NULL" else BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
nonRangeCols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
rangeCols = BS.intercalate ", " ((\col -> pgFmtIdent col <> " = (SELECT " <> pgFmtIdent col <> " FROM pgrst_update_body) ") <$> S.toList uCols)
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
mainTbl = fromQi mainQi
emptyBodyReturnedColumns = if null returnings then "NULL" else intercalateSnippet ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
nonRangeCols = intercalateSnippet ", " (pgFmtIdent . cfName <> const " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_body") . cfName <$> uCols)
rangeCols = intercalateSnippet ", " ((\col -> pgFmtIdent (cfName col) <> " = (SELECT " <> pgFmtIdent (cfName col) <> " FROM pgrst_update_body) ") <$> uCols)
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (cfName . coField <$> ordts)
mutateRequestToQuery (Delete mainQi logicForest range ordts returnings)
mutatePlanToQuery (Delete mainQi logicForest range ordts returnings)
| range == allRange =
"DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
"DELETE FROM " <> fromQi mainQi <> " " <>
whereLogic <> " " <>
SQL.sql (returningF mainQi returnings)
returningF mainQi returnings
| otherwise =
"WITH " <>
"pgrst_affected_rows AS (" <>
"SELECT " <> SQL.sql rangeIdF <> " FROM " <> SQL.sql (fromQi mainQi) <>
"SELECT " <> rangeIdF <> " FROM " <> fromQi mainQi <>
whereLogic <> " " <>
orderF mainQi ordts <> " " <>
limitOffsetF range <>
") " <>
"DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
"DELETE FROM " <> fromQi mainQi <> " " <>
"USING pgrst_affected_rows " <>
"WHERE " <> SQL.sql whereRangeIdF <> " " <>
SQL.sql (returningF mainQi returnings)
"WHERE " <> whereRangeIdF <> " " <>
returningF mainQi returnings
where
whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (cfName . coField <$> ordts)
requestToCallProcQuery :: CallRequest -> SQL.Snippet
requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall returnings) =
prmsCTE <> argsBody
callPlanToQuery :: CallPlan -> PgVersion -> SQL.Snippet
callPlanToQuery (FunctionCall qi params args returnsScalar returnsSetOfScalar returnsCompositeAlias returnings) pgVer =
"SELECT " <> (if returnsScalar || returnsSetOfScalar then "pgrst_call.pgrst_scalar" else returnedColumns) <> " " <>
fromCall
where
(prmsCTE, argFrag) = case params of
OnePosParam prm -> ("WITH pgrst_args AS (SELECT NULL)", singleParameter args (encodeUtf8 $ ppType prm))
KeyParams [] -> (mempty, mempty)
KeyParams prms -> (
"WITH " <> normalizedBody args <> ", " <>
SQL.sql (
BS.unwords [
"pgrst_args AS (",
"SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtParams prms (const mempty) (\a -> " " <> encodeUtf8 (ppType a)) <> ")",
")"])
, SQL.sql $ if multipleCall
then fmtParams prms varadicPrefix (\a -> " := pgrst_args." <> pgFmtIdent (ppName a))
else fmtParams prms varadicPrefix (\a -> " := (SELECT " <> pgFmtIdent (ppName a) <> " FROM pgrst_args LIMIT 1)")
)
fromCall = case params of
OnePosParam prm -> "FROM " <> callIt (singleParameter args $ encodeUtf8 $ ppType prm)
KeyParams [] -> "FROM " <> callIt mempty
KeyParams prms -> fromJsonBodyF args ((\p -> CoercibleField (ppName p) mempty False (ppTypeMaxLength p) Nothing Nothing) <$> prms) False True False <> ", " <>
"LATERAL " <> callIt (fmtParams prms)
fmtParams :: [ProcParam] -> (ProcParam -> SqlFragment) -> (ProcParam -> SqlFragment) -> SqlFragment
fmtParams prms prmFragPre prmFragSuf = BS.intercalate ", "
((\a -> prmFragPre a <> pgFmtIdent (ppName a) <> prmFragSuf a) <$> prms)
callIt :: SQL.Snippet -> SQL.Snippet
callIt argument | pgVer < pgVersion130 && pgVer >= pgVersion110 && returnsCompositeAlias = "(SELECT (" <> fromQi qi <> "(" <> argument <> ")).*) pgrst_call"
| returnsScalar || returnsSetOfScalar = "(SELECT " <> fromQi qi <> "(" <> argument <> ") pgrst_scalar) pgrst_call"
| otherwise = fromQi qi <> "(" <> argument <> ") pgrst_call"
varadicPrefix :: ProcParam -> SqlFragment
varadicPrefix a = if ppVar a then "VARIADIC " else mempty
argsBody :: SQL.Snippet
argsBody
| multipleCall =
if returnsScalar
then "SELECT " <> callIt <> " AS pgrst_scalar FROM pgrst_args"
else "SELECT pgrst_lat_args.* FROM pgrst_args, " <>
"LATERAL ( SELECT " <> returnedColumns <> " FROM " <> callIt <> " ) pgrst_lat_args"
| otherwise =
if returnsScalar
then "SELECT " <> callIt <> " AS pgrst_scalar"
else "SELECT " <> returnedColumns <> " FROM " <> callIt
callIt :: SQL.Snippet
callIt = SQL.sql (fromQi qi) <> "(" <> argFrag <> ")"
fmtParams :: [RoutineParam] -> SQL.Snippet
fmtParams prms = intercalateSnippet ", "
((\a -> (if ppVar a then "VARIADIC " else mempty) <> pgFmtIdent (ppName a) <> " := pgrst_body." <> pgFmtIdent (ppName a)) <$> prms)
returnedColumns :: SQL.Snippet
returnedColumns
| null returnings = "*"
| otherwise = SQL.sql $ BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings)
| otherwise = intercalateSnippet ", " (pgFmtColumn (QualifiedIdentifier mempty "pgrst_call") <$> returnings)
-- | SQL query meant for COUNTing the root node of the Tree.
-- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT.
@@ -223,31 +223,43 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r
-- For this case, we use a WHERE EXISTS instead of an INNER JOIN on the count query.
-- See https://github.com/PostgREST/postgrest/issues/2009#issuecomment-977473031
-- Only for the nodes that have an INNER JOIN linked to the root level.
readRequestToCountQuery :: ReadRequest -> SQL.Snippet
readRequestToCountQuery (Node (Select{from=mainQi, fromAlias=tblAlias, where_=logicForest, joinConditions=joinConditions_}, (_, rel, _, _, _, _)) forest) =
readPlanToCountQuery :: ReadPlanTree -> SQL.Snippet
readPlanToCountQuery (Node ReadPlan{from=mainQi, fromAlias=tblAlias, where_=logicForest, relToParent=rel, relJoinConds} forest) =
"SELECT 1 " <> fromFrag <>
(if null logicForest && null joinConditions_ && null subQueries
(if null logicForest && null relJoinConds && null subQueries
then mempty
else " WHERE " ) <>
intercalateSnippet " AND " (
map (pgFmtLogicTree qi) logicForest ++
map pgFmtJoinCondition joinConditions_ ++
map (pgFmtLogicTreeCount qi) logicForest ++
map pgFmtJoinCondition relJoinConds ++
subQueries
)
where
qi = getQualifiedIdentifier rel mainQi tblAlias
fromFrag = fromF rel mainQi tblAlias
subQueries = foldr existsSubquery [] forest
existsSubquery :: ReadRequest -> [SQL.Snippet] -> [SQL.Snippet]
existsSubquery readReq@(Node (_, (_, _, _, _, joinType, _)) _) rest =
existsSubquery :: ReadPlanTree -> [SQL.Snippet] -> [SQL.Snippet]
existsSubquery readReq@(Node ReadPlan{relJoinType=joinType} _) rest =
if joinType == Just JTInner
then ("EXISTS (" <> readRequestToCountQuery readReq <> " )"):rest
then ("EXISTS (" <> readPlanToCountQuery readReq <> " )"):rest
else rest
findNullEmbedRel fld = find (\(Node ReadPlan{relAggAlias} _) -> fld == relAggAlias) forest
-- https://github.com/PostgREST/postgrest/pull/2930#discussion_r1325293698
pgFmtLogicTreeCount :: QualifiedIdentifier -> CoercibleLogicTree -> SQL.Snippet
pgFmtLogicTreeCount qiCount (CoercibleExpr hasNot op frst) = SQL.sql notOp <> " (" <> intercalateSnippet (opSql op) (pgFmtLogicTreeCount qiCount <$> frst) <> ")"
where
notOp = if hasNot then "NOT" else mempty
opSql And = " AND "
opSql Or = " OR "
pgFmtLogicTreeCount _ (CoercibleStmnt (CoercibleFilterNullEmbed hasNot fld)) =
maybe mempty (\x -> (if not hasNot then "NOT " else mempty) <> "EXISTS (" <> readPlanToCountQuery x <> ")") (findNullEmbedRel fld)
pgFmtLogicTreeCount qiCount (CoercibleStmnt flt) = pgFmtFilter qiCount flt
limitedQuery :: SQL.Snippet -> Maybe Integer -> SQL.Snippet
limitedQuery query maxRows = query <> SQL.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
-- TODO refactor so this function is uneeded and ComputedRelationship QualifiedIdentifier comes from the ReadQuery type
-- TODO refactor so this function is uneeded and ComputedRelationship QualifiedIdentifier comes from the ReadPlan type
getQualifiedIdentifier :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> QualifiedIdentifier
getQualifiedIdentifier rel mainQi tblAlias = case rel of
Just ComputedRelationship{relFunction} -> QualifiedIdentifier mempty $ fromMaybe (qiName relFunction) tblAlias
@@ -255,10 +267,12 @@ getQualifiedIdentifier rel mainQi tblAlias = case rel of
-- FROM clause plus implicit joins
fromF :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> SQL.Snippet
fromF rel mainQi tblAlias = SQL.sql $ "FROM " <>
fromF rel mainQi tblAlias = "FROM " <>
(case rel of
Just ComputedRelationship{relFunction,relTable} -> fromQi relFunction <> "(" <> pgFmtIdent (qiName relTable) <> ")"
_ -> fromQi mainQi) <>
-- Due to the use of CTEs on RPC, we need to cast the parameter to the table name in case of function overloading.
-- See https://github.com/PostgREST/postgrest/issues/2963#issuecomment-1736557386
Just ComputedRelationship{relFunction,relTableAlias,relTable} -> fromQi relFunction <> "(" <> pgFmtIdent (qiName relTableAlias) <> "::" <> fromQi relTable <> ")"
_ -> fromQi mainQi) <>
maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias <>
(case rel of
Just Relationship{relCardinality=M2M Junction{junTable=jt}} -> ", " <> fromQi jt
+328 -146
View File
@@ -1,135 +1,139 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}
{-|
Module : PostgREST.Query.SqlFragment
Description : Helper functions for PostgREST.QueryBuilder.
Any function that outputs a SqlFragment should be in this module.
-}
module PostgREST.Query.SqlFragment
( noLocationF
, SqlFragment
, asBinaryF
, asCsvF
, asGeoJsonF
, asJsonF
, asJsonSingleF
, asXmlF
, handlerF
, countF
, groupF
, fromQi
, limitOffsetF
, locationF
, mutRangeF
, normalizedBody
, orderF
, pgFmtColumn
, pgFmtFilter
, pgFmtIdent
, pgFmtIdentList
, pgFmtJoinCondition
, pgFmtLogicTree
, pgFmtOrderTerm
, pgFmtSelectItem
, pgFmtSpreadSelectItem
, fromJsonBodyF
, responseHeadersF
, responseStatusF
, addConfigPgrstInserted
, currentSettingF
, returningF
, selectBody
, singleParameter
, sourceCTE
, sourceCTEName
, unknownEncoder
, intercalateSnippet
, explainF
, setConfigWithConstantName
, setConfigWithDynamicName
, setConfigWithConstantNameJSON
, escapeIdent
, escapeIdentList
) where
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Hasql.DynamicStatements.Snippet as SQL
import qualified Hasql.Encoders as HE
import Control.Arrow ((***))
import Data.Foldable (foldr1)
import Text.InterpolatedString.Perl6 (qc)
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier (..))
import PostgREST.MediaType (MTPlanFormat (..),
MTPlanOption (..))
import PostgREST.RangeQuery (NonnegRange, allRange,
rangeLimit, rangeOffset)
import PostgREST.Request.ReadQuery (SelectItem)
import PostgREST.Request.Types (Alias, Field, Filter (..),
import PostgREST.ApiRequest.Types (AggregateFunction (..),
Alias, Cast,
FtsOperator (..),
JoinCondition (..),
JsonOperand (..),
JsonOperation (..),
JsonPath,
LogicOperator (..),
LogicTree (..), OpExpr (..),
OpExpr (..),
OpQuantifier (..),
Operation (..),
OrderDirection (..),
OrderNulls (..),
OrderTerm (..),
QuantOperator (..),
SimpleOperator (..),
TrileanVal (..))
import PostgREST.MediaType (MTVndPlanFormat (..),
MTVndPlanOption (..))
import PostgREST.Plan.ReadPlan (JoinCondition (..))
import PostgREST.Plan.Types (CoercibleField (..),
CoercibleFilter (..),
CoercibleLogicTree (..),
CoercibleOrderTerm (..),
CoercibleSelectField (..),
RelSelectField (..),
SpreadSelectField (..),
unknownField)
import PostgREST.RangeQuery (NonnegRange, allRange,
rangeLimit, rangeOffset)
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier (..))
import PostgREST.SchemaCache.Routine (MediaHandler (..),
Routine (..),
funcReturnsScalar,
funcReturnsSetOfScalar,
funcReturnsSingleComposite)
import Protolude hiding (cast)
import Protolude hiding (Sum, cast)
-- | A part of a SQL query that cannot be executed independently
type SqlFragment = ByteString
noLocationF :: SqlFragment
noLocationF = "array[]::text[]"
sourceCTEName :: SqlFragment
sourceCTEName :: Text
sourceCTEName = "pgrst_source"
singleValOperator :: SimpleOperator -> SqlFragment
singleValOperator = \case
sourceCTE :: SQL.Snippet
sourceCTE = "pgrst_source"
noLocationF :: SQL.Snippet
noLocationF = "array[]::text[]"
simpleOperator :: SimpleOperator -> SQL.Snippet
simpleOperator = \case
OpNotEqual -> "<>"
OpContains -> "@>"
OpContained -> "<@"
OpOverlap -> "&&"
OpStrictlyLeft -> "<<"
OpStrictlyRight -> ">>"
OpNotExtendsRight -> "&<"
OpNotExtendsLeft -> "&>"
OpAdjacent -> "-|-"
quantOperator :: QuantOperator -> SQL.Snippet
quantOperator = \case
OpEqual -> "="
OpGreaterThanEqual -> ">="
OpGreaterThan -> ">"
OpLessThanEqual -> "<="
OpLessThan -> "<"
OpNotEqual -> "<>"
OpLike -> "like"
OpILike -> "ilike"
OpContains -> "@>"
OpContained -> "<@"
OpOverlap -> "&&"
OpStrictlyLeft -> "<<"
OpStrictlyRight -> ">>"
OpNotExtendsRight -> "&<"
OpNotExtendsLeft -> "&>"
OpAdjacent -> "-|-"
OpMatch -> "~"
OpIMatch -> "~*"
ftsOperator :: FtsOperator -> SqlFragment
ftsOperator :: FtsOperator -> SQL.Snippet
ftsOperator = \case
FilterFts -> "@@ to_tsquery"
FilterFtsPlain -> "@@ plainto_tsquery"
FilterFtsPhrase -> "@@ phraseto_tsquery"
FilterFtsWebsearch -> "@@ websearch_to_tsquery"
-- |
-- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads
-- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays
-- We do this in SQL to avoid processing the JSON in application code
-- TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body
normalizedBody :: Maybe LBS.ByteString -> SQL.Snippet
normalizedBody body =
"pgrst_payload AS (SELECT " <> jsonPlaceHolder <> " AS json_data), " <>
SQL.sql (BS.unwords [
"pgrst_body AS (",
"SELECT",
"CASE WHEN json_typeof(json_data) = 'array'",
"THEN json_data",
"ELSE json_build_array(json_data)",
"END AS val",
"FROM pgrst_payload)"])
where
jsonPlaceHolder = SQL.encoderAndParam (HE.nullable HE.unknown) (LBS.toStrict <$> body) <> "::json"
singleParameter :: Maybe LBS.ByteString -> ByteString -> SQL.Snippet
singleParameter body typ =
if typ == "bytea"
@@ -137,9 +141,6 @@ singleParameter body typ =
then SQL.encoderAndParam (HE.nullable HE.bytea) (LBS.toStrict <$> body)
else SQL.encoderAndParam (HE.nullable HE.unknown) (LBS.toStrict <$> body) <> "::" <> SQL.sql typ
selectBody :: SqlFragment
selectBody = "(SELECT val FROM pgrst_body)"
-- Here we build the pg array literal, e.g '{"Hebdon, John","Other","Another"}', manually.
-- This is necessary to pass an "unknown" array and let pg infer the type.
-- There are backslashes here, but since this value is parametrized and is not a string constant
@@ -154,8 +155,21 @@ pgBuildArrayLiteral vals =
"{" <> T.intercalate "," (escaped <$> vals) <> "}"
-- TODO: refactor by following https://github.com/PostgREST/postgrest/pull/1631#issuecomment-711070833
pgFmtIdent :: Text -> SqlFragment
pgFmtIdent x = encodeUtf8 $ "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "\""
pgFmtIdent :: Text -> SQL.Snippet
pgFmtIdent x = SQL.sql $ escapeIdent x
escapeIdent :: Text -> ByteString
escapeIdent x = encodeUtf8 $ "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "\""
-- Only use it if the input comes from the database itself, like on `jsonb_build_object('column_from_a_table', val)..`
pgFmtLit :: Text -> Text
pgFmtLit x =
let trimmed = trimNullChars x
escaped = "'" <> T.replace "'" "''" trimmed <> "'"
slashed = T.replace "\\" "\\\\" escaped in
if "\\" `T.isInfixOf` escaped
then "E" <> slashed
else slashed
trimNullChars :: Text -> Text
trimNullChars = T.takeWhile (/= '\x0')
@@ -163,12 +177,12 @@ trimNullChars = T.takeWhile (/= '\x0')
-- |
-- Format a list of identifiers and separate them by commas.
--
-- >>> pgFmtIdentList ["schema_1", "schema_2", "SPECIAL \"@/\\#~_-"]
-- >>> escapeIdentList ["schema_1", "schema_2", "SPECIAL \"@/\\#~_-"]
-- "\"schema_1\", \"schema_2\", \"SPECIAL \"\"@/\\#~_-\""
pgFmtIdentList :: [Text] -> SqlFragment
pgFmtIdentList schemas = BS.intercalate ", " $ pgFmtIdent <$> schemas
escapeIdentList :: [Text] -> ByteString
escapeIdentList schemas = BS.intercalate ", " $ escapeIdent <$> schemas
asCsvF :: SqlFragment
asCsvF :: SQL.Snippet
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
where
asCsvHeaderF =
@@ -176,32 +190,43 @@ asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
" FROM (" <>
" SELECT json_object_keys(r)::text as k" <>
" FROM ( " <>
" SELECT row_to_json(hh) as r from " <> sourceCTEName <> " as hh limit 1" <>
" SELECT row_to_json(hh) as r from " <> sourceCTE <> " as hh limit 1" <>
" ) s" <>
" ) a" <>
")"
asCsvBodyF = "coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"
asJsonF :: Bool -> SqlFragment
asJsonF returnsScalar
| returnsScalar = "coalesce(json_agg(_postgrest_t.pgrst_scalar), '[]')::character varying"
| otherwise = "coalesce(json_agg(_postgrest_t), '[]')::character varying"
addNullsToSnip :: Bool -> SQL.Snippet -> SQL.Snippet
addNullsToSnip strip snip =
if strip then "json_strip_nulls(" <> snip <> ")" else snip
asJsonSingleF :: Bool -> SqlFragment
asJsonSingleF returnsScalar
| returnsScalar = "coalesce((json_agg(_postgrest_t.pgrst_scalar)->0)::text, 'null')"
| otherwise = "coalesce((json_agg(_postgrest_t)->0)::text, 'null')"
asJsonSingleF :: Maybe Routine -> Bool -> SQL.Snippet
asJsonSingleF rout strip
| returnsScalar = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t.pgrst_scalar)->0" <> ", 'null')"
| otherwise = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t)->0" <> ", 'null')"
where
returnsScalar = maybe False funcReturnsScalar rout
asXmlF :: FieldName -> SqlFragment
asXmlF fieldName = "coalesce(xmlagg(_postgrest_t." <> pgFmtIdent fieldName <> "), '')"
asJsonF :: Maybe Routine -> Bool -> SQL.Snippet
asJsonF rout strip
| returnsSingleComposite = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t)->0" <> ", 'null')"
| returnsScalar = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t.pgrst_scalar)->0" <> ", 'null')"
| returnsSetOfScalar = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t.pgrst_scalar)" <> ", '[]')"
| otherwise = "coalesce(" <> addNullsToSnip strip "json_agg(_postgrest_t)" <> ", '[]')"
where
(returnsSingleComposite, returnsScalar, returnsSetOfScalar) = case rout of
Just r -> (funcReturnsSingleComposite r, funcReturnsScalar r, funcReturnsSetOfScalar r)
Nothing -> (False, False, False)
asGeoJsonF :: SqlFragment
asGeoJsonF :: SQL.Snippet
asGeoJsonF = "json_build_object('type', 'FeatureCollection', 'features', coalesce(json_agg(ST_AsGeoJSON(_postgrest_t)::json), '[]'))"
asBinaryF :: FieldName -> SqlFragment
asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
customFuncF :: Maybe Routine -> QualifiedIdentifier -> QualifiedIdentifier -> SQL.Snippet
customFuncF rout funcQi target
| (funcReturnsScalar <$> rout) == Just True = fromQi funcQi <> "(_postgrest_t.pgrst_scalar)"
| otherwise = fromQi funcQi <> "(_postgrest_t::" <> fromQi target <> ")"
locationF :: [Text] -> SqlFragment
locationF :: [Text] -> SQL.Snippet
locationF pKeys = [qc|(
WITH data AS (SELECT row_to_json(_) AS row FROM {sourceCTEName} AS _ LIMIT 1)
SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))
@@ -211,88 +236,183 @@ locationF pKeys = [qc|(
where
fmtPKeys = T.intercalate "','" pKeys
fromQi :: QualifiedIdentifier -> SqlFragment
fromQi :: QualifiedIdentifier -> SQL.Snippet
fromQi t = (if T.null s then mempty else pgFmtIdent s <> ".") <> pgFmtIdent n
where
n = qiName t
s = qiSchema t
pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
pgFmtColumn :: QualifiedIdentifier -> Text -> SQL.Snippet
pgFmtColumn table "*" = fromQi table <> ".*"
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
pgFmtField :: QualifiedIdentifier -> Field -> SQL.Snippet
pgFmtField table (c, []) = SQL.sql (pgFmtColumn table c)
-- Using to_jsonb instead of to_json to avoid missing operator errors when filtering:
-- "operator does not exist: json = unknown"
pgFmtField table (c, jp) = SQL.sql ("to_jsonb(" <> pgFmtColumn table c <> ")") <> pgFmtJsonPath jp
pgFmtCallUnary :: Text -> SQL.Snippet -> SQL.Snippet
pgFmtCallUnary f x = SQL.sql (encodeUtf8 f) <> "(" <> x <> ")"
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet
pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias)
pgFmtField :: QualifiedIdentifier -> CoercibleField -> SQL.Snippet
pgFmtField table CoercibleField{cfName=fn, cfJsonPath=[]} = pgFmtColumn table fn
pgFmtField table CoercibleField{cfName=fn, cfToJson=doToJson, cfJsonPath=jp} | doToJson = "to_jsonb(" <> pgFmtColumn table fn <> ")" <> pgFmtJsonPath jp
| otherwise = pgFmtColumn table fn <> pgFmtJsonPath jp
-- Select the value of a named element from a table, applying its optional coercion mapping if any.
pgFmtTableCoerce :: QualifiedIdentifier -> CoercibleField -> SQL.Snippet
pgFmtTableCoerce table fld@(CoercibleField{cfTransform=(Just formatterProc)}) = pgFmtCallUnary formatterProc (pgFmtField table fld)
pgFmtTableCoerce table f = pgFmtField table f
-- | Like the previous but now we just have a name so no namespace or JSON paths.
pgFmtCoerceNamed :: CoercibleField -> SQL.Snippet
pgFmtCoerceNamed CoercibleField{cfName=fn, cfTransform=(Just formatterProc)} = pgFmtCallUnary formatterProc (pgFmtIdent fn) <> " AS " <> pgFmtIdent fn
pgFmtCoerceNamed CoercibleField{cfName=fn} = pgFmtIdent fn
pgFmtSelectItem :: QualifiedIdentifier -> CoercibleSelectField -> SQL.Snippet
pgFmtSelectItem table CoercibleSelectField{csField=fld, csAggFunction=agg, csAggCast=aggCast, csCast=cast, csAlias=alias} =
pgFmtApplyAggregate agg aggCast (pgFmtApplyCast cast (pgFmtTableCoerce table fld)) <> pgFmtAs alias
pgFmtSpreadSelectItem :: Alias -> SpreadSelectField -> SQL.Snippet
pgFmtSpreadSelectItem aggAlias SpreadSelectField{ssSelName, ssSelAggFunction, ssSelAggCast, ssSelAlias} =
pgFmtApplyAggregate ssSelAggFunction ssSelAggCast fullSelName <> pgFmtAs ssSelAlias
where
fullSelName = case ssSelName of
"*" -> pgFmtIdent aggAlias <> ".*"
_ -> pgFmtIdent aggAlias <> "." <> pgFmtIdent ssSelName
pgFmtApplyAggregate :: Maybe AggregateFunction -> Maybe Cast -> SQL.Snippet -> SQL.Snippet
pgFmtApplyAggregate Nothing _ snippet = snippet
pgFmtApplyAggregate (Just agg) aggCast snippet =
pgFmtApplyCast aggCast aggregatedSnippet
where
convertAggFunction :: AggregateFunction -> SQL.Snippet
-- Convert from e.g. Sum (the data type) to SUM
convertAggFunction = SQL.sql . BS.map toUpper . BS.pack . show
aggregatedSnippet = convertAggFunction agg <> "(" <> snippet <> ")"
pgFmtApplyCast :: Maybe Cast -> SQL.Snippet -> SQL.Snippet
pgFmtApplyCast Nothing snippet = snippet
-- Ideally we'd quote the cast with "pgFmtIdent cast". However, that would invalidate common casts such as "int", "bigint", etc.
-- Try doing: `select 1::"bigint"` - it'll err, using "int8" will work though. There's some parser magic that pg does that's invalidated when quoting.
-- Not quoting should be fine, we validate the input on Parsers.
pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _, _) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias)
pgFmtApplyCast (Just cast) snippet = "CAST( " <> snippet <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )"
pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SQL.Snippet
pgFmtOrderTerm qi ot =
pgFmtField qi (otTerm ot) <> " " <>
SQL.sql (BS.unwords [
maybe mempty direction $ otDirection ot,
maybe mempty nullOrder $ otNullOrder ot])
-- TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body
fromJsonBodyF :: Maybe LBS.ByteString -> [CoercibleField] -> Bool -> Bool -> Bool -> SQL.Snippet
fromJsonBodyF body fields includeSelect includeLimitOne includeDefaults =
(if includeSelect then "SELECT " <> namedCols <> " " else mempty) <>
"FROM (SELECT " <> jsonPlaceHolder <> " AS json_data) pgrst_payload, " <>
-- convert a json object into a json array, this way we can use json_to_recordset for all json payloads
-- Otherwise we'd have to use json_to_record for json objects and json_to_recordset for json arrays
-- We do this in SQL to avoid processing the JSON in application code
"LATERAL (SELECT CASE WHEN " <> jsonTypeofF <> "(pgrst_payload.json_data) = 'array' THEN pgrst_payload.json_data ELSE " <> jsonBuildArrayF <> "(pgrst_payload.json_data) END AS val) pgrst_uniform_json, " <>
(if includeDefaults
then "LATERAL (SELECT jsonb_agg(jsonb_build_object(" <> defsJsonb <> ") || elem) AS val from jsonb_array_elements(pgrst_uniform_json.val) elem) pgrst_json_defs, "
else mempty) <>
"LATERAL (SELECT " <> parsedCols <> " FROM " <>
(if null fields
-- When we are inserting no columns (e.g. using default values), we can't use our ordinary `json_to_recordset`
-- because it can't extract records with no columns (there's no valid syntax for the `AS (colName colType,...)`
-- part). But we still need to ensure as many rows are created as there are array elements.
then SQL.sql $ jsonArrayElementsF <> "(" <> finalBodyF <> ") _ "
else jsonToRecordsetF <> "(" <> SQL.sql finalBodyF <> ") AS _(" <> typedCols <> ") " <> if includeLimitOne then "LIMIT 1" else mempty
) <>
") pgrst_body "
where
namedCols = intercalateSnippet ", " $ fromQi . QualifiedIdentifier "pgrst_body" . cfName <$> fields
parsedCols = intercalateSnippet ", " $ pgFmtCoerceNamed <$> fields
typedCols = intercalateSnippet ", " $ pgFmtIdent . cfName <> const " " <> SQL.sql . encodeUtf8 . cfIRType <$> fields
defsJsonb = SQL.sql $ BS.intercalate "," fieldsWDefaults
fieldsWDefaults = mapMaybe (\case
CoercibleField{cfName=nam, cfDefault=Just def} -> Just $ encodeUtf8 (pgFmtLit nam <> ", " <> def)
CoercibleField{cfDefault=Nothing} -> Nothing
) fields
(finalBodyF, jsonTypeofF, jsonBuildArrayF, jsonArrayElementsF, jsonToRecordsetF) =
if includeDefaults
then ("pgrst_json_defs.val", "jsonb_typeof", "jsonb_build_array", "jsonb_array_elements", "jsonb_to_recordset")
else ("pgrst_uniform_json.val", "json_typeof", "json_build_array", "json_array_elements", "json_to_recordset")
jsonPlaceHolder = SQL.encoderAndParam (HE.nullable $ if includeDefaults then HE.jsonbLazyBytes else HE.jsonLazyBytes) body
pgFmtOrderTerm :: QualifiedIdentifier -> CoercibleOrderTerm -> SQL.Snippet
pgFmtOrderTerm qi ot =
fmtOTerm ot <> " " <>
SQL.sql (BS.unwords [
maybe mempty direction $ coDirection ot,
maybe mempty nullOrder $ coNullOrder ot])
where
fmtOTerm = \case
CoercibleOrderTerm{coField=cof} -> pgFmtField qi cof
CoercibleOrderRelationTerm{coRelation, coRelTerm=(fn, jp)} -> pgFmtField (QualifiedIdentifier mempty coRelation) (unknownField fn jp)
direction OrderAsc = "ASC"
direction OrderDesc = "DESC"
nullOrder OrderNullsFirst = "NULLS FIRST"
nullOrder OrderNullsLast = "NULLS LAST"
-- | Interpret a literal in the way the planner indicated through the CoercibleField.
pgFmtUnknownLiteralForField :: SQL.Snippet -> CoercibleField -> SQL.Snippet
pgFmtUnknownLiteralForField value CoercibleField{cfTransform=(Just parserProc)} = pgFmtCallUnary parserProc value
-- But when no transform is requested, we just use the literal as-is.
pgFmtUnknownLiteralForField value _ = value
pgFmtFilter :: QualifiedIdentifier -> Filter -> SQL.Snippet
pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
Op op val -> pgFmtFieldOp op <> " " <> case op of
OpLike -> unknownLiteral (T.map star val)
OpILike -> unknownLiteral (T.map star val)
_ -> unknownLiteral val
-- | Array version of the above, used by ANY().
pgFmtArrayLiteralForField :: [Text] -> CoercibleField -> SQL.Snippet
-- When a transformation is requested, we need to apply the transformation to each element of the array. This could be done by just making a query with `parser(value)` for each value, but may lead to huge query lengths. Imagine `data_representations.color_from_text('...'::text)` for repeated for a hundred values. Instead we use `unnest()` to unpack a standard array literal and then apply the transformation to each element, like a map.
-- Note the literals will be treated as text since in every case when we use ANY() the parameters are textual (coming from a query string). We want to rely on the `text->domain` parser to do the right thing.
pgFmtArrayLiteralForField values CoercibleField{cfTransform=(Just parserProc)} = SQL.sql "(SELECT " <> pgFmtCallUnary parserProc (SQL.sql "unnest(" <> unknownLiteral (pgBuildArrayLiteral values) <> "::text[])") <> ")"
-- When no transformation is requested, we don't need a subquery.
pgFmtArrayLiteralForField values _ = unknownLiteral (pgBuildArrayLiteral values)
pgFmtFilter :: QualifiedIdentifier -> CoercibleFilter -> SQL.Snippet
pgFmtFilter _ (CoercibleFilterNullEmbed hasNot fld) = pgFmtIdent fld <> " IS " <> (if not hasNot then "NOT " else mempty) <> "DISTINCT FROM NULL"
pgFmtFilter _ (CoercibleFilter _ (NoOpExpr _)) = mempty -- TODO unreachable because NoOpExpr is filtered on QueryParams
pgFmtFilter table (CoercibleFilter fld (OpExpr hasNot oper)) = notOp <> " " <> pgFmtField table fld <> case oper of
Op op val -> " " <> simpleOperator op <> " " <> pgFmtUnknownLiteralForField (unknownLiteral val) fld
OpQuant op quant val -> " " <> quantOperator op <> " " <> case op of
OpLike -> fmtQuant quant $ unknownLiteral (T.map star val)
OpILike -> fmtQuant quant $ unknownLiteral (T.map star val)
_ -> fmtQuant quant $ pgFmtUnknownLiteralForField (unknownLiteral val) fld
-- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error.
-- The above can be fixed by using `PREPARE boolplan AS SELECT * FROM projects where id IS NOT DISTINCT FROM $1;`
-- However that would not accept the TRUE/FALSE/NULL/UNKNOWN keywords. See: https://stackoverflow.com/questions/6133525/proper-way-to-set-preparedstatement-parameter-to-null-under-postgres.
-- This is why `IS` operands are whitelisted at the Parsers.hs level
Is triVal -> pgFmtField table fld <> " IS " <> case triVal of
Is triVal -> " IS " <> case triVal of
TriTrue -> "TRUE"
TriFalse -> "FALSE"
TriNull -> "NULL"
TriUnknown -> "UNKNOWN"
IsDistinctFrom val -> " IS DISTINCT FROM " <> unknownLiteral val
-- We don't use "IN", we use "= ANY". IN has the following disadvantages:
-- + No way to use an empty value on IN: "col IN ()" is invalid syntax. With ANY we can do "= ANY('{}')"
-- + Can invalidate prepared statements: multiple parameters on an IN($1, $2, $3) will lead to using different prepared statements and not take advantage of caching.
In vals -> pgFmtField table fld <> " " <> case vals of
In vals -> " " <> case vals of
[""] -> "= ANY('{}') "
_ -> "= ANY (" <> unknownLiteral (pgBuildArrayLiteral vals) <> ") "
_ -> "= ANY (" <> pgFmtArrayLiteralForField vals fld <> ") "
Fts op lang val ->
pgFmtFieldFts op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
Fts op lang val -> " " <> ftsOperator op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
where
ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ")
pgFmtFieldOp op = pgFmtField table fld <> " " <> SQL.sql (singleValOperator op)
pgFmtFieldFts op = pgFmtField table fld <> " " <> SQL.sql (ftsOperator op)
notOp = if hasNot then "NOT" else mempty
star c = if c == '*' then '%' else c
fmtQuant q val = case q of
Just QuantAny -> "ANY(" <> val <> ")"
Just QuantAll -> "ALL(" <> val <> ")"
Nothing -> val
pgFmtJoinCondition :: JoinCondition -> SQL.Snippet
pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) =
SQL.sql $ pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SQL.Snippet
pgFmtLogicTree qi (Expr hasNot op forest) = SQL.sql notOp <> " (" <> intercalateSnippet (opSql op) (pgFmtLogicTree qi <$> forest) <> ")"
pgFmtLogicTree :: QualifiedIdentifier -> CoercibleLogicTree -> SQL.Snippet
pgFmtLogicTree qi (CoercibleExpr hasNot op forest) = SQL.sql notOp <> " (" <> intercalateSnippet (opSql op) (pgFmtLogicTree qi <$> forest) <> ")"
where
notOp = if hasNot then "NOT" else mempty
opSql And = " AND "
opSql Or = " OR "
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
pgFmtLogicTree qi (CoercibleStmnt flt) = pgFmtFilter qi flt
pgFmtJsonPath :: JsonPath -> SQL.Snippet
pgFmtJsonPath = \case
@@ -303,19 +423,42 @@ pgFmtJsonPath = \case
pgFmtJsonOperand (JKey k) = unknownLiteral k
pgFmtJsonOperand (JIdx i) = unknownLiteral i <> "::int"
pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment
pgFmtAs _ [] Nothing = mempty
pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
Just (JKey key) -> " AS " <> pgFmtIdent key
Just (JIdx _) -> " AS " <> pgFmtIdent (fromMaybe fName lastKey)
-- We get the lastKey because on:
-- `select=data->1->mycol->>2`, we need to show the result as [ {"mycol": ..}, {"mycol": ..} ]
-- `select=data->3`, we need to show the result as [ {"data": ..}, {"data": ..} ]
where lastKey = jVal <$> find (\case JKey{} -> True; _ -> False) (jOp <$> reverse jp)
Nothing -> mempty
pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
pgFmtAs :: Maybe Alias -> SQL.Snippet
pgFmtAs Nothing = mempty
pgFmtAs (Just alias) = " AS " <> pgFmtIdent alias
countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SqlFragment)
groupF :: QualifiedIdentifier -> [CoercibleSelectField] -> [RelSelectField] -> SQL.Snippet
groupF qi select relSelect
| (noSelectsAreAggregated && noRelSelectsAreAggregated) || null groupTerms = mempty
| otherwise = " GROUP BY " <> intercalateSnippet ", " groupTerms
where
noSelectsAreAggregated = null $ [s | s@(CoercibleSelectField { csAggFunction = Just _ }) <- select]
noRelSelectsAreAggregated = all (\case Spread sels _ -> all (isNothing . ssSelAggFunction) sels; _ -> True) relSelect
groupTermsFromSelect = mapMaybe (pgFmtGroup qi) select
groupTermsFromRelSelect = mapMaybe groupTermFromRelSelectField relSelect
groupTerms = groupTermsFromSelect ++ groupTermsFromRelSelect
groupTermFromRelSelectField :: RelSelectField -> Maybe SQL.Snippet
groupTermFromRelSelectField (JsonEmbed { rsSelName }) =
Just $ pgFmtIdent rsSelName
groupTermFromRelSelectField (Spread { rsSpreadSel, rsAggAlias }) =
if null groupTerms
then Nothing
else
Just $ intercalateSnippet ", " groupTerms
where
processField :: SpreadSelectField -> Maybe SQL.Snippet
processField SpreadSelectField{ssSelAggFunction = Just _} = Nothing
processField SpreadSelectField{ssSelName, ssSelAlias} =
Just $ pgFmtIdent rsAggAlias <> "." <> pgFmtIdent (fromMaybe ssSelName ssSelAlias)
groupTerms = mapMaybe processField rsSpreadSel
pgFmtGroup :: QualifiedIdentifier -> CoercibleSelectField -> Maybe SQL.Snippet
pgFmtGroup _ CoercibleSelectField{csAggFunction=Just _} = Nothing
pgFmtGroup _ CoercibleSelectField{csAlias=Just alias, csAggFunction=Nothing} = Just $ pgFmtIdent alias
pgFmtGroup qi CoercibleSelectField{csField=fld, csAlias=Nothing, csAggFunction=Nothing} = Just $ pgFmtField qi fld
countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SQL.Snippet)
countF countQuery shouldCount =
if shouldCount
then (
@@ -325,11 +468,11 @@ countF countQuery shouldCount =
mempty
, "null::bigint")
returningF :: QualifiedIdentifier -> [FieldName] -> SqlFragment
returningF :: QualifiedIdentifier -> [FieldName] -> SQL.Snippet
returningF qi returnings =
if null returnings
then "RETURNING 1" -- For mutation cases where there's no ?select, we return 1 to know how many rows were modified
else "RETURNING " <> BS.intercalate ", " (pgFmtColumn qi <$> returnings)
else "RETURNING " <> intercalateSnippet ", " (pgFmtColumn qi <$> returnings)
limitOffsetF :: NonnegRange -> SQL.Snippet
limitOffsetF range =
@@ -338,25 +481,30 @@ limitOffsetF range =
limit = maybe "ALL" (\l -> unknownEncoder (BS.pack $ show l)) $ rangeLimit range
offset = unknownEncoder (BS.pack . show $ rangeOffset range)
responseHeadersF :: SqlFragment
responseHeadersF :: SQL.Snippet
responseHeadersF = currentSettingF "response.headers"
responseStatusF :: SqlFragment
responseStatusF :: SQL.Snippet
responseStatusF = currentSettingF "response.status"
currentSettingF :: SqlFragment -> SqlFragment
addConfigPgrstInserted :: Bool -> SQL.Snippet
addConfigPgrstInserted add =
let (symbol, num) = if add then ("+", "0") else ("-", "-1") in
"set_config('pgrst.inserted', (coalesce(" <> currentSettingF "pgrst.inserted" <> "::int, 0) " <> symbol <> " 1)::text, true) <> '" <> num <> "'"
currentSettingF :: SQL.Snippet -> SQL.Snippet
currentSettingF setting =
-- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
"nullif(current_setting('" <> setting <> "', true), '')"
mutRangeF :: QualifiedIdentifier -> [FieldName] -> (SqlFragment, SqlFragment)
mutRangeF :: QualifiedIdentifier -> [FieldName] -> (SQL.Snippet, SQL.Snippet)
mutRangeF mainQi rangeId =
(
BS.intercalate " AND " $ (\col -> pgFmtColumn mainQi col <> " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_affected_rows") col) <$> rangeId
, BS.intercalate ", " (pgFmtColumn mainQi <$> rangeId)
intercalateSnippet " AND " $ (\col -> pgFmtColumn mainQi col <> " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_affected_rows") col) <$> rangeId
, intercalateSnippet ", " (pgFmtColumn mainQi <$> rangeId)
)
orderF :: QualifiedIdentifier -> [OrderTerm] -> SQL.Snippet
orderF :: QualifiedIdentifier -> [CoercibleOrderTerm] -> SQL.Snippet
orderF _ [] = mempty
orderF qi ordts = "ORDER BY " <> intercalateSnippet ", " (pgFmtOrderTerm qi <$> ordts)
@@ -371,18 +519,52 @@ intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet
intercalateSnippet _ [] = mempty
intercalateSnippet frag snippets = foldr1 (\a b -> a <> SQL.sql frag <> b) snippets
explainF :: MTPlanFormat -> [MTPlanOption] -> SQL.Snippet -> SQL.Snippet
explainF :: MTVndPlanFormat -> [MTVndPlanOption] -> SQL.Snippet -> SQL.Snippet
explainF fmt opts snip =
"EXPLAIN (" <>
SQL.sql (BS.intercalate ", " (fmtPlanFmt fmt : (fmtPlanOpt <$> opts))) <>
") " <> snip
where
fmtPlanOpt :: MTPlanOption -> BS.ByteString
fmtPlanOpt :: MTVndPlanOption -> BS.ByteString
fmtPlanOpt PlanAnalyze = "ANALYZE"
fmtPlanOpt PlanVerbose = "VERBOSE"
fmtPlanOpt PlanSettings = "SETTINGS"
fmtPlanOpt PlanBuffers = "BUFFERS"
fmtPlanOpt PlanWAL = "WAL"
fmtPlanFmt PlanJSON = "FORMAT JSON"
fmtPlanFmt PlanText = "FORMAT TEXT"
fmtPlanFmt PlanJSON = "FORMAT JSON"
-- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
setConfigLocal :: (SQL.Snippet, ByteString) -> SQL.Snippet
setConfigLocal (k, v) =
"set_config(" <> k <> ", " <> unknownEncoder v <> ", true)"
-- | For when the settings are hardcoded and not parameterized
setConfigWithConstantName :: (SQL.Snippet, ByteString) -> SQL.Snippet
setConfigWithConstantName (k, v) = setConfigLocal ("'" <> k <> "'", v)
-- | For when the settings need to be parameterized
setConfigWithDynamicName :: (ByteString, ByteString) -> SQL.Snippet
setConfigWithDynamicName (k, v) =
setConfigLocal (unknownEncoder k, v)
-- | Starting from PostgreSQL v14, some characters are not allowed for config names (mostly affecting headers with "-").
-- | A JSON format string is used to avoid this problem. See https://github.com/PostgREST/postgrest/issues/1857
setConfigWithConstantNameJSON :: SQL.Snippet -> [(ByteString, ByteString)] -> [SQL.Snippet]
setConfigWithConstantNameJSON prefix keyVals = [setConfigWithConstantName (prefix, gucJsonVal keyVals)]
where
gucJsonVal :: [(ByteString, ByteString)] -> ByteString
gucJsonVal = LBS.toStrict . JSON.encode . HM.fromList . arrayByteStringToText
arrayByteStringToText :: [(ByteString, ByteString)] -> [(Text,Text)]
arrayByteStringToText keyVal = (T.decodeUtf8 *** T.decodeUtf8) <$> keyVal
handlerF :: Maybe Routine -> QualifiedIdentifier -> MediaHandler -> SQL.Snippet
handlerF rout target = \case
BuiltinAggArrayJsonStrip -> asJsonF rout True
BuiltinAggSingleJson strip -> asJsonSingleF rout strip
BuiltinOvAggJson -> asJsonF rout False
BuiltinOvAggGeoJson -> asGeoJsonF
BuiltinOvAggCsv -> asCsvF
CustomFunc funcQi -> customFuncF rout funcQi target
NoAgg -> "''::text"
+59 -90
View File
@@ -15,30 +15,22 @@ module PostgREST.Query.Statements
, ResultSet (..)
) where
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Lens as L
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Hasql.Decoders as HD
import qualified Hasql.DynamicStatements.Snippet as SQL
import qualified Hasql.DynamicStatements.Statement as SQL
import qualified Hasql.Statement as SQL
import Control.Lens ((^?))
import Data.Maybe (fromJust)
import Data.Text.Read (decimal)
import Network.HTTP.Types.Status (Status)
import Control.Lens ((^?))
import PostgREST.Error (Error (..))
import PostgREST.GucHeader (GucHeader)
import PostgREST.DbStructure.Identifiers (FieldName)
import PostgREST.MediaType (MTPlanAttrs (..),
MTPlanFormat (..),
MediaType (..),
getMediaType)
import PostgREST.ApiRequest.Preferences
import PostgREST.MediaType (MTVndPlanFormat (..),
MediaType (..))
import PostgREST.Query.SqlFragment
import PostgREST.Request.Preferences
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier)
import PostgREST.SchemaCache.Routine (MediaHandler (..), Routine,
funcReturnsSingle)
import Protolude
@@ -54,122 +46,103 @@ data ResultSet
-- variable bindings like @"k1=eq.42"@, or the empty list if there is no location header.
, rsBody :: BS.ByteString
-- ^ the aggregated body of the query
, rsGucHeaders :: Either Error [GucHeader]
, rsGucHeaders :: Maybe BS.ByteString
-- ^ the HTTP headers to be added to the response
, rsGucStatus :: Either Error (Maybe Status)
, rsGucStatus :: Maybe Text
-- ^ the HTTP status to be added to the response
, rsInserted :: Maybe Int64
-- ^ the number of rows inserted (Only used for upserts)
}
| RSPlan BS.ByteString -- ^ the plan of the query
prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType ->
PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet
prepareWrite selectQuery mutateQuery isInsert mt rep pKeys =
prepareWrite :: QualifiedIdentifier -> SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> MediaType -> MediaHandler ->
Maybe PreferRepresentation -> Maybe PreferResolution -> [Text] -> Bool -> SQL.Statement () ResultSet
prepareWrite qi selectQuery mutateQuery isInsert isPut mt handler rep resolution pKeys =
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
where
checkUpsert snip = if isInsert && (isPut || resolution == Just MergeDuplicates) then snip else "''"
pgrstInsertedF = checkUpsert "nullif(current_setting('pgrst.inserted', true),'')::int"
snippet =
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
SQL.sql (
"WITH " <> sourceCTE <> " AS (" <> mutateQuery <> ") " <>
"SELECT " <>
"'' AS total_result_set, " <>
"pg_catalog.count(_postgrest_t) AS page_total, " <>
locF <> " AS header, " <>
bodyF <> " AS body, " <>
handlerF Nothing qi handler <> " AS body, " <>
responseHeadersF <> " AS response_headers, " <>
responseStatusF <> " AS response_status "
) <>
responseStatusF <> " AS response_status, " <>
pgrstInsertedF <> " AS response_inserted " <>
"FROM (" <> selectF <> ") _postgrest_t"
locF =
if isInsert && rep == HeadersOnly
then BS.unwords [
"CASE WHEN pg_catalog.count(_postgrest_t) = 1",
"THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
"ELSE " <> noLocationF,
"END"]
if isInsert && rep == Just HeadersOnly
then
"CASE WHEN pg_catalog.count(_postgrest_t) = 1 " <>
"THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ") " <>
"ELSE " <> noLocationF <> " " <>
"END"
else noLocationF
bodyF
| rep /= Full = "''"
| getMediaType mt == MTTextCSV = asCsvF
| getMediaType mt == MTGeoJSON = asGeoJsonF
| getMediaType mt == MTSingularJSON = asJsonSingleF False
| otherwise = asJsonF False
selectF
-- prevent using any of the column names in ?select= when no response is returned from the CTE
| rep /= Full = SQL.sql ("SELECT * FROM " <> sourceCTEName)
| otherwise = selectQuery
| handler == NoAgg = "SELECT * FROM " <> sourceCTE
| otherwise = selectQuery
decodeIt :: HD.Result ResultSet
decodeIt = case mt of
MTPlan{} -> planRow
_ -> fromMaybe (RSStandard Nothing 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow False)
MTVndPlan{} -> planRow
_ -> fromMaybe (RSStandard Nothing 0 mempty mempty Nothing Nothing Nothing) <$> HD.rowMaybe (standardRow False)
prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> Maybe FieldName -> Bool -> SQL.Statement () ResultSet
prepareRead selectQuery countQuery countTotal mt binaryField =
prepareRead :: QualifiedIdentifier -> SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> MediaHandler -> Bool -> SQL.Statement () ResultSet
prepareRead qi selectQuery countQuery countTotal mt handler =
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
where
snippet =
"WITH " <>
SQL.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <>
"WITH " <> sourceCTE <> " AS ( " <> selectQuery <> " ) " <>
countCTEF <> " " <>
SQL.sql ("SELECT " <>
"SELECT " <>
countResultF <> " AS total_result_set, " <>
"pg_catalog.count(_postgrest_t) AS page_total, " <>
bodyF <> " AS body, " <>
handlerF Nothing qi handler <> " AS body, " <>
responseHeadersF <> " AS response_headers, " <>
responseStatusF <> " AS response_status " <>
"FROM ( SELECT * FROM " <> sourceCTEName <> " ) _postgrest_t")
responseStatusF <> " AS response_status, " <>
"''" <> " AS response_inserted " <>
"FROM ( SELECT * FROM " <> sourceCTE <> " ) _postgrest_t"
(countCTEF, countResultF) = countF countQuery countTotal
bodyF
| getMediaType mt == MTTextCSV = asCsvF
| getMediaType mt == MTSingularJSON = asJsonSingleF False
| getMediaType mt == MTGeoJSON = asGeoJsonF
| isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField
| isJust binaryField = asBinaryF $ fromJust binaryField
| otherwise = asJsonF False
decodeIt :: HD.Result ResultSet
decodeIt = case mt of
MTPlan{} -> planRow
_ -> HD.singleRow $ standardRow True
MTVndPlan{} -> planRow
_ -> HD.singleRow $ standardRow True
prepareCall :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
MediaType -> Bool -> Maybe FieldName -> Bool ->
prepareCall :: QualifiedIdentifier -> Routine -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
MediaType -> MediaHandler -> Bool ->
SQL.Statement () ResultSet
prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mt multObjects binaryField =
prepareCall qi rout callProcQuery selectQuery countQuery countTotal mt handler =
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
where
snippet =
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
"WITH " <> sourceCTE <> " AS (" <> callProcQuery <> ") " <>
countCTEF <>
SQL.sql (
"SELECT " <>
countResultF <> " AS total_result_set, " <>
"pg_catalog.count(_postgrest_t) AS page_total, " <>
bodyF <> " AS body, " <>
(if funcReturnsSingle rout
then "1"
else "pg_catalog.count(_postgrest_t)") <> " AS page_total, " <>
handlerF (Just rout) qi handler <> " AS body, " <>
responseHeadersF <> " AS response_headers, " <>
responseStatusF <> " AS response_status ") <>
responseStatusF <> " AS response_status, " <>
"''" <> " AS response_inserted " <>
"FROM (" <> selectQuery <> ") _postgrest_t"
(countCTEF, countResultF) = countF countQuery countTotal
bodyF
| getMediaType mt == MTSingularJSON = asJsonSingleF returnsScalar
| getMediaType mt == MTTextCSV = asCsvF
| getMediaType mt == MTGeoJSON = asGeoJsonF
| isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField
| isJust binaryField = asBinaryF $ fromJust binaryField
| returnsSingle && not multObjects = asJsonSingleF returnsScalar
| otherwise = asJsonF returnsScalar
decodeIt :: HD.Result ResultSet
decodeIt = case mt of
MTPlan{} -> planRow
_ -> fromMaybe (RSStandard (Just 0) 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow True)
MTVndPlan{} -> planRow
_ -> fromMaybe (RSStandard (Just 0) 0 mempty mempty Nothing Nothing Nothing) <$> HD.rowMaybe (standardRow True)
preparePlanRows :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
preparePlanRows countQuery =
@@ -184,9 +157,11 @@ preparePlanRows countQuery =
standardRow :: Bool -> HD.Row ResultSet
standardRow noLocation =
RSStandard <$> nullableColumn HD.int8 <*> column HD.int8
<*> (if noLocation then pure mempty else fmap splitKeyValue <$> arrayColumn HD.bytea) <*> column HD.bytea
<*> (fromMaybe (Right []) <$> nullableColumn decodeGucHeaders)
<*> (fromMaybe (Right Nothing) <$> nullableColumn decodeGucStatus)
<*> (if noLocation then pure mempty else fmap splitKeyValue <$> arrayColumn HD.bytea)
<*> (fromMaybe mempty <$> nullableColumn HD.bytea)
<*> nullableColumn HD.bytea
<*> nullableColumn HD.text
<*> nullableColumn HD.int8
where
splitKeyValue :: ByteString -> (ByteString, ByteString)
splitKeyValue kv =
@@ -195,19 +170,13 @@ standardRow noLocation =
mtSnippet :: MediaType -> SQL.Snippet -> SQL.Snippet
mtSnippet mediaType snippet = case mediaType of
MTPlan (MTPlanAttrs _ fmt opts) -> explainF fmt opts snippet
_ -> snippet
MTVndPlan _ fmt opts -> explainF fmt opts snippet
_ -> snippet
-- | We use rowList because when doing EXPLAIN (FORMAT TEXT), the result comes as many rows. FORMAT JSON comes as one.
planRow :: HD.Result ResultSet
planRow = RSPlan . BS.unlines <$> HD.rowList (column HD.bytea)
decodeGucHeaders :: HD.Value (Either Error [GucHeader])
decodeGucHeaders = first (const GucHeadersError) . JSON.eitherDecode . LBS.fromStrict <$> HD.bytea
decodeGucStatus :: HD.Value (Either Error (Maybe Status))
decodeGucStatus = first (const GucStatusError) . fmap (Just . toEnum . fst) . decimal <$> HD.text
column :: HD.Value a -> HD.Row a
column = HD.column . HD.nonNullable
+7
View File
@@ -12,6 +12,7 @@ module PostgREST.RangeQuery (
, allRange
, limitZeroRange
, hasLimitZero
, convertToLimitZeroRange
, NonnegRange
, rangeStatusHeader
, contentRangeH
@@ -86,6 +87,12 @@ limitZeroRange = Range (BoundaryBelow 0) (BoundaryAbove (-1))
hasLimitZero :: Range Integer -> Bool
hasLimitZero r = rangeUpper r == rangeUpper limitZeroRange
-- Used to convert a range into a special limitZeroRange if it has a
-- limit=0 in order to bypass validations for empty ranges.
convertToLimitZeroRange :: Range Integer -> Range Integer -> Range Integer
convertToLimitZeroRange range fallbackRange =
if hasLimitZero range then limitZeroRange else fallbackRange
rangeStatusHeader :: NonnegRange -> Int64 -> Maybe Int64 -> (Status, Header)
rangeStatusHeader topLevelRange queryTotal tableTotal =
let lower = rangeOffset topLevelRange
-488
View File
@@ -1,488 +0,0 @@
{-|
Module : PostgREST.Request.ApiRequest
Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Request.ApiRequest
( ApiRequest(..)
, InvokeMethod(..)
, Mutation(..)
, MediaType(..)
, Action(..)
, Target(..)
, Payload(..)
, userApiRequest
) where
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.CaseInsensitive as CI
import qualified Data.Csv as CSV
import qualified Data.HashMap.Strict as HM
import qualified Data.List as L
import qualified Data.List.NonEmpty as NonEmptyList
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text.Encoding as T
import qualified Data.Vector as V
import Control.Arrow ((***))
import Data.Aeson.Types (emptyArray, emptyObject)
import Data.List (lookup, union)
import Data.Maybe (fromJust)
import Data.Ranged.Ranges (emptyRange, rangeIntersection)
import Network.HTTP.Types.Header (hCookie)
import Network.HTTP.Types.URI (parseSimpleQuery)
import Network.Wai (Request (..))
import Network.Wai.Parse (parseHttpAccept)
import Web.Cookie (parseCookies)
import PostgREST.Config (AppConfig (..),
OpenAPIMode (..))
import PostgREST.DbStructure (DbStructure (..))
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema)
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcParam (..), ProcsMap)
import PostgREST.MediaType (MTPlanAttrs (..),
MTPlanFormat (..),
MediaType (..))
import PostgREST.RangeQuery (NonnegRange, allRange,
hasLimitZero,
limitZeroRange,
rangeRequested)
import PostgREST.Request.Preferences (PreferCount (..),
PreferParameters (..),
PreferRepresentation (..),
PreferResolution (..),
PreferTransaction (..))
import PostgREST.Request.QueryParams (QueryParams (..))
import PostgREST.Request.Types (ApiRequestError (..))
import qualified PostgREST.MediaType as MediaType
import qualified PostgREST.Request.Preferences as Preferences
import qualified PostgREST.Request.QueryParams as QueryParams
import Protolude
type RequestBody = LBS.ByteString
data Payload
= ProcessedJSON -- ^ Cached attributes of a JSON payload
{ payRaw :: LBS.ByteString
-- ^ This is the raw ByteString that comes from the request body. We
-- cache this instead of an Aeson Value because it was detected that for
-- large payloads the encoding had high memory usage, see
-- https://github.com/PostgREST/postgrest/pull/1005 for more details
, payKeys :: S.Set Text
-- ^ Keys of the object or if it's an array these keys are guaranteed to
-- be the same across all its objects
}
| RawJSON { payRaw :: LBS.ByteString }
| RawPay { payRaw :: LBS.ByteString }
data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
data Mutation = MutationCreate | MutationDelete | MutationSingleUpsert | MutationUpdate deriving Eq
-- | Types of things a user wants to do to tables/views/procs
data Action
= ActionMutate Mutation
| ActionRead {isHead :: Bool}
| ActionInvoke InvokeMethod
| ActionInfo
| ActionInspect {isHead :: Bool}
deriving Eq
-- | The path info that will be mapped to a target (used to handle validations and errors before defining the Target)
data PathInfo
= PathInfo
{ pathName :: Text
, pathIsProc :: Bool
, pathIsDefSpec :: Bool
, pathIsRootSpec :: Bool
}
-- | The target db object of a user action
data Target = TargetIdent QualifiedIdentifier
| TargetProc{tProc :: ProcDescription, tpIsRootSpec :: Bool}
| TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/"
-- | RPC query param value `/rpc/func?v=<value>`, used for VARIADIC functions on form-urlencoded POST and GETs
-- | It can be fixed `?v=1` or repeated `?v=1&v=2&v=3.
data RpcParamValue = Fixed Text | Variadic [Text]
instance JSON.ToJSON RpcParamValue where
toJSON (Fixed v) = JSON.toJSON v
toJSON (Variadic v) = JSON.toJSON v
toRpcParamValue :: ProcDescription -> (Text, Text) -> (Text, RpcParamValue)
toRpcParamValue proc (k, v) | prmIsVariadic k = (k, Variadic [v])
| otherwise = (k, Fixed v)
where
prmIsVariadic prm = isJust $ find (\ProcParam{ppName, ppVar} -> ppName == prm && ppVar) $ pdParams proc
-- | Convert rpc params `/rpc/func?a=val1&b=val2` to json `{"a": "val1", "b": "val2"}
jsonRpcParams :: ProcDescription -> [(Text, Text)] -> Payload
jsonRpcParams proc prms =
if not $ pdHasVariadic proc then -- if proc has no variadic param, save steps and directly convert to json
ProcessedJSON (JSON.encode $ HM.fromList $ second JSON.toJSON <$> prms) (S.fromList $ fst <$> prms)
else
let paramsMap = HM.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
ProcessedJSON (JSON.encode paramsMap) (S.fromList $ HM.keys paramsMap)
where
mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue
mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a
mergeParams v _ = v -- repeated params for non-variadic parameters are not merged
targetToJsonRpcParams :: Maybe Target -> [(Text, Text)] -> Maybe Payload
targetToJsonRpcParams target params =
case target of
Just TargetProc{tProc} -> Just $ jsonRpcParams tProc params
_ -> Nothing
{-|
Describes what the user wants to do. This data type is a
translation of the raw elements of an HTTP request into domain
specific language. There is no guarantee that the intent is
sensible, it is up to a later stage of processing to determine
if it is an action we are able to perform.
-}
data ApiRequest = ApiRequest {
iAction :: Action -- ^ Similar but not identical to HTTP method, e.g. Create/Invoke both POST
, iRange :: HM.HashMap Text NonnegRange -- ^ Requested range of rows within response
, iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level
, iTarget :: Target -- ^ The target, be it calling a proc or accessing a table
, iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions
, iPreferRepresentation :: PreferRepresentation -- ^ If client wants created items echoed back
, iPreferParameters :: Maybe PreferParameters -- ^ How to pass parameters to a stored procedure
, iPreferCount :: Maybe PreferCount -- ^ Whether the client wants a result count
, iPreferResolution :: Maybe PreferResolution -- ^ Whether the client wants to UPSERT or ignore records on PK conflict
, iPreferTransaction :: Maybe PreferTransaction -- ^ Whether the clients wants to commit or rollback the transaction
, iQueryParams :: QueryParams.QueryParams
, iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload
, iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers
, iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies
, iPath :: ByteString -- ^ Raw request path
, iMethod :: ByteString -- ^ Raw request method
, iProfile :: Maybe Schema -- ^ The request profile for enabling use of multiple schemas. Follows the spec in hhttps://www.w3.org/TR/dx-prof-conneg/ttps://www.w3.org/TR/dx-prof-conneg/.
, iSchema :: Schema -- ^ The request schema. Can vary depending on iProfile.
, iAcceptMediaType :: MediaType
}
-- | Examines HTTP request and translates it into user intent.
userApiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
userApiRequest conf dbStructure req reqBody = do
qPrms <- first QueryParamError $ QueryParams.parse $ rawQueryString req
pInfo <- getPathInfo conf $ pathInfo req
act <- getAction pInfo $ requestMethod req
apiRequest conf dbStructure req reqBody qPrms pInfo act
getPathInfo :: AppConfig -> [Text] -> Either ApiRequestError PathInfo
getPathInfo AppConfig{configOpenApiMode, configDbRootSpec} path =
case path of
[] -> case configDbRootSpec of
Just (QualifiedIdentifier _ pathName) -> Right $ PathInfo pathName True False True
Nothing | configOpenApiMode == OADisabled -> Left NotFound
| otherwise -> Right $ PathInfo mempty False True False
[table] -> Right $ PathInfo table False False False
["rpc", pName] -> Right $ PathInfo pName True False False
_ -> Left NotFound
getAction :: PathInfo -> ByteString -> Either ApiRequestError Action
getAction PathInfo{pathIsProc, pathIsDefSpec} method =
if pathIsProc && method `notElem` ["HEAD", "GET", "POST", "OPTIONS"]
then Left $ InvalidRpcMethod method
else case method of
-- The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response
-- From https://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html#sec9.4
"HEAD" | pathIsDefSpec -> Right $ ActionInspect{isHead=True}
| pathIsProc -> Right $ ActionInvoke InvHead
| otherwise -> Right $ ActionRead{isHead=True}
"GET" | pathIsDefSpec -> Right $ ActionInspect{isHead=False}
| pathIsProc -> Right $ ActionInvoke InvGet
| otherwise -> Right $ ActionRead{isHead=False}
"POST" | pathIsProc -> Right $ ActionInvoke InvPost
| otherwise -> Right $ ActionMutate MutationCreate
"PATCH" -> Right $ ActionMutate MutationUpdate
"PUT" -> Right $ ActionMutate MutationSingleUpsert
"DELETE" -> Right $ ActionMutate MutationDelete
"OPTIONS" -> Right ActionInfo
_ -> Left $ UnsupportedMethod method
apiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action -> Either ApiRequestError ApiRequest
apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..} path@PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action
| isJust profile && fromJust profile `notElem` configDbSchemas = Left $ UnacceptableSchema $ toList configDbSchemas
| isInvalidRange = Left InvalidRange
| shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload
| not expectParams && not (L.null qsParams) = Left $ ParseRequestError "Unexpected param or filter missing operator" ("Failed to parse " <> show qsParams)
| method `elem` ["PATCH", "DELETE"] && not (null qsRanges) && null qsOrder = Left LimitNoOrderError
| method == "PUT" && topLevelRange /= allRange = Left PutRangeNotAllowedError
| otherwise = do
acceptMediaType <- findAcceptMediaType conf action path accepts
checkedTarget <- target
return ApiRequest {
iAction = action
, iTarget = checkedTarget
, iRange = ranges
, iTopLevelRange = topLevelRange
, iPayload = relevantPayload
, iPreferRepresentation = fromMaybe None preferRepresentation
, iPreferParameters = preferParameters
, iPreferCount = preferCount
, iPreferResolution = preferResolution
, iPreferTransaction = preferTransaction
, iQueryParams = queryparams
, iColumns = payloadColumns
, iHeaders = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
, iCookies = maybe [] parseCookies $ lookupHeader "Cookie"
, iPath = rawPathInfo req
, iMethod = method
, iProfile = profile
, iSchema = schema
, iAcceptMediaType = acceptMediaType
}
where
accepts = maybe [MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
expectParams = pathIsProc && method /= "POST"
contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type"
columns = case action of
ActionMutate MutationCreate -> qsColumns
ActionMutate MutationUpdate -> qsColumns
ActionInvoke InvPost -> qsColumns
_ -> Nothing
payloadColumns =
case (contentMediaType, action) of
(_, ActionInvoke InvGet) -> S.fromList $ fst <$> qsParams
(_, ActionInvoke InvHead) -> S.fromList $ fst <$> qsParams
(MTUrlEncoded, _) -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
_ -> case (relevantPayload, columns) of
(Just ProcessedJSON{payKeys}, _) -> payKeys
(Just RawJSON{}, Just cls) -> cls
_ -> S.empty
payload :: Either ByteString Payload
payload = case (contentMediaType, pathIsProc) of
(MTApplicationJSON, _) ->
if isJust columns
then Right $ RawJSON reqBody
else note "All object keys must match" . payloadAttributes reqBody
=<< if LBS.null reqBody && pathIsProc
then Right emptyObject
else first BS.pack $ JSON.eitherDecode reqBody
(MTTextCSV, _) -> do
json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
(MTUrlEncoded, _) ->
let paramsMap = HM.fromList $ (T.decodeUtf8 *** JSON.String . T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) in
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (HM.keys paramsMap)
(MTTextPlain, True) -> Right $ RawPay reqBody
(MTTextXML, True) -> Right $ RawPay reqBody
(MTOctetStream, True) -> Right $ RawPay reqBody
(ct, _) -> Left $ "Content-Type not acceptable: " <> MediaType.toMime ct
topLevelRange = fromMaybe allRange $ HM.lookup "limit" ranges -- if no limit is specified, get all the request rows
defaultSchema = NonEmptyList.head configDbSchemas
profile
| length configDbSchemas <= 1 -- only enable content negotiation by profile when there are multiple schemas specified in the config
= Nothing
| otherwise = case method of
-- POST/PATCH/PUT/DELETE don't use the same header as per the spec
"DELETE" -> contentProfile
"PATCH" -> contentProfile
"POST" -> contentProfile
"PUT" -> contentProfile
_ -> acceptProfile
where
contentProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Content-Profile"
acceptProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Accept-Profile"
schema = fromMaybe defaultSchema profile
target
| pathIsProc = (`TargetProc` pathIsRootSpec) <$> callFindProc schema pathName
| pathIsDefSpec = Right $ TargetDefaultSpec schema
| otherwise = Right $ TargetIdent $ QualifiedIdentifier schema pathName
where
callFindProc procSch procNam = findProc
(QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs dbStructure)
contentMediaType (action == ActionInvoke InvPost)
shouldParsePayload = case (action, contentMediaType) of
(ActionMutate MutationCreate, _) -> True
(ActionInvoke InvPost, MTUrlEncoded) -> False
(ActionInvoke InvPost, _) -> True
(ActionMutate MutationSingleUpsert, _) -> True
(ActionMutate MutationUpdate, _) -> True
_ -> False
relevantPayload = case (contentMediaType, action) of
-- Though ActionInvoke GET/HEAD doesn't really have a payload, we use the payload variable as a way
-- to store the query string arguments to the function.
(_, ActionInvoke InvGet) -> targetToJsonRpcParams (rightToMaybe target) qsParams
(_, ActionInvoke InvHead) -> targetToJsonRpcParams (rightToMaybe target) qsParams
(MTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
_ | shouldParsePayload -> rightToMaybe payload
| otherwise -> Nothing
method = requestMethod req
hdrs = requestHeaders req
lookupHeader = flip lookup hdrs
Preferences.Preferences{..} = Preferences.fromHeaders hdrs
headerRange = rangeRequested hdrs
limitRange = fromMaybe allRange (HM.lookup "limit" qsRanges)
headerAndLimitRange = rangeIntersection headerRange limitRange
-- Bypass all the ranges and send only the limit zero range (0 <= x <= -1) if
-- limit=0 is present in the query params (not allowed for the Range header)
ranges = HM.insert "limit" (if hasLimitZero limitRange then limitZeroRange else headerAndLimitRange) qsRanges
-- The only emptyRange allowed is the limit zero range
isInvalidRange = topLevelRange == emptyRange && not (hasLimitZero limitRange)
{-|
Find the best match from a list of media types accepted by the
client in order of decreasing preference and a list of types
producible by the server. If there is no match but the client
accepts */* then return the top server pick.
-}
mutuallyAgreeable :: [MediaType] -> [MediaType] -> Maybe MediaType
mutuallyAgreeable sProduces cAccepts =
let exact = listToMaybe $ L.intersect cAccepts sProduces in
if isNothing exact && MTAny `elem` cAccepts
then listToMaybe sProduces
else exact
type CsvData = V.Vector (M.Map Text LBS.ByteString)
{-|
Converts CSV like
a,b
1,hi
2,bye
into a JSON array like
[ {"a": "1", "b": "hi"}, {"a": 2, "b": "bye"} ]
The reason for its odd signature is so that it can compose
directly with CSV.decodeByName
-}
csvToJson :: (CSV.Header, CsvData) -> JSON.Value
csvToJson (_, vals) =
JSON.Array $ V.map rowToJsonObj vals
where
rowToJsonObj = JSON.Object . KM.fromMapText .
M.map (\str ->
if str == "NULL"
then JSON.Null
else JSON.String . T.decodeUtf8 $ LBS.toStrict str
)
payloadAttributes :: RequestBody -> JSON.Value -> Maybe Payload
payloadAttributes raw json =
-- Test that Array contains only Objects having the same keys
case json of
JSON.Array arr ->
case arr V.!? 0 of
Just (JSON.Object o) ->
let canonicalKeys = S.fromList $ K.toText <$> KM.keys o
areKeysUniform = all (\case
JSON.Object x -> S.fromList (K.toText <$> KM.keys x) == canonicalKeys
_ -> False) arr in
if areKeysUniform
then Just $ ProcessedJSON raw canonicalKeys
else Nothing
Just _ -> Nothing
Nothing -> Just emptyPJArray
JSON.Object o -> Just $ ProcessedJSON raw (S.fromList $ K.toText <$> KM.keys o)
-- truncate everything else to an empty array.
_ -> Just emptyPJArray
where
emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty
findAcceptMediaType :: AppConfig -> Action -> PathInfo -> [MediaType] -> Either ApiRequestError MediaType
findAcceptMediaType conf action path accepts =
case mutuallyAgreeable (requestMediaTypes conf action path) accepts of
Just ct ->
Right ct
Nothing ->
Left . MediaTypeError $ map MediaType.toMime accepts
requestMediaTypes :: AppConfig -> Action -> PathInfo -> [MediaType]
requestMediaTypes conf action path =
case action of
ActionRead _ -> defaultMediaTypes ++ rawMediaTypes
ActionInvoke _ -> invokeMediaTypes
ActionInspect _ -> [MTOpenAPI, MTApplicationJSON]
ActionInfo -> [MTTextCSV]
_ -> defaultMediaTypes
where
invokeMediaTypes =
defaultMediaTypes
++ rawMediaTypes
++ [MTOpenAPI | pathIsRootSpec path]
defaultMediaTypes =
[MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++
[MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf]
rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML]
{-|
Search a pg proc by matching name and arguments keys to parameters. Since a function can be overloaded,
the name is not enough to find it. An overloaded function can have a different volatility or even a different return type.
-}
findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> MediaType -> Bool -> Either ApiRequestError ProcDescription
findProc qi argumentsKeys paramsAsSingleObject allProcs contentMediaType isInvPost =
case matchProc of
([], []) -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentMediaType isInvPost
-- If there are no functions with named arguments, fallback to the single unnamed argument function
([], [proc]) -> Right proc
([], procs) -> Left $ AmbiguousRpc (toList procs)
-- Matches the functions with named arguments
([proc], _) -> Right proc
(procs, _) -> Left $ AmbiguousRpc (toList procs)
where
matchProc = overloadedProcPartition $ HM.lookupDefault mempty qi allProcs -- first find the proc by name
-- The partition obtained has the form (overloadedProcs,fallbackProcs)
-- where fallbackProcs are functions with a single unnamed parameter
overloadedProcPartition = foldr select ([],[])
select proc ~(ts,fs)
| matchesParams proc = (proc:ts,fs)
| hasSingleUnnamedParam proc = (ts,proc:fs)
| otherwise = (ts,fs)
-- If the function is called with post and has a single unnamed parameter
-- it can be called depending on content type and the parameter type
hasSingleUnnamedParam ProcDescription{pdParams=[ProcParam{ppType}]} = isInvPost && case (contentMediaType, ppType) of
(MTApplicationJSON, "json") -> True
(MTApplicationJSON, "jsonb") -> True
(MTTextPlain, "text") -> True
(MTTextXML, "xml") -> True
(MTOctetStream, "bytea") -> True
_ -> False
hasSingleUnnamedParam _ = False
matchesParams proc =
let
params = pdParams proc
firstType = (ppType <$> headMay params)
in
-- exceptional case for Prefer: params=single-object
if paramsAsSingleObject
then length params == 1 && (firstType == Just "json" || firstType == Just "jsonb")
-- If the function has no parameters, the arguments keys must be empty as well
else if null params
then null argumentsKeys && not (isInvPost && contentMediaType `elem` [MTOctetStream, MTTextPlain, MTTextXML])
-- A function has optional and required parameters. Optional parameters have a default value and
-- don't require arguments for the function to be executed, required parameters must have an argument present.
else case L.partition ppReq params of
-- If the function only has required parameters, the arguments keys must match those parameters
(reqParams, []) -> argumentsKeys == S.fromList (ppName <$> reqParams)
-- If the function only has optional parameters, the arguments keys can match none or any of them(a subset)
([], optParams) -> argumentsKeys `S.isSubsetOf` S.fromList (ppName <$> optParams)
-- If the function has required and optional parameters, the arguments keys have to match the required parameters
-- and can match any or none of the default parameters.
(reqParams, optParams) -> argumentsKeys `S.difference` S.fromList (ppName <$> optParams) == S.fromList (ppName <$> reqParams)
-395
View File
@@ -1,395 +0,0 @@
{-|
Module : PostgREST.Request.DbRequestBuilder
Description : PostgREST database request builder
This module is in charge of building an intermediate
representation(ReadRequest, MutateRequest) between the HTTP request and the
final resulting SQL query.
A query tree is built in case of resource embedding. By inferring the
relationship between tables, join conditions are added for every embedded
resource.
-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Request.DbRequestBuilder
( readRequest
, mutateRequest
, callRequest
) where
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S
import Data.Either.Combinators (mapLeft)
import Data.List (delete)
import Data.Tree (Tree (..))
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema, TableName)
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcParam (..),
procReturnsScalar)
import PostgREST.DbStructure.Relationship (Cardinality (..),
Junction (..),
Relationship (..),
RelationshipsMap)
import PostgREST.Error (Error (..))
import PostgREST.Query.SqlFragment (sourceCTEName)
import PostgREST.RangeQuery (NonnegRange, allRange,
restrictRange)
import PostgREST.Request.ApiRequest (Action (..),
ApiRequest (..),
InvokeMethod (..),
Mutation (..),
Payload (..))
import PostgREST.Request.MutateQuery
import PostgREST.Request.Preferences
import PostgREST.Request.ReadQuery as ReadQuery
import PostgREST.Request.Types
import qualified PostgREST.Request.QueryParams as QueryParams
import Protolude hiding (from)
-- | Builds the ReadRequest tree on a number of stages.
-- | Adds filters, order, limits on its respective nodes.
-- | Adds joins conditions obtained from resource embedding.
readRequest :: Schema -> TableName -> Maybe Integer -> RelationshipsMap -> ApiRequest -> Either Error ReadRequest
readRequest schema rootTableName maxRows allRels apiRequest =
mapLeft ApiRequestError $
treeRestrictRange maxRows (iAction apiRequest) =<<
augmentRequestWithJoin schema allRels =<<
addLogicTrees apiRequest =<<
addRanges apiRequest =<<
addOrders apiRequest =<<
addFilters apiRequest (initReadRequest rootName rootAlias qsSelect)
where
QueryParams.QueryParams{..} = iQueryParams apiRequest
(rootName, rootAlias) = case iAction apiRequest of
ActionRead _ -> (QualifiedIdentifier schema rootTableName, Nothing)
-- the CTE we use for non-read cases has a sourceCTEName(see Statements.hs) as the WITH name so we use the table name as an alias so findRel can find the right relationship
_ -> (QualifiedIdentifier mempty $ decodeUtf8 sourceCTEName, Just rootTableName)
-- Build the initial tree with a Depth attribute so when a self join occurs we
-- can differentiate the parent and child tables by having an alias like
-- "table_depth", this is related to
-- http://github.com/PostgREST/postgrest/issues/987.
initReadRequest :: QualifiedIdentifier -> Maybe Alias -> [Tree SelectItem] -> ReadRequest
initReadRequest rootQi rootAlias =
foldr (treeEntry rootDepth) initial
where
rootDepth = 0
rootSchema = qiSchema rootQi
rootName = qiName rootQi
initial = Node (Select [] rootQi rootAlias [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, Nothing, rootDepth)) []
treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
treeEntry depth (Node fld@((fn, _),_,alias, hint, joinType) fldForest) (Node (q, i) rForest) =
let nxtDepth = succ depth in
case fldForest of
[] -> Node (q {select=fld:select q}, i) rForest
_ -> Node (q, i) $
foldr (treeEntry nxtDepth)
(Node (Select [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] allRange,
(fn, Nothing, alias, hint, joinType, nxtDepth)) [])
fldForest:rForest
-- | Enforces the `max-rows` config on the result
treeRestrictRange :: Maybe Integer -> Action -> ReadRequest -> Either ApiRequestError ReadRequest
treeRestrictRange _ (ActionMutate _) request = Right request
treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> request
where
nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
augmentRequestWithJoin :: Schema -> RelationshipsMap -> ReadRequest -> Either ApiRequestError ReadRequest
augmentRequestWithJoin schema allRels request =
addJoinConditions Nothing <$> addRels schema allRels Nothing request
addRels :: Schema -> RelationshipsMap -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, joinType, depth)) forest) =
case parentNode of
Just (Node (Select{from=parentNodeQi, fromAlias=aliasQi}, _) _) ->
let newFrom r = if qiName tbl == nodeName then relForeignTable r else tbl
newReadNode = (\r ->
if not $ relIsSelf r -- add alias if self rel TODO consolidate aliasing in another function
then (query{from=newFrom r}, (nodeName, Just r, alias, hint, joinType, depth))
else (query{from=newFrom r, fromAlias=Just (qiName (newFrom r) <> "_" <> show depth)}, (nodeName, Just r, alias, hint, joinType, depth))
) <$> rel
origin = if depth == 1 -- Only on depth 1 we check if the root(depth 0) has an alias so the sourceCTEName alias can be found as a relationship
then fromMaybe (qiName parentNodeQi) aliasQi
else qiName parentNodeQi
rel = findRel schema allRels origin nodeName hint
in
Node <$> newReadNode <*> (updateForest . hush $ Node <$> newReadNode <*> pure forest)
_ ->
let rn = (query, (nodeName, Nothing, alias, Nothing, joinType, depth)) in
Node rn <$> updateForest (Just $ Node rn forest)
where
updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
updateForest rq = addRels schema allRels rq `traverse` forest
-- applies aliasing to join conditions TODO refactor, this should go into the querybuilder module
addJoinConditions :: Maybe Alias -> ReadRequest -> ReadRequest
addJoinConditions _ (Node node@(Select{fromAlias=tblAlias}, (_, Nothing, _, _, _, _)) forest) = Node node (addJoinConditions tblAlias <$> forest)
addJoinConditions _ (Node node@(Select{fromAlias=tblAlias}, (_, Just ComputedRelationship{}, _, _, _, _)) forest) = Node node (addJoinConditions tblAlias <$> forest)
addJoinConditions previousAlias (Node (query@Select{fromAlias=tblAlias}, nodeProps@(_, Just (Relationship QualifiedIdentifier{qiSchema=tSchema, qiName=tN} QualifiedIdentifier{qiName=ftN} _ card _ _), _, _, _, _)) forest) =
Node (query{joinConditions=joinConds}, nodeProps) (addJoinConditions tblAlias <$> forest)
where
joinConds =
case card of
M2M (Junction QualifiedIdentifier{qiName=jtn} _ _ jcols1 jcols2) ->
(toJoinCondition Nothing Nothing ftN jtn <$> jcols2) ++ (toJoinCondition previousAlias tblAlias tN jtn <$> jcols1)
O2M _ cols ->
toJoinCondition previousAlias tblAlias tN ftN <$> cols
M2O _ cols ->
toJoinCondition previousAlias tblAlias tN ftN <$> cols
O2O _ cols ->
toJoinCondition previousAlias tblAlias tN ftN <$> cols
toJoinCondition :: Maybe Alias -> Maybe Alias -> Text -> Text -> (FieldName, FieldName) -> JoinCondition
toJoinCondition prAl newAl tb ftb (c, fc) =
let qi1 = QualifiedIdentifier tSchema ftb
qi2 = QualifiedIdentifier tSchema tb in
JoinCondition (maybe qi1 (QualifiedIdentifier mempty) newAl, fc)
(maybe qi2 (QualifiedIdentifier mempty) prAl, c)
-- Finds a relationship between an origin and a target in the request:
-- /origin?select=target(*) If more than one relationship is found then the
-- request is ambiguous and we return an error. In that case the request can
-- be disambiguated by adding precision to the target or by using a hint:
-- /origin?select=target!hint(*). The origin can be a table or view.
findRel :: Schema -> RelationshipsMap -> NodeName -> NodeName -> Maybe Hint -> Either ApiRequestError Relationship
findRel schema allRels origin target hint =
case rels of
[] -> Left $ NoRelBetween origin target schema
[r] -> Right r
rs -> Left $ AmbiguousRelBetween origin target rs
where
matchFKSingleCol hint_ card = case card of
O2M _ [(col, _)] -> hint_ == col
M2O _ [(col, _)] -> hint_ == col
O2O _ [(col, _)] -> hint_ == col
_ -> False
matchFKRefSingleCol hint_ card = case card of
O2M _ [(_, fCol)] -> hint_ == fCol
M2O _ [(_, fCol)] -> hint_ == fCol
O2O _ [(_, fCol)] -> hint_ == fCol
_ -> False
matchConstraint tar card = case card of
O2M cons _ -> tar == cons
M2O cons _ -> tar == cons
O2O cons _ -> tar == cons
_ -> False
matchJunction hint_ card = case card of
M2M Junction{junTable} -> hint_ == qiName junTable
_ -> False
isM2O card = case card of
M2O _ _ -> True
_ -> False
isO2M card = case card of
O2M _ _ -> True
_ -> False
rels = filter (\case
ComputedRelationship{relFunction} -> target == qiName relFunction
Relationship{..} ->
-- In a self-relationship we have a single foreign key but two relationships with different cardinalities: M2O/O2M. For disambiguation, we use the convention of getting:
-- TODO: handle one-to-one and many-to-many self-relationships
if relIsSelf
then case hint of
Nothing ->
-- The O2M by using the table name in the target
target == qiName relForeignTable && isO2M relCardinality -- /family_tree?select=children:family_tree(*)
||
-- The M2O by using the column name in the target
matchFKSingleCol target relCardinality && isM2O relCardinality -- /family_tree?select=parent(*)
Just hnt ->
-- /organizations?select=auditees:organizations!auditor(*)
target == qiName relForeignTable && isO2M relCardinality
&& matchFKRefSingleCol hnt relCardinality -- auditor
else case hint of
-- target = table / view / constraint / column-from-origin (constraint/column-from-origin can only come from tables https://github.com/PostgREST/postgrest/issues/2277)
-- hint = table / view / constraint / column-from-origin / column-from-target (hint can take table / view values to aid in finding the junction in an m2m relationship)
Nothing ->
-- /projects?select=clients(*)
target == qiName relForeignTable -- clients
||
-- /projects?select=projects_client_id_fkey(*)
matchConstraint target relCardinality -- projects_client_id_fkey
&& not relFTableIsView
||
-- /projects?select=client_id(*)
matchFKSingleCol target relCardinality -- client_id
&& not relFTableIsView
Just hnt ->
-- /projects?select=clients(*)
target == qiName relForeignTable -- clients
&& (
-- /projects?select=clients!projects_client_id_fkey(*)
matchConstraint hnt relCardinality || -- projects_client_id_fkey
-- /projects?select=clients!client_id(*) or /projects?select=clients!id(*)
matchFKSingleCol hnt relCardinality || -- client_id
matchFKRefSingleCol hnt relCardinality || -- id
-- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
matchJunction hnt relCardinality -- users_tasks
)
) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier schema origin, schema) allRels
addFilters :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addFilters ApiRequest{..} rReq =
foldr addFilterToNode (Right rReq) flts
where
QueryParams.QueryParams{..} = iQueryParams
flts =
case iAction of
ActionInvoke InvGet -> qsFilters
ActionInvoke InvHead -> qsFilters
ActionInvoke _ -> qsFilters
ActionRead _ -> qsFilters
_ -> qsFiltersNotRoot
addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
addFilterToNode =
updateNode (\flt (Node (q@Select {where_=lf}, i) f) -> Node (q{ReadQuery.where_=addFilterToLogicForest flt lf}, i) f)
addOrders :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addOrders ApiRequest{..} rReq =
case iAction of
ActionMutate _ -> Right rReq
_ -> foldr addOrderToNode (Right rReq) qsOrder
where
QueryParams.QueryParams{..} = iQueryParams
addOrderToNode :: (EmbedPath, [OrderTerm]) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
addOrderToNode = updateNode (\o (Node (q,i) f) -> Node (q{order=o}, i) f)
addRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addRanges ApiRequest{..} rReq =
case iAction of
ActionMutate _ -> Right rReq
_ -> foldr addRangeToNode (Right rReq) =<< ranges
where
ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
ranges = first QueryParamError $ QueryParams.pRequestRange `traverse` HM.toList iRange
addRangeToNode :: (EmbedPath, NonnegRange) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
addRangeToNode = updateNode (\r (Node (q,i) f) -> Node (q{range_=r}, i) f)
addLogicTrees :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addLogicTrees ApiRequest{..} rReq =
foldr addLogicTreeToNode (Right rReq) qsLogic
where
QueryParams.QueryParams{..} = iQueryParams
addLogicTreeToNode :: (EmbedPath, LogicTree) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
addLogicTreeToNode = updateNode (\t (Node (q@Select{where_=lf},i) f) -> Node (q{ReadQuery.where_=t:lf}, i) f)
-- Find a Node of the Tree and apply a function to it
updateNode :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest
updateNode f ([], a) rr = f a <$> rr
updateNode _ _ (Left e) = Left e
updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
case findNode of
Nothing -> Left $ NotEmbedded targetNodeName
Just target ->
(\node -> Node rootNode $ node : delete target forest) <$>
updateNode f (remainingPath, a) (Right target)
where
findNode :: Maybe ReadRequest
findNode = find (\(Node (_,(nodeName,_,alias,_,_, _)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
mutateRequest :: Mutation -> Schema -> TableName -> ApiRequest -> [FieldName] -> ReadRequest -> Either Error MutateRequest
mutateRequest mutation schema tName ApiRequest{..} pkCols readReq = mapLeft ApiRequestError $
case mutation of
MutationCreate ->
Right $ Insert qi iColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings
MutationUpdate -> Right $ Update qi iColumns body combinedLogic iTopLevelRange rootOrder returnings
MutationSingleUpsert ->
if null qsLogic &&
qsFilterFields == S.fromList pkCols &&
not (null (S.fromList pkCols)) &&
all (\case
Filter _ (OpExpr False (Op OpEqual _)) -> True
_ -> False) qsFiltersRoot
then Right $ Insert qi iColumns body (Just (MergeDuplicates, pkCols)) combinedLogic returnings
else
Left InvalidFilters
MutationDelete -> Right $ Delete qi combinedLogic iTopLevelRange rootOrder returnings
where
confCols = fromMaybe pkCols qsOnConflict
QueryParams.QueryParams{..} = iQueryParams
qi = QualifiedIdentifier schema tName
returnings =
if iPreferRepresentation == None
then []
else returningCols readReq pkCols
logic = map snd qsLogic
rootOrder = maybe [] snd $ find (\(x, _) -> null x) qsOrder
combinedLogic = foldr addFilterToLogicForest logic qsFiltersRoot
body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates)
callRequest :: ProcDescription -> ApiRequest -> ReadRequest -> CallRequest
callRequest proc apiReq readReq = FunctionCall {
funCQi = QualifiedIdentifier (pdSchema proc) (pdName proc)
, funCParams = callParams
, funCArgs = payRaw <$> iPayload apiReq
, funCScalar = procReturnsScalar proc
, funCMultipleCall = iPreferParameters apiReq == Just MultipleObjects
, funCReturning = returningCols readReq []
}
where
paramsAsSingleObject = iPreferParameters apiReq == Just SingleObject
callParams = case pdParams proc of
[prm] | paramsAsSingleObject -> OnePosParam prm
| ppName prm == mempty -> OnePosParam prm
| otherwise -> KeyParams $ specifiedParams [prm]
prms -> KeyParams $ specifiedParams prms
specifiedParams = filter (\x -> ppName x `S.member` iColumns apiReq)
returningCols :: ReadRequest -> [FieldName] -> [FieldName]
returningCols rr@(Node _ forest) pkCols
-- if * is part of the select, we must not add pk or fk columns manually -
-- otherwise those would be selected and output twice
| "*" `elem` fldNames = ["*"]
| otherwise = returnings
where
fldNames = fstFieldNames rr
-- Without fkCols, when a mutateRequest to
-- /projects?select=name,clients(name) occurs, the RETURNING SQL part would
-- be `RETURNING name`(see QueryBuilder). This would make the embedding
-- fail because the following JOIN would need the "client_id" column from
-- projects. So this adds the foreign key columns to ensure the embedding
-- succeeds, result would be `RETURNING name, client_id`.
fkCols = concat $ mapMaybe (\case
Node (_, (_, Just Relationship{relCardinality=O2M _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols
Node (_, (_, Just Relationship{relCardinality=M2O _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols
Node (_, (_, Just Relationship{relCardinality=O2O _ cols}, _, _, _, _)) _ -> Just $ fst <$> cols
Node (_, (_, Just Relationship{relCardinality=M2M Junction{junColumns1, junColumns2}}, _, _, _, _)) _ -> Just $ (fst <$> junColumns1) ++ (fst <$> junColumns2)
_ -> Nothing
) forest
hasComputedRel = isJust $ find (\case
Node (_, (_, Just ComputedRelationship{}, _, _, _, _)) _ -> True
_ -> False
) forest
-- However if the "client_id" is present, e.g. mutateRequest to
-- /projects?select=client_id,name,clients(name) we would get `RETURNING
-- client_id, name, client_id` and then we would produce the "column
-- reference \"client_id\" is ambiguous" error from PostgreSQL. So we
-- deduplicate with Set: We are adding the primary key columns as well to
-- make sure, that a proper location header can always be built for
-- INSERT/POST
returnings =
if not hasComputedRel
then S.toList . S.fromList $ fldNames ++ fkCols ++ pkCols
else ["*"] -- on computed relationships we cannot know the required columns for an embedding to succeed, so we just return all
-- Traditional filters(e.g. id=eq.1) are added as root nodes of the LogicTree
-- they are later concatenated with AND in the QueryBuilder
addFilterToLogicForest :: Filter -> [LogicTree] -> [LogicTree]
addFilterToLogicForest flt lf = Stmnt flt : lf
-44
View File
@@ -1,44 +0,0 @@
module PostgREST.Request.MutateQuery
( MutateQuery(..)
, MutateRequest
)
where
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Set as S
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.Request.Preferences (PreferResolution)
import PostgREST.Request.Types (LogicTree, OrderTerm)
import Protolude
type MutateRequest = MutateQuery
data MutateQuery
= Insert
{ in_ :: QualifiedIdentifier
, insCols :: S.Set FieldName
, insBody :: Maybe LBS.ByteString
, onConflict :: Maybe (PreferResolution, [FieldName])
, where_ :: [LogicTree]
, returning :: [FieldName]
}
| Update
{ in_ :: QualifiedIdentifier
, updCols :: S.Set FieldName
, updBody :: Maybe LBS.ByteString
, where_ :: [LogicTree]
, mutRange :: NonnegRange
, mutOrder :: [OrderTerm]
, returning :: [FieldName]
}
| Delete
{ in_ :: QualifiedIdentifier
, where_ :: [LogicTree]
, mutRange :: NonnegRange
, mutOrder :: [OrderTerm]
, returning :: [FieldName]
}
-523
View File
@@ -1,523 +0,0 @@
-- |
-- Module : PostgREST.Request.QueryParams
-- Description : Parser for PostgREST Query paramters
--
-- This module is in charge of parsing all the querystring values in an url, e.g.
-- the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`.
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
module PostgREST.Request.QueryParams
( parse
, QueryParams(..)
, pRequestRange
) where
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashMap.Strict as HM
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Base as HTTP
import qualified Network.HTTP.Types.URI as HTTP
import qualified Text.ParserCombinators.Parsec as P
import Control.Arrow ((***))
import Data.Either.Combinators (mapLeft)
import Data.List (init, last)
import Data.Ranged.Boundaries (Boundary (..))
import Data.Ranged.Ranges (Range (..))
import Data.Tree (Tree (..))
import Text.Parsec.Error (errorMessages,
showErrorMessages)
import Text.Parsec.Prim (parserFail)
import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser,
anyChar, between, char, digit,
eof, errorPos, letter,
lookAhead, many1, noneOf,
notFollowedBy, oneOf,
optionMaybe, sepBy1, string,
try, (<?>))
import PostgREST.DbStructure.Identifiers (FieldName)
import PostgREST.RangeQuery (NonnegRange, allRange,
rangeGeq, rangeLimit,
rangeOffset, restrictRange)
import PostgREST.Request.ReadQuery (SelectItem)
import PostgREST.Request.Types (EmbedParam (..), EmbedPath, Field,
Filter (..), FtsOperator (..),
JoinType (..), JsonOperand (..),
JsonOperation (..), JsonPath,
ListVal, LogicOperator (..),
LogicTree (..), OpExpr (..),
Operation (..),
OrderDirection (..),
OrderNulls (..), OrderTerm (..),
QPError (..), SimpleOperator (..),
SingleVal, TrileanVal (..))
import Protolude hiding (try)
-- $setup
-- Setup for doctests
-- >>> import Text.Pretty.Simple (pPrint)
-- >>> deriving instance Show QPError
-- >>> deriving instance Show TrileanVal
-- >>> deriving instance Show FtsOperator
-- >>> deriving instance Show SimpleOperator
-- >>> deriving instance Show Operation
-- >>> deriving instance Show OpExpr
-- >>> deriving instance Show JsonOperand
-- >>> deriving instance Show JsonOperation
-- >>> deriving instance Show Filter
-- >>> deriving instance Show JoinType
data QueryParams =
QueryParams
{ qsCanonical :: ByteString
-- ^ Canonical representation of the query params, sorted alphabetically
, qsParams :: [(Text, Text)]
-- ^ Parameters for RPC calls
, qsRanges :: HM.HashMap Text (Range Integer)
-- ^ Ranges derived from &limit and &offset params
, qsOrder :: [(EmbedPath, [OrderTerm])]
-- ^ &order parameters for each level
, qsLogic :: [(EmbedPath, LogicTree)]
-- ^ &and and &or parameters used for complex boolean logic
, qsColumns :: Maybe (S.Set FieldName)
-- ^ &columns parameter and payload
, qsSelect :: [Tree SelectItem]
-- ^ &select parameter used to shape the response
, qsFilters :: [(EmbedPath, Filter)]
-- ^ Filters on the result from e.g. &id=e.10
, qsFiltersRoot :: [Filter]
-- ^ Subset of the filters that apply on the root table. These are used on UPDATE/DELETE.
, qsFiltersNotRoot :: [(EmbedPath, Filter)]
-- ^ Subset of the filters that do not apply on the root table
, qsFilterFields :: S.Set FieldName
-- ^ Set of fields that filters apply to
, qsOnConflict :: Maybe [FieldName]
-- ^ &on_conflict parameter used to upsert on specific unique keys
}
-- |
-- Parse query parameters from a query string like "id=eq.1&select=name".
--
-- The canonical representation of the query string has paramters sorted alphabetically:
--
-- >>> qsCanonical <$> parse "a=1&c=3&b=2&d"
-- Right "a=1&b=2&c=3&d="
--
-- 'select' is a reserved parameter that selects the fields to be returned:
--
-- >>> qsSelect <$> parse "select=name,location"
-- Right [Node {rootLabel = (("name",[]),Nothing,Nothing,Nothing,Nothing), subForest = []},Node {rootLabel = (("location",[]),Nothing,Nothing,Nothing,Nothing), subForest = []}]
--
-- Filters are parameters whose value contains an operator, separated by a '.' from its value:
--
-- >>> qsFilters <$> parse "a.b=eq.0"
-- Right [(["a"],Filter {field = ("b",[]), opExpr = OpExpr False (Op OpEqual "0")})]
--
-- If the operator specified in a filter does not exist, parsing the query string fails:
--
-- >>> qsFilters <$> parse "a.b=noop.0"
-- Left (QPError "\"failed to parse filter (noop.0)\" (line 1, column 6)" "unknown single value operator noop")
parse :: ByteString -> Either QPError QueryParams
parse qs =
QueryParams
canonical
params
ranges
<$> pRequestOrder `traverse` order
<*> pRequestLogicTree `traverse` logic
<*> pRequestColumns columns
<*> pRequestSelect select
<*> pRequestFilter `traverse` filters
<*> (fmap snd <$> (pRequestFilter `traverse` filtersRoot))
<*> pRequestFilter `traverse` filtersNotRoot
<*> pure (S.fromList (fst <$> filters))
<*> sequenceA (pRequestOnConflict <$> onConflict)
where
logic = filter (endingIn ["and", "or"] . fst) nonemptyParams
select = fromMaybe "*" $ lookupParam "select"
onConflict = lookupParam "on_conflict"
columns = lookupParam "columns"
order = filter (endingIn ["order"] . fst) nonemptyParams
limits = filter (endingIn ["limit"] . fst) nonemptyParams
-- Replace .offset ending with .limit to be able to match those params later in a map
offsets = first (replaceLast "limit") <$> filter (endingIn ["offset"] . fst) nonemptyParams
lookupParam :: Text -> Maybe Text
lookupParam needle = toS <$> join (L.lookup needle qParams)
nonemptyParams = mapMaybe (\(k, v) -> (k,) <$> v) qParams
qString = HTTP.parseQueryReplacePlus True qs
qParams = [(T.decodeUtf8 k, T.decodeUtf8 <$> v)|(k,v) <- qString]
canonical =
BS.pack $ HTTP.urlEncodeVars
. L.sortOn fst
. map (join (***) BS.unpack . second (fromMaybe mempty))
$ qString
endingIn:: [Text] -> Text -> Bool
endingIn xx key = lastWord `elem` xx
where lastWord = L.last $ T.split (== '.') key
(filters, params) = L.partition isParam filtersAndParams
isParam (k, v) = isEmbedPath k || hasOperator v || hasFtsOperator v
filtersAndParams = filter (isFilterOrParam . fst) nonemptyParams
isFilterOrParam k = not (endingIn reservedEmbeddable k) && notElem k reserved
reserved = ["select", "columns", "on_conflict"]
reservedEmbeddable = ["order", "limit", "offset", "and", "or"]
(filtersNotRoot, filtersRoot) = L.partition isNotRoot filters
isNotRoot = flip T.isInfixOf "." . fst
-- TODO: These checks are redundant to the parsers, should use parsers to differentiate params
hasOperator val =
case T.splitOn "." val of
"not" : _ : _ -> True
"is" : _ -> True
"in" : _ -> True
x : _ -> isJust (operator x) || isJust (ftsOperator x)
_ -> False
hasFtsOperator val =
case T.splitOn "(" val of
x : _ : _ -> isJust $ ftsOperator x
_ -> False
isEmbedPath = T.isInfixOf "."
replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) <> [x]
ranges :: HM.HashMap Text (Range Integer)
ranges = HM.unionWith f limitParams offsetParams
where
f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
where
l = fromMaybe 0 $ rangeLimit rl
o = rangeOffset ro
limitParams =
HM.fromList [(k, restrictRange (readMaybe v) allRange) | (k,v) <- limits]
offsetParams =
HM.fromList [(k, maybe allRange rangeGeq (readMaybe v)) | (k,v) <- offsets]
operator :: Text -> Maybe SimpleOperator
operator = \case
"eq" -> Just OpEqual
"gte" -> Just OpGreaterThanEqual
"gt" -> Just OpGreaterThan
"lte" -> Just OpLessThanEqual
"lt" -> Just OpLessThan
"neq" -> Just OpNotEqual
"like" -> Just OpLike
"ilike" -> Just OpILike
"cs" -> Just OpContains
"cd" -> Just OpContained
"ov" -> Just OpOverlap
"sl" -> Just OpStrictlyLeft
"sr" -> Just OpStrictlyRight
"nxr" -> Just OpNotExtendsRight
"nxl" -> Just OpNotExtendsLeft
"adj" -> Just OpAdjacent
"match" -> Just OpMatch
"imatch" -> Just OpIMatch
_ -> Nothing
ftsOperator :: Text -> Maybe FtsOperator
ftsOperator = \case
"fts" -> Just FilterFts
"plfts" -> Just FilterFtsPlain
"phfts" -> Just FilterFtsPhrase
"wfts" -> Just FilterFtsWebsearch
_ -> Nothing
-- PARSERS
pRequestSelect :: Text -> Either QPError [Tree SelectItem]
pRequestSelect selStr =
mapError $ P.parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
pRequestOnConflict :: Text -> Either QPError [FieldName]
pRequestOnConflict oncStr =
mapError $ P.parse pColumns ("failed to parse on_conflict parameter (" <> toS oncStr <> ")") (toS oncStr)
pRequestFilter :: (Text, Text) -> Either QPError (EmbedPath, Filter)
pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
where
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
oper = P.parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
path = fst <$> treePath
fld = snd <$> treePath
pRequestOrder :: (Text, Text) -> Either QPError (EmbedPath, [OrderTerm])
pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
where
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
path = fst <$> treePath
ord' = P.parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
pRequestRange :: (Text, NonnegRange) -> Either QPError (EmbedPath, NonnegRange)
pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
where
treePath = P.parse pTreePath ("failed to parse tree path (" ++ toS k ++ ")") $ toS k
path = fst <$> treePath
pRequestLogicTree :: (Text, Text) -> Either QPError (EmbedPath, LogicTree)
pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
where
path = P.parse pLogicPath ("failed to parse logic path (" ++ toS k ++ ")") $ toS k
embedPath = fst <$> path
logicTree = do
op <- snd <$> path
-- Concat op and v to make pLogicTree argument regular,
-- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
P.parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
pRequestColumns :: Maybe Text -> Either QPError (Maybe (S.Set FieldName))
pRequestColumns colStr =
case colStr of
Just str ->
mapError $ Just . S.fromList <$> P.parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str)
_ -> Right Nothing
ws :: Parser Text
ws = toS <$> many (oneOf " \t")
lexeme :: Parser a -> Parser a
lexeme p = ws *> p <* ws
pTreePath :: Parser (EmbedPath, Field)
pTreePath = do
p <- pFieldName `sepBy1` pDelimiter
jp <- P.option [] pJsonPath
return (init p, (last p, jp))
pFieldForest :: Parser [Tree SelectItem]
pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
where
pFieldTree :: Parser (Tree SelectItem)
pFieldTree = try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) <|>
Node <$> pFieldSelect <*> pure []
pStar :: Parser Text
pStar = string "*" $> "*"
pFieldName :: Parser Text
pFieldName =
pQuotedValue <|>
T.intercalate "-" . map toS <$> (many1 pIdentifierChar `sepBy1` dash) <?>
"field name (* or [a..z0..9_])"
where
isDash :: GenParser Char st ()
isDash = try ( char '-' >> notFollowedBy (char '>') )
dash :: Parser Char
dash = isDash $> '-'
-- |
-- Parse json operators in select, order and filters
--
-- >>> P.parse pJsonPath "" "->text"
-- Right [JArrow {jOp = JKey {jVal = "text"}}]
--
-- >>> P.parse pJsonPath "" "->1"
-- Right [JArrow {jOp = JIdx {jVal = "+1"}}]
--
-- >>> P.parse pJsonPath "" "->>text"
-- Right [J2Arrow {jOp = JKey {jVal = "text"}}]
--
-- >>> P.parse pJsonPath "" "->>1"
-- Right [J2Arrow {jOp = JIdx {jVal = "+1"}}]
--
-- >>> P.parse pJsonPath "" "->0,other"
-- Right [JArrow {jOp = JIdx {jVal = "+0"}}]
--
-- >>> P.parse pJsonPath "" "->0.desc"
-- Right [JArrow {jOp = JIdx {jVal = "+0"}}]
pJsonPath :: Parser JsonPath
pJsonPath = many pJsonOperation
where
pJsonOperation :: Parser JsonOperation
pJsonOperation = pJsonArrow <*> pJsonOperand
pJsonArrow =
try (string "->>" $> J2Arrow) <|>
try (string "->" $> JArrow)
pJsonOperand =
let pJKey = JKey . toS <$> pFieldName
pJIdx = JIdx . toS <$> ((:) <$> P.option '+' (char '-') <*> many1 digit) <* pEnd
pEnd = try (void $ lookAhead (string "->")) <|>
try (void $ lookAhead (string "::")) <|>
try (void $ lookAhead (string ".")) <|>
try (void $ lookAhead (string ",")) <|>
try eof in
try pJIdx <|> try pJKey
pField :: Parser Field
pField = lexeme $ (,) <$> pFieldName <*> P.option [] pJsonPath
aliasSeparator :: Parser ()
aliasSeparator = char ':' >> notFollowedBy (char ':')
pRelationSelect :: Parser SelectItem
pRelationSelect = lexeme $ try ( do
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
fld <- pField
prm1 <- optionMaybe pEmbedParam
prm2 <- optionMaybe pEmbedParam
return (fld, Nothing, alias, embedParamHint prm1 <|> embedParamHint prm2, embedParamJoin prm1 <|> embedParamJoin prm2)
)
where
pEmbedParam :: Parser EmbedParam
pEmbedParam =
char '!' *> (
try (string "left" $> EPJoinType JTLeft) <|>
try (string "inner" $> EPJoinType JTInner) <|>
try (EPHint <$> pFieldName))
embedParamHint prm = case prm of
Just (EPHint hint) -> Just hint
_ -> Nothing
embedParamJoin prm = case prm of
Just (EPJoinType jt) -> Just jt
_ -> Nothing
pFieldSelect :: Parser SelectItem
pFieldSelect = lexeme $
try (
do
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
fld <- pField
cast' <- optionMaybe (string "::" *> many pIdentifierChar)
return (fld, toS <$> cast', alias, Nothing, Nothing)
)
<|> do
s <- pStar
return ((s, []), Nothing, Nothing, Nothing, Nothing)
pOpExpr :: Parser SingleVal -> Parser OpExpr
pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
where
pOperation :: Parser Operation
pOperation = pIn <|> pIs <|> try pFts <|> pOp <?> "operator (eq, gt, ...)"
pIn = In <$> (try (string "in" *> pDelimiter) *> pListVal)
pIs = Is <$> (try (string "is" *> pDelimiter) *> pTriVal)
pOp = do
opStr <- try (P.manyTill anyChar (try pDelimiter))
op <- parseMaybe ("unknown single value operator " <> opStr) . operator $ toS opStr
Op op <$> pSVal
pTriVal = try (ciString "null" $> TriNull)
<|> try (ciString "unknown" $> TriUnknown)
<|> try (ciString "true" $> TriTrue)
<|> try (ciString "false" $> TriFalse)
<?> "null or trilean value (unknown, true, false)"
pFts = do
opStr <- try (P.many (noneOf ".("))
op <- parseMaybe ("unknown fts operator " <> opStr) . ftsOperator $ toS opStr
lang <- optionMaybe $ try (between (char '(') (char ')') $ many pIdentifierChar)
pDelimiter >> Fts op (toS <$> lang) <$> pSVal
parseMaybe :: [Char] -> Maybe a -> Parser a
parseMaybe err Nothing = parserFail err
parseMaybe _ (Just x) = pure x
-- case insensitive char and string
ciChar :: Char -> GenParser Char state Char
ciChar c = char c <|> char (toUpper c)
ciString :: [Char] -> GenParser Char state [Char]
ciString = traverse ciChar
pSingleVal :: Parser SingleVal
pSingleVal = toS <$> many anyChar
pListVal :: Parser ListVal
pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
pListElement :: Parser Text
pListElement = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)"))
pQuotedValue :: Parser Text
pQuotedValue = toS <$> (char '"' *> many pCharsOrSlashed <* char '"')
where
pCharsOrSlashed = noneOf "\\\"" <|> (char '\\' *> anyChar)
pDelimiter :: Parser Char
pDelimiter = char '.' <?> "delimiter (.)"
pOrder :: Parser [OrderTerm]
pOrder = lexeme pOrderTerm `sepBy1` char ','
pOrderTerm :: Parser OrderTerm
pOrderTerm = do
fld <- pField
dir <- optionMaybe $
try (pDelimiter *> string "asc" $> OrderAsc) <|>
try (pDelimiter *> string "desc" $> OrderDesc)
nls <- optionMaybe pNulls <* pEnd <|>
pEnd $> Nothing
return $ OrderTerm fld dir nls
where
pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|>
try (pDelimiter *> string "nullslast" $> OrderNullsLast)
pEnd = try (void $ lookAhead (char ',')) <|>
try eof
pLogicTree :: Parser LogicTree
pLogicTree = Stmnt <$> try pLogicFilter
<|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')'))
where
pLogicFilter :: Parser Filter
pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal
pNot :: Parser Bool
pNot = try (string "not" *> pDelimiter $> True)
<|> pure False
<?> "negation operator (not)"
pLogicOp :: Parser LogicOperator
pLogicOp = try (string "and" $> And)
<|> string "or" $> Or
<?> "logic operator (and, or)"
pLogicSingleVal :: Parser SingleVal
pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
where
pPgArray :: Parser Text
pPgArray = do
a <- string "{"
b <- many (noneOf "{}")
c <- string "}"
pure (toS $ a ++ b ++ c)
pLogicPath :: Parser (EmbedPath, Text)
pLogicPath = do
path <- pFieldName `sepBy1` pDelimiter
let op = last path
notOp = "not." <> op
return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
pColumns :: Parser [FieldName]
pColumns = pFieldName `sepBy1` lexeme (char ',')
pIdentifierChar :: Parser Char
pIdentifierChar = letter <|> digit <|> oneOf "_ $"
mapError :: Either ParseError a -> Either QPError a
mapError = mapLeft translateError
where
translateError e =
QPError message details
where
message = show $ errorPos e
details = T.strip $ T.replace "\n" " " $ toS
$ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
-46
View File
@@ -1,46 +0,0 @@
module PostgREST.Request.ReadQuery
( ReadNode
, ReadQuery(..)
, ReadRequest
, SelectItem
, fstFieldNames
) where
import Data.Tree (Tree (..))
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.DbStructure.Relationship (Relationship)
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.Request.Types (Alias, Cast, Depth, Field,
Hint, JoinCondition,
JoinType, LogicTree,
NodeName, OrderTerm)
import Protolude
type ReadRequest = Tree ReadNode
type ReadNode =
(ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe Hint, Maybe JoinType, Depth))
-- | The select value in `/tbl?select=alias:field::cast`
type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType)
data ReadQuery = Select
{ select :: [SelectItem]
, from :: QualifiedIdentifier
, fromAlias :: Maybe Alias
-- ^ A table alias is used in case of self joins
, where_ :: [LogicTree]
, joinConditions :: [JoinCondition]
, order :: [OrderTerm]
, range_ :: NonnegRange
}
deriving (Eq)
-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
fstFieldNames :: ReadRequest -> [FieldName]
fstFieldNames (Node (sel, _) _) =
fst . (\(f, _, _, _, _) -> f) <$> select sel
+300
View File
@@ -0,0 +1,300 @@
{- |
Module : PostgREST.Response
Description : Generate HTTP Response
-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Response
( createResponse
, deleteResponse
, infoIdentResponse
, infoProcResponse
, infoRootResponse
, invokeResponse
, openApiResponse
, readResponse
, singleUpsertResponse
, updateResponse
, PgrstResponse(..)
) where
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
import Data.Maybe (fromJust)
import Data.Text.Read (decimal)
import qualified Network.HTTP.Types.Header as HTTP
import qualified Network.HTTP.Types.Status as HTTP
import qualified Network.HTTP.Types.URI as HTTP
import qualified PostgREST.Error as Error
import qualified PostgREST.MediaType as MediaType
import qualified PostgREST.RangeQuery as RangeQuery
import qualified PostgREST.Response.OpenAPI as OpenAPI
import PostgREST.ApiRequest (ApiRequest (..),
InvokeMethod (..))
import PostgREST.ApiRequest.Preferences (PreferRepresentation (..),
PreferResolution (..),
Preferences (..),
prefAppliedHeader,
shouldCount)
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
import PostgREST.Config (AppConfig (..))
import PostgREST.MediaType (MediaType (..))
import PostgREST.Plan (CallReadPlan (..),
MutateReadPlan (..),
WrappedReadPlan (..))
import PostgREST.Plan.MutatePlan (MutatePlan (..))
import PostgREST.Query.Statements (ResultSet (..))
import PostgREST.Response.GucHeader (GucHeader, unwrapGucHeader)
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
Schema)
import PostgREST.SchemaCache.Routine (FuncVolatility (..),
Routine (..), RoutineMap)
import PostgREST.SchemaCache.Table (Table (..), TablesMap)
import qualified PostgREST.ApiRequest.Types as ApiRequestTypes
import qualified PostgREST.SchemaCache.Routine as Routine
import Protolude hiding (Handler, toS)
import Protolude.Conv (toS)
data PgrstResponse = PgrstResponse {
pgrstStatus :: HTTP.Status
, pgrstHeaders :: [HTTP.Header]
, pgrstBody :: LBS.ByteString
}
readResponse :: WrappedReadPlan -> Bool -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet =
case resultSet of
RSStandard{..} -> do
let
(status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing Nothing preferCount preferTransaction Nothing preferHandling preferTimezone []
headers =
[ contentRange
, ( "Content-Location"
, "/"
<> toUtf8 (qiName identifier)
<> if BS.null (qsCanonical iQueryParams) then mempty else "?" <> qsCanonical iQueryParams
)
]
++ contentTypeHeaders wrMedia ctxApiRequest
++ prefHeader
(ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers
let bod | status == HTTP.status416 = Error.errorPayload $ Error.ApiRequestError $ ApiRequestTypes.InvalidRange $
ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal)
| headersOnly = mempty
| otherwise = LBS.fromStrict rsBody
Right $ PgrstResponse ovStatus ovHeaders bod
RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders wrMedia ctxApiRequest) $ LBS.fromStrict plan
createResponse :: QualifiedIdentifier -> MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of
RSStandard{..} -> do
let
pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;}
prefHeader = prefAppliedHeader $
Preferences (if null pkCols && isNothing (qsOnConflict iQueryParams) then Nothing else preferResolution)
preferRepresentation Nothing preferCount preferTransaction preferMissing preferHandling preferTimezone []
headers =
catMaybes
[ if null rsLocation then
Nothing
else
Just
( HTTP.hLocation
, "/"
<> toUtf8 qiName
<> HTTP.renderSimpleQuery True rsLocation
)
, Just . RangeQuery.contentRangeH 1 0 $
if shouldCount preferCount then Just rsQueryTotal else Nothing
, prefHeader ]
let isInsertIfGTZero i =
if i <= 0 && preferResolution == Just MergeDuplicates then
HTTP.status200
else
HTTP.status201
status = maybe HTTP.status200 isInsertIfGTZero rsInserted
(headers', bod) = case preferRepresentation of
Just Full -> (headers ++ contentTypeHeaders mrMedia ctxApiRequest, LBS.fromStrict rsBody)
Just None -> (headers, mempty)
Just HeadersOnly -> (headers, mempty)
Nothing -> (headers, mempty)
(ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers'
Right $ PgrstResponse ovStatus ovHeaders bod
RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
updateResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard{..} -> do
let
contentRangeHeader =
Just . RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
if shouldCount preferCount then Just rsQueryTotal else Nothing
prefHeader = prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction preferMissing preferHandling preferTimezone []
headers = catMaybes [contentRangeHeader, prefHeader]
let (status, headers', body) =
case preferRepresentation of
Just Full -> (HTTP.status200, headers ++ contentTypeHeaders mrMedia ctxApiRequest, LBS.fromStrict rsBody)
Just None -> (HTTP.status204, headers, mempty)
_ -> (HTTP.status204, headers, mempty)
(ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers'
Right $ PgrstResponse ovStatus ovHeaders body
RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
singleUpsertResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard {..} -> do
let
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling preferTimezone []
cTHeader = contentTypeHeaders mrMedia ctxApiRequest
let isInsertIfGTZero i = if i > 0 then HTTP.status201 else HTTP.status200
upsertStatus = isInsertIfGTZero $ fromJust rsInserted
(status, headers, body) =
case preferRepresentation of
Just Full -> (upsertStatus, cTHeader ++ prefHeader, LBS.fromStrict rsBody)
Just None -> (HTTP.status204, prefHeader, mempty)
_ -> (HTTP.status204, prefHeader, mempty)
(ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers
Right $ PgrstResponse ovStatus ovHeaders body
RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
deleteResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard {..} -> do
let
contentRangeHeader =
RangeQuery.contentRangeH 1 0 $
if shouldCount preferCount then Just rsQueryTotal else Nothing
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling preferTimezone []
headers = contentRangeHeader : prefHeader
let (status, headers', body) =
case preferRepresentation of
Just Full -> (HTTP.status200, headers ++ contentTypeHeaders mrMedia ctxApiRequest, LBS.fromStrict rsBody)
Just None -> (HTTP.status204, headers, mempty)
_ -> (HTTP.status204, headers, mempty)
(ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers'
Right $ PgrstResponse ovStatus ovHeaders body
RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
infoIdentResponse :: QualifiedIdentifier -> SchemaCache -> Either Error.Error PgrstResponse
infoIdentResponse identifier sCache = do
case HM.lookup identifier (dbTables sCache) of
Just tbl -> respondInfo $ allowH tbl
Nothing -> Left $ Error.ApiRequestError ApiRequestTypes.NotFound
where
allowH table =
let hasPK = not . null $ tablePKCols table in
BS.intercalate "," $
["OPTIONS,GET,HEAD"] ++
["POST" | tableInsertable table] ++
["PUT" | tableInsertable table && tableUpdatable table && hasPK] ++
["PATCH" | tableUpdatable table] ++
["DELETE" | tableDeletable table]
infoProcResponse :: Routine -> Either Error.Error PgrstResponse
infoProcResponse proc | pdVolatility proc == Volatile = respondInfo "OPTIONS,POST"
| otherwise = respondInfo "OPTIONS,GET,HEAD,POST"
infoRootResponse :: Either Error.Error PgrstResponse
infoRootResponse = respondInfo "OPTIONS,GET,HEAD"
respondInfo :: ByteString -> Either Error.Error PgrstResponse
respondInfo allowHeader =
let allOrigins = ("Access-Control-Allow-Origin", "*") in
Right $ PgrstResponse HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty
invokeResponse :: CallReadPlan -> InvokeMethod -> Routine -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = case resultSet of
RSStandard {..} -> do
let
(status, contentRange) =
RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
rsOrErrBody = if status == HTTP.status416
then Error.errorPayload $ Error.ApiRequestError $ ApiRequestTypes.InvalidRange
$ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal)
else LBS.fromStrict rsBody
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing preferParameters preferCount preferTransaction Nothing preferHandling preferTimezone []
headers = contentRange : prefHeader
let (status', headers', body) =
if Routine.funcReturnsVoid proc then
(HTTP.status204, headers, mempty)
else
(status,
headers ++ contentTypeHeaders crMedia ctxApiRequest,
if invMethod == InvHead then mempty else rsOrErrBody)
(ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status' headers'
Right $ PgrstResponse ovStatus ovHeaders body
RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders crMedia ctxApiRequest) $ LBS.fromStrict plan
openApiResponse :: (Text, Text) -> Bool -> Maybe (TablesMap, RoutineMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse
openApiResponse versions headersOnly body conf sCache schema negotiatedByProfile =
Right $ PgrstResponse HTTP.status200
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile))
(maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode versions conf sCache x y z) body)
-- Status and headers can be overridden as per https://postgrest.org/en/stable/references/transactions.html#response-headers
overrideStatusHeaders :: Maybe Text -> Maybe BS.ByteString -> HTTP.Status -> [HTTP.Header]-> Either Error.Error (HTTP.Status, [HTTP.Header])
overrideStatusHeaders rsGucStatus rsGucHeaders pgrstStatus pgrstHeaders = do
gucStatus <- decodeGucStatus rsGucStatus
gucHeaders <- decodeGucHeaders rsGucHeaders
Right (fromMaybe pgrstStatus gucStatus, addHeadersIfNotIncluded pgrstHeaders $ map unwrapGucHeader gucHeaders)
decodeGucHeaders :: Maybe BS.ByteString -> Either Error.Error [GucHeader]
decodeGucHeaders =
maybe (Right []) $ first (const . Error.ApiRequestError $ ApiRequestTypes.GucHeadersError) . JSON.eitherDecode . LBS.fromStrict
decodeGucStatus :: Maybe Text -> Either Error.Error (Maybe HTTP.Status)
decodeGucStatus =
maybe (Right Nothing) $ first (const . Error.ApiRequestError $ ApiRequestTypes.GucStatusError) . fmap (Just . toEnum . fst) . decimal
contentTypeHeaders :: MediaType -> ApiRequest -> [HTTP.Header]
contentTypeHeaders mediaType ApiRequest{..} =
MediaType.toContentType mediaType : maybeToList (profileHeader iSchema iNegotiatedByProfile)
profileHeader :: Schema -> Bool -> Maybe HTTP.Header
profileHeader schema negotiatedByProfile =
if negotiatedByProfile
then Just $ (,) "Content-Profile" (toS schema)
else
Nothing
-- | Add headers not already included to allow the user to override them instead of duplicating them
addHeadersIfNotIncluded :: [HTTP.Header] -> [HTTP.Header] -> [HTTP.Header]
addHeadersIfNotIncluded newHeaders initialHeaders =
filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++
initialHeaders
@@ -1,7 +1,6 @@
module PostgREST.GucHeader
module PostgREST.Response.GucHeader
( GucHeader
, unwrapGucHeader
, addHeadersIfNotIncluded
) where
import qualified Data.Aeson as JSON
@@ -29,9 +28,3 @@ instance JSON.FromJSON GucHeader where
unwrapGucHeader :: GucHeader -> Header
unwrapGucHeader (GucHeader (k, v)) = (k, v)
-- | Add headers not already included to allow the user to override them instead of duplicating them
addHeadersIfNotIncluded :: [Header] -> [Header] -> [Header]
addHeadersIfNotIncluded newHeaders initialHeaders =
filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++
initialHeaders
@@ -4,7 +4,7 @@ Description : Generates the OpenAPI output
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.OpenAPI (encode) where
module PostgREST.Response.OpenAPI (encode) where
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
@@ -12,7 +12,6 @@ import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet.InsOrd as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Control.Arrow ((&&&))
import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)
@@ -26,26 +25,27 @@ import Data.Swagger
import PostgREST.Config (AppConfig (..), Proxy (..),
isMalformedProxyUri, toURI)
import PostgREST.DbStructure (DbStructure (..))
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcParam (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
import PostgREST.SchemaCache.Relationship (Cardinality (..),
Relationship (..),
RelationshipsMap)
import PostgREST.DbStructure.Table (Column (..), Table (..),
TablesMap)
import PostgREST.Version (docsVersion, prettyVersion)
import PostgREST.SchemaCache.Routine (Routine (..),
RoutineParam (..))
import PostgREST.SchemaCache.Table (Column (..), Table (..),
TablesMap,
tableColumnsList)
import PostgREST.MediaType
import Protolude hiding (Proxy, get)
encode :: AppConfig -> DbStructure -> TablesMap -> HM.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
encode conf dbStructure tables procs schemaDescription =
encode :: (Text, Text) -> AppConfig -> SchemaCache -> TablesMap -> HM.HashMap k [Routine] -> Maybe Text -> LBS.ByteString
encode versions conf sCache tables procs schemaDescription =
JSON.encode $
postgrestSpec
(dbRelationships dbStructure)
versions
(dbRelationships sCache)
(concat $ HM.elems procs)
(snd <$> HM.toList tables)
(proxyUri conf)
@@ -66,10 +66,22 @@ toSwaggerType "bigint" = Just SwaggerInteger
toSwaggerType "numeric" = Just SwaggerNumber
toSwaggerType "real" = Just SwaggerNumber
toSwaggerType "double precision" = Just SwaggerNumber
toSwaggerType "ARRAY" = Just SwaggerArray
toSwaggerType "json" = Nothing
toSwaggerType "jsonb" = Nothing
toSwaggerType _ = Just SwaggerString
toSwaggerType colType = case T.takeEnd 2 colType of
"[]" -> Just SwaggerArray
_ -> Just SwaggerString
typeFromArray :: Text -> Text
typeFromArray = T.dropEnd 2
toSwaggerTypeFromArray :: Text -> Maybe (SwaggerType t)
toSwaggerTypeFromArray arrType = toSwaggerType $ typeFromArray arrType
makePropertyItems :: Text -> Maybe (Referenced Schema)
makePropertyItems arrType = case toSwaggerType arrType of
Just SwaggerArray -> Just $ Inline (mempty & type_ .~ toSwaggerTypeFromArray arrType)
_ -> Nothing
parseDefault :: Text -> Text -> Text
parseDefault colType colDefault =
@@ -87,8 +99,8 @@ makeTableDef rels t =
(tn, (mempty :: Schema)
& description .~ tableDescription t
& type_ ?~ SwaggerObject
& properties .~ fromList (makeProperty t rels <$> tableColumns t)
& required .~ fmap colName (filter (not . colNullable) $ tableColumns t))
& properties .~ fromList (makeProperty t rels <$> tableColumnsList t)
& required .~ fmap colName (filter (not . colNullable) $ tableColumnsList t))
makeProperty :: Table -> RelationshipsMap -> Column -> (Text, Referenced Schema)
makeProperty tbl rels col = (colName col, Inline s)
@@ -97,11 +109,14 @@ makeProperty tbl rels col = (colName col, Inline s)
fk :: Maybe Text
fk =
let
searchedRels = fromMaybe mempty $ HM.lookup (QualifiedIdentifier (tableSchema tbl) (tableName tbl), tableSchema tbl) rels
-- Sorts the relationship list to get tables first
relsSortedByIsView = sortOn relFTableIsView [ r | r@Relationship{} <- searchedRels]
-- Finds the relationship that has a single column foreign key
rel = find (\case
Relationship{relCardinality=(M2O _ relColumns)} -> [colName col] == (fst <$> relColumns)
_ -> False
) $ fromMaybe mempty $ HM.lookup (QualifiedIdentifier (tableSchema tbl) (tableName tbl), tableSchema tbl) rels
) relsSortedByIsView
fCol = (headMay . (\r -> snd <$> relColumns (relCardinality r)) =<< rel)
fTbl = qiName . relForeignTable <$> rel
fTblCol = (,) <$> fTbl <*> fCol
@@ -127,8 +142,9 @@ makeProperty tbl rels col = (colName col, Inline s)
& format ?~ colType col
& maxLength .~ (fromIntegral <$> colMaxLen col)
& type_ .~ toSwaggerType (colType col)
& items .~ (SwaggerItemsObject <$> makePropertyItems (colType col))
makeProcSchema :: ProcDescription -> Schema
makeProcSchema :: Routine -> Schema
makeProcSchema pd =
(mempty :: Schema)
& description .~ pdDescription pd
@@ -136,11 +152,12 @@ makeProcSchema pd =
& properties .~ fromList (fmap makeProcProperty (pdParams pd))
& required .~ fmap ppName (filter ppReq (pdParams pd))
makeProcProperty :: ProcParam -> (Text, Referenced Schema)
makeProcProperty (ProcParam n t _ _) = (n, Inline s)
makeProcProperty :: RoutineParam -> (Text, Referenced Schema)
makeProcProperty (RoutineParam n t _ _ _) = (n, Inline s)
where
s = (mempty :: Schema)
& type_ .~ toSwaggerType t
& items .~ (SwaggerItemsObject <$> makePropertyItems t)
& format ?~ t
makePreferParam :: [Text] -> Param
@@ -152,10 +169,47 @@ makePreferParam ts =
& schema .~ ParamOther ((mempty :: ParamOtherSchema)
& in_ .~ ParamHeader
& type_ ?~ SwaggerString
& enum_ .~ JSON.decode (JSON.encode ts))
& enum_ .~ JSON.decode (JSON.encode $ foldl (<>) [] (val <$> ts)))
where
val :: Text -> [Text]
val = \case
"count" -> ["count=none"]
"params" -> ["params=single-object"]
"return" -> ["return=representation", "return=minimal", "return=none"]
"resolution" -> ["resolution=ignore-duplicates", "resolution=merge-duplicates"]
_ -> []
makeProcParam :: ProcDescription -> [Referenced Param]
makeProcParam pd =
makeProcGetParam :: RoutineParam -> Referenced Param
makeProcGetParam (RoutineParam n t _ r v) =
Inline $ (mempty :: Param)
& name .~ n
& required ?~ r
& schema .~ ParamOther fullSchema
where
fullSchema = if v then schemaMulti else schemaNotMulti
baseSchema = (mempty :: ParamOtherSchema)
& in_ .~ ParamQuery
schemaNotMulti = baseSchema
& format ?~ t
& type_ ?~ toParamType (toSwaggerType t)
schemaMulti = baseSchema
& type_ ?~ fromMaybe SwaggerString (toSwaggerType t)
& items ?~ SwaggerItemsPrimitive (Just CollectionMulti)
((mempty :: ParamSchema x)
& type_ .~ toSwaggerTypeFromArray t
& format ?~ typeFromArray t)
toParamType paramType = case paramType of
-- Array uses {} in query params
Just SwaggerArray -> SwaggerString
-- Type must be specified in query params
Nothing -> SwaggerString
_ -> fromJust paramType
makeProcGetParams :: [RoutineParam] -> [Referenced Param]
makeProcGetParams = fmap makeProcGetParam
makeProcPostParams :: Routine -> [Referenced Param]
makeProcPostParams pd =
[ Inline $ (mempty :: Param)
& name .~ "args"
& required ?~ True
@@ -165,9 +219,11 @@ makeProcParam pd =
makeParamDefs :: [Table] -> [(Text, Param)]
makeParamDefs ti =
[ ("preferParams", makePreferParam ["params=single-object"])
, ("preferReturn", makePreferParam ["return=representation", "return=minimal", "return=none"])
, ("preferCount", makePreferParam ["count=none"])
-- TODO: create Prefer for each method (GET, PATCH, etc.)
[ ("preferParams", makePreferParam ["params"])
, ("preferReturn", makePreferParam ["return"])
, ("preferCount", makePreferParam ["count"])
, ("preferPost", makePreferParam ["return", "resolution"])
, ("select", (mempty :: Param)
& name .~ "select"
& description ?~ "Filtering Columns"
@@ -219,7 +275,7 @@ makeParamDefs ti =
& in_ .~ ParamQuery
& type_ ?~ SwaggerString))
]
<> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) (tableColumns t)
<> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) (tableColumnsList t)
| t <- ti
]
@@ -267,7 +323,7 @@ makePathItem t = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t
)
)
postOp = tOp
& parameters .~ fmap ref ["body." <> tn, "select", "preferReturn"]
& parameters .~ fmap ref ["body." <> tn, "select", "preferPost"]
& at 201 ?~ "Created"
patchOp = tOp
& parameters .~ fmap ref (rs <> ["body." <> tn, "preferReturn"])
@@ -280,24 +336,29 @@ makePathItem t = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t
p False = pr
p True = pw
tn = tableName t
rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- tableColumns t ]
rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- tableColumnsList t ]
ref = Ref . Reference
makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
makeProcPathItem :: Routine -> (FilePath, PathItem)
makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
where
-- Use first line of proc 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
(pSum, pDesc) = fmap fst &&& fmap (T.dropWhile (=='\n') . snd) $
T.breakOn "\n" <$> pdDescription pd
postOp = (mempty :: Operation)
procOp = (mempty :: Operation)
& summary .~ pSum
& description .~ mfilter (/="") pDesc
& parameters .~ makeProcParam pd
& tags .~ Set.fromList ["(rpc) " <> pdName pd]
& produces ?~ makeMimeList [MTApplicationJSON, MTSingularJSON]
& produces ?~ makeMimeList [MTApplicationJSON, MTVndSingularJSON True, MTVndSingularJSON False]
& at 200 ?~ "OK"
pe = (mempty :: PathItem) & post ?~ postOp
getOp = procOp
& parameters .~ makeProcGetParams (pdParams pd)
postOp = procOp
& parameters .~ makeProcPostParams pd
pe = (mempty :: PathItem)
& get ?~ getOp
& post ?~ postOp
makeRootPathItem :: (FilePath, PathItem)
makeRootPathItem = ("/", p)
@@ -310,7 +371,7 @@ makeRootPathItem = ("/", p)
pr = (mempty :: PathItem) & get ?~ getOp
p = pr
makePathItems :: [ProcDescription] -> [Table] -> InsOrdHashMap FilePath PathItem
makePathItems :: [Routine] -> [Table] -> InsOrdHashMap FilePath PathItem
makePathItems pds ti = fromList $ makeRootPathItem :
fmap makePathItem ti ++ fmap makeProcPathItem pds
@@ -330,14 +391,14 @@ escapeHostName "*6" = "0.0.0.0"
escapeHostName "!6" = "0.0.0.0"
escapeHostName h = h
postgrestSpec :: RelationshipsMap -> [ProcDescription] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
postgrestSpec rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
postgrestSpec :: (Text, Text) -> RelationshipsMap -> [Routine] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
postgrestSpec (prettyVersion, docsVersion) rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
& basePath ?~ T.unpack b
& schemes ?~ [s']
& info .~ ((mempty :: Info)
& version .~ T.decodeUtf8 prettyVersion
& title .~ "PostgREST API"
& description ?~ d)
& version .~ prettyVersion
& title .~ fromMaybe "PostgREST API" dTitle
& description ?~ fromMaybe "This is a dynamic API generated by PostgREST" dDesc)
& externalDocs ?~ ((mempty :: ExternalDocs)
& description ?~ "PostgREST Documentation"
& url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
@@ -345,15 +406,16 @@ postgrestSpec rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
& definitions .~ fromList (makeTableDef rels <$> ti)
& parameters .~ fromList (makeParamDefs ti)
& paths .~ makePathItems pds ti
& produces .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
& consumes .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
& produces .~ makeMimeList [MTApplicationJSON, MTVndSingularJSON True, MTVndSingularJSON False, MTTextCSV]
& consumes .~ makeMimeList [MTApplicationJSON, MTVndSingularJSON True, MTVndSingularJSON False, MTTextCSV]
& securityDefinitions .~ makeSecurityDefinitions securityDefName allowSecurityDef
& security .~ [SecurityRequirement (fromList [(securityDefName, [])]) | allowSecurityDef]
where
s' = if s == "http" then Http else Https
h' = Just $ Host (T.unpack $ escapeHostName h) (Just (fromInteger p))
d = fromMaybe "This is a dynamic API generated by PostgREST" sd
securityDefName = "JWT"
(dTitle, dDesc) = fmap fst &&& fmap (T.dropWhile (=='\n') . snd) $
T.breakOn "\n" <$> sd
pickProxy :: Maybe Text -> Maybe Proxy
pickProxy proxy
+36
View File
@@ -0,0 +1,36 @@
module PostgREST.Response.Performance
( ServerTiming (..)
, serverTimingHeader
)
where
import qualified Data.ByteString.Char8 as BS
import qualified Network.HTTP.Types as HTTP
import Numeric (showFFloat)
import Protolude
data ServerTiming =
ServerTiming
{ jwt :: Maybe Double
, parse :: Maybe Double
, plan :: Maybe Double
, transaction :: Maybe Double
, response :: Maybe Double
}
deriving (Show)
-- | Render the Server-Timing header from a ServerTimingData
--
-- >>> serverTimingHeader ServerTiming { plan=Just 0.1, transaction=Just 0.2, response=Just 0.3, jwt=Just 0.4, parse=Just 0.5}
-- ("Server-Timing","jwt;dur=400000.0, parse;dur=500000.0, plan;dur=100000.0, transaction;dur=200000.0, response;dur=300000.0")
serverTimingHeader :: ServerTiming -> HTTP.Header
serverTimingHeader timing =
("Server-Timing", renderTiming)
where
renderMetric metric = maybe "" (\dur -> BS.concat [metric, BS.pack $ ";dur=" <> showFFloat (Just 1) (dur * 1000000) ""])
renderTiming = BS.intercalate ", " $ (\(k, v) -> renderMetric k (v timing)) <$>
[ ("jwt", jwt)
, ("parse", parse)
, ("plan", plan)
, ("transaction", transaction)
, ("response", response)
]
@@ -1,8 +1,8 @@
{-|
Module : PostgREST.DbStructure
Module : PostgREST.SchemaCache
Description : PostgREST schema cache
This module contains queries that target PostgreSQL system catalogs, these are used to build the schema cache(DbStructure).
This module(used to be named DbStructure) contains queries that target PostgreSQL system catalogs, these are used to build the schema cache(SchemaCache).
The schema cache is necessary for resource embedding, foreign keys are used for inferring the relationships between tables.
@@ -18,60 +18,110 @@ These queries are executed once at startup or when PostgREST is reloaded.
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
module PostgREST.DbStructure
( DbStructure(..)
, queryDbStructure
module PostgREST.SchemaCache
( SchemaCache(..)
, querySchemaCache
, accessibleTables
, accessibleProcs
, accessibleFuncs
, schemaDescription
) where
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
import qualified Hasql.Statement as SQL
import qualified Hasql.Transaction as SQL
import Control.Monad.Extra (whenJust)
import Data.Aeson ((.=))
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Types as JSON
import qualified Data.HashMap.Strict as HM
import qualified Data.HashMap.Strict.InsOrd as HMI
import qualified Data.Set as S
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
import qualified Hasql.Statement as SQL
import qualified Hasql.Transaction as SQL
import Contravariant.Extras (contrazip2)
import Text.InterpolatedString.Perl6 (q)
import PostgREST.Config.Database (pgVersionStatement)
import PostgREST.Config.PgVersion (PgVersion, pgVersion100,
pgVersion110)
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema)
import PostgREST.DbStructure.Proc (PgType (..),
ProcDescription (..),
ProcParam (..),
ProcVolatility (..),
ProcsMap, RetType (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
Junction (..),
Relationship (..),
RelationshipsMap)
import PostgREST.DbStructure.Table (Column (..), Table (..),
TablesMap)
import PostgREST.Config (AppConfig (..))
import PostgREST.Config.Database (TimezoneNames,
pgVersionStatement,
toIsolationLevel)
import PostgREST.Config.PgVersion (PgVersion, pgVersion100,
pgVersion110,
pgVersion120)
import PostgREST.SchemaCache.Identifiers (AccessSet, FieldName,
QualifiedIdentifier (..),
RelIdentifier (..),
Schema, isAnyElement)
import PostgREST.SchemaCache.Relationship (Cardinality (..),
Junction (..),
Relationship (..),
RelationshipsMap)
import PostgREST.SchemaCache.Representations (DataRepresentation (..),
RepresentationsMap)
import PostgREST.SchemaCache.Routine (FuncVolatility (..),
MediaHandler (..),
MediaHandlerMap,
PgType (..),
RetType (..),
Routine (..),
RoutineMap,
RoutineParam (..))
import PostgREST.SchemaCache.Table (Column (..), ColumnMap,
Table (..), TablesMap)
import qualified PostgREST.MediaType as MediaType
import Protolude
data DbStructure = DbStructure
{ dbTables :: TablesMap
, dbRelationships :: RelationshipsMap
, dbProcs :: ProcsMap
data SchemaCache = SchemaCache
{ dbTables :: TablesMap
, dbRelationships :: RelationshipsMap
, dbRoutines :: RoutineMap
, dbRepresentations :: RepresentationsMap
, dbMediaHandlers :: MediaHandlerMap
, dbTimezones :: TimezoneNames
}
deriving (Generic, JSON.ToJSON)
instance JSON.ToJSON SchemaCache where
toJSON (SchemaCache tabs rels routs reps _ _) = JSON.object [
"dbTables" .= JSON.toJSON tabs
, "dbRelationships" .= JSON.toJSON rels
, "dbRoutines" .= JSON.toJSON routs
, "dbRepresentations" .= JSON.toJSON reps
, "dbMediaHandlers" .= JSON.emptyArray
, "dbTimezones" .= JSON.emptyArray
]
-- | A view foreign key or primary key dependency detected on its source table
-- Each column of the key could be referenced multiple times in the view, e.g.
--
-- create view projects_view as
-- select
-- id as id_1,
-- id as id_2,
-- id as id_3,
-- name
-- from projects
--
-- In this case, the keyDepCols mapping maps projects.id to all three of the columns:
--
-- [('id', ['id_1', 'id_2', 'id_3'])]
--
-- Depending on key type, we can then choose how to handle this case. Primary keys
-- can arbitrarily choose one of the columns, but for foreign keys we need to create
-- relationships for each possible mutations.
--
-- Previously, we stored a (FieldName, FieldName) tuple only, but then we had no
-- way to make a difference between a multi-column-key and a single-column-key with multiple
-- references in the view. Or even worse in the multi-column-key-multi-reference case...
data ViewKeyDependency = ViewKeyDependency {
keyDepTable :: QualifiedIdentifier
, keyDepView :: QualifiedIdentifier
, keyDepCons :: Text
, keyDepType :: KeyDep
, keyDepCols :: [(FieldName, FieldName)] -- ^ First element is the table column, second is the view column
, keyDepCols :: [(FieldName, [FieldName])] -- ^ First element is the table column, second is a list of view columns
} deriving (Eq)
data KeyDep
= PKDep -- ^ PK dependency
@@ -82,24 +132,37 @@ data KeyDep
-- | A SQL query that can be executed independently
type SqlQuery = ByteString
queryDbStructure :: [Schema] -> [Schema] -> Bool -> SQL.Transaction DbStructure
queryDbStructure schemas extraSearchPath prepared = do
querySchemaCache :: AppConfig -> SQL.Transaction SchemaCache
querySchemaCache AppConfig{..} = do
SQL.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object
pgVer <- SQL.statement mempty pgVersionStatement
pgVer <- SQL.statement mempty $ pgVersionStatement prepared
tabs <- SQL.statement schemas $ allTables pgVer prepared
keyDeps <- SQL.statement (schemas, extraSearchPath) $ allViewsKeyDependencies prepared
keyDeps <- SQL.statement (schemas, configDbExtraSearchPath) $ allViewsKeyDependencies prepared
m2oRels <- SQL.statement mempty $ allM2OandO2ORels pgVer prepared
procs <- SQL.statement schemas $ allProcs pgVer prepared
funcs <- SQL.statement schemas $ allFunctions pgVer prepared
cRels <- SQL.statement mempty $ allComputedRels prepared
reps <- SQL.statement schemas $ dataRepresentations prepared
mHdlers <- SQL.statement schemas $ mediaHandlers pgVer prepared
tzones <- SQL.statement mempty $ timezones prepared
_ <-
let sleepCall = SQL.Statement "select pg_sleep($1)" (param HE.int4) HD.noResult prepared in
whenJust configInternalSCSleep (`SQL.statement` sleepCall) -- only used for testing
let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps
rels = addInverseRels $ addM2MRels tabsWViewsPks $ addViewM2OAndO2ORels keyDeps m2oRels
return $ removeInternal schemas $ DbStructure {
return $ removeInternal schemas $ SchemaCache {
dbTables = tabsWViewsPks
, dbRelationships = getOverrideRelationshipsMap rels cRels
, dbProcs = procs
, dbRoutines = funcs
, dbRepresentations = reps
, dbMediaHandlers = HM.union mHdlers initialMediaHandlers -- the custom handlers will override the initial ones
, dbTimezones = tzones
}
where
schemas = toList configDbSchemas
prepared = configDbPreparedStatements
-- | overrides detected relationships with the computed relationships and gets the RelationshipsMap
getOverrideRelationshipsMap :: [Relationship] -> [Relationship] -> RelationshipsMap
@@ -121,14 +184,17 @@ getOverrideRelationshipsMap rels cRels =
deformedRelMap = HM.fromListWith (++) . fmap addDeformedRelKey . HM.toList
addDeformedRelKey ((relT, relFT), rls) = ((relT, qiSchema relFT), rls)
-- | Remove db objects that belong to an internal schema(not exposed through the API) from the DbStructure.
removeInternal :: [Schema] -> DbStructure -> DbStructure
-- | Remove db objects that belong to an internal schema(not exposed through the API) from the SchemaCache.
removeInternal :: [Schema] -> SchemaCache -> SchemaCache
removeInternal schemas dbStruct =
DbStructure {
dbTables = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct
, dbRelationships = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$>
HM.filterWithKey (\(QualifiedIdentifier sch _, _) _ -> sch `elem` schemas ) (dbRelationships dbStruct)
, dbProcs = dbProcs dbStruct -- procs are only obtained from the exposed schemas, no need to filter them.
SchemaCache {
dbTables = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct
, dbRelationships = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$>
HM.filterWithKey (\(QualifiedIdentifier sch _, _) _ -> sch `elem` schemas ) (dbRelationships dbStruct)
, dbRoutines = dbRoutines dbStruct -- procs are only obtained from the exposed schemas, no need to filter them.
, dbRepresentations = dbRepresentations dbStruct -- no need to filter, not directly exposed through the API
, dbMediaHandlers = dbMediaHandlers dbStruct
, dbTimezones = dbTimezones dbStruct
}
where
hasInternalJunction ComputedRelationship{} = False
@@ -136,6 +202,14 @@ removeInternal schemas dbStruct =
M2M Junction{junTable} -> qiSchema junTable `notElem` schemas
_ -> False
decodeAccessibleIdentifiers :: HD.Result AccessSet
decodeAccessibleIdentifiers =
S.fromList <$> HD.rowList row
where
row = QualifiedIdentifier
<$> column HD.text
<*> column HD.text
decodeTables :: HD.Result TablesMap
decodeTables =
HM.fromList . map (\tbl@Table{tableSchema, tableName} -> (QualifiedIdentifier tableSchema tableName, tbl)) <$> HD.rowList tblRow
@@ -149,15 +223,20 @@ decodeTables =
<*> column HD.bool
<*> column HD.bool
<*> arrayColumn HD.text
<*> compositeArrayColumn
(Column
<*> parseCols (compositeArrayColumn
(Column
<$> compositeField HD.text
<*> nullableCompositeField HD.text
<*> compositeField HD.bool
<*> compositeField HD.text
<*> compositeField HD.text
<*> nullableCompositeField HD.int4
<*> nullableCompositeField HD.text
<*> compositeFieldArray HD.text)
<*> compositeFieldArray HD.text))
parseCols :: HD.Row [Column] -> HD.Row ColumnMap
parseCols = fmap (HMI.fromList . map (\col@Column{colName} -> (colName, col)))
decodeRels :: HD.Result [Relationship]
decodeRels =
@@ -184,28 +263,29 @@ decodeViewKeyDeps =
<*> compositeArrayColumn
((,)
<$> compositeField HD.text
<*> compositeField HD.text)
<*> compositeFieldArray HD.text)
viewKeyDepFromRow :: (Text,Text,Text,Text,Text,Text,[(Text, Text)]) -> ViewKeyDependency
viewKeyDepFromRow :: (Text,Text,Text,Text,Text,Text,[(Text, [Text])]) -> ViewKeyDependency
viewKeyDepFromRow (s1,t1,s2,v2,cons,consType,sCols) = ViewKeyDependency (QualifiedIdentifier s1 t1) (QualifiedIdentifier s2 v2) cons keyDep sCols
where
keyDep | consType == "p" = PKDep
| consType == "f" = FKDep
| otherwise = FKDepRef -- f_ref, we build this type in the query
decodeProcs :: HD.Result ProcsMap
decodeProcs =
-- Duplicate rows for a function means they're overloaded, order these by least args according to ProcDescription Ord instance
map sort . HM.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey) <$> HD.rowList procRow
decodeFuncs :: HD.Result RoutineMap
decodeFuncs =
-- Duplicate rows for a function means they're overloaded, order these by least args according to Routine Ord instance
map sort . HM.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey) <$> HD.rowList funcRow
where
procRow = ProcDescription
funcRow = Function
<$> column HD.text
<*> column HD.text
<*> nullableColumn HD.text
<*> compositeArrayColumn
(ProcParam
(RoutineParam
<$> compositeField HD.text
<*> compositeField HD.text
<*> compositeField HD.text
<*> compositeField HD.bool
<*> compositeField HD.bool)
<*> (parseRetType
@@ -216,38 +296,75 @@ decodeProcs =
<*> column HD.bool)
<*> (parseVolatility <$> column HD.char)
<*> column HD.bool
<*> nullableColumn (toIsolationLevel <$> HD.text)
<*> nullableColumn HD.text
addKey :: ProcDescription -> (QualifiedIdentifier, ProcDescription)
addKey :: Routine -> (QualifiedIdentifier, Routine)
addKey pd = (QualifiedIdentifier (pdSchema pd) (pdName pd), pd)
parseRetType :: Text -> Text -> Bool -> Bool -> Bool -> Maybe RetType
parseRetType schema name isSetOf isComposite isVoid
| isVoid = Nothing
| isSetOf = Just (SetOf pgType)
| otherwise = Just (Single pgType)
parseRetType :: Text -> Text -> Bool -> Bool -> Bool -> RetType
parseRetType schema name isSetOf isComposite isCompositeAlias
| isSetOf = SetOf pgType
| otherwise = Single pgType
where
qi = QualifiedIdentifier schema name
pgType
| isComposite = Composite qi
| otherwise = Scalar
| isComposite = Composite qi isCompositeAlias
| otherwise = Scalar qi
parseVolatility :: Char -> ProcVolatility
parseVolatility :: Char -> FuncVolatility
parseVolatility v | v == 'i' = Immutable
| v == 's' = Stable
| otherwise = Volatile -- only 'v' can happen here
allProcs :: PgVersion -> Bool -> SQL.Statement [Schema] ProcsMap
allProcs pgVer = SQL.Statement sql (arrayParam HE.text) decodeProcs
decodeRepresentations :: HD.Result RepresentationsMap
decodeRepresentations =
HM.fromList . map (\rep@DataRepresentation{drSourceType, drTargetType} -> ((drSourceType, drTargetType), rep)) <$> HD.rowList row
where
sql = procsSqlQuery pgVer <> " AND pn.nspname = ANY($1)"
row = DataRepresentation
<$> column HD.text
<*> column HD.text
<*> column HD.text
accessibleProcs :: PgVersion -> Bool -> SQL.Statement Schema ProcsMap
accessibleProcs pgVer = SQL.Statement sql (param HE.text) decodeProcs
-- Selects all potential data representation transformations. To qualify the cast must be
-- 1. to or from a domain
-- 2. implicit
-- For the time being it must also be to/from JSON or text, although one can imagine a future where we support special
-- cases like CSV specific representations.
dataRepresentations :: Bool -> SQL.Statement [Schema] RepresentationsMap
dataRepresentations = SQL.Statement sql (arrayParam HE.text) decodeRepresentations
where
sql = procsSqlQuery pgVer <> " AND pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
sql = [q|
SELECT
c.castsource::regtype::text,
c.casttarget::regtype::text,
c.castfunc::regproc::text
FROM
pg_catalog.pg_cast c
JOIN pg_catalog.pg_type src_t
ON c.castsource::oid = src_t.oid
JOIN pg_catalog.pg_type dst_t
ON c.casttarget::oid = dst_t.oid
WHERE
c.castcontext = 'i'
AND c.castmethod = 'f'
AND has_function_privilege(c.castfunc, 'execute')
AND ((src_t.typtype = 'd' AND c.casttarget IN ('json'::regtype::oid , 'text'::regtype::oid))
OR (dst_t.typtype = 'd' AND c.castsource IN ('json'::regtype::oid , 'text'::regtype::oid)))
|]
procsSqlQuery :: PgVersion -> SqlQuery
procsSqlQuery pgVer = [q|
allFunctions :: PgVersion -> Bool -> SQL.Statement [Schema] RoutineMap
allFunctions pgVer = SQL.Statement sql (arrayParam HE.text) decodeFuncs
where
sql = funcsSqlQuery pgVer <> " AND pn.nspname = ANY($1)"
accessibleFuncs :: PgVersion -> Bool -> SQL.Statement Schema RoutineMap
accessibleFuncs pgVer = SQL.Statement sql (param HE.text) decodeFuncs
where
sql = funcsSqlQuery pgVer <> " AND pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
funcsSqlQuery :: PgVersion -> SqlQuery
funcsSqlQuery pgVer = [q|
-- Recursively get the base types of domains
WITH
base_types AS (
@@ -278,6 +395,13 @@ procsSqlQuery pgVer = [q|
array_agg((
COALESCE(name, ''), -- name
type::regtype::text, -- type
CASE type
WHEN 'bit'::regtype THEN 'bit varying'
WHEN 'bit[]'::regtype THEN 'bit varying[]'
WHEN 'character'::regtype THEN 'character varying'
WHEN 'character[]'::regtype THEN 'character varying[]'
ELSE type::regtype::text
END, -- convert types that ignore the lenth and accept any value till maximum size
idx <= (pronargs - pronargdefaults), -- is_required
COALESCE(mode = 'v', FALSE) -- is_variadic
) ORDER BY idx) AS args,
@@ -304,9 +428,11 @@ procsSqlQuery pgVer = [q|
-- if any TABLE, INOUT or OUT arguments present, treat as composite
or COALESCE(proargmodes::text[] && '{t,b,o}', false)
) AS rettype_is_composite,
('void'::regtype = t.oid) AS rettype_is_void,
bt.oid <> bt.base as rettype_is_composite_alias,
p.provolatile,
p.provariadic > 0 as hasvariadic
p.provariadic > 0 as hasvariadic,
lower((regexp_split_to_array((regexp_split_to_array(iso_config, '='))[2], ','))[1]) AS transaction_isolation_level,
lower((regexp_split_to_array((regexp_split_to_array(timeout_config, '='))[2], ','))[1]) AS statement_timeout
FROM pg_proc p
LEFT JOIN arguments a ON a.oid = p.oid
JOIN pg_namespace pn ON pn.oid = p.pronamespace
@@ -315,6 +441,8 @@ procsSqlQuery pgVer = [q|
JOIN pg_namespace tn ON tn.oid = t.typnamespace
LEFT JOIN pg_class comp ON comp.oid = t.typrelid
LEFT JOIN pg_description as d ON d.objoid = p.oid
LEFT JOIN LATERAL unnest(proconfig) iso_config ON iso_config like 'default_transaction_isolation%'
LEFT JOIN LATERAL unnest(proconfig) timeout_config ON timeout_config like 'statement_timeout%'
WHERE t.oid <> 'trigger'::regtype AND COALESCE(a.callable, true)
|] <> (if pgVer >= pgVersion110 then "AND prokind = 'f'" else "AND NOT (proisagg OR proiswindow)")
@@ -331,11 +459,27 @@ schemaDescription =
where
n.nspname = $1 |]
accessibleTables :: PgVersion -> Bool -> SQL.Statement [Schema] TablesMap
accessibleTables :: PgVersion -> Bool -> SQL.Statement [Schema] AccessSet
accessibleTables pgVer =
SQL.Statement sql (arrayParam HE.text) decodeTables
SQL.Statement sql (arrayParam HE.text) decodeAccessibleIdentifiers
where
sql = tablesSqlQuery False pgVer
sql = [q|
SELECT
n.nspname AS table_schema,
c.relname AS table_name
FROM pg_class c
JOIN pg_namespace n ON n.oid = c.relnamespace
WHERE c.relkind IN ('v','r','m','f','p')
AND n.nspname NOT IN ('pg_catalog', 'information_schema')
AND n.nspname = ANY($1)
AND (
pg_has_role(c.relowner, 'USAGE')
or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER')
or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES')
) |] <>
relIsPartition <>
"ORDER BY table_schema, table_name"
relIsPartition = if pgVer >= pgVersion100 then " AND not c.relispartition " else mempty
{-
Adds M2O and O2O relationships for views to tables, tables to views, and views to views. The example below is taken from the test fixtures, but the views names/colnames were modified.
@@ -354,7 +498,7 @@ test | personnages_view | test | actors_view | personnage
-}
addViewM2OAndO2ORels :: [ViewKeyDependency] -> [Relationship] -> [Relationship]
addViewM2OAndO2ORels keyDeps rels =
rels ++ concat (viewRels <$> rels)
rels ++ concatMap viewRels rels
where
isM2O card = case card of {M2O _ _ -> True; _ -> False;}
isO2O card = case card of {O2O _ _ -> True; _ -> False;}
@@ -370,19 +514,21 @@ addViewM2OAndO2ORels keyDeps rels =
(keyDepView vwTbl)
relForeignTable
False
((if isM2O card then M2O else O2O) cons $ zipWith (\(_, vCol) (_, fCol)-> (vCol, fCol)) (keyDepCols vwTbl) relCols)
((if isM2O card then M2O else O2O) cons $ zipWith (\(_, vCol) (_, fCol)-> (vCol, fCol)) keyDepColsVwTbl relCols)
True
False
| vwTbl <- viewTableRels ]
| vwTbl <- viewTableRels
, keyDepColsVwTbl <- expandKeyDepCols $ keyDepCols vwTbl ]
++
[ Relationship
relTable
(keyDepView tblVw)
False
((if isM2O card then M2O else O2O) cons $ zipWith (\(tCol, _) (_, vCol) -> (tCol, vCol)) relCols (keyDepCols tblVw))
((if isM2O card then M2O else O2O) cons $ zipWith (\(tCol, _) (_, vCol) -> (tCol, vCol)) relCols keyDepColsTblVw)
False
True
| tblVw <- tableViewRels ]
| tblVw <- tableViewRels
, keyDepColsTblVw <- expandKeyDepCols $ keyDepCols tblVw ]
++
[
let
@@ -393,13 +539,16 @@ addViewM2OAndO2ORels keyDeps rels =
vw1
vw2
(vw1 == vw2)
((if isM2O card then M2O else O2O) cons $ zipWith (\(_, vcol1) (_, vcol2) -> (vcol1, vcol2)) (keyDepCols vwTbl) (keyDepCols tblVw))
((if isM2O card then M2O else O2O) cons $ zipWith (\(_, vcol1) (_, vcol2) -> (vcol1, vcol2)) keyDepColsVwTbl keyDepColsTblVw)
True
True
| vwTbl <- viewTableRels
, tblVw <- tableViewRels ]
, keyDepColsVwTbl <- expandKeyDepCols $ keyDepCols vwTbl
, tblVw <- tableViewRels
, keyDepColsTblVw <- expandKeyDepCols $ keyDepCols tblVw ]
else []
viewRels _ = []
expandKeyDepCols kdc = zip (fst <$> kdc) <$> traverse snd kdc
addInverseRels :: [Relationship] -> [Relationship]
addInverseRels rels =
@@ -428,21 +577,29 @@ addViewPrimaryKeys tabs keyDeps =
else tbl) <$> tabs
where
findViewPKCols sch vw =
maybe [] (\(ViewKeyDependency _ _ _ _ pkCols) -> snd <$> pkCols) $
find (\(ViewKeyDependency _ viewQi _ dep _) -> dep == PKDep && viewQi == QualifiedIdentifier sch vw) keyDeps
concatMap (\(ViewKeyDependency _ _ _ _ pkCols) -> takeFirstPK pkCols) $
filter (\(ViewKeyDependency _ viewQi _ dep _) -> dep == PKDep && viewQi == QualifiedIdentifier sch vw) keyDeps
-- In the case of multiple reference to the same PK (see comment for ViewKeyDependency) we take the first reference available.
-- We assume this to be safe to do, because:
-- * We don't have any logic that requires the client to name a PK column (compared to the column hints in embedding for FKs),
-- so we don't need to know about the other references.
-- * We need to choose a single reference for each column, otherwise we'd output too many columns in location headers etc.
takeFirstPK = mapMaybe (head . snd)
allTables :: PgVersion -> Bool -> SQL.Statement [Schema] TablesMap
allTables pgVer =
SQL.Statement sql (arrayParam HE.text) decodeTables
where
sql = tablesSqlQuery True pgVer
sql = tablesSqlQuery pgVer
-- | Gets tables with their PK cols
tablesSqlQuery :: Bool -> PgVersion -> SqlQuery
tablesSqlQuery getAll pgVer =
tablesSqlQuery :: PgVersion -> SqlQuery
tablesSqlQuery pgVer =
-- the tbl_constraints/key_col_usage CTEs are based on the standard "information_schema.table_constraints"/"information_schema.key_column_usage" views,
-- we cannot use those directly as they include the following privilege filter:
-- (pg_has_role(ss.relowner, 'USAGE'::text) OR has_column_privilege(ss.roid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text));
-- on the "columns" CTE, left joining on pg_depend and pg_class is used to obtain the sequence name as a column default in case there are GENERATED .. AS IDENTITY,
-- generated columns are only available from pg >= 10 but the query is agnostic to versions. dep.deptype = 'i' is done because there are other 'a' dependencies on PKs
[q|
WITH
columns AS (
@@ -451,22 +608,21 @@ tablesSqlQuery getAll pgVer =
c.relname::name AS table_name,
a.attname::name AS column_name,
d.description AS description,
pg_get_expr(ad.adbin, ad.adrelid)::text AS column_default,
|] <> columnDefault <> [q| AS column_default,
not (a.attnotnull OR t.typtype = 'd' AND t.typnotnull) AS is_nullable,
CASE
WHEN t.typtype = 'd' THEN
CASE
WHEN t.typtype = 'd' THEN
CASE
WHEN bt.typelem <> 0::oid AND bt.typlen = (-1) THEN 'ARRAY'::text
WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
ELSE format_type(a.atttypid, a.atttypmod)
END
ELSE
CASE
WHEN t.typelem <> 0::oid AND t.typlen = (-1) THEN 'ARRAY'::text
WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
ELSE format_type(a.atttypid, a.atttypmod)
END
END::text AS data_type,
WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
ELSE format_type(a.atttypid, a.atttypmod)
END
ELSE
CASE
WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
ELSE format_type(a.atttypid, a.atttypmod)
END
END::text AS data_type,
format_type(a.atttypid, a.atttypmod)::text AS nominal_data_type,
information_schema._pg_char_max_length(
information_schema._pg_truetypid(a.*, t.*),
information_schema._pg_truetypmod(a.*, t.*)
@@ -486,6 +642,12 @@ tablesSqlQuery getAll pgVer =
ON t.typtype = 'd' AND t.typbasetype = bt.oid
LEFT JOIN (pg_collation co JOIN pg_namespace nco ON co.collnamespace = nco.oid)
ON a.attcollation = co.oid AND (nco.nspname <> 'pg_catalog'::name OR co.collname <> 'default'::name)
LEFT JOIN pg_depend dep
ON dep.refobjid = a.attrelid and dep.refobjsubid = a.attnum and dep.deptype = 'i'
LEFT JOIN pg_class seqclass
ON seqclass.oid = dep.objid
LEFT JOIN pg_namespace seqsch
ON seqsch.oid = seqclass.relnamespace
WHERE
NOT pg_is_other_temp_schema(nc.oid)
AND a.attnum > 0
@@ -502,6 +664,7 @@ tablesSqlQuery getAll pgVer =
info.description,
info.is_nullable::boolean,
info.data_type,
info.nominal_data_type,
info.character_maximum_length,
info.column_default,
coalesce(enum_info.vals, '{}')) order by info.position) as columns
@@ -630,18 +793,28 @@ tablesSqlQuery getAll pgVer =
WHERE c.relkind IN ('v','r','m','f','p')
AND n.nspname NOT IN ('pg_catalog', 'information_schema') |] <>
relIsPartition <>
fltTables <>
"ORDER BY table_schema, table_name"
where
fltTables = if getAll then mempty else [q|
AND n.nspname = ANY($1)
AND (
pg_has_role(c.relowner, 'USAGE')
or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER')
or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES')
)|]
relIsPartition = if pgVer >= pgVersion100 then " AND not c.relispartition " else mempty
columnDefault -- typbasetype and typdefaultbin handles `CREATE DOMAIN .. DEFAULT val`, attidentity/attgenerated handles generated columns, pg_get_expr gets the default of a column
| pgVer >= pgVersion120 = [q|
CASE
WHEN t.typbasetype != 0 THEN pg_get_expr(t.typdefaultbin, 0)
WHEN a.attidentity = 'd' THEN format('nextval(%s)', quote_literal(seqsch.nspname || '.' || seqclass.relname))
WHEN a.attgenerated = 's' THEN null
ELSE pg_get_expr(ad.adbin, ad.adrelid)::text
END|]
| pgVer >= pgVersion100 = [q|
CASE
WHEN t.typbasetype != 0 THEN pg_get_expr(t.typdefaultbin, 0)
WHEN a.attidentity = 'd' THEN format('nextval(%s)', quote_literal(seqsch.nspname || '.' || seqclass.relname))
ELSE pg_get_expr(ad.adbin, ad.adrelid)::text
END|]
| otherwise = [q|
CASE
WHEN t.typbasetype != 0 THEN pg_get_expr(t.typdefaultbin, 0)
ELSE pg_get_expr(ad.adbin, ad.adrelid)::text
END|]
-- | Gets many-to-one relationships and one-to-one(O2O) relationships, which are a refinement of the many-to-one's
allM2OandO2ORels :: PgVersion -> Bool -> SQL.Statement () [Relationship]
@@ -679,9 +852,9 @@ allM2OandO2ORels pgVer =
FROM pg_constraint traint
JOIN LATERAL (
SELECT
array_agg(row(cols.attname, refs.attname) order by cols.attnum) AS cols_and_fcols,
jsonb_agg(cols.attname order by cols.attnum) AS cols
FROM ( SELECT unnest(traint.conkey) AS col, unnest(traint.confkey) AS ref) _
array_agg(row(cols.attname, refs.attname) order by ord) AS cols_and_fcols,
jsonb_agg(cols.attname order by ord) AS cols
FROM unnest(traint.conkey, traint.confkey) WITH ORDINALITY AS _(col, ref, ord)
JOIN pg_attribute cols ON cols.attrelid = traint.conrelid AND cols.attnum = col
JOIN pg_attribute refs ON refs.attrelid = traint.confrelid AND refs.attnum = ref
) AS column_info ON TRUE
@@ -710,13 +883,13 @@ allComputedRels =
),
computed_rels as (
select
p.pronamespace::regnamespace::text as schema,
p.proname::text as name,
arg_schema.nspname::text as rel_table_schema,
arg_name.typname::text as rel_table_name,
ret_schema.nspname::text as rel_ftable_schema,
ret_name.typname::text as rel_ftable_name,
p.prorows = 1 as single_row
(parse_ident(p.pronamespace::regnamespace::text))[1] as schema,
p.proname::text as name,
arg_schema.nspname::text as rel_table_schema,
arg_name.typname::text as rel_table_name,
ret_schema.nspname::text as rel_ftable_schema,
ret_name.typname::text as rel_ftable_name,
not p.proretset or p.prorows = 1 as single_row
from pg_proc p
join pg_type arg_name on arg_name.oid = p.proargtypes[0]
join pg_namespace arg_schema on arg_schema.oid = arg_name.typnamespace
@@ -738,6 +911,7 @@ allComputedRels =
(QualifiedIdentifier <$> column HD.text <*> column HD.text) <*>
(QualifiedIdentifier <$> column HD.text <*> column HD.text) <*>
(QualifiedIdentifier <$> column HD.text <*> column HD.text) <*>
pure (QualifiedIdentifier mempty mempty) <*>
column HD.bool <*>
column HD.bool
@@ -756,18 +930,24 @@ allViewsKeyDependencies =
select
contype::text as contype,
conname,
array_length(conkey, 1) as ncol,
conrelid as resorigtbl,
unnest(conkey) as resorigcol
col as resorigcol,
ord
from pg_constraint
left join lateral unnest(conkey) with ordinality as _(col, ord) on true
where contype IN ('p', 'f')
union
-- fk referenced col
select
concat(contype, '_ref') as contype,
conname,
array_length(confkey, 1) as ncol,
confrelid,
unnest(confkey)
col,
ord
from pg_constraint
left join lateral unnest(confkey) with ordinality as _(col, ord) on true
where contype='f'
),
views as (
@@ -875,8 +1055,13 @@ allViewsKeyDependencies =
(entry->>'resorigcol')::int as resorigcol
from target_entries
),
recursion as(
select r.*
-- CYCLE detection according to PG docs: https://www.postgresql.org/docs/current/queries-with.html#QUERIES-WITH-CYCLE
-- Can be replaced with CYCLE clause once PG v13 is EOL.
recursion(view_id, view_schema, view_name, view_column, resorigtbl, resorigcol, is_cycle, path) as(
select
r.*,
false,
ARRAY[resorigtbl]
from results r
where view_schema = ANY ($1)
union all
@@ -886,27 +1071,138 @@ allViewsKeyDependencies =
view.view_name,
view.view_column,
tab.resorigtbl,
tab.resorigcol
tab.resorigcol,
tab.resorigtbl = ANY(path),
path || tab.resorigtbl
from recursion view
join results tab on view.resorigtbl=tab.view_id and view.resorigcol=tab.view_column
where not is_cycle
),
repeated_references as(
select
view_id,
view_schema,
view_name,
resorigtbl,
resorigcol,
array_agg(attname) as view_columns
from recursion
join pg_attribute vcol on vcol.attrelid = view_id and vcol.attnum = view_column
group by
view_id,
view_schema,
view_name,
resorigtbl,
resorigcol
)
select
sch.nspname as table_schema,
tbl.relname as table_name,
rec.view_schema,
rec.view_name,
rep.view_schema,
rep.view_name,
pks_fks.conname as constraint_name,
pks_fks.contype as constraint_type,
array_agg(row(col.attname, vcol.attname) order by col.attnum) as column_dependencies
from recursion rec
join pg_class tbl on tbl.oid = rec.resorigtbl
join pg_attribute col on col.attrelid = tbl.oid and col.attnum = rec.resorigcol
join pg_attribute vcol on vcol.attrelid = rec.view_id and vcol.attnum = rec.view_column
join pg_namespace sch on sch.oid = tbl.relnamespace
array_agg(row(col.attname, view_columns) order by pks_fks.ord) as column_dependencies
from repeated_references rep
join pks_fks using (resorigtbl, resorigcol)
group by sch.nspname, tbl.relname, rec.view_schema, rec.view_name, pks_fks.conname, pks_fks.contype
join pg_class tbl on tbl.oid = rep.resorigtbl
join pg_attribute col on col.attrelid = tbl.oid and col.attnum = rep.resorigcol
join pg_namespace sch on sch.oid = tbl.relnamespace
group by sch.nspname, tbl.relname, rep.view_schema, rep.view_name, pks_fks.conname, pks_fks.contype, pks_fks.ncol
-- make sure we only return key for which all columns are referenced in the view - no partial PKs or FKs
having ncol = array_length(array_agg(row(col.attname, view_columns) order by pks_fks.ord), 1)
|]
initialMediaHandlers :: MediaHandlerMap
initialMediaHandlers =
HM.insert (RelAnyElement, MediaType.MTAny ) (BuiltinOvAggJson, MediaType.MTApplicationJSON) $
HM.insert (RelAnyElement, MediaType.MTApplicationJSON) (BuiltinOvAggJson, MediaType.MTApplicationJSON) $
HM.insert (RelAnyElement, MediaType.MTTextCSV ) (BuiltinOvAggCsv, MediaType.MTTextCSV) $
HM.insert (RelAnyElement, MediaType.MTGeoJSON ) (BuiltinOvAggGeoJson, MediaType.MTGeoJSON)
HM.empty
mediaHandlers :: PgVersion -> Bool -> SQL.Statement [Schema] MediaHandlerMap
mediaHandlers pgVer =
SQL.Statement sql (arrayParam HE.text) decodeMediaHandlers
where
sql = [q|
with
all_relations as (
select reltype
from pg_class
where relkind in ('v','r','m','f','p')
union
select oid
from pg_type
where typname = 'anyelement'
),
media_types as (
SELECT
t.oid,
lower(t.typname) as typname,
b.oid as base_oid,
b.typname AS basetypname,
t.typnamespace,
case t.typname
when '*/*' then 'application/octet-stream'
else t.typname
end as resolved_media_type
FROM pg_type t
JOIN pg_type b ON t.typbasetype = b.oid
WHERE
t.typbasetype <> 0 and
(t.typname ~* '^[A-Za-z0-9.-]+/[A-Za-z0-9.\+-]+$' or t.typname = '*/*')
)
select
proc_schema.nspname as handler_schema,
proc.proname as handler_name,
arg_schema.nspname::text as target_schema,
arg_name.typname::text as target_name,
media_types.typname as media_type,
media_types.resolved_media_type
from media_types
join pg_proc proc on proc.prorettype = media_types.oid
join pg_namespace proc_schema on proc_schema.oid = proc.pronamespace
join pg_aggregate agg on agg.aggfnoid = proc.oid
join pg_type arg_name on arg_name.oid = proc.proargtypes[0]
join pg_namespace arg_schema on arg_schema.oid = arg_name.typnamespace
where
proc_schema.nspname = ANY($1) and
proc.pronargs = 1 and
arg_name.oid in (select reltype from all_relations)
union
select
typ_sch.nspname as handler_schema,
mtype.typname as handler_name,
pro_sch.nspname as target_schema,
proname as target_name,
mtype.typname as media_type,
mtype.resolved_media_type
from pg_proc proc
join pg_namespace pro_sch on pro_sch.oid = proc.pronamespace
join media_types mtype on proc.prorettype = mtype.oid
join pg_namespace typ_sch on typ_sch.oid = mtype.typnamespace
where
pro_sch.nspname = ANY($1) and NOT proretset
|] <> (if pgVer >= pgVersion110 then " AND prokind = 'f'" else " AND NOT (proisagg OR proiswindow)")
decodeMediaHandlers :: HD.Result MediaHandlerMap
decodeMediaHandlers =
HM.fromList . fmap (\(x, y, z, w) -> ((if isAnyElement y then RelAnyElement else RelId y, z), (CustomFunc x, w)) ) <$> HD.rowList caggRow
where
caggRow = (,,,)
<$> (QualifiedIdentifier <$> column HD.text <*> column HD.text)
<*> (QualifiedIdentifier <$> column HD.text <*> column HD.text)
<*> (MediaType.decodeMediaType . encodeUtf8 <$> column HD.text)
<*> (MediaType.decodeMediaType . encodeUtf8 <$> column HD.text)
timezones :: Bool -> SQL.Statement () TimezoneNames
timezones = SQL.Statement sql HE.noParams decodeTimezones
where
sql = "SELECT name FROM pg_timezone_names"
decodeTimezones :: HD.Result TimezoneNames
decodeTimezones = S.fromList . map encodeUtf8 <$> HD.rowList (column HD.text)
param :: HE.Value a -> HE.Params a
param = HE.param . HE.nonNullable
@@ -1,20 +1,27 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module PostgREST.DbStructure.Identifiers
module PostgREST.SchemaCache.Identifiers
( QualifiedIdentifier(..)
, RelIdentifier(..)
, isAnyElement
, Schema
, TableName
, FieldName
, AccessSet
, dumpQi
, toQi
) where
import qualified Data.Aeson as JSON
import qualified Data.Set as S
import qualified Data.Text as T
import Protolude
data RelIdentifier = RelId QualifiedIdentifier | RelAnyElement
deriving (Eq, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey)
instance Hashable RelIdentifier
-- | Represents a pg identifier with a prepended schema name "schema.table".
-- When qiSchema is "", the schema is defined by the pg search_path.
@@ -22,10 +29,13 @@ data QualifiedIdentifier = QualifiedIdentifier
{ qiSchema :: Schema
, qiName :: TableName
}
deriving (Eq, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey)
deriving (Eq, Show, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey)
instance Hashable QualifiedIdentifier
isAnyElement :: QualifiedIdentifier -> Bool
isAnyElement y = QualifiedIdentifier "pg_catalog" "anyelement" == y
dumpQi :: QualifiedIdentifier -> Text
dumpQi (QualifiedIdentifier s i) =
(if T.null s then mempty else s <> ".") <> i
@@ -40,3 +50,5 @@ toQi txt = case T.drop 1 <$> T.breakOn "." txt of
type Schema = Text
type TableName = Text
type FieldName = Text
type AccessSet = S.Set QualifiedIdentifier
@@ -1,17 +1,18 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module PostgREST.DbStructure.Relationship
module PostgREST.SchemaCache.Relationship
( Cardinality(..)
, Relationship(..)
, Junction(..)
, RelationshipsMap
, relIsToOne
) where
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM
import PostgREST.DbStructure.Identifiers (FieldName,
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier, Schema)
import Protolude
@@ -30,10 +31,11 @@ data Relationship = Relationship
{ relFunction :: QualifiedIdentifier
, relTable :: QualifiedIdentifier
, relForeignTable :: QualifiedIdentifier
, relTableAlias :: QualifiedIdentifier
, relToOne :: Bool
, relIsSelf :: Bool
}
deriving (Eq, Ord, Generic, JSON.ToJSON)
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
-- | The relationship cardinality
-- | https://en.wikipedia.org/wiki/Cardinality_(data_modeling)
@@ -46,7 +48,7 @@ data Cardinality
-- ^ one-to-one, this is a refinement over M2O so operating on it is pretty much the same as M2O
| M2M Junction
-- ^ many-to-many
deriving (Eq, Ord, Generic, JSON.ToJSON)
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
type FKConstraint = Text
@@ -55,10 +57,17 @@ data Junction = Junction
{ junTable :: QualifiedIdentifier
, junConstraint1 :: FKConstraint
, junConstraint2 :: FKConstraint
, junColumns1 :: [(FieldName, FieldName)]
, junColumns2 :: [(FieldName, FieldName)]
, junColsSource :: [(FieldName, FieldName)]
, junColsTarget :: [(FieldName, FieldName)]
}
deriving (Eq, Ord, Generic, JSON.ToJSON)
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
-- | Key based on the source table and the foreign table schema
type RelationshipsMap = HM.HashMap (QualifiedIdentifier, Schema) [Relationship]
relIsToOne :: Relationship -> Bool
relIsToOne rel = case rel of
Relationship{relCardinality=M2O _ _} -> True
Relationship{relCardinality=O2O _ _} -> True
ComputedRelationship{relToOne=True} -> True
_ -> False
@@ -0,0 +1,29 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module PostgREST.SchemaCache.Representations
( DataRepresentation(..)
, RepresentationsMap
) where
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM
import Protolude
-- | Data representations allow user customisation of how to present and receive data through APIs, per field.
-- This structure is used for the library of available transforms. It answers questions like:
-- - What function, if any, should be used to present a certain field that's been selected for API output?
-- - How do we parse incoming data for a certain field type when inserting or updating?
-- - And similarly, how do we parse textual data in a query string to be used as a filter?
--
-- Support for outputting special formats like CSV and binary data would fit into the same system.
data DataRepresentation = DataRepresentation
{ drSourceType :: Text
, drTargetType :: Text
, drFunction :: Text
} deriving (Eq, Show, Generic, JSON.ToJSON, JSON.FromJSON)
-- The representation map maps from (source type, target type) to a DR.
type RepresentationsMap = HM.HashMap (Text, Text) DataRepresentation
+151
View File
@@ -0,0 +1,151 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module PostgREST.SchemaCache.Routine
( PgType(..)
, Routine(..)
, RoutineParam(..)
, FuncVolatility(..)
, RoutineMap
, RetType(..)
, funcReturnsScalar
, funcReturnsSetOfScalar
, funcReturnsSingleComposite
, funcReturnsVoid
, funcTableName
, funcReturnsCompositeAlias
, funcReturnsSingle
, MediaHandlerMap
, ResolvedHandler
, MediaHandler(..)
) where
import Data.Aeson ((.=))
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM
import qualified Hasql.Transaction.Sessions as SQL
import qualified PostgREST.MediaType as MediaType
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
RelIdentifier (..), Schema,
TableName)
import Protolude
data PgType
= Scalar QualifiedIdentifier
| Composite QualifiedIdentifier Bool -- True if the composite is a domain alias(used to work around a bug in pg 11 and 12, see QueryBuilder.hs)
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
data RetType
= Single PgType
| SetOf PgType
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
data FuncVolatility
= Volatile
| Stable
| Immutable
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
data Routine = Function
{ pdSchema :: Schema
, pdName :: Text
, pdDescription :: Maybe Text
, pdParams :: [RoutineParam]
, pdReturnType :: RetType
, pdVolatility :: FuncVolatility
, pdHasVariadic :: Bool
, pdIsoLvl :: Maybe SQL.IsolationLevel
, pdTimeout :: Maybe Text
}
deriving (Eq, Show, Generic)
-- need to define JSON manually bc SQL.IsolationLevel doesn't have a JSON instance(and we can't define one for that type without getting a compiler error)
instance JSON.ToJSON Routine where
toJSON (Function sch nam desc params ret vol hasVar _ tout) = JSON.object
[
"pdSchema" .= sch
, "pdName" .= nam
, "pdDescription" .= desc
, "pdParams" .= JSON.toJSON params
, "pdReturnType" .= JSON.toJSON ret
, "pdVolatility" .= JSON.toJSON vol
, "pdHasVariadic" .= JSON.toJSON hasVar
, "pdTimeout" .= tout
]
data RoutineParam = RoutineParam
{ ppName :: Text
, ppType :: Text
, ppTypeMaxLength :: Text
, ppReq :: Bool
, ppVar :: Bool
}
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
-- Order by least number of params in the case of overloaded functions
instance Ord Routine where
Function schema1 name1 des1 prms1 rt1 vol1 hasVar1 iso1 tout1 `compare` Function schema2 name2 des2 prms2 rt2 vol2 hasVar2 iso2 tout2
| schema1 == schema2 && name1 == name2 && length prms1 < length prms2 = LT
| schema2 == schema2 && name1 == name2 && length prms1 > length prms2 = GT
| otherwise = (schema1, name1, des1, prms1, rt1, vol1, hasVar1, iso1, tout1) `compare` (schema2, name2, des2, prms2, rt2, vol2, hasVar2, iso2, tout2)
-- | A map of all procs, all of which can be overloaded(one entry will have more than one Routine).
-- | It uses a HashMap for a faster lookup.
type RoutineMap = HM.HashMap QualifiedIdentifier [Routine]
-- | A media handler can be an aggregate over a composite type or a function over a scalar
data MediaHandler
-- non overridable builtins
= BuiltinAggSingleJson Bool
| BuiltinAggArrayJsonStrip
-- these builtins are overridable
| BuiltinOvAggJson
| BuiltinOvAggGeoJson
| BuiltinOvAggCsv
-- custom
| CustomFunc QualifiedIdentifier
| NoAgg
deriving (Eq, Show)
funcReturnsSingle :: Routine -> Bool
funcReturnsSingle proc = case proc of
Function{pdReturnType = Single _} -> True
_ -> False
funcReturnsScalar :: Routine -> Bool
funcReturnsScalar proc = case proc of
Function{pdReturnType = Single (Scalar{})} -> True
_ -> False
funcReturnsSetOfScalar :: Routine -> Bool
funcReturnsSetOfScalar proc = case proc of
Function{pdReturnType = SetOf (Scalar{})} -> True
_ -> False
funcReturnsCompositeAlias :: Routine -> Bool
funcReturnsCompositeAlias proc = case proc of
Function{pdReturnType = Single (Composite _ True)} -> True
Function{pdReturnType = SetOf (Composite _ True)} -> True
_ -> False
funcReturnsSingleComposite :: Routine -> Bool
funcReturnsSingleComposite proc = case proc of
Function{pdReturnType = Single (Composite _ _)} -> True
_ -> False
funcReturnsVoid :: Routine -> Bool
funcReturnsVoid proc = case proc of
Function{pdReturnType = Single (Scalar (QualifiedIdentifier "pg_catalog" "void"))} -> True
_ -> False
funcTableName :: Routine -> Maybe TableName
funcTableName proc = case pdReturnType proc of
SetOf (Composite qi _) -> Just $ qiName qi
Single (Composite qi _) -> Just $ qiName qi
_ -> Nothing
-- the resolved handler also carries the media type because MTAny (*/*) is resolved to a different media type
type ResolvedHandler = (MediaHandler, MediaType.MediaType)
type MediaHandlerMap = HM.HashMap (RelIdentifier, MediaType.MediaType) ResolvedHandler
@@ -1,16 +1,20 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
module PostgREST.DbStructure.Table
module PostgREST.SchemaCache.Table
( Column(..)
, Table(..)
, tableColumnsList
, TablesMap
, ColumnMap
) where
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM
import qualified Data.HashMap.Strict.InsOrd as HMI
import PostgREST.DbStructure.Identifiers (FieldName,
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema, TableName)
@@ -28,9 +32,12 @@ data Table = Table
, tableUpdatable :: Bool
, tableDeletable :: Bool
, tablePKCols :: [FieldName]
, tableColumns :: [Column]
, tableColumns :: ColumnMap
}
deriving (Show, Ord, Generic, JSON.ToJSON)
deriving (Show, Generic, JSON.ToJSON)
tableColumnsList :: Table -> [Column]
tableColumnsList = HMI.elems . tableColumns
instance Eq Table where
Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
@@ -40,6 +47,7 @@ data Column = Column
, colDescription :: Maybe Text
, colNullable :: Bool
, colType :: Text
, colNominalType :: Text
, colMaxLen :: Maybe Int32
, colDefault :: Maybe Text
, colEnum :: [Text]
@@ -47,3 +55,4 @@ data Column = Column
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
type TablesMap = HM.HashMap QualifiedIdentifier Table
type ColumnMap = HMI.InsOrdHashMap FieldName Column
+42 -47
View File
@@ -1,58 +1,53 @@
{-# LANGUAGE CPP #-}
module PostgREST.Unix
( runAppWithSocket
, installSignalHandlers
( installSignalHandlers
, createAndBindDomainSocket
) where
import qualified Network.Socket as Socket
import qualified Network.Wai.Handler.Warp as Warp
import qualified System.Posix.Signals as Signals
#ifndef mingw32_HOST_OS
import qualified System.Posix.Signals as Signals
#endif
import System.Posix.Types (FileMode)
import System.PosixCompat.Files (setFileMode)
import Network.Wai (Application)
import System.Directory (removeFile)
import System.IO.Error (isDoesNotExistError)
import System.Posix.Files (setFileMode)
import System.Posix.Types (FileMode)
import qualified PostgREST.AppState as AppState
import qualified PostgREST.Workers as Workers
import Protolude
-- | Run the PostgREST application with user defined socket.
runAppWithSocket :: Warp.Settings -> Application -> FileMode -> FilePath -> IO ()
runAppWithSocket settings app socketFileMode socketFilePath =
bracket createAndBindSocket Socket.close $ \socket -> do
Socket.listen socket Socket.maxListenQueue
Warp.runSettingsSocket settings socket app
where
createAndBindSocket = do
deleteSocketFileIfExist socketFilePath
sock <- Socket.socket Socket.AF_UNIX Socket.Stream Socket.defaultProtocol
Socket.bind sock $ Socket.SockAddrUnix socketFilePath
setFileMode socketFilePath socketFileMode
return sock
deleteSocketFileIfExist path =
removeFile path `catch` handleDoesNotExist
handleDoesNotExist e
| isDoesNotExistError e = return ()
| otherwise = throwIO e
import Data.String (String)
import qualified Network.Socket as NS
import Protolude
import System.Directory (removeFile)
import System.IO.Error (isDoesNotExistError)
-- | Set signal handlers, only for systems with signals
installSignalHandlers :: AppState.AppState -> IO ()
installSignalHandlers appState = do
let interrupt = throwTo (AppState.getMainThreadId appState) UserInterrupt
installSignalHandlers :: ThreadId -> IO () -> IO () -> IO ()
#ifndef mingw32_HOST_OS
installSignalHandlers tid usr1 usr2 = do
let interrupt = throwTo tid UserInterrupt
install Signals.sigINT interrupt
install Signals.sigTERM interrupt
-- The SIGUSR1 signal updates the internal 'DbStructure' by running
-- 'connectionWorker' exactly as before.
install Signals.sigUSR1 $ Workers.connectionWorker appState
-- Re-read the config on SIGUSR2
install Signals.sigUSR2 $ Workers.reReadConfig False appState
install Signals.sigUSR1 usr1
install Signals.sigUSR2 usr2
where
install signal handler =
void $ Signals.installHandler signal (Signals.Catch handler) Nothing
#else
installSignalHandlers _ _ _ = pass
#endif
-- | Create a unix domain socket and bind it to the given path.
-- | The socket file will be deleted if it already exists.
createAndBindDomainSocket :: String -> FileMode -> IO NS.Socket
createAndBindDomainSocket path mode = do
unless NS.isUnixDomainSocketAvailable $
panic "Cannot run with unix socket on non-unix platforms. Consider deleting the `server-unix-socket` config entry in order to continue."
deleteSocketFileIfExist path
sock <- NS.socket NS.AF_UNIX NS.Stream NS.defaultProtocol
NS.bind sock $ NS.SockAddrUnix path
NS.listen sock (max 2048 NS.maxListenQueue)
setFileMode path mode
return sock
where
deleteSocketFileIfExist path' =
removeFile path' `catch` handleDoesNotExist
handleDoesNotExist e
| isDoesNotExistError e = return ()
| otherwise = throwIO e
-265
View File
@@ -1,265 +0,0 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Workers
( connectionWorker
, reReadConfig
, listener
) where
import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text.Encoding as T
import qualified Hasql.Notifications as SQL
import qualified Hasql.Transaction.Sessions as SQL
import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
retrying, rsPreviousDelay)
import Hasql.Connection (acquire)
import PostgREST.AppState (AppState)
import PostgREST.Config (AppConfig (..), readAppConfig)
import PostgREST.Config.Database (queryDbSettings, queryPgVersion)
import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
import PostgREST.DbStructure (queryDbStructure)
import PostgREST.Error (PgError (PgError), checkIsFatal,
errorPayload)
import qualified PostgREST.AppState as AppState
import Protolude
-- | Current database connection status data ConnectionStatus
data ConnectionStatus
= NotConnected
| Connected PgVersion
| FatalConnectionError Text
deriving (Eq)
-- | Schema cache status
data SCacheStatus
= SCLoaded
| SCOnRetry
| SCFatalFail
-- | The purpose of this worker is to obtain a healthy connection to pg and an
-- up-to-date schema cache(DbStructure). This method is meant to be called
-- multiple times by the same thread, but does nothing if the previous
-- invocation has not terminated. In all cases this method does not halt the
-- calling thread, the work is performed in a separate thread.
--
-- Background thread that does the following :
-- 1. Tries to connect to pg server and will keep trying until success.
-- 2. Checks if the pg version is supported and if it's not it kills the main
-- program.
-- 3. Obtains the dbStructure. If this fails, it goes back to 1.
connectionWorker :: AppState -> IO ()
connectionWorker appState = do
runExclusively (AppState.getWorkerSem appState) work
-- Prevents multiple workers to be running at the same time. Could happen on
-- too many SIGUSR1s.
where
runExclusively mvar action = mask_ $ do
success <- tryPutMVar mvar ()
when success $ do
void $ forkIO $ action `finally` takeMVar mvar
work = do
AppConfig{..} <- AppState.getConfig appState
AppState.logWithZTime appState "Attempting to connect to the database..."
connected <- connectionStatus appState
case connected of
FatalConnectionError reason ->
-- Fatal error when connecting
AppState.logWithZTime appState reason >> killThread (AppState.getMainThreadId appState)
NotConnected ->
-- Unreachable because connectionStatus will keep trying to connect
return ()
Connected actualPgVersion -> do
-- Procede with initialization
AppState.putPgVersion appState actualPgVersion
when configDbChannelEnabled $
AppState.signalListener appState
AppState.logWithZTime appState "Connection successful"
-- this could be fail because the connection drops, but the
-- loadSchemaCache will pick the error and retry again
when configDbConfig $ reReadConfig False appState
scStatus <- loadSchemaCache appState
case scStatus of
SCLoaded ->
-- do nothing and proceed if the load was successful
return ()
SCOnRetry ->
-- retry reloading the schema cache
work
SCFatalFail ->
-- die if our schema cache query has an error
killThread $ AppState.getMainThreadId appState
-- | Check if a connection from the pool allows access to the PostgreSQL
-- database. If not, the pool connections are released and a new connection is
-- tried. Releasing the pool is key for rapid recovery. Otherwise, the pool
-- timeout would have to be reached for new healthy connections to be acquired.
-- Which might not happen if the server is busy with requests. No idle
-- connection, no pool timeout.
--
-- The connection tries are capped, but if the connection times out no error is
-- thrown, just 'False' is returned.
connectionStatus :: AppState -> IO ConnectionStatus
connectionStatus appState =
retrying retrySettings shouldRetry $
const $ AppState.releasePool appState >> getConnectionStatus
where
retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds
delayMicroseconds = 32000000 -- 32 seconds
backoffMicroseconds = 1000000 -- 1 second
getConnectionStatus :: IO ConnectionStatus
getConnectionStatus = do
pgVersion <- AppState.usePool appState queryPgVersion
case pgVersion of
Left e -> do
let err = PgError False e
AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
case checkIsFatal err of
Just reason ->
return $ FatalConnectionError reason
Nothing ->
return NotConnected
Right version ->
if version < minimumPgVersion then
return . FatalConnectionError $
"Cannot run in this PostgreSQL version, PostgREST needs at least "
<> pgvName minimumPgVersion
else
return . Connected $ version
shouldRetry :: RetryStatus -> ConnectionStatus -> IO Bool
shouldRetry rs isConnSucc = do
let
delay = fromMaybe 0 (rsPreviousDelay rs) `div` backoffMicroseconds
itShould = NotConnected == isConnSucc
when itShould . AppState.logWithZTime appState $
"Attempting to reconnect to the database in "
<> (show delay::Text)
<> " seconds..."
when itShould $ AppState.putRetryNextIn appState delay
return itShould
-- | Load the DbStructure by using a connection from the pool.
loadSchemaCache :: AppState -> IO SCacheStatus
loadSchemaCache appState = do
AppConfig{..} <- AppState.getConfig appState
result <-
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
AppState.usePool appState . transaction SQL.ReadCommitted SQL.Read $
queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
case result of
Left e -> do
let
err = PgError False e
putErr = AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
case checkIsFatal err of
Just hint -> do
AppState.logWithZTime appState "A fatal error ocurred when loading the schema cache"
putErr
AppState.logWithZTime appState hint
return SCFatalFail
Nothing -> do
AppState.putDbStructure appState Nothing
AppState.logWithZTime appState "An error ocurred when loading the schema cache"
putErr
return SCOnRetry
Right dbStructure -> do
AppState.putDbStructure appState (Just dbStructure)
when (isJust configDbRootSpec) .
AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode dbStructure
AppState.logWithZTime appState "Schema cache loaded"
return SCLoaded
-- | Starts a dedicated pg connection to LISTEN for notifications. When a
-- NOTIFY <db-channel> - with an empty payload - is done, it refills the schema
-- cache. It uses the connectionWorker in case the LISTEN connection dies.
listener :: AppState -> IO ()
listener appState = do
AppConfig{..} <- AppState.getConfig appState
let dbChannel = toS configDbChannel
-- The listener has to wait for a signal from the connectionWorker.
-- This is because when the connection to the db is lost, the listener also
-- tries to recover the connection, but not with the same pace as the connectionWorker.
-- Not waiting makes stderr quickly fill with connection retries messages from the listener.
AppState.waitListener appState
-- forkFinally allows to detect if the thread dies
void . flip forkFinally (handleFinally dbChannel) $ do
dbOrError <- acquire $ toUtf8 configDbUri
case dbOrError of
Right db -> do
AppState.logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel"
AppState.putIsListenerOn appState True
SQL.listen db $ SQL.toPgIdentifier dbChannel
SQL.waitForNotifications handleNotification db
_ ->
die $ "Could not listen for notifications on the " <> dbChannel <> " channel"
where
handleFinally dbChannel _ = do
-- if the thread dies, we try to recover
AppState.logWithZTime appState $ "Retrying listening for notifications on the " <> dbChannel <> " channel.."
AppState.putIsListenerOn appState False
-- assume the pool connection was also lost, call the connection worker
connectionWorker appState
-- retry the listener
listener appState
handleNotification _ msg
| BS.null msg = scLoader -- reload the schema cache
| msg == "reload schema" = scLoader -- reload the schema cache
| msg == "reload config" = reReadConfig False appState -- reload the config
| otherwise = pure () -- Do nothing if anything else than an empty message is sent
scLoader =
-- It's not necessary to check the loadSchemaCache success
-- here. If the connection drops, the thread will die and
-- proceed to recover.
void $ loadSchemaCache appState
-- | Re-reads the config plus config options from the db
reReadConfig :: Bool -> AppState -> IO ()
reReadConfig startingUp appState = do
AppConfig{..} <- AppState.getConfig appState
dbSettings <-
if configDbConfig then do
qDbSettings <- AppState.usePool appState $ queryDbSettings configDbPreparedStatements
case qDbSettings of
Left e -> do
let
err = PgError False e
putErr = AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
AppState.logWithZTime appState
"An error ocurred when trying to query database settings for the config parameters"
case checkIsFatal err of
Just hint -> do
putErr
AppState.logWithZTime appState hint
killThread (AppState.getMainThreadId appState)
Nothing -> do
putErr
pure []
Right x -> pure x
else
pure mempty
readAppConfig dbSettings configFilePath (Just configDbUri) >>= \case
Left err ->
if startingUp then
panic err -- die on invalid config if the program is starting up
else
AppState.logWithZTime appState $ "Failed reloading config: " <> err
Right newConf -> do
AppState.putConfig appState newConf
if startingUp then
pass
else
AppState.logWithZTime appState "Config reloaded"
+5 -10
View File
@@ -1,4 +1,4 @@
resolver: lts-19.14 # 2022-07-01, GHC 9.0.2
resolver: lts-20.6 # 2023-01-09, GHC 9.2.5
nix:
packages:
@@ -10,12 +10,7 @@ nix:
pure: false
extra-deps:
- HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
- configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
- hasql-dynamic-statements-0.3.1.1@sha256:2cfe6e75990e690f595a87cbe553f2e90fcd738610f6c66749c81cc4396b2cc4,2675
- hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
- hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
- lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
- optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
- protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
- ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
- git: https://github.com/PostgREST/postgresql-libpq.git
commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc
- hasql-notifications-0.2.0.6
- hasql-pool-0.10
+20 -58
View File
@@ -5,71 +5,33 @@
packages:
- completed:
hackage: HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc
git: https://github.com/PostgREST/postgresql-libpq.git
name: postgresql-libpq
pantry-tree:
size: 1428
sha256: b73a7f6d21cf20bbf819e19039409c9010efb5000d2b72cdd8fd67a9027c14e8
sha256: 074668b9669b9c49f3c522c8af5c608799a1965e203c463b188b2632995beac2
size: 1414
version: 0.9.4.3
original:
hackage: HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc
git: https://github.com/PostgREST/postgresql-libpq.git
- completed:
hackage: configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
hackage: hasql-notifications-0.2.0.6@sha256:16d783f5cd1660fad924fd3769380889de5804e057f09b304dcdc3a3ff11eb3c,2028
pantry-tree:
size: 2463
sha256: 97efe7a22afc93033bda5adcffdabc0f1c30dc32b2c3ba02114ce7cd74c942fd
sha256: 2319743501bb3c0bef801014ce61308b8666cef86ae5a97a0a283c0c1ec12d4f
size: 452
original:
hackage: configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
hackage: hasql-notifications-0.2.0.6
- completed:
hackage: hasql-dynamic-statements-0.3.1.1@sha256:2cfe6e75990e690f595a87cbe553f2e90fcd738610f6c66749c81cc4396b2cc4,2675
hackage: hasql-pool-0.10@sha256:912197a328acb85505f98bb9700d61f366b87659ca45126c5c2d636687b801c3,2112
pantry-tree:
size: 595
sha256: b84ae10a5c776f88f546df73bc957a35e61056400b7e805dad0b254612907e97
sha256: b655c540a49764a8d16b62941137e295b936b96edc0785eb9250972f0f92dc47
size: 346
original:
hackage: hasql-dynamic-statements-0.3.1.1@sha256:2cfe6e75990e690f595a87cbe553f2e90fcd738610f6c66749c81cc4396b2cc4,2675
- completed:
hackage: hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
pantry-tree:
size: 264
sha256: d49af8f8749ab7039fa668af4b78f997f7fa2928b4aded6798f573a3d08e76a0
original:
hackage: hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
- completed:
hackage: hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
pantry-tree:
size: 412
sha256: 2741a33f947d28b4076c798c20c1f646beecd21f5eaf522c8256cbeb34d4d6d0
original:
hackage: hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
- completed:
hackage: lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
pantry-tree:
size: 541
sha256: b31392b78f2a03111c805f4400007778eb93b49f998ab41dfbebaaf9b5526bad
original:
hackage: lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
- completed:
hackage: optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
pantry-tree:
size: 2979
sha256: dd092d843091c08691485d68a1908517079b1bc6f3d73928f37635a19dc27fc1
original:
hackage: optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
- completed:
hackage: protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
pantry-tree:
size: 1594
sha256: a36d2912ac552d950ba4476de7d950b56b82dd28e48b9f4d0efee938f10bc525
original:
hackage: protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
- completed:
hackage: ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
pantry-tree:
size: 1303
sha256: 557c438345de19f82bf01d676100da2a191ef06f624e7a4b90b09ac17cbb52a5
original:
hackage: ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
hackage: hasql-pool-0.10
snapshots:
- completed:
size: 618951
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/14.yaml
sha256: 4c31d4ef975b0211078862566aedf3b82b6cea569fc2cde4c72a51e5a8d236ce
original: lts-19.14
sha256: 4905c93319aa94aa53da8f41d614d7bacdbfe6c63a8c6132d32e6e62f24a9af4
size: 649315
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/6.yaml
original: lts-20.6
Binary file not shown.

After

Width:  |  Height:  |  Size: 55 KiB

BIN
View File
Binary file not shown.

After

Width:  |  Height:  |  Size: 77 KiB

BIN
View File
Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 MiB

+9 -2
View File
@@ -11,8 +11,15 @@ main =
[ "-XOverloadedStrings"
, "-XNoImplicitPrelude"
, "-XStandaloneDeriving"
, "-XDuplicateRecordFields"
, "-isrc"
, "src/PostgREST/Query/SqlFragment.hs"
, "src/PostgREST/Request/Preferences.hs"
, "src/PostgREST/Request/QueryParams.hs"
, "src/PostgREST/ApiRequest/Preferences.hs"
, "src/PostgREST/ApiRequest/QueryParams.hs"
, "src/PostgREST/Response/Performance.hs"
, "src/PostgREST/Error.hs"
, "src/PostgREST/MediaType.hs"
, "src/PostgREST/Config.hs"
, "src/PostgREST/Plan.hs"
, "src/PostgREST/Response.hs"
]
+55
View File
@@ -0,0 +1,55 @@
import os
import pathlib
import shutil
import signal
import pytest
import yaml
BASEDIR = pathlib.Path(os.path.realpath(__file__)).parent
CONFIGSDIR = BASEDIR / "configs"
FIXTURES = yaml.load((BASEDIR / "fixtures.yaml").read_text(), Loader=yaml.Loader)
POSTGREST_BIN = shutil.which("postgrest")
SECRET = "reallyreallyreallyreallyverysafe"
@pytest.fixture
def dburi():
"Postgres database connection URI."
dbname = os.environ["PGDATABASE"]
host = os.environ["PGHOST"]
user = os.environ["PGUSER"]
return f"postgresql://?dbname={dbname}&host={host}&user={user}".encode()
@pytest.fixture
def baseenv():
"Base environment to connect to PostgreSQL"
return {
"PGDATABASE": os.environ["PGDATABASE"],
"PGHOST": os.environ["PGHOST"],
"PGUSER": os.environ["PGUSER"],
}
@pytest.fixture
def defaultenv(baseenv):
"Default environment for PostgREST."
return {
**baseenv,
"PGRST_DB_CONFIG": "true",
"PGRST_LOG_LEVEL": "info",
"PGRST_DB_POOL": "1",
"PGRST_NOT_EXISTING": "should not break any tests",
}
def hpctixfile():
"Returns an individual filename for each test, if the HPCTIXFILE environment variable is set."
if "HPCTIXFILE" not in os.environ:
return ""
tixfile = pathlib.Path(os.environ["HPCTIXFILE"])
test = hash(os.environ["PYTEST_CURRENT_TEST"])
return tixfile.with_suffix(f".{test}.tix")
+1
View File
@@ -1,4 +1,5 @@
db-schema = "provided_through_alias"
db-pool-timeout = 5
max-rows = 1000
pre-request = "check_alias"
role-claim-key = ".aliased"
+2
View File
@@ -1,2 +1,4 @@
# Not the default, but only works with PG* variables, which are not set
db-config = false
# not existing config options should not break tests
not-existing = "should succeed"

Some files were not shown because too many files have changed in this diff Show More