Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
e8426671c0 | ||
|
|
455f086880 | ||
|
|
42110643a3 | ||
|
|
e315dbc91e | ||
|
|
e272c2ed08 | ||
|
|
a875db2b82 | ||
|
|
02c6de4144 | ||
|
|
7563b5e2f4 | ||
|
|
5e3d9442af | ||
|
|
c0c1a260ba | ||
|
|
6ebd7fd2d7 | ||
|
|
24dd4e8626 | ||
|
|
dc727f900d | ||
|
|
0847a38691 | ||
|
|
7c83edc402 | ||
|
|
e76de196e0 | ||
|
|
b7331135a6 | ||
|
|
0940b2dccf | ||
|
|
4f53aef74f | ||
|
|
f4027cb5fd | ||
|
|
38afe71ec7 | ||
|
|
308c006a30 | ||
|
|
c7d863c998 | ||
|
|
44cdc97d71 | ||
|
|
a87dcd5553 | ||
|
|
592dd39222 | ||
|
|
45d0f85b0d | ||
|
|
b68fcd2522 | ||
|
|
abd81c998b | ||
|
|
6a2edb2844 | ||
|
|
5c38b4328b | ||
|
|
2cb04c1d5c | ||
|
|
b089e0a7dd | ||
|
|
a21464ddca | ||
|
|
900b9f1991 | ||
|
|
cf16f90fab | ||
|
|
36a6b10d0d | ||
|
|
2ac3ad9e37 | ||
|
|
9e6542680b | ||
|
|
7e41b620ff | ||
|
|
18e3c30ad8 | ||
|
|
0dbd0ece9a | ||
|
|
c13f0a369b | ||
|
|
cacc725e41 | ||
|
|
0dc33dbf9f | ||
|
|
d9205bd838 | ||
|
|
88aad4b1b6 | ||
|
|
5aadfba84b | ||
|
|
eae5857d0e | ||
|
|
c32d13c8f1 | ||
|
|
0401a8eb13 | ||
|
|
9a1a87ff8e | ||
|
|
16e3b16081 |
@@ -5,8 +5,33 @@ This project adheres to [Semantic Versioning](http://semver.org/).
|
||||
|
||||
## Unreleased
|
||||
|
||||
### Added
|
||||
|
||||
### Fixed
|
||||
|
||||
## [0.3.2.0] - 2016-06-10
|
||||
|
||||
### Added
|
||||
- Reload database schema on SIGHUP - @begriffs
|
||||
- Support "-" in column names - @ruslantalpa
|
||||
- Support column/node renaming `alias:column` - @ruslantalpa
|
||||
- Accept posts from HTML forms - @begriffs
|
||||
- Ability to order embedded entities - @ruslantalpa
|
||||
- Ability to paginate using &limit and &offset parameters - @ruslantalpa
|
||||
- Ability to apply limits to embedded entities and enforce --max-rows on all levels - @ruslantalpa, @begriffs
|
||||
- Add allow response header in OPTIONS - @begriffs
|
||||
|
||||
### Fixed
|
||||
- Return 401 or 403 for access denied rather than 404 - @begriffs
|
||||
- Omit Content-Type header for empty body - @begriffs
|
||||
- Prevent role from being changed twice - @begriffs
|
||||
- Use read-only transaction for read requests - @ruslantalpa
|
||||
- Include entities from the same parent table using two different foreign keys - @ruslantalpa
|
||||
- Ensure that Location header in 201 response is URL-encoded - @league
|
||||
- Fix garbage collector CPU leak - @ruslantalpa et al.
|
||||
- Return deleted items when return=representation header is sent - @ruslantalpa
|
||||
- Use table default values for empty object inserts - @begriffs
|
||||
|
||||
## [0.3.1.1] - 2016-03-28
|
||||
|
||||
### Fixed
|
||||
|
||||
+1
-1
@@ -1,6 +1,6 @@
|
||||
FROM debian:jessie
|
||||
|
||||
ENV POSTGREST_VERSION 0.3.1.0
|
||||
ENV POSTGREST_VERSION 0.3.2.0
|
||||
ENV POSTGREST_SCHEMA public
|
||||
ENV POSTGREST_ANONYMOUS postgres
|
||||
ENV POSTGREST_JWT_SECRET thisisnotarealsecret
|
||||
|
||||
@@ -5,6 +5,7 @@
|
||||
<img src="https://img.shields.io/badge/%E2%86%91_Deploy_to-Heroku-7056bf.svg" alt="Deploy">
|
||||
</a>
|
||||
[](https://gitter.im/begriffs/postgrest)
|
||||
[](https://hub.docker.com/r/begriffs/postgrest/)
|
||||
|
||||
PostgREST serves a fully RESTful API from any existing PostgreSQL
|
||||
database. It provides a cleaner, more standards-compliant, faster
|
||||
|
||||
@@ -10,7 +10,7 @@
|
||||
},
|
||||
"POSTGREST_VER": {
|
||||
"description": "Version of PostgREST to deploy",
|
||||
"value": "0.3.1.1"
|
||||
"value": "0.3.2.0"
|
||||
},
|
||||
"DB_NAME": {
|
||||
"description": "Database name",
|
||||
|
||||
+3
-2
@@ -3,8 +3,9 @@ dependencies:
|
||||
- "~/.stack"
|
||||
- ".stack-work"
|
||||
pre:
|
||||
- curl -L https://github.com/commercialhaskell/stack/releases/download/v1.0.2/stack-1.0.2-linux-x86_64.tar.gz | tar zx -C /tmp
|
||||
- sudo mv /tmp/stack-1.0.2-linux-x86_64/stack /usr/bin
|
||||
- curl -L https://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar zx -C /tmp
|
||||
- sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
|
||||
- sudo apt-get update; sudo apt-get install --only-upgrade binutils
|
||||
- createuser --superuser --no-password postgrest_test
|
||||
- createdb -O postgrest_test -U ubuntu postgrest_test
|
||||
override:
|
||||
|
||||
+60
-14
@@ -91,15 +91,20 @@ These operators are available:
|
||||
abbreviation | meaning
|
||||
------------ | -------
|
||||
eq | equals
|
||||
gt | greater than
|
||||
lt | less than
|
||||
gte | greater than or equal
|
||||
gt | greater than
|
||||
lte | less than or equal
|
||||
lt | less than
|
||||
neq | not equal
|
||||
like | LIKE operator (use * in place of %)
|
||||
ilike | ILIKE operator (use * in place of %)
|
||||
@@ | full-text search using to_tsquery
|
||||
is | checking for exact equality (null,true,false)
|
||||
in | one of a list of values e.g. `?a=in.1,2,3`
|
||||
notin | not one of a list of values e.g. `?a=notin.1,2,3`
|
||||
is | checking for exact equality (null,true,false)
|
||||
isnot | checking for exact inequality (null,true,false)
|
||||
@@ | full-text search using to_tsquery
|
||||
@> | contains e.g. `?tags=@>.{example, new}`
|
||||
<@ | contained in e.g. `values=<@{1,2,3}`
|
||||
not | negates another operator, see below
|
||||
|
||||
To negate any operator, prefix it with `not` like `?a=not.eq.2`.
|
||||
@@ -172,6 +177,12 @@ GET /people?order=age.nullsfirst
|
||||
GET /people?order=age.desc.nullslast
|
||||
```
|
||||
|
||||
To order the embedded items, you need to specify the tree path for the order param like so.
|
||||
```HTTP
|
||||
GET /projects?select=id,name,tasks{id,name}&order=id.asc&tasks.order=name.asc
|
||||
```
|
||||
|
||||
|
||||
You can also use [computed
|
||||
columns](http://www.postgresql.org/docs/current/interactive/xfunc-sql.html#XFUNC-SQL-COMPOSITE-FUNCTIONS)
|
||||
to order the results, even though the computed
|
||||
@@ -208,6 +219,15 @@ Range: 0-4
|
||||
You can also use open-ended ranges for an offset with no limit:
|
||||
`Range: 10-`.
|
||||
|
||||
In addition to the `Range` header, you can use `&limit` and `&offset` parameters
|
||||
to achieve the same result.
|
||||
|
||||
You can also set a limit (but not offset) for the embedded items like so
|
||||
```HTTP
|
||||
/posts?select=id,title,body,comments{id,email,body}&limit=10&comments.limit=3
|
||||
```
|
||||
The above request will return the first 10 posts and for each of the posts, 3 comments at most
|
||||
|
||||
#### Suppressing Counts
|
||||
|
||||
Sometimes knowing the total row count of a query is unnecessary and
|
||||
@@ -258,7 +278,8 @@ but the the select query is recursive. You could for instance specify
|
||||
GET /foo?select=x, y, bar{z, w, baz{*}}
|
||||
```
|
||||
|
||||
You can select not only using table names, but also column names!
|
||||
You can select not only using table names, but also foreign key column names!
|
||||
This is especially needed when you have a table with two foreign keys pointing to the same table, for example billing_address_id and shipping_address_id.
|
||||
To embed the same foreign key row from our client example earlier
|
||||
you could do the following:
|
||||
|
||||
@@ -270,8 +291,7 @@ In the response there will be a `client_id` object containing all
|
||||
the data for that row.
|
||||
|
||||
However, a `client_id` object doesn't make a lot of sense, so you
|
||||
could do one of two things. Create a view which renames `client_id`
|
||||
to just `client` (this is the hard way), or just try `client{*}`
|
||||
could do one of two things. Tell PostgREST that you want the key renamed by using the `alias` feature like so `client:client_id{*}`, or just try `client{*}`
|
||||
in the select parameter! PostgREST supports smart ducktype checking
|
||||
for common foreign key names, so if your column name ends with
|
||||
`_id`, `_fk`, or any variation of the two (including camelcase)
|
||||
@@ -285,6 +305,32 @@ GET /projects?id=eq.1&select=id, name, client{*}
|
||||
|
||||
Would embed in the `client` key the row referenced with `client_id`.
|
||||
|
||||
The `alias` feature works for embedded entities and also for regular columns. This is useful in situations where for example you use different naming conventions in the database and frontend.
|
||||
|
||||
The following request will produce the output below:
|
||||
```HTTP
|
||||
GET /orders?id=eq.1&select=orderId:id, customer:customer_id{customerId:id, customerName:name}
|
||||
```
|
||||
|
||||
```json
|
||||
[
|
||||
{
|
||||
"orderId": 1,
|
||||
"customer": {
|
||||
"customerId": 1,
|
||||
"customerName": "John Smith"
|
||||
}
|
||||
}
|
||||
]
|
||||
```
|
||||
|
||||
If you want to apply filters to the embedded items, you can do that like so:
|
||||
```HTTP
|
||||
GET /clients?id=eq.42&select=id,name,projects{id,name,is_active}&projects.is_active=eq.true
|
||||
```
|
||||
The above request will return the client with id=42 and all the projects for that client that are still active
|
||||
|
||||
|
||||
<div class="admonition note">
|
||||
<p class="admonition-title">Design Consideration</p>
|
||||
<p>In order for this feature to work as expected after a schema change, PostgREST currently requires to be restarted.</p>
|
||||
@@ -328,14 +374,14 @@ OPTIONS /my_view
|
||||
This will include the row names, their types, primary key
|
||||
information, and foreign keys for the given table or view.
|
||||
|
||||
<div class="admonition danger">
|
||||
<p class="admonition-title">Deprecation Warning</p>
|
||||
<div class="admonition warning">
|
||||
<p class="admonition-title">Schema Changes</p>
|
||||
|
||||
<p>Although we currently use the OPTIONS verb for this, some
|
||||
people <a
|
||||
href="https://www.mnot.net/blog/2012/10/29/NO_OPTIONS">argue</a> that
|
||||
this is inappropriate. We are considering a <code>describedby</code>
|
||||
header link instead.</p>
|
||||
<p>Note that when the schema of your database changes PostgREST will not reflect
|
||||
the change. You have to either restart PostgREST or send its running process
|
||||
a HUP signal:
|
||||
|
||||
<pre><code>killall -HUP postgrest</code></pre>
|
||||
</div>
|
||||
|
||||
### CORS
|
||||
|
||||
+38
-7
@@ -71,21 +71,52 @@ security](http://www.postgresql.org/docs/9.5/static/ddl-rowsecurity.html).
|
||||
Note that it requires PostgreSQL 9.5 or later.
|
||||
|
||||
```sql
|
||||
grant select on posts, comments to anon;
|
||||
|
||||
ALTER TABLE posts ENABLE ROW LEVEL SECURITY;
|
||||
drop policy if exists authors_eigenedit on posts;
|
||||
create policy authors_eigenedit on posts
|
||||
using (true)
|
||||
ALTER TABLE comments ENABLE ROW LEVEL SECURITY;
|
||||
|
||||
drop policy if exists posts_select_unsecure on posts;
|
||||
create policy posts_select_unsecure on posts for select
|
||||
using (true);
|
||||
|
||||
drop policy if exists comments_select_unsecure on comments;
|
||||
create policy comments_select_unsecure on comments for select
|
||||
using (true);
|
||||
|
||||
drop policy if exists authors_eigencreate on posts;
|
||||
create policy authors_eigencreate on posts for insert
|
||||
with check (
|
||||
author = basic_auth.current_email()
|
||||
);
|
||||
|
||||
ALTER TABLE comments ENABLE ROW LEVEL SECURITY;
|
||||
drop policy if exists authors_eigenedit on comments;
|
||||
create policy authors_eigenedit on comments
|
||||
using (true)
|
||||
drop policy if exists authors_eigencreate on comments;
|
||||
create policy authors_eigencreate on comments for insert
|
||||
with check (
|
||||
author = basic_auth.current_email()
|
||||
);
|
||||
|
||||
drop policy if exists authors_eigenedit on posts;
|
||||
create policy authors_eigenedit on posts for update
|
||||
using (author = basic_auth.current_email())
|
||||
with check (
|
||||
author = basic_auth.current_email()
|
||||
);
|
||||
|
||||
drop policy if exists authors_eigenedit on comments;
|
||||
create policy authors_eigenedit on comments for update
|
||||
using (author = basic_auth.current_email())
|
||||
with check (
|
||||
author = basic_auth.current_email()
|
||||
);
|
||||
|
||||
drop policy if exists authors_eigendelete on posts;
|
||||
create policy authors_eigendelete on posts for delete
|
||||
using (author = basic_auth.current_email());
|
||||
|
||||
drop policy if exists authors_eigendelete on comments;
|
||||
create policy authors_eigendelete on comments for delete
|
||||
using (author = basic_auth.current_email());
|
||||
```
|
||||
|
||||
Finally we need to modify the `users` view from the previous example.
|
||||
|
||||
+13
-4
@@ -409,14 +409,22 @@ login(email text, pass text) returns basic_auth.jwt_claims
|
||||
as $$
|
||||
declare
|
||||
_role name;
|
||||
_verified boolean;
|
||||
_email text;
|
||||
result basic_auth.jwt_claims;
|
||||
begin
|
||||
-- check email and password
|
||||
select basic_auth.user_role(email, pass) into _role;
|
||||
if _role is null then
|
||||
raise invalid_password using message = 'invalid user or password';
|
||||
end if;
|
||||
-- TODO; check verified flag if you care whether users
|
||||
-- check verified flag whether users
|
||||
-- have validated their emails
|
||||
_email := email;
|
||||
select verified from basic_auth.users as u where u.email=_email limit 1 into _verified;
|
||||
if not _verified then
|
||||
raise invalid_authorization_specification using message = 'user is not verified';
|
||||
end if;
|
||||
select _role as role, login.email as email into result;
|
||||
return result;
|
||||
end;
|
||||
@@ -456,15 +464,16 @@ Here's a function to get the email of the currently authenticated
|
||||
user.
|
||||
|
||||
```sql
|
||||
-- Prevent current_setting('postgrest.claims.email') from raising
|
||||
-- an exception if the setting is not present. Default it to ''.
|
||||
ALTER DATABASE your_db_name SET postgrest.claims.email TO '';
|
||||
|
||||
create or replace function
|
||||
basic_auth.current_email() returns text
|
||||
language plpgsql
|
||||
as $$
|
||||
begin
|
||||
return current_setting('postgrest.claims.email');
|
||||
exception
|
||||
-- handle unrecognized configuration parameter error
|
||||
when undefined_object then return '';
|
||||
end;
|
||||
$$;
|
||||
```
|
||||
|
||||
@@ -23,7 +23,9 @@ import System.IO (BufferMode (..),
|
||||
hSetBuffering, stderr,
|
||||
stdin, stdout)
|
||||
import Web.JWT (secret)
|
||||
import Data.IORef
|
||||
#ifndef mingw32_HOST_OS
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import System.Posix.Signals
|
||||
import Control.Concurrent (myThreadId)
|
||||
import Control.Exception.Base (throwTo, AsyncException(..))
|
||||
@@ -58,15 +60,6 @@ main = do
|
||||
|
||||
pool <- P.acquire (configPool conf, 10, pgSettings)
|
||||
|
||||
#ifndef mingw32_HOST_OS
|
||||
tid <- myThreadId
|
||||
forM_ [sigINT, sigTERM] $ \sig ->
|
||||
void $ installHandler sig (Catch $ do
|
||||
P.release pool
|
||||
throwTo tid UserInterrupt
|
||||
) Nothing
|
||||
#endif
|
||||
|
||||
result <- P.use pool $ do
|
||||
supported <- isServerVersionSupported
|
||||
unless supported $ error (
|
||||
@@ -74,5 +67,21 @@ main = do
|
||||
<> show minimumPgVersion)
|
||||
getDbStructure (cs $ configSchema conf)
|
||||
|
||||
let dbStructure = either (error.show) id result
|
||||
runSettings appSettings $ postgrest conf dbStructure pool
|
||||
refDbStructure <- newIORef $ either (error.show) id result
|
||||
|
||||
#ifndef mingw32_HOST_OS
|
||||
tid <- myThreadId
|
||||
forM_ [sigINT, sigTERM] $ \sig ->
|
||||
void $ installHandler sig (Catch $ do
|
||||
P.release pool
|
||||
throwTo tid UserInterrupt
|
||||
) Nothing
|
||||
|
||||
void $ installHandler sigHUP (
|
||||
Catch . void . P.use pool $ do
|
||||
s <- getDbStructure (cs $ configSchema conf)
|
||||
liftIO $ atomicWriteIORef refDbStructure s
|
||||
) Nothing
|
||||
#endif
|
||||
|
||||
runSettings appSettings $ postgrest conf refDbStructure pool
|
||||
+24
-42
@@ -2,7 +2,7 @@ name: postgrest
|
||||
description: Reads the schema of a PostgreSQL database and creates RESTful routes
|
||||
for the tables and views, supporting all HTTP verbs that security
|
||||
permits.
|
||||
version: 0.3.1.1
|
||||
version: 0.3.2.0
|
||||
synopsis: REST API for any Postgres database
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
@@ -22,29 +22,34 @@ Flag CI
|
||||
Default: False
|
||||
|
||||
executable postgrest
|
||||
main-is: PostgREST/Main.hs
|
||||
main-is: Main.hs
|
||||
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
ghc-options:
|
||||
-threaded
|
||||
-rtsopts
|
||||
"-with-rtsopts=-N -I2"
|
||||
default-language: Haskell2010
|
||||
build-depends: aeson (>= 0.8 && < 0.10) || (>= 0.11 && < 0.12)
|
||||
, base >= 4.8 && < 5
|
||||
, base >= 4.8 && < 6
|
||||
, bytestring
|
||||
, bytestring-tree-builder == 0.2.7
|
||||
, case-insensitive
|
||||
, cassava
|
||||
, containers
|
||||
, contravariant
|
||||
, errors
|
||||
, hasql >= 0.19.9 && < 0.20
|
||||
, hasql-pool >= 0.4 && < 0.5
|
||||
, hasql-transaction >= 0.4.3 && < 0.5
|
||||
, hasql == 0.19.12
|
||||
, hasql-pool == 0.4.1
|
||||
, hasql-transaction == 0.4.5
|
||||
, http-types
|
||||
, interpolatedstring-perl6
|
||||
, jwt
|
||||
, lens >=3.8 && < 5.0
|
||||
, lens-aeson >= 1.0.0.0 && < 1.1.0.0
|
||||
, microlens >= 0.4.2 && < 0.5
|
||||
, microlens-aeson >= 2.1.1 && < 2.2
|
||||
, mtl
|
||||
, optparse-applicative >= 0.11 && < 0.13
|
||||
, parsec
|
||||
, postgresql-binary == 0.9.0.1
|
||||
, postgrest
|
||||
, regex-tdfa
|
||||
, safe >= 0.3 && < 0.4
|
||||
@@ -52,6 +57,7 @@ executable postgrest
|
||||
, string-conversions
|
||||
, text
|
||||
, time
|
||||
, transformers
|
||||
, unordered-containers
|
||||
, vector
|
||||
, wai >= 3.0.1
|
||||
@@ -64,25 +70,13 @@ executable postgrest
|
||||
if !os(windows)
|
||||
build-depends: unix >= 2.7 && < 3
|
||||
|
||||
hs-source-dirs: src
|
||||
other-modules: Paths_postgrest
|
||||
, PostgREST.App
|
||||
, PostgREST.Auth
|
||||
, PostgREST.Config
|
||||
, PostgREST.Error
|
||||
, PostgREST.Middleware
|
||||
, PostgREST.Parsers
|
||||
, PostgREST.DbStructure
|
||||
, PostgREST.QueryBuilder
|
||||
, PostgREST.RangeQuery
|
||||
, PostgREST.ApiRequest
|
||||
, PostgREST.Types
|
||||
hs-source-dirs: main
|
||||
|
||||
library
|
||||
default-language: Haskell2010
|
||||
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
|
||||
build-depends: aeson
|
||||
, base >=4.6 && <5
|
||||
, base
|
||||
, bytestring
|
||||
, case-insensitive
|
||||
, cassava
|
||||
@@ -95,8 +89,8 @@ library
|
||||
, http-types
|
||||
, interpolatedstring-perl6
|
||||
, jwt
|
||||
, lens
|
||||
, lens-aeson
|
||||
, microlens
|
||||
, microlens-aeson
|
||||
, mtl
|
||||
, optparse-applicative
|
||||
, parsec
|
||||
@@ -135,7 +129,7 @@ Test-Suite spec
|
||||
Default-Language: Haskell2010
|
||||
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
Hs-Source-Dirs: test, src
|
||||
Hs-Source-Dirs: test
|
||||
Main-Is: Main.hs
|
||||
Other-Modules: Feature.AuthSpec
|
||||
, Feature.ConcurrentSpec
|
||||
@@ -147,18 +141,6 @@ Test-Suite spec
|
||||
, Feature.RangeSpec
|
||||
, Feature.StructureSpec
|
||||
, Feature.UnicodeSpec
|
||||
, Paths_postgrest
|
||||
, PostgREST.App
|
||||
, PostgREST.Auth
|
||||
, PostgREST.Config
|
||||
, PostgREST.Error
|
||||
, PostgREST.Middleware
|
||||
, PostgREST.Parsers
|
||||
, PostgREST.DbStructure
|
||||
, PostgREST.QueryBuilder
|
||||
, PostgREST.RangeQuery
|
||||
, PostgREST.ApiRequest
|
||||
, PostgREST.Types
|
||||
, SpecHelper
|
||||
, TestTypes
|
||||
Build-Depends: aeson
|
||||
@@ -175,18 +157,19 @@ Test-Suite spec
|
||||
, hasql-pool
|
||||
, hasql-transaction
|
||||
, heredoc
|
||||
, hspec == 2.2.*
|
||||
, hspec
|
||||
, hspec-wai
|
||||
, hspec-wai-json
|
||||
, http-types
|
||||
, interpolatedstring-perl6
|
||||
, jwt
|
||||
, lens
|
||||
, lens-aeson
|
||||
, microlens
|
||||
, microlens-aeson
|
||||
, monad-control
|
||||
, mtl
|
||||
, optparse-applicative
|
||||
, parsec
|
||||
, postgrest
|
||||
, process
|
||||
, regex-tdfa
|
||||
, safe
|
||||
@@ -197,7 +180,6 @@ Test-Suite spec
|
||||
, transformers
|
||||
, transformers-base
|
||||
, unordered-containers
|
||||
, unix
|
||||
, vector
|
||||
, wai
|
||||
, wai-cors
|
||||
|
||||
+69
-33
@@ -1,26 +1,32 @@
|
||||
module PostgREST.ApiRequest where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Csv as CSV
|
||||
import Data.List (find)
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Set as S
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing,
|
||||
listToMaybe, fromJust)
|
||||
import Control.Monad (join)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.String.Conversions (cs)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Network.Wai (Request (..))
|
||||
import Network.Wai.Parse (parseHttpAccept)
|
||||
import PostgREST.RangeQuery (NonnegRange, rangeRequested)
|
||||
import PostgREST.Types (QualifiedIdentifier (..),
|
||||
Schema, Payload(..),
|
||||
UniformObjects(..))
|
||||
import Data.Ranged.Ranges (singletonRange)
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Csv as CSV
|
||||
import Data.List (find, sortBy)
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Set as S
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing,
|
||||
listToMaybe, fromJust)
|
||||
import Control.Arrow ((***))
|
||||
import Control.Monad (join)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Ord (comparing)
|
||||
import Data.String.Conversions (cs)
|
||||
import qualified Data.Text as T
|
||||
import Text.Read (readMaybe)
|
||||
import qualified Data.Vector as V
|
||||
import Network.HTTP.Base (urlEncodeVars)
|
||||
import Network.HTTP.Types.Header (hAuthorization)
|
||||
import Network.HTTP.Types.URI (parseSimpleQuery)
|
||||
import Network.Wai (Request (..))
|
||||
import Network.Wai.Parse (parseHttpAccept)
|
||||
import PostgREST.RangeQuery (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange)
|
||||
import PostgREST.Types (QualifiedIdentifier (..),
|
||||
Schema, Payload(..),
|
||||
UniformObjects(..))
|
||||
import Data.Ranged.Ranges (singletonRange, rangeIntersection)
|
||||
|
||||
type RequestBody = BL.ByteString
|
||||
|
||||
@@ -52,11 +58,11 @@ instance Show ContentType where
|
||||
if it is an action we are able to perform.
|
||||
-}
|
||||
data ApiRequest = ApiRequest {
|
||||
-- | Set to Nothing for unknown HTTP verbs
|
||||
-- | Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
|
||||
iAction :: Action
|
||||
-- | Set to Nothing for malformed range
|
||||
, iRange :: NonnegRange
|
||||
-- | Set to Nothing for strangely nested urls
|
||||
-- | Requested range of rows within response
|
||||
, iRange :: M.HashMap String NonnegRange
|
||||
-- | The target, be it calling a proc or accessing a table
|
||||
, iTarget :: Target
|
||||
-- | The content type the client most desires (or JSON if undecided)
|
||||
, iAccepts :: Either BS.ByteString ContentType
|
||||
@@ -72,8 +78,12 @@ data ApiRequest = ApiRequest {
|
||||
, iFilters :: [(String, String)]
|
||||
-- | &select parameter used to shape the response
|
||||
, iSelect :: String
|
||||
-- | &order parameter
|
||||
, iOrder :: Maybe String
|
||||
-- | &order parameters for each level
|
||||
, iOrder :: [(String,String)]
|
||||
-- | Alphabetized (canonical) request query string for response URLs
|
||||
, iCanonicalQS :: String
|
||||
-- | JSON Web Token
|
||||
, iJWT :: T.Text
|
||||
}
|
||||
|
||||
-- | Examines HTTP request and translates it into user intent.
|
||||
@@ -113,6 +123,13 @@ userApiRequest schema req reqBody =
|
||||
Nothing -> PayloadParseError "All lines must have same number of fields"
|
||||
Just json -> PayloadJSON json)
|
||||
(CSV.decodeByName reqBody)
|
||||
-- This is a Left value because form-urlencoded is not a content
|
||||
-- type which we ever use for responses, only something we handle
|
||||
-- just this once for requests
|
||||
Left "application/x-www-form-urlencoded" ->
|
||||
PayloadJSON . UniformObjects . V.singleton . M.fromList
|
||||
. map (cs *** JSON.String . cs) . parseSimpleQuery
|
||||
$ cs reqBody
|
||||
Left accept ->
|
||||
PayloadParseError $
|
||||
"Content-type not acceptable: " <> accept
|
||||
@@ -124,18 +141,23 @@ userApiRequest schema req reqBody =
|
||||
|
||||
ApiRequest {
|
||||
iAction = action
|
||||
, iRange = if singular then singletonRange 0 else rangeRequested hdrs
|
||||
, iTarget = target
|
||||
, iRange = M.insert "limit" (rangeIntersection headerRange urlRange) $
|
||||
M.fromList [ (cs k, restrictRange (readMaybe =<< v) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k ]
|
||||
, iAccepts = pickContentType $ lookupHeader "accept"
|
||||
, iPayload = relevantPayload
|
||||
, iPreferRepresentation = representation
|
||||
, iPreferSingular = singular
|
||||
, iPreferCount = not $ singular || hasPrefer "count=none"
|
||||
, iFilters = [ (k, fromJust v) | (k,v) <- qParams, k `notElem` ["select", "order"], isJust v ]
|
||||
, iSelect = if method == "DELETE"
|
||||
then "*"
|
||||
else fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
|
||||
, iOrder = join $ lookup "order" qParams
|
||||
, iFilters = [ (cs k, fromJust v) | (k,v) <- qParams, isJust v, k /= "select", k /= "offset", not (endingIn ["order", "limit"] k) ]
|
||||
, iSelect = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
|
||||
, iOrder = [(cs k, fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
|
||||
, iCanonicalQS = urlEncodeVars
|
||||
. sortBy (comparing fst)
|
||||
. map (join (***) cs)
|
||||
. parseSimpleQuery
|
||||
$ rawQueryString req
|
||||
, iJWT = tokenStr
|
||||
}
|
||||
|
||||
where
|
||||
@@ -155,6 +177,20 @@ userApiRequest schema req reqBody =
|
||||
| hasPrefer "return=representation" = Full
|
||||
| hasPrefer "return=minimal" = None
|
||||
| otherwise = HeadersOnly
|
||||
auth = fromMaybe "" $ lookupHeader hAuthorization
|
||||
tokenStr = case T.split (== ' ') (cs auth) of
|
||||
("Bearer" : t : _) -> t
|
||||
_ -> ""
|
||||
endingIn:: [T.Text] -> T.Text -> Bool
|
||||
endingIn xx key = lastWord `elem` xx
|
||||
where lastWord = last $ T.split (=='.') key
|
||||
|
||||
headerRange = if singular then singletonRange 0 else rangeRequested hdrs
|
||||
urlOffsetRange = rangeGeq . fromMaybe (0::Integer) $
|
||||
readMaybe =<< join (lookup "offset" qParams)
|
||||
urlRange = restrictRange
|
||||
(readMaybe =<< join (lookup "limit" qParams))
|
||||
urlOffsetRange
|
||||
|
||||
-- PRIVATE ---------------------------------------------------------------
|
||||
|
||||
|
||||
+161
-85
@@ -7,12 +7,11 @@ module PostgREST.App (
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Arrow ((***))
|
||||
import Control.Monad (join)
|
||||
import Data.Bifunctor (first)
|
||||
import Data.List (find, sortBy, delete)
|
||||
import Data.Maybe (isJust, fromMaybe, fromJust, mapMaybe)
|
||||
import Data.Ord (comparing)
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import Data.IORef (IORef, readIORef)
|
||||
import Data.List (find, delete)
|
||||
import Data.Maybe (fromMaybe, fromJust, mapMaybe)
|
||||
import Data.Ranged.Ranges (emptyRange)
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Text (Text, replace, strip)
|
||||
@@ -24,10 +23,9 @@ import qualified Hasql.Transaction as HT
|
||||
import Text.Parsec.Error
|
||||
import Text.ParserCombinators.Parsec (parse)
|
||||
|
||||
import Network.HTTP.Base (urlEncodeVars)
|
||||
import Network.HTTP.Types.Header
|
||||
import Network.HTTP.Types.Status
|
||||
import Network.HTTP.Types.URI (parseSimpleQuery)
|
||||
import Network.HTTP.Types.URI (renderSimpleQuery)
|
||||
import Network.Wai
|
||||
import Network.Wai.Middleware.RequestLogger (logStdout)
|
||||
|
||||
@@ -38,16 +36,18 @@ import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||
import qualified Data.Vector as V
|
||||
import qualified Hasql.Transaction as H
|
||||
|
||||
import qualified Data.HashMap.Strict as M
|
||||
|
||||
import PostgREST.ApiRequest (ApiRequest(..), ContentType(..)
|
||||
, Action(..), Target(..)
|
||||
, PreferRepresentation (..)
|
||||
, userApiRequest)
|
||||
import PostgREST.Auth (tokenJWT)
|
||||
import PostgREST.Auth (tokenJWT, jwtClaims, containsRole)
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.DbStructure
|
||||
import PostgREST.Error (errResponse, pgErrResponse)
|
||||
import PostgREST.Parsers
|
||||
import PostgREST.RangeQuery
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange, rangeOffset, restrictRange)
|
||||
import PostgREST.Middleware
|
||||
import PostgREST.QueryBuilder ( callProc
|
||||
, addJoinConditions
|
||||
@@ -64,21 +64,33 @@ import PostgREST.Types
|
||||
import Prelude
|
||||
|
||||
|
||||
postgrest :: AppConfig -> DbStructure -> P.Pool -> Application
|
||||
postgrest conf dbStructure pool =
|
||||
postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> Application
|
||||
postgrest conf refDbStructure pool =
|
||||
let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in
|
||||
|
||||
middle $ \ req respond -> do
|
||||
time <- getPOSIXTime
|
||||
body <- strictRequestBody req
|
||||
dbStructure <- readIORef refDbStructure
|
||||
|
||||
let handleReq = runWithClaims conf time (app dbStructure conf body) req
|
||||
resp <- either pgErrResponse id <$> P.use pool
|
||||
(HT.run handleReq HT.ReadCommitted HT.Write)
|
||||
let schema = cs $ configSchema conf
|
||||
apiRequest = userApiRequest schema req body
|
||||
eClaims = jwtClaims (configJwtSecret conf) (iJWT apiRequest) time
|
||||
authed = containsRole eClaims
|
||||
handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
|
||||
txMode = transactionMode $ iAction apiRequest
|
||||
|
||||
resp <- either (pgErrResponse authed) id <$> P.use pool
|
||||
(HT.run handleReq HT.ReadCommitted txMode)
|
||||
respond resp
|
||||
|
||||
app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Transaction Response
|
||||
app dbStructure conf reqBody req =
|
||||
transactionMode :: Action -> H.Mode
|
||||
transactionMode ActionRead = HT.Read
|
||||
transactionMode ActionInfo = HT.Read
|
||||
transactionMode _ = HT.Write
|
||||
|
||||
app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response
|
||||
app dbStructure conf apiRequest =
|
||||
let
|
||||
-- TODO: blow up for Left values (there is a middleware that checks the headers)
|
||||
contentType = either (const ApplicationJSON) id (iAccepts apiRequest)
|
||||
@@ -91,7 +103,7 @@ app dbStructure conf reqBody req =
|
||||
Left e -> return $ responseLBS status400 [jsonH] $ cs e
|
||||
Right (q, cq) -> do
|
||||
let singular = iPreferSingular apiRequest
|
||||
stm = createReadStatement q cq range singular
|
||||
stm = createReadStatement q cq singular
|
||||
shouldCount (contentType == TextCSV)
|
||||
respondToRange $ do
|
||||
row <- H.query () stm
|
||||
@@ -102,11 +114,7 @@ app dbStructure conf reqBody req =
|
||||
else responseLBS status200 [contentTypeH] (cs body)
|
||||
else do
|
||||
let (status, contentRange) = rangeHeader queryTotal tableTotal
|
||||
canonical = urlEncodeVars -- should this be moved to the dbStructure (location)?
|
||||
. sortBy (comparing fst)
|
||||
. map (join (***) cs)
|
||||
. parseSimpleQuery
|
||||
$ rawQueryString req
|
||||
canonical = iCanonicalQS apiRequest
|
||||
return $ responseLBS status
|
||||
[contentTypeH, contentRange,
|
||||
("Content-Location",
|
||||
@@ -124,13 +132,14 @@ app dbStructure conf reqBody req =
|
||||
let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
|
||||
let stm = createWriteStatement qi sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == TextCSV) payload
|
||||
row <- H.query uniform stm
|
||||
let (_, _, location, body) = extractQueryResult row
|
||||
return $ responseLBS status201
|
||||
[
|
||||
contentTypeH,
|
||||
(hLocation, "/" <> cs table <> "?" <> cs location)
|
||||
]
|
||||
$ if iPreferRepresentation apiRequest == Full then cs body else ""
|
||||
let (_, _, fs, body) = extractQueryResult row
|
||||
header =
|
||||
if null fs then []
|
||||
else [(hLocation, "/" <> cs table <> renderLocationFields fs)]
|
||||
|
||||
return $ if iPreferRepresentation apiRequest == Full
|
||||
then responseLBS status201 (contentTypeH : header) (cs body)
|
||||
else responseLBS status201 header ""
|
||||
|
||||
(ActionUpdate, TargetIdent qi, Just payload@(PayloadJSON uniform)) ->
|
||||
case mutateSqlParts of
|
||||
@@ -143,33 +152,39 @@ app dbStructure conf reqBody req =
|
||||
s = case () of _ | queryTotal == 0 -> status404
|
||||
| iPreferRepresentation apiRequest == Full -> status200
|
||||
| otherwise -> status204
|
||||
return $ responseLBS s [contentTypeH, r]
|
||||
$ if iPreferRepresentation apiRequest == Full then cs body else ""
|
||||
return $ if iPreferRepresentation apiRequest == Full
|
||||
then responseLBS s [contentTypeH, r] (cs body)
|
||||
else responseLBS s [r] ""
|
||||
|
||||
(ActionDelete, TargetIdent qi, Nothing) ->
|
||||
case mutateSqlParts of
|
||||
Left e -> return $ responseLBS status400 [jsonH] $ cs e
|
||||
Right (sq,mq) -> do
|
||||
let emptyUniform = UniformObjects V.empty
|
||||
let fakeload = PayloadJSON emptyUniform
|
||||
let stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) fakeload
|
||||
fakeload = PayloadJSON emptyUniform
|
||||
stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) fakeload
|
||||
row <- H.query emptyUniform stm
|
||||
let (_, queryTotal, _, _) = extractQueryResult row
|
||||
let (_, queryTotal, _, body) = extractQueryResult row
|
||||
r = contentRangeH 1 0 (toInteger <$> Just queryTotal)
|
||||
return $ if queryTotal == 0
|
||||
then notFound
|
||||
else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] ""
|
||||
else if iPreferRepresentation apiRequest == Full
|
||||
then responseLBS status200 [contentTypeH, r] (cs body)
|
||||
else responseLBS status204 [r] ""
|
||||
|
||||
(ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) ->
|
||||
if isJust $ find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure)
|
||||
then let cols = filter (filterCol tSchema tTable) $ dbColumns dbStructure
|
||||
pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys
|
||||
body = encode (TableOptions cols pkeys)
|
||||
filterCol :: Schema -> TableName -> Column -> Bool
|
||||
filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb
|
||||
filterCol _ _ _ = False in
|
||||
return $ responseLBS status200 [jsonH, allOrigins] $ cs body
|
||||
else
|
||||
return notFound
|
||||
let mTable = find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure) in
|
||||
case mTable of
|
||||
Nothing -> return notFound
|
||||
Just table ->
|
||||
let cols = filter (filterCol tSchema tTable) $ dbColumns dbStructure
|
||||
pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys
|
||||
body = encode (TableOptions cols pkeys)
|
||||
filterCol :: Schema -> TableName -> Column -> Bool
|
||||
filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb
|
||||
filterCol _ _ _ = False
|
||||
acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
|
||||
return $ responseLBS status200 [jsonH, allOrigins, acceptH] $ cs body
|
||||
|
||||
(ActionInvoke, TargetProc qi,
|
||||
Just (PayloadJSON (UniformObjects payload))) -> do
|
||||
@@ -179,7 +194,7 @@ app dbStructure conf reqBody req =
|
||||
let p = V.head payload
|
||||
jwtSecret = configJwtSecret conf
|
||||
respondToRange $ do
|
||||
row <- H.query () (callProc qi p range shouldCount)
|
||||
row <- H.query () (callProc qi p topLevelRange shouldCount)
|
||||
returnJWT <- H.query qi doesProcReturnJWT
|
||||
let (tableTotal, queryTotal, body) = fromMaybe (Just 0, 0, emptyArray) row
|
||||
(status, contentRange) = rangeHeader queryTotal tableTotal
|
||||
@@ -210,25 +225,32 @@ app dbStructure conf reqBody req =
|
||||
allPrKeys = dbPrimaryKeys dbStructure
|
||||
allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
|
||||
schema = cs $ configSchema conf
|
||||
apiRequest = userApiRequest schema req reqBody
|
||||
shouldCount = iPreferCount apiRequest
|
||||
range = restrictRange (configMaxRows conf) $ iRange apiRequest
|
||||
readDbRequest = DbRead <$> buildReadRequest (dbRelations dbStructure) apiRequest
|
||||
topLevelRange = fromMaybe allRange $ M.lookup "limit" $ iRange apiRequest
|
||||
readDbRequest = DbRead <$> buildReadRequest (configMaxRows conf) (dbRelations dbStructure) apiRequest
|
||||
mutateDbRequest = DbMutate <$> buildMutateRequest apiRequest
|
||||
selectQuery = requestToQuery schema <$> readDbRequest
|
||||
countQuery = requestToCountQuery schema <$> readDbRequest
|
||||
mutateQuery = requestToQuery schema <$> mutateDbRequest
|
||||
readSqlParts = (,) <$> selectQuery <*> countQuery
|
||||
mutateSqlParts = (,) <$> selectQuery <*> mutateQuery
|
||||
respondToRange response = if range == emptyRange
|
||||
respondToRange response = if topLevelRange == emptyRange
|
||||
then return $ errResponse status416 "HTTP Range error"
|
||||
else response
|
||||
rangeHeader queryTotal tableTotal = let frm = rangeOffset range
|
||||
rangeHeader queryTotal tableTotal = let frm = rangeOffset topLevelRange
|
||||
to = frm + toInteger queryTotal - 1
|
||||
contentRange = contentRangeH frm to (toInteger <$> tableTotal)
|
||||
status = rangeStatus frm to (toInteger <$> tableTotal)
|
||||
in (status, contentRange)
|
||||
|
||||
splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
|
||||
splitKeyValue kv = (k, BS.tail v)
|
||||
where (k, v) = BS.break (== '=') kv
|
||||
|
||||
renderLocationFields :: [BS.ByteString] -> BS.ByteString
|
||||
renderLocationFields fields =
|
||||
renderSimpleQuery True $ map splitKeyValue fields
|
||||
|
||||
rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
|
||||
rangeStatus _ _ Nothing = status200
|
||||
rangeStatus frm to (Just total)
|
||||
@@ -272,68 +294,122 @@ augumentRequestWithJoin schema allRels request =
|
||||
(first formatRelationError . addRelations schema allRels Nothing) request
|
||||
>>= addJoinConditions schema
|
||||
|
||||
buildReadRequest :: [Relation] -> ApiRequest -> Either Text ReadRequest
|
||||
buildReadRequest allRels apiRequest =
|
||||
augumentRequestWithJoin schema rels =<< first formatParserError (foldr addFilter <$> (addOrder <$> readRequest <*> ord) <*> flts)
|
||||
addFiltersOrdersRanges :: ApiRequest -> Either ParseError (ReadRequest -> ReadRequest)
|
||||
addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
|
||||
flip (foldr addFilter) <$> filters,
|
||||
flip (foldr addOrder) <$> orders,
|
||||
flip (foldr addRange) <$> ranges
|
||||
]
|
||||
{-
|
||||
The esence of what is going on above is that we are composing tree functions
|
||||
of type (ReadRequest->ReadRequest) that are in (Either ParseError a) context
|
||||
-}
|
||||
where
|
||||
filters :: Either ParseError [(Path, Filter)]
|
||||
filters = mapM pRequestFilter flts
|
||||
where
|
||||
action = iAction apiRequest
|
||||
flts = if action == ActionRead
|
||||
then iFilters apiRequest
|
||||
else filter (( '.' `elem` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
|
||||
orders :: Either ParseError [(Path, [OrderTerm])]
|
||||
orders = mapM pRequestOrder $ iOrder apiRequest
|
||||
ranges :: Either ParseError [(Path, NonnegRange)]
|
||||
ranges = mapM pRequestRange $ M.toList $ iRange apiRequest
|
||||
|
||||
treeRestrictRange :: Maybe Integer -> ReadRequest -> Either Text ReadRequest
|
||||
treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` request
|
||||
where
|
||||
nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
|
||||
nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
|
||||
|
||||
buildReadRequest :: Maybe Integer -> [Relation] -> ApiRequest -> Either Text ReadRequest
|
||||
buildReadRequest maxRows allRels apiRequest =
|
||||
treeRestrictRange maxRows =<<
|
||||
augumentRequestWithJoin schema relations =<<
|
||||
first formatParserError readRequest
|
||||
where
|
||||
selStr = iSelect apiRequest
|
||||
orderS = iOrder apiRequest
|
||||
action = iAction apiRequest
|
||||
target = iTarget apiRequest
|
||||
(schema, rootTableName) = fromJust $ -- Make it safe
|
||||
let target = iTarget apiRequest in
|
||||
case target of
|
||||
(TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
|
||||
_ -> Nothing
|
||||
|
||||
rootName = if action == ActionRead
|
||||
then rootTableName
|
||||
else sourceCTEName
|
||||
filters = if action == ActionRead
|
||||
then iFilters apiRequest
|
||||
else filter (( '.' `elem` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
|
||||
rels = case action of
|
||||
action :: Action
|
||||
action = iAction apiRequest
|
||||
|
||||
readRequest :: Either ParseError ReadRequest
|
||||
readRequest = addFiltersOrdersRanges apiRequest <*>
|
||||
parse (pRequestSelect rootName) ("failed to parse select parameter <<"++selStr++">>") selStr
|
||||
where
|
||||
selStr = iSelect apiRequest
|
||||
rootName = if action == ActionRead
|
||||
then rootTableName
|
||||
else sourceCTEName
|
||||
|
||||
relations :: [Relation]
|
||||
relations = case action of
|
||||
ActionCreate -> fakeSourceRelations ++ allRels
|
||||
ActionUpdate -> fakeSourceRelations ++ allRels
|
||||
ActionDelete -> fakeSourceRelations ++ allRels
|
||||
_ -> allRels
|
||||
where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation
|
||||
readRequest = parse (pRequestSelect rootName) ("failed to parse select parameter <<"++selStr++">>") selStr
|
||||
addOrder (Node (q,i) f) o = Node (q{order=o}, i) f
|
||||
flts = mapM pRequestFilter filters
|
||||
ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderS++">>")) orderS
|
||||
|
||||
buildMutateRequest :: ApiRequest -> Either Text MutateRequest
|
||||
buildMutateRequest apiRequest =
|
||||
mutateApiRequest
|
||||
buildMutateRequest apiRequest = case action of
|
||||
ActionCreate -> Insert rootTableName <$> pure payload
|
||||
ActionUpdate -> Update rootTableName <$> pure payload <*> filters
|
||||
ActionDelete -> Delete rootTableName <$> filters
|
||||
_ -> Left "Unsupported HTTP verb"
|
||||
where
|
||||
action = iAction apiRequest
|
||||
target = iTarget apiRequest
|
||||
payload = fromJust $ iPayload apiRequest
|
||||
rootTableName = -- TODO: Make it safe
|
||||
let target = iTarget apiRequest in
|
||||
case target of
|
||||
(TargetIdent (QualifiedIdentifier _ t) ) -> t
|
||||
_ -> undefined
|
||||
mutateApiRequest = case action of
|
||||
ActionCreate -> Insert rootTableName <$> pure payload
|
||||
ActionUpdate -> Update rootTableName <$> pure payload <*> cond
|
||||
ActionDelete -> Delete rootTableName <$> cond
|
||||
_ -> Left "Unsupported HTTP verb"
|
||||
mutateFilters = filter (not . ( '.' `elem` ) . fst) $ iFilters apiRequest -- update/delete filters can be only on the root table
|
||||
cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
|
||||
filters = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
|
||||
where mutateFilters = filter (not . ( '.' `elem` ) . fst) $ iFilters apiRequest -- update/delete filters can be only on the root table
|
||||
|
||||
addFilterToNode :: Filter -> ReadRequest -> ReadRequest
|
||||
addFilterToNode flt (Node (q@Select {flt_=flts}, i) f) = Node (q {flt_=flt:flts}, i) f
|
||||
|
||||
addFilter :: (Path, Filter) -> ReadRequest -> ReadRequest
|
||||
addFilter ([], flt) (Node (q@Select {flt_=flts}, i) forest) = Node (q {flt_=flt:flts}, i) forest
|
||||
addFilter (path, flt) (Node rn forest) =
|
||||
addFilter = addProperty addFilterToNode
|
||||
|
||||
addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest
|
||||
addOrderToNode o (Node (q,i) f) = Node (q{order=Just o}, i) f
|
||||
|
||||
addOrder :: (Path, [OrderTerm]) -> ReadRequest -> ReadRequest
|
||||
addOrder = addProperty addOrderToNode
|
||||
|
||||
addRangeToNode :: NonnegRange -> ReadRequest -> ReadRequest
|
||||
addRangeToNode r (Node (q,i) f) = Node (q{range_=r}, i) f
|
||||
|
||||
addRange :: (Path, NonnegRange) -> ReadRequest -> ReadRequest
|
||||
addRange = addProperty addRangeToNode
|
||||
|
||||
addProperty :: (a -> ReadRequest -> ReadRequest) -> (Path, a) -> ReadRequest -> ReadRequest
|
||||
addProperty f ([], a) n = f a n
|
||||
addProperty f (path, a) (Node rn forest) =
|
||||
case targetNode of
|
||||
Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
|
||||
Just tn -> Node rn (addFilter (remainingPath, flt) tn:restForest)
|
||||
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:restForest)
|
||||
where
|
||||
targetNodeName:remainingPath = path
|
||||
(targetNode,restForest) = splitForest targetNodeName forest
|
||||
splitForest :: NodeName -> Forest ReadNode -> (Maybe ReadRequest, Forest ReadNode)
|
||||
splitForest name forst =
|
||||
case maybeNode of
|
||||
Nothing -> (Nothing,forest)
|
||||
Just node -> (Just node, delete node forest)
|
||||
where maybeNode = find ((name==).fst.snd.rootLabel) forst
|
||||
where
|
||||
maybeNode :: Maybe ReadRequest
|
||||
maybeNode = find fnd forst
|
||||
where
|
||||
fnd :: ReadRequest -> Bool
|
||||
fnd (Node (_,(n,_,_)) _) = n == name
|
||||
|
||||
-- in a relation where one of the tables mathces "TableName"
|
||||
-- replace the name to that table with pg_source
|
||||
@@ -359,4 +435,4 @@ instance ToJSON TableOptions where
|
||||
|
||||
|
||||
extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount
|
||||
extractQueryResult = fromMaybe (Nothing, 0, "", "")
|
||||
extractQueryResult = fromMaybe (Nothing, 0, [], "")
|
||||
|
||||
+35
-34
@@ -12,20 +12,20 @@ In the test suite there is an example of simple login function that can be used
|
||||
very simple authentication system inside the PostgreSQL database.
|
||||
-}
|
||||
module PostgREST.Auth (
|
||||
setRole
|
||||
, claimsToSQL
|
||||
claimsToSQL
|
||||
, containsRole
|
||||
, jwtClaims
|
||||
, tokenJWT
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import Lens.Micro
|
||||
import Lens.Micro.Aeson
|
||||
import Data.Aeson (Value (..), parseJSON, toJSON)
|
||||
import Data.Aeson.Lens
|
||||
import Data.Aeson.Types (parseMaybe, emptyObject, emptyArray)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Maybe (fromMaybe, maybeToList, fromJust)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Text (Text)
|
||||
@@ -34,47 +34,41 @@ import PostgREST.QueryBuilder (pgFmtIdent, pgFmtLit, unquoted)
|
||||
import qualified Web.JWT as JWT
|
||||
|
||||
{-|
|
||||
Receives a map of JWT claims and returns a list
|
||||
of PostgreSQL statements to set the claims as user defined GUCs.
|
||||
Except if we have a claim called role,
|
||||
this one is mapped to a SET ROLE statement.
|
||||
In case there is any problem decoding the JWT it returns Nothing.
|
||||
Receives a map of JWT claims and returns a list of PostgreSQL
|
||||
statements to set the claims as user defined GUCs. Except if we
|
||||
have a claim called role, this one is mapped to a SET ROLE
|
||||
statement.
|
||||
-}
|
||||
claimsToSQL :: M.HashMap Text Value -> [BS.ByteString]
|
||||
claimsToSQL = map setVar . M.toList
|
||||
where
|
||||
setVar ("role", String val) = setRole val
|
||||
setVar (k, val) = "set local " <> cs (pgFmtIdent $ "postgrest.claims." <> k)
|
||||
<> " = " <> cs (valueToVariable val) <> ";"
|
||||
valueToVariable = pgFmtLit . unquoted
|
||||
claimsToSQL claims = roleStmts <> varStmts
|
||||
where
|
||||
roleStmts = maybeToList $
|
||||
(\r -> "set local role " <> r <> ";") . cs . valueToVariable <$> M.lookup "role" claims
|
||||
varStmts = map setVar $ M.toList (M.delete "role" claims)
|
||||
setVar (k, val) = "set local " <> cs (pgFmtIdent $ "postgrest.claims." <> k)
|
||||
<> " = " <> cs (valueToVariable val) <> ";"
|
||||
valueToVariable = pgFmtLit . unquoted
|
||||
|
||||
{-|
|
||||
Receives the JWT secret (from config) and a JWT and
|
||||
returns a map of JWT claims
|
||||
In case there is any problem decoding the JWT it returns Nothing.
|
||||
In case there is any problem decoding the JWT it returns an error Text
|
||||
-}
|
||||
|
||||
|
||||
jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Either Text (M.HashMap Text Value)
|
||||
jwtClaims secret input time =
|
||||
case mClaims of
|
||||
Nothing -> Right M.empty
|
||||
Just claims -> do
|
||||
let mExp = claims ^? key "exp" . _Integer
|
||||
expired = fromMaybe False $ (<= time) . fromInteger <$> mExp
|
||||
if expired
|
||||
then Left "JWT expired"
|
||||
else Right (value2map claims)
|
||||
jwtClaims _ "" _ = Right M.empty
|
||||
jwtClaims secret jwt time =
|
||||
case isExpired <$> mClaims of
|
||||
Just True -> Left "JWT expired"
|
||||
Nothing -> Left "Invalid JWT"
|
||||
Just False -> Right $ value2map $ fromJust mClaims
|
||||
where
|
||||
mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature secret input
|
||||
isExpired claims =
|
||||
let mExp = claims ^? key "exp" . _Integer
|
||||
in fromMaybe False $ (<= time) . fromInteger <$> mExp
|
||||
mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature secret jwt
|
||||
value2map (Object o) = o
|
||||
value2map _ = M.empty
|
||||
|
||||
{-| Receives the name of a role and returns a SET ROLE statement -}
|
||||
setRole :: Text -> BS.ByteString
|
||||
setRole r = "set local role " <> cs (pgFmtLit r) <> ";"
|
||||
|
||||
|
||||
{-|
|
||||
Receives the JWT secret (from config) and a JWT and a JSON value
|
||||
and returns a signed JWT.
|
||||
@@ -85,3 +79,10 @@ tokenJWT secret (Array arr) =
|
||||
jcs = parseMaybe parseJSON obj :: Maybe JWT.JWTClaimsSet in
|
||||
JWT.encodeSigned JWT.HS256 secret $ fromMaybe JWT.def jcs
|
||||
tokenJWT secret _ = tokenJWT secret emptyArray
|
||||
|
||||
{-|
|
||||
Whether a response from jwtClaims contains a role claim
|
||||
-}
|
||||
containsRole :: Either Text (M.HashMap Text Value) -> Bool
|
||||
containsRole (Left _) = False
|
||||
containsRole (Right claims) = M.member "role" claims
|
||||
|
||||
+15
-10
@@ -21,9 +21,15 @@ import Network.Wai (Response, responseLBS)
|
||||
errResponse :: HT.Status -> Text -> Response
|
||||
errResponse status message = responseLBS status [(hContentType, "application/json")] (cs $ T.concat ["{\"message\":\"",message,"\"}"])
|
||||
|
||||
pgErrResponse :: P.UsageError -> Response
|
||||
pgErrResponse e = responseLBS (httpStatus e)
|
||||
[(hContentType, "application/json")] (JSON.encode e)
|
||||
pgErrResponse :: Bool -> P.UsageError -> Response
|
||||
pgErrResponse authed e =
|
||||
let status = httpStatus authed e
|
||||
jsonType = (hContentType, "application/json")
|
||||
wwwAuth = ("WWW-Authenticate", "Bearer")
|
||||
hdrs = if status == HT.status401
|
||||
then [jsonType, wwwAuth]
|
||||
else [jsonType] in
|
||||
responseLBS status hdrs (JSON.encode e)
|
||||
|
||||
instance JSON.ToJSON P.UsageError where
|
||||
toJSON (P.ConnectionError e) = JSON.object [
|
||||
@@ -60,10 +66,9 @@ instance JSON.ToJSON H.Error where
|
||||
"message" .= ("Database client error"::String),
|
||||
"details" .= (fmap cs d::Maybe T.Text)]
|
||||
|
||||
httpStatus :: P.UsageError -> HT.Status
|
||||
httpStatus (P.ConnectionError _) =
|
||||
HT.status500
|
||||
httpStatus (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
|
||||
httpStatus :: Bool -> P.UsageError -> HT.Status
|
||||
httpStatus _ (P.ConnectionError _) = HT.status500
|
||||
httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
|
||||
case cs c of
|
||||
'0':'8':_ -> HT.status503 -- pg connection err
|
||||
'0':'9':_ -> HT.status500 -- triggered action exception
|
||||
@@ -88,7 +93,7 @@ httpStatus (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
|
||||
'P':'0':_ -> HT.status500 -- PL/pgSQL Error
|
||||
'X':'X':_ -> HT.status500 -- internal Error
|
||||
"42P01" -> HT.status404 -- undefined table
|
||||
"42501" -> HT.status404 -- insufficient privilege
|
||||
"42501" -> if authed then HT.status403 else HT.status401 -- insufficient privilege
|
||||
_ -> HT.status400
|
||||
httpStatus (P.SessionError (H.ResultError _)) = HT.status500
|
||||
httpStatus (P.SessionError (H.ClientError _)) = HT.status503
|
||||
httpStatus _ (P.SessionError (H.ResultError _)) = HT.status500
|
||||
httpStatus _ (P.SessionError (H.ClientError _)) = HT.status503
|
||||
|
||||
+15
-30
@@ -3,16 +3,13 @@
|
||||
|
||||
module PostgREST.Middleware where
|
||||
|
||||
import Control.Monad (unless)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Aeson (Value (..))
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Text
|
||||
import Data.Time.Clock (NominalDiffTime)
|
||||
import qualified Hasql.Transaction as H
|
||||
|
||||
import Network.HTTP.Types.Header (hAccept, hAuthorization)
|
||||
import Network.HTTP.Types.Header (hAccept)
|
||||
import Network.HTTP.Types.Status (status400, status415)
|
||||
import Network.Wai (Application, Request (..),
|
||||
Response, requestHeaders)
|
||||
@@ -20,37 +17,25 @@ import Network.Wai.Middleware.Cors (cors)
|
||||
import Network.Wai.Middleware.Gzip (def, gzip)
|
||||
import Network.Wai.Middleware.Static (only, staticPolicy)
|
||||
|
||||
import PostgREST.ApiRequest (pickContentType)
|
||||
import PostgREST.Auth (setRole, jwtClaims, claimsToSQL)
|
||||
import PostgREST.ApiRequest (ApiRequest(..), pickContentType)
|
||||
import PostgREST.Auth (claimsToSQL)
|
||||
import PostgREST.Config (AppConfig (..), corsPolicy)
|
||||
import PostgREST.Error (errResponse)
|
||||
|
||||
import Prelude hiding (concat, null)
|
||||
|
||||
runWithClaims :: AppConfig -> NominalDiffTime ->
|
||||
(Request -> H.Transaction Response) ->
|
||||
Request -> H.Transaction Response
|
||||
runWithClaims conf time app req = do
|
||||
H.sql setAnon
|
||||
let tokenStr = case split (== ' ') (cs auth) of
|
||||
("Bearer" : t : _) -> t
|
||||
_ -> ""
|
||||
eClaims = jwtClaims jwtSecret tokenStr time
|
||||
case eClaims of
|
||||
Left e -> clientErr e
|
||||
Right claims ->
|
||||
if M.null claims && not (null tokenStr)
|
||||
then clientErr "Invalid JWT"
|
||||
else do
|
||||
let cmdBatch = mconcat $ claimsToSQL claims
|
||||
unless (BS.null cmdBatch) (H.sql cmdBatch)
|
||||
app req
|
||||
runWithClaims :: AppConfig -> Either Text (M.HashMap Text Value) ->
|
||||
(ApiRequest -> H.Transaction Response) ->
|
||||
ApiRequest -> H.Transaction Response
|
||||
runWithClaims conf eClaims app req =
|
||||
case eClaims of
|
||||
Left e -> clientErr e
|
||||
Right claims -> do
|
||||
-- role claim defaults to anon if not specified in jwt
|
||||
H.sql . mconcat . claimsToSQL $ M.union claims (M.singleton "role" anon)
|
||||
app req
|
||||
where
|
||||
hdrs = requestHeaders req
|
||||
jwtSecret = configJwtSecret conf
|
||||
auth = fromMaybe "" $ lookup hAuthorization hdrs
|
||||
anon = cs $ configAnonRole conf
|
||||
setAnon = setRole anon
|
||||
anon = String . cs $ configAnonRole conf
|
||||
clientErr = return . errResponse status400
|
||||
|
||||
unsupportedAccept :: Application -> Application
|
||||
|
||||
@@ -6,22 +6,27 @@ where
|
||||
import Control.Applicative hiding ((<$>))
|
||||
import Data.Monoid
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Text (Text)
|
||||
import Data.Text (Text, intercalate)
|
||||
import Data.Tree
|
||||
import PostgREST.QueryBuilder (operators)
|
||||
import PostgREST.Types
|
||||
import Text.ParserCombinators.Parsec hiding (many, (<|>))
|
||||
import PostgREST.RangeQuery (NonnegRange,allRange)
|
||||
|
||||
pRequestSelect :: Text -> Parser ReadRequest
|
||||
pRequestSelect rootNodeName = do
|
||||
fieldTree <- pFieldForest
|
||||
return $ foldr treeEntry (Node (Select [] [rootNodeName] [] Nothing, (rootNodeName, Nothing)) []) fieldTree
|
||||
return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing)) []) fieldTree
|
||||
where
|
||||
readQuery = Select [] [rootNodeName] [] Nothing allRange
|
||||
treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest
|
||||
treeEntry (Node fld@((fn, _),_) fldForest) (Node (q, i) rForest) =
|
||||
treeEntry (Node fld@((fn, _),_,alias) fldForest) (Node (q, i) rForest) =
|
||||
case fldForest of
|
||||
[] -> Node (q {select=fld:select q}, i) rForest
|
||||
_ -> Node (q, i) (foldr treeEntry (Node (Select [] [fn] [] Nothing, (fn, Nothing)) []) fldForest:rForest)
|
||||
_ -> Node (q, i) newForest
|
||||
where
|
||||
newForest =
|
||||
foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias)) []) fldForest:rForest
|
||||
|
||||
pRequestFilter :: (String, String) -> Either ParseError (Path, Filter)
|
||||
pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
|
||||
@@ -33,6 +38,19 @@ pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
|
||||
op = fst <$> opVal
|
||||
val = snd <$> opVal
|
||||
|
||||
pRequestOrder :: (String, String) -> Either ParseError (Path, [OrderTerm])
|
||||
pRequestOrder (k, v) = (,) <$> path <*> ord
|
||||
where
|
||||
treePath = parse pTreePath ("failed to parser tree path (" ++ k ++ ")") k
|
||||
path = fst <$> treePath
|
||||
ord = parse pOrder ("failed to parse order (" ++ v ++ ")") v
|
||||
|
||||
pRequestRange :: (String, NonnegRange) -> Either ParseError (Path, NonnegRange)
|
||||
pRequestRange (k, v) = (,) <$> path <*> pure v
|
||||
where
|
||||
treePath = parse pTreePath ("failed to parser tree path (" ++ k ++ ")") k
|
||||
path = fst <$> treePath
|
||||
|
||||
ws :: Parser Text
|
||||
ws = cs <$> many (oneOf " \t")
|
||||
|
||||
@@ -51,15 +69,23 @@ pFieldForest :: Parser [Tree SelectItem]
|
||||
pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
|
||||
|
||||
pFieldTree :: Parser (Tree SelectItem)
|
||||
pFieldTree = try (Node <$> pSelect <*> between (char '{') (char '}') pFieldForest)
|
||||
pFieldTree = try (Node <$> pSimpleSelect <*> between (char '{') (char '}') pFieldForest)
|
||||
<|> Node <$> pSelect <*> pure []
|
||||
|
||||
pStar :: Parser Text
|
||||
pStar = cs <$> (string "*" *> pure ("*"::String))
|
||||
|
||||
|
||||
pFieldName :: Parser Text
|
||||
pFieldName = cs <$> (many1 (letter <|> digit <|> oneOf "_")
|
||||
<?> "field name (* or [a..z0..9_])")
|
||||
pFieldName = do
|
||||
matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) <?> "field name (* or [a..z0..9_])"
|
||||
return $ intercalate "-" $ map cs matches
|
||||
where
|
||||
isDash :: GenParser Char st ()
|
||||
isDash = try ( char '-' >> notFollowedBy (char '>') )
|
||||
dash :: Parser Char
|
||||
dash = isDash *> pure '-'
|
||||
|
||||
|
||||
pJsonPathStep :: Parser Text
|
||||
pJsonPathStep = cs <$> try (string "->" *> pFieldName)
|
||||
@@ -70,12 +96,28 @@ pJsonPath = (++) <$> many pJsonPathStep <*> ( (:[]) <$> (string "->>" *> pFieldN
|
||||
pField :: Parser Field
|
||||
pField = lexeme $ (,) <$> pFieldName <*> optionMaybe pJsonPath
|
||||
|
||||
aliasSeparator :: Parser ()
|
||||
aliasSeparator = char ':' >> notFollowedBy (char ':')
|
||||
|
||||
pSimpleSelect :: Parser SelectItem
|
||||
pSimpleSelect = lexeme $ try ( do
|
||||
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
||||
fld <- pField
|
||||
return (fld, Nothing, alias)
|
||||
)
|
||||
|
||||
pSelect :: Parser SelectItem
|
||||
pSelect = lexeme $
|
||||
try ((,) <$> pField <*>((cs <$>) <$> optionMaybe (string "::" *> many letter)) )
|
||||
try (
|
||||
do
|
||||
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
|
||||
fld <- pField
|
||||
cast <- optionMaybe (string "::" *> many letter)
|
||||
return (fld, cs <$> cast, alias)
|
||||
)
|
||||
<|> do
|
||||
s <- pStar
|
||||
return ((s, Nothing), Nothing)
|
||||
return ((s, Nothing), Nothing, Nothing)
|
||||
|
||||
pOperator :: Parser Operator
|
||||
pOperator = cs <$> (pOp <?> "operator (eq, gt, ...)")
|
||||
|
||||
@@ -35,18 +35,18 @@ import qualified Hasql.Decoders as HD
|
||||
import qualified Data.Aeson as JSON
|
||||
import Data.Int (Int64)
|
||||
|
||||
import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset)
|
||||
import Control.Error (note, fromMaybe, mapMaybe)
|
||||
import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset, allRange)
|
||||
import Control.Error (note, fromMaybe)
|
||||
import Data.Functor.Contravariant (contramap)
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.List (find, (\\))
|
||||
import Data.List (find)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text, intercalate, unwords, replace, isInfixOf, toLower, split)
|
||||
import qualified Data.Text as T (map, takeWhile)
|
||||
import qualified Data.Text as T (map, takeWhile, null)
|
||||
import qualified Data.Text.Encoding as T
|
||||
import Data.String.Conversions (cs)
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Monad (join)
|
||||
import Control.Monad (replicateM)
|
||||
import Data.Tree (Tree(..))
|
||||
import qualified Data.Vector as V
|
||||
import PostgREST.Types
|
||||
@@ -61,9 +61,20 @@ import Data.Scientific ( FPFormat (..)
|
||||
import Prelude hiding (unwords)
|
||||
import PostgREST.ApiRequest (PreferRepresentation (..))
|
||||
|
||||
{-| 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)
|
||||
|
||||
{-| The generic query result format used by API responses -}
|
||||
type ResultsWithCount = (Maybe Int64, Int64, BS.ByteString, BS.ByteString)
|
||||
standardRow :: HD.Row ResultsWithCount
|
||||
standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
|
||||
<*> HD.value header <*> HD.value HD.bytea
|
||||
where
|
||||
header = HD.array $ HD.arrayDimension replicateM $ HD.arrayValue HD.bytea
|
||||
|
||||
noLocationF :: Text
|
||||
noLocationF = "array[]::text[]"
|
||||
|
||||
{-| Read and Write api requests use a similar response format which includes
|
||||
various record counts and possible location header. This is the decoder
|
||||
@@ -72,16 +83,10 @@ type ResultsWithCount = (Maybe Int64, Int64, BS.ByteString, BS.ByteString)
|
||||
decodeStandard :: HD.Result ResultsWithCount
|
||||
decodeStandard =
|
||||
HD.singleRow standardRow
|
||||
where
|
||||
standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
|
||||
<*> HD.value HD.bytea <*> HD.value HD.bytea
|
||||
|
||||
decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
|
||||
decodeStandardMay =
|
||||
HD.maybeRow standardRow
|
||||
where
|
||||
standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
|
||||
<*> HD.value HD.bytea <*> HD.value HD.bytea
|
||||
|
||||
{-| JSON and CSV payloads from the client are given to us as
|
||||
UniformObjects (objects who all have the same keys),
|
||||
@@ -91,19 +96,19 @@ encodeUniformObjs :: HE.Params UniformObjects
|
||||
encodeUniformObjs =
|
||||
contramap (JSON.Array . V.map JSON.Object . unUniformObjects) (HE.value HE.json)
|
||||
|
||||
createReadStatement :: SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool ->
|
||||
createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
|
||||
H.Query () ResultsWithCount
|
||||
createReadStatement selectQuery countQuery range isSingle countTotal asCsv =
|
||||
createReadStatement selectQuery countQuery isSingle countTotal asCsv =
|
||||
unicodeStatement sql HE.unit decodeStandard True
|
||||
where
|
||||
sql = [qc|
|
||||
WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}
|
||||
FROM ( SELECT * FROM {sourceCTEName} {limitF range}) t |]
|
||||
FROM ( SELECT * FROM {sourceCTEName}) t |]
|
||||
countResultF = if countTotal then "("<>countQuery<>")" else "null"
|
||||
cols = intercalate ", " [
|
||||
countResultF <> " AS total_result_set",
|
||||
"pg_catalog.count(t) AS page_total",
|
||||
"'' AS header",
|
||||
noLocationF <> " AS header",
|
||||
bodyF <> " AS body"
|
||||
]
|
||||
bodyF
|
||||
@@ -121,7 +126,7 @@ createWriteStatement _ _ mutateQuery _ None
|
||||
where
|
||||
sql = [qc|
|
||||
WITH {sourceCTEName} AS ({mutateQuery})
|
||||
SELECT '', 0, '', '' |]
|
||||
SELECT '', 0, {noLocationF}, '' |]
|
||||
|
||||
createWriteStatement qi _ mutateQuery isSingle HeadersOnly
|
||||
pKeys _ (PayloadJSON (UniformObjects _)) =
|
||||
@@ -134,7 +139,7 @@ createWriteStatement qi _ mutateQuery isSingle HeadersOnly
|
||||
cols = intercalate ", " [
|
||||
"'' AS total_result_set",
|
||||
"pg_catalog.count(t) AS page_total",
|
||||
if isSingle then locationF pKeys else "''",
|
||||
if isSingle then locationF pKeys else noLocationF,
|
||||
"''"
|
||||
]
|
||||
|
||||
@@ -149,7 +154,7 @@ createWriteStatement qi selectQuery mutateQuery isSingle Full
|
||||
cols = intercalate ", " [
|
||||
"'' AS total_result_set", -- when updateing it does not make sense
|
||||
"pg_catalog.count(t) AS page_total",
|
||||
if isSingle then locationF pKeys else "''" <> " AS header",
|
||||
if isSingle then locationF pKeys else noLocationF <> " AS header",
|
||||
bodyF <> " AS body"
|
||||
]
|
||||
bodyF
|
||||
@@ -158,18 +163,18 @@ createWriteStatement qi selectQuery mutateQuery isSingle Full
|
||||
| otherwise = asJsonF
|
||||
|
||||
addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest
|
||||
addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _)) forest) =
|
||||
addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _, alias)) forest) =
|
||||
case parentNode of
|
||||
(Just (Node (Select{from=[parentTable]}, (_, _)) _)) -> Node <$> (addRel readNode <$> rel) <*> updatedForest
|
||||
(Just (Node (Select{from=[parentTable]}, (_, _, _)) _)) -> Node <$> (addRel readNode <$> rel) <*> updatedForest
|
||||
where
|
||||
rel = note ("no relation between " <> parentTable <> " and " <> name)
|
||||
$ findRelationByTable schema name parentTable
|
||||
<|> findRelationByColumn schema parentTable name
|
||||
addRel :: (ReadQuery, (NodeName, Maybe Relation)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation))
|
||||
addRel (query', (n, _)) r = (query' {from=fromRelation}, (n, Just r))
|
||||
addRel :: (ReadQuery, (NodeName, Maybe Relation, Maybe Alias)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
|
||||
addRel (query', (n, _, a)) r = (query' {from=fromRelation}, (n, Just r, a))
|
||||
where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from query')
|
||||
|
||||
_ -> Node (query, (name, Nothing)) <$> updatedForest
|
||||
_ -> Node (query, (name, Nothing, alias)) <$> updatedForest
|
||||
where
|
||||
updatedForest = mapM (addRelations schema allRelations (Just node)) forest
|
||||
-- Searches through all the relations and returns a match given the parameter conditions.
|
||||
@@ -182,25 +187,18 @@ addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _
|
||||
where n `colMatches` rc = (cs ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (cs n :: BS.ByteString)
|
||||
|
||||
addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
|
||||
addJoinConditions schema (Node (query, (n, r)) forest) =
|
||||
addJoinConditions schema (Node nn@(query, (n, r, a)) forest) =
|
||||
case r of
|
||||
Nothing -> Node (updatedQuery, (n,r)) <$> updatedForest -- this is the root node
|
||||
Just rel@Relation{relType=Child} -> Node (addCond updatedQuery (getJoinConditions rel),(n,r)) <$> updatedForest
|
||||
Just Relation{relType=Parent} -> Node (updatedQuery, (n,r)) <$> updatedForest
|
||||
Nothing -> Node nn <$> updatedForest -- this is the root node
|
||||
Just rel@Relation{relType=Child} -> Node (addCond query (getJoinConditions rel),(n,r,a)) <$> updatedForest
|
||||
Just Relation{relType=Parent} -> Node nn <$> updatedForest
|
||||
Just rel@Relation{relType=Many, relLTable=(Just linkTable)} ->
|
||||
Node (qq, (n, r)) <$> updatedForest
|
||||
Node (qq, (n, r, a)) <$> updatedForest
|
||||
where
|
||||
query' = addCond updatedQuery (getJoinConditions rel)
|
||||
query' = addCond query (getJoinConditions rel)
|
||||
qq = query'{from=tableName linkTable : from query'}
|
||||
_ -> Left "unknown relation"
|
||||
where
|
||||
-- add parentTable and parentJoinConditions to the query
|
||||
updatedQuery = foldr (flip addCond) query parentJoinConditions
|
||||
where
|
||||
parentJoinConditions = map (getJoinConditions . snd) parents
|
||||
parents = mapMaybe (getParents . rootLabel) forest
|
||||
getParents (_, (tbl, Just rel@Relation{relType=Parent})) = Just (tbl, rel)
|
||||
getParents _ = Nothing
|
||||
updatedForest = mapM (addJoinConditions schema) forest
|
||||
addCond query' con = query'{flt_=con ++ flt_ query'}
|
||||
|
||||
@@ -262,7 +260,7 @@ pgFmtLit x =
|
||||
|
||||
requestToCountQuery :: Schema -> DbRequest -> SqlQuery
|
||||
requestToCountQuery _ (DbMutate _) = undefined
|
||||
requestToCountQuery schema (DbRead (Node (Select _ _ conditions _, (mainTbl, _)) _)) =
|
||||
requestToCountQuery schema (DbRead (Node (Select _ _ conditions _ _, (mainTbl, _, _)) _)) =
|
||||
unwords [
|
||||
"SELECT pg_catalog.count(1)",
|
||||
"FROM ", fromQi $ QualifiedIdentifier schema mainTbl,
|
||||
@@ -276,7 +274,7 @@ requestToCountQuery schema (DbRead (Node (Select _ _ conditions _, (mainTbl, _))
|
||||
requestToQuery :: Schema -> DbRequest -> SqlQuery
|
||||
requestToQuery _ (DbMutate (Insert _ (PayloadParseError _))) = undefined
|
||||
requestToQuery _ (DbMutate (Update _ (PayloadParseError _) _)) = undefined
|
||||
requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (nodeName, maybeRelation)) forest)) =
|
||||
requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) =
|
||||
query
|
||||
where
|
||||
-- TODO! the folloing helper functions are just to remove the "schema" part when the table is "source" which is the name
|
||||
@@ -288,9 +286,10 @@ requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (nod
|
||||
query = unwords [
|
||||
"SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
|
||||
"FROM ", intercalate ", " (map (fromQi . toQi) tbls),
|
||||
unwords (map joinStr joins),
|
||||
("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) localConditions )) `emptyOnNull` localConditions,
|
||||
orderF (fromMaybe [] ord)
|
||||
unwords joins,
|
||||
("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
|
||||
orderF (fromMaybe [] ord),
|
||||
limitF range
|
||||
]
|
||||
orderF ts =
|
||||
if null ts
|
||||
@@ -304,50 +303,48 @@ requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (nod
|
||||
<> (cs.show) (otDirection t) <> " "
|
||||
<> maybe "" (cs.show) (otNullOrder t) <> " "
|
||||
(joins, selects) = foldr getQueryParts ([],[]) forest
|
||||
parentTables = map snd joins
|
||||
parentConditions = join $ map (( `filter` conditions ) . filterParentConditions) parentTables
|
||||
localConditions = conditions \\ parentConditions
|
||||
joinStr :: (SqlFragment, TableName) -> SqlFragment
|
||||
joinStr (sql, t) = "LEFT OUTER JOIN " <> sql <> " ON " <>
|
||||
intercalate " AND " ( map (pgFmtCondition qi ) joinConditions )
|
||||
where
|
||||
joinConditions = filter (filterParentConditions t) conditions
|
||||
filterParentConditions parentTable (Filter _ _ (VForeignKey (QualifiedIdentifier "" t) _)) = parentTable == t
|
||||
filterParentConditions _ _ = False
|
||||
getQueryParts :: Tree ReadNode -> ([(SqlFragment, TableName)], [SqlFragment]) -> ([(SqlFragment,TableName)], [SqlFragment])
|
||||
getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}})) forst) (j,s) = (j,sel:s)
|
||||
|
||||
getQueryParts :: Tree ReadNode -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
|
||||
getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
|
||||
where
|
||||
sel = "COALESCE(("
|
||||
<> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
|
||||
<> "FROM (" <> subquery <> ") " <> pgFmtIdent table
|
||||
<> "), '[]') AS " <> pgFmtIdent name
|
||||
<> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
|
||||
where subquery = requestToQuery schema (DbRead (Node n forst))
|
||||
getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}})) forst) (j,s) = (joi:j,sel:s)
|
||||
getQueryParts (Node n@(_, (name, Just r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (joi:j,sel:s)
|
||||
where
|
||||
sel = "row_to_json(" <> pgFmtIdent table <> ".*) AS "<>pgFmtIdent name --TODO must be singular
|
||||
joi = ("( " <> subquery <> " ) AS " <> pgFmtIdent table, table)
|
||||
node_name = fromMaybe name alias
|
||||
local_table_name = table <> "_" <> node_name
|
||||
replaceTableName localTableName (Filter a b (VForeignKey (QualifiedIdentifier "" _) c)) = Filter a b (VForeignKey (QualifiedIdentifier "" localTableName) c)
|
||||
replaceTableName _ x = x
|
||||
sel = "row_to_json(" <> pgFmtIdent local_table_name <> ".*) AS " <> pgFmtIdent node_name
|
||||
joi = " LEFT OUTER JOIN ( " <> subquery <> " ) AS " <> pgFmtIdent local_table_name <>
|
||||
" ON " <> intercalate " AND " ( map (pgFmtCondition qi . replaceTableName local_table_name) (getJoinConditions r) )
|
||||
where subquery = requestToQuery schema (DbRead (Node n forst))
|
||||
getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}})) forst) (j,s) = (j,sel:s)
|
||||
getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
|
||||
where
|
||||
sel = "COALESCE (("
|
||||
<> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
|
||||
<> "FROM (" <> subquery <> ") " <> pgFmtIdent table
|
||||
<> "), '[]') AS " <> pgFmtIdent name
|
||||
<> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
|
||||
where subquery = requestToQuery schema (DbRead (Node n forst))
|
||||
--the following is just to remove the warning
|
||||
--getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
|
||||
--posible relations are Child Parent Many
|
||||
getQueryParts (Node (_,(_,Nothing)) _) _ = undefined
|
||||
getQueryParts (Node (_,(_,Nothing,_)) _) _ = undefined
|
||||
requestToQuery schema (DbMutate (Insert mainTbl (PayloadJSON (UniformObjects rows)))) =
|
||||
let qi = QualifiedIdentifier schema mainTbl
|
||||
cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
|
||||
colsString = intercalate ", " cols in
|
||||
unwords [
|
||||
"INSERT INTO ", fromQi qi,
|
||||
" (" <> colsString <> ")" <>
|
||||
" SELECT " <> colsString <>
|
||||
" FROM json_populate_recordset(null::" , fromQi qi, ", $1)"
|
||||
]
|
||||
colsString = intercalate ", " cols
|
||||
insInto = unwords [ "INSERT INTO" , fromQi qi,
|
||||
if T.null colsString then "" else "(" <> colsString <> ")"
|
||||
]
|
||||
vals = unwords $ if T.null colsString
|
||||
then ["DEFAULT VALUES"]
|
||||
else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"] in
|
||||
insInto <> vals
|
||||
|
||||
requestToQuery schema (DbMutate (Update mainTbl (PayloadJSON (UniformObjects rows)) conditions)) =
|
||||
case rows V.!? 0 of
|
||||
Just obj ->
|
||||
@@ -361,7 +358,6 @@ requestToQuery schema (DbMutate (Update mainTbl (PayloadJSON (UniformObjects row
|
||||
Nothing -> undefined
|
||||
where
|
||||
qi = QualifiedIdentifier schema mainTbl
|
||||
|
||||
requestToQuery schema (DbMutate (Delete mainTbl conditions)) =
|
||||
query
|
||||
where
|
||||
@@ -406,7 +402,7 @@ locationF :: [Text] -> SqlFragment
|
||||
locationF pKeys =
|
||||
"(" <>
|
||||
" WITH s AS (SELECT row_to_json(ss) as r from " <> sourceCTEName <> " as ss limit 1)" <>
|
||||
" SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
|
||||
" SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))" <>
|
||||
" FROM s, json_each_text(s.r) AS json_data" <>
|
||||
(
|
||||
if null pKeys
|
||||
@@ -415,7 +411,9 @@ locationF pKeys =
|
||||
) <> ")"
|
||||
|
||||
limitF :: NonnegRange -> SqlFragment
|
||||
limitF r = "LIMIT " <> limit <> " OFFSET " <> offset
|
||||
limitF r = if r == allRange
|
||||
then ""
|
||||
else "LIMIT " <> limit <> " OFFSET " <> offset
|
||||
where
|
||||
limit = maybe "ALL" (cs . show) $ rangeLimit r
|
||||
offset = cs . show $ rangeOffset r
|
||||
@@ -463,8 +461,8 @@ pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
|
||||
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
|
||||
|
||||
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
|
||||
pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp
|
||||
pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp
|
||||
pgFmtSelectItem table (f@(_, jp), Nothing, alias) = pgFmtField table f <> pgFmtAs jp alias
|
||||
pgFmtSelectItem table (f@(_, jp), Just cast, alias) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs jp alias
|
||||
|
||||
pgFmtCondition :: QualifiedIdentifier -> Filter -> SqlFragment
|
||||
pgFmtCondition table (Filter (col,jp) ops val) =
|
||||
@@ -511,9 +509,10 @@ pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
|
||||
pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
|
||||
pgFmtJsonPath _ = ""
|
||||
|
||||
pgFmtAsJsonPath :: Maybe JsonPath -> SqlFragment
|
||||
pgFmtAsJsonPath Nothing = ""
|
||||
pgFmtAsJsonPath (Just xx) = " AS " <> last xx
|
||||
pgFmtAs :: Maybe JsonPath -> Maybe Alias -> SqlFragment
|
||||
pgFmtAs Nothing Nothing = ""
|
||||
pgFmtAs (Just xx) Nothing = " AS " <> pgFmtIdent (last xx)
|
||||
pgFmtAs _ (Just alias) = " AS " <> pgFmtIdent alias
|
||||
|
||||
trimNullChars :: Text -> Text
|
||||
trimNullChars = T.takeWhile (/= '\x0')
|
||||
|
||||
@@ -4,13 +4,14 @@ module PostgREST.RangeQuery (
|
||||
, rangeLimit
|
||||
, rangeOffset
|
||||
, restrictRange
|
||||
, rangeGeq
|
||||
, allRange
|
||||
, NonnegRange
|
||||
) where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
import Network.HTTP.Types.Header
|
||||
import PostgREST.Types ()
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import Data.Ranged.Boundaries
|
||||
@@ -34,18 +35,19 @@ rangeParse range = do
|
||||
Just parsedRange ->
|
||||
let [_, from, to] = readMaybe . cs <$> parsedRange
|
||||
lower = fromMaybe emptyRange (rangeGeq <$> from)
|
||||
upper = fromMaybe (rangeGeq 0) (rangeLeq <$> to) in
|
||||
upper = fromMaybe allRange (rangeLeq <$> to) in
|
||||
rangeIntersection lower upper
|
||||
Nothing -> rangeGeq 0
|
||||
Nothing -> allRange
|
||||
|
||||
rangeRequested :: RequestHeaders -> NonnegRange
|
||||
rangeRequested = rangeParse . fromMaybe "" . lookup hRange
|
||||
rangeRequested headers = fromMaybe allRange $
|
||||
rangeParse <$> lookup hRange headers
|
||||
|
||||
restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange
|
||||
restrictRange Nothing r = r
|
||||
restrictRange (Just limit) r =
|
||||
rangeIntersection r $
|
||||
Range BoundaryBelowAll (BoundaryAbove $ rangeOffset r + limit - 1)
|
||||
rangeIntersection r $
|
||||
Range BoundaryBelowAll (BoundaryAbove $ rangeOffset r + limit - 1)
|
||||
|
||||
rangeLimit :: NonnegRange -> Maybe Integer
|
||||
rangeLimit range =
|
||||
@@ -63,6 +65,9 @@ rangeGeq :: Integer -> NonnegRange
|
||||
rangeGeq n =
|
||||
Range (BoundaryBelow n) BoundaryAboveAll
|
||||
|
||||
allRange :: NonnegRange
|
||||
allRange = rangeGeq 0
|
||||
|
||||
rangeLeq :: Integer -> NonnegRange
|
||||
rangeLeq n =
|
||||
Range BoundaryBelowAll (BoundaryAbove n)
|
||||
|
||||
@@ -6,6 +6,7 @@ import Data.Int (Int32)
|
||||
import Data.Text
|
||||
import Data.Tree
|
||||
import qualified Data.Vector as V
|
||||
import PostgREST.RangeQuery (NonnegRange)
|
||||
|
||||
data DbStructure = DbStructure {
|
||||
dbTables :: [Table]
|
||||
@@ -106,16 +107,17 @@ data FValue = VText Text | VForeignKey QualifiedIdentifier ForeignKey deriving (
|
||||
type FieldName = Text
|
||||
type JsonPath = [Text]
|
||||
type Field = (FieldName, Maybe JsonPath)
|
||||
type Alias = Text
|
||||
type Cast = Text
|
||||
type NodeName = Text
|
||||
type SelectItem = (Field, Maybe Cast)
|
||||
type SelectItem = (Field, Maybe Cast, Maybe Alias)
|
||||
type Path = [Text]
|
||||
data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm] } deriving (Show, Eq)
|
||||
data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq)
|
||||
data MutateQuery = Insert { in_::TableName, qPayload::Payload }
|
||||
| Delete { in_::TableName, where_::[Filter] }
|
||||
| Update { in_::TableName, qPayload::Payload, where_::[Filter] } deriving (Show, Eq)
|
||||
data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
|
||||
type ReadNode = (ReadQuery, (NodeName, Maybe Relation))
|
||||
type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
|
||||
type ReadRequest = Tree ReadNode
|
||||
type MutateRequest = MutateQuery
|
||||
data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
|
||||
|
||||
+18
-9
@@ -1,15 +1,24 @@
|
||||
resolver: lts-5.5
|
||||
resolver: lts-6.2
|
||||
extra-deps:
|
||||
- Ranged-sets-0.3.0
|
||||
- bytestring-tree-builder-0.2.5
|
||||
- hasql-0.19.9
|
||||
- hasql-pool-0.4
|
||||
- hasql-transaction-0.4.3
|
||||
- packdeps-0.4.2.1
|
||||
- bytestring-tree-builder-0.2.7
|
||||
- hasql-0.19.12
|
||||
- hasql-pool-0.4.1
|
||||
- hasql-transaction-0.4.5
|
||||
- jwt-0.7.2
|
||||
- postgresql-binary-0.9.0.1
|
||||
- binary-parser-0.5.2
|
||||
- contravariant-extras-0.3.2
|
||||
- placeholders-0.1
|
||||
- postgresql-error-codes-1
|
||||
- postgresql-binary-0.8.1
|
||||
- success-0.2.6
|
||||
- tuple-th-0.2.5
|
||||
- wai-cors-0.2.5
|
||||
- cryptohash-sha256-0.11.100.0
|
||||
- hackage-security-0.5.2.1
|
||||
|
||||
ghc-options:
|
||||
postgrest: -O2 -Werror -Wall -fwarn-monomorphism-restriction -fwarn-missing-exported-sigs -fwarn-identities
|
||||
postgrest: -O2 -Werror -Wall -fwarn-identities
|
||||
|
||||
packages:
|
||||
- '.'
|
||||
- .
|
||||
|
||||
@@ -13,8 +13,29 @@ import Network.Wai (Application)
|
||||
spec :: SpecWith Application
|
||||
spec = describe "authorization" $ do
|
||||
|
||||
it "hides tables that anonymous does not own" $
|
||||
get "/authors_only" `shouldRespondWith` 404
|
||||
it "denies access to tables that anonymous does not own" $
|
||||
get "/authors_only" `shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [json| {
|
||||
"hint":null,
|
||||
"details":null,
|
||||
"code":"42501",
|
||||
"message":"permission denied for relation authors_only"} |]
|
||||
, matchStatus = 401
|
||||
, matchHeaders = ["WWW-Authenticate" <:> "Bearer"]
|
||||
}
|
||||
|
||||
it "denies access to tables that postgrest_test_author does not own" $
|
||||
let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" in
|
||||
request methodGet "/private_table" [auth] ""
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [json| {
|
||||
"hint":null,
|
||||
"details":null,
|
||||
"code":"42501",
|
||||
"message":"permission denied for relation private_table"} |]
|
||||
, matchStatus = 403
|
||||
, matchHeaders = []
|
||||
}
|
||||
|
||||
it "returns jwt functions as jwt tokens" $
|
||||
post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |]
|
||||
|
||||
@@ -19,6 +19,28 @@ spec =
|
||||
, matchHeaders = ["Content-Range" <:> "*/1"]
|
||||
}
|
||||
|
||||
it "returns the deleted item" $
|
||||
request methodDelete "/items?id=eq.2" [("Prefer", "return=representation")] ""
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [str|[{"id":2}]|]
|
||||
, matchStatus = 200
|
||||
, matchHeaders = ["Content-Range" <:> "*/1"]
|
||||
}
|
||||
it "returns the deleted item and shapes the response" $
|
||||
request methodDelete "/complex_items?id=eq.2&select=id,name" [("Prefer", "return=representation")] ""
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [str|[{"id":2,"name":"Two"}]|]
|
||||
, matchStatus = 200
|
||||
, matchHeaders = ["Content-Range" <:> "*/1"]
|
||||
}
|
||||
it "can embed (parent) entities" $
|
||||
request methodDelete "/tasks?id=eq.8&select=id,name,project{id}" [("Prefer", "return=representation")] ""
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
|
||||
, matchStatus = 200
|
||||
, matchHeaders = ["Content-Range" <:> "*/1"]
|
||||
}
|
||||
|
||||
it "actually clears items ouf the db" $ do
|
||||
_ <- request methodDelete "/items?id=lt.15" [] ""
|
||||
get "/items"
|
||||
|
||||
+59
-17
@@ -32,6 +32,8 @@ spec = do
|
||||
liftIO $ do
|
||||
simpleBody p `shouldBe` ""
|
||||
simpleStatus p `shouldBe` created201
|
||||
-- should not have content type set when body is empty
|
||||
lookup hContentType (simpleHeaders p) `shouldBe` Nothing
|
||||
|
||||
it "filters columns in result using &select" $
|
||||
request methodPost "/menagerie?select=integer,varchar" [("Prefer", "return=representation")]
|
||||
@@ -53,6 +55,15 @@ spec = do
|
||||
, matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8", "Location" <:> "/projects?id=eq.6"]
|
||||
}
|
||||
|
||||
context "from an html form" $
|
||||
it "accepts disparate json types" $ do
|
||||
p <- request methodPost "/menagerie"
|
||||
[("Content-Type", "application/x-www-form-urlencoded")]
|
||||
("integer=7&double=2.71828&varchar=forms+are+fun&" <>
|
||||
"boolean=false&date=1900-01-01&money=$3.99&enum=foo")
|
||||
liftIO $ do
|
||||
simpleBody p `shouldBe` ""
|
||||
simpleStatus p `shouldBe` created201
|
||||
|
||||
context "with no pk supplied" $ do
|
||||
context "into a table with auto-incrementing pk" $
|
||||
@@ -110,13 +121,32 @@ spec = do
|
||||
simpleStatus p `shouldBe` created201
|
||||
|
||||
context "with compound pk supplied" $
|
||||
it "builds response location header appropriately" $
|
||||
post "/compound_pk" [json| { "k1":12, "k2":42 } |]
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Nothing,
|
||||
matchStatus = 201,
|
||||
matchHeaders = ["Location" <:> "/compound_pk?k1=eq.12&k2=eq.42"]
|
||||
}
|
||||
it "builds response location header appropriately" $ do
|
||||
let inserted = [json| { "k1":12, "k2":"Rock & R+ll" } |]
|
||||
expectedObj = CompoundPK 12 "Rock & R+ll" Nothing
|
||||
expectedLoc = "/compound_pk?k1=eq.12&k2=eq.Rock%20%26%20R%2Bll"
|
||||
p <- request methodPost "/compound_pk"
|
||||
[("Prefer", "return=representation")]
|
||||
inserted
|
||||
liftIO $ do
|
||||
JSON.decode (simpleBody p) `shouldBe` Just expectedObj
|
||||
simpleStatus p `shouldBe` created201
|
||||
lookup hLocation (simpleHeaders p) `shouldBe` Just expectedLoc
|
||||
|
||||
r <- get expectedLoc
|
||||
liftIO $ do
|
||||
JSON.decode (simpleBody r) `shouldBe` Just [expectedObj]
|
||||
simpleStatus r `shouldBe` ok200
|
||||
|
||||
context "with bulk insert" $
|
||||
it "returns 201 but no location header" $ do
|
||||
let bulkData = [json| [ {"k1":21, "k2":"hello world"}
|
||||
, {"k1":22, "k2":"bye for now"}]
|
||||
|]
|
||||
p <- request methodPost "/compound_pk" [] bulkData
|
||||
liftIO $ do
|
||||
simpleStatus p `shouldBe` created201
|
||||
lookup hLocation (simpleHeaders p) `shouldBe` Nothing
|
||||
|
||||
context "with invalid json payload" $
|
||||
it "fails with 400 and error" $
|
||||
@@ -137,24 +167,34 @@ spec = do
|
||||
context "jsonb" $ do
|
||||
it "serializes nested object" $ do
|
||||
let inserted = [json| { "data": { "foo":"bar" } } |]
|
||||
location = "/json?data=eq.%7B%22foo%22%3A%22bar%22%7D"
|
||||
request methodPost "/json"
|
||||
[("Prefer", "return=representation")]
|
||||
inserted
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just inserted
|
||||
, matchStatus = 201
|
||||
, matchHeaders = ["Location" <:> [str|/json?data=eq.{"foo":"bar"}|]]
|
||||
, matchHeaders = ["Location" <:> location]
|
||||
}
|
||||
|
||||
it "serializes nested array" $ do
|
||||
let inserted = [json| { "data": [1,2,3] } |]
|
||||
location = "/json?data=eq.%5B1%2C2%2C3%5D"
|
||||
request methodPost "/json"
|
||||
[("Prefer", "return=representation")]
|
||||
inserted
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just inserted
|
||||
, matchStatus = 201
|
||||
, matchHeaders = ["Location" <:> [str|/json?data=eq.[1,2,3]|]]
|
||||
, matchHeaders = ["Location" <:> location]
|
||||
}
|
||||
|
||||
context "empty object" $
|
||||
it "successfully populates table with all-default columns" $
|
||||
post "/items" "{}" `shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just ""
|
||||
, matchStatus = 201
|
||||
, matchHeaders = []
|
||||
}
|
||||
|
||||
describe "CSV insert" $ do
|
||||
@@ -259,7 +299,7 @@ spec = do
|
||||
length rows `shouldBe` 1
|
||||
let record = head rows
|
||||
compoundK1 record `shouldBe` 12
|
||||
compoundK2 record `shouldBe` 42
|
||||
compoundK2 record `shouldBe` "42"
|
||||
compoundExtra record `shouldBe` Just 3
|
||||
|
||||
it "can update an existing record" $ do
|
||||
@@ -312,13 +352,15 @@ spec = do
|
||||
g <- get "/items?id=eq.42"
|
||||
liftIO $ simpleHeaders g
|
||||
`shouldSatisfy` matchHeader "Content-Range" "\\*/0"
|
||||
request methodPatch "/items?id=eq.2" []
|
||||
[json| { "id":42 } |]
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Nothing,
|
||||
matchStatus = 204,
|
||||
matchHeaders = ["Content-Range" <:> "0-0/1"]
|
||||
}
|
||||
p <- request methodPatch "/items?id=eq.2" [] [json| { "id":42 } |]
|
||||
pure p `shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Nothing,
|
||||
matchStatus = 204,
|
||||
matchHeaders = ["Content-Range" <:> "0-0/1"]
|
||||
}
|
||||
liftIO $
|
||||
lookup hContentType (simpleHeaders p) `shouldBe` Nothing
|
||||
|
||||
g' <- get "/items?id=eq.42"
|
||||
liftIO $ simpleHeaders g'
|
||||
`shouldSatisfy` matchHeader "Content-Range" "0-0/1"
|
||||
|
||||
@@ -5,7 +5,7 @@ import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
import Network.HTTP.Types
|
||||
import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
|
||||
|
||||
import Text.Heredoc
|
||||
import SpecHelper
|
||||
import Network.Wai (Application)
|
||||
|
||||
@@ -15,15 +15,23 @@ spec =
|
||||
it "restricts results" $
|
||||
get "/items"
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [json| [{"id":1},{"id":2},{"id":3}] |]
|
||||
matchBody = Just [json| [{"id":1},{"id":2}] |]
|
||||
, matchStatus = 206
|
||||
, matchHeaders = ["Content-Range" <:> "0-2/15"]
|
||||
, matchHeaders = ["Content-Range" <:> "0-1/15"]
|
||||
}
|
||||
|
||||
it "respects additional client limiting" $ do
|
||||
r <- request methodGet "/items"
|
||||
(rangeHdrs $ ByteRangeFromTo 0 1) ""
|
||||
(rangeHdrs $ ByteRangeFromTo 0 0) ""
|
||||
liftIO $ do
|
||||
simpleHeaders r `shouldSatisfy`
|
||||
matchHeader "Content-Range" "0-1/15"
|
||||
matchHeader "Content-Range" "0-0/15"
|
||||
simpleStatus r `shouldBe` partialContent206
|
||||
|
||||
it "limit works on all levels" $
|
||||
get "/users?select=id,tasks{id}&order=id.asc&tasks.order=id.asc"
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [str|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
|
||||
, matchStatus = 206
|
||||
, matchHeaders = ["Content-Range" <:> "0-1/3"]
|
||||
}
|
||||
|
||||
@@ -143,16 +143,29 @@ spec = do
|
||||
|
||||
it "selectStar works in absense of parameter" $
|
||||
get "/complex_items?id=eq.3" `shouldRespondWith`
|
||||
[str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3]}]|]
|
||||
[str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3],"field-with_sep":1}]|]
|
||||
|
||||
it "dash `-` in column names is accepted" $
|
||||
get "/complex_items?id=eq.3&select=id,field-with_sep" `shouldRespondWith`
|
||||
[str|[{"id":3,"field-with_sep":1}]|]
|
||||
|
||||
it "one simple column" $
|
||||
get "/complex_items?select=id" `shouldRespondWith`
|
||||
[json| [{"id":1},{"id":2},{"id":3}] |]
|
||||
|
||||
it "rename simple column" $
|
||||
get "/complex_items?id=eq.1&select=myId:id" `shouldRespondWith`
|
||||
[json| [{"myId":1}] |]
|
||||
|
||||
|
||||
it "one simple column with casting (text)" $
|
||||
get "/complex_items?select=id::text" `shouldRespondWith`
|
||||
[json| [{"id":"1"},{"id":"2"},{"id":"3"}] |]
|
||||
|
||||
it "rename simple column with casting" $
|
||||
get "/complex_items?id=eq.1&select=myId:id::text" `shouldRespondWith`
|
||||
[json| [{"myId":"1"}] |]
|
||||
|
||||
it "json column" $
|
||||
get "/complex_items?id=eq.1&select=settings" `shouldRespondWith`
|
||||
[json| [{"settings":{"foo":{"int":1,"bar":"baz"}}}] |]
|
||||
@@ -161,6 +174,10 @@ spec = do
|
||||
get "/complex_items?id=eq.1&select=settings->>foo::json" `shouldRespondWith`
|
||||
[json| [{"foo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"
|
||||
|
||||
it "rename json subfield one level with casting (json)" $
|
||||
get "/complex_items?id=eq.1&select=myFoo:settings->>foo::json" `shouldRespondWith`
|
||||
[json| [{"myFoo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"
|
||||
|
||||
it "fails on bad casting (data of the wrong format)" $
|
||||
get "/complex_items?select=settings->foo->>bar::integer"
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
@@ -182,15 +199,33 @@ spec = do
|
||||
get "/complex_items?id=eq.1&select=settings->foo->>bar" `shouldRespondWith`
|
||||
[json| [{"bar":"baz"}] |]
|
||||
|
||||
it "rename json subfield two levels (string)" $
|
||||
get "/complex_items?id=eq.1&select=myBar:settings->foo->>bar" `shouldRespondWith`
|
||||
[json| [{"myBar":"baz"}] |]
|
||||
|
||||
|
||||
it "json subfield two levels with casting (int)" $
|
||||
get "/complex_items?id=eq.1&select=settings->foo->>int::integer" `shouldRespondWith`
|
||||
[json| [{"int":1}] |] -- the value in the db is an int, but here we expect a string for now
|
||||
|
||||
it "rename json subfield two levels with casting (int)" $
|
||||
get "/complex_items?id=eq.1&select=myInt:settings->foo->>int::integer" `shouldRespondWith`
|
||||
[json| [{"myInt":1}] |] -- the value in the db is an int, but here we expect a string for now
|
||||
|
||||
it "requesting parents and children" $
|
||||
get "/projects?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
|
||||
[str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
|
||||
|
||||
it "embed data with two fk pointing to the same table" $
|
||||
get "/orders?id=eq.1&select=id, name, billing_address_id{id}, shipping_address_id{id}" `shouldRespondWith`
|
||||
[str|[{"id":1,"name":"order 1","billing_address_id":{"id":1},"shipping_address_id":{"id":2}}]|]
|
||||
|
||||
|
||||
it "requesting parents and children while renaming them" $
|
||||
get "/projects?id=eq.1&select=myId:id, name, project_client:client_id{*}, project_tasks:tasks{id, name}" `shouldRespondWith`
|
||||
[str|[{"myId":1,"name":"Windows 7","project_client":{"id":1,"name":"Microsoft"},"project_tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
|
||||
|
||||
|
||||
it "requesting parents and filtering parent columns" $
|
||||
get "/projects?id=eq.1&select=id, name, clients{id}" `shouldRespondWith`
|
||||
[str|[{"id":1,"name":"Windows 7","clients":{"id":1}}]|]
|
||||
@@ -211,6 +246,10 @@ spec = do
|
||||
get "/tasks?select=id,users{id}" `shouldRespondWith`
|
||||
[str|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|]
|
||||
|
||||
it "requesting many<->many relation with rename" $
|
||||
get "/tasks?id=eq.1&select=id,theUsers:users{id}" `shouldRespondWith`
|
||||
[str|[{"id":1,"theUsers":[{"id":1},{"id":3}]}]|]
|
||||
|
||||
|
||||
it "requesting many<->many relation reverse" $
|
||||
get "/users?select=id,tasks{id}" `shouldRespondWith`
|
||||
@@ -323,6 +362,28 @@ spec = do
|
||||
it "without other constraints" $
|
||||
get "/items?order=id.asc" `shouldRespondWith` 200
|
||||
|
||||
it "ordering embeded entities" $
|
||||
get "/projects?id=eq.1&select=id, name, tasks{id, name}&tasks.order=name.asc" `shouldRespondWith`
|
||||
[str|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
|
||||
|
||||
it "ordering embeded entities with alias" $
|
||||
get "/projects?id=eq.1&select=id, name, the_tasks:tasks{id, name}&tasks.order=name.asc" `shouldRespondWith`
|
||||
[str|[{"id":1,"name":"Windows 7","the_tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
|
||||
|
||||
it "ordering embeded entities, two levels" $
|
||||
get "/projects?id=eq.1&select=id, name, tasks{id, name, users{id, name}}&tasks.order=name.asc&tasks.users.order=name.desc" `shouldRespondWith`
|
||||
[str|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7","users":[{"id":1,"name":"Angela Martin"}]},{"id":1,"name":"Design w7","users":[{"id":3,"name":"Dwight Schrute"},{"id":1,"name":"Angela Martin"}]}]}]|]
|
||||
|
||||
it "ordering embeded parents does not break things" $
|
||||
get "/projects?id=eq.1&select=id, name, clients{id, name}&clients.order=name.asc" `shouldRespondWith`
|
||||
[str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"}}]|]
|
||||
|
||||
it "ordering embeded parents does not break things when using ducktape names" $
|
||||
get "/projects?id=eq.1&select=id, name, client{id, name}&client.order=name.asc" `shouldRespondWith`
|
||||
[str|[{"id":1,"name":"Windows 7","client":{"id":1,"name":"Microsoft"}}]|]
|
||||
|
||||
|
||||
|
||||
describe "Accept headers" $ do
|
||||
it "should respond an unknown accept type with 415" $
|
||||
request methodGet "/simple_pk"
|
||||
|
||||
@@ -9,6 +9,7 @@ import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
|
||||
import SpecHelper
|
||||
import Text.Heredoc
|
||||
import Network.Wai (Application)
|
||||
|
||||
defaultRange :: BL.ByteString
|
||||
@@ -142,6 +143,50 @@ spec = do
|
||||
, matchHeaders = ["Content-Range" <:> "0-0/*"]
|
||||
}
|
||||
|
||||
context "with limit/offset parameters" $ do
|
||||
it "no parameters return everything" $
|
||||
get "/items?select=id&order=id.asc"
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [str|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
|
||||
, matchStatus = 200
|
||||
, matchHeaders = ["Content-Range" <:> "0-14/15"]
|
||||
}
|
||||
it "top level limit with parameter" $
|
||||
get "/items?select=id&order=id.asc&limit=3"
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [str|[{"id":1},{"id":2},{"id":3}]|]
|
||||
, matchStatus = 206
|
||||
, matchHeaders = ["Content-Range" <:> "0-2/15"]
|
||||
}
|
||||
it "headers override get parameters" $
|
||||
request methodGet "/items?select=id&order=id.asc&limit=3"
|
||||
(rangeHdrs $ ByteRangeFromTo 0 1) ""
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [str|[{"id":1},{"id":2}]|]
|
||||
, matchStatus = 206
|
||||
, matchHeaders = ["Content-Range" <:> "0-1/15"]
|
||||
}
|
||||
|
||||
it "limit works on all levels" $
|
||||
get "/clients?select=id,projects{id,tasks{id}}&order=id.asc&limit=1&projects.order=id.asc&projects.limit=1&projects.tasks.order=id.asc&projects.tasks.limit=2"
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]}]}]|]
|
||||
, matchStatus = 206
|
||||
, matchHeaders = ["Content-Range" <:> "0-0/2"]
|
||||
}
|
||||
|
||||
it "fails on offset specified below level 1" $
|
||||
get "/clients?select=id,projects{id,tasks{id}}&projects.offset=2&projects.limit=1"
|
||||
`shouldRespondWith` 400
|
||||
|
||||
it "limit and offset works on first level" $
|
||||
get "/items?select=id&order=id.asc&limit=3&offset=2"
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [str|[{"id":3},{"id":4},{"id":5}]|]
|
||||
, matchStatus = 206
|
||||
, matchHeaders = ["Content-Range" <:> "2-4/15"]
|
||||
}
|
||||
|
||||
context "with range headers" $ do
|
||||
|
||||
context "of acceptable range" $ do
|
||||
|
||||
@@ -8,6 +8,7 @@ import SpecHelper
|
||||
|
||||
import Network.HTTP.Types
|
||||
import Network.Wai (Application)
|
||||
import Network.Wai.Test (SResponse(simpleHeaders))
|
||||
|
||||
spec :: SpecWith Application
|
||||
spec = do
|
||||
@@ -17,6 +18,7 @@ spec = do
|
||||
request methodGet "/" [] ""
|
||||
`shouldRespondWith` [json| [
|
||||
{"schema":"test","name":"Escap3e;","insertable":true}
|
||||
, {"schema":"test","name":"addresses","insertable":true}
|
||||
, {"schema":"test","name":"articleStars","insertable":true}
|
||||
, {"schema":"test","name":"articles","insertable":true}
|
||||
, {"schema":"test","name":"auto_incrementing_pk","insertable":true}
|
||||
@@ -24,6 +26,7 @@ spec = do
|
||||
, {"schema":"test","name":"comments","insertable":true}
|
||||
, {"schema":"test","name":"complex_items","insertable":true}
|
||||
, {"schema":"test","name":"compound_pk","insertable":true}
|
||||
, {"schema":"test","name":"empty_table","insertable":true}
|
||||
, {"schema":"test","name":"filtered_tasks","insertable":true}
|
||||
, {"schema":"test","name":"ghostBusters","insertable":true}
|
||||
, {"schema":"test","name":"has_count_column","insertable":false}
|
||||
@@ -36,6 +39,7 @@ spec = do
|
||||
, {"schema":"test","name":"menagerie","insertable":true}
|
||||
, {"schema":"test","name":"no_pk","insertable":true}
|
||||
, {"schema":"test","name":"nullable_integer","insertable":true}
|
||||
, {"schema":"test","name":"orders","insertable":true}
|
||||
, {"schema":"test","name":"projects","insertable":true}
|
||||
, {"schema":"test","name":"projects_view","insertable":true}
|
||||
, {"schema":"test","name":"simple_pk","insertable":true}
|
||||
@@ -379,3 +383,17 @@ spec = do
|
||||
|
||||
it "errors for non existant tables" $
|
||||
request methodOptions "/dne" [] "" `shouldRespondWith` 404
|
||||
|
||||
describe "Allow header" $ do
|
||||
|
||||
it "includes read/write verbs for writeable table" $ do
|
||||
r <- request methodOptions "/items" [] ""
|
||||
liftIO $
|
||||
simpleHeaders r `shouldSatisfy`
|
||||
matchHeader "Allow" "GET,POST,PATCH,DELETE"
|
||||
|
||||
it "includes read verbs for read-only table" $ do
|
||||
r <- request methodOptions "/has_count_column" [] ""
|
||||
liftIO $
|
||||
simpleHeaders r `shouldSatisfy`
|
||||
matchHeader "Allow" "GET"
|
||||
|
||||
+5
-4
@@ -7,6 +7,7 @@ import qualified Hasql.Pool as P
|
||||
|
||||
import PostgREST.DbStructure (getDbStructure)
|
||||
import PostgREST.App (postgrest)
|
||||
import Data.IORef
|
||||
import Data.String.Conversions (cs)
|
||||
|
||||
import qualified Feature.AuthSpec
|
||||
@@ -27,10 +28,10 @@ main = do
|
||||
pool <- P.acquire (3, 10, cs testDbConn)
|
||||
|
||||
result <- P.use pool $ getDbStructure "test"
|
||||
let dbStructure = either (error.show) id result
|
||||
withApp = return $ postgrest testCfg dbStructure pool
|
||||
ltdApp = return $ postgrest testLtdRowsCfg dbStructure pool
|
||||
unicodeApp = return $ postgrest testUnicodeCfg dbStructure pool
|
||||
refDbStructure <- newIORef $ either (error.show) id result
|
||||
let withApp = return $ postgrest testCfg refDbStructure pool
|
||||
ltdApp = return $ postgrest testLtdRowsCfg refDbStructure pool
|
||||
unicodeApp = return $ postgrest testUnicodeCfg refDbStructure pool
|
||||
|
||||
hspec $ do
|
||||
mapM_ (beforeAll_ resetDb . before withApp) specs
|
||||
|
||||
+1
-1
@@ -27,7 +27,7 @@ testUnicodeCfg =
|
||||
|
||||
testLtdRowsCfg :: AppConfig
|
||||
testLtdRowsCfg =
|
||||
AppConfig testDbConn "postgrest_test_anonymous" "test" 3000 (secret "safe") 10 (Just 3) True
|
||||
AppConfig testDbConn "postgrest_test_anonymous" "test" 3000 (secret "safe") 10 (Just 2) True
|
||||
|
||||
setupDb :: IO ()
|
||||
setupDb = do
|
||||
|
||||
+2
-2
@@ -37,9 +37,9 @@ instance JSON.FromJSON IncPK where
|
||||
|
||||
data CompoundPK = CompoundPK {
|
||||
compoundK1 :: Int
|
||||
, compoundK2 :: Int
|
||||
, compoundK2 :: String
|
||||
, compoundExtra :: Maybe Int
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance JSON.FromJSON CompoundPK where
|
||||
parseJSON (JSON.Object r) = CompoundPK <$>
|
||||
|
||||
Vendored
+15
-2
@@ -204,7 +204,7 @@ INSERT INTO items VALUES (15);
|
||||
-- Name: items_id_seq; Type: SEQUENCE SET; Schema: test; Owner: -
|
||||
--
|
||||
|
||||
SELECT pg_catalog.setval('items_id_seq', 1, true);
|
||||
SELECT pg_catalog.setval('items_id_seq', 15, true);
|
||||
|
||||
|
||||
--
|
||||
@@ -267,7 +267,20 @@ TRUNCATE TABLE "ghostBusters" CASCADE;
|
||||
INSERT INTO "ghostBusters" VALUES (1), (3), (5);
|
||||
|
||||
TRUNCATE TABLE "withUnique" CASCADE;
|
||||
INSERT INTO "withUnique" VALUES ('nodup', 'blah')
|
||||
INSERT INTO "withUnique" VALUES ('nodup', 'blah');
|
||||
|
||||
|
||||
|
||||
TRUNCATE TABLE addresses CASCADE;
|
||||
INSERT INTO addresses VALUES (1, 'address 1');
|
||||
INSERT INTO addresses VALUES (2, 'address 2');
|
||||
INSERT INTO addresses VALUES (3, 'address 3');
|
||||
INSERT INTO addresses VALUES (4, 'address 4');
|
||||
|
||||
TRUNCATE TABLE orders CASCADE;
|
||||
INSERT INTO orders VALUES (1, 'order 1', 1, 2);
|
||||
INSERT INTO orders VALUES (2, 'order 2', 3, 4);
|
||||
|
||||
--
|
||||
-- PostgreSQL database dump complete
|
||||
--
|
||||
|
||||
Vendored
+3
@@ -17,6 +17,7 @@ GRANT ALL ON TABLE
|
||||
, comments
|
||||
, complex_items
|
||||
, compound_pk
|
||||
, empty_table
|
||||
, has_count_column
|
||||
, has_fk
|
||||
, insertable_view_with_join
|
||||
@@ -38,6 +39,8 @@ GRANT ALL ON TABLE
|
||||
, "ghostBusters"
|
||||
, "withUnique"
|
||||
, "موارد"
|
||||
, addresses
|
||||
, orders
|
||||
TO postgrest_test_anonymous;
|
||||
|
||||
GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;
|
||||
|
||||
Vendored
+23
-2
@@ -432,7 +432,8 @@ CREATE TABLE complex_items (
|
||||
id bigint NOT NULL,
|
||||
name text,
|
||||
settings pg_catalog.json,
|
||||
arr_data integer[]
|
||||
arr_data integer[],
|
||||
"field-with_sep" integer default 1 not null
|
||||
);
|
||||
|
||||
|
||||
@@ -442,7 +443,7 @@ CREATE TABLE complex_items (
|
||||
|
||||
CREATE TABLE compound_pk (
|
||||
k1 integer NOT NULL,
|
||||
k2 integer NOT NULL,
|
||||
k2 text NOT NULL,
|
||||
extra integer
|
||||
);
|
||||
|
||||
@@ -457,6 +458,13 @@ CREATE TABLE empty_table (
|
||||
);
|
||||
|
||||
|
||||
--
|
||||
-- Name: private_table; Type: TABLE; Schema: test; Owner: -
|
||||
--
|
||||
|
||||
CREATE TABLE private_table ();
|
||||
|
||||
|
||||
--
|
||||
-- Name: has_count_column; Type: VIEW; Schema: test; Owner: -
|
||||
--
|
||||
@@ -1000,6 +1008,19 @@ ALTER TABLE ONLY users_tasks
|
||||
ALTER TABLE ONLY users_tasks
|
||||
ADD CONSTRAINT users_tasks_user_id_fkey FOREIGN KEY (user_id) REFERENCES users(id);
|
||||
|
||||
|
||||
create table addresses (
|
||||
id int not null unique,
|
||||
address text not null
|
||||
);
|
||||
|
||||
create table orders (
|
||||
id int not null unique,
|
||||
name text not null,
|
||||
billing_address_id int references addresses(id),
|
||||
shipping_address_id int references addresses(id)
|
||||
);
|
||||
|
||||
--
|
||||
-- PostgreSQL database dump complete
|
||||
--
|
||||
|
||||
Reference in New Issue
Block a user