Compare commits

..
356 Commits
Author SHA1 Message Date
steve-chavez f56bed2a75 bump version to 10.1.2 2023-02-02 03:30:15 -05:00
Laurence IslaandSteve Chavez af8e436732 Add missing fixes to the changelog 2023-02-02 03:30:15 -05:00
steve-chavez 98a29bee04 fix: NOTIFY pgrst not reoading the catalog cache 2023-02-02 03:30:15 -05:00
Tuan LeandSteve Chavez 557285b659 fix: consider authentication failure as a fatal error 2023-02-02 03:30:15 -05:00
Laurence IslaandSteve Chavez 81501aefa0 fix: FK pointing to VIEW instead of TABLE in OpenAPI output 2023-02-02 03:30:15 -05:00
Laurence IslaandSteve Chavez 12c1d4a8e4 Add upsert headers for POST requests to the OpenAPI output 2023-02-02 03:30:15 -05:00
Laurence IslaandSteve Chavez 8aa7368786 fix: Add required OpenAPI items object when the paramater is an array 2023-02-02 03:30:15 -05:00
Laurence IslaandSteve Chavez 9d4ff812c9 Add suggestions with fuzzy text search when no relationship is found (#2583) 2023-02-02 03:30:15 -05:00
Laurence IslaandSteve Chavez 171dd313d9 fix: clarify error messages for functions
Move explanation on single unnamed parameters to the error details
2023-02-02 03:30:15 -05:00
Laurence IslaandSteve Chavez fd24a7374b feat: hint function names/parameters on error 2023-02-02 03:30:15 -05:00
steve-chavez a525790c4c fix: bad M2M embed on RPC 2023-02-02 03:30:15 -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
steve-chavez a41380b965 bump version to 10.0.0 2022-08-18 23:35:41 -05:00
steve-chavez b2a2504201 changelog: clarify and stamp date for v10 2022-08-18 23:07:24 -05:00
steve-chavez c45e85c5a6 feat: add one to one relationship for embedding
BREAKING CHANGE: For the cases where one to one relationships are
detected, json objects will be returned instead of json arrays of length
1.

If you wish to override this behavior, you can use computed
relationships to return arrays again.
2022-08-18 22:36:47 -05:00
Laurence IslaandSteve Chavez 2afe13fa89 Move feature to fix in the changelog 2022-08-18 20:15:57 -05:00
steve-chavez 36c24d9cbe refactor: clean allM2ORels query
* remove unnecessary lateral usage
* use alias for pg_constraint
2022-08-18 15:08:14 -05:00
steve-chavez d6ec171bcb feat: add computed relationships
* work for select, mutations, rpc
* overrides detected relationships
2022-08-17 22:50:06 -05:00
steve-chavez 06c9e246f4 refactor: simplify addJoinConditions
* remove unnecessary Either
* remove implicitJoins from ReadQuery
* remove unnecessary foldr in addJoinConditions
* move aliasing to addRels
2022-08-17 22:50:06 -05:00
Laurence IslaandGitHub b2b92e75cc Make text the default format for the execution plan 2022-08-17 17:58:02 -05:00
GabrielandGitHub 506929c586 fix: Make views pk and fk schema query compatible with postgres v15 2022-08-17 14:20:34 -05:00
Matt VotavaandGitHub f75e77cf60 Nix: allow building from pure-eval mode (#2427)
* default.nix: allow import with pure-eval enabled

* Update hercules-ci/gitignore

* shell.nix: fix import of default.nix
2022-08-15 20:44:02 -05:00
Laurence IslaandGitHub ba3ba9fd5b refactor: simplify tests where mutations need to be verified in the db 2022-08-15 12:06:54 -05:00
Laurence IslaandGitHub 7de8d5446a Revert bulk update patch
- Revert patch #2311
- Keep the refactor done to qsFiltersRoot
- Keep the refactor done to the items tables
- Add tests that now work with pg-safeupdate as a result
2022-08-12 10:00:33 -05:00
Laurence IslaandGitHub 4ac47df528 tests: Add tests for the pg-safeupdate library 2022-08-10 11:50:57 -05:00
Robert Vollmert 57bc3d805c nix: bump nixpkgs version
- move from GHC 9.2.3 to GHC 9.2.4
- drop upstreamed openssl runtime dependency patch
2022-08-10 06:46:43 +02:00
steve-chavez 3648986aa8 refactor: correlated subquery for o2m query
Improves the query costs a bit as shown in the tests and reduces code.
2022-08-06 21:42:53 -05:00
steve-chavez c050b61db8 tests: add basic resource embedding costs
Adds costs thresholds on the PlanSpec for the o2m,m2o and m2m queries.
2022-08-06 21:42:53 -05:00
Robert Vollmert 92d00749a3 refactor: move pool release on shutdown out of signal handler
This changes behaviour somewhat in that:
- We now consistently release the pool on shutdown, even on non-Unix
  platforms, and including for CmdDumpConfig.
- We release the pool *after* interrupting `App.run`, which will
  rather cause more than fewer connection to be closed properly.
  (Previously any in-use connections would not have been caught by
  `releasePool`, though *maybe* the `UserInterrupt` handling in
  the web handler ends up closing the connections properly already
  anyway).

(The main aim of the change is to make it clearer when and why the
pool is released.)
2022-08-03 19:02:33 +02:00
Robert Vollmert c5849ecbe0 misc: comment typo fix 2022-08-03 19:02:33 +02:00
Robert Vollmert fea38a4caf misc: style fix 2022-08-03 19:02:33 +02:00
steve-chavez d24f0c8216 bump version to 9.0.1.20220802 2022-08-02 21:13:35 -05:00
Robert Vollmert 35a114a81b tests: add failing test showing reconfiguration doesn't take effect (#2401) 2022-08-02 19:03:45 +02:00
Robert Vollmert ed988100c6 tests: add a test to verify pool size, and parallel request handling
The main point for this test is to verify the test setup for follow-up
tests of pool behaviour.
2022-08-02 19:03:45 +02:00
Robert Vollmert b6a93aae1f tests: add a Thread class that catches exceptions 2022-08-02 19:03:45 +02:00
Robert Vollmert 70cae5beed tests: move pool settings to defaultenv from run
This allows overriding them if necessary.
2022-08-02 19:03:45 +02:00
Robert Vollmert 0a24a83fa9 tests: decouple config tests from test-specific postgrest settings 2022-08-02 19:03:45 +02:00
Robert Vollmert c8739aa8a3 fix: fix some race conditions running connection worker
Previously, it was quite possible to have two connection workers
running, or to get into a state where a failed connection worker
is still considered running preventing new connection workers
from starting.
2022-08-02 09:51:19 +02:00
Robert Vollmert d4950c6460 refactor: drop getPool 2022-08-02 09:24:14 +02:00
Robert Vollmert 1d15060c63 refactor: AppState.usePool for App
This is a bit ugly, it would be a bit nicer to just pass
'AppState.usePool appState' but then the types get messy.
Or we could introduce our own 'Pool' wrapper type.
2022-08-02 09:24:14 +02:00
Robert Vollmert 401b98c5b4 refactor: introduce AppState.usePool 2022-08-02 09:24:14 +02:00
Robert Vollmert d53949e4a4 refactor: queryDbSettings doesn't need the pool 2022-08-02 09:24:14 +02:00
Robert Vollmert 421163dc75 refactor: use AppState.releasePool everywhere
This prepares for wrapping the pool in a reference.
2022-08-02 09:24:14 +02:00
Robert Vollmert eae169ca67 refactor: move interrupt out of releasePool helper 2022-08-02 09:24:14 +02:00
Robert Vollmert ec23067e3e refactor: simplify main, address reReadConfig TODO 2022-08-02 09:24:14 +02:00
Robert Vollmert bfacec3a67 ci: check python file formatting
Previously, postgrest-style would reformat python files, but their
formatting wasn't enforced.
2022-08-02 09:24:14 +02:00
Robert Vollmert e7b69cb99c tests: fix python formatting 2022-08-02 09:24:14 +02:00
steve-chavez fd7c23f7a1 Add "for" param for the vnd.pgrst.plan media type 2022-08-01 17:41:23 -05:00
steve-chavez 84e03a16dd fix: columns w/ dollar sign($) don't need quoting 2022-07-30 19:50:09 -05:00
Robert Vollmert d556cea8ce tests: add tests for statement_timeout
The new tests verify that:
- statement_timeout on the authenticator role works to cancel slow statements
- changes to statement_timeout take effect on SIGUSR1

This reuses the old "limited_authenticator" role and adds some plumbing to
allow reliably changing the statement timeout even if the current role is
not functional due to a low statement timeout, and to make tests that modify
the role independent from each other.

- introduce module-wide metapostgrest fixture to have an out-of-band way to
  manipulate the database, without having to spin up extra postgrest instances
  per test
- reset statement_timeout at the start of the respective tests
2022-07-29 21:46:57 +02:00
Steve ChavezandGitHub 8911afd079 feat: Allow getting the EXPLAIN plan of a request 2022-07-27 19:33:34 -05:00
steve-chavez d2df289696 bump version to 9.0.1.20220717 2022-07-17 18:44:13 -05:00
steve-chavez 2eb7c803e3 feat: support OPTIONS on RPC and root path 2022-07-17 18:40:14 -05:00
steve-chavez 71a5748718 refactor: DRY pytest no pool connection logic 2022-07-17 14:41:51 -05:00
steve-chavez 4ab5e63e58 fix: no empty transaction on OPTIONS request 2022-07-17 14:41:51 -05:00
steve-chavez c445105d55 correct query on rpc count=exact
corrects bad logic on e4006da(perf: remove toSourceRel)
2022-07-16 17:18:25 -05:00
steve-chavez 2905753194 test: no empty tx for invalid JWT 2022-07-15 22:23:33 -05:00
steve-chavez df49f482dc test: no empty tx started for invalid path/method 2022-07-15 22:23:33 -05:00
Robert Vollmert 23e4c7fe6e nix: bump nixpkgs version 2022-07-16 00:14:25 +02:00
Laurence Isla 5ac4c29a9e bump version to 9.0.1.20220714 2022-07-14 15:44:31 -05:00
Laurence IslaandGitHub e0ba6b6d1c Add security definitions to the OpenAPI output 2022-07-13 22:47:09 -05:00
Laurence IslaandGitHub bdf1cbe111 fix: inaccurate result count when an inner embed is selected after a normal embed in the query string 2022-07-12 22:29:42 -05:00
Robert Vollmert 9252ec2509 ci: verify that static executable is static 2022-07-12 23:25:06 +02:00
steve-chavez 8230128ff6 fix: no empty tx on bad HTTP method 2022-07-11 18:21:36 -05:00
steve-chavez 6d7bf9faa9 fix: no empty tx on Not Found error 2022-07-11 18:21:36 -05:00
steve-chavez 28183a667c refactor: rm raw media types unnecessary decoding
Just convert them to MTOther instead
2022-07-11 18:21:36 -05:00
Robert Vollmert 1eda7db0fb stack: build with latest LTS release, GHC 9.0
Also bump FreeBSD release.
2022-07-09 02:30:53 +02:00
Steve ChavezandGitHub 3cdc6d15d7 test: add bulk insert to loadtest (#2358) 2022-07-06 13:50:58 -05:00
steve-chavez 0708f46df3 refactor: pass media type to Statements module 2022-07-06 13:47:59 -05:00
steve-chavez 7a7ceaf39a refactor: rename ContentType to MediaType
The core type was wrongly named as the header
2022-07-06 13:47:59 -05:00
steve-chavez 3e83bef9c4 bump version to 9.0.1.20220630 2022-06-30 13:53:33 -05:00
Laurence IslaandGitHub 169547aee6 Return Location header only when using Prefer: return=header-only 2022-06-24 12:53:27 -05:00
Laurence IslaandGitHub f7745e1569 fix: Allow schema names with special characters in the search path
Fixes regression where the search path did not recognize schemas with uppercase, spaces and other special characters in their names.
2022-06-23 18:54:43 -05:00
steve-chavez 870f7a39b0 Add PostGIS GeoJSON support
Works for GET, POST, PATCH, PUT, DELETE, RPC.
2022-06-22 22:16:44 -05:00
steve-chavez 86c40e8df9 test: don't run spec tests with stack
We cannot handle postgis and other postgresql dependencies with
stack.

Also delete test/with_tmp_db since it's no longer used.
2022-06-22 22:16:44 -05:00
steve-chavez d87b622d64 nix: update tests README 2022-06-20 15:55:22 -05:00
Laurence IslaandGitHub 7088e9d510 nix: Add command to remove old hie files in postgrest-clean 2022-06-16 19:16:15 -05:00
RobertandGitHub fe8b32d077 Merge pull request #2324 from robx/ghc92
Update GHC to 9.2.2 (fixes #2288)
2022-06-16 18:45:10 +02:00
Robert Vollmert 478c48cc84 nix: define GHC 9.2.2's Cabal version for static build 2022-06-16 10:39:03 +02:00
Robert Vollmert c9c64fd71f nix: update hsie for GHC 9.2 2022-06-16 10:39:03 +02:00
Robert Vollmert 93210f9380 nix: upgrade weeder to 2.4.0 (GHC 9.2 compatible) 2022-06-16 10:39:02 +02:00
Robert Vollmert c25473e001 nix: upgrade ptr to 0.16.8.2 (GHC 9.2 compatible) 2022-06-16 10:39:02 +02:00
Robert Vollmert f3cbab6f82 nix: use GHC 9.2.2 2022-06-16 10:39:02 +02:00
Robert Vollmert 3d65d66b1b tests: fix incomplete pattern warnings (GHC 9.2) 2022-06-16 10:39:02 +02:00
Robert Vollmert f582798276 ReadQuery: split out to fix record field warning
The use of `where_` in DbRequestBuilder issues a warning since
GHC 9.2 as per
https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0366-no-ambiguous-field-access.rst

To disambiguate that, move the type to a separate module and use
the record field names qualified. For symmetry, MutateQuery also
gets its own module.
2022-06-16 10:38:59 +02:00
Robert Vollmert ba87a60a47 rangeParse: fix incomplete pattern match warning
The warning is new in GHC 9.2 compared to 8.10.
2022-06-16 10:37:05 +02:00
Robert Vollmert 356bff9cbd cabal: relax upper bounds to allow GHC 9.2 2022-06-16 10:37:05 +02:00
Steve ChavezandGitHub 86574c89a8 Bulk update (#2311)
* refactor: remove EmbedPath type from qsFiltersRoot

* Rename reset items function for reusability
2022-06-15 20:30:31 -05:00
Robert Vollmert 734f8e6df2 nix: fix static build
- the isExecutable patch was broken, remove it
- the ncurses fix was broken, we still need `enableStatic`
- the original error was caused by the new ghc-bignum
  package, which isn't a "proper" Haskell package; we filter
  this out explicitly now
2022-06-16 01:07:28 +02:00
steve-chavez df7d71db32 fix: Increase the db-pool-timeout to 1 hour 2022-06-15 13:19:44 -05:00
Robert Vollmert 0c5d2e553e nix: build postgrest with nix in loadtest (fixes #2308)
This allows running the load test against main even if the
dependencies change.
2022-06-15 00:41:38 +02:00
Robert Vollmert 36ed7e2fb7 src, nix: hlint update
This pulls in an updated hlint version from nixpkgs, and fixes some
new eta-reduction warnings. (I don't particularly think this is more
readable, but I suppose being consistently hlint-clean is worth it.)
2022-06-14 19:13:55 +02:00
RobertandGitHub bac63f339d Merge pull request #2292 from robx/aeson2
Upgrade aeson to 2.0.*
2022-06-14 07:43:08 +02:00
Robert Vollmert 8d8074d500 nix: keep old hlint
This keeps the pre-nixpkgs update hlint version, so we can defer
addressing the warnings to a follow-up PR.
2022-06-13 13:25:54 +02:00
Robert Vollmert 63ebf6e92b nix: hack static-haskell-nix for updated nixpkgs
This patches static-haskell-nix to work for building postgrest
with updated nixpkgs (from ~202203):

- The ncurses 'enableStatic' argument doesn't exist anymore.
  We use the vanilla package instead, which seems to work fine.
- The 'isExecutable' check fails with a strange error related
  to trying to override 'mkDerivation'.
  We patch 'isExecutable' to check explicitly whether we're building
  postgrest. ('isExecutable' is used to determine whether to build
  a package statically.)
2022-06-13 13:25:54 +02:00
Robert Vollmert d7f54e76f4 nix: haskell overlay update 2022-06-13 13:25:54 +02:00
Robert Vollmert 34d0f34620 nix: bashCompletion -> bash-completion 2022-06-13 13:25:54 +02:00
Robert Vollmert 14c882a566 nix: fetch PostgreSQL 9.6 via postgresql legacy overlay 2022-06-13 13:25:54 +02:00
Wolfgang WaltherandRobert Vollmert ff56c3adf4 nix: port openssl patch to updated nixpkgs 2022-06-13 13:25:54 +02:00
Robert Vollmert 12967f8643 nix: nix version bump 2022-06-13 13:25:54 +02:00
Robert Vollmert b056735535 stack: update stack.yaml 2022-06-13 13:25:54 +02:00
Robert Vollmert f5afa419f1 cabal, tests: require wai-logger 2.4.0, adapt tests
wai-logger version 2.4.0 fixes log output to not say 'unknownSocket'
for unix sockets.
2022-06-13 13:25:54 +02:00
Robert Vollmert 7531c5490d cabal: allow hasql-1.5, hasql-dynamic-statements-0.3.* 2022-06-13 13:25:54 +02:00
Robert Vollmert bb62e559d6 cabal: require jose >= 0.8.5.1 (aeson-2 compat)
jose version before 0.8.5.1 lacked an upper bound on
aeson-2, causing build failures with aeson-2 present.
2022-06-13 13:25:54 +02:00
Robert Vollmert e42bf30aeb cabal: allow swagger 2.8 2022-06-13 13:25:54 +02:00
Robert Vollmert 2b8ffc8e61 src: update for changed map type in aeson-2
This means that we're now using Data.Map.Strict instead of
Data.HashMap.Strict for JSON objects in general, and specifically
for claims maps and CSV rows.

This addresses certain hash flooding vulnerabilities, but may
have performance downsides.

Compare e.g. https://frasertweedale.github.io/blog-fp/posts/2021-10-12-aeson-hash-flooding-protection.html
2022-06-13 13:25:54 +02:00
Robert Vollmert 48a3d1d516 cabal: update aeson to 2.0.3 2022-06-13 13:16:56 +02:00
Robert Vollmert 5e6987b1d8 src: consistently import HashMap as HM, Map as M
With both HashMap and Map imported as M in different modules,
linter rules prevented ever importing both modules in one place.
2022-06-13 13:16:50 +02:00
Robert Vollmert 4dfcb59f73 nix: more explicit logging in load test
* Write vegeta output to file explicitly.
  The previous version using `tee` captured the standard
  output of the `withPgrst` helper, too, causing weird
  errors when those had unexpected output.

* Log and fail the postgrest build explicitly.
  In situations such as changing nix dependencies, the
  `cabal build` run could fail, but this wasn't visible
  in CI.

With these changes, the load test now fails with a nice
error message when the build fails.
2022-06-09 14:56:50 +02:00
Laurence IslaandGitHub 620da2e776 Update CHANGELOG to include release v9.0.1 (#2307) 2022-06-08 23:00:19 -05:00
Laurence IslaandGitHub f9688c3553 Upgrade protolude to 0.3.1 2022-06-08 11:41:39 -05:00
Robert Vollmert 4ff2469f57 nix: don't write to /nix/store from hsie build (fixes #2304)
This is a kind of hacky fix to the kind of hacky hsie derivation.
2022-06-07 21:36:38 +02:00
Robert Vollmert e3252a6e9e nix: test script without glibc locales
glibcLocales is not available e.g. on darwin. This change allows
running various dev tools on darwin, and other theoretical
non-glibc systems.
2022-06-07 21:36:38 +02:00
Robert Vollmert a9035bba2f nix: use the matching weeder
weeder needs to be compiled with the same GHC that we build postgrest
with.

Before this change, we were relying on the fact that we happened
to set ${compiler} to the same ghc8107 as used by nixpkgs for
haskellPackages, now we explicitly take it from the correct
haskell package set.
2022-06-07 21:36:38 +02:00
Robert Vollmert 4c8c3ccfb2 nix: pass through hspec arguments to postgrest-test-spec
This allows e.g. running

  postgrest-test-spec --match "some failing test"
2022-06-07 21:36:38 +02:00
Robert Vollmert 09f3e09c96 tests: don't specify openapi root result
Whereas the test used to specify a body of

  [{"qiName":"referrals","qiSchema":"test"},"private"]

we see both

  [{"qiName":"authors_w_entities","qiSchema":"test"},"test"]

and

  [{"qiName":"organizations","qiSchema":"test"},"test"]

on the GHC 9.2 upgrade PR.

This changes the test to no longer expect a particular body.

Compare:
- https://github.com/PostgREST/postgrest/pull/2292#issuecomment-1146160792
- https://github.com/PostgREST/postgrest/issues/1698
2022-06-07 16:56:22 +02:00
Franz-Josef FärberandSteve Chavez 807364bd7b RPC POST for function w/single unnamed XML param 2022-06-03 11:52:57 -05:00
steve-chavez d14f745406 bump version to 9.0.0.20220531 2022-05-31 18:19:02 -05:00
steve-chavez 1cdc9169c7 fix: using CPU while idle 2022-05-31 12:17:36 -05:00
steve-chavez 9aa400c8f3 fix: disable parallel GC for perf on high-core CPU 2022-05-31 12:17:36 -05:00
Laurence IslaandGitHub e4cdb8c491 ci: run on branches starting with "rel-" 2022-05-30 22:38:05 -05:00
Laurence IslaandSteve Chavez c812a3fe3e ci: Run ARM builds on releases 2022-05-16 18:10:36 -05:00
steve-chavez 1ab11de96c bump version to 9.0.0.20220516 2022-05-16 14:36:04 -05:00
steve-chavez f7b173163c fix: ignore views on col/fk as target
Also refactor self relationship findRel logic
2022-05-16 12:22:24 -05:00
steve-chavez 2be63b36d6 refactor: self relationship
* Add test for self relationship in view
2022-05-09 21:31:19 -05:00
steve-chavez c60380b5fc perf: RelationshipsMap with foreign schema as key 2022-05-09 21:31:19 -05:00
steve-chavez d88b16e5ab fix: allow cast on types with underscores/numbers
e.g. select=oid_array::_int4
2022-05-09 13:02:33 -05:00
Laurence IslaandGitHub 867f2569a0 ci: Fix Windows build using Stack
Added PostgreSQL binaries to the PATH and removed the use of msys2-keyring
2022-05-05 00:06:00 -05:00
Franz-Josef FärberandSteve Chavez 5a3fbd7111 Allow returning XML from single-column queries 2022-05-04 10:27:28 -05:00
Laurence IslaandGitHub a2349d90c0 Reorganize error groups
* Grouped Hasql errors into one error and renamed it to InternalError
* Move all the General errors to ApiRequest errors
2022-05-02 21:16:31 -05:00
steve-chavez 980f27a6d1 bump version to 9.0.0.20220502 2022-05-02 16:06:51 -05:00
steve-chavez ce96c88ba0 test: increase memory tests memory by 1M 2022-05-02 11:12:02 -05:00
steve-chavez 50b275d3e2 refactor: move PUT checks to ApiRequest 2022-05-02 11:12:02 -05:00
steve-chavez e90391b7ac limited update/delete requires explicit order
* limited update/delete now works on views with explicit order
* no default order, enforce order presence
* apply row count to ensure limited mutations
* move requiring order to ApiRequest
2022-05-02 11:12:02 -05:00
Laurence IslaandGitHub 5ad8800773 feat: Allow limit=0 in query params to return an empty array 2022-04-28 17:14:29 -05:00
Franz-Josef FärberandSteve Chavez d2aa50be52 Allow returning XML from RPCs 2022-04-26 17:37:59 -05:00
Laurence IslaandGitHub a8477b7822 Add tests for the ~ ltree operator (#2267) 2022-04-26 22:48:15 +02:00
steve-chavez 115dae7484 perf: Relationship list to a hash map 2022-04-25 21:41:51 -05:00
steve-chavez e4006da9bc perf: remove toSourceRel
toSourceRel is an expensive operation since it iterates over all the
relationships detected. We now use an alias on the CTE so embedding can
work without toSourceRel.
2022-04-25 21:41:51 -05:00
steve-chavez a47c59baca fix: restrict generated m2m relationships
Only add m2m relationship based on real junctions:
a table has FKs to two other tables and the FK columns
are part of the PK columns.

Also add some stats to big_schema.sql
2022-04-25 12:35:16 -05:00
dependabot[bot]andSteve Chavez b191431530 build(deps): bump codecov/codecov-action from 3.0.0 to 3.1.0
Bumps [codecov/codecov-action](https://github.com/codecov/codecov-action) from 3.0.0 to 3.1.0.
- [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.0.0...v3.1.0)

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

Signed-off-by: dependabot[bot] <support@github.com>
2022-04-25 12:24:38 -05:00
Laurence IslaandGitHub 9bdb4e5c4f ci: remove armv7 architectures for ARM builds
Now only builds aarch64 on the remote server without Docker
2022-04-23 20:30:07 +02:00
steve-chavez 07d619981e perf: don't lookup Table pkCols unnecessarily
handleCreate only needs it on some headers, udpate and delete don't need
pkcols.
2022-04-22 19:04:16 -05:00
steve-chavez 778b8d074d refactor: merge Column list into Table
* Remove Table from Column
* Correct OpenAPI test where the schema was appearing for the enum unnecessarily
* Increase memory-tests consumption by 2M

Seems the Hasql decoder consumes more memory now that the allTables
results also have [Column] inside.
2022-04-22 19:04:16 -05:00
steve-chavez 902e4e8921 refactor: clean allColumns query
* Add OpenAPI test to ensure enum labels are present
* Remove unnecessary fk/pk columns cte
* Remove unnecessary step for parsing enum labels
2022-04-22 11:46:45 -05:00
steve-chavez d2719420f4 refactor: PKcols in table, ViewKeyDependency type
* Get PKcols inside tables - done with SQL for tables and
  with an additional step in Haskell for views.

  This fixes an fk column being considered as a pk column on views
  and corrects the test added on
  https://github.com/PostgREST/postgrest/pull/1875/files/1d549768580310e18aac4ffa6dbd01c5b77934a7#r853674126

* classify view key dependencies in SQL

* remove Column from Relationship

* Merge cols/fcols in Relationship and
  ensure allM2ORels and allViewsKeyDependencies fk columns
  are ordered - done by attnum in SQL

* Cardinality now contains relColumns instead of Relationship -
  this simplifies getJoinConditions.
2022-04-21 14:44:45 -05:00
steve-chavez 057e8d63bf test: add big schema openapi test
The io test is marked as pending for now, because the stack size it
requires is too big.
2022-04-20 20:05:11 -05:00
steve-chavez f4e171aa2b refactor: ignore partitions in allM2ORels
Also clarify foreign key filter
2022-04-19 17:23:12 -05:00
steve-chavez 7f1507b9fb refactor: remove Table from Relationship
Just having the QualifiedIdentifier gets us closer to having
Relationship as a Table attribute since it avoids a cyclic dependency

* remove unnecessary findTable
* modify RootSpec test
2022-04-18 15:48:03 -05:00
steve-chavez cdcc175abf refactor: table list to table map 2022-04-18 15:48:03 -05:00
steve-chavez f995799e8f refactor: remove fkey from allPrimaryKeys query
The query had the unnecessary 'f' in `c.contype in ('p', 'u', 'f')`

Also comment and clarify the query by using explicit JOINs
2022-04-18 15:48:03 -05:00
steve-chavez 44e2b2fbb4 refactor: DRY allTables/accessibleTables query 2022-04-18 15:48:03 -05:00
steve-chavez 2eaf81334e nix: local history for nix-shell 2022-04-18 15:48:03 -05:00
steve-chavez c399b1f5f8 nix: log all statements in temp db 2022-04-18 15:48:03 -05:00
Laurence IslaandGitHub bc7d54c7d2 Add CI for ARM architectures (#2127) 2022-04-18 17:40:32 +02:00
Laurence IslaandGitHub 7589102c6c Fix misleading disambiguation error where relationship looks like valid syntax
* Add columns for the m2m relationship
2022-04-12 00:02:19 +02:00
Michael Kane JunckerandWolfgang Walther 007f49a8bc feat(query): add basic regular expression operator support - refs #2236 2022-04-11 08:33:16 +02:00
dependabot[bot]andWolfgang Walther a768bcbf20 build(deps): bump codecov/codecov-action from 2.1.0 to 3.0.0
Bumps [codecov/codecov-action](https://github.com/codecov/codecov-action) from 2.1.0 to 3.0.0.
- [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/v2.1.0...v3.0.0)

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

Signed-off-by: dependabot[bot] <support@github.com>
2022-04-11 08:23:26 +02:00
dependabot[bot]andWolfgang Walther cb145271ac build(deps): bump actions/cache from 2.1.7 to 3
Bumps [actions/cache](https://github.com/actions/cache) from 2.1.7 to 3.
- [Release notes](https://github.com/actions/cache/releases)
- [Commits](https://github.com/actions/cache/compare/v2.1.7...v3)

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

Signed-off-by: dependabot[bot] <support@github.com>
2022-03-28 07:45:07 +02:00
Laurence IslaandGitHub 9124dfd427 Bypass FreeBSD builds due to timeouts 2022-03-26 15:14:54 -05:00
Laurence Isla 8e86177486 bump version to 9.0.0.20220326 2022-03-26 12:26:47 -05:00
Laurence IslaandGitHub fe898c27ae Fix incorrectly placed feature in CHANGELOG
Move incorrectly placed feature for PostgREST errors from v9.0.0 to Upcoming
2022-03-26 11:08:37 -05:00
steve-chavez f3f9030c48 disallow limit/offset on views 2022-03-26 15:29:13 +01:00
steve-chavez 73dc2692b1 refactor: add findTable function 2022-03-26 15:29:13 +01:00
steve-chavez 87ffe39746 fix: ignore max-rows on POST/PATCH/PUT/DELETE 2022-03-26 15:29:13 +01:00
steve-chavez 331e88ea39 feat: add limited delete 2022-03-26 15:29:13 +01:00
steve-chavez f4becf99ad feat: add limited update 2022-03-26 15:29:13 +01:00
Ezequiel AlvarezandGitHub 799daa7556 fix: json/jsonb columns should not have type "string" in OpenAPI spec (#2203)
* Switch to no type for json/jsonb
2022-03-26 15:16:35 +01:00
Steve ChavezandGitHub a3c1d9977f Correct live/ready checks to consider special host values (#2182) 2022-03-11 15:16:45 +01:00
dependabot[bot]andGitHub c803c4d0b6 build(deps): bump actions/checkout from 2.4.0 to 3 (#2186) 2022-03-08 01:56:58 +01:00
dependabot[bot]andGitHub 8aef09574c build(deps): bump actions/upload-artifact from 2.3.1 to 3 (#2187) 2022-03-08 01:46:30 +01:00
dependabot[bot]andGitHub efcc93ad89 build(deps): bump actions/download-artifact from 2.1.0 to 3 (#2185) 2022-03-07 22:54:47 +01:00
Laurence IslaandGitHub d6834e8bf8 Add 'PGRST' error code to differentiate from PostgreSQL errors 2022-03-04 15:57:38 -05:00
Laurence IslaandGitHub 99d0b805df fix: Using GET with certain Content-Type headers now correctly calls the no parameter function if it exists
Using GET with text/plain or application/octet-stream as Content-Type headers no longer returns 404 Not Found when a function with no parameters exists
2022-02-28 13:23:55 -05:00
Laurence IslaandGitHub 69070f341a fix: Remove admin-server-port from in-db configuration 2022-02-23 17:26:01 -05:00
steve-chavez dcf7ade5bc bump version to 9.0.0.20220211 2022-02-11 14:47:33 -05:00
Steve ChavezandGitHub 9021c96baa fix: Keep working when EMFILE is reached (#2158)
Done by upgrading to warp 3.3.19
2022-02-09 17:27:29 -05:00
Wolfgang WaltherandWolfgang Walther 41a4396147 fix: Remove uncallable functions from schema cache and OpenAPI output
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-02-08 09:08:27 +01:00
Wolfgang WaltherandWolfgang Walther d9f7f6f509 refactor: Remove pg_catalog prefix from schema cache queries
Since the search path is voided at the beginning, there is no need to qualify those.

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-02-08 09:08:27 +01:00
Wolfgang WaltherandWolfgang Walther bd62008e1c fix: Remove aggregates, procedures and window functions from schema cache and OpenAPI output
Aggregates and Window functions can't be called as RPCs in a useful way.

Procedures are not supported right now, but might be added later.

Resolves #2101

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-02-05 17:48:22 +01:00
Wolfgang WaltherandWolfgang Walther ded8981368 fix: Take PG version into account in --dump-schema
The PG version is only read by the Connection Worker, which is not used in the case dump-schema. Now, the pg version is read in the schema cache queries directly, avoiding this problem in all cases.

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-02-05 17:48:22 +01:00
Wolfgang WaltherandWolfgang Walther 52d628f1ed fix: Return 204 No Content without Content-Type for RPCs returning VOID
Resolves #2001

BREAKING CHANGE: Previously, those RPCs would return "null" as a body with Content-Type: application/json.
2022-02-05 09:28:28 +01:00
Wolfgang Walther 9ca9a54d21 bump version to 9.0.0.20220204 2022-02-04 08:34:51 +01:00
Wolfgang Walther bf689565a5 fix broken link in docker hub description, resolves #2148
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-02-04 08:34:35 +01:00
Wolfgang WaltherandWolfgang Walther 9f1b5c0a81 feat: Support accessing array items and fields of composite types through json operators
This is supported in select=, in filters and in order=.

Resolves #1543

Resolves #2075

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-02-03 08:13:38 +01:00
Wolfgang WaltherandWolfgang Walther 87bd8e72cf fix changelog
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-02-03 08:13:38 +01:00
Wolfgang WaltherandWolfgang Walther 8934190d43 nix: Add postgrest-release tool
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-01-30 19:52:35 +01:00
Wolfgang Walther c894b543b0 bump version to 9.0.0.20220130 2022-01-30 16:15:27 +01:00
Wolfgang WaltherandWolfgang Walther 58f76f3d6d fix: Return 405 Method Not Allowed for unsupported verbs
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-01-28 19:26:33 +01:00
Wolfgang WaltherandWolfgang Walther 8980b09419 refactor: Sort error types
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-01-28 19:26:33 +01:00
Wolfgang WaltherandWolfgang Walther 927ff6f1e5 test: Split spec tests into multiple subfolders
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-01-28 19:26:33 +01:00
Wolfgang WaltherandWolfgang Walther 8a722e2cfe refactor: Replace elem with pattern matching to highlight missing code coverage
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-01-28 19:26:33 +01:00
Wolfgang WaltherandWolfgang Walther 271c329677 nix: Fix postgrest-git-hooks causing merge conflicts when staging files partially
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-01-28 19:26:33 +01:00
Wolfgang WaltherandWolfgang Walther c63420f0e7 nix: Fix postgrest-git-hooks disable not working
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-01-28 19:26:33 +01:00
Wolfgang WaltherandWolfgang Walther 2fe2c9104b ci: Fix weeder not stopping CI on error
Removes dead code that was unnoticed

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-01-28 17:12:32 +01:00
Wolfgang WaltherandWolfgang Walther 0ea36fc039 ci: Fix windows build failing because of outdated keyring
Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
2022-01-28 17:12:32 +01:00
Wolfgang WaltherandWolfgang Walther fc7113e52e fix: Remove trigger functions from schema cache and OpenAPI output
Trigger functions can't be called directly from SQL and can't be called
via the /rpc prefix either - it makes no sense to expose them in the
OpenAPI output. And we don't need to cache them in the schema cache
either.

Best practice would be to keep the trigger functions in a non-exposed
schema anyway.
2022-01-28 16:45:36 +01:00
Steve ChavezandGitHub c7cadcd776 Fix embedded filter silently getting ignored (#2133)
When the embedded resource is not included in the request
2022-01-24 17:52:27 -05:00
Wolfgang WaltherandWolfgang Walther fae1e168a7 Fix memory tests timing out after c3ade07 2022-01-24 14:56:06 +01:00
Wolfgang WaltherandWolfgang Walther d2791ea0e5 Sort example config alphabetically 2022-01-24 14:56:06 +01:00
Wolfgang WaltherandWolfgang Walther f4637c64c9 Remove db-root-spec from example config file
We are not going to support this officially right now.
2022-01-24 14:56:06 +01:00
Wolfgang WaltherandWolfgang Walther 1b9a30cff4 Make db-uri, db-schemas and db-anon-role optional in example config file 2022-01-24 14:56:06 +01:00
Wolfgang WaltherandWolfgang Walther 5a627e76b2 format comments in example config consistently 2022-01-24 14:56:06 +01:00
Wolfgang Walther d9e016be8b feat: Allow running postgrest without configuration
Resolves #1823
2022-01-22 15:59:26 +01:00
Wolfgang Walther c3ade07ad6 feat: Make db-anon-role optional
Without db-anon-role, PostgREST will block any anonymous access without hitting the database.

Resolves #1689, Ref #1823
2022-01-22 15:59:26 +01:00
Wolfgang Walther 05b5ecd23b Reformatting of some test-cases and removal of superfluous comments. 2022-01-22 15:13:21 +01:00
Wolfgang Walther dbbde6aae1 feat: Make db-schemas optional
Resolves #1769, Ref #1823
2022-01-22 15:13:21 +01:00
Wolfgang Walther 9ed30c0ba4 feat: Make db-uri optional
The default is now "postgresql://" which falls back to LIBPQ environment variables.

Resolves #1991, Ref #1823
2022-01-22 15:13:19 +01:00
Wolfgang Walther ec09b87940 test: Make io tests use environment variables instead of config files where possible.
Load jwt secret from file instead of stdin in tests, because stdin is not supported when reloading the config. Resolves #2126.
2022-01-22 15:10:25 +01:00
Wolfgang WaltherandWolfgang Walther 6b5370f145 ci: Add -with-rtsopts=-KxK option to prevent introducing space leaks
Resolves #387
2022-01-10 22:09:32 +01:00
Wolfgang WaltherandWolfgang Walther a25ad42644 Align columns in postgrest.cabal 2022-01-10 22:09:32 +01:00
Wolfgang WaltherandWolfgang Walther 995215c6a5 fix: Read database configuration properly when = is present in value
Resolves #2120
2022-01-10 09:24:49 +01:00
Wolfgang WaltherandWolfgang Walther 4b841dba61 refactor: Reformat db-config query 2022-01-10 09:24:49 +01:00
Wolfgang WaltherandWolfgang Walther 9639cd5751 feat: Add current user to apache-style request logging. 2022-01-07 20:26:33 +01:00
3c17f97c87 refactor: Make JWT authorization a middleware
This follows the style of wai-middleware-auth package and
makes the JWT parsing a middleware.

Co-authored-by: Wolfgang Walther <walther@technowledgy.de>
2022-01-07 20:26:33 +01:00
Wolfgang WaltherandWolfgang Walther d97bf3b864 refactor: Move each Wai Middleware to a separate file 2022-01-07 20:26:33 +01:00
Steve ChavezandGitHub 65f27653dc cov: empty coverage overlay (#2119)
The overlay depended on the version number, which caused errors when upgrading.

Also update cabal description.
2022-01-07 13:06:03 -05:00
steve-chavez a134d8a493 pre-release: Bump to 9.0.0.20220107
Previous pre-release had a wrong date
2022-01-07 11:06:03 -05:00
steve-chavez 3ded567f6d pre-release: Bump to 9.0.0.20210107 2022-01-07 11:01:59 -05:00
Wolfgang WaltherandWolfgang Walther 8b63d928ae test: Reorganize test/ folder into one subdirectory for each test type 2022-01-07 13:10:36 +01:00
Wolfgang WaltherandWolfgang Walther 8060fe3559 Remove unused dependencies from postgrest.cabal 2022-01-07 12:07:48 +01:00
Wolfgang WaltherandWolfgang Walther df5d9400fe test: Make io tests use admin/ready to wait for startup 2022-01-07 12:07:09 +01:00
Wolfgang Walther 6bc965e2a0 run postgrest-style 2022-01-07 11:39:41 +01:00
monacoremoandWolfgang Walther bfbec8fa36 refactor: Carve out QueryParams module 2022-01-07 09:32:33 +01:00
steve-chavezandWolfgang Walther 51ee072f84 fix: clarify error for failed schema cache load 2022-01-07 09:31:30 +01:00
steve-chavezandWolfgang Walther aa82d2e277 Consider schema cache state on the ready check
* empty schema cache when it fails loading so the ready check can pick
  its new state
2022-01-07 09:31:30 +01:00
Wolfgang WaltherandWolfgang Walther e13d912a79 cov: Add coverage overlay for impossible case in corsPolicy 2022-01-05 11:01:54 +01:00
Wolfgang WaltherandWolfgang Walther 826ae7459a refactor: simplify logger middleware 2022-01-05 11:01:54 +01:00
Wolfgang WaltherandWolfgang Walther cde9cd4ab7 cov: Remove unreachable static icon 2022-01-05 11:01:54 +01:00
Wolfgang WaltherandWolfgang Walther b0a0c4768d cov: Add tests for request logging 2022-01-05 11:01:54 +01:00
steve-chavez 4a9ca9bdae Add live endpoint to admin server
* refactor io tests
* add network package to windows
2022-01-04 20:12:52 -05:00
steve-chavez 65a3ae08f0 Change admin health endpoint to ready 2022-01-04 20:12:52 -05:00
steve-chavez bba6e96fd3 Connect to main app socket on health check 2022-01-04 20:12:52 -05:00
Wolfgang WaltherandWolfgang Walther cc900787de test: Remove unused unix-socket.config file
Unix sockets are the default in io tests and we are testing ip connections explicitly.
2022-01-04 09:36:22 +01:00
Wolfgang WaltherandWolfgang Walther 01e65f5221 test: Improve io test perfomance
Local test improves performance by 15%.
2022-01-04 09:36:22 +01:00
Wolfgang WaltherandWolfgang Walther 1e9031573c test: Move io-tests SQL fixtures to a separate file 2022-01-04 09:36:22 +01:00
Wolfgang WaltherandWolfgang Walther 81ebdff977 test: Improve log output for failing io-tests 2022-01-04 09:36:22 +01:00
Wolfgang WaltherandWolfgang Walther 9baad293e8 test: Refactor invalid_role_claim_key_notify_reload test to properly read all available input 2022-01-04 09:36:22 +01:00
Wolfgang WaltherandWolfgang Walther efc7a21427 test: Refactor test-cases for admin/health endpoint 2022-01-04 09:36:22 +01:00
Wolfgang WaltherandWolfgang Walther b9c497a3ab test: Use .encode() end .decode default values in io-tests
Those default to "utf-8" anyway.
2022-01-04 09:36:22 +01:00
Wolfgang WaltherandWolfgang Walther 5f43235370 nix: Fix nested postgrest-with-postgresql-x calls when -f is used 2022-01-04 09:36:22 +01:00
Wolfgang WaltherandWolfgang Walther 57ff89be64 Remove outdated heroku manifest 2022-01-01 15:57:58 +01:00
Wolfgang WaltherandWolfgang Walther 4f7ee6f36a cov: Improve jwt claims test-cases 2021-12-25 13:27:53 +01:00
Wolfgang WaltherandWolfgang Walther 14f3b25022 fix: Fix wrong CORS header Authentication -> Authorization
Also refactors defaultCorsPolicy and corsPolicy and cleans up CORS tests
2021-12-25 13:27:53 +01:00
Wolfgang WaltherandWolfgang Walther b99c8c897c fix: Make recursive view parsing work with XMLTABLE + DEFAULT 2021-12-24 19:01:20 +01:00
Steve ChavezandGitHub ac3655df1d feat: minimal health check (#2092) 2021-12-23 08:00:10 -05:00
Laurence IslaandGitHub c858d158aa Add hint to verify table and foreign key existence on a relationship error 2021-12-20 12:11:07 -05:00
dependabot[bot]andGitHub cc8a7ef0c2 build(deps): bump actions/upload-artifact from 2.3.0 to 2.3.1 (#2094) 2021-12-20 10:54:13 -05:00
Steve ChavezandGitHub c86e254a24 fix: is not working with upper/mixed case values (#2081) 2021-12-14 19:13:38 -05:00
dependabot[bot]andSteve Chavez 1c7ca51308 build(deps): bump actions/upload-artifact from 2.2.4 to 2.3.0
Bumps [actions/upload-artifact](https://github.com/actions/upload-artifact) from 2.2.4 to 2.3.0.
- [Release notes](https://github.com/actions/upload-artifact/releases)
- [Commits](https://github.com/actions/upload-artifact/compare/v2.2.4...v2.3.0)

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

Signed-off-by: dependabot[bot] <support@github.com>
2021-12-13 12:43:16 -05:00
dependabot[bot]andSteve Chavez 6a3f8ca828 build(deps): bump actions/download-artifact from 2.0.10 to 2.1.0
Bumps [actions/download-artifact](https://github.com/actions/download-artifact) from 2.0.10 to 2.1.0.
- [Release notes](https://github.com/actions/download-artifact/releases)
- [Commits](https://github.com/actions/download-artifact/compare/v2.0.10...v2.1.0)

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

Signed-off-by: dependabot[bot] <support@github.com>
2021-12-13 12:42:53 -05:00
Wolfgang WaltherandWolfgang Walther 031de4d35e fix: Dump db-config option without quotes as it's a boolean 2021-12-11 08:12:59 +01:00
Wolfgang WaltherandWolfgang Walther 595c2a5257 nix(feat): Add postgrest-git-hooks to enable pre-commit and pre-push hooks 2021-12-06 10:40:23 +01:00
Wolfgang WaltherandRemo 74f6e5225c nix: Add weeder to postgrest-coverage
Removes a bit of dead code from SpecHelper.hs
2021-12-04 11:39:56 +01:00
Wolfgang WaltherandWolfgang Walther c581148f1b refactor: Make asJsonSingleF "safe", by accessing only the first element of a json_agg result 2021-12-01 09:19:47 +01:00
Wolfgang WaltherandWolfgang Walther 0e20b47875 fix: Return 204 No Content without Content-Type for PUT 2021-12-01 09:19:47 +01:00
Wolfgang WaltherandWolfgang Walther 1cb00d3c62 fix: Execute deferred constraint triggers when using Prefer: tx=rollback
Resolves #2020
2021-11-30 15:54:12 +01:00
Wolfgang WaltherandWolfgang Walther bbc07d3f40 fix: Link to latest docs in pre-release openapi output
Resolves #2018
2021-11-29 08:40:38 +01:00
Wolfgang WaltherandSteve Chavez 9c6597c351 ci: Use matrix strategy to test against postgres versions 2021-11-27 13:15:42 -05:00
Wolfgang WaltherandSteve Chavez defdcb85ef ci: Run IO tests against all postgres versions
Resolves #1820.
2021-11-27 13:15:42 -05:00
Wolfgang WaltherandSteve Chavez 94115ff134 ci: Disable update of dockerhub description on release
This is not allowed via personal access token right now and could be re-enabled in the future, once solved by docker hub.
2021-11-27 13:11:30 -05:00
Wolfgang WaltherandWolfgang Walther 5a8d9b1246 nix(feat): Add bash completion for git references 2021-11-27 10:57:29 +01:00
Wolfgang WaltherandWolfgang Walther 32ff9dfb48 nix(feat): Add postgrest-loadtest 2021-11-27 10:57:29 +01:00
Wolfgang WaltherandWolfgang Walther ab90bd24e0 nix(feat): Add postgrest-with-git and postgrest-with-pgrst tools 2021-11-27 10:57:29 +01:00
225 changed files with 25890 additions and 7001 deletions
+2 -2
View File
@@ -1,9 +1,9 @@
freebsd_instance:
image_family: freebsd-13-0
image_family: freebsd-13-1
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
+2 -2
View File
@@ -11,8 +11,8 @@ inputs:
runs:
using: composite
steps:
- uses: cachix/install-nix-action@v16
- uses: cachix/cachix-action@v10
- uses: cachix/install-nix-action@v18
- uses: cachix/cachix-action@v12
with:
name: postgrest
authToken: ${{ inputs.authToken }}
+63
View File
@@ -0,0 +1,63 @@
#!/bin/bash
# This script builds PostgREST in a remote ARM server
[ -z "$1" ] && { echo "Missing 1st argument: PostgREST github commit SHA"; exit 1; }
[ -z "$2" ] && { echo "Missing 2nd argument: Build environment directory name"; exit 1; }
PGRST_GITHUB_COMMIT="$1"
SCRIPT_DIR="$2"
DOCKER_BUILD_DIR="$SCRIPT_DIR/docker-env"
install_packages() {
sudo apt-get update -y
sudo apt-get upgrade -y
sudo apt-get install -y git build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5 llvm libnuma-dev zlib1g-dev libpq-dev jq gcc
sudo apt-get clean
}
install_ghcup() {
export BOOTSTRAP_HASKELL_NONINTERACTIVE=1
export BOOTSTRAP_HASKELL_MINIMAL=1
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
source ~/.ghcup/env
}
install_cabal() {
ghcup upgrade
ghcup install cabal 3.6.0.0
ghcup set cabal 3.6.0.0
}
install_ghc() {
ghcup install ghc 8.10.7
ghcup set ghc 8.10.7
}
install_packages
# Add ghcup to the PATH for this session
[ -f ~/.ghcup/env ] && source ~/.ghcup/env
ghcup --version || install_ghcup
cabal --version || install_cabal
ghc --version || install_ghc
cd ~/$SCRIPT_DIR
# Clone the repository and build the project
git clone https://github.com/PostgREST/postgrest.git
cd postgrest
git checkout $PGRST_GITHUB_COMMIT
cabal v2-update && cabal v2-build
# Copy the built binary to the Dockerfile directory
PGRST_BIN=$(cabal exec which postgrest | tail -1)
cp $PGRST_BIN ~/$DOCKER_BUILD_DIR
# Move and compress the built binary
mkdir -p ~/$SCRIPT_DIR/result
mv $PGRST_BIN ~/$SCRIPT_DIR/result
cd ~/$SCRIPT_DIR
tar -cJf result.tar.xz result
+16
View File
@@ -0,0 +1,16 @@
# PostgREST docker hub image
FROM ubuntu:focal AS postgrest
RUN apt-get update -y \
&& apt install -y --no-install-recommends libpq-dev zlib1g-dev jq gcc libnuma-dev \
&& apt-get clean \
&& rm -rf /var/lib/apt/lists/*
COPY postgrest /usr/bin/postgrest
EXPOSE 3000
USER 1000
CMD postgrest
+50
View File
@@ -0,0 +1,50 @@
#!/bin/bash
# This script publishes the Docker ARM images to Docker Hub.
[ -z "$1" ] && { echo "Missing 1st argument: PostgREST github commit SHA"; exit 1; }
[ -z "$2" ] && { echo "Missing 2nd argument: Docker repo"; exit 1; }
[ -z "$3" ] && { echo "Missing 3rd argument: Docker username"; exit 1; }
[ -z "$4" ] && { echo "Missing 4th argument: Docker password"; exit 1; }
[ -z "$5" ] && { echo "Missing 5th argument: Build environment directory name"; exit 1; }
[ -z "$6" ] && { echo "Missing 6th argument: PostgREST version"; exit 1; }
PGRST_GITHUB_COMMIT="$1"
DOCKER_REPO="$2"
DOCKER_USER="$3"
DOCKER_PASS="$4"
SCRIPT_DIR="$5"
PGRST_VERSION="v$6"
IS_PRERELEASE="$7"
DOCKER_BUILD_DIR="$SCRIPT_DIR/docker-env"
clean_env()
{
sudo docker logout
}
# Login to Docker
sudo docker logout
{ echo $DOCKER_PASS | sudo docker login -u $DOCKER_USER --password-stdin; } || { echo "Couldn't login to docker"; exit 1; }
trap clean_env sigint sigterm exit
# Move to the docker build environment
cd ~/$DOCKER_BUILD_DIR
# Push final images to Docker hub
# NOTE: This command publishes a separate ARM image because the builds cannot
# be added to the manifest if they are not in the registry beforehand.
# This image must be manually deleted from Docker Hub at the end of the process.
sudo docker buildx build --build-arg PGRST_GITHUB_COMMIT=$PGRST_GITHUB_COMMIT \
-t $DOCKER_REPO/postgrest:$PGRST_VERSION-arm \
--push .
# Add the arm images to the manifest
# NOTE: This assumes that there already is a `postgrest:<version>` image
# for the amd64 architecture pushed to Docker Hub
sudo docker buildx imagetools create --append -t $DOCKER_REPO/postgrest:$PGRST_VERSION $DOCKER_REPO/postgrest:$PGRST_VERSION-arm
[ -z $IS_PRERELEASE ] && sudo docker buildx imagetools create --append -t $DOCKER_REPO/postgrest:latest $DOCKER_REPO/postgrest:$PGRST_VERSION-arm
sudo docker logout
+207 -74
View File
@@ -4,18 +4,20 @@ on:
push:
branches:
- main
- rel-*
tags:
- v*
pull_request:
branches:
- main
- rel-*
jobs:
Lint-Style:
name: Lint & check code style
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2.4.0
- uses: actions/checkout@v3
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
@@ -35,39 +37,19 @@ jobs:
# https://github.com/actions/runner/issues/241#issuecomment-842566950
shell: script -qec "bash --noprofile --norc -eo pipefail {0}"
steps:
- uses: actions/checkout@v2.4.0
- uses: actions/checkout@v3
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
tools: tests withTools
tools: tests
- 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@v2.1.0
uses: codecov/codecov-action@v3.1.1
with:
files: ./coverage/codecov.json
- name: Run the spec tests against PostgreSQL 13
if: always()
run: postgrest-with-postgresql-13 postgrest-test-spec
- name: Run the spec tests against PostgreSQL 12
if: always()
run: postgrest-with-postgresql-12 postgrest-test-spec
- name: Run the spec tests against PostgreSQL 11
if: always()
run: postgrest-with-postgresql-11 postgrest-test-spec
- name: Run the spec tests against PostgreSQL 10
if: always()
run: postgrest-with-postgresql-10 postgrest-test-spec
- name: Run the spec tests against PostgreSQL 9.6
if: always()
run: postgrest-with-postgresql-9.6 postgrest-test-spec
- name: Run query cost tests against all PostgreSQL versions
if: always()
run: postgrest-with-all postgrest-test-querycost
- name: Run doctests
if: always()
run: nix-shell --run postgrest-test-doctests
@@ -77,11 +59,43 @@ jobs:
run: postgrest-test-spec-idempotence
Test-Pg-Nix:
strategy:
fail-fast: false
matrix:
pgVersion: [9.6, 10, 11, 12, 13, 14, 15]
name: Test PG ${{ matrix.pgVersion }} (Nix)
runs-on: ubuntu-latest
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
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
tools: tests withTools
- name: Run spec tests
if: always()
run: postgrest-with-postgresql-${{ matrix.pgVersion }} postgrest-test-spec
- 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
Test-Memory-Nix:
name: Test memory (Nix)
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2.4.0
- uses: actions/checkout@v3
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
@@ -90,20 +104,23 @@ jobs:
run: postgrest-test-memory
Build-Nix:
Build-Static-Nix:
name: Build Linux static (Nix)
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2.4.0
- uses: actions/checkout@v3
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
tools: tests
- 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@v2.2.4
uses: actions/upload-artifact@v3
with:
name: postgrest-linux-static-x64
path: result/bin/postgrest
@@ -112,7 +129,7 @@ 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@v2.2.4
uses: actions/upload-artifact@v3
with:
name: postgrest-docker-x64
path: postgrest-docker.tar.gz
@@ -131,22 +148,18 @@ jobs:
fail-fast: false
matrix:
include:
- name: Linux & test
- name: Linux
runs-on: ubuntu-latest
cache: |
~/.stack
.stack-work
test: true
pgdir: /usr/lib/postgresql
artifact: postgrest-ubuntu-x64
- name: MacOS & test
- name: MacOS
runs-on: macos-latest
cache: |
~/.stack
.stack-work
test: true
pgdir: /usr/local/Cellar/postgresql
artifact: postgrest-macos-x64
- name: Windows
@@ -155,18 +168,15 @@ jobs:
~\AppData\Roaming\stack
~\AppData\Local\Programs\stack
.stack-work
deps: |
stack exec -- pacman -S mingw64/mingw-w64-x86_64-postgresql --noconfirm
# We'd need to make test/with_tmp_db run on Windows first
# test: true
deps: Add-Content $env:GITHUB_PATH $env:PGBIN
artifact: postgrest-windows-x64
name: Build ${{ matrix.name }} (Stack)
runs-on: ${{ matrix.runs-on }}
steps:
- uses: actions/checkout@v2.4.0
- uses: actions/checkout@v3
- name: Stack working files cache
uses: actions/cache@v2.1.7
uses: actions/cache@v3
with:
path: ${{ matrix.cache }}
key: ${{ runner.os }}-${{ hashFiles('stack.yaml.lock') }}
@@ -175,14 +185,8 @@ jobs:
run: ${{ matrix.deps }}
- name: Build with Stack
run: stack build --local-bin-path result --copy-bins
- name: Run Spec tests with Stack
if: ${{ matrix.test }}
run: |
postgresql_bin="$(find ${{ matrix.pgdir }} -maxdepth 2 -type d -name bin | head -n 1)"
echo "Using PostgreSQL binaries at $postgresql_bin ..."
PATH="$postgresql_bin:$PATH" test/with_tmp_db stack test
- name: Save built executable as artifact
uses: actions/upload-artifact@v2.2.4
uses: actions/upload-artifact@v3
with:
name: ${{ matrix.artifact }}
path: |
@@ -190,24 +194,108 @@ jobs:
result/postgrest.exe
if-no-files-found: error
Get-FreeBSD-CirrusCI:
name: Get FreeBSD build from CirrusCI
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2.4.0
- uses: actions/checkout@v3
- 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}}
run: .github/get_cirrusci_freebsd
- name: Save executable as artifact
uses: actions/upload-artifact@v2.2.4
uses: actions/upload-artifact@v3
with:
name: postgrest-freebsd-x64
path: postgrest
if-no-files-found: error
Build-Cabal:
strategy:
matrix:
ghc: ['8.10.7', '9.2.4']
fail-fast: false
name: Build Linux (Cabal, GHC ${{ matrix.ghc }})
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v3
- name: ghcup
run: |
ghcup install ghc ${{ matrix.ghc }}
ghcup set ghc ${{ matrix.ghc }}
- name: Copy cabal.project
run: |
cp cabal.project.non-nix cabal.project
- name: Cache
uses: actions/cache@v3
with:
path: ~/.cabal
key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }}
restore-keys: |
${{ 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)
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 }}
steps:
- uses: actions/checkout@v3
- id: Remote-Dir
name: Unique directory name for the remote build
run: echo "::set-output name=remotepath::postgrest-build-$(uuidgen)"
- name: Copy script files to the remote server
uses: appleboy/scp-action@master
with:
host: ${{ secrets.SSH_ARM_HOST }}
username: ubuntu
key: ${{ secrets.SSH_ARM_PRIVATE_KEY }}
fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
source: ".github/scripts/arm/*"
target: ${{ steps.Remote-Dir.outputs.remotepath }}
strip_components: 3
- name: Build ARM
uses: appleboy/ssh-action@master
env:
REMOTE_DIR: ${{ steps.Remote-Dir.outputs.remotepath }}
with:
host: ${{ secrets.SSH_ARM_HOST }}
username: ubuntu
key: ${{ secrets.SSH_ARM_PRIVATE_KEY }}
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"
- name: Download binaries from remote server
uses: nicklasfrahm/scp-action@main
with:
direction: download
host: ${{ secrets.SSH_ARM_HOST }}
username: ubuntu
key: ${{ secrets.SSH_ARM_PRIVATE_KEY }}
fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
source: "${{ steps.Remote-Dir.outputs.remotepath }}/result.tar.xz"
target: "result.tar.xz"
- 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
with:
name: postgrest-ubuntu-aarch64
path: result/postgrest
if-no-files-found: error
Prepare-Release:
name: Prepare release
@@ -216,15 +304,17 @@ jobs:
needs:
- Lint-Style
- Test-Nix
- Test-Pg-Nix
- Test-Memory-Nix
- Build-Nix
- Build-Static-Nix
- Build-Stack
- Get-FreeBSD-CirrusCI
#- Get-FreeBSD-CirrusCI
- Build-Cabal-Arm
outputs:
version: ${{ steps.Identify-Version.outputs.version }}
isprerelease: ${{ steps.Identify-Version.outputs.isprerelease }}
steps:
- uses: actions/checkout@v2.4.0
- uses: actions/checkout@v3
- id: Identify-Version
name: Identify the version to be released
run: |
@@ -261,7 +351,7 @@ jobs:
echo "Relevant extract from CHANGELOG.md:"
cat CHANGES.md
- name: Save CHANGES.md as artifact
uses: actions/upload-artifact@v2.2.4
uses: actions/upload-artifact@v3
with:
name: release-changes
path: CHANGES.md
@@ -277,9 +367,9 @@ jobs:
env:
VERSION: ${{ needs.Prepare-Release.outputs.version }}
steps:
- uses: actions/checkout@v2.4.0
- uses: actions/checkout@v3
- name: Download all artifacts
uses: actions/download-artifact@v2.0.10
uses: actions/download-artifact@v3
with:
path: artifacts
- name: Create release bundle with archives for all builds
@@ -299,14 +389,18 @@ jobs:
tar cJvf "release-bundle/postgrest-v$VERSION-macos-x64.tar.xz" \
-C artifacts/postgrest-macos-x64 postgrest
tar cJvf "release-bundle/postgrest-v$VERSION-freebsd-x64.tar.xz" \
-C artifacts/postgrest-freebsd-x64 postgrest
# TODO: Fix timeouts for FreeBSD builds in Cirrus
#tar cJvf "release-bundle/postgrest-v$VERSION-freebsd-x64.tar.xz" \
# -C artifacts/postgrest-freebsd-x64 postgrest
tar cJvf "release-bundle/postgrest-v$VERSION-ubuntu-aarch64.tar.xz" \
-C artifacts/postgrest-ubuntu-aarch64 postgrest
zip "release-bundle/postgrest-v$VERSION-windows-x64.zip" \
artifacts/postgrest-windows-x64/postgrest.exe
- name: Save release bundle
uses: actions/upload-artifact@v2.2.4
uses: actions/upload-artifact@v3
with:
name: release-bundle
path: release-bundle
@@ -329,25 +423,29 @@ jobs:
Release-Docker:
name: Release on Docker Hub
runs-on: ubuntu-latest
needs: Prepare-Release
needs:
- Build-Cabal-Arm
- Prepare-Release
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@v2.4.0
- uses: actions/checkout@v3
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
tools: release
- name: Download Docker image
uses: actions/download-artifact@v2.0.10
uses: actions/download-artifact@v3
with:
name: postgrest-docker-x64
- name: Publish images on Docker Hub
run: |
docker login -u "$DOCKER_USER" -p "${{ secrets.DOCKER_PASS }}"
docker login -u "$DOCKER_USER" -p "$DOCKER_PASS"
docker load -i postgrest-docker.tar.gz
docker tag postgrest:latest "$DOCKER_REPO/postgrest:v$VERSION"
@@ -361,13 +459,48 @@ jobs:
else
echo "Skipping pushing to 'latest' tag for v$VERSION pre-release..."
fi
- name: Update descriptions on Docker Hub
- name: Publish images for ARM builds on Docker Hub
uses: appleboy/ssh-action@master
env:
DOCKER_PASS: ${{ secrets.DOCKER_PASS }}
run: |
if [[ -z "$ISPRERELEASE" ]]; then
echo "Updating description on Docker Hub..."
postgrest-release-dockerhub-description
else
echo "Skipping updating description for pre-release..."
fi
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
# env:
# DOCKER_PASS: ${{ secrets.DOCKER_PASS }}
# run: |
# if [[ -z "$ISPRERELEASE" ]]; then
# echo "Updating description on Docker Hub..."
# postgrest-release-dockerhub-description
# else
# echo "Skipping updating description for pre-release..."
# fi
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-')) }}
runs-on: ubuntu-latest
env:
REMOTE_DIR: ${{ needs.Build-Cabal-Arm.outputs.remotepath }}
steps:
- uses: actions/checkout@v2.4.0
- name: Remove uploaded files from server
uses: appleboy/ssh-action@master
with:
host: ${{ secrets.SSH_ARM_HOST }}
username: ubuntu
key: ${{ secrets.SSH_ARM_PRIVATE_KEY }}
fingerprint: ${{ secrets.SSH_ARM_FINGERPRINT }}
envs: REMOTE_DIR
script: rm -rf $REMOTE_DIR
+34
View File
@@ -0,0 +1,34 @@
name: Loadtest
on:
push:
branches:
- main
tags:
- v*
pull_request:
branches:
- main
jobs:
Loadtest-Nix:
name: Loadtest (Nix)
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v3
with:
fetch-depth: 0
- name: Setup Nix Environment
uses: ./.github/actions/setup-nix
with:
tools: loadtest
- name: Run loadtest
run: |
postgrest-loadtest-against main
postgrest-loadtest-report > loadtest/loadtest.md
- name: Upload report
uses: actions/upload-artifact@v3
with:
name: loadtest.md
path: loadtest/loadtest.md
if-no-files-found: error
+1 -1
View File
@@ -22,7 +22,7 @@ jobs:
name: loadtest.md
path: artifacts
- name: Upload to GitHub Checks
uses: LouisBrunner/checks-action@v1.2.0
uses: LouisBrunner/checks-action@v1.5.0
with:
token: ${{ secrets.GITHUB_TOKEN }}
sha: ${{ github.event.workflow_run.head_sha }}
+2
View File
@@ -21,3 +21,5 @@ __pycache__
*.tix
coverage
.hpc
loadtest
.history
+70
View File
@@ -0,0 +1,70 @@
# 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.
### Workers.hs
This spawns threads which are used to execute concurrent jobs.
Jobs include connection recovery, a listener for the PostgreSQL LISTEN command, and an admin server.
### 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.
+155 -1
View File
@@ -3,12 +3,166 @@
All notable changes to this project will be documented in this file.
This project adheres to [Semantic Versioning](http://semver.org/).
## Unreleased
## [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
## [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
- #1933, #2109, Add a minimal health check endpoint - @steve-chavez
+ For enabling this, the `admin-server-port` config must be set explictly
+ A `<host>:<admin_server_port>/live` endpoint is available for checking if postgrest is running on its port/socket. 200 OK = alive, 503 = dead.
+ A `<host>:<admin_server_port>/ready` endpoint is available for checking a correct internal state(the database connection plus the schema cache). 200 OK = ready, 503 = not ready.
- #1988, Add the current user to the request log on stdout - @DavidLindbom, @wolfgangwalther
- #1823, Add the ability to run postgrest without any configuration. - @wolfgangwalther
+ #1991, Add the ability to run without `db-uri` using libpq's PG environment variables to connect. - @wolfgangwalther
+ #1769, Add the ability to run without `db-schemas`, defaulting to `db-schemas=public`. - @wolfgangwalther
+ #1689, Add the ability to run without `db-anon-role` disabling anonymous access. - @wolfgangwalther
- #1543, Allow access to fields of composite types in select=, order= and filters through JSON operators -> and ->>. - @wolfgangwalther
- #2075, Allow access to array items in ?select=, ?order= and filters through JSON operators -> and ->>. - @wolfgangwalther
- #2156, #2211, Allow applying `limit/offset` to UPDATE/DELETE to only affect a subset of rows - @steve-chavez
+ It requires an explicit `order` on a unique column(s)
- #1917, Add error codes with the `"PGRST"` prefix to the error response body to differentiate PostgREST errors from PostgreSQL errors - @laurenceisla
- #1917, Normalize the error response body by always having the `detail` and `hint` error fields with a `null` value if they are empty - @laurenceisla
- #2176, Errors raised with `SQLSTATE` now include the message and the code in the response body - @laurenceisla
- #2236, Support POSIX regular expression operators for row filtering - @enote-kane
- #2202, Allow returning XML from RPCs - @fjf2002
- #2268, Allow returning XML from single-column queries - @fjf2002
- #2300, RPC POST for function w/single unnamed XML param #2300 - @fjf2002
- #1564, Allow geojson output by specifying the `Accept: application/geo+json` media type - @steve-chavez
+ Requires postgis >= 3.0
+ Works for GET, RPC, POST/PATCH/DELETE with `Prefer: return=representation`.
+ Resource embedding works and the embedded rows will go into the `properties` key
+ In case of multiple geometries in the same table, you can choose which one will go into the `geometry` key with the usual `?select` query parameter.
- #1082, Add security definitions to the OpenAPI output - @laurenceisla
- #2378, Support http OPTIONS method on RPC and root path - @steve-chavez
- #2354, Allow getting the EXPLAIN plan of a request by using the `Accept: application/vnd.pgrst.plan` header - @steve-chavez
+ Only allowed if the `db-plan-enabled` config is set to true
+ Can generate the plan for different media types using the `for` parameter: `Accept: application/vnd.pgrst.plan; for="application/vnd.pgrst.object"`
+ Different options for the plan can be used with the `options` parameter: `Accept: application/vnd.pgrst.plan; options=analyze|verbose|settings|buffers|wal`
+ The plan can be obtained in text or json by using different media type suffixes: `Accept: application/vnd.pgrst.plan+text` and `Accept: application/vnd.pgrst.plan+json`.
- #2144, Support computed relationships which allow extending and overriding relationships for resource embedding - @steve-chavez, @wolfgangwalther
- #1984, Detect one-to-one relationships for resource embedding - @steve-chavez
+ Detected when there's a foreign key with a unique constraint or when a foreign key is also a primary key
### Fixed
- #2058, Return 204 No Content without Content-Type for PUT - @wolfgangwalther
- #2107, Clarify error for failed schema cache load. - @steve-chavez
+ From `Database connection lost. Retrying the connection` to `Could not query the database for the schema cache. Retrying.`
- #1771, Fix silently ignoring filter on a non-existent embedded resource - @steve-chavez
- #2152, Remove functions, which are uncallable because of unnamend arguments from schema cache and OpenAPI output. - @wolfgangwalther
- #2145, Fix accessing json array fields with -> and ->> in ?select= and ?order=. - @wolfgangwalther
- #2155, Ignore `max-rows` on POST, PATCH, PUT and DELETE - @steve-chavez
- #2254, Fix inferring a foreign key column as a primary key column on views - @steve-chavez
- #2070, Restrict generated many-to-many relationships - @steve-chavez
+ Only adds many-to-many relationships when: a table has FKs to two other tables and these FK columns are part of the table's PK columns.
- #2278, Allow casting to types with underscores and numbers(e.g. `select=oid_array::_int4`) - @steve-chavez
- #2277, #2238, #1643, Prevent views from breaking one-to-many/many-to-one embeds when using column or FK as target - @steve-chavez
+ When using a column or FK as target for embedding(`/tbl?select=*,col-or-fk(*)`), only tables are now detected and views are not.
+ You can still use a column or an inferred FK on a view to embed a table(`/view?select=*,col-or-fk(*)`)
- #2317, Increase the `db-pool-timeout` to 1 hour to prevent frequent high connection latency - @steve-chavez
- #2341, The search path now correctly identifies schemas with uppercase and special characters in their names (regression) - @laurenceisla
- #2364, "404 Not Found" on nested routes and "405 Method Not Allowed" errors no longer start an empty database transaction - @steve-chavez
- #2342, Fix inaccurate result count when an inner embed was selected after a normal embed in the query string - @laurenceisla
- #2376, OPTIONS requests no longer start an empty database transaction - @steve-chavez
- #2395, Allow using columns with dollar sign($) without double quoting in filters and `select` - @steve-chavez
- #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
- #2001, Return 204 No Content without Content-Type for RPCs returning VOID - @wolfgangwalther
+ Previously, those RPCs would return "null" as a body with Content-Type: application/json.
- #2156, `limit/offset` now limits the affected rows on UPDATE/DELETE - @steve-chavez
+ Previously, `limit/offset` only limited the returned rows but not the actual updated rows
- #2155, `max-rows` is no longer applied on POST/PATCH/PUT/DELETE returned rows - @steve-chavez
+ This was misleading because the affected rows were not really affected by `max-rows`, only the returned rows were limited
- #2070, Restrict generated many-to-many relationships - @steve-chavez
+ A primary key that contains the foreign key columns is now needed for generating many-to-many relationships.
- #2277, Views now are not detected when embedding using the column or FK as target (`/view?select=*,column(*)`) - @steve-chavez
+ This embedding form was easily made ambiguous whenever a new view was added.
+ You can use computed relationships to keep this embedding form working
- #2312, Using `Prefer: return=representation` no longer returns a `Location` header - @laurenceisla
- #1984, For the cases where one to one relationships are detected, json objects will be returned instead of json arrays of length 1
+ If you wish to override this behavior, you can use computed relationships to return arrays again
## [9.0.1] - 2022-06-03
### Fixed
- #2165, Fix json/jsonb columns should not have type in OpenAPI spec - @clrnd
- #2020, Execute deferred constraint triggers when using `Prefer: tx=rollback` - @wolfgangwalther
- #2077, Fix `is` not working with upper or mixed case values like `NULL, TrUe, FaLsE` - @steve-chavez
- #2024, Fix schema cache loading when views with XMLTABLE and DEFAULT are present - @wolfgangwalther
- #1724, Fix wrong CORS header Authentication -> Authorization - @wolfgangwalther
- #2120, Fix reading database configuration properly when `=` is present in value - @wolfgangwalther
- #2135, Remove trigger functions from schema cache and OpenAPI output, because they can't be called directly anyway. - @wolfgangwalther
- #2101, Remove aggregates, procedures and window functions from the schema cache and OpenAPI output. - @wolfgangwalther
- #2153, Fix --dump-schema running with a wrong PG version. - @wolfgangwalther
- #2042, Keep working when EMFILE(Too many open files) is reached. - @steve-chavez
- #2147, Ignore `Content-Type` headers for `GET` requests when calling RPCs. - @laurenceisla
+ Previously, `GET` without parameters, but with `Content-Type: text/plain` or `Content-Type: application/octet-stream` would fail with `404 Not Found`, even if a function without arguments was available.
- #2239, Fix misleading disambiguation error where the content of the `relationship` key looks like valid syntax - @laurenceisla
- #2294, Disable parallel GC for better performance on higher core CPUs - @steve-chavez
- #1076, Fix using CPU while idle - @steve-chavez
## [9.0.0] - 2021-11-25
### Added
-3
View File
@@ -2,9 +2,6 @@
[![Donate](https://img.shields.io/badge/Donate-Patreon-orange.svg?colorB=F96854)](https://www.patreon.com/postgrest)
[![Donate](https://img.shields.io/badge/Donate-PayPal-green.svg)](https://www.paypal.me/postgrest)
<a href="https://heroku.com/deploy?template=https://github.com/PostgREST/postgrest">
<img src="https://img.shields.io/badge/%E2%86%91_Deploy_to-Heroku-7056bf.svg" alt="Deploy">
</a>
[![Join the chat at https://gitter.im/begriffs/postgrest](https://img.shields.io/badge/gitter-join%20chat%20%E2%86%92-brightgreen.svg)](https://gitter.im/begriffs/postgrest)
[![Docs](https://img.shields.io/badge/docs-latest-brightgreen.svg?style=flat)](http://postgrest.org)
[![Docker Stars](https://img.shields.io/docker/pulls/postgrest/postgrest.svg)](https://hub.docker.com/r/postgrest/postgrest/)
-59
View File
@@ -1,59 +0,0 @@
{
"name": "PostgREST",
"description": "RESTful API for any PostgreSQL database.",
"logo": "https://avatars2.githubusercontent.com/u/15115011",
"repository": "https://github.com/PostgREST/postgrest",
"env": {
"BUILDPACK_URL": {
"description": "Heroku buildpack for deploying Haskell applications",
"value": "https://github.com/PostgREST/postgrest-heroku"
},
"POSTGREST_VER": {
"description": "Version of PostgREST to deploy",
"value": "8.0.0"
},
"DB_URI": {
"description": "Database connection string, e.g. postgres://user:pass@xxxxxxx.rds.amazonaws.com/mydb",
"required": true
},
"DB_SCHEMA": {
"description": "The database schema to expose to REST clients. Tables, views and stored procedures in this schema will get API endpoints",
"required": true,
"value": "public"
},
"DB_ANON_ROLE": {
"description": "The database role to use when executing commands on behalf of unauthenticated clients",
"required": true
},
"DB_POOL": {
"description": "Number of connections to keep open in PostgRESTs database pool",
"required": false,
"value": "10"
},
"SERVER_PROXY_URI": {
"description": "Overrides the base URL used within the OpenAPI self-documentation hosted at the API root path",
"required": false
},
"JWT_SECRET": {
"description": "The secret used to decode JWT tokens clients provide for authentication",
"required": false
},
"SECRET_IS_BASE64": {
"description": "When this is set to true, the value derived from jwt-secret will be treated as a base64 encoded secret",
"required": false,
"value": "false"
},
"JWT_AUD": {
"description": "The audience that should be validated if the JWT token contains an aud claim",
"required": false
},
"MAX_ROWS": {
"description": "A hard limit to the number of rows PostgREST will fetch from a view, table, or stored procedure",
"required": false
},
"PRE_REQUEST": {
"description": "A schema-qualified stored procedure name to call right after switching roles for a client request",
"required": false
}
}
}
+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: 33ff97db570b5b432255f5f24a68db51453f6eb8
+20 -11
View File
@@ -1,9 +1,11 @@
{ system ? builtins.currentSystem }:
let
name =
"postgrest";
compiler =
"ghc8107";
"ghc924";
# PostgREST source files, filtered based on the rules in the .gitignore files
# and file extensions. We want to include as litte as possible, as the files
@@ -34,7 +36,8 @@ 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; })
@@ -42,16 +45,17 @@ let
# Evaluated expression of the Nixpkgs repository.
pkgs =
import nixpkgs { inherit overlays; };
import nixpkgs { inherit overlays system; };
postgresqlVersions =
[
{ name = "postgresql-14"; postgresql = pkgs.postgresql_14; }
{ name = "postgresql-13"; postgresql = pkgs.postgresql_13; }
{ name = "postgresql-12"; postgresql = pkgs.postgresql_12; }
{ name = "postgresql-11"; postgresql = pkgs.postgresql_11; }
{ name = "postgresql-10"; postgresql = pkgs.postgresql_10; }
{ name = "postgresql-9.6"; postgresql = pkgs.postgresql_9_6; }
{ 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 ]); }
{ name = "postgresql-11"; postgresql = pkgs.postgresql_11.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
{ name = "postgresql-10"; postgresql = pkgs.postgresql_10.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
{ name = "postgresql-9.6"; postgresql = pkgs.postgresql_9_6.withPackages (p: [ p.postgis p.pg_safeupdate ]); }
];
patches =
@@ -64,7 +68,7 @@ let
# Function that derives a fully static Haskell package based on
# nh2/static-haskell-nix
staticHaskellPackage =
import nix/static-haskell-package.nix { inherit nixpkgs compiler patches allOverlays; };
import nix/static-haskell-package.nix { inherit nixpkgs system compiler patches allOverlays; };
# Options passed to cabal in dev tools and tests
devCabalOptions =
@@ -123,6 +127,10 @@ rec {
docker =
pkgs.callPackage nix/tools/docker { postgrest = postgrestStatic; };
# Load testing tools.
loadtest =
pkgs.callPackage nix/tools/loadtest.nix { inherit withTools; };
# Script for running memory tests.
memory =
pkgs.callPackage nix/tools/memory.nix { inherit postgrestProfiled withTools; };
@@ -145,8 +153,9 @@ rec {
inherit postgrest devCabalOptions withTools;
ghc = pkgs.haskell.compiler."${compiler}";
inherit (pkgs.haskell.packages."${compiler}") hpc-codecov;
inherit (pkgs.haskell.packages."${compiler}") weeder;
};
withTools =
pkgs.callPackage nix/tools/withTools.nix { inherit postgresqlVersions; };
pkgs.callPackage nix/tools/withTools.nix { inherit devCabalOptions postgresqlVersions postgrest; };
}
+1 -6
View File
@@ -2,15 +2,11 @@
module Main (main) where
import qualified Data.Map.Strict as M
import System.IO (BufferMode (..), hSetBuffering)
import qualified PostgREST.App as App
import qualified PostgREST.CLI as CLI
import PostgREST.Config (readPGRSTEnvironment)
import Protolude
#ifndef mingw32_HOST_OS
@@ -20,8 +16,7 @@ import qualified PostgREST.Unix as Unix
main :: IO ()
main = do
setBuffering
hasPGRSTEnv <- not . M.null <$> readPGRSTEnvironment
opts <- CLI.readCLIShowHelp hasPGRSTEnv
opts <- CLI.readCLIShowHelp
CLI.main installSignalHandlers runAppInSocket opts
installSignalHandlers :: App.SignalHandlerInstaller
+51 -3
View File
@@ -149,13 +149,13 @@ the PostgREST repo. Paths are resolved relative to the repo root:
$ cd src
# Even though the current directory is ./src, the config path must still start
# from the repo root:
$ postgrest-run test/io-tests/configs/simple.conf
$ postgrest-run test/io/configs/simple.conf
```
## Testing
In nix-shell, you'll find utility scripts that make it very easy to run the
Haskell test suite, including setting up all required dependencies and
In nix-shell, you'll find utility scripts that make it very easy to run our
test suite, including setting up all required dependencies and
temporary test databases:
```bash
@@ -182,7 +182,55 @@ 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
```
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
# Run the memory test
postgrest-test-memory
```
The loadtests ensure that performance doesn't drop on a change. Underlyingly they use
[vegeta](https://github.com/tsenart/vegeta).
```bash
# Run the loadtests on the latest commit(HEAD)
postgrest-loadtest
# You can loadtest comparing to a different branch
postgrest-loadtest-against master
# 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
```
doctests for some of our modules are also available:
```bash
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.
```bash
# Will run all the tests and produce a coverage dir
postgrest-coverage
# Visualize the output
cd coverage
python -mSimpleHTTPServer 8080
```
## Linting and styling code
+8 -8
View File
@@ -24,21 +24,22 @@ import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Dot
import qualified GHC
import qualified GHC.Paths
import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint
import qualified Options.Applicative as O
import qualified System.FilePath as FP
import Bag (bagToList)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Function ((&))
import Data.List (intercalate)
import Data.Maybe (catMaybes, mapMaybe)
import Data.Text (Text)
import GHC.Data.Bag (bagToList)
import GHC.Generics (Generic)
import GHC.Hs.Extension (GhcPs)
import Module (moduleNameString)
import OccName (occNameString)
import RdrName (rdrNameOcc)
import GHC.Types.Name.Occurrence (occNameString)
import GHC.Types.Name.Reader (rdrNameOcc)
import GHC.Unit.Module.Name (moduleNameString)
import System.Directory.Recursive (getFilesRecursive)
import System.Exit (exitFailure)
@@ -197,11 +198,11 @@ sourceSymbols source = do
return $ concatMap (importSymbols source filepath . GHC.unLoc) hsmodImports
-- | Parse a Haskell module
parseModule :: String -> IO (GHC.HsModule GhcPs)
parseModule :: FilePath -> IO GHC.HsModule
parseModule filepath = do
result <- ExactPrint.parseModule filepath
result <- ExactPrint.parseModule GHC.Paths.libdir filepath
case result of
Right (_, hsmod) ->
Right hsmod ->
return $ GHC.unLoc hsmod
Left errs ->
fail $ "Errors with " <> show filepath <> ":\n "
@@ -212,7 +213,6 @@ parseModule filepath = do
-- If the import is a wildcard, i.e. no symbols are selected for import, then
-- only one item is returned.
importSymbols :: FilePath -> FilePath -> GHC.ImportDecl GhcPs -> [ImportedSymbol]
importSymbols _ _ (GHC.XImportDecl _) = mempty
importSymbols source filepath GHC.ImportDecl{..} =
case ideclHiding of
Just (hiding, syms) ->
+8 -3
View File
@@ -16,15 +16,20 @@ let
ghc = ghcWithPackages modules;
hsie =
runCommand "haskellimports" { inherit name src; }
"${ghc}/bin/ghc -O -Werror -Wall -package ghc $src -o $out";
''
cd $TMP
cp $src $TMP/Main.hs
${ghc}/bin/ghc -O -Werror -Wall -package ghc Main.hs -o Main
cp Main $out
'';
bin =
runCommand name { inherit hsie name; }
''
mkdir -p $out/bin
ln -s $hsie $out/bin/$name
'';
bashCompletion =
bash-completion =
runCommand "${name}-bash-completion" { inherit bin name; }
"$bin/bin/$name --bash-completion-script $bin/bin/$name > $out";
in
hsie // { inherit bashCompletion bin; }
hsie // { inherit bash-completion bin; }
+3 -3
View File
@@ -1,6 +1,6 @@
# Pinned version of Nixpkgs, generated with postgrest-nixpkgs-upgrade.
{
date = "2021-11-02";
rev = "7053541084bf5ce2921ef307e5585d39d7ba8b3f";
tarballHash = "1flhh5d4zy43x6060hvzjb5hi5cmc51ivc0nwmija9n8d35kcc4x";
date = "2022-10-28";
rev = "f44ba1be526c8da9e79a5759feca2365204003f6";
tarballHash = "0npbwsdjw88py5w2pjflwh94wgi4jmnmls0k1n7q8m6h94w1y1ps";
}
+3 -3
View File
@@ -1,11 +1,11 @@
# Creates an environment that exposes bashCompletion arguments from all checkedShellScripts
# Creates an environment that exposes bash-completion arguments from all checkedShellScripts
{ buildEnv }:
{ name
, tools
, extra ? { }
}:
let
bashCompletion = builtins.map (tool: tool.bashCompletion) tools;
bash-completion = builtins.map (tool: tool.bash-completion) tools;
env = buildEnv {
inherit name;
@@ -13,4 +13,4 @@ let
};
in
env // { inherit bashCompletion; } // extra
env // { inherit bash-completion; } // extra
@@ -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
@@ -14,7 +14,7 @@
{ name
, docs
, args ? [ ]
, addCommandCompletion ? false
, positionalCompletion ? ""
, inRootDir ? false
, redirectTixFiles ? true
, withEnv ? null
@@ -22,11 +22,10 @@
, withTmpDir ? false
}: text:
let
# square brackets are a pain to escape - if even possible. just don't use them...
escape = builtins.replaceStrings [ "\n" ] [ " \\n" ];
argsTemplate =
let
# square brackets are a pain to escape - if even possible. just don't use them...
escapedDocs = builtins.replaceStrings [ "\n" ] [ " \\n" ] docs;
in
writeTextFile {
inherit name;
destination = "/${name}.m4"; # destination is needed to have the proper basename for completion
@@ -37,7 +36,7 @@ let
# stripping the /nix/store/... path for nicer display
BASH_ARGV0="$(basename "$0")"
# ARG_HELP([${name}], [${escapedDocs}])
# ARG_HELP([${name}], [${escape docs}])
${lib.strings.concatMapStrings (arg: "# " + arg) args}
# ARG_POSITIONAL_DOUBLEDASH()
# ARG_DEFAULTS_POS()
@@ -59,14 +58,14 @@ let
sed '/_positionals_count + 1/a\\t\t\t\tset -- "''${@:1:1}" "--" "''${@:2}"' -i $out
'';
bashCompletion =
bash-completion =
runCommand "${name}-completion" { } (
''
${argbash}/bin/argbash --type completion --strip all ${argsTemplate}/${name}.m4 > $out
''
+ lib.optionalString addCommandCompletion ''
sed 's/COMPREPLY.*compgen -o bashdefault .*$/_command/' -i $out
+ lib.optionalString (positionalCompletion != "") ''
sed 's#COMPREPLY.*compgen -o bashdefault .*$#${escape positionalCompletion}#' -i $out
''
);
@@ -78,7 +77,7 @@ let
text =
''
#!${bash_5}/bin/bash
#!${bash}/bin/bash
source ${argsParser}
set -euo pipefail
''
@@ -139,4 +138,4 @@ let
script =
runCommand name { inherit bin name; } "ln -s $bin/bin/$name $out";
in
script // { inherit bin bashCompletion; }
script // { inherit bin bash-completion; }
+1
View File
@@ -3,6 +3,7 @@
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;
+2 -2
View File
@@ -12,8 +12,8 @@ self: super:
gitignoreSrc = super.fetchFromGitHub {
owner = "hercules-ci";
repo = "gitignore";
rev = "211907489e9f198594c0eb0ca9256a1949c9d412";
sha256 = "06j7wpvj54khw0z10fjyi31kpafkr6hi1k0di13k1xp8kywvfyx8";
rev = "a20de23b925fd8264fd7fad6454652e142fd7f73";
sha256 = "sha256-8DFJjXG8zqoONA1vXtgeKXy68KdJL5UaXR8NtVMUbx8=";
};
in
(super.callPackage gitignoreSrc { }).gitignoreSource;
+38 -10
View File
@@ -13,21 +13,49 @@ 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 {
# owner = "<owner>";
# repo = "<repo>";
# rev = "<commit>";
# sha256 = "<sha256>";
# }) "--subpath=<subpath>" {};
#
# To fill in the sha256:
# update-nix-fetchgit nix/overlays/haskell-packages.nix
hasql-dynamic-statements =
lib.dontCheck (lib.unmarkBroken prev.hasql-dynamic-statements);
hashtables = lib.dontCheck prev.hashtables_1_3_1;
hasql = lib.dontCheck prev.hasql_1_6_1_4;
hasql-dynamic-statements = lib.dontCheck prev.hasql-dynamic-statements_0_3_1_2;
hasql-pool = lib.dontCheck
(prev.callHackageDirect
{
pkg = "hasql-pool";
ver = "0.8.0.6";
sha256 = "sha256-2u/cwPk8XfXffaDRzGeyzhL+9k2+2T4b8bGOZwz8AX0=";
}
{ });
hasql-transaction = lib.dontCheck prev.hasql-transaction_1_0_1_2;
isomorphism-class = lib.unmarkBroken prev.isomorphism-class;
lens = lib.dontCheck prev.lens_5_2;
postgresql-binary = lib.dontCheck prev.postgresql-binary_0_13_1;
text-builder = lib.dontCheck prev.text-builder_0_6_7;
text-builder-dev = lib.dontCheck prev.text-builder-dev_0_3_3;
hasql-implicits =
lib.dontCheck (lib.unmarkBroken prev.hasql-implicits);
ptr =
lib.dontCheck (lib.unmarkBroken prev.ptr);
postgresql-libpq = lib.dontCheck
(prev.callCabal2nix "postgresql-libpq"
(super.fetchFromGitHub {
owner = "PostgREST";
repo = "postgresql-libpq";
rev = "cef92cb4c07b56568dffdbf4b719258b82183119"; # master
sha256 = "0r59klrz47qcnd22s47h612mlz3jbg40wwalfj3f6djwg0cdyr85";
})
{ });
} // 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 ];
});
}
+28 -14
View File
@@ -2,19 +2,33 @@ self: super:
# Overlay that adds legacy versions of PostgreSQL that are supported by
# PostgREST.
{
# PostgreSQL 9.5 was removed from Nixpkgs with
# https://github.com/NixOS/nixpkgs/commit/72ab382fb6b729b0d654f2c03f5eb25b39f11fbb
# PostgreSQL 9.6 was removed from Nixpkgs with
# https://github.com/NixOS/nixpkgs/commit/757dd008b2f2926fc0f7688fa8189f930ea47521
# We pin its parent commit to get the last version that was available.
# postgresql_9_5 =
# let
# rev = "55ac7d4580c9ab67848c98cb9519317a1cc399c8";
# tarballHash = "02ffj9f8s1hwhmxj85nx04sv64qb6jm7w0122a1dz9n32fymgklj";
#
# pinnedPkgs =
# builtins.fetchTarball {
# url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
# sha256 = tarballHash;
# };
# in
# (import pinnedPkgs { }).pkgs.postgresql_9_5;
postgresql_9_6 =
let
rev = "571cbf3d1db477058303cef8754fb85a14e90eb7";
tarballHash = "0q74wn418i1bn5sssacmw8ykpmqvzr0s93sj6pbs3rf6bf134fkz";
pinnedPkgs =
builtins.fetchTarball {
url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz";
sha256 = tarballHash;
};
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;
}
+8 -3
View File
@@ -18,7 +18,12 @@
done
'';
# See: https://github.com/NixOS/nixpkgs/pull/87879
nixpkgs-openssl-split-runtime-dependencies-of-static-builds =
./nixpkgs-openssl-split-runtime-dependencies-of-static-builds.patch;
static-haskell-nix-ncurses =
./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;
}
@@ -1,76 +0,0 @@
diff --git a/pkgs/development/libraries/openssl/default.nix b/pkgs/development/libraries/openssl/default.nix
index d4be8cc2428..3979698711f 100644
--- a/pkgs/development/libraries/openssl/default.nix
+++ b/pkgs/development/libraries/openssl/default.nix
@@ -50,9 +50,21 @@ let
substituteInPlace crypto/async/arch/async_posix.h \
--replace '!defined(__ANDROID__) && !defined(__OpenBSD__)' \
'!defined(__ANDROID__) && !defined(__OpenBSD__) && 0'
+ '' + optionalString static
+ # On static builds, the ENGINESDIR will be empty, but its path will be
+ # compiled into the library. In order to minimize the runtime dependencies
+ # of packages that statically link openssl, we move it into the OPENSSLDIR,
+ # which will be separated into the 'etc' output.
+ ''
+ substituteInPlace Configurations/unix-Makefile.tmpl \
+ --replace 'ENGINESDIR=$(libdir)/engines-{- $sover_dirname -}' \
+ 'ENGINESDIR=$(OPENSSLDIR)/engines-{- $sover_dirname -}'
'';
- outputs = [ "bin" "dev" "out" "man" ] ++ optional withDocs "doc";
+ outputs = [ "bin" "dev" "out" "man" ]
+ ++ optional withDocs "doc"
+ # Separate output for the runtime dependencies of the static build.
+ ++ optional static "etc";
setOutputFlags = false;
separateDebugInfo =
!stdenv.hostPlatform.isDarwin &&
@@ -101,7 +113,17 @@ let
configureFlags = [
"shared" # "shared" builds both shared and static libraries
"--libdir=lib"
- "--openssldir=etc/ssl"
+ (if !static then
+ "--openssldir=etc/ssl"
+ else
+ # Separate the OPENSSLDIR into its own output, as its path will be
+ # compiled into 'libcrypto.a'. This makes it a runtime dependency of
+ # any package that statically links openssl, so we want to keep that
+ # output minimal. We need to prepend '/.' to the path in order to make
+ # it appear absolute before variable expansion, the 'prefix' would be
+ # prepended to it otherwise.
+ "--openssldir=/.$(etc)/etc/ssl"
+ )
] ++ lib.optionals withCryptodev [
"-DHAVE_CRYPTODEV"
"-DUSE_CRYPTODEV_DIGESTS"
@@ -131,6 +153,9 @@ let
if [ -n "$(echo $out/lib/*.so $out/lib/*.dylib $out/lib/*.dll)" ]; then
rm "$out/lib/"*.a
fi
+
+ # 'etc' is a separate output on static builds only.
+ etc=$out
'' + lib.optionalString (!stdenv.hostPlatform.isWindows)
# Fix bin/c_rehash's perl interpreter line
#
@@ -152,14 +177,15 @@ let
mv $out/include $dev/
# remove dependency on Perl at runtime
- rm -r $out/etc/ssl/misc
+ rm -r $etc/etc/ssl/misc
- rmdir $out/etc/ssl/{certs,private}
+ rmdir $etc/etc/ssl/{certs,private}
'';
postFixup = lib.optionalString (!stdenv.hostPlatform.isWindows) ''
- # Check to make sure the main output doesn't depend on perl
- if grep -r '${buildPackages.perl}' $out; then
+ # Check to make sure the main output and the static runtime dependencies
+ # don't depend on perl
+ if grep -r '${buildPackages.perl}' $out $etc; then
echo "Found an erroneous dependency on perl ^^^" >&2
exit 1
fi
+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 70afbbc..28cb0e9 100644
--- a/survey/default.nix
+++ b/survey/default.nix
@@ -81,6 +81,7 @@ let
# `.override` and the likes).
isProperHaskellPackage = val:
lib.isDerivation val && # must pass lib.isDerivation
+ val.pname != "ghc-bignum" &&
val ? env; # must have an .env key
# Function that tells us if a given Haskell package has an executable.
@@ -0,0 +1,13 @@
diff --git a/survey/default.nix b/survey/default.nix
index 46d8066..a47f214 100644
--- a/survey/default.nix
+++ b/survey/default.nix
@@ -1519,7 +1519,7 @@ let
[
"--enable-executable-static" # requires `useFixedCabal`
# `enableShared` seems to be required to avoid `recompile with -fPIC` errors on some packages.
- "--extra-lib-dirs=${final.ncurses.override { enableStatic = true; enableShared = true; }}/lib"
+ "--extra-lib-dirs=${final.ncurses.override { enableStatic = true; }}/lib"
]
# TODO Figure out why this and the below libffi are necessary.
# `working` and `workingStackageExecutables` don't seem to need that,
@@ -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; });
+8 -13
View File
@@ -1,5 +1,5 @@
# Derive a fully static Haskell package based on musl instead of glibc.
{ nixpkgs, compiler, patches, allOverlays }:
{ nixpkgs, system, compiler, patches, allOverlays }:
name: src:
let
@@ -17,14 +17,9 @@ let
patches.applyPatches "patched-static-haskell-nix"
static-haskell-nix
[
# No patches currently required.
];
patchedNixpkgs =
patches.applyPatches "patched-nixpkgs"
nixpkgs
[
patches.nixpkgs-openssl-split-runtime-dependencies-of-static-builds
patches.static-haskell-nix-ncurses
patches.static-haskell-nix-ghc-bignum
patches.static-haskell-nix-openssl
];
extraOverrides =
@@ -40,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
@@ -50,13 +45,13 @@ let
)
];
# Apply our overlay to the given pkgs.
# Apply our overlay to nixpkgs.
normalPkgs =
import patchedNixpkgs { inherit overlays; };
import nixpkgs { inherit overlays system; };
defaultCabalPackageVersionComingWithGhc =
{
ghc8107 = "Cabal_3_2_1_0";
ghc924 = "Cabal_3_6_3_0";
}."${compiler}";
# The static-haskell-nix 'survey' derives a full static set of Haskell
+2
View File
@@ -28,6 +28,8 @@ let
''
# clean old coverage data, too
rm -rf .hpc coverage
# clean old hie files
find . -name "*.hie" -type f -delete
exec ${cabal-install}/bin/cabal v2-clean
'';
+160 -7
View File
@@ -4,7 +4,10 @@
, checkedShellScript
, devCabalOptions
, entr
, git
, gnugrep
, graphviz
, haskellPackages
, hsie
, nix
, silver-searcher
@@ -29,7 +32,7 @@ let
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
"ARG_LEFTOVERS([command arguments])"
];
addCommandCompletion = true;
positionalCompletion = "_command";
redirectTixFiles = false; # will be done by sub-command
inRootDir = true;
}
@@ -64,23 +67,172 @@ let
name = "postgrest-check";
docs =
''
Run most checks that will also run on CI.
Run most checks that will also run on CI, but only against the
latest PostgreSQL version.
This currently excludes the memory tests, as those are particularly
expensive.
This currently excludes the memory and spec-idempotence tests,
as those are particularly expensive.
'';
inRootDir = true;
}
''
${withTools}/bin/postgrest-with-all ${tests}/bin/postgrest-test-spec
${withTools}/bin/postgrest-with-all ${tests}/bin/postgrest-test-querycost
${tests}/bin/postgrest-test-spec
${tests}/bin/postgrest-test-querycost
${tests}/bin/postgrest-test-doctests
${tests}/bin/postgrest-test-spec-idempotence
${tests}/bin/postgrest-test-io
${style}/bin/postgrest-lint
${style}/bin/postgrest-style-check
'';
gitHooks =
let
name = "postgrest-git-hooks";
in
checkedShellScript
{
inherit name;
docs =
''
Enable or disable git pre-commit and pre-push hooks.
Basic is faster and will only run:
- pre-commit: postgrest-style
- pre-push: postgrest-lint
Full takes a lot more time and will run:
- pre-commit: postgrest-style && postgrest-lint
- pre-push: postgrest-check
Changes made by postgrest-style will be staged automatically.
Example usage:
postgrest-git-hooks disable
postgrest-git-hooks enable basic
postgrest-git-hooks enable full
The "run" operation and "--hook" argument are only used internally.
'';
args =
[
"ARG_POSITIONAL_SINGLE([operation], [Operation])"
"ARG_TYPE_GROUP_SET([OPERATION], [OPERATION], [operation], [disable,enable,run])"
"ARG_POSITIONAL_SINGLE([mode], [Mode], [basic])"
"ARG_TYPE_GROUP_SET([MODE], [MODE], [mode], [basic,full])"
"ARG_OPTIONAL_SINGLE([hook], , [Hook], [pre-commit])"
"ARG_TYPE_GROUP_SET([HOOK], [HOOK], [hook], [pre-commit,pre-push])"
];
positionalCompletion =
''
if test "$prev" == "${name}"; then
COMPREPLY=( $(compgen -W "enable disable" -- "$cur") )
elif test "$prev" == "enable" || test "$prev" == "disable"; then
COMPREPLY=( $(compgen -W "basic full" -- "$cur") )
fi
'';
inRootDir = true;
}
''
if [ run != "$_arg_operation" ]; then
# Remove all hooks first and ignore failures because the file might be missing.
# This assumes that we're only adding lines that include "postgrest-git-hooks"
# to the hook file.
sed -i -e '/postgrest-git-hooks/d' .git/hooks/pre-{commit,push} 2> /dev/null || true
if [ disable != "$_arg_operation" ]; then
# The nix-shell && + nix-shell || pattern makes sure we can run the hook
# in a pure nix-shell, where nix-shell itself is not available, too.
# The $(nix-shell --run "command -v ...") pattern ensures we only need to enable
# the hooks once and still run the latest of our hook scripts, even when we
# update them in the repo.
echo 'command -v nix-shell > /dev/null || postgrest-git-hooks --hook=pre-commit run' "$_arg_mode" \
>> .git/hooks/pre-commit
# shellcheck disable=SC2016
echo 'command -v nix-shell > /dev/null && $(nix-shell --quiet -Q --run "command -v postgrest-git-hooks") --hook=pre-commit run' "$_arg_mode" \
>> .git/hooks/pre-commit
chmod +x .git/hooks/pre-commit
echo 'command -v nix-shell > /dev/null || postgrest-git-hooks --hook=pre-push run' "$_arg_mode" \
>> .git/hooks/pre-push
# shellcheck disable=SC2016
echo 'command -v nix-shell > /dev/null && $(nix-shell --quiet -Q --run "command -v postgrest-git-hooks") --hook=pre-push run' "$_arg_mode" \
>> .git/hooks/pre-push
chmod +x .git/hooks/pre-push
fi
else
# When run from a git hook, the GIT_ environment variables conflict with our withGit helper.
# The following unsets all GIT_ variables.
unset "''${!GIT_@}"
function restore () {
ref="$(git stash list --format=format:%gD --grep "$1" -n1)"
# this will avoid merge conflicts when applying the stash
${git}/bin/git restore --source="$ref" .
# restore untracked files, too. could fail with no files
if [ "$(git show --numstat --format=oneline "$ref^3" | wc -l)" -gt 1 ]; then
${git}/bin/git restore --overlay --source="$ref^3" .
fi
${git}/bin/git stash drop "$ref"
}
case "$_arg_mode" in
basic)
case "$_arg_hook" in
pre-commit)
# To be able to automatically add only changes from postgrest-style to the staging area,
# we need to run postgrest-style twice. Otherwise we'd risk merge conflicts when popping
# the stash afterwards.
${style}/bin/postgrest-style
stash="postgrest-git-hooks-$RANDOM"
${git}/bin/git stash push --include-untracked --keep-index -m "$stash"
if [ "$(git stash list --grep $stash)" ]; then
# Only create the stash pop trap, if we actually created a stash.
# Otherwise stash pop will cause havoc.
trap 'restore "$stash"' EXIT
fi
${style}/bin/postgrest-style
${git}/bin/git add .
;;
pre-push)
# Create a clean working tree without any uncomitted changes.
${withTools.withGit} HEAD ${style}/bin/postgrest-lint
;;
esac
;;
full)
case "$_arg_hook" in
pre-commit)
# To be able to automatically add only changes from postgrest-style to the staging area,
# we need to run postgrest-style twice. Otherwise we'd risk merge conflicts when popping
# the stash afterwards.
${style}/bin/postgrest-style
stash="postgrest-git-hooks-$RANDOM"
${git}/bin/git stash push --include-untracked --keep-index -m "$stash"
if [ "$(git stash list --grep $stash)" ]; then
# Only create the stash pop trap, if we actually created a stash.
# Otherwise stash pop will cause havoc.
trap 'restore "$stash"' EXIT
fi
${style}/bin/postgrest-style
${git}/bin/git add .
${style}/bin/postgrest-lint
;;
pre-push)
# Create a clean working tree without any uncomitted changes.
${withTools.withGit} HEAD ${check}
;;
esac
;;
esac
fi
'';
dumpMinimalImports =
checkedShellScript
{
@@ -146,6 +298,7 @@ buildToolbox
watch
pushCachix
check
gitHooks
dumpMinimalImports
hsieMinimalImports
hsieGraphModules
+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.
+178
View File
@@ -0,0 +1,178 @@
{ buildToolbox
, checkedShellScript
, jq
, python3Packages
, vegeta
, withTools
, writers
}:
let
runner =
checkedShellScript
{
name = "postgrest-loadtest-runner";
docs = "Run vegeta. Assume PostgREST to be running.";
args = [
"ARG_LEFTOVERS([additional vegeta arguments])"
"ARG_USE_ENV([PGRST_SERVER_UNIX_SOCKET], [], [Unix socket to connect to running PostgREST instance])"
];
}
''
# ARG_USE_ENV only adds defaults or docs for environment variables
# We manually implement a required check here
# See also: https://github.com/matejak/argbash/issues/80
: "''${PGRST_SERVER_UNIX_SOCKET:?PGRST_SERVER_UNIX_SOCKET is required}"
${vegeta}/bin/vegeta -cpus 1 attack \
-unix-socket "$PGRST_SERVER_UNIX_SOCKET" \
-max-workers 1 \
-workers 1 \
-rate 0 \
-duration 60s \
"''${_arg_leftovers[@]}"
'';
loadtest =
checkedShellScript
{
name = "postgrest-loadtest";
docs = "Run the vegeta loadtests with PostgREST.";
args = [
"ARG_OPTIONAL_SINGLE([output], [o], [Filename to dump json output to], [./loadtest/result.bin])"
"ARG_OPTIONAL_SINGLE([testdir], [t], [Directory to load tests and fixtures from], [./test/load])"
"ARG_LEFTOVERS([additional vegeta arguments])"
];
inRootDir = true;
}
''
# previously required settings to make this work with older branches
export PGRST_DB_ANON_ROLE="postgrest_test_anonymous"
export PGRST_DB_URI="postgresql://"
export PGRST_DB_SCHEMAS="test"
export PGRST_DB_CONFIG="false"
export PGRST_DB_POOL="1"
export PGRST_DB_TX_END="rollback-allow-override"
export PGRST_LOG_LEVEL="crit"
mkdir -p "$(dirname "$_arg_output")"
# shellcheck disable=SC2145
${withTools.withPg} --fixtures "$_arg_testdir"/fixtures.sql \
${withTools.withPgrst} \
sh -c "cd \"$_arg_testdir\" && ${runner} -targets targets.http -output \"$_arg_output\" \"''${_arg_leftovers[@]}\""
${vegeta}/bin/vegeta report -type=text "$_arg_output"
'';
loadtestAgainst =
let
name = "postgrest-loadtest-against";
in
checkedShellScript
{
inherit name;
docs =
''
Run the vegeta loadtest twice:
- once on the <target> branch
- once in the current worktree
'';
args = [
"ARG_POSITIONAL_SINGLE([target], [Commit-ish reference to compare with])"
"ARG_LEFTOVERS([additional vegeta arguments])"
];
positionalCompletion =
''
if test "$prev" == "${name}"; then
__gitcomp_nl "$(__git_refs)"
fi
'';
inRootDir = true;
}
''
cat << EOF
Running loadtest on "$_arg_target"...
EOF
# Runs the test files from the current working tree
# to make sure both tests are run with the same files.
# 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[@]}"
cat << EOF
Done running on "$_arg_target".
EOF
cat << EOF
Running loadtest on HEAD...
EOF
${loadtest} --output "$PWD/loadtest/head.bin" --testdir "$PWD/test/load" "''${_arg_leftovers[@]}"
cat << EOF
Done running on HEAD.
EOF
'';
reporter =
checkedShellScript
{
name = "postgrest-loadtest-reporter";
docs = "Create a named json report for a single result file.";
args = [
"ARG_POSITIONAL_SINGLE([file], [Filename of result to create report for])"
"ARG_LEFTOVERS([additional vegeta arguments])"
];
inRootDir = true;
}
''
${vegeta}/bin/vegeta report -type=json "$_arg_file" \
| ${jq}/bin/jq --arg branch "$(basename "$_arg_file" .bin)" '. + {branch: $branch}'
'';
toMarkdown =
writers.writePython3 "postgrest-loadtest-to-markdown"
{
libraries = [ python3Packages.pandas python3Packages.tabulate ];
}
''
import sys
import pandas as pd
pd.read_json(sys.stdin) \
.set_index('param') \
.drop(['branch', 'earliest', 'end', 'latest']) \
.convert_dtypes() \
.to_markdown(sys.stdout, floatfmt='.0f')
'';
report =
checkedShellScript
{
name = "postgrest-loadtest-report";
docs = "Create a report of all loadtest reports as markdown.";
inRootDir = true;
}
''
find loadtest -type f -iname '*.bin' -exec ${reporter} {} \; \
| ${jq}/bin/jq '[leaf_paths as $path | {param: $path | join("."), (.branch): getpath($path)}]' \
| ${jq}/bin/jq --slurp 'flatten | group_by(.param) | map(add)' \
| ${toMarkdown}
'';
in
buildToolbox {
name = "postgrest-loadtest";
tools = [ loadtest loadtestAgainst report ];
}
+1 -1
View File
@@ -17,7 +17,7 @@ let
withPath = [ postgrestProfiled curl ];
}
''
${withTools.latest} test/memory-tests.sh
${withTools.withPg} test/memory/memory-tests.sh
'';
in
+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}.
+84 -2
View File
@@ -40,15 +40,97 @@ 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} \
--data-urlencode full_description@${fullDescription}
'';
release =
checkedShellScript
{
name = "postgrest-release";
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 "" ERR
trap "echo You have uncommitted changes in postgrest.cabal. Exiting ..." ERR
git diff --exit-code HEAD postgrest.cabal > /dev/null
trap "" ERR
current_version="$(grep -oP '^version:\s*\K.*' postgrest.cabal)"
# shellcheck disable=SC2034
IFS=. read -r major minor patch pre <<< "$current_version"
echo "Current version is $current_version"
today_date="$(date '+%Y%m%d')"
today_date_for_changelog="$(date '+%Y-%m-%d')"
bump_pre="$major.$minor.$patch.$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
case "$REPLY" in
1|2|3|4)
echo "Selected $new_version"
break
;;
*)
echo "Invalid option $REPLY"
;;
esac
done
echo "Updating postgrest.cabal ..."
sed -i -E "s/^(version:\s+).*$/\1$new_version/" postgrest.cabal > /dev/null
echo "Committing ..."
git add postgrest.cabal > /dev/null
if [[ "$new_version" != "$bump_pre" ]]; 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
remote="$(git remote -v | grep PostgREST/postgrest | grep push | cut -f1)"
trap "" ERR
push="git push --atomic $remote main 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
y|Y)
$push
;;
*)
echo "Aborting ..."
;;
esac
'';
in
buildToolbox
{
name = "postgrest-release";
tools = [ dockerHubDescription ];
tools = [ dockerHubDescription release ];
}
@@ -55,7 +55,7 @@ write from scratch.
# Usage
To learn how to use this container, see the [PostgREST Docker
documentation](https://postgrest.com/en/stable/install.html#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).
@@ -66,5 +66,5 @@ 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
no commands are listed in the image history. See the [PostgREST
respository](https://github.com/PostgREST/postgrest/tree/main/nix/docker) for
respository](https://github.com/PostgREST/postgrest/tree/main/nix/tools/docker) for
details on the build process and how to inspect the image.
+4 -3
View File
@@ -44,7 +44,9 @@ let
''
${style}
${git}/bin/git diff-index --exit-code HEAD -- '*.hs' '*.lhs' '*.nix'
trap "echo postgrest-style-check failed. Run postgrest-style to fix issues automatically." ERR
${git}/bin/git diff-index --exit-code HEAD -- '*.hs' '*.lhs' '*.nix' '*.py'
'';
lint =
@@ -67,8 +69,7 @@ let
echo "Linting bash scripts..."
${shellcheck}/bin/shellcheck \
.github/get_cirrusci_freebsd \
.github/release \
test/with_tmp_db
.github/release
echo "Linting workflows..."
${actionlint}/bin/actionlint
+96 -60
View File
@@ -3,14 +3,17 @@
, checkedShellScript
, devCabalOptions
, ghc
, glibcLocales
, glibcLocales ? null
, gnugrep
, haskell
, hpc-codecov
, hostPlatform
, jq
, lib
, postgrest
, python3
, runtimeShell
, stdenv
, weeder
, withTools
, yq
}:
@@ -19,12 +22,14 @@ let
checkedShellScript
{
name = "postgrest-test-spec";
docs = "Run the Haskell test suite";
docs = "Run the Haskell test suite. Use --match PATTERN for running individual specs";
args = [ "ARG_LEFTOVERS([hspec arguments])" ];
inRootDir = true;
withEnv = postgrest.env;
}
''
${withTools.latest} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} \
test:spec -- "''${_arg_leftovers[@]}"
'';
testQuerycost =
@@ -36,7 +41,7 @@ let
withEnv = postgrest.env;
}
''
${withTools.latest} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
'';
testDoctests =
@@ -66,7 +71,7 @@ let
withEnv = postgrest.env;
}
''
${withTools.latest} ${runtimeShell} -c " \
${withTools.withPg} ${runtimeShell} -c " \
${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec && \
${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec"
'';
@@ -75,7 +80,7 @@ let
python3.withPackages (ps: [
ps.pyjwt
ps.pytest
ps.pytest_xdist
ps.pytest-xdist
ps.pyyaml
ps.requests
ps.requests-unixsocket
@@ -85,28 +90,28 @@ let
checkedShellScript
{
name = "postgrest-test-io";
docs = "Run the pytest-based IO tests.";
docs = "Run the pytest-based IO tests. Add -k to run tests that match a given expression.";
args = [ "ARG_LEFTOVERS([pytest arguments])" ];
inRootDir = true;
withEnv = postgrest.env;
}
''
${cabal-install}/bin/cabal v2-build ${devCabalOptions}
${cabal-install}/bin/cabal v2-exec ${withTools.latest} \
${ioTestPython}/bin/pytest -- -v test/io-tests "''${_arg_leftovers[@]}"
${cabal-install}/bin/cabal v2-exec -- ${withTools.withPg} -f test/io/fixtures.sql \
${ioTestPython}/bin/pytest -v test/io "''${_arg_leftovers[@]}"
'';
dumpSchema =
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 ];
}
''
${withTools.latest} \
${withTools.withPg} \
${cabal-install}/bin/cabal v2-run ${devCabalOptions} --verbose=0 -- \
postgrest --dump-schema \
| ${yq}/bin/yq -y .
@@ -116,69 +121,79 @@ let
checkedShellScript
{
name = "postgrest-coverage";
docs = "Run spec and io tests while collecting hpc coverage data.";
docs = "Run spec and io tests while collecting hpc coverage data. First runs weeder to detect dead code.";
args = [ "ARG_LEFTOVERS([hpc report arguments])" ];
inRootDir = true;
redirectTixFiles = false;
withEnv = postgrest.env;
withTmpDir = true;
}
''
export LOCALE_ARCHIVE="${glibcLocales}/lib/locale/locale-archive"
(
# required for `hpc markup` in CI; glibcLocales is not available e.g. on Darwin
lib.optionalString (stdenv.isLinux && hostPlatform.libc == "glibc") ''
export LOCALE_ARCHIVE="${glibcLocales}/lib/locale/locale-archive"
'' +
# clean up previous coverage reports
mkdir -p coverage
rm -rf coverage/*
''
# clean up previous coverage reports
mkdir -p coverage
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
# build once before running all the tests
${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec test:querycost
# collect all tests
HPCTIXFILE="$tmpdir"/io.tix \
${withTools.latest} ${cabal-install}/bin/cabal v2-exec ${devCabalOptions} \
${ioTestPython}/bin/pytest -- -v test/io-tests
HPCTIXFILE="$tmpdir"/spec.tix \
${withTools.latest} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec
(
trap 'echo Found dead code: Check file list above.' ERR ;
${weeder}/bin/weeder --config=./test/weeder.dhall
)
HPCTIXFILE="$tmpdir"/querycost.tix \
${withTools.latest} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
# collect all tests
HPCTIXFILE="$tmpdir"/io.tix \
${withTools.withPg} -f test/io/fixtures.sql ${cabal-install}/bin/cabal v2-exec ${devCabalOptions} -- \
${ioTestPython}/bin/pytest -v test/io
# Note: No coverage for doctests, as doctests leverage GHCi and GHCi does not support hpc
HPCTIXFILE="$tmpdir"/spec.tix \
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec
# 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
HPCTIXFILE="$tmpdir"/querycost.tix \
${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
# prepare the overlay
${ghc}/bin/hpc overlay --output="$tmpdir"/overlay.tix test/coverage.overlay
${ghc}/bin/hpc sum --union --output="$tmpdir"/tests-overlay.tix "$tmpdir"/tests.tix "$tmpdir"/overlay.tix
# Note: No coverage for doctests, as doctests leverage GHCi and GHCi does not support hpc
# check nothing in the overlay is actually tested
${ghc}/bin/hpc map --function=inv --output="$tmpdir"/inverted.tix "$tmpdir"/tests.tix
${ghc}/bin/hpc combine --function=sub \
--output="$tmpdir"/check.tix "$tmpdir"/overlay.tix "$tmpdir"/inverted.tix
# returns zero exit code if any count="<non-zero>" lines are found, i.e.
# something is covered by both the overlay and the tests
if ${ghc}/bin/hpc report --xml "$tmpdir"/check.tix | ${gnugrep}/bin/grep -qP 'count="[^0]'
then
${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"
exit 1
else
# copy the result .tix file to the coverage/ dir to make it available to postgrest-coverage-draft-overlay, too
cp "$tmpdir"/tests-overlay.tix coverage/postgrest.tix
# prepare codecov json report
${hpc-codecov}/bin/hpc-codecov --mix=.hpc --out=coverage/codecov.json coverage/postgrest.tix
# 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
# create html and stdout reports
${ghc}/bin/hpc markup --destdir=coverage coverage/postgrest.tix
echo "file://$(pwd)/coverage/hpc_index.html"
${ghc}/bin/hpc report coverage/postgrest.tix "''${_arg_leftovers[@]}"
fi
'';
# prepare the overlay
${ghc}/bin/hpc overlay --output="$tmpdir"/overlay.tix test/coverage.overlay
${ghc}/bin/hpc sum --union --output="$tmpdir"/tests-overlay.tix "$tmpdir"/tests.tix "$tmpdir"/overlay.tix
# check nothing in the overlay is actually tested
${ghc}/bin/hpc map --function=inv --output="$tmpdir"/inverted.tix "$tmpdir"/tests.tix
${ghc}/bin/hpc combine --function=sub \
--output="$tmpdir"/check.tix "$tmpdir"/overlay.tix "$tmpdir"/inverted.tix
# returns zero exit code if any count="<non-zero>" lines are found, i.e.
# something is covered by both the overlay and the tests
if ${ghc}/bin/hpc report --xml "$tmpdir"/check.tix | ${gnugrep}/bin/grep -qP 'count="[^0]'
then
${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"
exit 1
else
# copy the result .tix file to the coverage/ dir to make it available to postgrest-coverage-draft-overlay, too
cp "$tmpdir"/tests-overlay.tix coverage/postgrest.tix
# prepare codecov json report
${hpc-codecov}/bin/hpc-codecov --mix=.hpc --out=coverage/codecov.json coverage/postgrest.tix
# create html and stdout reports
${ghc}/bin/hpc markup --destdir=coverage coverage/postgrest.tix
echo "file://$(pwd)/coverage/hpc_index.html"
${ghc}/bin/hpc report coverage/postgrest.tix "''${_arg_leftovers[@]}"
fi
''
);
coverageDraftOverlay =
checkedShellScript
@@ -192,6 +207,26 @@ let
sed -i 's|^module \(.*\):|module \1/|g' test/coverage.overlay
'';
checkStatic =
checkedShellScript
{
name = "postgrest-check-static";
docs = "Verify that the argument is a static executable.";
args = [ "ARG_POSITIONAL_SINGLE([executable], [Executable])" ];
inRootDir = true;
withEnv = postgrest.env;
}
''
exe="$_arg_executable"
ldd_output=$(ldd "$exe" 2>&1 || true)
if ! grep -q "not a dynamic executable" <<< "$ldd_output"; then
echo "not a static executable, ldd output:"
echo "$ldd_output"
exit 1
fi
"$exe" --help
'';
in
buildToolbox
{
@@ -206,5 +241,6 @@ buildToolbox
dumpSchema
coverage
coverageDraftOverlay
checkStatic
];
}
+175 -23
View File
@@ -1,9 +1,14 @@
{ bashCompletion
{ bash-completion
, buildToolbox
, cabal-install
, checkedShellScript
, curl
, devCabalOptions
, git
, lib
, postgresqlVersions
, writeTextFile
, postgrest
, writeText
}:
let
withTmpDb =
@@ -14,15 +19,14 @@ let
docs = "Run the given command in a temporary database with ${name}";
args =
[
"ARG_OPTIONAL_SINGLE([fixtures], [f], [SQL file to load fixtures from], [test/fixtures/load.sql])"
"ARG_OPTIONAL_SINGLE([fixtures], [f], [SQL file to load fixtures from], [test/spec/fixtures/load.sql])"
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
"ARG_LEFTOVERS([command arguments])"
"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([PGRST_DB_ANON_ROLE], [postgrest_test_anonymous], [Anonymous PG role])"
];
addCommandCompletion = true;
positionalCompletion = "_command";
inRootDir = true;
redirectTixFiles = false;
withPath = [ postgresql ];
@@ -30,8 +34,8 @@ let
}
''
# avoid starting multiple layers of withTmpDb
if test -v PGRST_DB_URI; then
exec "$@"
if test -v PGHOST; then
exec "$_arg_command" "''${_arg_leftovers[@]}"
fi
setuplog="$tmpdir/setup.log"
@@ -48,9 +52,11 @@ let
export PGHOST="$tmpdir/socket"
export PGUSER
export PGDATABASE
export PGRST_DB_URI="postgresql:///$PGDATABASE?host=$PGHOST&user=$PGUSER"
export PGRST_DB_SCHEMAS
export PGRST_DB_ANON_ROLE
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
@@ -60,7 +66,7 @@ let
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" \
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"
stop () {
@@ -78,27 +84,27 @@ let
'';
# Helper script for running a command against all PostgreSQL versions.
withAll =
withPgAll =
let
runners =
builtins.map
(pg:
(version:
''
cat << EOF
Running against ${pg.name}...
Running against ${version.name}...
EOF
trap 'echo "Failed on ${pg.name}"' exit
trap 'echo "Failed on ${version.name}"' exit
(${withTmpDb pg} "$_arg_command" "''${_arg_leftovers[@]}")
(${withTmpDb version} "$_arg_command" "''${_arg_leftovers[@]}")
trap "" exit
cat << EOF
Done running against ${pg.name}.
Done running against ${version.name}.
EOF
'')
@@ -113,21 +119,167 @@ let
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
"ARG_LEFTOVERS([command arguments])"
];
addCommandCompletion = true;
positionalCompletion = "_command";
inRootDir = true;
}
(lib.concatStringsSep "\n\n" runners);
# Create a `postgrest-with-postgresql-` for each PostgreSQL version
withVersions = builtins.map withTmpDb postgresqlVersions;
withPgVersions = builtins.map withTmpDb postgresqlVersions;
withPg = builtins.head withPgVersions;
withGit =
let
name = "postgrest-with-git";
in
checkedShellScript
{
inherit name;
docs =
''
Create a new worktree of the postgrest repo in a temporary directory and
check out <commit>, then run <command> with arguments inside the temporary folder.
'';
args =
[
"ARG_POSITIONAL_SINGLE([commit], [Commit-ish reference to run command with])"
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
"ARG_LEFTOVERS([command arguments])"
];
positionalCompletion =
''
if test "$prev" == "${name}"; then
__gitcomp_nl "$(__git_refs)"
else
_command_offset 2
fi
'';
inRootDir = true;
}
''
# not using withTmpDir here, because we don't want to keep the directory on error
tmpdir="$(mktemp -d)"
trap 'rm -rf "$tmpdir"' EXIT
${git}/bin/git worktree add -f "$tmpdir" "$_arg_commit" > /dev/null
cd "$tmpdir"
("$_arg_command" "''${_arg_leftovers[@]}")
${git}/bin/git worktree remove -f "$tmpdir" > /dev/null
'';
legacyConfig =
writeText "legacy.conf"
''
# Using this config file to support older postgrest versions for `postgrest-loadtest-against`
db-uri="$(PGRST_DB_URI)"
db-schema="$(PGRST_DB_SCHEMAS)"
db-anon-role="$(PGRST_DB_ANON_ROLE)"
db-pool="$(PGRST_DB_POOL)"
server-unix-socket="$(PGRST_SERVER_UNIX_SOCKET)"
log-level="$(PGRST_LOG_LEVEL)"
'';
waitForPgrstPid =
checkedShellScript
{
name = "postgrest-wait-for-pgrst-pid";
docs = "Wait for PostgREST to be running. Needs to be a separate command for timeout to work below.";
args = [
"ARG_USE_ENV([PGRST_SERVER_UNIX_SOCKET], [], [Unix socket to check for running PostgREST instance])"
];
}
''
# ARG_USE_ENV only adds defaults or docs for environment variables
# We manually implement a required check here
# See also: https://github.com/matejak/argbash/issues/80
: "''${PGRST_SERVER_UNIX_SOCKET:?PGRST_SERVER_UNIX_SOCKET is required}"
until [ -S "$PGRST_SERVER_UNIX_SOCKET" ]
do
sleep 0.1
done
# return pid of postgrest process
lsof -t -c '/^postgrest$/' "$PGRST_SERVER_UNIX_SOCKET"
'';
waitForPgrstReady =
checkedShellScript
{
name = "postgrest-wait-for-pgrst-ready";
docs = "Wait for PostgREST to be ready to serve requests. Needs to be a separate command for timeout to work below.";
args = [
"ARG_USE_ENV([PGRST_SERVER_UNIX_SOCKET], [], [Unix socket to check for running PostgREST instance])"
];
}
''
# ARG_USE_ENV only adds defaults or docs for environment variables
# We manually implement a required check here
# See also: https://github.com/matejak/argbash/issues/80
: "''${PGRST_SERVER_UNIX_SOCKET:?PGRST_SERVER_UNIX_SOCKET is required}"
function check_status () {
${curl}/bin/curl -s -o /dev/null -w "%{http_code}" --unix-socket "$PGRST_SERVER_UNIX_SOCKET" http://localhost/
}
while [[ "$(check_status)" != "200" ]];
do sleep 0.1;
done
'';
withPgrst =
checkedShellScript
{
name = "postgrest-with-pgrst";
docs = "Build and run PostgREST and run <command> with PGRST_SERVER_UNIX_SOCKET set.";
args =
[
"ARG_POSITIONAL_SINGLE([command], [Command to run])"
"ARG_LEFTOVERS([command arguments])"
];
positionalCompletion = "_command";
inRootDir = true;
withEnv = postgrest.env;
withTmpDir = true;
}
''
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
}
echo "done."
echo -n "Starting postgrest... "
./result/bin/postgrest ${legacyConfig} > "$tmpdir"/run.log 2>&1 &
pid=$!
cleanup() {
kill "$pid" || true
}
trap cleanup EXIT
timeout -s TERM 5 ${waitForPgrstReady} || {
echo "timed out, output:"
cat "$tmpdir"/run.log
exit 1
}
echo "done."
("$_arg_command" "''${_arg_leftovers[@]}")
'';
in
buildToolbox
{
name = "postgrest-with";
tools = [ withAll ] ++ withVersions;
extra = {
# make withTools.latest available for other nix files
latest = withTmpDb (builtins.head postgresqlVersions);
};
tools = [ withPgAll withGit withPgrst ] ++ withPgVersions;
# make withTools available for other nix files
extra = { inherit withGit withPg withPgAll withPgrst; };
}
+144 -135
View File
@@ -1,8 +1,8 @@
name: postgrest
version: 9.0.0
version: 10.1.2
synopsis: REST API for any Postgres database
description: Reads the schema of a PostgreSQL database and creates RESTful routes
for the tables and views, supporting all HTTP verbs that security
for tables, views, and functions, supporting all HTTP methods that security
permits.
license: MIT
license-file: LICENSE
@@ -43,77 +43,86 @@ library
PostgREST.Config.JSPath
PostgREST.Config.PgVersion
PostgREST.Config.Proxy
PostgREST.ContentType
PostgREST.DbStructure
PostgREST.DbStructure.Identifiers
PostgREST.DbStructure.Proc
PostgREST.DbStructure.Relationship
PostgREST.DbStructure.Table
PostgREST.Cors
PostgREST.SchemaCache
PostgREST.SchemaCache.Identifiers
PostgREST.SchemaCache.Proc
PostgREST.SchemaCache.Relationship
PostgREST.SchemaCache.Table
PostgREST.Error
PostgREST.GucHeader
PostgREST.Middleware
PostgREST.OpenAPI
PostgREST.Logger
PostgREST.MediaType
PostgREST.Query
PostgREST.Query.QueryBuilder
PostgREST.Query.SqlFragment
PostgREST.Query.Statements
PostgREST.Plan
PostgREST.Plan.CallPlan
PostgREST.Plan.MutatePlan
PostgREST.Plan.ReadPlan
PostgREST.RangeQuery
PostgREST.Request.ApiRequest
PostgREST.Request.DbRequestBuilder
PostgREST.Request.Parsers
PostgREST.Request.Preferences
PostgREST.Request.Types
PostgREST.ApiRequest
PostgREST.ApiRequest.Preferences
PostgREST.ApiRequest.QueryParams
PostgREST.ApiRequest.Types
PostgREST.Response
PostgREST.Response.OpenAPI
PostgREST.Response.GucHeader
PostgREST.Version
PostgREST.Workers
other-modules: Paths_postgrest
build-depends: base >= 4.9 && < 4.16
build-depends: base >= 4.9 && < 4.17
, HTTP >= 4000.3.7 && < 4000.4
, Ranged-sets >= 0.3 && < 0.5
, aeson >= 1.4.7 && < 1.6
, ansi-wl-pprint >= 0.6.7 && < 0.7
, aeson >= 2.0.3 && < 2.2
, auto-update >= 0.1.4 && < 0.2
, base64-bytestring >= 1 && < 1.3
, bytestring >= 0.10.8 && < 0.11
, bytestring >= 0.10.8 && < 0.12
, case-insensitive >= 1.2 && < 1.3
, cassava >= 0.4.5 && < 0.6
, configurator-pg >= 0.2 && < 0.3
, containers >= 0.5.7 && < 0.7
, contravariant >= 1.4 && < 1.6
, contravariant-extras >= 0.3.3 && < 0.4
, cookie >= 0.4.2 && < 0.5
, either >= 4.4.1 && < 5.1
, fast-logger >= 2.4.5
, fuzzyset >= 0.2.3
, gitrev >= 1.2 && < 1.4
, hasql >= 1.4 && < 1.5
, hasql-dynamic-statements == 0.3.1
, 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-pool >= 0.8.0.6 && < 0.9
, 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.1 && < 0.9
, lens >= 4.14 && < 5.1
, jose >= 0.8.5.1 && < 0.11
, lens >= 4.14 && < 5.3
, lens-aeson >= 1.0.1 && < 1.2
, mtl >= 2.2.2 && < 2.3
, network >= 2.6 && < 3.2
, network-uri >= 2.6.1 && < 2.8
, optparse-applicative >= 0.13 && < 0.17
, parsec >= 3.1.11 && < 3.2
, protolude >= 0.3 && < 0.4
, 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
, swagger2 >= 2.4 && < 2.7
, swagger2 >= 2.4 && < 2.9
, text >= 1.2.2 && < 1.3
, time >= 1.6 && < 1.11
, time >= 1.6 && < 1.12
, unordered-containers >= 0.2.8 && < 0.3
, vector >= 0.11 && < 0.13
, vault >= 0.3.1.5 && < 0.4
, vector >= 0.11 && < 0.14
, wai >= 3.2.1 && < 3.3
, wai-cors >= 0.2.5 && < 0.3
, wai-extra >= 3.0.19 && < 3.2
, wai-logger >= 2.3.2
, wai-middleware-static >= 0.8.1 && < 0.10
, warp >= 3.2.12 && < 3.4
, wai-extra >= 3.1.8 && < 3.2
-- We already depend on wai-logger >= 2.3.7 indirectly via wai-extra,
-- but we want to depend on 2.4.0 which fixes 'unknownSocket' log output
-- for unix sockets; this is tested in test/io/test_io.py. See
-- https://github.com/kazu-yamamoto/logger/commit/3a71ca70afdbb93d4ecf0083eeba1fbbbcab3fc3
, wai-logger >= 2.4.0
, warp >= 3.3.19 && < 3.4
-- -fno-spec-constr may help keep compile time memory use in check,
-- see https://gitlab.haskell.org/ghc/ghc/issues/16017#note_219304
-- -optP-Wno-nonportable-include-path
@@ -123,7 +132,7 @@ library
-fno-spec-constr -optP-Wno-nonportable-include-path
if flag(dev)
ghc-options: -O0
ghc-options: -O0 -fwrite-ide-info
if flag(hpc)
ghc-options: -fhpc -hpcdir .hpc
else
@@ -133,7 +142,6 @@ library
build-depends:
unix
, directory >= 1.2.6 && < 1.4
, network >= 2.6 && < 3.2
exposed-modules:
PostgREST.Unix
@@ -143,16 +151,18 @@ executable postgrest
NoImplicitPrelude
hs-source-dirs: main
main-is: Main.hs
build-depends: base >= 4.9 && < 4.16
build-depends: base >= 4.9 && < 4.17
, containers >= 0.5.7 && < 0.7
, postgrest
, protolude >= 0.3 && < 0.4
ghc-options: -threaded -rtsopts "-with-rtsopts=-N -I2"
, protolude >= 0.3.1 && < 0.4
ghc-options: -threaded -rtsopts "-with-rtsopts=-N -I0 -qg"
-O2 -Werror -Wall -fwarn-identities
-fno-spec-constr -optP-Wno-nonportable-include-path
if flag(dev)
ghc-options: -O0
ghc-options: -O0 -fwrite-ide-info
-- https://github.com/PostgREST/postgrest/issues/387
-with-rtsopts=-K1K
if flag(hpc)
ghc-options: -fhpc -hpcdir .hpc
else
@@ -164,135 +174,134 @@ test-suite spec
default-extensions: OverloadedStrings
QuasiQuotes
NoImplicitPrelude
hs-source-dirs: test
hs-source-dirs: test/spec
main-is: Main.hs
other-modules: Feature.AndOrParamsSpec
Feature.AsymmetricJwtSpec
Feature.AudienceJwtSecretSpec
Feature.AuthSpec
Feature.BinaryJwtSecretSpec
other-modules: Feature.Auth.AsymmetricJwtSpec
Feature.Auth.AudienceJwtSecretSpec
Feature.Auth.AuthSpec
Feature.Auth.BinaryJwtSecretSpec
Feature.Auth.NoAnonSpec
Feature.Auth.NoJwtSpec
Feature.ConcurrentSpec
Feature.CorsSpec
Feature.DeleteSpec
Feature.DisabledOpenApiSpec
Feature.EmbedDisambiguationSpec
Feature.EmbedInnerJoinSpec
Feature.ExtraSearchPathSpec
Feature.HtmlRawOutputSpec
Feature.InsertSpec
Feature.IgnorePrivOpenApiSpec
Feature.JsonOperatorSpec
Feature.LegacyGucsSpec
Feature.MultipleSchemaSpec
Feature.NoJwtSpec
Feature.NonexistentSchemaSpec
Feature.OpenApiSpec
Feature.OpenApi.DisabledOpenApiSpec
Feature.OpenApi.IgnorePrivOpenApiSpec
Feature.OpenApi.OpenApiSpec
Feature.OpenApi.ProxySpec
Feature.OpenApi.RootSpec
Feature.OpenApi.SecurityOpenApiSpec
Feature.OptionsSpec
Feature.ProxySpec
Feature.QueryLimitedSpec
Feature.QuerySpec
Feature.RangeSpec
Feature.RawOutputTypesSpec
Feature.Query.AndOrParamsSpec
Feature.Query.ComputedRelsSpec
Feature.Query.DeleteSpec
Feature.Query.EmbedDisambiguationSpec
Feature.Query.EmbedInnerJoinSpec
Feature.Query.PlanSpec
Feature.Query.HtmlRawOutputSpec
Feature.Query.InsertSpec
Feature.Query.JsonOperatorSpec
Feature.Query.MultipleSchemaSpec
Feature.Query.ErrorSpec
Feature.Query.PgSafeUpdateSpec
Feature.Query.PostGISSpec
Feature.Query.QueryLimitedSpec
Feature.Query.QuerySpec
Feature.Query.RangeSpec
Feature.Query.RawOutputTypesSpec
Feature.Query.RpcSpec
Feature.Query.SingularSpec
Feature.Query.UnicodeSpec
Feature.Query.UpdateSpec
Feature.Query.UpsertSpec
Feature.RollbackSpec
Feature.RootSpec
Feature.RpcPreRequestGucsSpec
Feature.RpcSpec
Feature.SingularSpec
Feature.UnicodeSpec
Feature.UpdateSpec
Feature.UpsertSpec
SpecHelper
TestTypes
build-depends: base >= 4.9 && < 4.16
, aeson >= 1.4.7 && < 1.6
build-depends: base >= 4.9 && < 4.17
, 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
, base64-bytestring >= 1 && < 1.3
, bytestring >= 0.10.8 && < 0.11
, bytestring >= 0.10.8 && < 0.12
, case-insensitive >= 1.2 && < 1.3
, cassava >= 0.4.5 && < 0.6
, containers >= 0.5.7 && < 0.7
, contravariant >= 1.4 && < 1.6
, hasql >= 1.4 && < 1.5
, hasql-pool >= 0.5 && < 0.6
, hasql-pool >= 0.8.0.2 && < 0.9
, 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.1
, lens >= 4.14 && < 5.3
, lens-aeson >= 1.0.1 && < 1.2
, monad-control >= 1.0.1 && < 1.1
, postgrest
, process >= 1.4.2 && < 1.7
, protolude >= 0.3 && < 0.4
, protolude >= 0.3.1 && < 0.4
, regex-tdfa >= 1.2.2 && < 1.4
, text >= 1.2.2 && < 1.3
, time >= 1.6 && < 1.11
, 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
-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
main-is: QueryCost.hs
other-modules: SpecHelper
build-depends: base >= 4.9 && < 4.16
, aeson >= 1.4.7 && < 1.6
, aeson-qq >= 0.8.1 && < 0.9
, async >= 2.1.1 && < 2.3
, auto-update >= 0.1.4 && < 0.2
, base64-bytestring >= 1 && < 1.3
, bytestring >= 0.10.8 && < 0.11
, case-insensitive >= 1.2 && < 1.3
, cassava >= 0.4.5 && < 0.6
, containers >= 0.5.7 && < 0.7
, contravariant >= 1.4 && < 1.6
, hasql >= 1.4 && < 1.5
, hasql-dynamic-statements == 0.3.1
, 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.1
, lens-aeson >= 1.0.1 && < 1.2
, monad-control >= 1.0.1 && < 1.1
, postgrest
, process >= 1.4.2 && < 1.7
, protolude >= 0.3 && < 0.4
, regex-tdfa >= 1.2.2 && < 1.4
, text >= 1.2.2 && < 1.3
, time >= 1.6 && < 1.11
, 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
-fno-spec-constr -optP-Wno-nonportable-include-path
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.2
, 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.6 && < 1.7
, hasql-dynamic-statements >= 0.3.1 && < 0.4
, hasql-pool >= 0.8.0.2 && < 0.9
, 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.3
, 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
default-extensions: OverloadedStrings
NoImplicitPrelude
hs-source-dirs: test/doctests
main-is: Main.hs
build-depends: base >= 4.9 && < 4.16
, doctest >= 0.8
, postgrest
, pretty-simple
, protolude >= 0.3 && < 0.4
ghc-options: -threaded -O0 -Werror -Wall -fwarn-identities
-fno-spec-constr -optP-Wno-nonportable-include-path
type: exitcode-stdio-1.0
default-language: Haskell2010
default-extensions: OverloadedStrings
NoImplicitPrelude
hs-source-dirs: test/doc
main-is: Main.hs
build-depends: base >= 4.9 && < 4.17
, doctest >= 0.8
, postgrest
, pretty-simple
, protolude >= 0.3.1 && < 0.4
ghc-options: -threaded -O0 -Werror -Wall -fwarn-identities
-fno-spec-constr -optP-Wno-nonportable-include-path
+11 -5
View File
@@ -11,7 +11,7 @@
}:
let
postgrest =
import ./default.nix;
import ./default.nix { };
inherit (postgrest) pkgs;
@@ -21,6 +21,7 @@ let
[
postgrest.cabalTools
postgrest.devTools
postgrest.loadtest
postgrest.nixpkgsTools
postgrest.style
postgrest.tests
@@ -37,20 +38,25 @@ lib.overrideDerivation postgrest.env (
base.buildInputs ++ [
pkgs.cabal-install
pkgs.cabal2nix
pkgs.git
pkgs.postgresql
pkgs.update-nix-fetchgit
postgrest.hsie.bin
]
++ toolboxes;
shellHook =
''
source ${pkgs.bashCompletion}/etc/profile.d/bash_completion.sh
source ${postgrest.hsie.bashCompletion}
export HISTFILE=.history
source ${pkgs.bash-completion}/etc/profile.d/bash_completion.sh
source ${pkgs.git}/share/git/contrib/completion/git-completion.bash
source ${postgrest.hsie.bash-completion}
''
+ builtins.concatStringsSep "\n" (
builtins.map (bashCompletion: "source ${bashCompletion}") (
builtins.concatLists (builtins.map (toolbox: toolbox.bashCompletion) toolboxes)
builtins.map (bash-completion: "source ${bash-completion}") (
builtins.concatLists (builtins.map (toolbox: toolbox.bash-completion) toolboxes)
)
);
}
+536
View File
@@ -0,0 +1,536 @@
{-|
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.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.Ranged.Ranges (emptyRange, rangeIntersection,
rangeIsEmpty)
import Data.Tree (Tree (..))
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.Preferences (PreferCount (..),
PreferParameters (..),
PreferRepresentation (..),
PreferResolution (..),
PreferTransaction (..))
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
import PostgREST.ApiRequest.Types (ApiRequestError (..),
RangeError (..),
SelectItem (..))
import PostgREST.Config (AppConfig (..),
OpenAPIMode (..))
import PostgREST.MediaType (MTPlanAttrs (..),
MTPlanFormat (..),
MediaType (..))
import PostgREST.RangeQuery (NonnegRange, allRange,
convertToLimitZeroRange,
hasLimitZero,
rangeRequested)
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema)
import PostgREST.SchemaCache.Proc (ProcDescription (..),
ProcParam (..), ProcsMap,
procReturnsScalar)
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
}
| 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
, 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 media type in the Accept header
, iBinaryField :: Maybe FieldName -- ^ field used for raw output
}
-- | Examines HTTP request and translates it into user intent.
userApiRequest :: AppConfig -> SchemaCache -> Request -> RequestBody -> Either ApiRequestError ApiRequest
userApiRequest conf sCache req reqBody = do
qPrms <- first QueryParamError $ QueryParams.parse $ rawQueryString req
pInfo <- getPathInfo conf $ pathInfo req
act <- getAction pInfo $ requestMethod req
mediaTypes <- getMediaTypes conf (requestHeaders req) act pInfo
negotiatedSchema <- getSchema conf (requestHeaders req) (requestMethod req)
apiRequest conf sCache req reqBody qPrms pInfo act mediaTypes negotiatedSchema
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
getMediaTypes :: AppConfig -> RequestHeaders -> Action -> PathInfo -> Either ApiRequestError (MediaType, MediaType)
getMediaTypes conf hdrs action path = do
acceptMediaType <- findAcceptMediaType conf action path accepts
pure (acceptMediaType, contentMediaType)
where
accepts = maybe [MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
contentMediaType = maybe MTApplicationJSON MediaType.decodeMediaType $ lookupHeader "content-type"
lookupHeader = flip lookup hdrs
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
apiRequest :: AppConfig -> SchemaCache -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action -> (MediaType, MediaType) -> (Schema, Bool) -> Either ApiRequestError ApiRequest
apiRequest conf sCache req reqBody queryparams@QueryParams{..} PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action (acceptMediaType, contentMediaType) (schema, negotiatedByProfile)
| isInvalidRange = Left $ InvalidRange (if rangeIsEmpty headerRange then LowerGTUpper else NegativeLimit)
| 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
checkedTarget <- target
bField <- binaryField conf acceptMediaType checkedTarget queryparams
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
, iSchema = schema
, iNegotiatedByProfile = negotiatedByProfile
, iAcceptMediaType = acceptMediaType
, iBinaryField = bField
}
where
expectParams = pathIsProc && method /= "POST"
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
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 sCache)
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" (convertToLimitZeroRange limitRange 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 (HM.keys allProcs) lookupProcName
-- 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 lookupProcName
-- First find the proc by name
lookupProcName = HM.lookupDefault mempty qi allProcs
-- 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)
-- | 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 :: AppConfig -> MediaType -> Target -> QueryParams -> Either ApiRequestError (Maybe FieldName)
binaryField AppConfig{configRawMediaTypes} acceptMediaType target QueryParams{qsSelect}
| returnsScalar target && isRawMediaType =
Right $ Just "pgrst_scalar"
| isRawMediaType =
let
fieldName = fstFieldName qsSelect
in
case fieldName of
Just fld -> Right $ Just fld
Nothing -> Left $ BinaryFieldError acceptMediaType
| otherwise =
Right Nothing
where
isRawMediaType = acceptMediaType `elem` configRawMediaTypes `union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan acceptMediaType
isRawPlan mt = case mt of
MTPlan (MTPlanAttrs (Just MTOctetStream) _ _) -> True
MTPlan (MTPlanAttrs (Just MTTextPlain) _ _) -> True
MTPlan (MTPlanAttrs (Just MTTextXML) _ _) -> True
_ -> False
returnsScalar :: Target -> Bool
returnsScalar (TargetProc proc _) = procReturnsScalar proc
returnsScalar _ = False
fstFieldName :: [Tree SelectItem] -> Maybe FieldName
fstFieldName [Node SelectField{selField=("*", _)} []] = Nothing
fstFieldName [Node SelectField{selField=(fld, _)} []] = Just fld
fstFieldName _ = Nothing
@@ -1,12 +1,12 @@
-- |
-- 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
module PostgREST.ApiRequest.Preferences
( Preferences(..)
, PreferCount(..)
, PreferParameters(..)
@@ -15,6 +15,7 @@ module PostgREST.Request.Preferences
, PreferTransaction(..)
, fromHeaders
, ToAppliedHeader(..)
, shouldCount
) where
import qualified Data.ByteString.Char8 as BS
@@ -155,7 +156,7 @@ instance ToAppliedHeader PreferResolution
--
-- From https://tools.ietf.org/html/rfc7240#section-4.2
data PreferRepresentation
= Full -- ^ Return the body plus the Location header(in case of POST).
= Full -- ^ Return the body.
| HeadersOnly -- ^ Return the Location header(in case of POST). This needs a SELECT privilege on the pk.
| None -- ^ Return nothing from the mutated data.
deriving Eq
@@ -171,6 +172,7 @@ data PreferParameters
| MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure.
deriving Eq
-- TODO: Deprecate params=multiple-objects in next major version
instance ToHeaderValue PreferParameters where
toHeaderValue SingleObject = "params=single-object"
toHeaderValue MultipleObjects = "params=multiple-objects"
@@ -187,6 +189,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.
+653
View File
@@ -0,0 +1,653 @@
-- |
-- 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.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.RangeQuery (NonnegRange, allRange,
rangeGeq, rangeLimit,
rangeOffset, restrictRange)
import PostgREST.SchemaCache.Identifiers (FieldName)
import PostgREST.ApiRequest.Types (EmbedParam (..), EmbedPath, Field,
Filter (..), FtsOperator (..),
JoinType (..), JsonOperand (..),
JsonOperation (..), JsonPath,
ListVal, LogicOperator (..),
LogicTree (..), OpExpr (..),
Operation (..),
OrderDirection (..),
OrderNulls (..), OrderTerm (..),
QPError (..), SelectItem (..),
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
-- >>> deriving instance Show SelectItem
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 "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 = SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SelectField {selField = ("location",[]), selCast = Nothing, selAlias = 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))
-- |
-- Parse select= into a Forest of SelectItems
--
-- >>> P.parse pFieldForest "" "id"
-- Right [Node {rootLabel = SelectField {selField = ("id",[]), 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",[]), selCast = Nothing, selAlias = Nothing}, subForest = []}]}]
--
-- >>> P.parse pFieldForest "" "*,client(*,nested(*))"
-- Right [Node {rootLabel = SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SelectRelation {selRelation = "client", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SelectRelation {selRelation = "nested", selAlias = Nothing, selHint = Nothing, selJoinType = Nothing}, subForest = [Node {rootLabel = SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing}, subForest = []}]}]}]
--
-- >>> P.parse pFieldForest "" "id,clients(name[])"
-- Left (line 1, column 16):
-- unexpected '['
-- expecting letter, digit, "-", "!", "(", "->>", "->", "::", ")", "," or end of input
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 "*" $> "*"
-- |
-- 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 <|>
T.intercalate "-" . map toS <$> (pIdentifier `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 ':')
-- |
-- 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 $ try ( do
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
name <- pFieldName
prm1 <- optionMaybe pEmbedParam
prm2 <- optionMaybe pEmbedParam
try (void $ lookAhead (string "("))
return $ SelectRelation name 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
-- |
-- Parse regular fields in select
--
-- >>> P.parse pFieldSelect "" "name"
-- Right (SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Nothing})
--
-- >>> P.parse pFieldSelect "" "name->jsonpath"
-- Right (SelectField {selField = ("name",[JArrow {jOp = JKey {jVal = "jsonpath"}}]), selCast = Nothing, selAlias = Nothing})
--
-- >>> P.parse pFieldSelect "" "name::cast"
-- Right (SelectField {selField = ("name",[]), selCast = Just "cast", selAlias = Nothing})
--
-- >>> P.parse pFieldSelect "" "alias:name"
-- Right (SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Just "alias"})
--
-- >>> P.parse pFieldSelect "" "alias:name->jsonpath::cast"
-- Right (SelectField {selField = ("name",[JArrow {jOp = JKey {jVal = "jsonpath"}}]), selCast = Just "cast", selAlias = Just "alias"})
--
-- >>> P.parse pFieldSelect "" "*"
-- Right (SelectField {selField = ("*",[]), 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
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
fld <- pField
cast' <- optionMaybe (string "::" *> pIdentifier)
pEnd
return $ SelectField fld (toS <$> cast') alias
)
<|> do
s <- pStar
pEnd
return $ SelectField (s, []) Nothing Nothing
where
pEnd = try (void $ lookAhead (string ")")) <|>
try (void $ lookAhead (string ",")) <|>
try eof
-- |
-- Parse operator expression used in horizontal filtering
--
-- >>> P.parse (pOpExpr pSingleVal) "" "fts().value"
-- Left (line 1, column 7):
-- unknown single value operator fts()
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 ')') pIdentifier)
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 ',')
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)
+220
View File
@@ -0,0 +1,220 @@
{-# LANGUAGE DuplicateRecordFields #-}
module PostgREST.ApiRequest.Types
( Alias
, Cast
, Depth
, EmbedParam(..)
, ApiRequestError(..)
, EmbedPath
, Field
, Filter(..)
, Hint
, JoinType(..)
, JsonOperand(..)
, JsonOperation(..)
, JsonPath
, ListVal
, LogicOperator(..)
, LogicTree(..)
, NodeName
, OpExpr(..)
, Operation (..)
, OrderDirection(..)
, OrderNulls(..)
, OrderTerm(..)
, QPError(..)
, RangeError(..)
, SingleVal
, TrileanVal(..)
, SimpleOperator(..)
, FtsOperator(..)
, SelectItem(..)
) where
import PostgREST.MediaType (MediaType (..))
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.SchemaCache.Proc (ProcDescription (..))
import PostgREST.SchemaCache.Relationship (Relationship,
RelationshipsMap)
import Protolude
-- | The select value in `/tbl?select=alias:field::cast`
data SelectItem
= SelectField
{ selField :: Field
, selCast :: Maybe Cast
, selAlias :: Maybe Alias
}
| SelectRelation
{ selRelation :: FieldName
, selAlias :: Maybe Alias
, selHint :: Maybe Hint
, selJoinType :: Maybe JoinType
}
deriving (Eq)
data ApiRequestError
= AmbiguousRelBetween Text Text [Relationship]
| AmbiguousRpc [ProcDescription]
| BinaryFieldError MediaType
| MediaTypeError [ByteString]
| InvalidBody ByteString
| InvalidFilters
| InvalidRange RangeError
| InvalidRpcMethod ByteString
| LimitNoOrderError
| NotFound
| NoRelBetween Text Text (Maybe Text) Text RelationshipsMap
| NoRpc Text Text [Text] Bool MediaType Bool [QualifiedIdentifier] [ProcDescription]
| NotEmbedded Text
| ParseRequestError Text Text
| PutRangeNotAllowedError
| QueryParamError QPError
| UnacceptableSchema [Text]
| UnsupportedMethod ByteString
data QPError = QPError Text Text
data RangeError
= NegativeLimit
| LowerGTUpper
| OutOfBounds Text Text
type NodeName = Text
type Depth = Integer
data OrderTerm = OrderTerm
{ otTerm :: Field
, otDirection :: Maybe OrderDirection
, otNullOrder :: Maybe OrderNulls
}
deriving (Eq)
data OrderDirection
= OrderAsc
| OrderDesc
deriving (Eq)
data OrderNulls
= OrderNullsFirst
| OrderNullsLast
deriving (Eq)
type Field = (FieldName, JsonPath)
type Cast = Text
type Alias = Text
type Hint = Text
data EmbedParam
-- | Disambiguates an embedding operation when there's multiple relationships
-- between two tables. Can be the name of a foreign key constraint, column
-- name or the junction in an m2m relationship.
= EPHint Hint
| EPJoinType JoinType
data JoinType
= JTInner
| JTLeft
deriving Eq
-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path
-- ["clients", "projects"]
type EmbedPath = [Text]
-- | Json path operations as specified in
-- https://www.postgresql.org/docs/current/static/functions-json.html
type JsonPath = [JsonOperation]
-- | Represents the single arrow `->` or double arrow `->>` operators
data JsonOperation
= JArrow { jOp :: JsonOperand }
| J2Arrow { jOp :: JsonOperand }
deriving (Eq)
-- | 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
-- '1'::int
data JsonOperand
= JKey { jVal :: Text }
| JIdx { jVal :: Text }
deriving (Eq)
-- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
--
-- And
-- / \
-- name.eq.N Or
-- / \
-- id.eq.1 id.eq.2
data LogicTree
= Expr Bool LogicOperator [LogicTree]
| Stmnt Filter
deriving (Eq)
data LogicOperator
= And
| Or
deriving Eq
data Filter = Filter
{ field :: Field
, opExpr :: OpExpr
}
deriving (Eq)
data OpExpr =
OpExpr Bool Operation
deriving (Eq)
data Operation
= Op SimpleOperator SingleVal
| In ListVal
| Is TrileanVal
| Fts FtsOperator (Maybe Language) SingleVal
deriving (Eq)
type Language = Text
-- | Represents a single value in a filter, e.g. id=eq.singleval
type SingleVal = Text
-- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3)
type ListVal = [Text]
-- | Three-valued logic values
data TrileanVal
= TriTrue
| TriFalse
| TriNull
| TriUnknown
deriving Eq
data SimpleOperator
= OpEqual
| OpGreaterThanEqual
| OpGreaterThan
| OpLessThanEqual
| OpLessThan
| OpNotEqual
| OpLike
| OpILike
| OpContains
| OpContained
| OpOverlap
| OpStrictlyLeft
| OpStrictlyRight
| OpNotExtendsRight
| OpNotExtendsLeft
| OpAdjacent
| OpMatch
| OpIMatch
deriving Eq
-- | Operators for full text search operators
data FtsOperator
= FilterFts
| FilterFtsPlain
| FilterFtsPhrase
| FilterFtsWebsearch
deriving Eq
+116 -513
View File
@@ -17,102 +17,61 @@ module PostgREST.App
, 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 Data.Time.Clock (UTCTime)
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 M
import qualified Data.Set as S
import qualified Hasql.DynamicStatements.Snippet as SQL
import qualified Hasql.Pool as SQL
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 Hasql.Transaction.Sessions as SQL
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified PostgREST.AppState as AppState
import qualified PostgREST.Auth as Auth
import qualified PostgREST.DbStructure as DbStructure
import qualified PostgREST.Error as Error
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.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.Workers as Workers
import PostgREST.AppState (AppState)
import PostgREST.Config (AppConfig (..),
LogLevel (..),
OpenAPIMode (..))
import PostgREST.Config.PgVersion (PgVersion (..))
import PostgREST.ContentType (ContentType (..))
import PostgREST.DbStructure (DbStructure (..),
tablePKCols)
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.Request.ApiRequest (Action (..),
ApiRequest (..),
InvokeMethod (..),
Target (..))
import PostgREST.Request.Preferences (PreferCount (..),
PreferParameters (..),
PreferRepresentation (..),
toAppliedHeader)
import PostgREST.Request.Types (ReadRequest, fstFieldNames)
import PostgREST.Version (prettyVersion)
import PostgREST.Workers (connectionWorker, listener)
import qualified PostgREST.ContentType as ContentType
import qualified PostgREST.DbStructure.Proc as Proc
import PostgREST.ApiRequest (Action (..), ApiRequest (..),
Mutation (..), Target (..))
import PostgREST.AppState (AppState)
import PostgREST.Auth (AuthResult (..))
import PostgREST.Config (AppConfig (..), LogLevel (..))
import PostgREST.Config.PgVersion (PgVersion (..))
import PostgREST.Error (Error)
import PostgREST.Query (DbHandler)
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.Version (prettyVersion)
import Protolude hiding (Handler)
data RequestContext = RequestContext
{ ctxConfig :: AppConfig
, ctxDbStructure :: DbStructure
, ctxApiRequest :: ApiRequest
, ctxPgVersion :: PgVersion
}
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
conf@AppConfig{..} <- AppState.getConfig appState
connectionWorker appState -- Loads the initial DbStructure
Workers.connectionWorker appState -- Loads the initial SchemaCache
installHandlers appState
-- reload schema cache + config on NOTIFY
when configDbChannelEnabled $ listener appState
Workers.runListener conf appState
let app = postgrest configLogLevel appState (connectionWorker appState)
Workers.runAdmin conf appState $ serverSettings conf
let app = postgrest configLogLevel appState (Workers.connectionWorker appState)
case configServerUnixSocket of
Just socket ->
@@ -122,7 +81,7 @@ run installHandlers maybeRunWithSocket appState = do
AppState.logWithZTime appState $ "Listening on unix socket " <> show socket
runWithSocket (serverSettings conf) app configServerUnixSocketMode socket
Nothing ->
panic "Cannot run with socket on non-unix plattforms."
panic "Cannot run with unix socket on non-unix platforms."
Nothing ->
do
AppState.logWithZTime appState $ "Listening on port " <> show configServerPort
@@ -137,475 +96,119 @@ serverSettings AppConfig{..} =
-- | PostgREST application
postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application
postgrest logLev appState connWorker =
Middleware.pgrstMiddleware logLev $
\req respond -> do
time <- AppState.getTime appState
conf <- AppState.getConfig appState
maybeDbStructure <- AppState.getDbStructure appState
pgVer <- AppState.getPgVersion appState
jsonDbS <- AppState.getJsonDbS appState
postgrest logLevel appState connWorker =
Cors.middleware .
Auth.middleware appState .
Logger.middleware logLevel $
-- 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
maybeSchemaCache <- AppState.getSchemaCache appState
pgVer <- AppState.getPgVersion appState
jsonDbS <- AppState.getJsonDbS appState
let
eitherResponse :: IO (Either Error Wai.Response)
eitherResponse =
runExceptT $ postgrestResponse conf maybeDbStructure jsonDbS pgVer (AppState.getPool appState) time req
let
eitherResponse :: IO (Either Error Wai.Response)
eitherResponse =
runExceptT $ postgrestResponse appState conf maybeSchemaCache jsonDbS 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
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
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.
when (Response.isServiceUnavailable response) connWorker
resp <- do
delay <- AppState.getRetryNextIn appState
return $ Response.addRetryHint delay response
respond resp
postgrestResponse
:: AppConfig
-> Maybe DbStructure
:: AppState.AppState
-> AppConfig
-> Maybe SchemaCache
-> ByteString
-> PgVersion
-> SQL.Pool
-> UTCTime
-> AuthResult
-> Wai.Request
-> Handler IO Wai.Response
postgrestResponse conf maybeDbStructure jsonDbS pgVer pool time req = do
postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jsonDbS pgVer authResult@AuthResult{..} req = do
sCache <-
case maybeSchemaCache of
Just sCache ->
return sCache
Nothing ->
throwError Error.NoSchemaCacheError
body <- lift $ Wai.strictRequestBody req
dbStructure <-
case maybeDbStructure of
Just dbStructure ->
return dbStructure
Nothing ->
throwError Error.ConnectionLostError
apiRequest@ApiRequest{..} <-
apiRequest <-
liftEither . mapLeft Error.ApiRequestError $
ApiRequest.userApiRequest conf dbStructure req body
ApiRequest.userApiRequest conf sCache req body
-- The JWT must be checked before touching the db
jwtClaims <- Auth.jwtClaims conf (toUtf8Lazy iJWT) time
Response.optionalRollback conf apiRequest $
handleRequest authResult conf appState (Query.txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements jsonDbS pgVer apiRequest sCache
let
handleReq apiReq =
handleRequest $ RequestContext conf dbStructure apiReq pgVer
runDbHandler pool (txMode apiRequest) jwtClaims (configDbPreparedStatements conf) .
Middleware.optionalRollback conf apiRequest $
Middleware.runPgLocals conf jwtClaims handleReq apiRequest jsonDbS pgVer
runDbHandler :: SQL.Pool -> SQL.Mode -> Auth.JWTClaims -> Bool -> DbHandler a -> Handler IO a
runDbHandler pool mode jwtClaims prepared handler = do
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 . SQL.use pool . transaction SQL.ReadCommitted mode $ runExceptT handler
lift . AppState.usePool appState . transaction SQL.ReadCommitted mode $ runExceptT handler
resp <-
liftEither . mapLeft Error.PgErr $
mapLeft (Error.PgError $ Auth.containsRole jwtClaims) dbResp
mapLeft (Error.PgError authenticated) dbResp
liftEither resp
handleRequest :: RequestContext -> DbHandler Wai.Response
handleRequest context@(RequestContext _ _ ApiRequest{..} _) =
handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> SQL.Mode -> Bool -> Bool -> ByteString -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response
handleRequest AuthResult{..} conf appState mode authenticated prepared jsonDbS pgVer apiReq@ApiRequest{..} sCache =
case (iAction, iTarget) of
(ActionRead headersOnly, TargetIdent identifier) ->
handleRead headersOnly identifier context
(ActionCreate, TargetIdent identifier) ->
handleCreate identifier context
(ActionUpdate, TargetIdent identifier) ->
handleUpdate identifier context
(ActionSingleUpsert, TargetIdent identifier) ->
handleSingleUpsert identifier context
(ActionDelete, TargetIdent identifier) ->
handleDelete identifier context
(ActionInfo, TargetIdent identifier) ->
handleInfo identifier context
(ActionInvoke invMethod, TargetProc proc _) ->
handleInvoke invMethod proc context
(ActionInspect headersOnly, TargetDefaultSpec tSchema) ->
handleOpenApi headersOnly tSchema context
_ ->
throwError Error.NotFound
(ActionRead headersOnly, TargetIdent identifier) -> do
rPlan <- liftEither $ Plan.readPlan identifier conf sCache apiReq
resultSet <- runQuery $ Query.readQuery rPlan conf apiReq
return $ Response.readResponse headersOnly identifier apiReq resultSet
handleRead :: Bool -> QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleRead headersOnly identifier context@RequestContext{..} = do
req <- readRequest identifier context
bField <- binaryField context req
(ActionMutate MutationCreate, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache
resultSet <- runQuery $ Query.createQuery mrPlan apiReq conf
return $ Response.createResponse identifier mrPlan apiReq resultSet
let
ApiRequest{..} = ctxApiRequest
AppConfig{..} = ctxConfig
countQuery = QueryBuilder.readRequestToCountQuery req
(ActionMutate MutationUpdate, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache
resultSet <- runQuery $ Query.updateQuery mrPlan apiReq conf
return $ Response.updateResponse apiReq resultSet
(tableTotal, queryTotal, _ , body, gucHeaders, gucStatus) <-
lift . SQL.statement mempty $
Statements.createReadStatement
(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
)
(iAcceptContentType == CTSingularJSON)
(shouldCount iPreferCount)
(iAcceptContentType == CTTextCSV)
bField
configDbPreparedStatements
(ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache
resultSet <- runQuery $ Query.singleUpsertQuery mrPlan apiReq conf
return $ Response.singleUpsertResponse apiReq resultSet
total <- readTotal ctxConfig ctxApiRequest tableTotal countQuery
response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders
(ActionMutate MutationDelete, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache
resultSet <- runQuery $ Query.deleteQuery mrPlan apiReq conf
return $ Response.deleteResponse apiReq resultSet
let
(status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange queryTotal total
headers =
[ contentRange
, ( "Content-Location"
, "/"
<> toUtf8 (qiName identifier)
<> if BS.null iCanonicalQS then mempty else "?" <> iCanonicalQS
)
]
++ contentTypeHeaders context
(ActionInvoke invMethod, TargetProc proc _) -> do
cPlan <- liftEither $ Plan.callReadPlan proc conf sCache apiReq
resultSet <- runQuery $ Query.invokeQuery proc cPlan apiReq conf
return $ Response.invokeResponse invMethod proc apiReq resultSet
failNotSingular iAcceptContentType queryTotal . response status headers $
if headersOnly then mempty else LBS.fromStrict body
(ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
oaiResult <- runQuery $ Query.openApiQuery sCache pgVer conf tSchema
return $ Response.openApiResponse headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile
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.createExplainStatement countQuery $
configDbPreparedStatements
handleCreate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
let
ApiRequest{..} = ctxApiRequest
pkCols = tablePKCols ctxDbStructure qiSchema qiName
WriteQueryResult{..} <- writeQuery identifier True pkCols context
let
response = gucResponse resGucStatus resGucHeaders
headers =
catMaybes
[ if null resFields then
Nothing
else
Just
( HTTP.hLocation
, "/"
<> toUtf8 qiName
<> HTTP.renderSimpleQuery True (splitKeyValue <$> resFields)
)
, Just . RangeQuery.contentRangeH 1 0 $
if shouldCount iPreferCount then Just resQueryTotal else Nothing
, if null pkCols && isNothing iOnConflict then
Nothing
else
toAppliedHeader <$> iPreferResolution
]
failNotSingular iAcceptContentType resQueryTotal $
if iPreferRepresentation == Full then
response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict resBody)
else
response HTTP.status201 headers mempty
handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
WriteQueryResult{..} <- writeQuery identifier False mempty context
let
response = gucResponse resGucStatus resGucHeaders
fullRepr = iPreferRepresentation == Full
updateIsNoOp = S.null iColumns
status
| resQueryTotal == 0 && not updateIsNoOp = HTTP.status404
| fullRepr = HTTP.status200
| otherwise = HTTP.status204
contentRangeHeader =
RangeQuery.contentRangeH 0 (resQueryTotal - 1) $
if shouldCount iPreferCount then Just resQueryTotal else Nothing
failNotSingular iAcceptContentType resQueryTotal $
if fullRepr then
response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict resBody)
else
response status [contentRangeHeader] mempty
handleSingleUpsert :: QualifiedIdentifier -> RequestContext-> DbHandler Wai.Response
handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..} _) = do
when (iTopLevelRange /= RangeQuery.allRange) $
throwError Error.PutRangeNotAllowedError
WriteQueryResult{..} <- writeQuery identifier False mempty context
let response = gucResponse resGucStatus resGucHeaders
-- 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 (resQueryTotal /= 1) $ do
lift SQL.condemn
throwError Error.PutMatchingPkError
return $
if iPreferRepresentation == Full then
response HTTP.status200 (contentTypeHeaders context) (LBS.fromStrict resBody)
else
response HTTP.status204 (contentTypeHeaders context) mempty
handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do
WriteQueryResult{..} <- writeQuery identifier False mempty context
let
response = gucResponse resGucStatus resGucHeaders
contentRangeHeader =
RangeQuery.contentRangeH 1 0 $
if shouldCount iPreferCount then Just resQueryTotal else Nothing
failNotSingular iAcceptContentType resQueryTotal $
if iPreferRepresentation == Full then
response HTTP.status200
(contentTypeHeaders context ++ [contentRangeHeader])
(LBS.fromStrict resBody)
else
response HTTP.status204 [contentRangeHeader] mempty
handleInfo :: Monad m => QualifiedIdentifier -> RequestContext -> Handler m Wai.Response
handleInfo identifier RequestContext{..} =
case find tableMatches $ dbTables ctxDbStructure of
Just table ->
return $ Wai.responseLBS HTTP.status200 [allOrigins, allowH table] mempty
Nothing ->
throwError Error.NotFound
where
allOrigins = ("Access-Control-Allow-Origin", "*")
allowH table =
( HTTP.hAllow
, BS.intercalate "," $
["OPTIONS,GET,HEAD"]
++ ["POST" | tableInsertable table]
++ ["PUT" | tableInsertable table && tableUpdatable table && hasPK]
++ ["PATCH" | tableUpdatable table]
++ ["DELETE" | tableDeletable table]
)
tableMatches table =
tableName table == qiName identifier
&& tableSchema table == qiSchema identifier
hasPK =
not $ null $ tablePKCols ctxDbStructure (qiSchema identifier) (qiName identifier)
handleInvoke :: InvokeMethod -> ProcDescription -> RequestContext -> DbHandler Wai.Response
handleInvoke invMethod proc context@RequestContext{..} = do
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
(tableTotal, queryTotal, body, gucHeaders, gucStatus) <-
lift . SQL.statement mempty $
Statements.callProcStatement
(Proc.procReturnsScalar proc)
(Proc.procReturnsSingle proc)
(QueryBuilder.requestToCallProcQuery callReq)
(QueryBuilder.readRequestToQuery req)
(QueryBuilder.readRequestToCountQuery req)
(shouldCount iPreferCount)
(iAcceptContentType == CTSingularJSON)
(iAcceptContentType == CTTextCSV)
(iPreferParameters == Just MultipleObjects)
bField
(configDbPreparedStatements ctxConfig)
response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders
let
(status, contentRange) =
RangeQuery.rangeStatusHeader iTopLevelRange queryTotal tableTotal
failNotSingular iAcceptContentType queryTotal $
response status
(contentTypeHeaders context ++ [contentRange])
(if invMethod == InvHead then mempty else LBS.fromStrict body)
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 configDbPreparedStatements)
<*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
OAIgnorePriv ->
OpenAPI.encode conf dbStructure
(filter (\x -> tableSchema x == tSchema) $ DbStructure.dbTables dbStructure)
(M.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure)
<$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
OADisabled ->
pure mempty
return $
Wai.responseLBS HTTP.status200
(ContentType.toHeader CTOpenAPI : 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
return $ Response.infoResponse iTarget sCache
_ ->
SQL.Write
-- | Result from executing a write query on the database
data WriteQueryResult = WriteQueryResult
{ resQueryTotal :: Int64
, resFields :: [ByteString]
, resBody :: ByteString
, resGucStatus :: Maybe HTTP.Status
, resGucHeaders :: [GucHeader]
}
writeQuery :: QualifiedIdentifier -> Bool -> [Text] -> RequestContext -> DbHandler WriteQueryResult
writeQuery identifier@QualifiedIdentifier{..} isInsert pkCols context@RequestContext{..} = do
readReq <- readRequest identifier context
mutateReq <-
liftEither $
ReqBuilder.mutateRequest qiSchema qiName ctxApiRequest
(tablePKCols ctxDbStructure qiSchema qiName)
readReq
(_, queryTotal, fields, body, gucHeaders, gucStatus) <-
lift . SQL.statement mempty $
Statements.createWriteStatement
(QueryBuilder.readRequestToQuery readReq)
(QueryBuilder.mutateRequestToQuery mutateReq)
(iAcceptContentType ctxApiRequest == CTSingularJSON)
isInsert
(iAcceptContentType ctxApiRequest == CTTextCSV)
(iPreferRepresentation ctxApiRequest)
pkCols
(configDbPreparedStatements ctxConfig)
liftEither $ WriteQueryResult queryTotal fields body <$> gucStatus <*> gucHeaders
-- | 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 :: ContentType -> Int64 -> Wai.Response -> DbHandler Wai.Response
failNotSingular contentType queryTotal response =
if contentType == CTSingularJSON && queryTotal /= 1 then
do
lift SQL.condemn
throwError $ Error.singularityError queryTotal
else
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{..} =
ContentType.toHeader (iAcceptContentType ctxApiRequest) : maybeToList (profileHeader ctxApiRequest)
-- | If raw(binary) output is requested, check that ContentType is one of the
-- admitted rawContentTypes and that`?select=...` contains only one field other
-- than `*`
binaryField :: Monad m => RequestContext -> ReadRequest -> Handler m (Maybe FieldName)
binaryField RequestContext{..} readReq
| returnsScalar (iTarget ctxApiRequest) && iAcceptContentType ctxApiRequest `elem` rawContentTypes ctxConfig =
return $ Just "pgrst_scalar"
| iAcceptContentType ctxApiRequest `elem` rawContentTypes ctxConfig =
let
fldNames = fstFieldNames readReq
fieldName = headMay fldNames
in
if length fldNames == 1 && fieldName /= Just "*" then
return fieldName
else
throwError $ Error.BinaryFieldError (iAcceptContentType ctxApiRequest)
| otherwise =
return Nothing
rawContentTypes :: AppConfig -> [ContentType]
rawContentTypes AppConfig{..} =
(ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain]
profileHeader :: ApiRequest -> Maybe HTTP.Header
profileHeader ApiRequest{..} =
(,) "Content-Profile" <$> (toUtf8 <$> iProfile)
splitKeyValue :: ByteString -> (ByteString, ByteString)
splitKeyValue kv =
(k, BS.tail v)
-- 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
where
(k, v) = BS.break (== '=') kv
runQuery query =
runDbHandler appState mode authenticated prepared $ do
Query.setPgLocals conf authClaims authRole apiReq jsonDbS pgVer
query
+57 -34
View File
@@ -2,30 +2,33 @@
module PostgREST.AppState
( AppState
, destroy
, flushPool
, getConfig
, getDbStructure
, getIsWorkerOn
, getSchemaCache
, getIsListenerOn
, getJsonDbS
, getMainThreadId
, getPgVersion
, getPool
, getTime
, getRetryNextIn
, getTime
, getWorkerSem
, init
, initWithPool
, logWithZTime
, putConfig
, putDbStructure
, putIsWorkerOn
, putSchemaCache
, putIsListenerOn
, putJsonDbS
, putPgVersion
, putRetryNextIn
, releasePool
, signalListener
, usePool
, waitListener
) where
import qualified Hasql.Pool as SQL
import qualified Hasql.Pool as SQL
import qualified Hasql.Session as SQL
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
updateAction)
@@ -37,22 +40,26 @@ import Data.Time.Clock (UTCTime, getCurrentTime)
import PostgREST.Config (AppConfig (..))
import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
import PostgREST.DbStructure (DbStructure)
import PostgREST.SchemaCache (SchemaCache)
import Protolude
data AppState = AppState
{ statePool :: SQL.Pool -- | Connection pool, either a 'Connection' or a 'ConnectionError'
-- | 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
, stateSchemaCache :: IORef (Maybe SchemaCache)
-- | Cached SchemaCache in json
, stateJsonDbS :: IORef ByteString
-- | Helper ref to make sure just one connectionWorker can run at a time
, stateIsWorkerOn :: IORef Bool
-- | Binary semaphore to make sure just one connectionWorker can run at a time
, stateWorkerSem :: MVar ()
-- | Binary semaphore used to sync the listener(NOTIFY reload) with the connectionWorker.
, stateListener :: MVar ()
-- | State of the LISTEN channel, used for the admin server checks
, stateIsListenerOn :: IORef Bool
-- | Config that can change at runtime
, stateConf :: IORef AppConfig
-- | Time used for verifying JWT expiration
@@ -67,32 +74,46 @@ data AppState = AppState
init :: AppConfig -> IO AppState
init conf = do
newPool <- initPool conf
initWithPool newPool conf
pool <- initPool conf
initWithPool pool conf
initWithPool :: SQL.Pool -> AppConfig -> IO AppState
initWithPool newPool conf =
AppState newPool
initWithPool pool conf =
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
<*> newIORef False
<*> newEmptyMVar
<*> newEmptyMVar
<*> newIORef False
<*> newIORef conf
<*> mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
<*> mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
<*> myThreadId
<*> newIORef 0
destroy :: AppState -> IO ()
destroy = destroyPool
initPool :: AppConfig -> IO SQL.Pool
initPool AppConfig{..} =
SQL.acquire (configDbPoolSize, configDbPoolTimeout, toUtf8 configDbUri)
SQL.acquire configDbPoolSize timeoutMilliseconds $ toUtf8 configDbUri
where
timeoutMilliseconds = (* oneSecond) <$> configDbPoolAcquisitionTimeout
oneSecond = 1000000
getPool :: AppState -> SQL.Pool
getPool = statePool
-- | Run an action with a database connection.
usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a)
usePool AppState{..} = SQL.use statePool
releasePool :: AppState -> IO ()
releasePool AppState{..} = SQL.release statePool >> throwTo stateMainThreadId UserInterrupt
-- | 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
@@ -100,12 +121,11 @@ 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 -> DbStructure -> IO ()
putDbStructure appState structure =
atomicWriteIORef (stateDbStructure appState) $ Just structure
putSchemaCache :: AppState -> Maybe SchemaCache -> IO ()
putSchemaCache appState = atomicWriteIORef (stateSchemaCache appState)
getJsonDbS :: AppState -> IO ByteString
getJsonDbS = readIORef . stateJsonDbS
@@ -113,11 +133,8 @@ getJsonDbS = readIORef . stateJsonDbS
putJsonDbS :: AppState -> ByteString -> IO ()
putJsonDbS appState = atomicWriteIORef (stateJsonDbS appState)
getIsWorkerOn :: AppState -> IO Bool
getIsWorkerOn = readIORef . stateIsWorkerOn
putIsWorkerOn :: AppState -> Bool -> IO ()
putIsWorkerOn = atomicWriteIORef . stateIsWorkerOn
getWorkerSem :: AppState -> MVar ()
getWorkerSem = stateWorkerSem
getRetryNextIn :: AppState -> IO Int
getRetryNextIn = readIORef . stateRetryNextIn
@@ -153,3 +170,9 @@ waitListener = takeMVar . stateListener
-- the connectionWorker is the only mvar producer.
signalListener :: AppState -> IO ()
signalListener appState = void $ tryPutMVar (stateListener appState) ()
getIsListenerOn :: AppState -> IO Bool
getIsListenerOn = readIORef . stateIsListenerOn
putIsListenerOn :: AppState -> Bool -> IO ()
putIsListenerOn = atomicWriteIORef . stateIsListenerOn
+73 -34
View File
@@ -12,40 +12,55 @@ very simple authentication system inside the PostgreSQL database.
-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Auth
( containsRole
, jwtClaims
, JWTClaims
( AuthResult (..)
, getResult
, getRole
, middleware
) where
import qualified Crypto.JWT as JWT
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as M
import qualified Data.Vector as V
import qualified Crypto.JWT as JWT
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.Lazy.Char8 as LBS
import qualified Data.Text.Encoding as T
import qualified Data.Vault.Lazy as Vault
import qualified Data.Vector as V
import qualified Network.HTTP.Types.Header as HTTP
import qualified Network.Wai as Wai
import qualified Network.Wai.Middleware.HttpAuth as Wai
import Control.Lens (set)
import Control.Monad.Except (liftEither)
import Data.Either.Combinators (mapLeft)
import Data.List (lookup)
import Data.Time.Clock (UTCTime)
import System.IO.Unsafe (unsafePerformIO)
import PostgREST.Config (AppConfig (..), JSPath, JSPathExp (..))
import PostgREST.Error (Error (..))
import PostgREST.AppState (AppState, getConfig, getTime)
import PostgREST.Config (AppConfig (..), JSPath, JSPathExp (..))
import PostgREST.Error (Error (..))
import Protolude
type JWTClaims = M.HashMap Text JSON.Value
data AuthResult = AuthResult
{ authClaims :: KM.KeyMap JSON.Value
, authRole :: Text
}
-- | Receives the JWT secret and audience (from config) and a JWT and returns a
-- map of JWT claims.
jwtClaims :: Monad m =>
AppConfig -> LByteString -> UTCTime -> ExceptT Error m JWTClaims
jwtClaims _ "" _ = return M.empty
jwtClaims AppConfig{..} payload time = do
-- JSON object of JWT claims.
parseToken :: Monad m =>
AppConfig -> LByteString -> UTCTime -> ExceptT Error m JSON.Value
parseToken _ "" _ = return JSON.emptyObject
parseToken AppConfig{..} token time = do
secret <- liftEither . maybeToRight JwtTokenMissing $ configJWKS
eitherClaims <-
lift . runExceptT $
JWT.verifyClaimsAt validation secret time =<< JWT.decodeCompact payload
liftEither . mapLeft jwtClaimsError $ claimsMap configJwtRoleClaimKey <$> eitherClaims
JWT.verifyClaimsAt validation secret time =<< JWT.decodeCompact token
liftEither . mapLeft jwtClaimsError $ JSON.toJSON <$> eitherClaims
where
validation =
JWT.defaultJWTValidationSettings audienceCheck & set JWT.allowedSkew 1
@@ -57,26 +72,50 @@ jwtClaims AppConfig{..} payload time = do
jwtClaimsError JWT.JWTExpired = JwtTokenInvalid "JWT expired"
jwtClaimsError e = JwtTokenInvalid $ show e
-- | Turn JWT ClaimSet into something easier to work with.
--
-- Also, here the jspath is applied to put the "role" in the map.
claimsMap :: JSPath -> JWT.ClaimsSet -> JWTClaims
claimsMap jspath claims =
case JSON.toJSON claims of
val@(JSON.Object o) ->
M.delete "role" o `M.union` role val
_ ->
M.empty
parseClaims :: Monad m =>
AppConfig -> JSON.Value -> ExceptT Error m AuthResult
parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
-- role defaults to anon if not specified in jwt
role <- liftEither . maybeToRight JwtTokenRequired $
unquoted <$> walkJSPath (Just jclaims) configJwtRoleClaimKey <|> configDbAnonRole
return AuthResult
{ authClaims = mclaims & KM.insert "role" (JSON.toJSON role)
, authRole = role
}
where
role value =
maybe M.empty (M.singleton "role") $ walkJSPath (Just value) jspath
walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value
walkJSPath x [] = x
walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (M.lookup key o) rest
walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (KM.lookup (K.fromText key) o) rest
walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest
walkJSPath _ _ = Nothing
-- | Whether a response from jwtClaims contains a role claim
containsRole :: JWTClaims -> Bool
containsRole = M.member "role"
unquoted :: JSON.Value -> Text
unquoted (JSON.String t) = t
unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
-- impossible case - just added to please -Wincomplete-patterns
parseClaims _ _ = return AuthResult { authClaims = KM.empty, authRole = mempty }
-- | Validate authorization header.
-- Parse and store JWT claims for future use in the request.
middleware :: AppState -> Wai.Middleware
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 req' = req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
app req' respond
authResultKey :: Vault.Key (Either Error AuthResult)
authResultKey = unsafePerformIO Vault.newKey
{-# NOINLINE authResultKey #-}
getResult :: Wai.Request -> Maybe (Either Error AuthResult)
getResult = Vault.lookup authResultKey . Wai.vault
getRole :: Wai.Request -> Maybe Text
getRole req = authRole <$> (rightToMaybe =<< getResult req)
+91 -97
View File
@@ -11,7 +11,6 @@ module PostgREST.CLI
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Hasql.Pool as SQL
import qualified Hasql.Transaction.Sessions as SQL
import qualified Options.Applicative as O
@@ -20,7 +19,7 @@ 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)
@@ -35,40 +34,37 @@ main :: App.SignalHandlerInstaller -> Maybe App.SocketRunner -> CLI -> IO ()
main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
conf@AppConfig{..} <-
either panic identity <$> Config.readAppConfig mempty cliPath Nothing
appState <- AppState.init conf
-- Override the config with config options from the db
-- TODO: the same operation is repeated on connectionWorker, ideally this
-- would be done only once, but dump CmdDumpConfig needs it for tests.
when configDbConfig $ reReadConfig True appState
-- Per https://github.com/PostgREST/postgrest/issues/268, we want to
-- explicitly close the connections to PostgreSQL on shutdown.
-- 'AppState.destroy' takes care of that.
bracket
(AppState.init conf)
AppState.destroy
(\appState -> case cliCommand of
CmdDumpConfig -> do
when configDbConfig $ reReadConfig True appState
putStr . Config.toText =<< AppState.getConfig appState
CmdDumpSchema -> putStrLn =<< dumpSchema appState
CmdRun -> App.run installSignalHandlers runAppWithSocket appState)
exec cliCommand appState
where
exec :: Command -> AppState -> IO ()
exec CmdDumpConfig appState = putStr . Config.toText =<< AppState.getConfig appState
exec CmdDumpSchema appState = putStrLn =<< dumpSchema appState
exec CmdRun appState = App.run installSignalHandlers runAppWithSocket appState
-- | Dump DbStructure schema to JSON
-- | Dump SchemaCache schema to JSON
dumpSchema :: AppState -> IO LBS.ByteString
dumpSchema appState = do
AppConfig{..} <- AppState.getConfig appState
actualPgVersion <- AppState.getPgVersion appState
result <-
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
SQL.use (AppState.getPool appState) $
AppState.usePool appState $
transaction SQL.ReadCommitted SQL.Read $
queryDbStructure
querySchemaCache
(toList configDbSchemas)
configDbExtraSearchPath
actualPgVersion
configDbPreparedStatements
SQL.release $ AppState.getPool appState
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
@@ -82,12 +78,12 @@ data Command
| CmdDumpSchema
-- | Read command line interface options. Also prints help.
readCLIShowHelp :: Bool -> IO CLI
readCLIShowHelp hasEnvironment =
readCLIShowHelp :: IO CLI
readCLIShowHelp =
O.customExecParser prefs opts
where
prefs = O.prefs $ O.showHelpOnError <> O.showHelpOnEmpty
opts = O.info parser $ O.fullDesc <> progDesc <> footer
opts = O.info parser $ O.fullDesc <> progDesc
parser = O.helper <*> exampleParser <*> cliParser
progDesc =
@@ -96,11 +92,6 @@ readCLIShowHelp hasEnvironment =
<> BS.unpack prettyVersion
<> " / create a REST API to an existing Postgres database"
footer =
O.footer $
"To run PostgREST, please pass the FILENAME argument"
<> " or set PGRST_ environment variables."
exampleParser =
O.infoOption exampleConfigFile $
O.long "example"
@@ -111,12 +102,12 @@ readCLIShowHelp hasEnvironment =
cliParser =
CLI
<$> (dumpConfigFlag <|> dumpSchemaFlag)
<*> optionalIf hasEnvironment configFileOption
<*> O.optional configFileOption
configFileOption =
O.strArgument $
O.metavar "FILENAME"
<> O.help "Path to configuration file (optional with PGRST_ environment variables)"
<> O.help "Path to configuration file"
dumpConfigFlag =
O.flag CmdRun CmdDumpConfig $
@@ -128,36 +119,13 @@ readCLIShowHelp hasEnvironment =
O.long "dump-schema"
<> O.help "Dump loaded schema as JSON and exit (for debugging, output structure is unstable)"
optionalIf :: Alternative f => Bool -> f a -> f (Maybe a)
optionalIf True = O.optional
optionalIf False = fmap Just
exampleConfigFile :: [Char]
exampleConfigFile =
[str|### REQUIRED:
|db-uri = "postgres://user:pass@localhost:5432/dbname"
|db-schema = "public"
|db-anon-role = "postgres"
[str|## Admin server used for checks. It's disabled by default unless a port is specified.
|# admin-server-port = 3001
|
|### OPTIONAL:
|## number of open connections in the pool
|db-pool = 10
|
|## Time to live, in seconds, for an idle database pool connection.
|db-pool-timeout = 10
|
|## extra schemas to add to the search_path of every request
|db-extra-search-path = "public"
|
|## limit rows in response
|# db-max-rows = 1000
|
|## stored proc to exec immediately after auth
|# db-pre-request = "stored_proc_name"
|
|## stored proc that overrides the root "/" spec
|## it must be inside the db-schema
|# db-root-spec = "stored_proc_name"
|## The database role to use when no client authentication is provided
|# db-anon-role = "anon"
|
|## Notification channel for reloading the schema cache
|db-channel = "pgrst"
@@ -168,56 +136,82 @@ exampleConfigFile =
|## Enable in-database configuration
|db-config = true
|
|## Extra schemas to add to the search_path of every request
|db-extra-search-path = "public"
|
|## Limit rows in response
|# db-max-rows = 1000
|
|## Allow getting the EXPLAIN plan through the `Accept: application/vnd.pgrst.plan` header
|# db-plan-enabled = false
|
|## Number of open connections in the pool
|db-pool = 10
|
|## Time in seconds to wait to acquire a slot from the connection pool
|# db-pool-acquisition-timeout = 10
|
|## Stored proc to exec immediately after auth
|# db-pre-request = "stored_proc_name"
|
|## Enable or disable prepared statements. disabling is only necessary when behind a connection pooler.
|## When disabled, statements will be parametrized but won't be prepared.
|db-prepared-statements = true
|
|## The name of which database schema to expose to REST clients
|db-schemas = "public"
|
|## How to terminate database transactions
|## Possible values are:
|## commit (default)
|## Transaction is always committed, this can not be overriden
|## commit-allow-override
|## Transaction is committed, but can be overriden with Prefer tx=rollback header
|## rollback
|## Transaction is always rolled back, this can not be overriden
|## rollback-allow-override
|## Transaction is rolled back, but can be overriden with Prefer tx=commit header
|db-tx-end = "commit"
|
|## The standard connection URI format, documented at
|## 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
|
|## how to terminate database transactions
|## possible values are:
|## commit (default)
|## transaction is always committed, this can not be overriden
|## commit-allow-override
|## transaction is committed, but can be overriden with Prefer tx=rollback header
|## rollback
|## transaction is always rolled back, this can not be overriden
|## rollback-allow-override
|## transaction is rolled back, but can be overriden with Prefer tx=commit header
|db-tx-end = "commit"
|# jwt-aud = "your_audience_claim"
|
|## enable or disable prepared statements. disabling is only necessary when behind a connection pooler.
|## when disabled, statements will be parametrized but won't be prepared.
|db-prepared-statements = true
|## Jspath to the role claim key
|jwt-role-claim-key = ".role"
|
|## Choose a secret, JSON Web Key (or set) to enable JWT auth
|## (use "@filename" to load from separate file)
|# jwt-secret = "secret_with_at_least_32_characters"
|jwt-secret-is-base64 = false
|
|## Logging level, the admitted values are: crit, error, warn and info.
|log-level = "error"
|
|## Determine if the OpenAPI output should follow or ignore role privileges or be disabled entirely.
|## Admitted values: follow-privileges, ignore-privileges, disabled
|openapi-mode = "follow-privileges"
|
|## Base url for the OpenAPI output
|openapi-server-proxy-uri = ""
|
|## Content types to produce raw output
|# raw-media-types="image/png, image/jpg"
|
|server-host = "!4"
|server-port = 3000
|
|## unix socket location
|## Unix socket location
|## if specified it takes precedence over server-port
|# server-unix-socket = "/tmp/pgrst.sock"
|
|## unix socket file mode
|## when none is provided, 660 is applied by default
|## Unix socket file mode
|## When none is provided, 660 is applied by default
|# server-unix-socket-mode = "660"
|
|## determine if the OpenAPI output should follow or ignore role privileges or be disabled entirely
|## admitted values: follow-privileges, ignore-privileges, disabled
|openapi-mode = "follow-privileges"
|
|## base url for the OpenAPI output
|openapi-server-proxy-uri = ""
|
|## choose a secret, JSON Web Key (or set) to enable JWT auth
|## (use "@filename" to load from separate file)
|# jwt-secret = "secret_with_at_least_32_characters"
|# jwt-aud = "your_audience_claim"
|jwt-secret-is-base64 = false
|
|## jspath to the role claim key
|jwt-role-claim-key = ".role"
|
|## content types to produce raw output
|# raw-media-types="image/png, image/jpg"
|
|## logging level, the admitted values are: crit, error, warn and info.
|log-level = "error"
|]
+59 -63
View File
@@ -46,7 +46,6 @@ import Data.List (lookup)
import Data.List.NonEmpty (fromList, toList)
import Data.Maybe (fromJust)
import Data.Scientific (floatingOrInteger)
import Data.Time.Clock (NominalDiffTime)
import Numeric (readOct, showOct)
import System.Environment (getEnvironment)
import System.Posix.Types (FileMode)
@@ -55,44 +54,48 @@ import PostgREST.Config.JSPath (JSPath, JSPathExp (..),
dumpJSPath, pRoleClaimKey)
import PostgREST.Config.Proxy (Proxy (..),
isMalformedProxyUri, toURI)
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi,
import PostgREST.MediaType (MediaType (..), toMime)
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier, dumpQi,
toQi)
import Protolude hiding (Proxy, toList)
data AppConfig = AppConfig
{ configAppSettings :: [(Text, Text)]
, configDbAnonRole :: Text
, configDbChannel :: Text
, configDbChannelEnabled :: Bool
, configDbExtraSearchPath :: [Text]
, configDbMaxRows :: Maybe Integer
, 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
, configOpenApiServerProxyUri :: Maybe Text
, configRawMediaTypes :: [BS.ByteString]
, configServerHost :: Text
, configServerPort :: Int
, configServerUnixSocket :: Maybe FilePath
, configServerUnixSocketMode :: FileMode
{ configAppSettings :: [(Text, Text)]
, configDbAnonRole :: Maybe Text
, configDbChannel :: Text
, configDbChannelEnabled :: Bool
, configDbExtraSearchPath :: [Text]
, configDbMaxRows :: Maybe Integer
, configDbPlanEnabled :: Bool
, configDbPoolSize :: Int
, configDbPoolAcquisitionTimeout :: Maybe Int
, 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
}
data LogLevel = LogCrit | LogError | LogWarn | LogInfo
@@ -120,18 +123,19 @@ toText conf =
where
-- apply conf to all pgrst settings
pgrstSettings = (\(k, v) -> (k, v conf)) <$>
[("db-anon-role", q . configDbAnonRole)
[("db-anon-role", q . 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", maybe "\"\"" show . configDbPoolAcquisitionTimeout)
,("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", q . T.toLower . show . configDbConfig)
,("db-config", T.toLower . show . configDbConfig)
,("db-tx-end", q . showTxEnd)
,("db-uri", q . configDbUri)
,("db-use-legacy-gucs", T.toLower . show . configDbUseLegacyGucs)
@@ -141,12 +145,14 @@ toText conf =
,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)
,("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 "," . configRawMediaTypes)
,("raw-media-types", q . T.decodeUtf8 . BS.intercalate "," . fmap toMime . configRawMediaTypes)
,("server-host", q . configServerHost)
,("server-port", show . configServerPort)
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
,("server-unix-socket-mode", q . T.pack . showSocketMode)
,("admin-server-port", maybe "\"\"" show . configAdminServerPort)
]
-- quote all app.settings
@@ -173,10 +179,10 @@ class JustIfMaybe a b where
justIfMaybe :: a -> b
instance JustIfMaybe a a where
justIfMaybe a = a
justIfMaybe = identity
instance JustIfMaybe a (Maybe a) where
justIfMaybe a = Just a
justIfMaybe = Just
-- | Reads and parses the config and overrides its parameters from env vars,
-- files or db settings.
@@ -205,26 +211,26 @@ parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> C.Parser C.Config A
parser optPath env dbSettings =
AppConfig
<$> parseAppSettings "app.settings"
<*> reqString "db-anon-role"
<*> optString "db-anon-role"
<*> (fromMaybe "pgrst" <$> optString "db-channel")
<*> (fromMaybe True <$> optBool "db-channel-enabled")
<*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path")
<*> optWithAlias (optInt "db-max-rows")
(optInt "max-rows")
<*> (fromMaybe False <$> optBool "db-plan-enabled")
<*> (fromMaybe 10 <$> optInt "db-pool")
<*> (fromIntegral . fromMaybe 10 <$> optInt "db-pool-timeout")
<*> optInt "db-pool-acquisition-timeout"
<*> (fmap toQi <$> optWithAlias (optString "db-pre-request")
(optString "pre-request"))
<*> (fromMaybe True <$> optBool "db-prepared-statements")
<*> (fmap toQi <$> optWithAlias (optString "db-root-spec")
(optString "root-spec"))
<*> (fromList . splitOnCommas <$> reqWithAlias (optValue "db-schemas")
(optValue "db-schema")
"missing key: either db-schemas or db-schema must be set")
<*> (fromList . maybe ["public"] splitOnCommas <$> optWithAlias (optValue "db-schemas")
(optValue "db-schema"))
<*> (fromMaybe True <$> optBool "db-config")
<*> parseTxEnd "db-tx-end" snd
<*> parseTxEnd "db-tx-end" fst
<*> reqString "db-uri"
<*> (fromMaybe "postgresql://" <$> optString "db-uri")
<*> (fromMaybe True <$> optBool "db-use-legacy-gucs")
<*> pure optPath
<*> pure Nothing
@@ -236,12 +242,14 @@ parser optPath env dbSettings =
(optBool "secret-is-base64"))
<*> parseLogLevel "log-level"
<*> parseOpenAPIMode "openapi-mode"
<*> (fromMaybe False <$> optBool "openapi-security-active")
<*> parseOpenAPIServerProxyURI "openapi-server-proxy-uri"
<*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types")
<*> (maybe [] (fmap (MTOther . encodeUtf8) . splitOnCommas) <$> optValue "raw-media-types")
<*> (fromMaybe "!4" <$> optString "server-host")
<*> (fromMaybe 3000 <$> optInt "server-port")
<*> (fmap T.unpack <$> optString "server-unix-socket")
<*> parseSocketFileMode "server-unix-socket-mode"
<*> optInt "admin-server-port"
where
parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)]
parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value
@@ -314,24 +322,12 @@ parser optPath env dbSettings =
Nothing -> pure [JSPKey "role"]
Just rck -> either (fail . show) pure $ pRoleClaimKey rck
reqWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> [Char] -> C.Parser C.Config a
reqWithAlias orig alias err =
orig >>= \case
Just v -> pure v
Nothing ->
alias >>= \case
Just v -> pure v
Nothing -> fail err
optWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a)
optWithAlias orig alias =
orig >>= \case
Just v -> pure $ Just v
Nothing -> alias
reqString :: C.Key -> C.Parser C.Config Text
reqString k = overrideFromDbOrEnvironment C.required k coerceText
optString :: C.Key -> C.Parser C.Config (Maybe Text)
optString k = mfilter (/= "") <$> overrideFromDbOrEnvironment C.optional k coerceText
@@ -358,8 +354,8 @@ parser optPath env dbSettings =
reloadableDbSetting =
let dbSettingName = T.pack $ dashToUnderscore <$> toS key in
if dbSettingName `notElem` [
"server_host", "server_port", "server_unix_socket", "server_unix_socket_mode", "log_level",
"db_anon_role", "db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_pool_timeout", "db_config"]
"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_acquisition_timeout", "db_config"]
then lookup dbSettingName dbSettings
else Nothing
@@ -369,17 +365,17 @@ parser optPath env dbSettings =
coerceInt :: (Read i, Integral i) => C.Value -> Maybe i
coerceInt (C.Number x) = rightToMaybe $ floatingOrInteger x
coerceInt (C.String x) = readMaybe $ toS x
coerceInt (C.String x) = readMaybe x
coerceInt _ = Nothing
coerceBool :: C.Value -> Maybe Bool
coerceBool (C.Bool b) = Just b
coerceBool (C.String s) =
-- parse all kinds of text: True, true, TRUE, "true", ...
case readMaybe . toS $ T.toTitle $ T.filter isAlpha $ toS s of
case readMaybe $ T.toTitle $ T.filter isAlpha $ toS s of
Just b -> Just b
-- numeric instead?
Nothing -> (> 0) <$> (readMaybe $ toS s :: Maybe Integer)
Nothing -> (> 0) <$> (readMaybe s :: Maybe Integer)
coerceBool _ = Nothing
splitOnCommas :: C.Value -> [Text]
+27 -18
View File
@@ -1,7 +1,8 @@
{-# LANGUAGE QuasiQuotes #-}
module PostgREST.Config.Database
( queryDbSettings
( pgVersionStatement
, queryDbSettings
, queryPgVersion
) where
@@ -9,7 +10,6 @@ import PostgREST.Config.PgVersion (PgVersion (..))
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
import qualified Hasql.Pool as SQL
import Hasql.Session (Session, statement)
import qualified Hasql.Statement as SQL
import qualified Hasql.Transaction as SQL
@@ -20,35 +20,44 @@ import Text.InterpolatedString.Perl6 (q)
import Protolude
queryPgVersion :: Session PgVersion
queryPgVersion = statement mempty $ SQL.Statement sql HE.noParams versionRow False
queryPgVersion = statement mempty pgVersionStatement
pgVersionStatement :: SQL.Statement () PgVersion
pgVersionStatement = SQL.Statement sql HE.noParams versionRow False
where
sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text
queryDbSettings :: SQL.Pool -> Bool -> IO (Either SQL.UsageError [(Text, Text)])
queryDbSettings pool prepared =
queryDbSettings :: Bool -> Session [(Text, Text)]
queryDbSettings prepared =
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
SQL.use pool . transaction SQL.ReadCommitted SQL.Read $
SQL.statement mempty dbSettingsStatement
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
where
sql = [q|
with
role_setting as (
select setdatabase, 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))
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))
),
kv_settings as (
select setdatabase, split_part(setting, '=', 1) as k, split_part(setting, '=', 2) as value from role_setting
where setting like 'pgrst.%'
kv_settings (database, k, v) AS (
SELECT database,
substr(setting, 1, strpos(setting, '=') - 1),
substr(setting, strpos(setting, '=') + 1)
FROM role_setting
WHERE setting LIKE 'pgrst.%'
)
select distinct on (key) replace(k, 'pgrst.', '') as key, value
from kv_settings
order by key, setdatabase desc;
SELECT DISTINCT ON (key)
replace(k, 'pgrst.', '') AS key,
v AS value
FROM kv_settings
ORDER BY key, database DESC;
|]
decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text
+4
View File
@@ -9,6 +9,7 @@ module PostgREST.Config.PgVersion
, pgVersion110
, pgVersion112
, pgVersion114
, pgVersion120
, pgVersion121
, pgVersion130
, pgVersion140
@@ -50,6 +51,9 @@ pgVersion112 = PgVersion 110002 "11.2"
pgVersion114 :: PgVersion
pgVersion114 = PgVersion 110004 "11.4"
pgVersion120 :: PgVersion
pgVersion120 = PgVersion 120000 "12.0"
pgVersion121 :: PgVersion
pgVersion121 = PgVersion 120001 "12.1"
-64
View File
@@ -1,64 +0,0 @@
{-# LANGUAGE DuplicateRecordFields #-}
module PostgREST.ContentType
( ContentType(..)
, toHeader
, toMime
, decodeContentType
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (c2w)
import Network.HTTP.Types.Header (Header, hContentType)
import Protolude
-- | Enumeration of currently supported response content types
data ContentType
= CTApplicationJSON
| CTSingularJSON
| CTTextCSV
| CTTextPlain
| CTOpenAPI
| CTUrlEncoded
| CTOctetStream
| CTAny
| CTOther ByteString
deriving (Eq)
-- | Convert from ContentType to a full HTTP Header
toHeader :: ContentType -> Header
toHeader ct = (hContentType, toMime ct <> charset)
where
charset = case ct of
CTOctetStream -> mempty
CTOther _ -> mempty
_ -> "; charset=utf-8"
-- | Convert from ContentType to a ByteString representing the mime type
toMime :: ContentType -> ByteString
toMime CTApplicationJSON = "application/json"
toMime CTTextCSV = "text/csv"
toMime CTTextPlain = "text/plain"
toMime CTOpenAPI = "application/openapi+json"
toMime CTSingularJSON = "application/vnd.pgrst.object+json"
toMime CTUrlEncoded = "application/x-www-form-urlencoded"
toMime CTOctetStream = "application/octet-stream"
toMime CTAny = "*/*"
toMime (CTOther ct) = ct
-- | Convert from ByteString to ContentType. Warning: discards MIME parameters
decodeContentType :: BS.ByteString -> ContentType
decodeContentType ct =
case BS.takeWhile (/= BS.c2w ';') ct of
"application/json" -> CTApplicationJSON
"text/csv" -> CTTextCSV
"text/plain" -> CTTextPlain
"application/openapi+json" -> CTOpenAPI
"application/vnd.pgrst.object+json" -> CTSingularJSON
"application/vnd.pgrst.object" -> CTSingularJSON
"application/x-www-form-urlencoded" -> CTUrlEncoded
"application/octet-stream" -> CTOctetStream
"*/*" -> CTAny
ct' -> CTOther ct'
+42
View File
@@ -0,0 +1,42 @@
{-|
Module : PostgREST.Cors
Description : Wai Middleware to set cors policy.
-}
module PostgREST.Cors (middleware) where
import qualified Data.ByteString.Char8 as BS
import qualified Data.CaseInsensitive as CI
import qualified Network.Wai as Wai
import qualified Network.Wai.Middleware.Cors as Wai
import Data.List (lookup)
import Protolude
middleware :: Wai.Middleware
middleware = Wai.cors corsPolicy
-- | 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 ->
Just Wai.CorsResourcePolicy
{ Wai.corsOrigins = Just ([origin], True)
, Wai.corsMethods = ["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"]
, Wai.corsRequestHeaders = "Authorization" : accHeaders
, Wai.corsExposedHeaders = Just
[ "Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
, "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"]
, Wai.corsMaxAge = Just $ 60*60*24
, Wai.corsVaryOrigin = False
, Wai.corsRequireOrigin = False
, Wai.corsIgnoreFailures = True
}
Nothing -> Nothing
where
headers = Wai.requestHeaders req
accHeaders = case lookup "access-control-request-headers" headers of
Just hdrs -> map (CI.mk . BS.strip) $ BS.split ',' hdrs
-- Impossible case, Middleware.Cors will not evaluate this when
-- the Access-Control-Request-Headers header is not set.
Nothing -> []
-924
View File
@@ -1,924 +0,0 @@
{-|
Module : PostgREST.DbStructure
Description : PostgREST schema cache
This module contains queries that target PostgreSQL system catalogs, these are used to build the schema cache(DbStructure).
The schema cache is necessary for resource embedding, foreign keys are used for inferring the relationships between tables.
These queries are executed once at startup or when PostgREST is reloaded.
-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
module PostgREST.DbStructure
( DbStructure(..)
, queryDbStructure
, accessibleTables
, accessibleProcs
, schemaDescription
, tableCols
, tablePKCols
) where
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as M
import qualified Data.List as L
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 Data.Set as S (fromList)
import Data.Text (split)
import Text.InterpolatedString.Perl6 (q)
import PostgREST.Config.PgVersion (PgVersion, pgVersion100)
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
Schema, TableName)
import PostgREST.DbStructure.Proc (PgType (..),
ProcDescription (..),
ProcParam (..),
ProcVolatility (..),
ProcsMap, RetType (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
Junction (..),
PrimaryKey (..),
Relationship (..))
import PostgREST.DbStructure.Table (Column (..), Table (..))
import Protolude
import Protolude.Unsafe (unsafeHead)
data DbStructure = DbStructure
{ dbTables :: [Table]
, dbColumns :: [Column]
, dbRelationships :: [Relationship]
, dbPrimaryKeys :: [PrimaryKey]
, dbProcs :: ProcsMap
}
deriving (Generic, JSON.ToJSON)
-- TODO Table could hold references to all its Columns
tableCols :: DbStructure -> Schema -> TableName -> [Column]
tableCols dbs tSchema tName = filter (\Column{colTable=Table{tableSchema=s, tableName=t}} -> s==tSchema && t==tName) $ dbColumns dbs
-- TODO Table could hold references to all its PrimaryKeys
tablePKCols :: DbStructure -> Schema -> TableName -> [Text]
tablePKCols dbs tSchema tName = pkName <$> filter (\pk -> tSchema == (tableSchema . pkTable) pk && tName == (tableName . pkTable) pk) (dbPrimaryKeys dbs)
-- | The source table column a view column refers to
type SourceColumn = (Column, ViewColumn)
type ViewColumn = Column
-- | A SQL query that can be executed independently
type SqlQuery = ByteString
queryDbStructure :: [Schema] -> [Schema] -> PgVersion -> Bool -> SQL.Transaction DbStructure
queryDbStructure schemas extraSearchPath pgVer prepared = 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
tabs <- SQL.statement mempty $ allTables pgVer prepared
cols <- SQL.statement schemas $ allColumns tabs prepared
srcCols <- SQL.statement (schemas, extraSearchPath) $ pfkSourceColumns cols prepared
m2oRels <- SQL.statement mempty $ allM2ORels tabs cols prepared
keys <- SQL.statement mempty $ allPrimaryKeys tabs prepared
procs <- SQL.statement schemas $ allProcs prepared
let rels = addO2MRels . addM2MRels $ addViewM2ORels srcCols m2oRels
keys' = addViewPrimaryKeys srcCols keys
return $ removeInternal schemas $ DbStructure {
dbTables = tabs
, dbColumns = cols
, dbRelationships = rels
, dbPrimaryKeys = keys'
, dbProcs = procs
}
-- | Remove db objects that belong to an internal schema(not exposed through the API) from the DbStructure.
removeInternal :: [Schema] -> DbStructure -> DbStructure
removeInternal schemas dbStruct =
DbStructure {
dbTables = filter (\x -> tableSchema x `elem` schemas) $ dbTables dbStruct
, dbColumns = filter (\x -> tableSchema (colTable x) `elem` schemas) (dbColumns dbStruct)
, dbRelationships = filter (\x -> tableSchema (relTable x) `elem` schemas &&
tableSchema (relForeignTable x) `elem` schemas &&
not (hasInternalJunction x)) $ dbRelationships dbStruct
, dbPrimaryKeys = filter (\x -> tableSchema (pkTable x) `elem` schemas) $ dbPrimaryKeys dbStruct
, dbProcs = dbProcs dbStruct -- procs are only obtained from the exposed schemas, no need to filter them.
}
where
hasInternalJunction rel = case relCardinality rel of
M2M Junction{junTable} -> tableSchema junTable `notElem` schemas
_ -> False
decodeTables :: HD.Result [Table]
decodeTables =
HD.rowList tblRow
where
tblRow = Table <$> column HD.text
<*> column HD.text
<*> nullableColumn HD.text
<*> column HD.bool
<*> column HD.bool
<*> column HD.bool
decodeColumns :: [Table] -> HD.Result [Column]
decodeColumns tables =
mapMaybe (columnFromRow tables) <$> HD.rowList colRow
where
colRow =
(,,,,,,,,)
<$> column HD.text
<*> column HD.text
<*> column HD.text
<*> nullableColumn HD.text
<*> column HD.bool
<*> column HD.text
<*> nullableColumn HD.int4
<*> nullableColumn HD.text
<*> nullableColumn HD.text
decodeRels :: [Table] -> [Column] -> HD.Result [Relationship]
decodeRels tables cols =
mapMaybe (relFromRow tables cols) <$> HD.rowList relRow
where
relRow = (,,,,,,)
<$> column HD.text
<*> column HD.text
<*> column HD.text
<*> arrayColumn HD.text
<*> column HD.text
<*> column HD.text
<*> arrayColumn HD.text
decodePks :: [Table] -> HD.Result [PrimaryKey]
decodePks tables =
mapMaybe (pkFromRow tables) <$> HD.rowList pkRow
where
pkRow = (,,) <$> column HD.text <*> column HD.text <*> column HD.text
decodeSourceColumns :: [Column] -> HD.Result [SourceColumn]
decodeSourceColumns cols =
mapMaybe (sourceColumnFromRow cols) <$> HD.rowList srcColRow
where
srcColRow = (,,,,,)
<$> column HD.text <*> column HD.text
<*> column HD.text <*> column HD.text
<*> column HD.text <*> column HD.text
sourceColumnFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe SourceColumn
sourceColumnFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
where
col1 = findCol s1 t1 c1
col2 = findCol s2 t2 c2
findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
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 . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey) <$> HD.rowList procRow
where
procRow = ProcDescription
<$> column HD.text
<*> column HD.text
<*> nullableColumn HD.text
<*> compositeArrayColumn
(ProcParam
<$> compositeField HD.text
<*> compositeField HD.text
<*> compositeField HD.bool
<*> compositeField HD.bool)
<*> (parseRetType
<$> column HD.text
<*> column HD.text
<*> column HD.bool
<*> column HD.bool)
<*> (parseVolatility <$> column HD.char)
<*> column HD.bool
addKey :: ProcDescription -> (QualifiedIdentifier, ProcDescription)
addKey pd = (QualifiedIdentifier (pdSchema pd) (pdName pd), pd)
parseRetType :: Text -> Text -> Bool -> Bool -> RetType
parseRetType schema name isSetOf isComposite
| isSetOf = SetOf pgType
| otherwise = Single pgType
where
qi = QualifiedIdentifier schema name
pgType
| isComposite = Composite qi
| otherwise = Scalar
parseVolatility :: Char -> ProcVolatility
parseVolatility v | v == 'i' = Immutable
| v == 's' = Stable
| otherwise = Volatile -- only 'v' can happen here
allProcs :: Bool -> SQL.Statement [Schema] ProcsMap
allProcs = SQL.Statement sql (arrayParam HE.text) decodeProcs
where
sql = procsSqlQuery <> " WHERE pn.nspname = ANY($1)"
accessibleProcs :: Bool -> SQL.Statement Schema ProcsMap
accessibleProcs = SQL.Statement sql (param HE.text) decodeProcs
where
sql = procsSqlQuery <> " WHERE pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
procsSqlQuery :: SqlQuery
procsSqlQuery = [q|
-- Recursively get the base types of domains
WITH
base_types AS (
WITH RECURSIVE
recurse AS (
SELECT
oid,
typbasetype,
COALESCE(NULLIF(typbasetype, 0), oid) AS base
FROM pg_type
UNION
SELECT
t.oid,
b.typbasetype,
COALESCE(NULLIF(b.typbasetype, 0), b.oid) AS base
FROM recurse t
JOIN pg_type b ON t.typbasetype = b.oid
)
SELECT
oid,
base
FROM recurse
WHERE typbasetype = 0
),
arguments AS (
SELECT
oid,
array_agg((
COALESCE(name, ''), -- name
type::regtype::text, -- type
idx <= (pronargs - pronargdefaults), -- is_required
COALESCE(mode = 'v', FALSE) -- is_variadic
) ORDER BY idx) AS args
FROM pg_proc,
unnest(proargnames, proargtypes, proargmodes)
WITH ORDINALITY AS _ (name, type, mode, idx)
WHERE type IS NOT NULL -- only input arguments
GROUP BY oid
)
SELECT
pn.nspname AS proc_schema,
p.proname AS proc_name,
d.description AS proc_description,
COALESCE(a.args, '{}') AS args,
tn.nspname AS schema,
COALESCE(comp.relname, t.typname) AS name,
p.proretset AS rettype_is_setof,
(t.typtype = 'c'
-- if any TABLE, INOUT or OUT arguments present, treat as composite
or COALESCE(proargmodes::text[] && '{t,b,o}', false)
) AS rettype_is_composite,
p.provolatile,
p.provariadic > 0 as hasvariadic
FROM pg_proc p
LEFT JOIN arguments a ON a.oid = p.oid
JOIN pg_namespace pn ON pn.oid = p.pronamespace
JOIN base_types bt ON bt.oid = p.prorettype
JOIN pg_type t ON t.oid = bt.base
JOIN pg_namespace tn ON tn.oid = t.typnamespace
LEFT JOIN pg_class comp ON comp.oid = t.typrelid
LEFT JOIN pg_catalog.pg_description as d ON d.objoid = p.oid
|]
schemaDescription :: Bool -> SQL.Statement Schema (Maybe Text)
schemaDescription =
SQL.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text))
where
sql = [q|
select
description
from
pg_catalog.pg_namespace n
left join pg_catalog.pg_description d on d.objoid = n.oid
where
n.nspname = $1 |]
accessibleTables :: PgVersion -> Bool -> SQL.Statement Schema [Table]
accessibleTables pgVer =
SQL.Statement sql (param HE.text) decodeTables
where
sql = [q|
select
n.nspname as table_schema,
relname as table_name,
d.description as table_description,
(
c.relkind IN ('r','p')
OR (
c.relkind IN ('v','f')
-- CMD_INSERT - see allTables query below for explanation
AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 8) = 8
)
) AS insertable,
(
c.relkind IN ('r','p')
OR (
c.relkind IN ('v','f')
-- CMD_UPDATE
AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 4) = 4
)
) as updatable,
(
c.relkind IN ('r','p')
OR (
c.relkind IN ('v','f')
-- CMD_DELETE
AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 16) = 16
)
) as deletable
from
pg_class c
join pg_namespace n on n.oid = c.relnamespace
left join pg_catalog.pg_description as d on d.objoid = c.oid and d.objsubid = 0
where
c.relkind in ('v','r','m','f','p')
and n.nspname = $1 |]
<> relIsNotPartition pgVer <> [q|
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')
)
order by relname |]
{-
Adds Views M2O Relationships based on SourceColumns found, the logic is as follows:
Having a Relationship{relTable=t1, relColumns=[c1], relFTable=t2, relFColumns=[c2], relCardinality=M2O} represented by:
t1.c1------t2.c2
When only having a t1_view.c1 source column, we need to add a View-Table M2O Relationship
t1.c1----t2.c2 t1.c1----------t2.c2
-> ________/
/
t1_view.c1 t1_view.c1
When only having a t2_view.c2 source column, we need to add a Table-View M2O Relationship
t1.c1----t2.c2 t1.c1----------t2.c2
-> \________
\
t2_view.c2 t2_view.c1
When having t1_view.c1 and a t2_view.c2 source columns, we need to add a View-View M2O Relationship in addition to the prior
t1.c1----t2.c2 t1.c1----------t2.c2
-> \________/
/ \
t1_view.c1 t2_view.c2 t1_view.c1-------t2_view.c1
The logic for composite pks is similar just need to make sure all the Relationship columns have source columns.
-}
addViewM2ORels :: [SourceColumn] -> [Relationship] -> [Relationship]
addViewM2ORels allSrcCols = concatMap (\rel@Relationship{..} -> rel :
let
srcColsGroupedByView :: [Column] -> [[SourceColumn]]
srcColsGroupedByView relCols = L.groupBy (\(_, viewCol1) (_, viewCol2) -> colTable viewCol1 == colTable viewCol2) $
filter (\(c, _) -> c `elem` relCols) allSrcCols
relSrcCols = srcColsGroupedByView relColumns
relFSrcCols = srcColsGroupedByView relForeignColumns
getView :: [SourceColumn] -> Table
getView = colTable . snd . unsafeHead
srcCols `allSrcColsOf` cols = S.fromList (fst <$> srcCols) == S.fromList cols
-- Relationship is dependent on the order of relColumns and relFColumns to get the join conditions right in the generated query.
-- So we need to change the order of the SourceColumns to match the relColumns
-- TODO: This could be avoided if the Relationship type is improved with a structure that maintains the association of relColumns and relFColumns
srcCols `sortAccordingTo` cols = sortOn (\(k, _) -> L.lookup k $ zip cols [0::Int ..]) srcCols
viewTableM2O =
[ Relationship
(getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
relForeignTable relForeignColumns relCardinality
| srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ]
tableViewM2O =
[ Relationship
relTable relColumns
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relForeignColumns)
relCardinality
| fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relForeignColumns ]
viewViewM2O =
[ Relationship
(getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns)
(getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relForeignColumns)
relCardinality
| srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns
, fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relForeignColumns ]
in viewTableM2O ++ tableViewM2O ++ viewViewM2O)
addO2MRels :: [Relationship] -> [Relationship]
addO2MRels rels = rels ++ [ Relationship ft fc t c (O2M cons)
| Relationship t c ft fc (M2O cons) <- rels ]
addM2MRels :: [Relationship] -> [Relationship]
addM2MRels rels = rels ++ [ Relationship t c ft fc (M2M $ Junction jt1 cons1 jc1 cons2 jc2)
| Relationship jt1 jc1 t c (M2O cons1) <- rels
, Relationship jt2 jc2 ft fc (M2O cons2) <- rels
, jt1 == jt2
, cons1 /= cons2]
addViewPrimaryKeys :: [SourceColumn] -> [PrimaryKey] -> [PrimaryKey]
addViewPrimaryKeys srcCols = concatMap (\pk ->
let viewPks = (\(_, viewCol) -> PrimaryKey{pkTable=colTable viewCol, pkName=colName viewCol}) <$>
filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) srcCols in
pk : viewPks)
allTables :: PgVersion -> Bool -> SQL.Statement () [Table]
allTables pgVer =
SQL.Statement sql HE.noParams decodeTables
where
sql = [q|
SELECT
n.nspname AS table_schema,
c.relname AS table_name,
d.description AS table_description,
(
c.relkind IN ('r','p')
OR (
c.relkind in ('v','f')
-- The function `pg_relation_is_updateable` returns a bitmask where 8
-- corresponds to `1 << CMD_INSERT` in the PostgreSQL source code, i.e.
-- it's possible to insert into the relation.
AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 8) = 8
)
) AS insertable,
(
c.relkind IN ('r','p')
OR (
c.relkind in ('v','f')
-- CMD_UPDATE
AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 4) = 4
)
) AS updatable,
(
c.relkind IN ('r','p')
OR (
c.relkind in ('v','f')
-- CMD_DELETE
AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 16) = 16
)
) AS deletable
FROM pg_class c
JOIN pg_namespace n ON n.oid = c.relnamespace
LEFT JOIN pg_catalog.pg_description as d on d.objoid = c.oid and d.objsubid = 0
WHERE c.relkind IN ('v','r','m','f','p')
AND n.nspname NOT IN ('pg_catalog', 'information_schema') |]
<> relIsNotPartition pgVer <> [q|
ORDER BY table_schema, table_name |]
relIsNotPartition :: PgVersion -> SqlQuery
relIsNotPartition pgVer = if pgVer >= pgVersion100 then " AND not c.relispartition " else mempty
allColumns :: [Table] -> Bool -> SQL.Statement [Schema] [Column]
allColumns tabs =
SQL.Statement sql (arrayParam HE.text) (decodeColumns tabs)
where
sql = [q|
SELECT DISTINCT
info.table_schema AS schema,
info.table_name AS table_name,
info.column_name AS name,
info.description AS description,
info.is_nullable::boolean AS nullable,
info.data_type AS col_type,
info.character_maximum_length AS max_len,
info.column_default AS default_value,
array_to_string(enum_info.vals, ',') AS enum,
info.position
FROM (
-- CTE based on pg_catalog to get PRIMARY/FOREIGN key and UNIQUE columns outside api schema
WITH key_columns AS (
SELECT
r.oid AS r_oid,
c.oid AS c_oid,
n.nspname,
c.relname,
r.conname,
r.contype,
unnest(r.conkey) AS conkey
FROM
pg_catalog.pg_constraint r,
pg_catalog.pg_class c,
pg_catalog.pg_namespace n
WHERE
r.contype IN ('f', 'p', 'u')
AND c.relkind IN ('r', 'v', 'f', 'm', 'p')
AND r.conrelid = c.oid
AND c.relnamespace = n.oid
AND n.nspname <> ANY (ARRAY['pg_catalog', 'information_schema'] || $1)
),
/*
-- CTE based on information_schema.columns
-- changed:
-- remove the owner filter
-- limit columns to the ones in the api schema or PK/FK columns
*/
columns AS (
SELECT
nc.nspname::name AS table_schema,
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,
not (a.attnotnull OR t.typtype = 'd' AND t.typnotnull) AS is_nullable,
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,
information_schema._pg_char_max_length(
information_schema._pg_truetypid(a.*, t.*),
information_schema._pg_truetypmod(a.*, t.*)
)::integer AS character_maximum_length,
COALESCE(bt.typname, t.typname)::name AS udt_name,
a.attnum::integer AS position
FROM pg_attribute a
LEFT JOIN key_columns kc
ON kc.conkey = a.attnum AND kc.c_oid = a.attrelid
LEFT JOIN pg_catalog.pg_description AS d
ON d.objoid = a.attrelid and d.objsubid = a.attnum
LEFT JOIN pg_attrdef ad
ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum
JOIN (pg_class c JOIN pg_namespace nc ON c.relnamespace = nc.oid)
ON a.attrelid = c.oid
JOIN (pg_type t JOIN pg_namespace nt ON t.typnamespace = nt.oid)
ON a.atttypid = t.oid
LEFT JOIN (pg_type bt JOIN pg_namespace nbt ON bt.typnamespace = nbt.oid)
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)
WHERE
NOT pg_is_other_temp_schema(nc.oid)
AND a.attnum > 0
AND NOT a.attisdropped
AND c.relkind in ('r', 'v', 'f', 'm', 'p')
-- Filter only columns that are FK/PK or in the api schema:
AND (nc.nspname = ANY ($1) OR kc.r_oid IS NOT NULL)
)
SELECT
table_schema,
table_name,
column_name,
description,
is_nullable,
data_type,
character_maximum_length,
column_default,
udt_name,
position
FROM columns
WHERE table_schema NOT IN ('pg_catalog', 'information_schema')
) AS info
LEFT OUTER JOIN (
SELECT
n.nspname AS s,
t.typname AS n,
array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals
FROM pg_type t
JOIN pg_enum e ON t.oid = e.enumtypid
JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace
GROUP BY s,n
) AS enum_info ON (info.udt_name = enum_info.n)
ORDER BY schema, position |]
columnFromRow :: [Table] ->
(Text, Text, Text,
Maybe Text, Bool, Text,
Maybe Int32, Maybe Text, Maybe Text)
-> Maybe Column
columnFromRow tabs (s, t, n, desc, nul, typ, l, d, e) = buildColumn <$> table
where
buildColumn tbl = Column tbl n desc nul typ l d (parseEnum e)
table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
parseEnum :: Maybe Text -> [Text]
parseEnum = maybe [] (split (==','))
allM2ORels :: [Table] -> [Column] -> Bool -> SQL.Statement () [Relationship]
allM2ORels tabs cols =
SQL.Statement sql HE.noParams (decodeRels tabs cols)
where
sql = [q|
SELECT ns1.nspname AS table_schema,
tab.relname AS table_name,
conname AS constraint_name,
column_info.cols AS columns,
ns2.nspname AS foreign_table_schema,
other.relname AS foreign_table_name,
column_info.refs AS foreign_columns
FROM pg_constraint,
LATERAL (
SELECT array_agg(cols.attname) AS cols,
array_agg(cols.attnum) AS nums,
array_agg(refs.attname) AS refs
FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
LATERAL (SELECT * FROM pg_attribute WHERE attrelid = conrelid AND attnum = col) AS cols,
LATERAL (SELECT * FROM pg_attribute WHERE attrelid = confrelid AND attnum = ref) AS refs) AS column_info,
LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
WHERE confrelid != 0
ORDER BY (conrelid, column_info.nums) |]
relFromRow :: [Table] -> [Column] -> (Text, Text, Text, [Text], Text, Text, [Text]) -> Maybe Relationship
relFromRow allTabs allCols (rs, rt, cn, rcs, frs, frt, frcs) =
Relationship <$> table <*> cols <*> tableF <*> colsF <*> pure (M2O cn)
where
findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
findCol s t c = find (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col == c) allCols
table = findTable rs rt
tableF = findTable frs frt
cols = mapM (findCol rs rt) rcs
colsF = mapM (findCol frs frt) frcs
allPrimaryKeys :: [Table] -> Bool -> SQL.Statement () [PrimaryKey]
allPrimaryKeys tabs =
SQL.Statement sql HE.noParams (decodePks tabs)
where
sql = [q|
-- CTE to replace information_schema.table_constraints to remove owner limit
WITH tc AS (
SELECT
c.conname::name AS constraint_name,
nr.nspname::name AS table_schema,
r.relname::name AS table_name
FROM pg_namespace nc,
pg_namespace nr,
pg_constraint c,
pg_class r
WHERE
nc.oid = c.connamespace
AND nr.oid = r.relnamespace
AND c.conrelid = r.oid
AND r.relkind IN ('r', 'p')
AND NOT pg_is_other_temp_schema(nr.oid)
AND c.contype = 'p'
),
-- CTE to replace information_schema.key_column_usage to remove owner limit
kc AS (
SELECT
ss.conname::name AS constraint_name,
ss.nr_nspname::name AS table_schema,
ss.relname::name AS table_name,
a.attname::name AS column_name,
(ss.x).n::integer AS ordinal_position,
CASE
WHEN ss.contype = 'f' THEN information_schema._pg_index_position(ss.conindid, ss.confkey[(ss.x).n])
ELSE NULL::integer
END::integer AS position_in_unique_constraint
FROM pg_attribute a,
( SELECT r.oid AS roid,
r.relname,
r.relowner,
nc.nspname AS nc_nspname,
nr.nspname AS nr_nspname,
c.oid AS coid,
c.conname,
c.contype,
c.conindid,
c.confkey,
information_schema._pg_expandarray(c.conkey) AS x
FROM pg_namespace nr,
pg_class r,
pg_namespace nc,
pg_constraint c
WHERE
nr.oid = r.relnamespace
AND r.oid = c.conrelid
AND nc.oid = c.connamespace
AND c.contype in ('p', 'u', 'f')
AND r.relkind IN ('r', 'p')
AND NOT pg_is_other_temp_schema(nr.oid)
) ss
WHERE
ss.roid = a.attrelid
AND a.attnum = (ss.x).x
AND NOT a.attisdropped
)
SELECT
kc.table_schema,
kc.table_name,
kc.column_name
FROM
tc, kc
WHERE
kc.table_name = tc.table_name AND
kc.table_schema = tc.table_schema AND
kc.constraint_name = tc.constraint_name AND
kc.table_schema NOT IN ('pg_catalog', 'information_schema') |]
pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
-- returns all the primary and foreign key columns which are referenced in views
pfkSourceColumns :: [Column] -> Bool -> SQL.Statement ([Schema], [Schema]) [SourceColumn]
pfkSourceColumns cols =
SQL.Statement sql (contrazip2 (arrayParam HE.text) (arrayParam HE.text)) (decodeSourceColumns cols)
-- query explanation at:
-- * rationale: https://gist.github.com/wolfgangwalther/5425d64e7b0d20aad71f6f68474d9f19
-- * json transformation: https://gist.github.com/wolfgangwalther/3a8939da680c24ad767e93ad2c183089
where
sql = [q|
with recursive
pks_fks as (
-- pk + fk referencing col
select
conrelid as resorigtbl,
unnest(conkey) as resorigcol
from pg_constraint
where contype IN ('p', 'f')
union
-- fk referenced col
select
confrelid,
unnest(confkey)
from pg_constraint
where contype='f'
),
views as (
select
c.oid as view_id,
n.nspname as view_schema,
c.relname as view_name,
r.ev_action as view_definition
from pg_class c
join pg_namespace n on n.oid = c.relnamespace
join pg_rewrite r on r.ev_class = c.oid
where c.relkind in ('v', 'm') and n.nspname = ANY($1 || $2)
),
transform_json as (
select
view_id, view_schema, view_name,
-- the following formatting is without indentation on purpose
-- to allow simple diffs, with less whitespace noise
replace(
replace(
replace(
replace(
replace(
replace(
replace(
replace(
regexp_replace(
replace(
replace(
replace(
replace(
replace(
replace(
replace(
replace(
replace(
replace(
view_definition::text,
-- This conversion to json is heavily optimized for performance.
-- The general idea is to use as few regexp_replace() calls as possible.
-- Simple replace() is a lot faster, so we jump through some hoops
-- to be able to use regexp_replace() only once.
-- This has been tested against a huge schema with 250+ different views.
-- The unit tests do NOT reflect all possible inputs. Be careful when changing this!
-- -----------------------------------------------
-- pattern | replacement | flags
-- -----------------------------------------------
-- `,` is not part of the pg_node_tree format, but used in the regex.
-- This removes all `,` that might be part of column names.
',' , ''
-- The same applies for `{` and `}`, although those are used a lot in pg_node_tree.
-- We remove the escaped ones, which might be part of column names again.
), E'\\{' , ''
), E'\\}' , ''
-- The fields we need are formatted as json manually to protect them from the regex.
), ' :targetList ' , ',"targetList":'
), ' :resno ' , ',"resno":'
), ' :resorigtbl ' , ',"resorigtbl":'
), ' :resorigcol ' , ',"resorigcol":'
-- Make the regex also match the node type, e.g. `{QUERY ...`, to remove it in one pass.
), '{' , '{ :'
-- Protect node lists, which start with `({` or `((` from the greedy regex.
-- The extra `{` is removed again later.
), '((' , '{(('
), '({' , '{({'
-- This regex removes all unused fields to avoid the need to format all of them correctly.
-- This leads to a smaller json result as well.
-- Removal stops at `,` for used fields (see above) and `}` for the end of the current node.
-- Nesting can't be parsed correctly with a regex, so we stop at `{` as well and
-- add an empty key for the followig node.
), ' :[^}{,]+' , ',"":' , 'g'
-- For performance, the regex also added those empty keys when hitting a `,` or `}`.
-- Those are removed next.
), ',"":}' , '}'
), ',"":,' , ','
-- This reverses the "node list protection" from above.
), '{(' , '('
-- Every key above has been added with a `,` so far. The first key in an object doesn't need it.
), '{,' , '{'
-- pg_node_tree has `()` around lists, but JSON uses `[]`
), '(' , '['
), ')' , ']'
-- pg_node_tree has ` ` between list items, but JSON uses `,`
), ' ' , ','
-- `<>` in pg_node_tree is the same as `null` in JSON, but due to very poor performance of json_typeof
-- we need to make this an empty array here to prevent json_array_elements from throwing an error
-- when the targetList is null.
), '<>' , '[]'
)::json as view_definition
from views
),
target_entries as(
select
view_id, view_schema, view_name,
json_array_elements(view_definition->0->'targetList') as entry
from transform_json
),
results as(
select
view_id, view_schema, view_name,
(entry->>'resno')::int as view_column,
(entry->>'resorigtbl')::oid as resorigtbl,
(entry->>'resorigcol')::int as resorigcol
from target_entries
),
recursion as(
select r.*
from results r
where view_schema = ANY ($1)
union all
select
view.view_id,
view.view_schema,
view.view_name,
view.view_column,
tab.resorigtbl,
tab.resorigcol
from recursion view
join results tab on view.resorigtbl=tab.view_id and view.resorigcol=tab.view_column
)
select
sch.nspname as table_schema,
tbl.relname as table_name,
col.attname as table_column_name,
rec.view_schema,
rec.view_name,
vcol.attname as view_column_name
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
join pks_fks using (resorigtbl, resorigcol)
order by view_schema, view_name, view_column_name; |]
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
compositeArrayColumn :: HD.Composite a -> HD.Row [a]
compositeArrayColumn = arrayColumn . HD.composite
compositeField :: HD.Value a -> HD.Composite a
compositeField = HD.field . HD.nonNullable
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
arrayColumn :: HD.Value a -> HD.Row [a]
arrayColumn = column . HD.listArray . HD.nonNullable
-62
View File
@@ -1,62 +0,0 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module PostgREST.DbStructure.Relationship
( Cardinality(..)
, PrimaryKey(..)
, Relationship(..)
, Junction(..)
, isSelfReference
) where
import qualified Data.Aeson as JSON
import PostgREST.DbStructure.Table (Column (..), Table (..))
import Protolude
-- | Relationship between two tables.
--
-- The order of the relColumns and relForeignColumns should be maintained to get the
-- join conditions right.
--
-- TODO merge relColumns and relForeignColumns to a tuple or Data.Bimap
data Relationship = Relationship
{ relTable :: Table
, relColumns :: [Column]
, relForeignTable :: Table
, relForeignColumns :: [Column]
, relCardinality :: Cardinality
}
deriving (Eq, Generic, JSON.ToJSON)
-- | The relationship cardinality
-- | https://en.wikipedia.org/wiki/Cardinality_(data_modeling)
-- TODO: missing one-to-one
data Cardinality
= O2M FKConstraint -- ^ one-to-many cardinality
| M2O FKConstraint -- ^ many-to-one cardinality
| M2M Junction -- ^ many-to-many cardinality
deriving (Eq, Generic, JSON.ToJSON)
type FKConstraint = Text
-- | Junction table on an M2M relationship
data Junction = Junction
{ junTable :: Table
, junConstraint1 :: FKConstraint
, junColumns1 :: [Column]
, junConstraint2 :: FKConstraint
, junColumns2 :: [Column]
}
deriving (Eq, Generic, JSON.ToJSON)
isSelfReference :: Relationship -> Bool
isSelfReference r = relTable r == relForeignTable r
data PrimaryKey = PrimaryKey
{ pkTable :: Table
, pkName :: Text
}
deriving (Generic, JSON.ToJSON)
+448 -167
View File
@@ -17,6 +17,8 @@ module PostgREST.Error
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
import qualified Data.FuzzySet as Fuzzy
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
@@ -29,16 +31,20 @@ import Network.Wai (Response, responseLBS)
import Network.HTTP.Types.Header (Header)
import PostgREST.ContentType (ContentType (..))
import qualified PostgREST.ContentType as ContentType
import PostgREST.ApiRequest.Types (ApiRequestError (..),
QPError (..),
RangeError (..))
import PostgREST.MediaType (MediaType (..))
import qualified PostgREST.MediaType as MediaType
import PostgREST.DbStructure.Proc (ProcDescription (..),
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
Schema)
import PostgREST.SchemaCache.Proc (ProcDescription (..),
ProcParam (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
import PostgREST.SchemaCache.Relationship (Cardinality (..),
Junction (..),
Relationship (..))
import PostgREST.DbStructure.Table (Column (..), Table (..))
Relationship (..),
RelationshipsMap)
import Protolude
@@ -52,108 +58,279 @@ class (JSON.ToJSON a) => PgrstError a where
errorResponseFor :: a -> Response
errorResponseFor err = responseLBS (status err) (headers err) $ errorPayload err
data ApiRequestError
= ActionInappropriate
| InvalidRange
| InvalidBody ByteString
| ParseRequestError Text Text
| NoRelBetween Text Text
| AmbiguousRelBetween Text Text [Relationship]
| AmbiguousRpc [ProcDescription]
| NoRpc Text Text [Text] Bool ContentType Bool
| InvalidFilters
| UnacceptableSchema [Text]
| ContentTypeError [ByteString]
| UnsupportedVerb -- Unreachable?
instance PgrstError ApiRequestError where
status InvalidRange = HTTP.status416
status InvalidFilters = HTTP.status405
status (InvalidBody _) = HTTP.status400
status UnsupportedVerb = HTTP.status405
status ActionInappropriate = HTTP.status405
status (ParseRequestError _ _) = HTTP.status400
status (NoRelBetween _ _) = HTTP.status400
status AmbiguousRelBetween{} = HTTP.status300
status (AmbiguousRpc _) = HTTP.status300
status AmbiguousRpc{} = HTTP.status300
status BinaryFieldError{} = HTTP.status406
status MediaTypeError{} = HTTP.status415
status InvalidBody{} = HTTP.status400
status InvalidFilters = HTTP.status405
status InvalidRpcMethod{} = HTTP.status405
status InvalidRange{} = HTTP.status416
status NotFound = HTTP.status404
status NoRelBetween{} = HTTP.status400
status NoRpc{} = HTTP.status404
status (UnacceptableSchema _) = HTTP.status406
status (ContentTypeError _) = HTTP.status415
status NotEmbedded{} = HTTP.status400
status ParseRequestError{} = HTTP.status400
status PutRangeNotAllowedError = HTTP.status400
status QueryParamError{} = HTTP.status400
status UnacceptableSchema{} = HTTP.status406
status UnsupportedMethod{} = HTTP.status405
status LimitNoOrderError = HTTP.status400
headers _ = [ContentType.toHeader CTApplicationJSON]
headers _ = [MediaType.toContentType MTApplicationJSON]
instance JSON.ToJSON ApiRequestError where
toJSON (ParseRequestError message details) = JSON.object [
"message" .= message, "details" .= details]
toJSON ActionInappropriate = JSON.object [
"message" .= ("Bad Request" :: Text)]
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 [
"message" .= T.decodeUtf8 errorMessage]
toJSON InvalidRange = JSON.object [
"message" .= ("HTTP Range error" :: Text)]
toJSON (NoRelBetween parent child) = JSON.object [
"hint" .= ("If a new foreign key between these entities was created in the database, try reloading the schema cache." :: Text),
"message" .= ("Could not find a relationship between " <> parent <> " and " <> child <> " in the schema cache" :: Text)]
toJSON (AmbiguousRelBetween parent child rels) = JSON.object [
"hint" .= ("Try changing '" <> child <> "' to one of the following: " <> relHint rels <> ". Find the desired relationship in the 'details' key." :: Text),
"message" .= ("Could not embed because more than one relationship was found for '" <> parent <> "' and '" <> child <> "'" :: Text),
"details" .= (compressedRel <$> rels) ]
toJSON (AmbiguousRpc procs) = JSON.object [
"hint" .= ("Try renaming the parameters or the function itself in the database so function overloading can be resolved" :: Text),
"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])]
toJSON (NoRpc schema procName argumentKeys hasPreferSingleObject contentType isInvPost) =
let prms = "(" <> T.intercalate ", " argumentKeys <> ")" in JSON.object [
"hint" .= ("If a new function was created in the database with this name and parameters, try reloading the schema cache." :: Text),
"message" .= ("Could not find the " <> schema <> "." <> procName <>
(case (hasPreferSingleObject, isInvPost, contentType) of
(True, _, _) -> " function with a single json or jsonb parameter"
(_, True, CTTextPlain) -> " function with a single unnamed text parameter"
(_, True, CTOctetStream) -> " function with a single unnamed bytea parameter"
(_, True, CTApplicationJSON) -> prms <> " function or the " <> schema <> "." <> procName <>" function with a single unnamed json or jsonb parameter"
_ -> prms <> " function") <>
" in the schema cache")]
toJSON UnsupportedVerb = JSON.object [
"message" .= ("Unsupported HTTP verb" :: Text)]
"code" .= ApiRequestErrorCode02,
"message" .= T.decodeUtf8 errorMessage,
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (InvalidRange rangeError) = JSON.object [
"code" .= ApiRequestErrorCode03,
"message" .= ("Requested range not satisfiable" :: Text),
"details" .= (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 -> "An offset of " <> lower <> " was requested, but there are only " <> total <> " rows."),
"hint" .= JSON.Null]
toJSON (ParseRequestError message details) = JSON.object [
"code" .= ApiRequestErrorCode04,
"message" .= message,
"details" .= details,
"hint" .= JSON.Null]
toJSON InvalidFilters = JSON.object [
"message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text)]
"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 [
"message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas)]
toJSON (ContentTypeError cts) = JSON.object [
"message" .= ("None of these Content-Types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts))]
"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 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 (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 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 (UnsupportedMethod method) = JSON.object [
"code" .= ApiRequestErrorCode17,
"message" .= ("Unsupported HTTP method: " <> T.decodeUtf8 method),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (NoRelBetween parent child embedHint schema allRels) = JSON.object [
"code" .= SchemaCacheErrorCode00,
"message" .= ("Could not find a relationship between '" <> parent <> "' and '" <> child <> "' in the schema cache" :: Text),
"details" .= ("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."),
"hint" .= noRelBetweenHint parent child schema allRels]
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 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 JSON.object [
"code" .= SchemaCacheErrorCode02,
"message" .= ("Could not find the function " <> func <> (if onlySingleParams then "" else fmtPrms prmsMsg) <> " in the schema cache"),
"details" .= ("Searched for the function " <> func <>
(case (hasPreferSingleObject, isInvPost, contentType) of
(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
"hint" .= if onlySingleParams
then Nothing
else noRpcHint schema procName argumentKeys allProcs overloadedProcs ]
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)]
-- |
-- 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 = [ProcDescription {pdParams = [ProcParam {ppName="val"}, ProcParam {ppName="param"}, ProcParam {ppName="name"}]}, ProcDescription {pdParams = [ProcParam {ppName="id"}, ProcParam {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] -> [ProcDescription] -> 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
compressedRel ComputedRelationship{} = JSON.object mempty
compressedRel Relationship{..} =
let
fmtTbl Table{..} = tableSchema <> "." <> tableName
fmtEls els = "[" <> T.intercalate ", " els <> "]"
fmtEls els = "(" <> T.intercalate ", " els <> ")"
in
JSON.object $
("embedding" .= (tableName relTable <> " with " <> tableName relForeignTable :: Text))
("embedding" .= (qiName relTable <> " with " <> qiName relForeignTable :: Text))
: case relCardinality of
M2M Junction{..} -> [
"cardinality" .= ("many-to-many" :: Text)
, "relationship" .= (fmtTbl junTable <> fmtEls [junConstraint1] <> fmtEls [junConstraint2])
, "relationship" .= (qiName junTable <> " using " <> junConstraint1 <> fmtEls (snd <$> junColsSource) <> " and " <> junConstraint2 <> fmtEls (snd <$> junColsTarget))
]
M2O cons -> [
M2O cons relColumns -> [
"cardinality" .= ("many-to-one" :: Text)
, "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))
, "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns))
]
O2M cons -> [
O2O cons relColumns -> [
"cardinality" .= ("one-to-one" :: Text)
, "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns))
]
O2M cons relColumns -> [
"cardinality" .= ("one-to-many" :: Text)
, "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))
, "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns))
]
relHint :: [Relationship] -> Text
relHint rels = T.intercalate ", " (hintList <$> rels)
where
hintList Relationship{..} =
let buildHint rel = "'" <> tableName relForeignTable <> "!" <> rel <> "'" in
let buildHint rel = "'" <> qiName relForeignTable <> "!" <> rel <> "'" in
case relCardinality of
M2M Junction{..} -> buildHint (tableName junTable)
M2O cons -> buildHint cons
O2M cons -> buildHint cons
M2M Junction{..} -> buildHint (qiName junTable)
M2O cons _ -> buildHint cons
O2O cons _ -> buildHint cons
O2M cons _ -> buildHint cons
-- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed
hintList ComputedRelationship{} = mempty
data PgError = PgError Authenticated SQL.UsageError
type Authenticated = Bool
@@ -163,61 +340,55 @@ instance PgrstError PgError where
headers err =
if status err == HTTP.status401
then [ContentType.toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
else [ContentType.toHeader CTApplicationJSON]
then [MediaType.toContentType MTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
else [MediaType.toContentType MTApplicationJSON]
instance JSON.ToJSON PgError where
toJSON (PgError _ usageError) = JSON.toJSON usageError
instance JSON.ToJSON SQL.UsageError where
toJSON (SQL.ConnectionError e) = JSON.object [
"code" .= ("" :: Text),
toJSON (SQL.ConnectionUsageError e) = JSON.object [
"code" .= ConnectionErrorCode00,
"message" .= ("Database connection error. Retrying the connection." :: Text),
"details" .= (T.decodeUtf8With T.lenientDecode $ fromMaybe "" e :: Text)]
toJSON (SQL.SessionError e) = JSON.toJSON e -- SQL.Error
"details" .= (T.decodeUtf8With T.lenientDecode $ fromMaybe "" e :: Text),
"hint" .= JSON.Null]
toJSON (SQL.SessionUsageError e) = JSON.toJSON e -- SQL.Error
toJSON SQL.AcquisitionTimeoutUsageError = JSON.object [
"code" .= ConnectionErrorCode00,
"message" .= ("Timed out acquiring connection from connection pool." :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
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)) = case BS.unpack c of
'P':'T':_ -> JSON.object [
"details" .= fmap T.decodeUtf8 d,
"hint" .= fmap T.decodeUtf8 h]
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)]
_ -> 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.ResultError resultError) = JSON.object [
"code" .= InternalErrorCode00,
"message" .= (show resultError :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (SQL.ResultError (SQL.UnexpectedResult m)) = JSON.object [
"message" .= (m :: Text)]
toJSON (SQL.ResultError (SQL.RowError i SQL.EndOfInput)) = JSON.object [
"message" .= ("Row error: end of input" :: Text),
"details" .= ("Attempt to parse more columns than there are in the result" :: Text),
"hint" .= (("Row number " <> show i) :: Text)]
toJSON (SQL.ResultError (SQL.RowError i SQL.UnexpectedNull)) = JSON.object [
"message" .= ("Row error: unexpected null" :: Text),
"details" .= ("Attempt to parse a NULL as some value." :: Text),
"hint" .= (("Row number " <> show i) :: Text)]
toJSON (SQL.ResultError (SQL.RowError i (SQL.ValueError d))) = JSON.object [
"message" .= ("Row error: Wrong value parser used" :: Text),
"details" .= d,
"hint" .= (("Row number " <> show i) :: Text)]
toJSON (SQL.ResultError (SQL.UnexpectedAmountOfRows i)) = JSON.object [
"message" .= ("Unexpected amount of rows" :: Text),
"details" .= i]
toJSON (SQL.ClientError d) = JSON.object [
"code" .= ConnectionErrorCode01,
"message" .= ("Database client error. Retrying the connection." :: Text),
"details" .= (fmap T.decodeUtf8 d :: Maybe Text)]
"details" .= (fmap T.decodeUtf8 d :: Maybe Text),
"hint" .= JSON.Null]
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 _ _ _) ->
case BS.unpack c of
'0':'8':_ -> HTTP.status503 -- pg connection err
'0':'9':_ -> HTTP.status500 -- triggered action exception
@@ -243,7 +414,9 @@ pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rErr
"P0001" -> HTTP.status400 -- default code for "raise"
'P':'0':_ -> HTTP.status500 -- PL/pgSQL Error
'X':'X':_ -> HTTP.status500 -- internal Error
"42883" -> HTTP.status404 -- undefined function
"42883"-> if BS.isPrefixOf "function xmlagg(" m
then HTTP.status406
else HTTP.status404 -- undefined function
"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)
@@ -252,88 +425,115 @@ pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rErr
_ -> HTTP.status500
checkIsFatal :: PgError -> Maybe Text
checkIsFatal (PgError _ (SQL.ConnectionError e))
checkIsFatal (PgError _ (SQL.ConnectionUsageError e))
| isAuthFailureMessage = Just $ toS failureMessage
| otherwise = Nothing
where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` failureMessage
where isAuthFailureMessage = "FATAL: password authentication failed" `isInfixOf` failureMessage
failureMessage = BS.unpack $ fromMaybe mempty e
checkIsFatal (PgError _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError serverError))))
checkIsFatal (PgError _ (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" _ _ _
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" _ _ _
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" _ _
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
= GucHeadersError
= ApiRequestError ApiRequestError
| GucHeadersError
| GucStatusError
| BinaryFieldError ContentType
| ConnectionLostError
| PutMatchingPkError
| PutRangeNotAllowedError
| JwtTokenMissing
| JwtTokenInvalid Text
| SingularityError Integer
| NotFound
| ApiRequestError ApiRequestError
| JwtTokenMissing
| JwtTokenRequired
| NoSchemaCacheError
| OffLimitsChangesError Int64 Integer
| PgErr PgError
| PutMatchingPkError
| SingularityError Integer
instance PgrstError Error where
status (ApiRequestError err) = status err
status GucHeadersError = HTTP.status500
status GucStatusError = HTTP.status500
status (BinaryFieldError _) = HTTP.status406
status ConnectionLostError = HTTP.status503
status PutMatchingPkError = HTTP.status400
status PutRangeNotAllowedError = HTTP.status400
status JwtTokenInvalid{} = HTTP.unauthorized401
status JwtTokenMissing = HTTP.status500
status (JwtTokenInvalid _) = HTTP.unauthorized401
status (SingularityError _) = HTTP.status406
status NotFound = HTTP.status404
status JwtTokenRequired = HTTP.unauthorized401
status NoSchemaCacheError = HTTP.status503
status OffLimitsChangesError{} = HTTP.status400
status (PgErr err) = status err
status (ApiRequestError err) = status err
status PutMatchingPkError = HTTP.status400
status SingularityError{} = HTTP.status406
headers (SingularityError _) = [ContentType.toHeader CTSingularJSON]
headers (JwtTokenInvalid m) = [ContentType.toHeader CTApplicationJSON, invalidTokenHeader m]
headers (PgErr err) = headers err
headers (ApiRequestError err) = headers err
headers _ = [ContentType.toHeader CTApplicationJSON]
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]
instance JSON.ToJSON Error where
toJSON GucHeadersError = JSON.object [
"message" .= ("response.headers guc must be a JSON array composed of objects with a single key and a string value" :: Text)]
toJSON GucStatusError = JSON.object [
"message" .= ("response.status guc must be a valid status code" :: Text)]
toJSON (BinaryFieldError ct) = JSON.object [
"message" .= ((T.decodeUtf8 (ContentType.toMime ct) <> " requested but more than one column was selected") :: Text)]
toJSON ConnectionLostError = JSON.object [
"message" .= ("Database connection lost. Retrying the connection." :: Text)]
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 PutRangeNotAllowedError = JSON.object [
"message" .= ("Range header and limit/offset querystring parameters are not allowed for PUT" :: Text)]
toJSON PutMatchingPkError = JSON.object [
"message" .= ("Payload values do not match URL in primary key column(s)" :: Text)]
toJSON (SingularityError n) = JSON.object [
"message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
"details" .= T.unwords ["Results contain", show n, "rows,", T.decodeUtf8 (ContentType.toMime CTSingularJSON), "requires 1 row"]]
toJSON JwtTokenMissing = JSON.object [
"message" .= ("Server lacks JWT secret" :: Text)]
toJSON JwtTokenMissing = JSON.object [
"code" .= JWTErrorCode00,
"message" .= ("Server lacks JWT secret" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (JwtTokenInvalid message) = JSON.object [
"message" .= (message :: Text)]
toJSON NotFound = 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 (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 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 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 (PgErr err) = JSON.toJSON err
toJSON (ApiRequestError err) = JSON.toJSON err
@@ -341,5 +541,86 @@ invalidTokenHeader :: Text -> Header
invalidTokenHeader m =
("WWW-Authenticate", "Bearer error=\"invalid_token\", " <> "error_description=" <> encodeUtf8 (show m))
requiredTokenHeader :: Header
requiredTokenHeader = ("WWW-Authenticate", "Bearer")
singularityError :: (Integral a) => a -> Error
singularityError = SingularityError . toInteger
-- Error codes are grouped by common modules or characteristics
data ErrorCode
-- PostgreSQL connection errors
= ConnectionErrorCode00
| ConnectionErrorCode01
| ConnectionErrorCode02
-- API Request errors
| ApiRequestErrorCode00
| ApiRequestErrorCode01
| ApiRequestErrorCode02
| ApiRequestErrorCode03
| ApiRequestErrorCode04
| ApiRequestErrorCode05
| ApiRequestErrorCode06
| ApiRequestErrorCode07
| ApiRequestErrorCode08
| ApiRequestErrorCode09
| ApiRequestErrorCode10
| ApiRequestErrorCode11
| ApiRequestErrorCode12
| ApiRequestErrorCode13
| ApiRequestErrorCode14
| ApiRequestErrorCode15
| ApiRequestErrorCode16
| ApiRequestErrorCode17
-- Schema Cache errors
| SchemaCacheErrorCode00
| SchemaCacheErrorCode01
| SchemaCacheErrorCode02
| SchemaCacheErrorCode03
-- JWT authentication errors
| JWTErrorCode00
| JWTErrorCode01
| JWTErrorCode02
-- Internal errors related to the Hasql library
| InternalErrorCode00
instance JSON.ToJSON ErrorCode where
toJSON e = JSON.toJSON (buildErrorCode e)
-- New group of errors will be added at the end of all the groups and will have the next prefix in the sequence
-- New errors are added at the end of the group they belong to and will have the next code in the sequence
buildErrorCode :: ErrorCode -> Text
buildErrorCode code = "PGRST" <> case code of
ConnectionErrorCode00 -> "000"
ConnectionErrorCode01 -> "001"
ConnectionErrorCode02 -> "002"
ApiRequestErrorCode00 -> "100"
ApiRequestErrorCode01 -> "101"
ApiRequestErrorCode02 -> "102"
ApiRequestErrorCode03 -> "103"
ApiRequestErrorCode04 -> "104"
ApiRequestErrorCode05 -> "105"
ApiRequestErrorCode06 -> "106"
ApiRequestErrorCode07 -> "107"
ApiRequestErrorCode08 -> "108"
ApiRequestErrorCode09 -> "109"
ApiRequestErrorCode10 -> "110"
ApiRequestErrorCode11 -> "111"
ApiRequestErrorCode12 -> "112"
ApiRequestErrorCode13 -> "113"
ApiRequestErrorCode14 -> "114"
ApiRequestErrorCode15 -> "115"
ApiRequestErrorCode16 -> "116"
ApiRequestErrorCode17 -> "117"
SchemaCacheErrorCode00 -> "200"
SchemaCacheErrorCode01 -> "201"
SchemaCacheErrorCode02 -> "202"
SchemaCacheErrorCode03 -> "203"
JWTErrorCode00 -> "300"
JWTErrorCode01 -> "301"
JWTErrorCode02 -> "302"
InternalErrorCode00 -> "X00"
+30
View File
@@ -0,0 +1,30 @@
{-|
Module : PostgREST.Logger
Description : Wai Middleware to log requests to stdout.
-}
module PostgREST.Logger (middleware) where
import qualified Network.Wai as Wai
import qualified Network.Wai.Middleware.RequestLogger as Wai
import Network.HTTP.Types.Status (status400, status500)
import System.IO.Unsafe (unsafePerformIO)
import qualified PostgREST.Auth as Auth
import PostgREST.Config (LogLevel (..))
import Protolude
middleware :: LogLevel -> Wai.Middleware
middleware logLevel = case logLevel of
LogInfo -> requestLogger (const True)
LogWarn -> requestLogger (>= status400)
LogError -> requestLogger (>= status500)
LogCrit -> requestLogger (const False)
where
requestLogger filterStatus = unsafePerformIO $ Wai.mkRequestLogger Wai.defaultRequestLoggerSettings
{ Wai.outputFormat = Wai.ApacheWithSettings $
Wai.defaultApacheSettings
& Wai.setApacheRequestFilter (\_ res -> filterStatus $ Wai.responseStatus res)
& Wai.setApacheUserGetter (fmap encodeUtf8 . Auth.getRole)
}
+124
View File
@@ -0,0 +1,124 @@
{-# LANGUAGE DuplicateRecordFields #-}
module PostgREST.MediaType
( MediaType(..)
, MTPlanOption (..)
, MTPlanFormat (..)
, MTPlanAttrs(..)
, 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)
import Protolude
-- | Enumeration of currently supported media types
data MediaType
= MTApplicationJSON
| MTSingularJSON
| MTGeoJSON
| MTTextCSV
| MTTextPlain
| MTTextXML
| MTOpenAPI
| MTUrlEncoded
| MTOctetStream
| MTAny
| MTOther ByteString
| MTPlan MTPlanAttrs
deriving Eq
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
= PlanAnalyze | PlanVerbose | PlanSettings | PlanBuffers | PlanWAL
data MTPlanFormat
= PlanJSON | PlanText
-- | Convert MediaType to a Content-Type HTTP Header
toContentType :: MediaType -> Header
toContentType ct = (hContentType, toMime ct <> charset)
where
charset = case ct of
MTOctetStream -> mempty
MTOther _ -> mempty
_ -> "; charset=utf-8"
-- | 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)) =
"application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
(if isNothing mt then mempty else "; for=\"" <> toMime (fromJust mt) <> "\"") <>
(if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts))
toMimePlanOption :: MTPlanOption -> ByteString
toMimePlanOption PlanAnalyze = "analyze"
toMimePlanOption PlanVerbose = "verbose"
toMimePlanOption PlanSettings = "settings"
toMimePlanOption PlanBuffers = "buffers"
toMimePlanOption PlanWAL = "wal"
toMimePlanFormat :: MTPlanFormat -> ByteString
toMimePlanFormat PlanJSON = "json"
toMimePlanFormat PlanText = "text"
-- | Convert from ByteString to MediaType. Warning: discards MIME parameters
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
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" ]
getMediaType :: MediaType -> MediaType
getMediaType mt = case mt of
MTPlan (MTPlanAttrs (Just mType) _ _) -> mType
MTPlan (MTPlanAttrs Nothing _ _) -> MTApplicationJSON
other -> other
-204
View File
@@ -1,204 +0,0 @@
{-|
Module : PostgREST.Middleware
Description : Sets CORS policy. Also the PostgreSQL GUCs, role, search_path and pre-request function.
-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Middleware
( runPgLocals
, pgrstFormat
, pgrstMiddleware
, defaultCorsPolicy
, corsPolicy
, optionalRollback
) where
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
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 qualified Network.Wai.Logger as Wai
import qualified Network.Wai.Middleware.Cors as Wai
import qualified Network.Wai.Middleware.Gzip as Wai
import qualified Network.Wai.Middleware.RequestLogger as Wai
import qualified Network.Wai.Middleware.Static as Wai
import Control.Arrow ((***))
import Data.Function (id)
import Data.List (lookup)
import Data.Scientific (FPFormat (..), formatScientific,
isInteger)
import Network.HTTP.Types.Status (Status, status400, status500,
statusCode)
import System.IO.Unsafe (unsafePerformIO)
import System.Log.FastLogger (toLogStr)
import PostgREST.Config (AppConfig (..), LogLevel (..))
import PostgREST.Config.PgVersion (PgVersion (..), pgVersion140)
import PostgREST.Error (Error, errorResponseFor)
import PostgREST.GucHeader (addHeadersIfNotIncluded)
import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet,
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 -> M.HashMap Text JSON.Value ->
(ApiRequest -> ExceptT Error SQL.Transaction Wai.Response) ->
ApiRequest -> ByteString -> PgVersion -> ExceptT Error SQL.Transaction Wai.Response
runPgLocals conf claims 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)
claimsWithRole =
let anon = JSON.String . toS $ configDbAnonRole conf in -- role claim defaults to anon if not specified in jwt
M.union claims (M.singleton "role" anon)
claimsSql = if usesLegacyGucs
then setConfigLocal "request.jwt.claim." <$> [(toUtf8 c, toUtf8 $ unquoted v) | (c,v) <- M.toList claimsWithRole]
else [setConfigLocal mempty ("request.jwt.claims", LBS.toStrict $ JSON.encode claimsWithRole)]
roleSql = maybeToList $ (\x -> setConfigLocal mempty ("role", toUtf8 $ unquoted x)) <$> M.lookup "role" claimsWithRole
appSettingsSql = setConfigLocal mempty <$> (join bimap toUtf8 <$> configAppSettings conf)
searchPathSql =
let schemas = T.intercalate ", " (iSchema req : configDbExtraSearchPath conf) in
setConfigLocal mempty ("search_path", toUtf8 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
-- | Log in apache format. Only requests that have a status greater than minStatus are logged.
-- | There's no way to filter logs in the apache format on wai-extra: https://hackage.haskell.org/package/wai-extra-3.0.29.2/docs/Network-Wai-Middleware-RequestLogger.html#t:OutputFormat.
-- | So here we copy wai-logger apacheLogStr function: https://github.com/kazu-yamamoto/logger/blob/a4f51b909a099c51af7a3f75cf16e19a06f9e257/wai-logger/Network/Wai/Logger/Apache.hs#L45
-- | TODO: Add the ability to filter apache logs on wai-extra and remove this function.
pgrstFormat :: Status -> Wai.OutputFormatter
pgrstFormat minStatus date req status responseSize =
if status < minStatus
then mempty
else toLogStr (getSourceFromSocket req)
<> " - - ["
<> toLogStr date
<> "] \""
<> toLogStr (Wai.requestMethod req)
<> " "
<> toLogStr (Wai.rawPathInfo req <> Wai.rawQueryString req)
<> " "
<> toLogStr (show (Wai.httpVersion req)::Text)
<> "\" "
<> toLogStr (show (statusCode status)::Text)
<> " "
<> toLogStr (maybe "-" show responseSize::Text)
<> " \""
<> toLogStr (fromMaybe mempty $ Wai.requestHeaderReferer req)
<> "\" \""
<> toLogStr (fromMaybe mempty $ Wai.requestHeaderUserAgent req)
<> "\"\n"
where
getSourceFromSocket = BS.pack . Wai.showSockAddr . Wai.remoteHost
pgrstMiddleware :: LogLevel -> Wai.Application -> Wai.Application
pgrstMiddleware logLevel =
logger
. Wai.cors corsPolicy
. Wai.staticPolicy (Wai.only [("favicon.ico", "static/favicon.ico")])
where
logger = case logLevel of
LogCrit -> id
LogError -> unsafePerformIO $ Wai.mkRequestLogger Wai.def { Wai.outputFormat = Wai.CustomOutputFormat $ pgrstFormat status500}
LogWarn -> unsafePerformIO $ Wai.mkRequestLogger Wai.def { Wai.outputFormat = Wai.CustomOutputFormat $ pgrstFormat status400}
LogInfo -> Wai.logStdout
defaultCorsPolicy :: Wai.CorsResourcePolicy
defaultCorsPolicy = Wai.CorsResourcePolicy Nothing
["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"] ["Authorization"] Nothing
(Just $ 60*60*24) False False True
-- | 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 -> Just defaultCorsPolicy {
Wai.corsOrigins = Just ([origin], True)
, Wai.corsRequestHeaders = "Authentication" : accHeaders
, Wai.corsExposedHeaders = Just [
"Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
, "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
]
}
Nothing -> Nothing
where
headers = Wai.requestHeaders req
accHeaders = case lookup "access-control-request-headers" headers of
Just hdrs -> map (CI.mk . BS.strip) $ BS.split ',' hdrs
Nothing -> []
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 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 . M.fromList . arrayByteStringToText
arrayByteStringToText :: [(ByteString, ByteString)] -> [(Text,Text)]
arrayByteStringToText keyVal = (T.decodeUtf8 *** T.decodeUtf8) <$> keyVal
+433
View File
@@ -0,0 +1,433 @@
{-|
Module : PostgREST.Plan
Description : PostgREST Request Planner
This module is in charge of building an intermediate
representation 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.Plan
( readPlan
, mutateReadPlan
, callReadPlan
, MutateReadPlan(..)
, CallReadPlan(..)
) where
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S
import qualified PostgREST.SchemaCache.Proc as Proc
import Data.Either.Combinators (mapLeft)
import Data.List (delete)
import Data.Tree (Tree (..))
import PostgREST.ApiRequest (Action (..),
ApiRequest (..),
InvokeMethod (..),
Mutation (..),
Payload (..))
import PostgREST.Config (AppConfig (..))
import PostgREST.Error (Error (..))
import PostgREST.Query.SqlFragment (sourceCTEName)
import PostgREST.RangeQuery (NonnegRange, allRange,
convertToLimitZeroRange,
restrictRange)
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema)
import PostgREST.SchemaCache.Proc (ProcDescription (..),
ProcParam (..),
procReturnsScalar)
import PostgREST.SchemaCache.Relationship (Cardinality (..),
Junction (..),
Relationship (..),
RelationshipsMap)
import PostgREST.SchemaCache.Table (tablePKCols)
import PostgREST.Plan.CallPlan
import PostgREST.Plan.MutatePlan
import PostgREST.Plan.ReadPlan as ReadPlan
import PostgREST.ApiRequest.Preferences
import PostgREST.ApiRequest.Types
import qualified PostgREST.ApiRequest.QueryParams as QueryParams
import Protolude hiding (from)
data MutateReadPlan = MutateReadPlan {
mrReadPlan :: ReadPlanTree
, mrMutatePlan :: MutatePlan
}
data CallReadPlan = CallReadPlan {
crReadPlan :: ReadPlanTree
, crCallPlan :: CallPlan
}
mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error MutateReadPlan
mutateReadPlan mutation apiRequest identifier conf sCache = do
rPlan <- readPlan identifier conf sCache apiRequest
mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan
return $ MutateReadPlan rPlan mPlan
callReadPlan :: ProcDescription -> AppConfig -> SchemaCache -> ApiRequest -> Either Error CallReadPlan
callReadPlan proc conf sCache apiRequest = do
let identifier = QualifiedIdentifier (pdSchema proc) (fromMaybe (pdName proc) $ Proc.procTableName proc)
rPlan <- readPlan identifier conf sCache apiRequest
let cPlan = callPlan proc apiRequest rPlan
return $ CallReadPlan rPlan cPlan
-- | Builds the ReadPlan tree on a number of stages.
-- | Adds filters, order, limits on its respective nodes.
-- | Adds joins conditions obtained from resource embedding.
readPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error ReadPlanTree
readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows} SchemaCache{dbRelationships} apiRequest =
mapLeft ApiRequestError $
treeRestrictRange configDbMaxRows (iAction apiRequest) =<<
addRels qiSchema (iAction apiRequest) dbRelationships Nothing =<<
addLogicTrees apiRequest =<<
addRanges apiRequest =<<
addOrders apiRequest =<<
addFilters apiRequest (initReadRequest qi $ QueryParams.qsSelect $ iQueryParams apiRequest)
-- Build the initial read plan tree
initReadRequest :: QualifiedIdentifier -> [Tree SelectItem] -> ReadPlanTree
initReadRequest qi@QualifiedIdentifier{..} =
foldr (treeEntry rootDepth) $ Node defReadPlan{from=qi, relName=qiName, depth=rootDepth} []
where
rootDepth = 0
defReadPlan = ReadPlan [] (QualifiedIdentifier mempty mempty) Nothing [] [] allRange mempty Nothing [] Nothing mempty Nothing Nothing rootDepth
treeEntry :: Depth -> Tree SelectItem -> ReadPlanTree -> ReadPlanTree
treeEntry depth (Node SelectRelation{..} fldForest) (Node q rForest) =
let nxtDepth = succ depth in
Node q $
foldr (treeEntry nxtDepth)
(Node defReadPlan{from=QualifiedIdentifier qiSchema selRelation, relName=selRelation, relAlias=selAlias, relHint=selHint, relJoinType=selJoinType, depth=nxtDepth} [])
fldForest:rForest
treeEntry _ (Node SelectField{..} _) (Node q rForest) = Node q{select=(selField, selCast, selAlias):select q} rForest
-- | Enforces the `max-rows` config on the result
treeRestrictRange :: Maybe Integer -> Action -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
treeRestrictRange _ (ActionMutate _) request = Right request
treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> request
where
nodeRestrictRange :: Maybe Integer -> ReadPlan -> ReadPlan
nodeRestrictRange m q@ReadPlan{range_=r} = q{range_= convertToLimitZeroRange r (restrictRange m r) }
-- add relationships to the nodes of the tree by traversing the forest while keeping track of the parentNode(https://stackoverflow.com/questions/22721064/get-the-parent-of-a-node-in-data-tree-haskell#comment34627048_22721064)
-- also adds aliasing
addRels :: Schema -> Action -> RelationshipsMap -> Maybe ReadPlanTree -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
addRels schema action allRels parentNode (Node rPlan@ReadPlan{relName,relHint,relAlias,depth} forest) =
case parentNode of
Just (Node ReadPlan{from=parentNodeQi, fromAlias=parentAlias} _) ->
let
newReadPlan = (\r ->
let newAlias = Just (qiName (relForeignTable r) <> "_" <> show depth)
aggAlias = qiName (relTable r) <> "_" <> fromMaybe relName relAlias <> "_" <> show depth in
case r of
Relationship{relCardinality=M2M _} -> -- m2m does internal implicit joins that don't need aliasing
rPlan{from=relForeignTable r, relToParent=Just r, relAggAlias=aggAlias, relJoinConds=getJoinConditions Nothing parentAlias r}
ComputedRelationship{} ->
rPlan{from=relForeignTable r, relToParent=Just r{relTable=maybe (relTable r) (QualifiedIdentifier mempty) parentAlias}, relAggAlias=aggAlias, fromAlias=newAlias}
_ ->
rPlan{from=relForeignTable r, relToParent=Just r, relAggAlias=aggAlias, fromAlias=newAlias, relJoinConds=getJoinConditions newAlias parentAlias r}
) <$> 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) parentAlias
else qiName parentNodeQi
rel = findRel schema allRels origin relName relHint
in
Node <$> newReadPlan <*> (updateForest . hush $ Node <$> newReadPlan <*> pure forest)
Nothing -> -- root case
let
newFrom = QualifiedIdentifier mempty $ decodeUtf8 sourceCTEName
newAlias = Just (qiName $ from rPlan)
newReadPlan = case action of
-- the CTE for mutations/rpc is used as WITH sourceCTEName .. SELECT .. FROM sourceCTEName as alias,
-- we use the table name as an alias so findRel can find the right relationship.
ActionMutate _ -> rPlan{from=newFrom, fromAlias=newAlias}
ActionInvoke _ -> rPlan{from=newFrom, fromAlias=newAlias}
_ -> rPlan
in
Node newReadPlan <$> updateForest (Just $ Node newReadPlan forest)
where
updateForest :: Maybe ReadPlanTree -> Either ApiRequestError [ReadPlanTree]
updateForest rq = addRels schema action allRels rq `traverse` forest
getJoinConditions :: Maybe Alias -> Maybe Alias -> Relationship -> [JoinCondition]
getJoinConditions _ _ ComputedRelationship{} = []
getJoinConditions tblAlias parentAlias Relationship{relTable=qi,relForeignTable=fQi,relCardinality=card} =
case card of
M2M (Junction QualifiedIdentifier{qiName=jtn} _ _ jcols1 jcols2) ->
(toJoinCondition Nothing Nothing ftN jtn <$> jcols2) ++ (toJoinCondition parentAlias tblAlias tN jtn <$> jcols1)
O2M _ cols ->
toJoinCondition parentAlias tblAlias tN ftN <$> cols
M2O _ cols ->
toJoinCondition parentAlias tblAlias tN ftN <$> cols
O2O _ cols ->
toJoinCondition parentAlias tblAlias tN ftN <$> cols
where
QualifiedIdentifier{qiSchema=tSchema, qiName=tN} = qi
QualifiedIdentifier{qiName=ftN} = fQi
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 hint schema allRels
[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 -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
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 ReadPlanTree -> Either ApiRequestError ReadPlanTree
addFilterToNode =
updateNode (\flt (Node q@ReadPlan{where_=lf} f) -> Node q{ReadPlan.where_=addFilterToLogicForest flt lf} f)
addOrders :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
addOrders ApiRequest{..} rReq =
case iAction of
ActionMutate _ -> Right rReq
_ -> foldr addOrderToNode (Right rReq) qsOrder
where
QueryParams.QueryParams{..} = iQueryParams
addOrderToNode :: (EmbedPath, [OrderTerm]) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
addOrderToNode = updateNode (\o (Node q f) -> Node q{order=o} f)
addRanges :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
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 ReadPlanTree -> Either ApiRequestError ReadPlanTree
addRangeToNode = updateNode (\r (Node q f) -> Node q{range_=r} f)
addLogicTrees :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
addLogicTrees ApiRequest{..} rReq =
foldr addLogicTreeToNode (Right rReq) qsLogic
where
QueryParams.QueryParams{..} = iQueryParams
addLogicTreeToNode :: (EmbedPath, LogicTree) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
addLogicTreeToNode = updateNode (\t (Node q@ReadPlan{where_=lf} f) -> Node q{ReadPlan.where_=t:lf} f)
-- Find a Node of the Tree and apply a function to it
updateNode :: (a -> ReadPlanTree -> ReadPlanTree) -> (EmbedPath, a) -> Either ApiRequestError ReadPlanTree -> Either ApiRequestError ReadPlanTree
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 ReadPlanTree
findNode = find (\(Node ReadPlan{relName, relAlias} _) -> relName == targetNodeName || relAlias == Just targetNodeName) forest
mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> SchemaCache -> ReadPlanTree -> Either Error MutatePlan
mutatePlan mutation qi ApiRequest{..} sCache readReq = mapLeft ApiRequestError $
case mutation of
MutationCreate ->
Right $ Insert qi iColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings pkCols
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 mempty
else
Left InvalidFilters
MutationDelete -> Right $ Delete qi combinedLogic iTopLevelRange rootOrder returnings
where
confCols = fromMaybe pkCols qsOnConflict
QueryParams.QueryParams{..} = iQueryParams
returnings =
if iPreferRepresentation == None
then []
else inferColsEmbedNeeds readReq pkCols
pkCols = maybe mempty tablePKCols $ HM.lookup qi $ dbTables sCache
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)
callPlan :: ProcDescription -> ApiRequest -> ReadPlanTree -> CallPlan
callPlan 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 = inferColsEmbedNeeds 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)
-- | Infers the columns needed for an embed to be successful after a mutation or a function call.
inferColsEmbedNeeds :: ReadPlanTree -> [FieldName] -> [FieldName]
inferColsEmbedNeeds (Node ReadPlan{select} 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 = (\((fld, _), _, _) -> fld) <$> select
-- Without fkCols, when a mutatePlan 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 ReadPlan{relToParent=Just Relationship{relCardinality=O2M _ cols}} _ ->
Just $ fst <$> cols
Node ReadPlan{relToParent=Just Relationship{relCardinality=M2O _ cols}} _ ->
Just $ fst <$> cols
Node ReadPlan{relToParent=Just Relationship{relCardinality=O2O _ cols}} _ ->
Just $ fst <$> cols
Node ReadPlan{relToParent=Just Relationship{relCardinality=M2M Junction{junColsSource=cols}}} _ ->
Just $ fst <$> cols
Node ReadPlan{relToParent=Just ComputedRelationship{}} _ ->
Nothing
Node ReadPlan{relToParent=Nothing} _ ->
Nothing
) forest
hasComputedRel = isJust $ find (\case
Node ReadPlan{relToParent=Just ComputedRelationship{}} _ -> True
_ -> False
) forest
-- However if the "client_id" is present, e.g. mutatePlan 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
+25
View File
@@ -0,0 +1,25 @@
module PostgREST.Plan.CallPlan
( CallPlan(..)
, CallParams(..)
)
where
import qualified Data.ByteString.Lazy as LBS
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.SchemaCache.Proc (ProcParam (..))
import Protolude
data CallPlan = 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)
+42
View File
@@ -0,0 +1,42 @@
module PostgREST.Plan.MutatePlan
( MutatePlan(..)
)
where
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Set as S
import PostgREST.ApiRequest.Preferences (PreferResolution)
import PostgREST.ApiRequest.Types (LogicTree, OrderTerm)
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier)
import Protolude
data MutatePlan
= Insert
{ in_ :: QualifiedIdentifier
, insCols :: S.Set FieldName
, insBody :: Maybe LBS.ByteString
, onConflict :: Maybe (PreferResolution, [FieldName])
, where_ :: [LogicTree]
, returning :: [FieldName]
, insPkCols :: [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]
}
+45
View File
@@ -0,0 +1,45 @@
module PostgREST.Plan.ReadPlan
( ReadPlanTree
, ReadPlan(..)
, JoinCondition(..)
) where
import Data.Tree (Tree (..))
import PostgREST.ApiRequest.Types (Alias, Cast, Depth, Field,
Hint, JoinType, LogicTree,
NodeName, OrderTerm)
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)
data ReadPlan = ReadPlan
{ select :: [(Field, Maybe Cast, Maybe Alias)]
, from :: QualifiedIdentifier
, fromAlias :: Maybe Alias
, where_ :: [LogicTree]
, order :: [OrderTerm]
, range_ :: NonnegRange
, relName :: NodeName
, relToParent :: Maybe Relationship
, relJoinConds :: [JoinCondition]
, relAlias :: Maybe Alias
, relAggAlias :: Alias
, relHint :: Maybe Hint
, relJoinType :: Maybe JoinType
, depth :: Depth
-- ^ used for aliasing
}
deriving (Eq)
+294
View File
@@ -0,0 +1,294 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Query
( createQuery
, deleteQuery
, invokeQuery
, openApiQuery
, readQuery
, singleUpsertQuery
, txMode
, updateQuery
, setPgLocals
, DbHandler
) 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.Set as S
import qualified Data.Text.Encoding as T
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 Hasql.Transaction.Sessions as SQL
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 qualified PostgREST.SchemaCache.Proc as Proc
import Data.Scientific (FPFormat (..), formatScientific, isInteger)
import PostgREST.ApiRequest (Action (..),
ApiRequest (..),
InvokeMethod (..),
Target (..))
import PostgREST.ApiRequest.Preferences (PreferCount (..),
PreferParameters (..),
PreferTransaction (..),
shouldCount)
import PostgREST.Config (AppConfig (..),
OpenAPIMode (..))
import PostgREST.Config.PgVersion (PgVersion (..),
pgVersion140)
import PostgREST.Error (Error)
import PostgREST.MediaType (MediaType (..))
import PostgREST.Plan (CallReadPlan (..),
MutateReadPlan (..))
import PostgREST.Plan.MutatePlan (MutatePlan (..))
import PostgREST.Plan.ReadPlan (ReadPlanTree)
import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet,
pgFmtIdentList,
setConfigLocal,
setConfigLocalJson)
import PostgREST.Query.Statements (ResultSet (..))
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
Schema)
import PostgREST.SchemaCache.Proc (ProcDescription (..),
ProcVolatility (..),
ProcsMap)
import PostgREST.SchemaCache.Table (TablesMap)
import Protolude hiding (Handler)
type DbHandler = ExceptT Error SQL.Transaction
readQuery :: ReadPlanTree -> AppConfig -> ApiRequest -> DbHandler ResultSet
readQuery req conf@AppConfig{..} apiReq@ApiRequest{..} = do
let countQuery = QueryBuilder.readPlanToCountQuery req
resultSet <-
lift . SQL.statement mempty $
Statements.prepareRead
(QueryBuilder.readPlanToQuery 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
iBinaryField
configDbPreparedStatements
failNotSingular iAcceptMediaType 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{..} rs@RSStandard{rsTableTotal=tableTotal} countQuery =
case iPreferCount 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 apiReq@ApiRequest{..} conf = do
resultSet <- writeQuery mrPlan apiReq conf
failNotSingular iAcceptMediaType resultSet
optionalRollback conf apiReq
pure resultSet
updateQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
updateQuery mrPlan apiReq@ApiRequest{..} conf = do
resultSet <- writeQuery mrPlan apiReq conf
failNotSingular iAcceptMediaType 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.PutMatchingPkError
deleteQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
deleteQuery mrPlan apiReq@ApiRequest{..} conf = do
resultSet <- writeQuery mrPlan apiReq conf
failNotSingular iAcceptMediaType resultSet
failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
optionalRollback conf apiReq
pure resultSet
invokeQuery :: ProcDescription -> CallReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
invokeQuery proc CallReadPlan{crReadPlan, crCallPlan} apiReq@ApiRequest{..} conf@AppConfig{..} = do
resultSet <-
lift . SQL.statement mempty $
Statements.prepareCall
(Proc.procReturnsScalar proc)
(Proc.procReturnsSingle proc)
(QueryBuilder.callPlanToQuery crCallPlan)
(QueryBuilder.readPlanToQuery crReadPlan)
(QueryBuilder.readPlanToCountQuery crReadPlan)
(shouldCount iPreferCount)
iAcceptMediaType
(iPreferParameters == Just MultipleObjects)
iBinaryField
configDbPreparedStatements
optionalRollback conf apiReq
failNotSingular iAcceptMediaType resultSet
pure resultSet
openApiQuery :: SchemaCache -> PgVersion -> AppConfig -> Schema -> DbHandler (Maybe (TablesMap, ProcsMap, 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.accessibleProcs 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.dbProcs sCache)
<$> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
OADisabled ->
pure Nothing
txMode :: ApiRequest -> SQL.Mode
txMode ApiRequest{..} =
case (iAction, iTarget) of
(ActionRead _, _) ->
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 :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
writeQuery MutateReadPlan{mrReadPlan, mrMutatePlan} apiReq conf =
let
(isInsert, pkCols) = case mrMutatePlan of {Insert{insPkCols} -> (True, insPkCols); _ -> (False, mempty);}
in
lift . SQL.statement mempty $
Statements.prepareWrite
(QueryBuilder.readPlanToQuery mrReadPlan)
(QueryBuilder.mutatePlanToQuery mrMutatePlan)
isInsert
(iAcceptMediaType apiReq)
(iPreferRepresentation apiReq)
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 (mediaType == MTSingularJSON && queryTotal /= 1) $ do
lift SQL.condemn
throwError $ Error.singularityError 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.OffLimitsChangesError queryTotal maxChanges
-- | Set a transaction to roll back if requested
optionalRollback :: AppConfig -> ApiRequest -> DbHandler ()
optionalRollback AppConfig{..} ApiRequest{..} = do
lift $ when (shouldRollback || (configDbTxRollbackAll && not shouldCommit)) $ do
SQL.sql "SET CONSTRAINTS ALL IMMEDIATE"
SQL.condemn
where
shouldCommit =
configDbTxAllowOverride && iPreferTransaction == Just Commit
shouldRollback =
configDbTxAllowOverride && iPreferTransaction == Just Rollback
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
setPgLocals :: AppConfig -> KM.KeyMap JSON.Value -> Text ->
ApiRequest -> ByteString -> PgVersion -> DbHandler ()
setPgLocals conf claims role 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
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
+144 -86
View File
@@ -1,17 +1,18 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-|
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
@@ -21,67 +22,67 @@ import qualified Hasql.DynamicStatements.Snippet as SQL
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.SchemaCache.Identifiers (QualifiedIdentifier (..))
import PostgREST.SchemaCache.Proc (ProcParam (..))
import PostgREST.SchemaCache.Relationship (Cardinality (..),
Junction (..),
Relationship (..))
import PostgREST.DbStructure.Table (Table (..))
import PostgREST.Request.Preferences (PreferResolution (..))
import PostgREST.ApiRequest.Types
import PostgREST.Plan.CallPlan
import PostgREST.Plan.MutatePlan
import PostgREST.Plan.ReadPlan
import PostgREST.Query.SqlFragment
import PostgREST.Request.Types
import PostgREST.RangeQuery (allRange)
import Protolude
readRequestToQuery :: ReadRequest -> SQL.Snippet
readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
readPlanToQuery :: ReadPlanTree -> SQL.Snippet
readPlanToQuery (Node ReadPlan{select,from=mainQi,fromAlias,where_=logicForest,order, range_=readRange, relToParent, relJoinConds} forest) =
"SELECT " <>
intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <>
"FROM " <> SQL.sql (BS.intercalate ", " (tabl : implJs)) <> " " <>
intercalateSnippet ", " ((pgFmtSelectItem qi <$> select) ++ selects) <> " " <>
fromFrag <> " " <>
intercalateSnippet " " joins <> " " <>
(if null logicForest && null joinConditions_ then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_))
<> " " <>
(if null ordts then mempty else "ORDER BY " <> intercalateSnippet ", " (map (pgFmtOrderTerm qi) ordts)) <> " " <>
limitOffsetF range
(if null logicForest && null relJoinConds
then mempty
else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition relJoinConds)) <> " " <>
orderF qi order <> " " <>
limitOffsetF readRange
where
implJs = fromQi <$> implJoins
tabl = fromQi mainQi <> maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias
qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias
(joins, selects) = foldr getJoinsSelects ([],[]) forest
fromFrag = fromF relToParent mainQi fromAlias
qi = getQualifiedIdentifier relToParent mainQi fromAlias
(selects, joins) = foldr getSelectsJoins ([],[]) forest
getJoinsSelects :: ReadRequest -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])
getJoinsSelects rr@(Node (_, (name, Just Relationship{relCardinality=card,relTable=Table{tableName=table}}, alias, _, joinType, _)) _) (joins,selects) =
let subquery = readRequestToQuery rr in
case card of
M2O _ ->
let aliasOrName = fromMaybe name alias
localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
sel = SQL.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)
joi = (if joinType == Just JTInner then " INNER" else " LEFT")
<> " JOIN LATERAL( " <> subquery <> " ) AS " <> SQL.sql localTableName <> " ON TRUE " in
(joi:joins,sel:selects)
_ -> case joinType of
Just JTInner ->
let aliasOrName = fromMaybe name alias
locTblName = table <> "_" <> aliasOrName
localTableName = pgFmtIdent locTblName
internalTableName = pgFmtIdent $ "_" <> locTblName
sel = SQL.sql $ localTableName <> "." <> internalTableName <> " AS " <> pgFmtIdent aliasOrName
joi = "INNER JOIN LATERAL(" <>
"SELECT json_agg(" <> SQL.sql internalTableName <> ") AS " <> SQL.sql internalTableName <>
"FROM (" <> subquery <> " ) AS " <> SQL.sql internalTableName <>
") AS " <> SQL.sql localTableName <> " ON " <> SQL.sql localTableName <> "IS NOT NULL" in
(joi:joins,sel:selects)
_ ->
let sel = "COALESCE (("
<> "SELECT json_agg(" <> SQL.sql (pgFmtIdent table) <> ".*) "
<> "FROM (" <> subquery <> ") " <> SQL.sql (pgFmtIdent table) <> " "
<> "), '[]') AS " <> SQL.sql (pgFmtIdent (fromMaybe name alias)) in
(joins,sel:selects)
getJoinsSelects (Node (_, (_, Nothing, _, _, _, _)) _) _ = ([], [])
getSelectsJoins :: ReadPlanTree -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])
getSelectsJoins (Node ReadPlan{relToParent=Nothing} _) _ = ([], [])
getSelectsJoins rr@(Node ReadPlan{relName, relToParent=Just rel, relAggAlias, relAlias, relJoinType=joinType} _) (selects,joins) =
let
subquery = readPlanToQuery rr
aliasOrName = pgFmtIdent $ fromMaybe relName relAlias
aggAlias = pgFmtIdent relAggAlias
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(" <> aggAlias <> ".*) AS " <> aliasOrName)
, correlatedSubquery subquery aggAlias "TRUE")
else
( SQL.sql $ "COALESCE( " <> aggAlias <> "." <> aggAlias <> ", '[]') AS " <> aliasOrName
, correlatedSubquery (
"SELECT json_agg(" <> SQL.sql aggAlias <> ") AS " <> SQL.sql aggAlias <>
"FROM (" <> subquery <> " ) AS " <> SQL.sql aggAlias
) aggAlias $ if joinType == Just JTInner then SQL.sql aggAlias <> " IS NOT NULL" else "TRUE")
in
(sel:selects, joi:joins)
mutateRequestToQuery :: MutateRequest -> SQL.Snippet
mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) =
mutatePlanToQuery :: MutatePlan -> SQL.Snippet
mutatePlanToQuery (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 <> " " <>
@@ -93,7 +94,7 @@ mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returning
if null oncCols then
mempty
else
"ON CONFLICT(" <> BS.intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
" ON CONFLICT(" <> BS.intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
IgnoreDuplicates ->
"DO NOTHING"
MergeDuplicates ->
@@ -105,31 +106,69 @@ mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returning
])
where
cols = BS.intercalate ", " $ pgFmtIdent <$> S.toList iCols
mutateRequestToQuery (Update mainQi uCols body logicForest returnings) =
if S.null uCols
-- An update without a limit is always filtered with a WHERE
mutatePlanToQuery (Update mainQi uCols body logicForest range ordts returnings)
| S.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
then SQL.sql ("SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false")
else
"WITH " <> normalizedBody body <> " " <>
"UPDATE " <> SQL.sql (fromQi mainQi) <> " SET " <> SQL.sql cols <> " " <>
"FROM (SELECT * FROM json_populate_recordset (null::" <> SQL.sql (fromQi mainQi) <> " , " <> SQL.sql selectBody <> " )) _ " <>
(if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)) <> " " <>
SQL.sql (returningF mainQi returnings)
where
cols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
emptyBodyReturnedColumns :: SqlFragment
emptyBodyReturnedColumns
| null returnings = "NULL"
| otherwise = BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
mutateRequestToQuery (Delete mainQi logicForest returnings) =
"DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
(if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree mainQi) logicForest)) <> " " <>
SQL.sql (returningF mainQi returnings)
SQL.sql $ "SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false"
requestToCallProcQuery :: CallRequest -> SQL.Snippet
requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall returnings) =
| range == allRange =
"WITH " <> normalizedBody body <> " " <>
"UPDATE " <> mainTbl <> " SET " <> SQL.sql nonRangeCols <> " " <>
"FROM (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " )) _ " <>
whereLogic <> " " <>
SQL.sql (returningF mainQi returnings)
| otherwise =
"WITH " <> normalizedBody body <> ", " <>
"pgrst_update_body AS (SELECT * FROM json_populate_recordset (null::" <> mainTbl <> " , " <> SQL.sql selectBody <> " ) LIMIT 1), " <>
"pgrst_affected_rows AS (" <>
"SELECT " <> SQL.sql rangeIdF <> " FROM " <> mainTbl <>
whereLogic <> " " <>
orderF mainQi ordts <> " " <>
limitOffsetF range <>
") " <>
"UPDATE " <> mainTbl <> " SET " <> SQL.sql rangeCols <>
"FROM pgrst_affected_rows " <>
"WHERE " <> SQL.sql whereRangeIdF <> " " <>
SQL.sql (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)
mutatePlanToQuery (Delete mainQi logicForest range ordts returnings)
| range == allRange =
"DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
whereLogic <> " " <>
SQL.sql (returningF mainQi returnings)
| otherwise =
"WITH " <>
"pgrst_affected_rows AS (" <>
"SELECT " <> SQL.sql rangeIdF <> " FROM " <> SQL.sql (fromQi mainQi) <>
whereLogic <> " " <>
orderF mainQi ordts <> " " <>
limitOffsetF range <>
") " <>
"DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
"USING pgrst_affected_rows " <>
"WHERE " <> SQL.sql whereRangeIdF <> " " <>
SQL.sql (returningF mainQi returnings)
where
whereLogic = if null logicForest then mempty else " WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)
(whereRangeIdF, rangeIdF) = mutRangeF mainQi (fst . otTerm <$> ordts)
callPlanToQuery :: CallPlan -> SQL.Snippet
callPlanToQuery (FunctionCall qi params args returnsScalar multipleCall returnings) =
prmsCTE <> argsBody
where
(prmsCTE, argFrag) = case params of
@@ -183,24 +222,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=qi, implicitJoins=implJoins, where_=logicForest, joinConditions=joinConditions_}, _) forest) =
"SELECT 1 FROM " <> SQL.sql (BS.intercalate ", " (fromQi qi:(fromQi <$> implJoins))) <>
(if null logicForest && null joinConditions_ && null subQueries
readPlanToCountQuery :: ReadPlanTree -> SQL.Snippet
readPlanToCountQuery (Node ReadPlan{from=mainQi, fromAlias=tblAlias, where_=logicForest, relToParent=rel, relJoinConds} forest) =
"SELECT 1 " <> fromFrag <>
(if null logicForest && null relJoinConds && null subQueries
then mempty
else " WHERE " ) <>
intercalateSnippet " AND " (
map (pgFmtLogicTree qi) logicForest ++
map pgFmtJoinCondition joinConditions_ ++
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
else mempty
then ("EXISTS (" <> readPlanToCountQuery readReq <> " )"):rest
else rest
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 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
_ -> maybe mainQi (QualifiedIdentifier mempty) tblAlias
-- FROM clause plus implicit joins
fromF :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> SQL.Snippet
fromF rel mainQi tblAlias = SQL.sql $ "FROM " <>
(case rel of
Just ComputedRelationship{relFunction,relTable} -> fromQi relFunction <> "(" <> pgFmtIdent (qiName relTable) <> ")"
_ -> fromQi mainQi) <>
maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias <>
(case rel of
Just Relationship{relCardinality=M2M Junction{junTable=jt}} -> ", " <> fromQi jt
_ -> mempty)
+126 -52
View File
@@ -1,5 +1,6 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}
{-|
Module : PostgREST.Query.SqlFragment
Description : Helper functions for PostgREST.QueryBuilder.
@@ -11,17 +12,20 @@ module PostgREST.Query.SqlFragment
, SqlFragment
, asBinaryF
, asCsvF
, asGeoJsonF
, asJsonF
, asJsonSingleF
, asXmlF
, countF
, fromQi
, ftsOperators
, limitOffsetF
, locationF
, mutRangeF
, normalizedBody
, operators
, orderF
, pgFmtColumn
, pgFmtIdent
, pgFmtIdentList
, pgFmtJoinCondition
, pgFmtLogicTree
, pgFmtOrderTerm
@@ -34,24 +38,28 @@ module PostgREST.Query.SqlFragment
, sourceCTEName
, unknownEncoder
, intercalateSnippet
, explainF
, setConfigLocal
, setConfigLocalJson
) 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 M
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.RangeQuery (NonnegRange, allRange,
rangeLimit, rangeOffset)
import PostgREST.Request.Types (Alias, Field, Filter (..),
JoinCondition (..),
import PostgREST.ApiRequest.Types (Alias, Cast, Field,
Filter (..),
FtsOperator (..),
JsonOperand (..),
JsonOperation (..),
JsonPath,
@@ -60,8 +68,16 @@ import PostgREST.Request.Types (Alias, Field, Filter (..),
Operation (..),
OrderDirection (..),
OrderNulls (..),
OrderTerm (..), SelectItem,
OrderTerm (..),
SimpleOperator (..),
TrileanVal (..))
import PostgREST.MediaType (MTPlanFormat (..),
MTPlanOption (..))
import PostgREST.Plan.ReadPlan (JoinCondition (..))
import PostgREST.RangeQuery (NonnegRange, allRange,
rangeLimit, rangeOffset)
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier (..))
import Protolude hiding (cast)
@@ -75,34 +91,33 @@ noLocationF = "array[]::text[]"
sourceCTEName :: SqlFragment
sourceCTEName = "pgrst_source"
operators :: M.HashMap Text SqlFragment
operators = M.union (M.fromList [
("eq", "="),
("gte", ">="),
("gt", ">"),
("lte", "<="),
("lt", "<"),
("neq", "<>"),
("like", "LIKE"),
("ilike", "ILIKE"),
("in", "IN"),
("is", "IS"),
("cs", "@>"),
("cd", "<@"),
("ov", "&&"),
("sl", "<<"),
("sr", ">>"),
("nxr", "&<"),
("nxl", "&>"),
("adj", "-|-")]) ftsOperators
singleValOperator :: SimpleOperator -> SqlFragment
singleValOperator = \case
OpEqual -> "="
OpGreaterThanEqual -> ">="
OpGreaterThan -> ">"
OpLessThanEqual -> "<="
OpLessThan -> "<"
OpNotEqual -> "<>"
OpLike -> "like"
OpILike -> "ilike"
OpContains -> "@>"
OpContained -> "<@"
OpOverlap -> "&&"
OpStrictlyLeft -> "<<"
OpStrictlyRight -> ">>"
OpNotExtendsRight -> "&<"
OpNotExtendsLeft -> "&>"
OpAdjacent -> "-|-"
OpMatch -> "~"
OpIMatch -> "~*"
ftsOperators :: M.HashMap Text SqlFragment
ftsOperators = M.fromList [
("fts", "@@ to_tsquery"),
("plfts", "@@ plainto_tsquery"),
("phfts", "@@ phraseto_tsquery"),
("wfts", "@@ websearch_to_tsquery")
]
ftsOperator :: FtsOperator -> SqlFragment
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
@@ -121,7 +136,7 @@ normalizedBody body =
"END AS val",
"FROM pgrst_payload)"])
where
jsonPlaceHolder = SQL.encoderAndParam (HE.nullable HE.unknown) (LBS.toStrict <$> body) <> "::json"
jsonPlaceHolder = SQL.encoderAndParam (HE.nullable HE.jsonLazyBytes) body
singleParameter :: Maybe LBS.ByteString -> ByteString -> SQL.Snippet
singleParameter body typ =
@@ -153,6 +168,14 @@ pgFmtIdent x = encodeUtf8 $ "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "
trimNullChars :: Text -> Text
trimNullChars = T.takeWhile (/= '\x0')
-- |
-- Format a list of identifiers and separate them by commas.
--
-- >>> pgFmtIdentList ["schema_1", "schema_2", "SPECIAL \"@/\\#~_-"]
-- "\"schema_1\", \"schema_2\", \"SPECIAL \"\"@/\\#~_-\""
pgFmtIdentList :: [Text] -> SqlFragment
pgFmtIdentList schemas = BS.intercalate ", " $ pgFmtIdent <$> schemas
asCsvF :: SqlFragment
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
where
@@ -172,10 +195,16 @@ asJsonF returnsScalar
| returnsScalar = "coalesce(json_agg(_postgrest_t.pgrst_scalar), '[]')::character varying"
| otherwise = "coalesce(json_agg(_postgrest_t), '[]')::character varying"
asJsonSingleF :: Bool -> SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
asJsonSingleF :: Bool -> SqlFragment
asJsonSingleF returnsScalar
| returnsScalar = "coalesce(string_agg(to_json(_postgrest_t.pgrst_scalar)::text, ','), 'null')::character varying"
| otherwise = "coalesce(string_agg(to_json(_postgrest_t)::text, ','), '')::character varying"
| returnsScalar = "coalesce((json_agg(_postgrest_t.pgrst_scalar)->0)::text, 'null')"
| otherwise = "coalesce((json_agg(_postgrest_t)->0)::text, 'null')"
asXmlF :: FieldName -> SqlFragment
asXmlF fieldName = "coalesce(xmlagg(_postgrest_t." <> pgFmtIdent fieldName <> "), '')"
asGeoJsonF :: SqlFragment
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 <> ", ''), '')"
@@ -201,14 +230,17 @@ pgFmtColumn table "*" = fromQi table <> ".*"
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
pgFmtField :: QualifiedIdentifier -> Field -> SQL.Snippet
pgFmtField table (c, jp) = SQL.sql (pgFmtColumn table c) <> pgFmtJsonPath jp
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
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet
pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias)
pgFmtSelectItem :: QualifiedIdentifier -> (Field, Maybe Cast, Maybe Alias) -> SQL.Snippet
pgFmtSelectItem table (f@(fName, jp), Nothing, alias) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias)
-- 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)
pgFmtSelectItem table (f@(fName, jp), Just cast, alias) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias)
pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SQL.Snippet
pgFmtOrderTerm qi ot =
@@ -227,8 +259,8 @@ pgFmtOrderTerm qi ot =
pgFmtFilter :: QualifiedIdentifier -> Filter -> SQL.Snippet
pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
Op op val -> pgFmtFieldOp op <> " " <> case op of
"like" -> unknownLiteral (T.map star val)
"ilike" -> unknownLiteral (T.map star val)
OpLike -> unknownLiteral (T.map star val)
OpILike -> unknownLiteral (T.map star val)
_ -> unknownLiteral val
-- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error.
@@ -249,11 +281,11 @@ pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper
_ -> "= ANY (" <> unknownLiteral (pgBuildArrayLiteral vals) <> ") "
Fts op lang val ->
pgFmtFieldOp op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
pgFmtFieldFts op <> "(" <> ftsLang lang <> unknownLiteral val <> ") "
where
ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ")
pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
sqlOperator o = SQL.sql $ M.lookupDefault "=" o operators
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
@@ -325,6 +357,17 @@ 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 mainQi rangeId =
(
BS.intercalate " AND " $ (\col -> pgFmtColumn mainQi col <> " = " <> pgFmtColumn (QualifiedIdentifier mempty "pgrst_affected_rows") col) <$> rangeId
, BS.intercalate ", " (pgFmtColumn mainQi <$> rangeId)
)
orderF :: QualifiedIdentifier -> [OrderTerm] -> SQL.Snippet
orderF _ [] = mempty
orderF qi ordts = "ORDER BY " <> intercalateSnippet ", " (pgFmtOrderTerm qi <$> ordts)
-- Hasql Snippet utilities
unknownEncoder :: ByteString -> SQL.Snippet
unknownEncoder = SQL.encoderAndParam (HE.nonNullable HE.unknown)
@@ -335,3 +378,34 @@ unknownLiteral = unknownEncoder . encodeUtf8
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 fmt opts snip =
"EXPLAIN (" <>
SQL.sql (BS.intercalate ", " (fmtPlanFmt fmt : (fmtPlanOpt <$> opts))) <>
") " <> snip
where
fmtPlanOpt :: MTPlanOption -> 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"
-- | 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
+102 -100
View File
@@ -6,50 +6,59 @@ This module constructs single SQL statements that can be parametrized and prepar
- It consumes the SqlQuery types generated by the QueryBuilder module.
- It generates the body format and some headers of the final HTTP response.
TODO: Currently, createReadStatement is not using prepared statements. See https://github.com/PostgREST/postgrest/issues/718.
-}
module PostgREST.Query.Statements
( createWriteStatement
, createReadStatement
, callProcStatement
, createExplainStatement
( prepareWrite
, prepareRead
, prepareCall
, preparePlanRows
, 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 Data.Maybe (fromJust)
import PostgREST.Error (Error (..))
import PostgREST.GucHeader (GucHeader)
import PostgREST.DbStructure.Identifiers (FieldName)
import PostgREST.ApiRequest.Preferences
import PostgREST.MediaType (MTPlanAttrs (..),
MTPlanFormat (..),
MediaType (..),
getMediaType)
import PostgREST.Query.SqlFragment
import PostgREST.Request.Preferences
import PostgREST.SchemaCache.Identifiers (FieldName)
import Protolude
{-| The generic query result format used by API responses. The location header
is represented as a list of strings containing variable bindings like
@"k1=eq.42"@, or the empty list if there is no location header.
-}
type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Error [GucHeader], Either Error (Maybe Status))
-- | Standard result set format used for all queries
data ResultSet
= RSStandard
{ rsTableTotal :: Maybe Int64
-- ^ count of all the table rows
, rsQueryTotal :: Int64
-- ^ count of the query rows
, rsLocation :: [(BS.ByteString, BS.ByteString)]
-- ^ The Location header(only used for inserts) is represented as a list of strings containing
-- 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 :: Maybe BS.ByteString
-- ^ the HTTP headers to be added to the response
, rsGucStatus :: Maybe Text
-- ^ the HTTP status to be added to the response
}
| RSPlan BS.ByteString -- ^ the plan of the query
createWriteStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool ->
PreferRepresentation -> [Text] -> Bool ->
SQL.Statement () ResultsWithCount
createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys =
SQL.dynamicallyParameterized snippet decodeStandard
prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType ->
PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet
prepareWrite selectQuery mutateQuery isInsert mt rep pKeys =
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
where
snippet =
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
@@ -65,7 +74,7 @@ createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys
"FROM (" <> selectF <> ") _postgrest_t"
locF =
if isInsert && rep `elem` [Full, HeadersOnly]
if isInsert && rep == HeadersOnly
then BS.unwords [
"CASE WHEN pg_catalog.count(_postgrest_t) = 1",
"THEN coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
@@ -74,24 +83,25 @@ createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys
else noLocationF
bodyF
| rep `elem` [None, HeadersOnly] = "''"
| asCsv = asCsvF
| wantSingle = asJsonSingleF False
| otherwise = asJsonF False
| 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 `elem` [None, HeadersOnly] = SQL.sql ("SELECT * FROM " <> sourceCTEName)
| otherwise = selectQuery
| rep /= Full = SQL.sql ("SELECT * FROM " <> sourceCTEName)
| otherwise = selectQuery
decodeStandard :: HD.Result ResultsWithCount
decodeStandard =
fromMaybe (Nothing, 0, [], mempty, Right [], Right Nothing) <$> HD.rowMaybe standardRow
decodeIt :: HD.Result ResultSet
decodeIt = case mt of
MTPlan{} -> planRow
_ -> fromMaybe (RSStandard Nothing 0 mempty mempty Nothing Nothing) <$> HD.rowMaybe (standardRow False)
createReadStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool ->
SQL.Statement () ResultsWithCount
createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
SQL.dynamicallyParameterized snippet decodeStandard
prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> Maybe FieldName -> Bool -> SQL.Statement () ResultSet
prepareRead selectQuery countQuery countTotal mt binaryField =
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
where
snippet =
"WITH " <>
@@ -100,7 +110,6 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField
SQL.sql ("SELECT " <>
countResultF <> " AS total_result_set, " <>
"pg_catalog.count(_postgrest_t) AS page_total, " <>
noLocationF <> " AS header, " <>
bodyF <> " AS body, " <>
responseHeadersF <> " AS response_headers, " <>
responseStatusF <> " AS response_status " <>
@@ -109,32 +118,23 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField
(countCTEF, countResultF) = countF countQuery countTotal
bodyF
| asCsv = asCsvF
| isSingle = asJsonSingleF False
| isJust binaryField = asBinaryF $ fromJust binaryField
| otherwise = asJsonF False
| 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
decodeStandard :: HD.Result ResultsWithCount
decodeStandard =
HD.singleRow standardRow
decodeIt :: HD.Result ResultSet
decodeIt = case mt of
MTPlan{} -> planRow
_ -> HD.singleRow $ standardRow True
{-| Read and Write api requests use a similar response format which includes
various record counts and possible location header. This is the decoder
for that common type of query.
-}
standardRow :: HD.Row ResultsWithCount
standardRow = (,,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
<*> arrayColumn HD.bytea <*> column HD.bytea
<*> (fromMaybe (Right []) <$> nullableColumn decodeGucHeaders)
<*> (fromMaybe (Right Nothing) <$> nullableColumn decodeGucStatus)
type ProcResults = (Maybe Int64, Int64, ByteString, Either Error [GucHeader], Either Error (Maybe Status))
callProcStatement :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
Bool -> Bool -> Bool -> Maybe FieldName -> Bool ->
SQL.Statement () ProcResults
callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal asSingle asCsv multObjects binaryField =
SQL.dynamicallyParameterized snippet decodeProc
prepareCall :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
MediaType -> Bool -> Maybe FieldName -> Bool ->
SQL.Statement () ResultSet
prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mt multObjects binaryField =
SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
where
snippet =
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
@@ -151,47 +151,49 @@ callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQue
(countCTEF, countResultF) = countF countQuery countTotal
bodyF
| asSingle = asJsonSingleF returnsScalar
| asCsv = asCsvF
| isJust binaryField = asBinaryF $ fromJust binaryField
| returnsSingle
&& not multObjects = asJsonSingleF returnsScalar
| otherwise = asJsonF returnsScalar
| 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
decodeProc :: HD.Result ProcResults
decodeProc =
fromMaybe (Just 0, 0, mempty, defGucHeaders, defGucStatus) <$> HD.rowMaybe procRow
where
defGucHeaders = Right []
defGucStatus = Right Nothing
procRow = (,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
<*> column HD.bytea
<*> (fromMaybe defGucHeaders <$> nullableColumn decodeGucHeaders)
<*> (fromMaybe defGucStatus <$> nullableColumn decodeGucStatus)
decodeIt :: HD.Result ResultSet
decodeIt = case mt of
MTPlan{} -> planRow
_ -> fromMaybe (RSStandard (Just 0) 0 mempty mempty Nothing Nothing) <$> HD.rowMaybe (standardRow True)
createExplainStatement :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
createExplainStatement countQuery =
SQL.dynamicallyParameterized snippet decodeExplain
preparePlanRows :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
preparePlanRows countQuery =
SQL.dynamicallyParameterized snippet decodeIt
where
snippet = "EXPLAIN (FORMAT JSON) " <> countQuery
-- |
-- An `EXPLAIN (FORMAT JSON) select * from items;` output looks like this:
-- [{
-- "Plan": {
-- "Node Type": "Seq Scan", "Parallel Aware": false, "Relation Name": "items",
-- "Alias": "items", "Startup Cost": 0.00, "Total Cost": 32.60,
-- "Plan Rows": 2260,"Plan Width": 8} }]
-- We only obtain the Plan Rows here.
decodeExplain :: HD.Result (Maybe Int64)
decodeExplain =
snippet = explainF PlanJSON mempty countQuery
decodeIt :: HD.Result (Maybe Int64)
decodeIt =
let row = HD.singleRow $ column HD.bytea in
(^? L.nth 0 . L.key "Plan" . L.key "Plan Rows" . L._Integral) <$> row
decodeGucHeaders :: HD.Value (Either Error [GucHeader])
decodeGucHeaders = first (const GucHeadersError) . JSON.eitherDecode . LBS.fromStrict <$> HD.bytea
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
<*> nullableColumn HD.bytea
<*> nullableColumn HD.text
where
splitKeyValue :: ByteString -> (ByteString, ByteString)
splitKeyValue kv =
let (k, v) = BS.break (== '=') kv in
(k, BS.tail v)
decodeGucStatus :: HD.Value (Either Error (Maybe Status))
decodeGucStatus = first (const GucStatusError) . fmap (Just . toEnum . fst) . decimal <$> HD.text
mtSnippet :: MediaType -> SQL.Snippet -> SQL.Snippet
mtSnippet mediaType snippet = case mediaType of
MTPlan (MTPlanAttrs _ 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)
column :: HD.Value a -> HD.Row a
column = HD.column . HD.nonNullable
+25 -6
View File
@@ -10,6 +10,9 @@ module PostgREST.RangeQuery (
, restrictRange
, rangeGeq
, allRange
, limitZeroRange
, hasLimitZero
, convertToLimitZeroRange
, NonnegRange
, rangeStatusHeader
, contentRangeH
@@ -34,13 +37,14 @@ rangeParse :: BS.ByteString -> NonnegRange
rangeParse range = do
let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString
case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of
Just parsedRange ->
let [_, mLower, mUpper] = readMaybe . BS.unpack <$> parsedRange
lower = maybe emptyRange rangeGeq mLower
upper = maybe allRange rangeLeq mUpper in
case range =~ rangeRegex :: [[BS.ByteString]] of
[[_, l, u]] ->
let lower = maybe emptyRange rangeGeq (readInteger l)
upper = maybe allRange rangeLeq (readInteger u) in
rangeIntersection lower upper
Nothing -> allRange
_ -> allRange
where
readInteger = readMaybe . BS.unpack
rangeRequested :: RequestHeaders -> NonnegRange
rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers
@@ -74,6 +78,21 @@ rangeLeq :: Integer -> NonnegRange
rangeLeq n =
Range BoundaryBelowAll (BoundaryAbove n)
-- Special case to allow limit 0 queries
-- https://github.com/PostgREST/postgrest/issues/1121
-- 0 <= x <= -1
limitZeroRange :: Range Integer
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
-518
View File
@@ -1,518 +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(..)
, ContentType(..)
, Action(..)
, Target(..)
, Payload(..)
, userApiRequest
) where
import qualified Data.Aeson as JSON
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 M
import qualified Data.List as L
import qualified Data.List.NonEmpty as NonEmptyList
import qualified Data.Set as S
import qualified Data.Text as T
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 (last, lookup, partition, union)
import Data.Maybe (fromJust)
import Data.Ranged.Boundaries (Boundary (..))
import Data.Ranged.Ranges (Range (..), emptyRange,
rangeIntersection)
import Network.HTTP.Base (urlEncodeVars)
import Network.HTTP.Types.Header (hAuthorization, hCookie)
import Network.HTTP.Types.URI (parseQueryReplacePlus,
parseSimpleQuery)
import Network.Wai (Request (..))
import Network.Wai.Parse (parseHttpAccept)
import Web.Cookie (parseCookies)
import PostgREST.Config (AppConfig (..),
OpenAPIMode (..))
import PostgREST.ContentType (ContentType (..))
import PostgREST.DbStructure (DbStructure (..))
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema)
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcParam (..), ProcsMap)
import PostgREST.Error (ApiRequestError (..))
import PostgREST.Query.SqlFragment (ftsOperators, operators)
import PostgREST.RangeQuery (NonnegRange, allRange,
rangeGeq, rangeLimit,
rangeOffset, rangeRequested,
restrictRange)
import PostgREST.Request.Parsers (pRequestColumns)
import PostgREST.Request.Preferences (PreferCount (..),
PreferParameters (..),
PreferRepresentation (..),
PreferResolution (..),
PreferTransaction (..))
import qualified PostgREST.ContentType as ContentType
import qualified PostgREST.Request.Preferences as Preferences
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
-- | Types of things a user wants to do to tables/views/procs
data Action = ActionCreate | ActionRead{isHead :: Bool}
| ActionUpdate | ActionDelete
| ActionSingleUpsert | 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 Path
= PathInfo
{ pSchema :: Schema,
pName :: Text,
pHasRpc :: Bool,
pIsDefaultSpec :: Bool,
pIsRootSpec :: Bool
}
| PathUnknown
-- | 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 "/"
| TargetUnknown
-- | 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 $ M.fromList $ second JSON.toJSON <$> prms) (S.fromList $ fst <$> prms)
else
let paramsMap = M.fromListWith mergeParams $ toRpcParamValue proc <$> prms in
ProcessedJSON (JSON.encode paramsMap) (S.fromList $ M.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 verb, e.g. Create/Invoke both POST
, iRange :: M.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
, iFilters :: [(Text, Text)] -- ^ Filters on the result ("id", "eq.10")
, iLogic :: [(Text, Text)] -- ^ &and and &or parameters used for complex boolean logic
, iSelect :: Maybe Text -- ^ &select parameter used to shape the response
, iOnConflict :: Maybe Text -- ^ &on_conflict parameter used to upsert on specific unique keys
, iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload
, iOrder :: [(Text, Text)] -- ^ &order parameters for each level
, iCanonicalQS :: ByteString -- ^ Alphabetized (canonical) request query string for response URLs
, iJWT :: Text -- ^ JSON Web Token
, 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.
, iAcceptContentType :: ContentType
}
-- | Examines HTTP request and translates it into user intent.
userApiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
userApiRequest conf@AppConfig{..} dbStructure req reqBody
| isJust profile && fromJust profile `notElem` configDbSchemas = Left $ UnacceptableSchema $ toList configDbSchemas
| isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate
| topLevelRange == emptyRange = Left InvalidRange
| shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload
| isLeft parsedColumns = either Left witness parsedColumns
| otherwise = do
acceptContentType <- findAcceptContentType 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
, iFilters = filters
, iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
, iSelect = toS <$> join (lookup "select" qParams)
, iOnConflict = toS <$> join (lookup "on_conflict" qParams)
, iColumns = payloadColumns
, iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
, iCanonicalQS = BS.pack $ urlEncodeVars
. L.sortOn fst
. map (join (***) BS.unpack . second (fromMaybe mempty))
$ qString
, iJWT = tokenStr
, iHeaders = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
, iCookies = maybe [] parseCookies $ lookupHeader "Cookie"
, iPath = rawPathInfo req
, iMethod = method
, iProfile = profile
, iSchema = schema
, iAcceptContentType = acceptContentType
}
where
accepts = maybe [CTAny] (map ContentType.decodeContentType . parseHttpAccept) $ lookupHeader "accept"
-- queryString with '+' converted to ' '(space)
qString = parseQueryReplacePlus True $ rawQueryString req
-- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
(filters, rpcQParams) =
case action of
ActionInvoke InvGet -> partitionFlts
ActionInvoke InvHead -> partitionFlts
_ -> (flts, [])
partitionFlts = partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
flts =
[ (toS k, toS $ fromJust v) |
(k,v) <- qParams, isJust v,
k `notElem` ["select", "columns"],
not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
hasOperator val = any (`T.isPrefixOf` val) $
((<> ".") <$> "not":M.keys operators) ++
((<> "(") <$> M.keys ftsOperators)
isEmbedPath = T.isInfixOf "."
isTargetingProc = case path of
PathInfo{pHasRpc, pIsRootSpec} -> pHasRpc || pIsRootSpec
_ -> False
isTargetingDefaultSpec = case path of
PathInfo{pIsDefaultSpec=True} -> True
_ -> False
contentType = maybe CTApplicationJSON ContentType.decodeContentType $ lookupHeader "content-type"
columns
| action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams)
| otherwise = Nothing
parsedColumns = pRequestColumns columns
payloadColumns =
case (contentType, action) of
(_, ActionInvoke InvGet) -> S.fromList $ fst <$> rpcQParams
(_, ActionInvoke InvHead) -> S.fromList $ fst <$> rpcQParams
(CTUrlEncoded, _) -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
_ -> case (relevantPayload, fromRight Nothing parsedColumns) of
(Just ProcessedJSON{payKeys}, _) -> payKeys
(Just RawJSON{}, Just cls) -> cls
_ -> S.empty
payload :: Either ByteString Payload
payload = case contentType of
CTApplicationJSON ->
if isJust columns
then Right $ RawJSON reqBody
else note "All object keys must match" . payloadAttributes reqBody
=<< if LBS.null reqBody && isTargetingProc
then Right emptyObject
else first BS.pack $ JSON.eitherDecode reqBody
CTTextCSV -> do
json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody)
note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
CTUrlEncoded ->
let paramsMap = M.fromList $ (T.decodeUtf8 *** JSON.String . T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) in
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (M.keys paramsMap)
ct ->
if isTargetingProc && ct `elem` [CTTextPlain, CTOctetStream]
then Right $ RawPay reqBody
else Left $ "Content-Type not acceptable: " <> ContentType.toMime ct
topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges -- if no limit is specified, get all the request rows
action =
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" | isTargetingDefaultSpec -> ActionInspect{isHead=True}
| isTargetingProc -> ActionInvoke InvHead
| otherwise -> ActionRead{isHead=True}
"GET" | isTargetingDefaultSpec -> ActionInspect{isHead=False}
| isTargetingProc -> ActionInvoke InvGet
| otherwise -> ActionRead{isHead=False}
"POST" -> if isTargetingProc
then ActionInvoke InvPost
else ActionCreate
"PATCH" -> ActionUpdate
"PUT" -> ActionSingleUpsert
"DELETE" -> ActionDelete
"OPTIONS" -> ActionInfo
_ -> ActionInspect{isHead=False}
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 action of
-- POST/PATCH/PUT/DELETE don't use the same header as per the spec
ActionCreate -> contentProfile
ActionUpdate -> contentProfile
ActionSingleUpsert -> contentProfile
ActionDelete -> contentProfile
ActionInvoke InvPost -> 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 =
let
callFindProc procSch procNam = findProc
(QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs dbStructure)
contentType (action == ActionInvoke InvPost)
in
case path of
PathInfo{pSchema, pName, pHasRpc, pIsRootSpec, pIsDefaultSpec}
| pHasRpc || pIsRootSpec -> (`TargetProc` pIsRootSpec) <$> callFindProc pSchema pName
| pIsDefaultSpec -> Right $ TargetDefaultSpec pSchema
| otherwise -> Right $ TargetIdent $ QualifiedIdentifier pSchema pName
PathUnknown -> Right TargetUnknown
shouldParsePayload = case (contentType, action) of
(CTUrlEncoded, ActionInvoke InvPost) -> False
(_, act) -> act `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke InvPost]
relevantPayload = case (contentType, 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) rpcQParams
(_, ActionInvoke InvHead) -> targetToJsonRpcParams (rightToMaybe target) rpcQParams
(CTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
_ | shouldParsePayload -> rightToMaybe payload
| otherwise -> Nothing
path =
case pathInfo req of
[] -> case configDbRootSpec of
Just (QualifiedIdentifier pSch pName) -> PathInfo (if pSch == mempty then schema else pSch) pName False False True
Nothing | configOpenApiMode == OADisabled -> PathUnknown
| otherwise -> PathInfo schema "" False True False
[table] -> PathInfo schema table False False False
["rpc", pName] -> PathInfo schema pName True False False
_ -> PathUnknown
method = requestMethod req
hdrs = requestHeaders req
qParams = [(T.decodeUtf8 k, T.decodeUtf8 <$> v)|(k,v) <- qString]
lookupHeader = flip lookup hdrs
Preferences.Preferences{..} = Preferences.fromHeaders hdrs
auth = fromMaybe "" $ lookupHeader hAuthorization
tokenStr = case T.split (== ' ') (T.decodeUtf8 auth) of
("Bearer" : t : _) -> t
("bearer" : t : _) -> t
_ -> ""
endingIn:: [Text] -> Text -> Bool
endingIn xx key = lastWord `elem` xx
where lastWord = last $ T.split (=='.') key
headerRange = rangeRequested hdrs
replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) ++ [x]
limitParams :: M.HashMap Text NonnegRange
limitParams = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe . toS =<< v) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]
offsetParams :: M.HashMap Text NonnegRange
offsetParams = M.fromList [(toS (replaceLast "limit" k), maybe allRange rangeGeq (readMaybe . toS =<< v)) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
urlRange = M.unionWith f limitParams offsetParams
where
f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
where
l = fromMaybe 0 $ rangeLimit rl
o = rangeOffset ro
ranges = M.insert "limit" (rangeIntersection headerRange (fromMaybe allRange (M.lookup "limit" urlRange))) urlRange
{-|
Find the best match from a list of content 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 :: [ContentType] -> [ContentType] -> Maybe ContentType
mutuallyAgreeable sProduces cAccepts =
let exact = listToMaybe $ L.intersect cAccepts sProduces in
if isNothing exact && CTAny `elem` cAccepts
then listToMaybe sProduces
else exact
type CsvData = V.Vector (M.HashMap 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 .
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 $ M.keys o
areKeysUniform = all (\case
JSON.Object x -> S.fromList (M.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 $ M.keys o)
-- truncate everything else to an empty array.
_ -> Just emptyPJArray
where
emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty
findAcceptContentType :: AppConfig -> Action -> Path -> [ContentType] -> Either ApiRequestError ContentType
findAcceptContentType conf action path accepts =
case mutuallyAgreeable (requestContentTypes conf action path) accepts of
Just ct ->
Right ct
Nothing ->
Left . ContentTypeError $ map ContentType.toMime accepts
requestContentTypes :: AppConfig -> Action -> Path -> [ContentType]
requestContentTypes conf action path =
case action of
ActionRead _ -> defaultContentTypes ++ rawContentTypes conf
ActionInvoke _ -> invokeContentTypes
ActionInspect _ -> [CTOpenAPI, CTApplicationJSON]
ActionInfo -> [CTTextCSV]
_ -> defaultContentTypes
where
invokeContentTypes =
defaultContentTypes
++ rawContentTypes conf
++ [CTOpenAPI | pIsRootSpec path]
defaultContentTypes =
[CTApplicationJSON, CTSingularJSON, CTTextCSV]
rawContentTypes :: AppConfig -> [ContentType]
rawContentTypes AppConfig{..} =
(ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain]
{-|
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 -> ContentType -> Bool -> Either ApiRequestError ProcDescription
findProc qi argumentsKeys paramsAsSingleObject allProcs contentType isInvPost =
case matchProc of
([], []) -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentType 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 $ M.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 procs = foldr select ([],[]) procs
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 proc = isInvPost && case pdParams proc of
[ProcParam "" ppType _ _]
| contentType == CTApplicationJSON -> ppType `elem` ["json", "jsonb"]
| contentType == CTTextPlain -> ppType == "text"
| contentType == CTOctetStream -> ppType == "bytea"
| otherwise -> False
_ -> False
matchesParams proc =
let params = pdParams proc in
-- exceptional case for Prefer: params=single-object
if paramsAsSingleObject
then length params == 1 && (ppType <$> headMay params) `elem` [Just "json", Just "jsonb"]
-- If the function has no parameters, the arguments keys must be empty as well
else if null params
then null argumentsKeys && contentType `notElem` [CTTextPlain, CTOctetStream]
-- 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)
-397
View File
@@ -1,397 +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 M
import qualified Data.Set as S
import Control.Arrow ((***))
import Data.Either.Combinators (mapLeft)
import Data.List (delete)
import Data.Text (isInfixOf)
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 (..))
import PostgREST.DbStructure.Table (Column (..), Table (..),
tableQi)
import PostgREST.Error (ApiRequestError (..),
Error (..))
import PostgREST.Query.SqlFragment (sourceCTEName)
import PostgREST.RangeQuery (NonnegRange, allRange,
restrictRange)
import PostgREST.Request.ApiRequest (Action (..),
ApiRequest (..),
Payload (..))
import PostgREST.Request.Parsers
import PostgREST.Request.Preferences
import PostgREST.Request.Types
import qualified PostgREST.DbStructure.Relationship as Relationship
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 -> [Relationship] -> ApiRequest -> Either Error ReadRequest
readRequest schema rootTableName maxRows allRels apiRequest =
mapLeft ApiRequestError $
treeRestrictRange maxRows =<<
augmentRequestWithJoin schema rootRels =<<
(addFiltersOrdersRanges apiRequest . initReadRequest rootName =<< pRequestSelect sel)
where
sel = fromMaybe "*" $ iSelect apiRequest -- default to all columns requested (SELECT *) for a non existent ?select querystring param
(rootName, rootRels) = rootWithRels schema rootTableName allRels (iAction apiRequest)
-- Get the root table name with its relationships according to the Action type.
-- This is done because of the shape of the final SQL Query. The mutation cases
-- are wrapped in a WITH {sourceCTEName}(see Statements.hs). So we need a FROM
-- {sourceCTEName} instead of FROM {tableName}.
rootWithRels :: Schema -> TableName -> [Relationship] -> Action -> (QualifiedIdentifier, [Relationship])
rootWithRels schema rootTableName allRels action = case action of
ActionRead _ -> (QualifiedIdentifier schema rootTableName, allRels) -- normal read case
_ -> (QualifiedIdentifier mempty _sourceCTEName, mapMaybe toSourceRel allRels ++ allRels) -- mutation cases and calling proc
where
_sourceCTEName = decodeUtf8 sourceCTEName
-- To enable embedding in the sourceCTEName cases we need to replace the
-- foreign key tableName in the Relationship with {sourceCTEName}. This way
-- findRel can find relationships with sourceCTEName.
toSourceRel :: Relationship -> Maybe Relationship
toSourceRel r@Relationship{relTable=t}
| rootTableName == tableName t = Just $ r {relTable=t {tableName=_sourceCTEName}}
| otherwise = Nothing
-- 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 -> [Tree SelectItem] -> ReadRequest
initReadRequest rootQi =
foldr (treeEntry rootDepth) initial
where
rootDepth = 0
rootSchema = qiSchema rootQi
rootName = qiName rootQi
initial = Node (Select [] rootQi Nothing [] [] [] [] 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 -> ReadRequest -> Either ApiRequestError ReadRequest
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 -> [Relationship] -> ReadRequest -> Either ApiRequestError ReadRequest
augmentRequestWithJoin schema allRels request =
addRels schema allRels Nothing request
>>= addJoinConditions Nothing
addRels :: Schema -> [Relationship] -> 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}, _) _) ->
let newFrom r = if qiName tbl == nodeName then tableQi (relForeignTable r) else tbl
newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, hint, joinType, depth))) <$> rel
rel = findRel schema allRels (qiName parentNodeQi) 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
-- 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 elements will be matched according to
-- these rules:
-- origin = table / view
-- target = table / view / constraint / column-from-origin
-- 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)
findRel :: Schema -> [Relationship] -> NodeName -> NodeName -> Maybe Hint -> Either ApiRequestError Relationship
findRel schema allRels origin target hint =
case rel of
[] -> Left $ NoRelBetween origin target
[r] -> Right r
-- Here we handle a self reference relationship to not cause a breaking
-- change: In a self reference we get two relationships with the same
-- foreign key and relTable/relFtable but with different
-- cardinalities(m2o/o2m) We output the O2M rel, the M2O rel can be
-- obtained by using the origin column as an embed hint.
rs@[rel0, rel1] -> case (relCardinality rel0, relCardinality rel1, relTable rel0 == relTable rel1 && relForeignTable rel0 == relForeignTable rel1) of
(O2M cons1, M2O cons2, True) -> if cons1 == cons2 then Right rel0 else Left $ AmbiguousRelBetween origin target rs
(M2O cons1, O2M cons2, True) -> if cons1 == cons2 then Right rel1 else Left $ AmbiguousRelBetween origin target rs
_ -> Left $ AmbiguousRelBetween origin target rs
rs -> Left $ AmbiguousRelBetween origin target rs
where
matchFKSingleCol hint_ cols = length cols == 1 && hint_ == (colName <$> head cols)
matchConstraint tar card = case card of
O2M cons -> tar == Just cons
M2O cons -> tar == Just cons
_ -> False
matchJunction hint_ card = case card of
M2M Junction{junTable} -> hint_ == Just (tableName junTable)
_ -> False
rel = filter (
\Relationship{..} ->
-- Both relationship ends need to be on the exposed schema
schema == tableSchema relTable && schema == tableSchema relForeignTable &&
(
-- /projects?select=clients(*)
origin == tableName relTable && -- projects
target == tableName relForeignTable || -- clients
-- /projects?select=projects_client_id_fkey(*)
(
origin == tableName relTable && -- projects
matchConstraint (Just target) relCardinality -- projects_client_id_fkey
) ||
-- /projects?select=client_id(*)
(
origin == tableName relTable && -- projects
matchFKSingleCol (Just target) relColumns -- client_id
)
) && (
isNothing hint || -- hint is optional
-- /projects?select=clients!projects_client_id_fkey(*)
matchConstraint hint relCardinality || -- projects_client_id_fkey
-- /projects?select=clients!client_id(*) or /projects?select=clients!id(*)
matchFKSingleCol hint relColumns || -- client_id
matchFKSingleCol hint relForeignColumns || -- id
-- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
matchJunction hint relCardinality -- users_tasks
)
) allRels
-- previousAlias is only used for the case of self joins
addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest
addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, rel, _, _, _, depth)) forest) =
case rel of
Just r@Relationship{relCardinality=M2M Junction{junTable}} ->
let rq = augmentQuery r in
Node (rq{implicitJoins=tableQi junTable:implicitJoins rq}, nodeProps) <$> updatedForest
Just r -> Node (augmentQuery r, nodeProps) <$> updatedForest
Nothing -> Node node <$> updatedForest
where
newAlias = case Relationship.isSelfReference <$> rel of
Just True
| depth /= 0 -> Just (qiName tbl <> "_" <> show depth) -- root node doesn't get aliased
| otherwise -> Nothing
_ -> Nothing
augmentQuery r =
foldr
(\jc rq@Select{joinConditions=jcs} -> rq{joinConditions=jc:jcs})
query{fromAlias=newAlias}
(getJoinConditions previousAlias newAlias r)
updatedForest = addJoinConditions newAlias `traverse` forest
-- previousAlias and newAlias are used in the case of self joins
getJoinConditions :: Maybe Alias -> Maybe Alias -> Relationship -> [JoinCondition]
getJoinConditions previousAlias newAlias (Relationship Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fCols card) =
case card of
M2M (Junction Table{tableName=jtn} _ jc1 _ jc2) ->
zipWith (toJoinCondition tN jtn) cols jc1 ++ zipWith (toJoinCondition ftN jtn) fCols jc2
_ ->
zipWith (toJoinCondition tN ftN) cols fCols
where
toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
toJoinCondition tb ftb c fc =
let qi1 = removeSourceCTESchema tSchema tb
qi2 = removeSourceCTESchema tSchema ftb in
JoinCondition (maybe qi1 (QualifiedIdentifier mempty) previousAlias, colName c)
(maybe qi2 (QualifiedIdentifier mempty) newAlias, colName fc)
-- On mutation and calling proc cases we wrap the target table in a WITH
-- {sourceCTEName} if this happens remove the schema `FROM
-- "schema"."{sourceCTEName}"` and use only the `FROM "{sourceCTEName}"`.
-- If the schema remains the FROM would be invalid.
removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == decodeUtf8 sourceCTEName then mempty else schema) tbl
addFiltersOrdersRanges :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest
addFiltersOrdersRanges apiRequest rReq = do
rFlts <- foldr addFilter rReq <$> filters
rOrds <- foldr addOrder rFlts <$> orders
rRngs <- foldr addRange rOrds <$> ranges
foldr addLogicTree rRngs <$> logicForest
where
filters :: Either ApiRequestError [(EmbedPath, Filter)]
filters = pRequestFilter `traverse` flts
orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
orders = pRequestOrder `traverse` iOrder apiRequest
ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
ranges = pRequestRange `traverse` M.toList (iRange apiRequest)
logicForest :: Either ApiRequestError [(EmbedPath, LogicTree)]
logicForest = pRequestLogicTree `traverse` logFrst
action = iAction apiRequest
-- there can be no filters on the root table when we are doing insert/update/delete
(flts, logFrst) =
case action of
ActionInvoke _ -> (iFilters apiRequest, iLogic apiRequest)
ActionRead _ -> (iFilters apiRequest, iLogic apiRequest)
_ -> join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
addFilterToNode :: Filter -> ReadRequest -> ReadRequest
addFilterToNode flt (Node (q@Select {where_=lf}, i) f) = Node (q{where_=addFilterToLogicForest flt lf}::ReadQuery, i) f
addFilter :: (EmbedPath, Filter) -> ReadRequest -> ReadRequest
addFilter = addProperty addFilterToNode
addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
addOrderToNode o (Node (q,i) f) = Node (q{order=o}, i) f
addOrder :: (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest
addOrder = addProperty addOrderToNode
addRangeToNode :: NonnegRange -> ReadRequest -> ReadRequest
addRangeToNode r (Node (q,i) f) = Node (q{range_=r}, i) f
addRange :: (EmbedPath, NonnegRange) -> ReadRequest -> ReadRequest
addRange = addProperty addRangeToNode
addLogicTreeToNode :: LogicTree -> ReadRequest -> ReadRequest
addLogicTreeToNode t (Node (q@Select{where_=lf},i) f) = Node (q{where_=t:lf}::ReadQuery, i) f
addLogicTree :: (EmbedPath, LogicTree) -> ReadRequest -> ReadRequest
addLogicTree = addProperty addLogicTreeToNode
addProperty :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> ReadRequest -> ReadRequest
addProperty f ([], a) rr = f a rr
addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
case pathNode of
Nothing -> Node rn forest -- the property is silenty dropped in the Request does not contain the required path
Just tn -> Node rn (addProperty f (remainingPath, a) tn:delete tn forest)
where
pathNode = find (\(Node (_,(nodeName,_,alias,_,_, _)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
mutateRequest :: Schema -> TableName -> ApiRequest -> [FieldName] -> ReadRequest -> Either Error MutateRequest
mutateRequest schema tName apiRequest pkCols readReq = mapLeft ApiRequestError $
case action of
ActionCreate -> do
confCols <- case iOnConflict apiRequest of
Nothing -> pure pkCols
Just param -> pRequestOnConflict param
pure $ Insert qi (iColumns apiRequest) body ((,) <$> iPreferResolution apiRequest <*> Just confCols) [] returnings
ActionUpdate -> Update qi (iColumns apiRequest) body <$> combinedLogic <*> pure returnings
ActionSingleUpsert ->
(\flts ->
if null (iLogic apiRequest) &&
S.fromList (fst <$> iFilters apiRequest) == S.fromList pkCols &&
not (null (S.fromList pkCols)) &&
all (\case
Filter _ (OpExpr False (Op "eq" _)) -> True
_ -> False) flts
then Insert qi (iColumns apiRequest) body (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
else
Left InvalidFilters) =<< filters
ActionDelete -> Delete qi <$> combinedLogic <*> pure returnings
_ -> Left UnsupportedVerb
where
qi = QualifiedIdentifier schema tName
action = iAction apiRequest
returnings =
if iPreferRepresentation apiRequest == None
then []
else returningCols readReq pkCols
filters = map snd <$> pRequestFilter `traverse` mutateFilters
logic = map snd <$> pRequestLogicTree `traverse` logicFilters
combinedLogic = foldr addFilterToLogicForest <$> logic <*> filters
-- update/delete filters can be only on the root table
(mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest)
onlyRoot = filter (not . ( "." `isInfixOf` ) . fst)
body = payRaw <$> iPayload apiRequest -- 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 params = filter (\x -> ppName x `S.member` iColumns apiReq) params
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{relColumns=cols}, _, _, _, _)) _ -> Just cols
_ -> Nothing
) 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 = S.toList . S.fromList $ fldNames ++ (colName <$> fkCols) ++ pkCols
-- 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
-294
View File
@@ -1,294 +0,0 @@
{-|
Module : PostgREST.Request.Parsers
Description : PostgREST parser combinators
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`.
-}
module PostgREST.Request.Parsers
( pColumns
, pLogicPath
, pLogicSingleVal
, pLogicTree
, pOrder
, pOrderTerm
, pRequestColumns
, pRequestFilter
, pRequestLogicTree
, pRequestOnConflict
, pRequestOrder
, pRequestRange
, pRequestSelect
, pSingleVal
, pTreePath
) where
import qualified Data.HashMap.Strict as M
import qualified Data.Set as S
import Data.Either.Combinators (mapLeft)
import Data.Foldable (foldl1)
import Data.List (init, last)
import Data.Text (intercalate, replace, strip)
import Data.Tree (Tree (..))
import Text.Parsec.Error (errorMessages,
showErrorMessages)
import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser,
anyChar, between, char, digit,
eof, errorPos, letter,
lookAhead, many1, noneOf,
notFollowedBy, oneOf, option,
optionMaybe, parse, sepBy1,
string, try, (<?>))
import PostgREST.DbStructure.Identifiers (FieldName)
import PostgREST.Error (ApiRequestError (ParseRequestError))
import PostgREST.Query.SqlFragment (ftsOperators, operators)
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.Request.Types
import Protolude hiding (intercalate, option, replace, try)
pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem]
pRequestSelect selStr =
mapError $ parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
pRequestOnConflict :: Text -> Either ApiRequestError [FieldName]
pRequestOnConflict oncStr =
mapError $ parse pColumns ("failed to parse on_conflict parameter (" <> toS oncStr <> ")") (toS oncStr)
pRequestFilter :: (Text, Text) -> Either ApiRequestError (EmbedPath, Filter)
pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
where
treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
oper = parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
path = fst <$> treePath
fld = snd <$> treePath
pRequestOrder :: (Text, Text) -> Either ApiRequestError (EmbedPath, [OrderTerm])
pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
where
treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
path = fst <$> treePath
ord' = parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v
pRequestRange :: (Text, NonnegRange) -> Either ApiRequestError (EmbedPath, NonnegRange)
pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
where
treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
path = fst <$> treePath
pRequestLogicTree :: (Text, Text) -> Either ApiRequestError (EmbedPath, LogicTree)
pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
where
path = parse pLogicPath ("failed to parser 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=(.. , ..)"
parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
pRequestColumns :: Maybe Text -> Either ApiRequestError (Maybe (S.Set FieldName))
pRequestColumns colStr =
case colStr of
Just str ->
mapError $ Just . S.fromList <$> 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 <- 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 <|>
intercalate "-" . map toS <$> (many1 (letter <|> digit <|> oneOf "_ ") `sepBy1` dash) <?>
"field name (* or [a..z0..9_])"
where
isDash :: GenParser Char st ()
isDash = try ( char '-' >> notFollowedBy (char '>') )
dash :: Parser Char
dash = isDash $> '-'
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 <$> ((:) <$> option '+' (char '-') <*> many1 digit) <* pEnd
pEnd = try (void $ lookAhead (string "->")) <|>
try (void $ lookAhead (string "::")) <|>
try eof in
try pJIdx <|> try pJKey
pField :: Parser Field
pField = lexeme $ (,) <$> pFieldName <*> 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 letter)
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 =
Op . toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys ops) <*> pSVal
<|> In <$> (try (string "in" *> pDelimiter) *> pListVal)
<|> Is <$> (try (string "is" *> pDelimiter) *> pTriVal)
<|> pFts
<?> "operator (eq, gt, ...)"
pTriVal = try (string "null" $> TriNull)
<|> try (string "unknown" $> TriUnknown)
<|> try (string "true" $> TriTrue)
<|> try (string "false" $> TriFalse)
<?> "null or trilean value (unknown, true, false)"
pFts = do
op <- foldl1 (<|>) (try . string . toS <$> ftsOps)
lang <- optionMaybe $ try (between (char '(') (char ')') (many (letter <|> digit <|> oneOf "_")))
pDelimiter >> Fts (toS op) (toS <$> lang) <$> pSVal
ops = M.filterWithKey (const . flip notElem ("in":"is":ftsOps)) operators
ftsOps = M.keys ftsOperators
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 ',')
mapError :: Either ParseError a -> Either ApiRequestError a
mapError = mapLeft translateError
where
translateError e =
ParseRequestError message details
where
message = show $ errorPos e
details = strip $ replace "\n" " " $ toS
$ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
-232
View File
@@ -1,232 +0,0 @@
{-# LANGUAGE DuplicateRecordFields #-}
module PostgREST.Request.Types
( Alias
, Depth
, EmbedParam(..)
, EmbedPath
, Field
, Filter(..)
, Hint
, CallQuery(..)
, CallParams(..)
, CallRequest
, JoinCondition(..)
, JoinType(..)
, JsonOperand(..)
, JsonOperation(..)
, JsonPath
, ListVal
, LogicOperator(..)
, LogicTree(..)
, MutateQuery(..)
, MutateRequest
, NodeName
, OpExpr(..)
, Operation (..)
, OrderDirection(..)
, OrderNulls(..)
, OrderTerm(..)
, ReadNode
, ReadQuery(..)
, ReadRequest
, SelectItem
, SingleVal
, TrileanVal(..)
, fstFieldNames
) where
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Set as S
import Data.Tree (Tree (..))
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.DbStructure.Proc (ProcParam (..))
import PostgREST.DbStructure.Relationship (Relationship)
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.Request.Preferences (PreferResolution)
import Protolude
type ReadRequest = Tree ReadNode
type MutateRequest = MutateQuery
type CallRequest = CallQuery
type ReadNode =
(ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe Hint, Maybe JoinType, Depth))
type NodeName = Text
type Depth = Integer
data ReadQuery = Select
{ select :: [SelectItem]
, from :: QualifiedIdentifier
-- ^ A table alias is used in case of self joins
, fromAlias :: Maybe Alias
-- ^ Only used for Many to Many joins. Parent and Child joins use explicit joins.
, implicitJoins :: [QualifiedIdentifier]
, where_ :: [LogicTree]
, joinConditions :: [JoinCondition]
, order :: [OrderTerm]
, range_ :: NonnegRange
}
deriving (Eq)
data JoinCondition =
JoinCondition
(QualifiedIdentifier, FieldName)
(QualifiedIdentifier, FieldName)
deriving (Eq)
data OrderTerm = OrderTerm
{ otTerm :: Field
, otDirection :: Maybe OrderDirection
, otNullOrder :: Maybe OrderNulls
}
deriving (Eq)
data OrderDirection
= OrderAsc
| OrderDesc
deriving (Eq)
data OrderNulls
= OrderNullsFirst
| OrderNullsLast
deriving (Eq)
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]
, returning :: [FieldName]
}
| Delete
{ in_ :: QualifiedIdentifier
, where_ :: [LogicTree]
, returning :: [FieldName]
}
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)
-- | The select value in `/tbl?select=alias:field::cast`
type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType)
type Field = (FieldName, JsonPath)
type Cast = Text
type Alias = Text
type Hint = Text
data EmbedParam
-- | Disambiguates an embedding operation when there's multiple relationships
-- between two tables. Can be the name of a foreign key constraint, column
-- name or the junction in an m2m relationship.
= EPHint Hint
| EPJoinType JoinType
data JoinType
= JTInner
| JTLeft
deriving Eq
-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path
-- ["clients", "projects"]
type EmbedPath = [Text]
-- | Json path operations as specified in
-- https://www.postgresql.org/docs/current/static/functions-json.html
type JsonPath = [JsonOperation]
-- | Represents the single arrow `->` or double arrow `->>` operators
data JsonOperation
= JArrow { jOp :: JsonOperand }
| J2Arrow { jOp :: JsonOperand }
deriving (Eq)
-- | 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
-- '1'::int
data JsonOperand
= JKey { jVal :: Text }
| JIdx { jVal :: Text }
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
-- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
--
-- And
-- / \
-- name.eq.N Or
-- / \
-- id.eq.1 id.eq.2
data LogicTree
= Expr Bool LogicOperator [LogicTree]
| Stmnt Filter
deriving (Eq)
data LogicOperator
= And
| Or
deriving Eq
data Filter = Filter
{ field :: Field
, opExpr :: OpExpr
}
deriving (Eq)
data OpExpr =
OpExpr Bool Operation
deriving (Eq)
data Operation
= Op Operator SingleVal
| In ListVal
| Is TrileanVal
| Fts Operator (Maybe Language) SingleVal
deriving (Eq)
type Operator = Text
type Language = Text
-- | Represents a single value in a filter, e.g. id=eq.singleval
type SingleVal = Text
-- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3)
type ListVal = [Text]
-- | Three-valued logic values
data TrileanVal
= TriTrue
| TriFalse
| TriNull
| TriUnknown
deriving Eq
+288
View File
@@ -0,0 +1,288 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Response
( createResponse
, deleteResponse
, infoResponse
, invokeResponse
, openApiResponse
, readResponse
, singleUpsertResponse
, updateResponse
, addRetryHint
, isServiceUnavailable
, optionalRollback
) 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.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 Network.Wai as Wai
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 (..),
Target (..))
import PostgREST.ApiRequest.Preferences (PreferRepresentation (..),
PreferTransaction (..),
shouldCount,
toAppliedHeader)
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
import PostgREST.Config (AppConfig (..))
import PostgREST.MediaType (MediaType (..))
import PostgREST.Plan (MutateReadPlan (..))
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.Proc (ProcDescription (..),
ProcVolatility (..),
ProcsMap)
import PostgREST.SchemaCache.Table (Table (..), TablesMap)
import qualified PostgREST.ApiRequest.Types as ApiRequestTypes
import qualified PostgREST.SchemaCache.Proc as Proc
import Protolude hiding (Handler, toS)
import Protolude.Conv (toS)
readResponse :: Bool -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Wai.Response
readResponse headersOnly identifier ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
RSStandard{..} -> do
let
(status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
response = gucResponse rsGucStatus rsGucHeaders
headers =
[ contentRange
, ( "Content-Location"
, "/"
<> toUtf8 (qiName identifier)
<> if BS.null (qsCanonical iQueryParams) then mempty else "?" <> qsCanonical iQueryParams
)
]
++ contentTypeHeaders ctxApiRequest
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
response status headers $ if headersOnly then mempty else rsOrErrBody
RSPlan plan ->
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
createResponse :: QualifiedIdentifier -> MutateReadPlan -> ApiRequest -> ResultSet -> Wai.Response
createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan} ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
RSStandard{..} -> do
let
pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;}
response = gucResponse rsGucStatus rsGucHeaders
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
]
if iPreferRepresentation == Full then
response HTTP.status201 (headers ++ contentTypeHeaders ctxApiRequest) (LBS.fromStrict rsBody)
else
response HTTP.status201 headers mempty
RSPlan plan ->
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
updateResponse :: ApiRequest -> ResultSet -> Wai.Response
updateResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
RSStandard{..} -> do
let
response = gucResponse rsGucStatus rsGucHeaders
contentRangeHeader =
RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
headers = [contentRangeHeader]
if iPreferRepresentation == Full then
response HTTP.status200
(headers ++ contentTypeHeaders ctxApiRequest)
(LBS.fromStrict rsBody)
else
response HTTP.status204 headers mempty
RSPlan plan ->
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
singleUpsertResponse :: ApiRequest -> ResultSet -> Wai.Response
singleUpsertResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
RSStandard {..} -> do
let
response = gucResponse rsGucStatus rsGucHeaders
if iPreferRepresentation == Full then
response HTTP.status200 (contentTypeHeaders ctxApiRequest) (LBS.fromStrict rsBody)
else
response HTTP.status204 [] mempty
RSPlan plan ->
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
deleteResponse :: ApiRequest -> ResultSet -> Wai.Response
deleteResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
RSStandard {..} -> do
let
response = gucResponse rsGucStatus rsGucHeaders
contentRangeHeader =
RangeQuery.contentRangeH 1 0 $
if shouldCount iPreferCount then Just rsQueryTotal else Nothing
headers = [contentRangeHeader]
if iPreferRepresentation == Full then
response HTTP.status200
(headers ++ contentTypeHeaders ctxApiRequest)
(LBS.fromStrict rsBody)
else
response HTTP.status204 headers mempty
RSPlan plan ->
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
infoResponse :: Target -> SchemaCache -> Wai.Response
infoResponse target sCache =
case target of
TargetIdent identifier ->
case HM.lookup identifier (dbTables sCache) of
Just tbl -> respondInfo $ allowH tbl
Nothing -> Error.errorResponseFor $ Error.ApiRequestError ApiRequestTypes.NotFound
TargetProc pd _
| pdVolatility pd == Volatile -> respondInfo "OPTIONS,POST"
| otherwise -> respondInfo "OPTIONS,GET,HEAD,POST"
TargetDefaultSpec _ -> respondInfo "OPTIONS,GET,HEAD"
where
respondInfo allowHeader = 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]
invokeResponse :: InvokeMethod -> ProcDescription -> ApiRequest -> ResultSet -> Wai.Response
invokeResponse invMethod proc ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
RSStandard {..} -> do
let
response = gucResponse rsGucStatus rsGucHeaders
(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
headers = [contentRange]
if Proc.procReturnsVoid proc then
response HTTP.status204 headers mempty
else
response status
(headers ++ contentTypeHeaders ctxApiRequest)
(if invMethod == InvHead then mempty else rsOrErrBody)
RSPlan plan ->
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
openApiResponse :: Bool -> Maybe (TablesMap, ProcsMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Wai.Response
openApiResponse headersOnly body conf sCache schema negotiatedByProfile =
Wai.responseLBS HTTP.status200
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile))
(maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode conf sCache x y z) body)
-- | Response with headers and status overridden from GUCs.
gucResponse
:: Maybe Text
-> Maybe BS.ByteString
-> HTTP.Status
-> [HTTP.Header]
-> LBS.ByteString
-> Wai.Response
gucResponse rsGucStatus rsGucHeaders status headers body =
case (,) <$> decodeGucStatus rsGucStatus <*> decodeGucHeaders rsGucHeaders of
Left err -> Error.errorResponseFor err
Right (gucStatus, gucHeaders) ->
Wai.responseLBS (fromMaybe status gucStatus) (addHeadersIfNotIncluded headers (map unwrapGucHeader gucHeaders)) body
decodeGucHeaders :: Maybe BS.ByteString -> Either Error.Error [GucHeader]
decodeGucHeaders =
maybe (Right []) $ first (const Error.GucHeadersError) . JSON.eitherDecode . LBS.fromStrict
decodeGucStatus :: Maybe Text -> Either Error.Error (Maybe HTTP.Status)
decodeGucStatus =
maybe (Right Nothing) $ first (const Error.GucStatusError) . fmap (Just . toEnum . fst) . decimal
contentTypeHeaders :: ApiRequest -> [HTTP.Header]
contentTypeHeaders ApiRequest{..} =
MediaType.toContentType iAcceptMediaType : maybeToList (profileHeader iSchema iNegotiatedByProfile)
profileHeader :: Schema -> Bool -> Maybe HTTP.Header
profileHeader schema negotiatedByProfile =
if negotiatedByProfile
then Just $ (,) "Content-Profile" (toS schema)
else
Nothing
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
isServiceUnavailable :: Wai.Response -> Bool
isServiceUnavailable response = Wai.responseStatus response == HTTP.status503
optionalRollback :: AppConfig -> ApiRequest -> ExceptT Error.Error IO Wai.Response -> ExceptT Error.Error IO Wai.Response
optionalRollback AppConfig{..} ApiRequest{..} resp = do
newRes <- catchError resp $ return . Error.errorResponseFor
return $ Wai.mapResponseHeaders preferenceApplied newRes
where
shouldCommit =
configDbTxAllowOverride && iPreferTransaction == Just Commit
shouldRollback =
configDbTxAllowOverride && iPreferTransaction == Just Rollback
preferenceApplied
| shouldCommit =
addHeadersIfNotIncluded
[toAppliedHeader Commit]
| shouldRollback =
addHeadersIfNotIncluded
[toAppliedHeader Rollback]
| otherwise =
identity
-- | 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,12 +1,12 @@
module PostgREST.GucHeader
module PostgREST.Response.GucHeader
( GucHeader
, unwrapGucHeader
, addHeadersIfNotIncluded
) where
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Strict as M
import Network.HTTP.Types.Header (Header)
@@ -21,16 +21,10 @@ newtype GucHeader = GucHeader (CI.CI ByteString, ByteString)
instance JSON.FromJSON GucHeader where
parseJSON (JSON.Object o) =
case M.toList o of
[(k, JSON.String s)] -> pure $ GucHeader (CI.mk $ toUtf8 k, toUtf8 s)
case KM.toList o of
[(k, JSON.String s)] -> pure $ GucHeader (CI.mk $ toUtf8 $ K.toText k, toUtf8 s)
_ -> mzero
parseJSON _ = mzero
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
@@ -3,14 +3,13 @@ Module : PostgREST.OpenAPI
Description : Generates the OpenAPI output
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# 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
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as M
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
@@ -27,86 +26,98 @@ import Data.Swagger
import PostgREST.Config (AppConfig (..), Proxy (..),
isMalformedProxyUri, toURI)
import PostgREST.DbStructure (DbStructure (..),
tableCols, tablePKCols)
import PostgREST.DbStructure.Proc (ProcDescription (..),
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
import PostgREST.SchemaCache.Proc (ProcDescription (..),
ProcParam (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
PrimaryKey (..),
Relationship (..))
import PostgREST.DbStructure.Table (Column (..), Table (..))
import PostgREST.SchemaCache.Relationship (Cardinality (..),
Relationship (..),
RelationshipsMap)
import PostgREST.SchemaCache.Table (Column (..), Table (..),
TablesMap)
import PostgREST.Version (docsVersion, prettyVersion)
import PostgREST.ContentType
import PostgREST.MediaType
import Protolude hiding (Proxy, get)
encode :: AppConfig -> DbStructure -> [Table] -> M.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
encode conf dbStructure tables procs schemaDescription =
encode :: AppConfig -> SchemaCache -> TablesMap -> HM.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
encode conf sCache tables procs schemaDescription =
JSON.encode $
postgrestSpec
(dbRelationships dbStructure)
(concat $ M.elems procs)
(openApiTableInfo dbStructure <$> tables)
(dbRelationships sCache)
(concat $ HM.elems procs)
(snd <$> HM.toList tables)
(proxyUri conf)
schemaDescription
(dbPrimaryKeys dbStructure)
(configOpenApiSecurityActive conf)
makeMimeList :: [ContentType] -> MimeList
makeMimeList :: [MediaType] -> MimeList
makeMimeList cs = MimeList $ fmap (fromString . BS.unpack . toMime) cs
toSwaggerType :: Text -> SwaggerType t
toSwaggerType "character varying" = SwaggerString
toSwaggerType "character" = SwaggerString
toSwaggerType "text" = SwaggerString
toSwaggerType "boolean" = SwaggerBoolean
toSwaggerType "smallint" = SwaggerInteger
toSwaggerType "integer" = SwaggerInteger
toSwaggerType "bigint" = SwaggerInteger
toSwaggerType "numeric" = SwaggerNumber
toSwaggerType "real" = SwaggerNumber
toSwaggerType "double precision" = SwaggerNumber
toSwaggerType "ARRAY" = SwaggerArray
toSwaggerType _ = SwaggerString
toSwaggerType :: Text -> Maybe (SwaggerType t)
toSwaggerType "character varying" = Just SwaggerString
toSwaggerType "character" = Just SwaggerString
toSwaggerType "text" = Just SwaggerString
toSwaggerType "boolean" = Just SwaggerBoolean
toSwaggerType "smallint" = Just SwaggerInteger
toSwaggerType "integer" = Just SwaggerInteger
toSwaggerType "bigint" = Just SwaggerInteger
toSwaggerType "numeric" = Just SwaggerNumber
toSwaggerType "real" = Just SwaggerNumber
toSwaggerType "double precision" = Just SwaggerNumber
toSwaggerType "json" = Nothing
toSwaggerType "jsonb" = Nothing
toSwaggerType colType = case T.takeEnd 2 colType of
"[]" -> Just SwaggerArray
_ -> Just SwaggerString
makeSwaggerItemType :: Maybe (SwaggerType t) -> Text -> Maybe (Referenced Schema)
makeSwaggerItemType itemType colType = case itemType of
Just SwaggerArray -> Just $ Inline (mempty & type_ .~ toSwaggerType (T.dropEnd 2 colType))
_ -> Nothing
parseDefault :: Text -> Text -> Text
parseDefault colType colDefault =
case toSwaggerType colType of
SwaggerString -> wrapInQuotations $ case T.stripSuffix ("::" <> colType) colDefault of
Just SwaggerString -> wrapInQuotations $ case T.stripSuffix ("::" <> colType) colDefault of
Just def -> T.dropAround (=='\'') def
Nothing -> colDefault
_ -> colDefault
where
wrapInQuotations text = "\"" <> text <> "\""
makeTableDef :: [Relationship] -> [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
makeTableDef rels pks (t, cs, _) =
makeTableDef :: RelationshipsMap -> Table -> (Text, Schema)
makeTableDef rels t =
let tn = tableName t in
(tn, (mempty :: Schema)
& description .~ tableDescription t
& type_ ?~ SwaggerObject
& properties .~ fromList (fmap (makeProperty rels pks) cs)
& required .~ fmap colName (filter (not . colNullable) cs))
& properties .~ fromList (makeProperty t rels <$> tableColumns t)
& required .~ fmap colName (filter (not . colNullable) $ tableColumns t))
makeProperty :: [Relationship] -> [PrimaryKey] -> Column -> (Text, Referenced Schema)
makeProperty rels pks c = (colName c, Inline s)
makeProperty :: Table -> RelationshipsMap -> Column -> (Text, Referenced Schema)
makeProperty tbl rels col = (colName col, Inline s)
where
e = if null $ colEnum c then Nothing else JSON.decode $ JSON.encode $ colEnum c
e = if null $ colEnum col then Nothing else JSON.decode $ JSON.encode $ colEnum col
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{relColumns, relCardinality=M2O _} -> [c] == relColumns
_ -> False
) rels
fCol = colName <$> (headMay . relForeignColumns =<< rel)
fTbl = tableName . relForeignTable <$> rel
Relationship{relCardinality=(M2O _ relColumns)} -> [colName col] == (fst <$> relColumns)
_ -> False
) relsSortedByIsView
fCol = (headMay . (\r -> snd <$> relColumns (relCardinality r)) =<< rel)
fTbl = qiName . relForeignTable <$> rel
fTblCol = (,) <$> fTbl <*> fCol
in
(\(a, b) -> T.intercalate "" ["This is a Foreign Key to `", a, ".", b, "`.<fk table='", a, "' column='", b, "'/>"]) <$> fTblCol
pk :: Bool
pk = any (\p -> pkTable p == colTable c && pkName p == colName c) pks
pk = colName col `elem` tablePKCols tbl
n = catMaybes
[ Just "Note:"
, if pk then Just "This is a Primary Key.<pk/>" else Nothing
@@ -114,17 +125,19 @@ makeProperty rels pks c = (colName c, Inline s)
]
d =
if length n > 1 then
Just $ T.append (maybe "" (`T.append` "\n\n") $ colDescription c) (T.intercalate "\n" n)
Just $ T.append (maybe "" (`T.append` "\n\n") $ colDescription col) (T.intercalate "\n" n)
else
colDescription c
colDescription col
pType = toSwaggerType (colType col)
s =
(mempty :: Schema)
& default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType c) =<< colDefault c)
& default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType col) =<< colDefault col)
& description .~ d
& enum_ .~ e
& format ?~ colType c
& maxLength .~ (fromIntegral <$> colMaxLen c)
& type_ ?~ toSwaggerType (colType c)
& format ?~ colType col
& maxLength .~ (fromIntegral <$> colMaxLen col)
& type_ .~ pType
& items .~ (SwaggerItemsObject <$> makeSwaggerItemType pType (colType col))
makeProcSchema :: ProcDescription -> Schema
makeProcSchema pd =
@@ -138,7 +151,8 @@ makeProcProperty :: ProcParam -> (Text, Referenced Schema)
makeProcProperty (ProcParam n t _ _) = (n, Inline s)
where
s = (mempty :: Schema)
& type_ ?~ toSwaggerType t
& type_ .~ toSwaggerType t
& items .~ (SwaggerItemsObject <$> makeSwaggerItemType (toSwaggerType t) t)
& format ?~ t
makePreferParam :: [Text] -> Param
@@ -150,7 +164,15 @@ 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 =
@@ -161,11 +183,13 @@ makeProcParam pd =
, Ref $ Reference "preferParams"
]
makeParamDefs :: [(Table, [Column], [Text])] -> [(Text, Param)]
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"
@@ -217,8 +241,8 @@ makeParamDefs ti =
& in_ .~ ParamQuery
& type_ ?~ SwaggerString))
]
<> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) cs
| (t, cs, _) <- ti
<> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) (tableColumns t)
| t <- ti
]
makeObjectBody :: Text -> (Text, Param)
@@ -243,8 +267,8 @@ makeRowFilter tn c =
makeRowFilters :: Text -> [Column] -> [(Text, Param)]
makeRowFilters tn = fmap (makeRowFilter tn)
makePathItem :: (Table, [Column], [Text]) -> (FilePath, PathItem)
makePathItem (t, cs, _) = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t || tableDeletable t)
makePathItem :: Table -> (FilePath, PathItem)
makePathItem t = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpdatable t || tableDeletable t)
where
-- Use first line of table description as summary; rest as description (if present)
-- We strip leading newlines from description so that users can include a blank line between summary and description
@@ -265,7 +289,7 @@ makePathItem (t, cs, _) = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpd
)
)
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"])
@@ -278,7 +302,7 @@ makePathItem (t, cs, _) = ("/" ++ T.unpack tn, p $ tableInsertable t || tableUpd
p False = pr
p True = pw
tn = tableName t
rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- cs ]
rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- tableColumns t ]
ref = Ref . Reference
makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
@@ -293,7 +317,7 @@ makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
& description .~ mfilter (/="") pDesc
& parameters .~ makeProcParam pd
& tags .~ Set.fromList ["(rpc) " <> pdName pd]
& produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON]
& produces ?~ makeMimeList [MTApplicationJSON, MTSingularJSON]
& at 200 ?~ "OK"
pe = (mempty :: PathItem) & post ?~ postOp
@@ -303,15 +327,23 @@ makeRootPathItem = ("/", p)
getOp = (mempty :: Operation)
& tags .~ Set.fromList ["Introspection"]
& summary ?~ "OpenAPI description (this document)"
& produces ?~ makeMimeList [CTOpenAPI, CTApplicationJSON]
& produces ?~ makeMimeList [MTOpenAPI, MTApplicationJSON]
& at 200 ?~ "OK"
pr = (mempty :: PathItem) & get ?~ getOp
p = pr
makePathItems :: [ProcDescription] -> [(Table, [Column], [Text])] -> InsOrdHashMap FilePath PathItem
makePathItems :: [ProcDescription] -> [Table] -> InsOrdHashMap FilePath PathItem
makePathItems pds ti = fromList $ makeRootPathItem :
fmap makePathItem ti ++ fmap makeProcPathItem pds
makeSecurityDefinitions :: Text -> Bool -> SecurityDefinitions
makeSecurityDefinitions secName allow
| allow = SecurityDefinitions (fromList [(secName, SecurityScheme secSchType secSchDescription)])
| otherwise = mempty
where
secSchType = SecuritySchemeApiKey (ApiKeyParams "Authorization" ApiKeyHeader)
secSchDescription = Just "Add the token prepending \"Bearer \" (without quotes) to it"
escapeHostName :: Text -> Text
escapeHostName "*" = "0.0.0.0"
escapeHostName "*4" = "0.0.0.0"
@@ -320,8 +352,8 @@ escapeHostName "*6" = "0.0.0.0"
escapeHostName "!6" = "0.0.0.0"
escapeHostName h = h
postgrestSpec :: [Relationship] -> [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> Swagger
postgrestSpec rels pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
postgrestSpec :: RelationshipsMap -> [ProcDescription] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Bool -> Swagger
postgrestSpec rels pds ti (s, h, p, b) sd allowSecurityDef = (mempty :: Swagger)
& basePath ?~ T.unpack b
& schemes ?~ [s']
& info .~ ((mempty :: Info)
@@ -332,15 +364,18 @@ postgrestSpec rels pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
& description ?~ "PostgREST Documentation"
& url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
& host .~ h'
& definitions .~ fromList (makeTableDef rels pks <$> ti)
& definitions .~ fromList (makeTableDef rels <$> ti)
& parameters .~ fromList (makeParamDefs ti)
& paths .~ makePathItems pds ti
& produces .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
& consumes .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
& produces .~ makeMimeList [MTApplicationJSON, MTSingularJSON, MTTextCSV]
& consumes .~ makeMimeList [MTApplicationJSON, MTSingularJSON, 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"
pickProxy :: Maybe Text -> Maybe Proxy
pickProxy proxy
@@ -378,10 +413,3 @@ proxyUri AppConfig{..} =
(proxyScheme, proxyHost, proxyPort, proxyPath)
Nothing ->
("http", configServerHost, toInteger configServerPort, "/")
openApiTableInfo :: DbStructure -> Table -> (Table, [Column], [Text])
openApiTableInfo dbStructure table =
( table
, tableCols dbStructure (tableSchema table) (tableName table)
, tablePKCols dbStructure (tableSchema table) (tableName table)
)
File diff suppressed because it is too large Load Diff
@@ -1,16 +1,18 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module PostgREST.DbStructure.Identifiers
module PostgREST.SchemaCache.Identifiers
( QualifiedIdentifier(..)
, 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
@@ -40,3 +42,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,7 +1,7 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module PostgREST.DbStructure.Proc
module PostgREST.SchemaCache.Proc
( PgType(..)
, ProcDescription(..)
, ProcParam(..)
@@ -10,13 +10,14 @@ module PostgREST.DbStructure.Proc
, RetType(..)
, procReturnsScalar
, procReturnsSingle
, procReturnsVoid
, procTableName
) where
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as M
import qualified Data.HashMap.Strict as HM
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
Schema, TableName)
import Protolude
@@ -42,7 +43,7 @@ data ProcDescription = ProcDescription
, pdName :: Text
, pdDescription :: Maybe Text
, pdParams :: [ProcParam]
, pdReturnType :: RetType
, pdReturnType :: Maybe RetType
, pdVolatility :: ProcVolatility
, pdHasVariadic :: Bool
}
@@ -65,21 +66,26 @@ instance Ord ProcDescription where
-- | 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 = M.HashMap QualifiedIdentifier [ProcDescription]
type ProcsMap = HM.HashMap QualifiedIdentifier [ProcDescription]
procReturnsScalar :: ProcDescription -> Bool
procReturnsScalar proc = case proc of
ProcDescription{pdReturnType = (Single Scalar)} -> True
ProcDescription{pdReturnType = (SetOf Scalar)} -> True
_ -> False
ProcDescription{pdReturnType = Just (Single Scalar)} -> True
ProcDescription{pdReturnType = Just (SetOf Scalar)} -> True
_ -> False
procReturnsSingle :: ProcDescription -> Bool
procReturnsSingle proc = case proc of
ProcDescription{pdReturnType = (Single _)} -> True
_ -> False
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
SetOf (Composite qi) -> Just $ qiName qi
Single (Composite qi) -> Just $ qiName qi
_ -> Nothing
Just (SetOf (Composite qi)) -> Just $ qiName qi
Just (Single (Composite qi)) -> Just $ qiName qi
_ -> Nothing
+64
View File
@@ -0,0 +1,64 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module PostgREST.SchemaCache.Relationship
( Cardinality(..)
, Relationship(..)
, Junction(..)
, RelationshipsMap
) where
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier, Schema)
import Protolude
-- | Relationship between two tables.
data Relationship = Relationship
{ relTable :: QualifiedIdentifier
, relForeignTable :: QualifiedIdentifier
, relIsSelf :: Bool -- ^ Whether is a self relationship
, relCardinality :: Cardinality
, relTableIsView :: Bool
, relFTableIsView :: Bool
}
| ComputedRelationship
{ relFunction :: QualifiedIdentifier
, relTable :: QualifiedIdentifier
, relForeignTable :: QualifiedIdentifier
, relToOne :: Bool
, relIsSelf :: Bool
}
deriving (Eq, Ord, Generic, JSON.ToJSON)
-- | The relationship cardinality
-- | https://en.wikipedia.org/wiki/Cardinality_(data_modeling)
data Cardinality
= O2M {relCons :: FKConstraint, relColumns :: [(FieldName, FieldName)]}
-- ^ one-to-many
| M2O {relCons :: FKConstraint, relColumns :: [(FieldName, FieldName)]}
-- ^ many-to-one
| O2O {relCons :: FKConstraint, relColumns :: [(FieldName, FieldName)]}
-- ^ 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)
type FKConstraint = Text
-- | Junction table on an M2M relationship
data Junction = Junction
{ junTable :: QualifiedIdentifier
, junConstraint1 :: FKConstraint
, junConstraint2 :: FKConstraint
, junColsSource :: [(FieldName, FieldName)]
, junColsTarget :: [(FieldName, FieldName)]
}
deriving (Eq, Ord, Generic, JSON.ToJSON)
-- | Key based on the source table and the foreign table schema
type RelationshipsMap = HM.HashMap (QualifiedIdentifier, Schema) [Relationship]
@@ -1,15 +1,16 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module PostgREST.DbStructure.Table
module PostgREST.SchemaCache.Table
( Column(..)
, Table(..)
, tableQi
, TablesMap
) where
import qualified Data.Aeson as JSON
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, TableName)
@@ -20,22 +21,22 @@ data Table = Table
{ tableSchema :: Schema
, tableName :: TableName
, tableDescription :: Maybe Text
-- TODO Find a better way to separate tables and views
, tableIsView :: Bool
-- The following fields identify what can be done on the table/view, they're not related to the privileges granted to it
, tableInsertable :: Bool
, tableUpdatable :: Bool
, tableDeletable :: Bool
, tablePKCols :: [FieldName]
, tableColumns :: [Column]
}
deriving (Show, Ord, Generic, JSON.ToJSON)
instance Eq Table where
Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
tableQi :: Table -> QualifiedIdentifier
tableQi Table{tableSchema=s, tableName=n} = QualifiedIdentifier s n
data Column = Column
{ colTable :: Table
, colName :: FieldName
{ colName :: FieldName
, colDescription :: Maybe Text
, colNullable :: Bool
, colType :: Text
@@ -43,13 +44,6 @@ data Column = Column
, colDefault :: Maybe Text
, colEnum :: [Text]
}
deriving (Ord, Generic, JSON.ToJSON)
deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
instance Eq Column where
Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
data PrimaryKey = PrimaryKey
{ pkTable :: Table
, pkName :: Text
}
deriving (Generic, JSON.ToJSON)
type TablesMap = HM.HashMap QualifiedIdentifier Table
+4 -5
View File
@@ -43,12 +43,11 @@ runAppWithSocket settings app socketFileMode socketFilePath =
-- | Set signal handlers, only for systems with signals
installSignalHandlers :: AppState.AppState -> IO ()
installSignalHandlers appState = do
-- Releases the connection pool whenever the program is terminated,
-- see https://github.com/PostgREST/postgrest/issues/268
install Signals.sigINT $ AppState.releasePool appState
install Signals.sigTERM $ AppState.releasePool appState
let interrupt = throwTo (AppState.getMainThreadId appState) UserInterrupt
install Signals.sigINT interrupt
install Signals.sigTERM interrupt
-- The SIGUSR1 signal updates the internal 'DbStructure' by running
-- The SIGUSR1 signal updates the internal 'SchemaCache' by running
-- 'connectionWorker' exactly as before.
install Signals.sigUSR1 $ Workers.connectionWorker appState
+4 -2
View File
@@ -30,10 +30,12 @@ prettyVersion =
-- | Version number used in docs.
-- Pre-release versions link to the latest docs
-- Uses only the two first components of the version. Example: 'v1.1'
docsVersion :: Text
docsVersion =
"v" <> (T.intercalate "." . map show . take 2 $ versionBranch version)
docsVersion
| isPreRelease = "latest"
| otherwise = "v" <> (T.intercalate "." . map show . take 2 $ versionBranch version)
-- | Versions with four components (e.g., '1.1.1.1') are treated as pre-releases.
+120 -40
View File
@@ -1,31 +1,40 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Workers
( connectionWorker
, reReadConfig
, listener
, runListener
, runAdmin
) where
import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
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.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
retrying, rsPreviousDelay)
import Hasql.Connection (acquire)
import Network.Socket
import Network.Socket.ByteString
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 PostgREST.SchemaCache (querySchemaCache)
import qualified PostgREST.AppState as AppState
@@ -46,35 +55,36 @@ data SCacheStatus
| 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
-- 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 preformed in a separate thread.
-- 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.
-- 3. Obtains the sCache. If this fails, it goes back to 1.
connectionWorker :: AppState -> IO ()
connectionWorker appState = do
isWorkerOn <- AppState.getIsWorkerOn appState
runExclusively (AppState.getWorkerSem appState) work
-- Prevents multiple workers to be running at the same time. Could happen on
-- too many SIGUSR1s.
unless isWorkerOn $ do
AppState.putIsWorkerOn appState True
void $ forkIO work
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
connected <- establishConnection 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
-- Unreachable because establishConnection will keep trying to connect
return ()
Connected actualPgVersion -> do
-- Procede with initialization
@@ -91,34 +101,34 @@ connectionWorker appState = do
-- 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
AppState.putIsWorkerOn appState False
-- | 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
-- | 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.
connectionStatus :: AppState -> IO ConnectionStatus
connectionStatus appState =
establishConnection :: AppState -> IO ConnectionStatus
establishConnection appState =
retrying retrySettings shouldRetry $
const $ SQL.release pool >> getConnectionStatus
const $ AppState.flushPool appState >> getConnectionStatus
where
pool = AppState.getPool appState
retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds
delayMicroseconds = 32000000 -- 32 seconds
backoffMicroseconds = 1000000 -- 1 second
getConnectionStatus :: IO ConnectionStatus
getConnectionStatus = do
pgVersion <- SQL.use pool queryPgVersion
pgVersion <- AppState.usePool appState queryPgVersion
case pgVersion of
Left e -> do
let err = PgError False e
@@ -148,15 +158,14 @@ connectionStatus appState =
when itShould $ AppState.putRetryNextIn appState delay
return itShould
-- | Load the DbStructure by using a connection from the pool.
-- | Load the SchemaCache by using a connection from the pool.
loadSchemaCache :: AppState -> IO SCacheStatus
loadSchemaCache appState = do
AppConfig{..} <- AppState.getConfig appState
actualPgVersion <- AppState.getPgVersion appState
result <-
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
SQL.use (AppState.getPool appState) . transaction SQL.ReadCommitted SQL.Read $
queryDbStructure (toList configDbSchemas) configDbExtraSearchPath actualPgVersion configDbPreparedStatements
AppState.usePool appState . transaction SQL.ReadCommitted SQL.Read $
querySchemaCache (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
case result of
Left e -> do
let
@@ -169,17 +178,22 @@ loadSchemaCache appState = do
AppState.logWithZTime appState hint
return SCFatalFail
Nothing -> do
AppState.putSchemaCache appState Nothing
AppState.logWithZTime appState "An error ocurred when loading the schema cache"
putErr
return SCOnRetry
Right dbStructure -> do
AppState.putDbStructure appState dbStructure
Right sCache -> do
AppState.putSchemaCache appState (Just sCache)
when (isJust configDbRootSpec) .
AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode dbStructure
AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode sCache
AppState.logWithZTime appState "Schema cache loaded"
return SCLoaded
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.
@@ -200,6 +214,7 @@ listener appState = do
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
_ ->
@@ -208,22 +223,22 @@ listener appState = do
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
| 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
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
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
-- | Re-reads the config plus config options from the db
reReadConfig :: Bool -> AppState -> IO ()
@@ -231,7 +246,7 @@ reReadConfig startingUp appState = do
AppConfig{..} <- AppState.getConfig appState
dbSettings <-
if configDbConfig then do
qDbSettings <- queryDbSettings (AppState.getPool appState) configDbPreparedStatements
qDbSettings <- AppState.usePool appState $ queryDbSettings configDbPreparedStatements
case qDbSettings of
Left e -> do
let
@@ -245,7 +260,7 @@ reReadConfig startingUp appState = do
AppState.logWithZTime appState hint
killThread (AppState.getMainThreadId appState)
Nothing -> do
AppState.logWithZTime appState $ show e
putErr
pure []
Right x -> pure x
else
@@ -255,10 +270,75 @@ reReadConfig startingUp appState = do
if startingUp then
panic err -- die on invalid config if the program is starting up
else
AppState.logWithZTime appState $ "Failed re-loading config: " <> err
AppState.logWithZTime appState $ "Failed reloading config: " <> err
Right newConf -> do
AppState.putConfig appState newConf
if startingUp then
pass
else
AppState.logWithZTime appState "Config re-loaded"
AppState.logWithZTime appState "Config reloaded"
runAdmin :: AppConfig -> AppState -> Warp.Settings -> IO ()
runAdmin conf@AppConfig{configAdminServerPort} appState settings =
whenJust configAdminServerPort $ \adminPort -> do
AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort
void . forkIO $ Warp.runSettings (settings & Warp.setPort adminPort) adminApp
where
whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
whenJust mg f = maybe (pure ()) f mg
adminApp = admin appState conf
-- | PostgREST admin application
admin :: AppState.AppState -> AppConfig -> Wai.Application
admin appState appConfig req respond = do
isMainAppReachable <- any isRight <$> reachMainApp appConfig
isSchemaCacheLoaded <- isJust <$> AppState.getSchemaCache appState
isConnectionUp <-
if configDbChannelEnabled appConfig
then AppState.getIsListenerOn appState
else isRight <$> AppState.usePool appState (SQL.sql "SELECT 1")
case Wai.pathInfo req of
["ready"] ->
respond $ Wai.responseLBS (if isMainAppReachable && isConnectionUp && isSchemaCacheLoaded then HTTP.status200 else HTTP.status503) [] mempty
["live"] ->
respond $ Wai.responseLBS (if isMainAppReachable then HTTP.status200 else HTTP.status503) [] mempty
_ ->
respond $ Wai.responseLBS HTTP.status404 [] mempty
-- 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
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
+21 -4
View File
@@ -1,4 +1,4 @@
resolver: lts-18.14 # 2021-10-24, GHC 8.10.7
resolver: lts-19.14 # 2022-07-01, GHC 9.0.2
nix:
packages:
@@ -10,6 +10,23 @@ nix:
pure: false
extra-deps:
- hasql-dynamic-statements-0.3.1@sha256:c3a2c89c4a8b3711368dbd33f0ccfe46a493faa7efc2c85d3e354c56a01dfc48,2673
- hasql-implicits-0.1.0.2@sha256:5d54e09cb779a209681b139fb3cc726bae75134557932156340cc0a56dd834a8,1361
- ptr-0.16.8.1@sha256:525219ec5f5da5c699725f7efcef91b00a7d44120fc019878b85c09440bf51d6,2686
- HTTP-4000.3.16
- configurator-pg-0.2.6
- hashable-1.4.1.0
- hashtables-1.3
- hasql-1.6.1.1
- hasql-dynamic-statements-0.3.1.2
- hasql-implicits-0.1.0.5
- hasql-notifications-0.2.0.3
- hasql-pool-0.8.0.6
- hasql-transaction-1.0.1.2
- isomorphism-class-0.1.0.6
- lens-aeson-1.1.3
- optparse-applicative-0.16.1.0
- postgresql-binary-0.12.5
- protolude-0.3.2
- ptr-0.16.8.2
- text-builder-0.6.7
- text-builder-dev-0.3.3
- git: https://github.com/PostgREST/postgresql-libpq.git
commit: 33ff97db570b5b432255f5f24a68db51453f6eb8
+132 -16
View File
@@ -5,29 +5,145 @@
packages:
- completed:
hackage: hasql-dynamic-statements-0.3.1@sha256:c3a2c89c4a8b3711368dbd33f0ccfe46a493faa7efc2c85d3e354c56a01dfc48,2673
hackage: HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
pantry-tree:
size: 641
sha256: b1b9a6a26ec765e5fe29f9a670a5c9ec7067ea00dee8491f0819284ff0201b6f
size: 1428
sha256: b73a7f6d21cf20bbf819e19039409c9010efb5000d2b72cdd8fd67a9027c14e8
original:
hackage: hasql-dynamic-statements-0.3.1@sha256:c3a2c89c4a8b3711368dbd33f0ccfe46a493faa7efc2c85d3e354c56a01dfc48,2673
hackage: HTTP-4000.3.16
- completed:
hackage: hasql-implicits-0.1.0.2@sha256:5d54e09cb779a209681b139fb3cc726bae75134557932156340cc0a56dd834a8,1361
hackage: configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
pantry-tree:
size: 310
sha256: 2f00d1467d0e226b966c2cd7bac433c8948e2f7bbdf8a44936029f66fc20b5f3
size: 2463
sha256: 97efe7a22afc93033bda5adcffdabc0f1c30dc32b2c3ba02114ce7cd74c942fd
original:
hackage: hasql-implicits-0.1.0.2@sha256:5d54e09cb779a209681b139fb3cc726bae75134557932156340cc0a56dd834a8,1361
hackage: configurator-pg-0.2.6
- completed:
hackage: ptr-0.16.8.1@sha256:525219ec5f5da5c699725f7efcef91b00a7d44120fc019878b85c09440bf51d6,2686
hackage: hashable-1.4.1.0@sha256:50b2f002c68fe67730ee7a3cd8607486197dd99b084255005ad51ecd6970a41b,5019
pantry-tree:
size: 1089
sha256: d2b8440a738719ef8430ec38fe33b129e3940e4ccf2c016a727a1110a43656bb
size: 1248
sha256: 9af2f7a42674f7effcabbebc043f97057240783f1709338a77f58216f4a5f18c
original:
hackage: ptr-0.16.8.1@sha256:525219ec5f5da5c699725f7efcef91b00a7d44120fc019878b85c09440bf51d6,2686
hackage: hashable-1.4.1.0
- completed:
hackage: hashtables-1.3@sha256:ab21804fdafbbd8ad918b2911dabb729ae0ea891780fe66bf7804cbcd07edadf,10379
pantry-tree:
size: 2895
sha256: e71f113ad989dbc994e0fb52bcc219d62930de9afa8b3441bf7909e864481b33
original:
hackage: hashtables-1.3
- completed:
hackage: hasql-1.6.1.1@sha256:948a2137308cc5354e4997bc3666753867124cd25db792424cb9614b1c1b44cf,6626
pantry-tree:
size: 2622
sha256: 28d21bf061522fc513f040e9c383b90532222b7258216cc094e07736add8be10
original:
hackage: hasql-1.6.1.1
- completed:
hackage: hasql-dynamic-statements-0.3.1.2@sha256:417aa533c84f074e2fa16bb2c4d4231326aa512097dd1025d915388e56acd1eb,2675
pantry-tree:
size: 595
sha256: 91696d3f3e0ef3254772ae5a8e4e89be68285febb49b302ed83d85ac4037a417
original:
hackage: hasql-dynamic-statements-0.3.1.2
- completed:
hackage: hasql-implicits-0.1.0.5@sha256:d16aacad6dc21428d72447d3ae8bcc03839a2f0aa1ec29c797ed9aca4609f9af,1361
pantry-tree:
size: 264
sha256: 0451b99a0a1d02db673d0c40acdf60d4e769e15852eed9e8dc05bffaf43efb70
original:
hackage: hasql-implicits-0.1.0.5
- completed:
hackage: hasql-notifications-0.2.0.3@sha256:aca3f7ee847a8f0b7ef6f989dc48f4a094a06c1a34e92aa3c8bb230085966ea6,2027
pantry-tree:
size: 452
sha256: 999f0f2856a00d21f4498a8a58452bbefc4ea972fe2984fd234a68a5fe61d98b
original:
hackage: hasql-notifications-0.2.0.3
- completed:
hackage: hasql-pool-0.8.0.6@sha256:b63bb83409bab5bc20ff24f5d62205e9b117701a0fc24531ddeac20ab8c2a42c,1818
pantry-tree:
size: 346
sha256: c4100946b7eae44375511e35a393abe2e1db0e5637c68cea8f53176b796bfd5b
original:
hackage: hasql-pool-0.8.0.6
- completed:
hackage: hasql-transaction-1.0.1.2@sha256:297b158cd1f0727f9b0e175bd7d3741c1bcb725a8094956d0ee79b41aafdb30a,2890
pantry-tree:
size: 983
sha256: 3679e6d5c835cc17a8fa0c252b8221e282880044b7219aa1de2531bbd5c40691
original:
hackage: hasql-transaction-1.0.1.2
- completed:
hackage: isomorphism-class-0.1.0.6@sha256:d93da31287359c761953b876354de28381f409c5c50e3241c572a443e50c553d,1703
pantry-tree:
size: 465
sha256: c97f922d1ae8f1a0db4c28fac9383d2716934879e95ff0b2b88ebb861d6fba14
original:
hackage: isomorphism-class-0.1.0.6
- completed:
hackage: lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
pantry-tree:
size: 541
sha256: b31392b78f2a03111c805f4400007778eb93b49f998ab41dfbebaaf9b5526bad
original:
hackage: lens-aeson-1.1.3
- 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
- completed:
hackage: postgresql-binary-0.12.5@sha256:de9da3cba9be541d6c75ae8da2858c33d83dc1b2e0c639b0b9781816b78a91f4,5594
pantry-tree:
size: 1619
sha256: b392337f91031a5b3407393e2f04dfe4e7a28019e88eae6a9370538b90e28c51
original:
hackage: postgresql-binary-0.12.5
- completed:
hackage: protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
pantry-tree:
size: 1594
sha256: a36d2912ac552d950ba4476de7d950b56b82dd28e48b9f4d0efee938f10bc525
original:
hackage: protolude-0.3.2
- completed:
hackage: ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
pantry-tree:
size: 1303
sha256: 557c438345de19f82bf01d676100da2a191ef06f624e7a4b90b09ac17cbb52a5
original:
hackage: ptr-0.16.8.2
- completed:
hackage: text-builder-0.6.7@sha256:efbb3e06107e9c8d1cfe85c963938ca9f375a74379af03da3173be4ef5c37bcf,2364
pantry-tree:
size: 425
sha256: cd0ae197e6f9f3860a8ab71f5b87c4a8452ed1fce2fdfd35e36d68ded6e6648e
original:
hackage: text-builder-0.6.7
- completed:
hackage: text-builder-dev-0.3.3@sha256:79ec422defcc2e5b34f94129c72b98d34b2efc1ed8bbd945ccb8f4f535a892c3,2784
pantry-tree:
size: 724
sha256: 8883631a132438e7892fcb13e89d6bbcdc0ac76c56fbea8df8d7aa482ce81f73
original:
hackage: text-builder-dev-0.3.3
- completed:
name: postgresql-libpq
version: 0.9.4.3
git: https://github.com/PostgREST/postgresql-libpq.git
pantry-tree:
size: 1081
sha256: 0df271e48af32eb8292a45301af45e114110d54099ee73dbc609d39770e8175e
commit: 33ff97db570b5b432255f5f24a68db51453f6eb8
original:
git: https://github.com/PostgREST/postgresql-libpq.git
commit: 33ff97db570b5b432255f5f24a68db51453f6eb8
snapshots:
- completed:
size: 586069
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/14.yaml
sha256: 87842ecbaa8ca9cee59a7e6be52369dbed82ed075cb4e0d152614a627e8fd488
original: lts-18.14
size: 618951
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/14.yaml
sha256: 4c31d4ef975b0211078862566aedf3b82b6cea569fc2cde4c72a51e5a8d236ce
original: lts-19.14
Binary file not shown.

Before

Width:  |  Height:  |  Size: 4.2 KiB

-74
View File
@@ -1,74 +0,0 @@
module Feature.CorsSpec where
-- {{{ Imports
import qualified Data.ByteString.Lazy as BL
import Network.Wai (Application)
import Network.Wai.Test (SResponse (simpleBody, simpleHeaders))
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Protolude
import SpecHelper
-- }}}
spec :: SpecWith ((), Application)
spec =
describe "CORS" $ do
let preflightHeaders = [
("Accept", "*/*"),
("Origin", "http://example.com"),
("Access-Control-Request-Method", "POST"),
("Access-Control-Request-Headers", "Foo,Bar") ]
let normalCors = [
("Host", "localhost:3000"),
("User-Agent", "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.9; rv:32.0) Gecko/20100101 Firefox/32.0"),
("Origin", "http://localhost:8000"),
("Accept", "text/csv, */*; q=0.01"),
("Accept-Language", "en-US,en;q=0.5"),
("Accept-Encoding", "gzip, deflate"),
("Referer", "http://localhost:8000/"),
("Connection", "keep-alive") ]
describe "preflight request" $ do
it "replies naively and permissively to preflight request" $ do
r <- request methodOptions "/items" preflightHeaders ""
liftIO $ do
let respHeaders = simpleHeaders r
respHeaders `shouldSatisfy` matchHeader
"Access-Control-Allow-Origin"
"http://example.com"
respHeaders `shouldSatisfy` matchHeader
"Access-Control-Allow-Credentials"
"true"
respHeaders `shouldSatisfy` matchHeader
"Access-Control-Allow-Methods"
"GET, POST, PATCH, PUT, DELETE, OPTIONS, HEAD"
respHeaders `shouldSatisfy` matchHeader
"Access-Control-Allow-Headers"
"Authentication, Foo, Bar, Accept, Accept-Language, Content-Language"
respHeaders `shouldSatisfy` matchHeader
"Access-Control-Max-Age"
"86400"
it "suppresses body in response" $ do
r <- request methodOptions "/" preflightHeaders ""
liftIO $ simpleBody r `shouldBe` ""
describe "regular request" $
it "exposes necesssary response headers" $ do
r <- request methodGet "/items" [("Origin", "http://example.com")] ""
liftIO $ simpleHeaders r `shouldSatisfy` matchHeader
"Access-Control-Expose-Headers"
"Content-Encoding, Content-Location, Content-Range, Content-Type, \
\Date, Location, Server, Transfer-Encoding, Range-Unit"
describe "postflight request" $
it "allows INFO body through even with CORS request headers present" $ do
r <- request methodOptions "/items" normalCors ""
liftIO $ do
simpleHeaders r `shouldSatisfy` matchHeader
"Access-Control-Allow-Origin" "\\*"
simpleBody r `shouldSatisfy` BL.null
-92
View File
@@ -1,92 +0,0 @@
module Feature.DeleteSpec where
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Protolude hiding (get)
spec :: SpecWith ((), Application)
spec =
describe "Deleting" $ do
context "existing record" $ do
it "succeeds with 204 and deletion count" $
request methodDelete "/items?id=eq.1" [] ""
`shouldRespondWith` ""
{ matchStatus = 204
, matchHeaders = ["Content-Range" <:> "*/*"]
}
it "returns the deleted item and count if requested" $
request methodDelete "/items?id=eq.2" [("Prefer", "return=representation"), ("Prefer", "count=exact")] ""
`shouldRespondWith` [json|[{"id":2}]|]
{ matchStatus = 200
, matchHeaders = ["Content-Range" <:> "*/1"]
}
it "ignores ?select= when return not set or return=minimal" $ do
request methodDelete "/items?id=eq.3&select=id" [] ""
`shouldRespondWith` ""
{ matchStatus = 204
, matchHeaders = ["Content-Range" <:> "*/*"]
}
request methodDelete "/items?id=eq.3&select=id" [("Prefer", "return=minimal")] ""
`shouldRespondWith` ""
{ matchStatus = 204
, matchHeaders = ["Content-Range" <:> "*/*"]
}
it "returns the deleted item and shapes the response" $
request methodDelete "/complex_items?id=eq.2&select=id,name" [("Prefer", "return=representation")] ""
`shouldRespondWith` [json|[{"id":2,"name":"Two"}]|]
{ matchStatus = 200
, matchHeaders = ["Content-Range" <:> "*/*"]
}
it "can rename and cast the selected columns" $
request methodDelete "/complex_items?id=eq.3&select=ciId:id::text,ciName:name" [("Prefer", "return=representation")] ""
`shouldRespondWith` [json|[{"ciId":"3","ciName":"Three"}]|]
it "can embed (parent) entities" $
request methodDelete "/tasks?id=eq.8&select=id,name,project:projects(id)" [("Prefer", "return=representation")] ""
`shouldRespondWith` [json|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
{ matchStatus = 200
, matchHeaders = ["Content-Range" <:> "*/*"]
}
context "known route, no records matched" $
it "includes [] body if return=rep" $
request methodDelete "/items?id=eq.101"
[("Prefer", "return=representation")] ""
`shouldRespondWith` "[]"
{ matchStatus = 200
, matchHeaders = ["Content-Range" <:> "*/*"]
}
context "totally unknown route" $
it "fails with 404" $
request methodDelete "/foozle?id=eq.101" [] "" `shouldRespondWith` 404
context "table with limited privileges" $ do
it "fails deleting the row when return=representation and selecting all the columns" $
request methodDelete "/app_users?id=eq.1" [("Prefer", "return=representation")] mempty
`shouldRespondWith` 401
it "succeeds deleting the row when return=representation and selecting only the privileged columns" $
request methodDelete "/app_users?id=eq.1&select=id,email" [("Prefer", "return=representation")]
[json| { "password": "passxyz" } |]
`shouldRespondWith` [json|[ { "id": 1, "email": "test@123.com" } ]|]
{ matchStatus = 200
, matchHeaders = ["Content-Range" <:> "*/*"]
}
it "suceeds deleting the row with no explicit select when using return=minimal" $
request methodDelete "/app_users?id=eq.2" [("Prefer", "return=minimal")] mempty
`shouldRespondWith` 204
it "suceeds deleting the row with no explicit select by default" $
request methodDelete "/app_users?id=eq.3" [] mempty
`shouldRespondWith` 204
-31
View File
@@ -1,31 +0,0 @@
module Feature.NoJwtSpec where
-- {{{ Imports
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Protolude
import SpecHelper
-- }}}
spec :: SpecWith ((), Application)
spec = describe "server started without JWT secret" $ do
-- this test will stop working 9999999999s after the UNIX EPOCH
it "responds with error on attempted auth" $ do
let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA"
request methodGet "/authors_only" [auth] ""
`shouldRespondWith`
[json|{"message":"Server lacks JWT secret"}|]
{ matchStatus = 500
, matchHeaders = [ matchContentTypeJson ]
}
it "behaves normally when user does not attempt auth" $
request methodGet "/items" [] ""
`shouldRespondWith` 200
-17
View File
@@ -1,17 +0,0 @@
module Feature.NonexistentSchemaSpec where
import Network.Wai (Application)
import Test.Hspec
import Test.Hspec.Wai
import Protolude hiding (get)
spec :: SpecWith ((), Application)
spec =
describe "Non existent api schema" $ do
it "succeeds when requesting root path" $
get "/" `shouldRespondWith` 200
it "gives 404 when requesting a nonexistent table in this nonexistent schema" $
get "/nonexistent_table" `shouldRespondWith` 404
-69
View File
@@ -1,69 +0,0 @@
module Feature.QueryLimitedSpec where
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Protolude hiding (get)
import SpecHelper
spec :: SpecWith ((), Application)
spec =
describe "Requesting many items with server limits(max-rows) enabled" $ do
it "restricts results" $
get "/items?order=id"
`shouldRespondWith`
[json| [{"id":1},{"id":2}] |]
{ matchHeaders = ["Content-Range" <:> "0-1/*"] }
it "respects additional client limiting" $ do
request methodGet "/items"
(rangeHdrs $ ByteRangeFromTo 0 0)
""
`shouldRespondWith`
[json| [{"id":1}] |]
{ matchHeaders = ["Content-Range" <:> "0-0/*"] }
it "works on all levels" $
get "/users?select=id,tasks(id)&order=id.asc&tasks.order=id.asc"
`shouldRespondWith`
[json|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
{ matchHeaders = ["Content-Range" <:> "0-1/*"] }
it "succeeds in getting parent embeds despite the limit, see #647" $
get "/tasks?select=id,project:projects(id)&id=gt.5"
`shouldRespondWith`
[json|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
{ matchHeaders = ["Content-Range" <:> "0-1/*"] }
it "can offset the parent embed, being consistent with the other embed types" $
get "/tasks?select=id,project:projects(id)&id=gt.5&project.offset=1"
`shouldRespondWith`
[json|[{"id":6,"project":null}, {"id":7,"project":null}]|]
{ matchHeaders = ["Content-Range" <:> "0-1/*"] }
context "count=estimated" $ do
it "uses the query planner guess when query rows > maxRows" $
request methodHead "/getallprojects_view" [("Prefer", "count=estimated")] ""
`shouldRespondWith`
""
{ matchStatus = 206
, matchHeaders = ["Content-Range" <:> "0-1/2019"]
}
it "gives exact count when query rows <= maxRows" $
request methodHead "/getallprojects_view?id=lt.3" [("Prefer", "count=estimated")] ""
`shouldRespondWith`
""
{ matchHeaders = ["Content-Range" <:> "0-1/2"] }
it "only uses the query planner guess if it's indeed greater than the exact count" $
request methodHead "/get_projects_above_view" [("Prefer", "count=estimated")] ""
`shouldRespondWith`
""
{ matchStatus = 206
, matchHeaders = ["Content-Range" <:> "0-1/3"]
}

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