diff --git a/CHANGELOG.md b/CHANGELOG.md index a4d7255ac..19d58aa23 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,20 @@ All notable changes to this project will be documented in this file. This project adheres to [Semantic Versioning](http://semver.org/). +## Unreleased + +### Added +- Ensure JWT expires - @calebmer +- Postgres connection string argument - @calebmer +- Encode JWT for procs that return type `jwt_claims` - @ +- Full text operators `@>`,`<@` - @ruslantalpa + +### Removed +- API versioning feature - @calebmer +- `--db-x` command line arguments - @calebmer +- Secure flag - @calebmer +- PUT request handling - @ruslantalpa + ## [0.2.12.1] - 2015-11-12 ### Fixed diff --git a/README.md b/README.md index c7d8858d5..121c4f38d 100644 --- a/README.md +++ b/README.md @@ -24,13 +24,16 @@ your own projects. Download the binary ([latest release](https://github.com/begriffs/postgrest/releases/latest)) and invoke like so: ```bash -postgrest --db-host localhost --db-port 5432 \ - --db-name my_db --db-user postgres \ - --db-pass foobar --db-pool 200 \ - --anonymous postgres --port 3000 \ - --v1schema public +postgrest postgres://postgres:foobar@localhost:5432/my_db \ + --port 3000 \ + --schema public \ + --anonymous postgres \ + --pool 200 ``` +For more information on valid connection strings see the +[Postgres docs](http://www.postgresql.org/docs/9.4/static/libpq-connect.html#LIBPQ-CONNSTRING). + In production include the `--secure` option which redirects all requests to HTTPS. Note that PostgREST does not handle the SSL internally and must be put behind another server that does (such @@ -100,13 +103,14 @@ guide](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions). ### Versioning A robust long-lived API needs the freedom to exist in multiple -versions. PostgREST supports versioning through HTTP content -negotiation. Requests for a certain version translate into switching -which database schema to search for tables. PostgreSQL schema search -paths allow tables from earlier versions to be reused verbatim in -later versions. +versions. Therefore it is a best practice that you version the database +schema exposed to PostgREST (e.g. `public1` or `api2`). This way you +future proof your API by allowing it to be backwards compatible when +you want to publish breaking API changes (e.g. a later version could +be `public2` or `api3`). -To learn more, see the [guide to versioning](https://github.com/begriffs/postgrest/wiki/API-Versioning). +For routing to different versions of a PostgREST API use a request +proxy (such as [nginx](http://nginx.org)). ### Self-documention @@ -153,7 +157,6 @@ and the [guide to routing](https://github.com/begriffs/postgrest/wiki/Routing). ### Guides * [Routing](https://github.com/begriffs/postgrest/wiki/Routing) -* [Versioning](https://github.com/begriffs/postgrest/wiki/API-Versioning) * [Performance](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling) * [Security](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions) * [Tutorial](http://blog.jonharrington.org/postgrest-introduction/) (external) diff --git a/circle.yml b/circle.yml index 84c32bb12..74c1982c8 100644 --- a/circle.yml +++ b/circle.yml @@ -3,7 +3,7 @@ machine: - createuser --superuser --no-password postgrest_test - createdb -O postgrest_test -U ubuntu postgrest_test ghc: - version: 7.8.3 + version: 7.10.1 dependencies: override: - cabal update diff --git a/debian/postgrest.default b/debian/postgrest.default index 33dab96cc..c2393494c 100644 --- a/debian/postgrest.default +++ b/debian/postgrest.default @@ -7,17 +7,23 @@ # database host #POSTGREST_DBHOST=localhost +# database host +#POSTGREST_DBPORT=5432 + # database to use -#POSTGREST_DBNAME= +#POSTGREST_DBNAME=app # database user -#POSTGREST_DBUSER=postgres +#POSTGREST_DBUSER=authenticator # database password #POSTGREST_DBPASS= # database pool -#POSTGREST_DBPOOL=10 +#POSTGREST_POOL=10 -# additional options -#POSTGREST_OPTS= +# jwt secret +#POSTGREST_JWT_SECRET=secret + +# default schema +#POSTGREST_SCHEMA=public diff --git a/debian/postgrest.init.d b/debian/postgrest.init.d index cacf528a4..a9091740e 100755 --- a/debian/postgrest.init.d +++ b/debian/postgrest.init.d @@ -2,48 +2,69 @@ ### BEGIN INIT INFO # Provides: postgrest # Required-Start: $local_fs $network postgresql -# Required-Stop: $local_fs $network +# Required-Stop: $local_fs $network # Default-Start: 2 3 4 5 # Default-Stop: 0 1 6 # Description: PostgreSQL REST API daemon ### END INIT INFO - + . /lib/lsb/init-functions if test -f /etc/default/postgrest; then . /etc/default/postgrest fi POSTGREST=/usr/local/bin/postgrest +CONNECTION_STRING="postgres://" +POSTGREST_OPTS="" POSTGREST_USER=${POSTGREST_USER:-postgrest} -POSTGREST_DBNAME=${POSTGREST_DBNAME:-postgres} -POSTGREST_DBUSER=${POSTGREST_DBUSER:-postgres} -if [ -n "$POSTGREST_DBHOST" ]; then - POSTGREST_OPTS="$POSTGREST_OPTS --db-host $POSTGREST_DBHOST" -fi -if [ -n "$POSTGREST_DBNAME" ]; then - POSTGREST_OPTS="$POSTGREST_OPTS --db-name $POSTGREST_DBNAME" -fi -if [ -n "$POSTGREST_DBUSER" ]; then - POSTGREST_OPTS="$POSTGREST_OPTS --db-user $POSTGREST_DBUSER" - POSTGREST_OPTS="$POSTGREST_OPTS --anonymous $POSTGREST_DBUSER" -fi +POSTGREST_PORT=${POSTGREST_PORT:-3000} +POSTGREST_DBUSER=${POSTGREST_DBUSER:-authenticator} +#POSTGREST_DBPASS=${POSTGREST_DBPASS:-authenticator} +POSTGREST_DBHOST=${POSTGREST_DBHOST:-localhost} +POSTGREST_DBPORT=${POSTGREST_DBPORT:-5432} +POSTGREST_DBNAME=${POSTGREST_DBNAME:-app} +POSTGREST_DBPOOL=${POSTGREST_DBPOOL:-10} +POSTGREST_ANON=${POSTGREST_ANON:-anonymous} +POSTGREST_JWT_SECRET=${POSTGREST_JWT_SECRET:-secret} +POSTGREST_SCHEMA=${POSTGREST_SCHEMA:-public} + +CONNECTION_STRING="$CONNECTION_STRING$POSTGREST_DBUSER" if [ -n "$POSTGREST_DBPASS" ]; then - POSTGREST_OPTS="$POSTGREST_OPTS --db-pass $POSTGREST_DBPASS" + CONNECTION_STRING="$CONNECTION_STRING:$POSTGREST_DBPASS" fi -if [ -n "$POSTGREST_DBPOOL" ]; then - POSTGREST_OPTS="$POSTGREST_OPTS --db-pool $POSTGREST_DBPOOL" +CONNECTION_STRING="$CONNECTION_STRING@$POSTGREST_DBHOST:$POSTGREST_DBPORT/$POSTGREST_DBNAME" + +if [ -n "$POSTGREST_PORT" ]; then + POSTGREST_OPTS="$POSTGREST_OPTS --port $POSTGREST_PORT" fi -POSTGREST_OPTS="$POSTGREST_OPTS --v1schema public" - + +if [ -n "$POSTGREST_POOL" ]; then + POSTGREST_OPTS="$POSTGREST_OPTS --pool $POSTGREST_POOL" +fi +if [ -n "$POSTGREST_JWT_SECRET" ]; then + #export POSTGREST_JWT_SECRET="$POSTGREST_JWT_SECRET" + POSTGREST_OPTS="$POSTGREST_OPTS --jwt-secret $POSTGREST_JWT_SECRET" +fi +if [ -n "$POSTGREST_SCHEMA" ]; then + POSTGREST_OPTS="$POSTGREST_OPTS --schema $POSTGREST_SCHEMA" +fi +if [ -n "$POSTGREST_ANON" ]; then + POSTGREST_OPTS="$POSTGREST_OPTS --anonymous $POSTGREST_ANON" +fi + +#export CONNECTION_STRING="$CONNECTION_STRING" + +START_PARAMS="$CONNECTION_STRING $POSTGREST_OPTS" + start() { log_daemon_msg "Starting PostgreSQL REST API daemon" "postgrest" || true - if start-stop-daemon --start --quiet --oknodo --chuid ${POSTGREST_USER} --startas /usr/local/bin/postgrest-wrapper --exec $POSTGREST -- $POSTGREST_OPTS; then + if start-stop-daemon --start --quiet --oknodo --chuid ${POSTGREST_USER} --startas /usr/local/bin/postgrest-wrapper --exec $POSTGREST -- $START_PARAMS; then log_end_msg 0 || true else log_end_msg 1 || true fi } - + stop() { log_daemon_msg "Stopping PostgreSQL REST API daemon" "postgrest" || true @@ -53,7 +74,7 @@ stop() log_end_msg 1 || true fi } - + status() { status_of_proc $POSTGREST postgrest && exit 0 || exit $? diff --git a/postgrest.cabal b/postgrest.cabal index bb137524c..9db15172a 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -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.2.12.1 +version: 0.3.0.0 synopsis: REST API for any Postgres database license: MIT license-file: LICENSE @@ -22,10 +22,15 @@ Flag CI Default: False executable postgrest + if flag(ci) + ghc-options: -Wall -W -Werror + else + ghc-options: -Wall -W -O2 + main-is: PostgREST/Main.hs default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes default-language: Haskell2010 - build-depends: base >=4.6 && <5 + build-depends: base >= 4.8 && < 5 , postgrest , hasql >= 0.7.3 && < 0.8 , hasql-backend >= 0.4.1 && < 0.5 @@ -37,6 +42,7 @@ executable postgrest , case-insensitive , scientific, time , aeson >= 0.8, network >= 2.6 + , aeson-pretty >= 0.7 && < 0.8 , bytestring, text, split, string-conversions , stringsearch , containers, unordered-containers @@ -56,6 +62,18 @@ executable postgrest , errors , bifunctors hs-source-dirs: src + other-modules: Paths_postgrest + , PostgREST.App + , PostgREST.Auth + , PostgREST.Config + , PostgREST.Error + , PostgREST.Middleware + , PostgREST.Parsers + , PostgREST.PgQuery + , PostgREST.DbStructure + , PostgREST.QueryBuilder + , PostgREST.RangeQuery + , PostgREST.Types library if flag(ci) @@ -65,47 +83,61 @@ library default-language: Haskell2010 default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes - build-depends: base >=4.6 && <5 - , hasql, hasql-backend - , hasql-postgres - , warp, wai - , wai-extra, wai-cors - , wai-middleware-static - , HTTP, convertible, http-types - , case-insensitive - , scientific, time - , aeson, network - , bytestring, text, split, string-conversions - , stringsearch - , containers, unordered-containers - , optparse-applicative - , regex-base, regex-tdfa + build-depends: HTTP + , MissingH , Ranged-sets - , transformers, MissingH - , bcrypt, base64-string - , network-uri - , resource-pool - , blaze-builder - , vector - , mtl - , cassava - , jwt - , parsec - , errors + , aeson + , base >=4.6 && <5 + , base64-string + , bcrypt , bifunctors + , blaze-builder + , bytestring + , case-insensitive + , cassava + , containers + , convertible + , errors + , hasql + , hasql-backend + , hasql-postgres + , http-types + , jwt + , mtl + , network + , network-uri + , optparse-applicative + , parsec + , regex-base + , regex-tdfa + , resource-pool + , scientific + , split + , string-conversions + , stringsearch + , text + , time + , transformers + , unordered-containers + , vector + , wai + , wai-cors + , wai-extra + , wai-middleware-static + , warp Other-Modules: Paths_postgrest Exposed-Modules: PostgREST.App - , PostgREST.Types - , PostgREST.Parsers - , PostgREST.QueryBuilder , PostgREST.Auth , PostgREST.Config , PostgREST.Error , PostgREST.Middleware + , PostgREST.Parsers , PostgREST.PgQuery - , PostgREST.PgStructure + , PostgREST.DbStructure + , PostgREST.QueryBuilder , PostgREST.RangeQuery + , PostgREST.Types hs-source-dirs: src Test-Suite spec @@ -118,21 +150,29 @@ Test-Suite spec else ghc-options: -Wall -W -O2 Main-Is: Main.hs - Other-Modules: PostgREST.App - , PostgREST.Types - , PostgREST.Parsers - , PostgREST.QueryBuilder + Other-Modules: Feature.AuthSpec + , Feature.CorsSpec + , Feature.DeleteSpec + , Feature.InsertSpec + , Feature.QuerySpec + , Feature.RangeSpec + , Feature.StructureSpec + , Paths_postgrest + , PostgREST.App , PostgREST.Auth , PostgREST.Config , PostgREST.Error , PostgREST.Middleware + , PostgREST.Parsers , PostgREST.PgQuery - , PostgREST.PgStructure + , PostgREST.DbStructure + , PostgREST.QueryBuilder , PostgREST.RangeQuery + , PostgREST.Types , Spec , SpecHelper - , Paths_postgrest - Build-Depends: base, hspec == 2.1.*, QuickCheck + , TestTypes + Build-Depends: base, hspec == 2.2.*, QuickCheck , hspec-wai, hspec-wai-json , hasql, hasql-backend , hasql-postgres diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 41bb2dcb5..a395353a3 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -1,102 +1,77 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +--module PostgREST.App where module PostgREST.App ( app -, sqlError -, isSqlError , contentTypeForAccept -, jsonH -, requestedSchema -, TableOptions(..) ) where -import qualified Blaze.ByteString.Builder as BB import Control.Applicative -import Control.Arrow (second, (***)) +import Control.Arrow ((***)) import Control.Monad (join) import Data.Bifunctor (first) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BL -import Data.CaseInsensitive (original) import qualified Data.Csv as CSV import Data.Functor.Identity -import qualified Data.HashMap.Strict as M -import Data.List (find, sortBy) -import Data.Maybe (fromMaybe, isJust, isNothing, - mapMaybe) +import qualified Data.HashMap.Strict as HM +import Data.List (find, sortBy, delete, transpose) +import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, mapMaybe) import Data.Ord (comparing) import Data.Ranged.Ranges (emptyRange) -import qualified Data.Set as S import Data.String.Conversions (cs) import Data.Text (Text, replace, strip) -import Text.Regex.TDFA ((=~)) +import Data.Tree +import qualified Data.Map as M 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.Wai -import Network.Wai.Internal (Response (..)) import Network.Wai.Parse (parseHttpAccept) import Data.Aeson +import Data.Aeson.Types (emptyArray) import Data.Monoid import qualified Data.Vector as V import qualified Hasql as H import qualified Hasql.Backend as B import qualified Hasql.Postgres as P -import PostgREST.Auth import PostgREST.Config (AppConfig (..)) import PostgREST.Parsers import PostgREST.PgQuery -import PostgREST.PgStructure +import PostgREST.DbStructure import PostgREST.QueryBuilder import PostgREST.RangeQuery import PostgREST.Types +import PostgREST.Auth (tokenJWT) import Prelude -app :: DbStructure -> AppConfig -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response -app dbstructure conf reqBody dbrole req = +app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response +app dbStructure conf reqBody req = case (path, verb) of - ([], _) -> do - let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTabs - return $ responseLBS status200 [jsonH] $ cs body - - ([table], "OPTIONS") -> do - let cols = filter (filterCol schema table) allCols - pkeys = map pkName $ filter (filterPk schema table) allPrKeys - body = encode (TableOptions cols pkeys) - return $ responseLBS status200 [jsonH, allOrigins] $ cs body - ([table], "GET") -> if range == Just emptyRange then return $ responseLBS status416 [] "HTTP Range error" else - case queries of - Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e - Right (qs, cqs) -> do - let qt = qualify table - count = if hasPrefer "count=none" - then countNone - else cqs - q = B.Stmt "select " V.empty True <> - parentheticT count - <> commaq <> ( - bodyForAccept contentType qt -- TODO! when in csv mode, the first row (columns) is not correct when requesting sub tables - . limitT range - $ qs - ) + case request of + Left e -> return $ responseLBS status400 [jsonH] $ cs e + Right (selectQuery, _, _) -> do + let q = B.Stmt (createStatement selectQuery Nothing True range [] (not $ hasPrefer "count=none") isCsv) V.empty True row <- H.maybeEx q - let (tableTotal, queryTotal, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString) row - to = from+queryTotal-1 - contentRange = contentRangeH from to tableTotal - status = rangeStatus from to tableTotal - canonical = urlEncodeVars + let (tableTotal, queryTotal, _ , body) = extractQueryResult row + to = frm+queryTotal-1 + contentRange = contentRangeH frm to tableTotal + status = rangeStatus frm to tableTotal + canonical = urlEncodeVars -- should this be moved to the dbStructure (location)? . sortBy (comparing fst) . map (join (***) cs) . parseSimpleQuery @@ -108,99 +83,48 @@ app dbstructure conf reqBody dbrole req = if Prelude.null canonical then "" else "?" <> cs canonical ) ] (fromMaybe "[]" body) - where - from = fromMaybe 0 $ rangeOffset <$> range - apiRequest = first formatParserError (parseGetRequest req) - >>= first formatRelationError . addRelations schema allRels Nothing - >>= addJoinConditions schema allCols - where - formatRelationError :: Text -> Text - formatRelationError e = cs $ encode $ object [ - "mesage" .= ("could not find foreign keys between these entities"::String), - "details" .= e] - formatParserError :: ParseError -> Text - formatParserError e = cs $ encode $ object [ - "message" .= message, - "details" .= details] - where - message = show (errorPos e) - details = strip $ replace "\n" " " $ cs - $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e) + frm = fromMaybe 0 $ rangeOffset <$> range - query = requestToQuery schema <$> apiRequest - countQuery = requestToCountQuery schema <$> apiRequest - queries = (,) <$> query <*> countQuery - - - (["postgrest", "users"], "POST") -> do - let user = decode reqBody :: Maybe AuthUser - - case user of - Nothing -> return $ responseLBS status400 [jsonH] $ - encode . object $ [("message", String "Failed to parse user.")] - Just u -> do - _ <- addUser (cs $ userId u) - (cs $ userPass u) (cs <$> userRole u) + ([table], "POST") -> + case request of + Left e -> return $ responseLBS status400 [jsonH] $ cs e + Right (selectQuery, mutateQuery, isSingle) -> do + let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself? + q = B.Stmt (createStatement selectQuery (Just (mutateQuery, isSingle)) echoRequested Nothing pKeys False isCsv) V.empty True + row <- H.maybeEx q + let (_, _, location, body) = extractQueryResult row return $ responseLBS status201 - [ jsonH - , (hLocation, "/postgrest/users?id=eq." <> cs (userId u)) - ] "" + [ + contentTypeH, + (hLocation, "/" <> cs table <> "?" <> cs (fromMaybe "" location)) + ] + $ if echoRequested then fromMaybe "[]" body else "" - (["postgrest", "tokens"], "POST") -> - case jwtSecret of - "secret" -> return $ responseLBS status500 [jsonH] $ - encode . object $ [("message", String "JWT Secret is set as \"secret\" which is an unsafe default.")] - _ -> do - let user = decode reqBody :: Maybe AuthUser + ([_], "PATCH") -> + case request of + Left e -> return $ responseLBS status400 [jsonH] $ cs e + Right (selectQuery, mutateQuery, _) -> do + let q = B.Stmt (createStatement selectQuery (Just (mutateQuery, False)) echoRequested Nothing [] False isCsv) V.empty True + row <- H.maybeEx q + let (_, queryTotal, _, body) = extractQueryResult row + r = contentRangeH 0 (queryTotal-1) (Just queryTotal) + s = case () of _ | queryTotal == 0 -> status404 + | echoRequested -> status200 + | otherwise -> status204 + return $ responseLBS s [contentTypeH, r] + $ if echoRequested then fromMaybe "[]" body else "" - case user of - Nothing -> return $ responseLBS status400 [jsonH] $ - encode . object $ [("message", String "Failed to parse user.")] - Just u -> do - setRole authenticator - login <- signInRole (cs $ userId u) (cs $ userPass u) - case login of - LoginSuccess role uid -> - return $ responseLBS status201 [ jsonH ] $ - encode . object $ [("token", String $ tokenJWT jwtSecret uid role)] - _ -> return $ responseLBS status401 [jsonH] $ - encode . object $ [("message", String "Failed authentication.")] - - ([table], "POST") -> do - let qt = qualify table - echoRequested = hasPrefer "return=representation" - parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value)) - parsed = if lookupHeader "Content-Type" == Just csvMT - then do - rows <- CSV.decode CSV.NoHeader reqBody - if V.null rows then Left "CSV requires header" - else Right (V.head rows, (V.map $ V.map $ parseCsvCell . cs) (V.tail rows)) - else eitherDecode reqBody >>= \val -> - case val of - Object obj -> Right . second V.singleton . V.unzip . V.fromList $ - M.toList obj - _ -> Left "Expecting single JSON object or CSV rows" - case parsed of - Left err -> return $ responseLBS status400 [] $ - encode . object $ [("message", String $ "Failed to parse JSON payload. " <> cs err)] - Right toBeInserted -> do - rows :: [Identity Text] <- H.listEx $ uncurry (insertInto qt) toBeInserted - let inserted :: [Object] = mapMaybe (decode . cs . runIdentity) rows - pKeys = map pkName $ filter (filterPk schema table) allPrKeys - responses = flip map inserted $ \obj -> do - let primaries = - if Prelude.null pKeys - then obj - else M.filterWithKey (const . (`elem` pKeys)) obj - let params = urlEncodeVars - $ map (\t -> (cs $ fst t, cs (paramFilter $ snd t))) - $ sortBy (comparing fst) $ M.toList primaries - responseLBS status201 - [ jsonH - , (hLocation, "/" <> cs table <> "?" <> cs params) - ] $ if echoRequested then encode obj else "" - return $ multipart status201 responses + ([_], "DELETE") -> + case request of + Left e -> return $ responseLBS status400 [jsonH] $ cs e + Right (selectQuery, mutateQuery, _) -> do + let q = B.Stmt (createStatement selectQuery (Just (mutateQuery, False)) False Nothing [] True isCsv) V.empty True + row <- H.maybeEx q + let (_, queryTotal, _, _) = extractQueryResult row + return $ if queryTotal == 0 + then responseLBS status404 [] "" + else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] "" (["rpc", proc], "POST") -> do let qi = QualifiedIdentifier schema (cs proc) @@ -208,137 +132,75 @@ app dbstructure conf reqBody dbrole req = if exists then do let call = B.Stmt "select " V.empty True <> - asJson (callProc qi $ fromMaybe M.empty (decode reqBody)) - body :: Maybe (Identity Text) <- H.maybeEx call + asJson (callProc qi $ fromMaybe HM.empty (decode reqBody)) + bodyJson :: Maybe (Identity Value) <- H.maybeEx call + returnJWT <- doesProcReturnJWT schema proc return $ responseLBS status200 [jsonH] - (cs $ fromMaybe "[]" $ runIdentity <$> body) + (let body = fromMaybe emptyArray $ runIdentity <$> bodyJson in + if returnJWT + then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}" + else cs $ encode body) else return $ responseLBS status404 [] "" -- check that proc exists -- check that arg names are all specified - -- select * from "1".proc(a := "foo"::undefined) where whereT limit limitT + -- select * from public.proc(a := "foo"::undefined) where whereT limit limitT - ([table], "PUT") -> - handleJsonObj reqBody $ \obj -> do - let qt = qualify table - pKeys = map pkName $ filter (filterPk schema table) allPrKeys - specifiedKeys = map (cs . fst) qq - if S.fromList pKeys /= S.fromList specifiedKeys - then return $ responseLBS status405 [] - "You must speficy all and only primary keys as params" - else do - let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols - cols = map cs $ M.keys obj - if S.fromList tableCols == S.fromList cols - then do - let vals = M.elems obj - H.unitEx $ iffNotT - (whereT qt qq $ update qt cols vals) - (insertSelect qt cols vals) - return $ responseLBS status204 [ jsonH ] "" + ([], _) -> do + body <- encode <$> accessibleTables (filter ((== cs schema) . tableSchema) allTabs) + return $ responseLBS status200 [jsonH] $ cs body - else return $ if Prelude.null tableCols - then responseLBS status404 [] "" - else responseLBS status400 [] - "You must specify all columns in PUT request" - - ([table], "PATCH") -> - handleJsonObj reqBody $ \obj -> do - let qt = qualify table - up = returningStarT - . whereT qt qq - $ update qt (map cs $ M.keys obj) (M.elems obj) - patch = withT up "t" $ B.Stmt - "select count(t), array_to_json(array_agg(row_to_json(t)))::character varying" - V.empty True - - row <- H.maybeEx patch - let (queryTotal, body) = - fromMaybe (0 :: Int, Just "" :: Maybe Text) row - r = contentRangeH 0 (queryTotal-1) (Just queryTotal) - echoRequested = hasPrefer "return=representation" - s = case () of _ | queryTotal == 0 -> status404 - | echoRequested -> status200 - | otherwise -> status204 - return $ responseLBS s [ jsonH, r ] $ if echoRequested then cs $ fromMaybe "[]" body else "" - - ([table], "DELETE") -> do - let qt = qualify table - del = countT - . returningStarT - . whereT qt qq - $ deleteFrom qt - row <- H.maybeEx del - let (Identity deletedCount) = fromMaybe (Identity 0 :: Identity Int) row - return $ if deletedCount == 0 - then responseLBS status404 [] "" - else responseLBS status204 [("Content-Range", "*/"<> cs (show deletedCount))] "" + ([table], "OPTIONS") -> do + let cols = filter (filterCol schema table) allCols + pkeys = map pkName $ filter (filterPk schema table) allPrKeys + body = encode (TableOptions cols pkeys) + return $ responseLBS status200 [jsonH, allOrigins] $ cs body (_, _) -> return $ responseLBS status404 [] "" where - allTabs = tables dbstructure - allRels = relations dbstructure - allCols = columns dbstructure - allPrKeys = primaryKeys dbstructure - filterCol sc table (Column{colSchema=s, colTable=t}) = s==sc && table==t + allTabs = dbTables dbStructure + allRels = dbRelations dbStructure + allCols = dbColumns dbStructure + allPrKeys = dbPrimaryKeys dbStructure + filterCol sc table (Column{colTable=Table{tableSchema=s, tableName=t}}) = s==sc && table==t filterCol _ _ _ = False - filterPk sc table pk = sc == pkSchema pk && table == pkTable pk - - filterTableAcl :: Text -> Table -> Bool - filterTableAcl r (Table{tableAcl=a}) = r `elem` a + filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk path = pathInfo req verb = requestMethod req - qq = queryString req - qualify = QualifiedIdentifier schema hdrs = requestHeaders req lookupHeader = flip lookup hdrs hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs accept = lookupHeader hAccept - schema = requestedSchema (cs $ configV1Schema conf) accept - authenticator = cs $ configDbUser conf - jwtSecret = cs $ configJwtSecret conf + schema = cs $ configSchema conf + jwtSecret = (cs $ configJwtSecret conf) :: Text range = rangeRequested hdrs allOrigins = ("Access-Control-Allow-Origin", "*") :: Header contentType = fromMaybe "application/json" $ contentTypeForAccept accept + isCsv = contentType == csvMT contentTypeH = (hContentType, contentType) - -sqlError :: t -sqlError = undefined - -isSqlError :: t -isSqlError = undefined + echoRequested = hasPrefer "return=representation" + request = parseRequest schema allRels (head path) req reqBody --TODO! is head safe? rangeStatus :: Int -> Int -> Maybe Int -> Status rangeStatus _ _ Nothing = status200 -rangeStatus from to (Just total) - | from > total = status416 - | (1 + to - from) < total = status206 +rangeStatus frm to (Just total) + | frm > total = status416 + | (1 + to - frm) < total = status206 | otherwise = status200 contentRangeH :: Int -> Int -> Maybe Int -> Header -contentRangeH from to total = +contentRangeH frm to total = ("Content-Range", cs headerValue) where headerValue = rangeString <> "/" <> totalString rangeString - | totalNotZero && fromInRange = show from <> "-" <> cs (show to) + | totalNotZero && fromInRange = show frm <> "-" <> cs (show to) | otherwise = "*" totalString = fromMaybe "*" (show <$> total) totalNotZero = fromMaybe True ((/=) 0 <$> total) - fromInRange = from <= to - -requestedSchema :: Text -> Maybe BS.ByteString -> Text -requestedSchema v1schema accept = - case verStr of - Just [[_, ver]] -> if ver == "1" then v1schema else cs ver - _ -> v1schema - - where - verRegex = "version[ ]*=[ ]*([0-9]+)" :: BS.ByteString - verStr = (=~ verRegex) <$> accept :: Maybe [[BS.ByteString]] - + fromInRange = frm <= to jsonMT :: BS.ByteString jsonMT = "application/json" @@ -362,48 +224,120 @@ contentTypeForAccept accept findInAccept = flip find $ parseHttpAccept acceptH has = isJust . findInAccept . BS.isPrefixOf -bodyForAccept :: BS.ByteString -> QualifiedIdentifier -> StatementT -bodyForAccept contentType table - | contentType == csvMT = asCsvWithCount table - | otherwise = asJsonWithCount -- defaults to JSON - -handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response) - -> H.Tx P.Postgres s Response -handleJsonObj reqBody handler = do - let p = eitherDecode reqBody - case p of - Left err -> - return $ responseLBS status400 [jsonH] jErr - where - jErr = encode . object $ - [("message", String $ "Failed to parse JSON payload. " <> cs err)] - Right (Object o) -> handler o - Right _ -> - return $ responseLBS status400 [jsonH] jErr - where - jErr = encode . object $ - [("message", String "Expecting a JSON object")] - parseCsvCell :: BL.ByteString -> Value parseCsvCell s = if s == "NULL" then Null else String $ cs s -multipart :: Status -> [Response] -> Response -multipart _ [] = responseLBS status204 [] "" -multipart _ [r] = r -multipart s rs = - responseLBS s [(hContentType, "multipart/mixed; boundary=\"postgrest_boundary\"")] $ - BL.intercalate "\n--postgrest_boundary\n" (map renderResponseBody rs) +formatRelationError :: Text -> Text +formatRelationError e = cs $ encode $ object [ + "mesage" .= ("could not find foreign keys between these entities"::String), + "details" .= e] +formatParserError :: ParseError -> Text +formatParserError e = cs $ encode $ object [ + "message" .= message, + "details" .= details] where - renderHeader :: Header -> BL.ByteString - renderHeader (k, v) = cs (original k) <> ": " <> cs v + message = show (errorPos e) + details = strip $ replace "\n" " " $ cs + $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e) - renderResponseBody :: Response -> BL.ByteString - renderResponseBody (ResponseBuilder _ headers b) = - BL.intercalate "\n" (map renderHeader headers) - <> "\n\n" <> BB.toLazyByteString b - renderResponseBody _ = error - "Unable to create multipart response from non-ResponseBuilder" +parseRequestBody :: Bool -> BL.ByteString -> Either Text ([Text],[[Value]]) +parseRequestBody isCsv reqBody = first cs $ + checkStructure =<< + if isCsv + then do + rows <- (map V.toList . V.toList) <$> CSV.decode CSV.NoHeader reqBody + if null rows then Left "CSV requires header" -- TODO! should check if length rows > 1 (header and 1 row) + else Right (head rows, (map $ map $ parseCsvCell . cs) (tail rows)) + else eitherDecode reqBody >>= convertJson + where + checkStructure :: ([Text], [[Value]]) -> Either String ([Text], [[Value]]) + checkStructure v + | headerMatchesContent v = Right v + | isCsv = Left "CSV header does not match rows length" + | otherwise = Left "The number of keys in objects do not match" + + headerMatchesContent :: ([Text], [[Value]]) -> Bool + headerMatchesContent (header, vals) = all ( (headerLength ==) . length) vals + where headerLength = length header + +convertJson :: Value -> Either String ([Text],[[Value]]) +convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized) + where + invalidMsg = "Expecting single JSON object or JSON array of objects" + normalized :: Either String [(Text, [Value])] + normalized = groupByKey =<< normalizeValue v + + vals :: [(Text, [Value])] -> [[Value]] + vals = transpose . map snd + + header :: [(Text, [Value])] -> [Text] + header = map fst + + groupByKey :: Value -> Either String [(Text,[Value])] + groupByKey (Array a) = HM.toList . foldr (HM.unionWith (++)) (HM.fromList []) <$> maps + where + maps :: Either String [HM.HashMap Text [Value]] + maps = mapM getElems $ V.toList a + getElems (Object o) = Right $ HM.map (:[]) o + getElems _ = Left invalidMsg + groupByKey _ = Left invalidMsg + + normalizeValue :: Value -> Either String Value + normalizeValue val = + case val of + Object obj -> Right $ Array (V.fromList[Object obj]) + a@(Array _) -> Right a + _ -> Left invalidMsg + +augumentRequestWithJoin :: Schema -> [Relation] -> ApiRequest -> Either Text ApiRequest +augumentRequestWithJoin schema allRels request = + (first formatRelationError . addRelations schema allRels Nothing) request + >>= addJoinConditions schema + +-- we use strings here because most of this data will be sent to parsers (which need strings for now) +queryParams :: Request -> [(String, Maybe String)] +queryParams httpRequest = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest] + +selectStr :: [(String, Maybe String)] -> String +selectStr qParams = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams + +whereFilters :: [(String, Maybe String)] -> [(String, String)] +whereFilters qParams = [ (k, fromJust v) | (k,v) <- qParams, k `notElem` ["select", "order"], isJust v ] + +orderStr :: [(String, Maybe String)] -> Maybe String +orderStr qParams = join $ lookup "order" qParams + +buildSelectApiRequest :: Text -> String -> [(String, String)] -> Maybe String -> Either Text ApiRequest +buildSelectApiRequest rootTableName sel wher orderS = + first formatParserError $ foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts + where + apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++sel++">>") sel + addOrder (Node (q,i) f) o = Node (q{order=o}, i) f + flts = mapM pRequestFilter wher + ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderS++">>")) orderS + +addFilter :: (Path, Filter) -> ApiRequest -> ApiRequest +addFilter ([], flt) (Node (q@(Select {where_=flts}), i) forest) = Node (q {where_=flt:flts}, i) forest +addFilter (path, flt) (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) + where + targetNodeName:remainingPath = path + (targetNode,restForest) = splitForest targetNodeName forest + splitForest name forst = + case maybeNode of + Nothing -> (Nothing,forest) + Just node -> (Just node, delete node forest) + where maybeNode = find ((name==).fst.snd.rootLabel) forst + +toSourceRelation :: Text -> Relation -> Maybe Relation +toSourceRelation mt r@(Relation t _ ft _ _ rt _ _) + | mt == tableName t = Just $ r {relTable=t {tableName=sourceSubqueryName}} + | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceSubqueryName}} + | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceSubqueryName}) <$> rt} + | otherwise = Nothing data TableOptions = TableOptions { tblOptcolumns :: [Column] @@ -414,3 +348,75 @@ instance ToJSON TableOptions where toJSON t = object [ "columns" .= tblOptcolumns t , "pkey" .= tblOptpkey t ] + +parseRequest :: Schema -> [Relation] -> NodeName -> Request -> BL.ByteString -> Either Text (Text, Text, Bool) +parseRequest schema allRels rootTableName httpRequest reqBody = + (,,) <$> selectQuery + <*> (if method == "GET" then pure "" else mutateQuery) + <*> (if method == "GET" then pure False else pure isSingleRecord) + where + hdrs = requestHeaders httpRequest + lookupHeader = flip lookup hdrs + isCsv = lookupHeader "Content-Type" == Just csvMT + method = requestMethod httpRequest + qParams = queryParams httpRequest + parsedBody = parseRequestBody isCsv reqBody + isSingleRecord = either (const False) ((==1) . length . snd ) parsedBody + parseField f = parse pField ("failed to parse field <<"++f++">>") f + flds = join $ first formatParserError . mapM (parseField . cs) <$> (fst <$> parsedBody) + vals = snd <$> parsedBody + setWith = if isSingleRecord + then M.fromList <$> (zip <$> flds <*> (head <$> vals)) + else Left "Expecting a sigle CSV line with header or a JSON object" + allFilters = whereFilters qParams + mutateFilters = filter (not . ( '.' `elem` ) . fst) allFilters -- update/delete filters can be only on the root table + cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters + fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels + rels = case method of + "POST" -> fakeSourceRelations ++ allRels + "PATCH" -> fakeSourceRelations ++ allRels + _ -> allRels + selectApiRequest = augumentRequestWithJoin schema rels + =<< buildSelectApiRequest rootName sel filters (orderStr qParams) + where + sel = if method == "DELETE" + then "*" -- we are not returning the records so no need to consider nested items + else selectStr qParams + rootName = if method == "GET" + then rootTableName + else sourceSubqueryName + filters = if method == "GET" + then allFilters + else filter (( '.' `elem` ) . fst) allFilters -- there can be no filters on the root table whre we are doing insert/update + selectQuery = requestToQuery schema <$> selectApiRequest + mutateQuery = requestToQuery schema <$> case method of + "POST" -> Node <$> ((,) <$> (Insert rootTableName <$> flds <*> vals) <*> pure (rootTableName, Nothing)) <*> pure [] + "PATCH" -> Node <$> ((,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)) <*> pure [] + "DELETE" -> Node <$> ((,) <$> (Delete [rootTableName] <$> cond) <*> pure (rootTableName, Nothing)) <*> pure [] + _ -> undefined + +createStatement :: Text -> Maybe (Text, Bool) -> Bool -> Maybe NonnegRange -> [Text] -> Bool -> Bool -> Text +createStatement selectQuery Nothing _ range _ countTable asCsv = + wrapQuery selectQuery [ + if countTable then countAllF else countNoneF, + countF, + "null", -- location header can not be calucalted + if asCsv then asCsvF else asJsonF + ] selectStarF range +createStatement selectQuery (Just (changeQuery, isSingle)) echoRequested _ pKeys _ asCsv = + wrapQuery changeQuery [ + countNoneF, -- when updateing it does not make sense + countF, + if isSingle then locationF pKeys else "null", + if echoRequested + then + if asCsv + then asCsvF + else if isSingle then asJsonSingleF else asJsonF + else "null" + + ] selectQuery Nothing + +extractQueryResult :: Maybe (Maybe Int, Int, Maybe BL.ByteString, Maybe BL.ByteString) + -> (Maybe Int, Int, Maybe BL.ByteString, Maybe BL.ByteString) +extractQueryResult = fromMaybe (Just 0, 0, Just "", Just "") diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs index edcf86cf9..a608b684c 100644 --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -1,104 +1,84 @@ -module PostgREST.Auth where +{-# LANGUAGE FlexibleContexts #-} +{-| +Module : PostgREST.Auth +Description : PostgREST authorization functions. -import Control.Applicative -import Control.Monad (mzero) -import Crypto.BCrypt -import Data.Aeson -import Data.Map -import Data.Monoid +This module provides functions to deal with the JWT authorization (http://jwt.io). +It also can be used to define other authorization functions, +in the future Oauth, LDAP and similar integrations can be coded here. + +Authentication should always be implemented in an external service. +In the test suite there is an example of simple login function that can be used for a +very simple authentication system inside the PostgreSQL database. +-} +module PostgREST.Auth ( + setRole + , claimsToSQL + , jwtClaims + , tokenJWT + ) where + +import Control.Monad (join) +import Data.Aeson (Value (..), Object) +import Data.Aeson.Types (emptyObject, emptyArray) +import Data.Vector as V (null, head) +import Data.Map as M (fromList, toList) +import Data.Monoid ((<>)) import Data.String.Conversions (cs) -import Data.Text -import Data.Maybe (isNothing) -import qualified Data.Vector as V -import qualified Hasql as H -import qualified Hasql.Backend as B -import qualified Hasql.Postgres as P -import PostgREST.PgQuery (pgFmtLit) -import Prelude +import Data.Text (Text) +import Data.Time.Clock (NominalDiffTime) +import PostgREST.PgQuery (pgFmtLit, pgFmtIdent, unquoted) import qualified Web.JWT as JWT +import qualified Data.HashMap.Lazy as H -import System.IO.Unsafe - -data AuthUser = AuthUser { - userId :: String - , userPass :: String - , userRole :: Maybe String - } deriving (Show) - -instance FromJSON AuthUser where - parseJSON (Object v) = AuthUser <$> - v .: "id" <*> - v .: "pass" <*> - v .:? "role" - parseJSON _ = mzero - -instance ToJSON AuthUser where - toJSON u = object [ - "id" .= userId u - , "pass" .= userPass u - , "role" .= userRole u ] - -type DbRole = Text -type UserId = Text - -data LoginAttempt = - NoCredentials - | MalformedAuth - | LoginFailed - | LoginSuccess DbRole UserId - deriving (Eq, Show) - -checkPass :: Text -> Text -> Bool -checkPass = (. cs) . validatePassword . cs - -setRole :: Text -> H.Tx P.Postgres s () -setRole role = H.unitEx $ B.Stmt ("set local role " <> cs (pgFmtLit role)) V.empty True - -setUserId :: Text -> H.Tx P.Postgres s () -setUserId uid = - if uid /= "" - then H.unitEx $ B.Stmt ("set local user_vars.user_id = " <> cs (pgFmtLit uid)) V.empty True - else resetUserId - -resetUserId :: H.Tx P.Postgres s () -resetUserId = H.unitEx [H.stmt|reset user_vars.user_id|] - -addUser :: Text -> Text -> Maybe Text -> H.Tx P.Postgres s () -addUser identity pass role = - H.unitEx $ - if isNothing role - then [H.stmt|insert into postgrest.auth (id, pass) values (?, ?)|] - identity hashedText - else [H.stmt|insert into postgrest.auth (id, pass, rolname) values (?, ?, ?)|] - identity hashedText role - where Just hashed = unsafePerformIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass) - hashedText = cs hashed :: Text - -signInRole :: Text -> Text -> H.Tx P.Postgres s LoginAttempt -signInRole user pass = do - u <- H.maybeEx $ [H.stmt|select id, pass, rolname from postgrest.auth where id = ?|] user - return $ maybe LoginFailed (\r -> - let (uid, hashed, role) = r in - if checkPass hashed pass - then LoginSuccess role uid - else LoginFailed - ) u - -signInWithJWT :: Text -> Text -> LoginAttempt -signInWithJWT secret input = case maybeRole of - Just (Just (String role)) -> case maybeUserId of - Just (Just (String uid)) -> LoginSuccess (cs role) (cs uid) - _ -> LoginFailed - _ -> LoginFailed +{-| + 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. +-} +claimsToSQL :: JWT.ClaimsMap -> [Text] +claimsToSQL = map setVar . toList + where + setVar ("role", String val) = setRole val + setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <> + " = " <> 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. +-} +jwtClaims :: Text -> Text -> NominalDiffTime -> Maybe JWT.ClaimsMap +jwtClaims secret input time = + case join $ claim JWT.exp of + Just expires -> + if JWT.secondsSinceEpoch expires > time + then customClaims + else Nothing + _ -> customClaims where - maybeRole = (Data.Map.lookup "role" <$> claims) ::Maybe (Maybe Value) - maybeUserId = (Data.Map.lookup "id" <$> claims) ::Maybe (Maybe Value) - claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input + claim :: (JWT.JWTClaimsSet -> a) -> Maybe a + claim prop = prop . JWT.claims <$> decoded + customClaims = claim JWT.unregisteredClaims -tokenJWT :: Text -> Text -> Text -> Text -tokenJWT secret uid role = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet - where - claimsSet = JWT.def { - JWT.unregisteredClaims = Data.Map.fromList [("id", String uid), ("role", String role)] - } +-- | Receives the name of a role and returns a SET ROLE statement +setRole :: Text -> Text +setRole role = "set local role " <> cs (pgFmtLit role) <> ";" + + +{-| + Receives the JWT secret (from config) and a JWT and a JSON value + and returns a signed JWT. +-} +tokenJWT :: Text -> Value -> Text +tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 (JWT.secret secret) + JWT.def { JWT.unregisteredClaims = fromHashMap o } + where + Object o = if V.null a then emptyObject else V.head a + fromHashMap :: Object -> JWT.ClaimsMap + fromHashMap = M.fromList . H.toList +tokenJWT secret _ = tokenJWT secret emptyArray diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 292cc040a..17a94ff07 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -28,44 +28,33 @@ import Data.Text (strip) import Data.Version (versionBranch) import Network.Wai import Network.Wai.Middleware.Cors (CorsResourcePolicy (..)) -import Options.Applicative hiding (columns) +import Options.Applicative import Paths_postgrest (version) import Prelude -- | Data type to store all command line options data AppConfig = AppConfig { - configDbName :: String - , configDbPort :: Int - , configDbUser :: String - , configDbPass :: String - , configDbHost :: String - + configDatabase :: String , configPort :: Int , configAnonRole :: String - , configSecure :: Bool - , configPool :: Int - , configV1Schema :: String + , configSchema :: String , configJwtSecret :: String + , configPool :: Int } argParser :: Parser AppConfig argParser = AppConfig - <$> strOption (long "db-name" <> short 'd' <> metavar "NAME" <> help "name of database") - <*> option auto (long "db-port" <> short 'P' <> metavar "PORT" <> value 5432 <> help "postgres server port" <> showDefault) - <*> strOption (long "db-user" <> short 'U' <> metavar "ROLE" <> help "postgres authenticator role") - <*> strOption (long "db-pass" <> metavar "PASS" <> value "" <> help "password for authenticator role") - <*> strOption (long "db-host" <> metavar "HOST" <> value "localhost" <> help "postgres server hostname" <> showDefault) + <$> argument str (help "database connection string" <> metavar "STRING") - <*> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 3000 <> help "port number on which to run HTTP server" <> showDefault) - <*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE" <> help "postgres role to use for non-authenticated requests") - <*> switch (long "secure" <> short 's' <> help "Redirect all requests to HTTPS") - <*> option auto (long "db-pool" <> metavar "COUNT" <> value 10 <> help "Max connections in database pool" <> showDefault) - <*> strOption (long "v1schema" <> metavar "NAME" <> value "1" <> help "Schema to use for nonspecified version (or explicit v1)" <> showDefault) - <*> strOption (long "jwt-secret" <> metavar "SECRET" <> value "secret" <> help "Secret used to encrypt and decrypt JWT tokens)" <> showDefault) + <*> option auto (long "port" <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault) + <*> strOption (long "anonymous" <> short 'a' <> help "postgres role to use for non-authenticated requests" <> metavar "ROLE") + <*> strOption (long "schema" <> short 's' <> help "schema to use for API routes" <> metavar "NAME" <> value "1" <> showDefault) + <*> strOption (long "jwt-secret" <> short 'j' <> help "secret used to encrypt and decrypt JWT tokens" <> metavar "SECRET" <> value "secret" <> showDefault) + <*> option auto (long "pool" <> short 'o' <> help "max connections in database pool" <> metavar "COUNT" <> value 10 <> showDefault) defaultCorsPolicy :: CorsResourcePolicy defaultCorsPolicy = CorsResourcePolicy Nothing - ["GET", "POST", "PUT", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing + ["GET", "POST", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing (Just $ 60*60*24) False False True -- | CORS policy to be used in by Wai Cors middleware diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs new file mode 100644 index 000000000..7eda5dc8a --- /dev/null +++ b/src/PostgREST/DbStructure.hs @@ -0,0 +1,354 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeSynonymInstances #-} +module PostgREST.DbStructure ( + getDbStructure +, accessibleTables +, doesProcExist +, doesProcReturnJWT +) where + +import Control.Applicative +import Control.Monad (join) +import Data.Functor.Identity +import Data.List (elemIndex, find, subsequences, sort, transpose) +import Data.Maybe (fromMaybe, fromJust, isJust, mapMaybe, listToMaybe) +import Data.Monoid +import Data.Text (Text, split) +import qualified Hasql as H +import qualified Hasql.Postgres as P +import qualified Hasql.Backend as B +import PostgREST.PgQuery () +import PostgREST.Types + +import GHC.Exts (groupWith) +import Prelude + +getDbStructure :: Schema -> H.Tx P.Postgres s DbStructure +getDbStructure schema = do + tabs <- allTables + cols <- allColumns tabs + syns <- allSynonyms cols + rels <- allRelations tabs cols + keys <- allPrimaryKeys tabs + + let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels + cols' = addForeignKeys rels' cols + keys' = synonymousPrimaryKeys syns keys + + return DbStructure { + dbTables = tabs + , dbColumns = cols' + , dbRelations = rels' + , dbPrimaryKeys = keys' + } + +doesProc :: forall c s. B.CxValue c Int => + (Text -> Text -> B.Stmt c) -> Text -> Text -> H.Tx c s Bool +doesProc stmt schema proc = do + row :: Maybe (Identity Int) <- H.maybeEx $ stmt schema proc + return $ isJust row + +doesProcExist :: Text -> Text -> H.Tx P.Postgres s Bool +doesProcExist = doesProc [H.stmt| + SELECT 1 + FROM pg_catalog.pg_namespace n + JOIN pg_catalog.pg_proc p + ON pronamespace = n.oid + WHERE nspname = ? + AND proname = ? + |] + +doesProcReturnJWT :: Text -> Text -> H.Tx P.Postgres s Bool +doesProcReturnJWT = doesProc [H.stmt| + SELECT 1 + FROM pg_catalog.pg_namespace n + JOIN pg_catalog.pg_proc p + ON pronamespace = n.oid + WHERE nspname = ? + AND proname = ? + AND pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims' + |] + +accessibleTables :: [Table] -> H.Tx P.Postgres s [Table] +accessibleTables allTabs = do + accessible <- H.listEx $ [H.stmt| + SELECT + n.nspname AS table_schema, + c.relname AS table_name + FROM pg_class c + JOIN pg_namespace n ON n.oid = c.relnamespace + WHERE + c.relkind IN ('v','r','m') AND + n.nspname NOT IN ('pg_catalog', 'information_schema') AND ( + pg_has_role(c.relowner, 'USAGE'::text) OR + has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR + has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text) + ) + ORDER BY table_schema, table_name + |] + let isAccessible table = isJust $ find (\(s,n) -> tableSchema table == s && tableName table == n) accessible + return $ filter isAccessible allTabs + +synonymousColumns :: [(Column,Column)] -> [Column] -> [[Column]] +synonymousColumns allSyns cols = synCols' + where + syns = sort $ filter ((== colTable (head cols)) . colTable . fst) allSyns + synCols  = transpose $ map (\c -> map snd $ filter ((== c) . fst) syns) cols + synCols' = (filter sameTable . filter matchLength) synCols + matchLength cs = length cols == length cs + sameTable (c:cs) = all (\cc -> colTable c == colTable cc) (c:cs) + sameTable [] = False + +addForeignKeys :: [Relation] -> [Column] -> [Column] +addForeignKeys rels = map addFk + where + addFk col = col { colFK = fk col } + fk col = join $ relToFk col <$> find (lookupFn col) rels + lookupFn :: Column -> Relation -> Bool + lookupFn c (Relation{relColumns=cs, relType=rty}) = c `elem` cs && rty==Child + -- lookupFn _ _ = False + relToFk col (Relation{relColumns=cols, relFColumns=colsF}) = ForeignKey <$> colF + where + pos = elemIndex col cols + colF = (colsF !!) <$> pos + +addSynonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation] +addSynonymousRelations _ [] = [] +addSynonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ addSynonymousRelations syns rels + where + synRelsP = synRels (relColumns rel) (\t cs -> rel{relTable=t,relColumns=cs}) + synRelsF = synRels (relFColumns rel) (\t cs -> rel{relFTable=t,relFColumns=cs}) + synRels cols mapFn = map (\cs -> mapFn (colTable $ head cs) cs) $ synonymousColumns syns cols + +addParentRelations :: [Relation] -> [Relation] +addParentRelations [] = [] +addParentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : addParentRelations rels + +addManyToManyRelations :: [Relation] -> [Relation] +addManyToManyRelations rels = rels ++ mapMaybe link2Relation links + where + links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels + groupFn :: Relation -> Text + groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t + combinations k ns = filter ((k==).length) (subsequences ns) + link2Relation [ + Relation{relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c}, + Relation{ relColumns=lc2, relFTable=ft, relFColumns=fc} + ] + | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc Many (Just lt) (Just lc1) (Just lc2) + | otherwise = Nothing + link2Relation _ = Nothing + +raiseRelations :: Schema -> [(Column,Column)] -> [Relation] -> [Relation] +raiseRelations schema syns = map raiseRel + where + raiseRel rel + | tableSchema table == schema = rel + | isJust newCols = rel{relFTable=fromJust newTable,relFColumns=fromJust newCols} + | otherwise = rel + where + cols = relFColumns rel + table = relFTable rel + newCols = listToMaybe $ filter ((== schema) . tableSchema . colTable . head) (synonymousColumns syns cols) + newTable = (colTable . head) <$> newCols + +synonymousPrimaryKeys :: [(Column,Column)] -> [PrimaryKey] -> [PrimaryKey] +synonymousPrimaryKeys _ [] = [] +synonymousPrimaryKeys syns (key:keys) = key : newKeys ++ synonymousPrimaryKeys syns keys + where + keySyns = filter ((\c -> colTable c == pkTable key && colName c == pkName key) . fst) syns + newKeys = map ((\c -> PrimaryKey{pkTable=colTable c,pkName=colName c}) . snd) keySyns + +allTables :: H.Tx P.Postgres s [Table] +allTables = do + rows <- H.listEx $ [H.stmt| + SELECT + n.nspname AS table_schema, + c.relname AS table_name, + c.relkind = 'r' OR (c.relkind IN ('v','f')) + AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8 + OR (EXISTS + ( SELECT 1 + FROM pg_trigger + WHERE pg_trigger.tgrelid = c.oid + AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable + FROM pg_class c + JOIN pg_namespace n ON n.oid = c.relnamespace + WHERE c.relkind IN ('v','r','m') + AND n.nspname NOT IN ('pg_catalog', 'information_schema') + GROUP BY table_schema, table_name, insertable + ORDER BY table_schema, table_name + |] + return $ map tableFromRow rows + +tableFromRow :: (Text, Text, Bool) -> Table +tableFromRow (s, n, i) = Table s n i + +allColumns :: [Table] -> H.Tx P.Postgres s [Column] +allColumns tabs = do + cols <- H.listEx $ [H.stmt| + SELECT DISTINCT + info.table_schema AS schema, + info.table_name AS table_name, + info.column_name AS name, + info.ordinal_position AS position, + info.is_nullable::boolean AS nullable, + info.data_type AS col_type, + info.is_updatable::boolean AS updatable, + info.character_maximum_length AS max_len, + info.numeric_precision AS precision, + info.column_default AS default_value, + array_to_string(enum_info.vals, ',') AS enum + FROM ( + SELECT + table_schema, + table_name, + column_name, + ordinal_position, + is_nullable, + data_type, + is_updatable, + character_maximum_length, + numeric_precision, + column_default, + udt_name + FROM information_schema.columns + WHERE table_schema NOT IN ('pg_catalog', 'information_schema') + ) AS info + LEFT OUTER JOIN ( + SELECT + n.nspname AS s, + t.typname AS n, + array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals + FROM pg_type t + JOIN pg_enum e ON t.oid = e.enumtypid + JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace + GROUP BY s,n + ) AS enum_info ON (info.udt_name = enum_info.n) + ORDER BY schema, position + |] + return $ mapMaybe (columnFromRow tabs) cols + +columnFromRow :: [Table] -> + (Text, Text, Text, + Int, Bool, Text, + Bool, Maybe Int, Maybe Int, + Maybe Text, Maybe Text) + -> Maybe Column +columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table + where + buildColumn tbl = Column tbl n pos nul typ u l p d (parseEnum e) Nothing + table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs + parseEnum :: Maybe Text -> [Text] + parseEnum str = fromMaybe [] $ split (==',') <$> str + +allRelations :: [Table] -> [Column] -> H.Tx P.Postgres s [Relation] +allRelations tabs cols = do + rels <- H.listEx $ [H.stmt| + SELECT ns1.nspname AS table_schema, + tab.relname AS table_name, + column_info.cols AS columns, + ns2.nspname AS foreign_table_schema, + other.relname AS foreign_table_name, + column_info.refs AS foreign_columns + FROM pg_constraint, + LATERAL (SELECT array_agg(cols.attname) AS cols, + array_agg(cols.attnum) AS nums, + array_agg(refs.attname) AS refs + FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k, + LATERAL (SELECT * FROM pg_attribute + WHERE attrelid = conrelid AND attnum = col) + AS cols, + LATERAL (SELECT * FROM pg_attribute + WHERE attrelid = confrelid AND attnum = ref) + AS refs) + AS column_info, + LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1, + LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab, + LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other, + LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2 + WHERE confrelid != 0 + ORDER BY (conrelid, column_info.nums) + |] + return $ mapMaybe (relationFromRow tabs cols) rels + +relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation +relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) = + if isJust table && isJust tableF && length cols == length rcs && length colsF == length frcs + then Just $ Relation (fromJust table) cols (fromJust tableF) colsF Child Nothing Nothing Nothing + else Nothing + where + findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs + findCols s t cs = filter (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col `elem` cs) allCols + table = findTable rs rt + tableF = findTable frs frt + cols = findCols rs rt rcs + colsF = findCols frs frt frcs + +allPrimaryKeys :: [Table] -> H.Tx P.Postgres s [PrimaryKey] +allPrimaryKeys tabs = do + pks <- H.listEx $ [H.stmt| + SELECT + kc.table_schema, + kc.table_name, + kc.column_name + FROM + information_schema.table_constraints tc, + information_schema.key_column_usage kc + WHERE + tc.constraint_type = 'PRIMARY KEY' AND + kc.table_name = tc.table_name AND + kc.table_schema = tc.table_schema AND + kc.constraint_name = tc.constraint_name AND + kc.table_schema NOT IN ('pg_catalog', 'information_schema') + |] + return $ mapMaybe (pkFromRow tabs) pks + +pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey +pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n + where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs + +allSynonyms :: [Column] -> H.Tx P.Postgres s [(Column,Column)] +allSynonyms allCols = do + syns <- H.listEx $ [H.stmt| + WITH synonyms AS ( + SELECT + vcu.table_schema AS src_table_schema, + vcu.table_name AS src_table_name, + vcu.column_name AS src_column_name, + view.table_schema AS syn_table_schema, + view.table_name AS syn_table_name, + view.view_definition AS view_definition + FROM + information_schema.views AS view, + information_schema.view_column_usage AS vcu + WHERE + view.table_schema = vcu.view_schema AND + view.table_name = vcu.view_name AND + view.table_schema NOT IN ('pg_catalog', 'information_schema') AND + (SELECT COUNT(*) FROM information_schema.view_table_usage WHERE view_schema = view.table_schema AND view_name = view.table_name) = 1 + ) + SELECT + src_table_schema, src_table_name, src_column_name, + syn_table_schema, syn_table_name, + (regexp_matches(view_definition, CONCAT('\.(', src_column_name, ')(?=,|$)'), 'gn'))[1] + FROM synonyms + UNION ( + SELECT + src_table_schema, src_table_name, src_column_name, + syn_table_schema, syn_table_name, + (regexp_matches(view_definition, CONCAT('\.', src_column_name, '\sAS\s("?)(.+?)\1(,|$)'), 'gn'))[2] /* " <- for syntax highlighting */ + FROM synonyms + ) + |] + return $ mapMaybe (synonymFromRow allCols) syns + +synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column) +synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2 + where + col1 = findCol s1 t1 c1 + col2 = findCol s2 t2 c2 + findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs index 2c1567c51..4b12d07b8 100644 --- a/src/PostgREST/Main.hs +++ b/src/PostgREST/Main.hs @@ -1,39 +1,39 @@ module Main where -import PostgREST.PgStructure -import PostgREST.Types -import Network.Wai - import PostgREST.App -import PostgREST.Error (errResponse) +import PostgREST.Config (AppConfig (..), + minimumPgVersion, + prettyVersion, + readOptions) +import PostgREST.Error (errResponse, PgError) import PostgREST.Middleware +import PostgREST.DbStructure import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) +import Data.Aeson (encode) import Data.Functor.Identity import Data.Monoid ((<>)) import Data.String.Conversions (cs) import Data.Text (Text) import qualified Hasql as H import qualified Hasql.Postgres as P +import Network.Wai import Network.Wai.Handler.Warp hiding (Connection) import Network.Wai.Middleware.RequestLogger (logStdout) - import System.IO (BufferMode (..), hSetBuffering, stderr, stdin, stdout) -import PostgREST.Config (AppConfig (..), - prettyVersion, - readOptions, - minimumPgVersion) - isServerVersionSupported :: H.Session P.Postgres IO Bool isServerVersionSupported = do - Identity (row :: Text) <- H.tx Nothing $ H.singleEx $ [H.stmt|SHOW server_version_num|] + Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|] return $ read (cs row) >= minimumPgVersion +hasqlError :: PgError -> IO a +hasqlError = error . cs . encode + main :: IO () main = do hSetBuffering stdout LineBuffering @@ -43,55 +43,36 @@ main = do conf <- readOptions let port = configPort conf - unless (configSecure conf) $ - putStrLn "WARNING, running in insecure mode, auth will be in plaintext" unless ("secret" /= configJwtSecret conf) $ putStrLn "WARNING, running in insecure mode, JWT secret is the default value" Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String) - let pgSettings = P.ParamSettings (cs $ configDbHost conf) - (fromIntegral $ configDbPort conf) - (cs $ configDbUser conf) - (cs $ configDbPass conf) - (cs $ configDbName conf) + let pgSettings = P.StringSettings $ cs (configDatabase conf) appSettings = setPort port . setServerName (cs $ "postgrest/" <> prettyVersion) $ defaultSettings - middle = logStdout . defaultMiddle (configSecure conf) + middle = logStdout . defaultMiddle poolSettings <- maybe (fail "Improper session settings") return $ H.poolSettings (fromIntegral $ configPool conf) 30 pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings supportedOrError <- H.session pool isServerVersionSupported - either (fail . show) + either hasqlError (\supported -> unless supported $ - fail "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0" + error ( + "Cannot run in this PostgreSQL version, PostgREST needs at least " + <> show minimumPgVersion) ) supportedOrError let txSettings = Just (H.ReadCommitted, Just True) - metadata <- H.session pool $ H.tx txSettings $ do - tabs <- allTables - rels <- allRelations - cols <- allColumns rels - keys <- allPrimaryKeys - return (tabs, rels, cols, keys) - - dbstructure <- case metadata of - Left e -> fail $ show e - Right (tabs, rels, cols, keys) -> - return DbStructure { - tables=tabs - , columns=cols - , relations=rels - , primaryKeys=keys - } - + dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema conf) + dbStructure <- either hasqlError return dbOrError runSettings appSettings $ middle $ \ req respond -> do body <- strictRequestBody req resOrError <- liftIO $ H.session pool $ H.tx txSettings $ - authenticated conf (app dbstructure conf body) req + runWithClaims conf (app dbStructure conf body) req either (respond . errResponse) respond resOrError diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs index b2dfee16a..3144bc84f 100644 --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -4,91 +4,57 @@ module PostgREST.Middleware where import Data.Maybe (fromMaybe, isNothing) -import Data.Monoid import Data.Text import Data.String.Conversions (cs) +import Data.Time.Clock.POSIX (getPOSIXTime) import qualified Hasql as H import qualified Hasql.Postgres as P -import Network.HTTP.Types (RequestHeaders) -import Network.HTTP.Types.Header (hAccept, hAuthorization, - hLocation) -import Network.HTTP.Types.Status (status301, status400, status401, - status415) -import Network.URI (URI (..), parseURI) -import Network.Wai (Application, Request (..), - Response, isSecure, rawPathInfo, - rawQueryString, requestHeaders, - responseLBS) +import Network.HTTP.Types.Header (hAccept, hAuthorization) +import Network.HTTP.Types.Status (status415, status400) +import Network.Wai (Application, Request (..), Response, + requestHeaders, responseLBS) import Network.Wai.Middleware.Cors (cors) import Network.Wai.Middleware.Gzip (def, gzip) import Network.Wai.Middleware.Static (only, staticPolicy) -import Codec.Binary.Base64.String (decode) import PostgREST.App (contentTypeForAccept) -import PostgREST.Auth (DbRole, LoginAttempt (..), - setRole, setUserId, signInRole, - signInWithJWT) +import PostgREST.Auth (setRole, jwtClaims, claimsToSQL) import PostgREST.Config (AppConfig (..), corsPolicy) -import Prelude +import System.IO.Unsafe (unsafePerformIO) -authenticated :: forall s. AppConfig -> - (DbRole -> Request -> H.Tx P.Postgres s Response) -> +import Prelude hiding(concat) + +import qualified Data.Vector as V +import qualified Hasql.Backend as B +import qualified Data.Map.Lazy as M + +runWithClaims :: forall s. AppConfig -> + (Request -> H.Tx P.Postgres s Response) -> Request -> H.Tx P.Postgres s Response -authenticated conf app req = do - attempt <- httpRequesterRole (requestHeaders req) - case attempt of - MalformedAuth -> - return $ responseLBS status400 [] "Malformed basic auth header" - LoginFailed -> - return $ responseLBS status401 [] "Invalid username or password" - LoginSuccess role uid -> if role /= currentRole then runInRole role uid else app currentRole req - NoCredentials -> if anon /= currentRole then runInRole anon "" else app currentRole req - - where - jwtSecret = cs $ configJwtSecret conf - currentRole = cs $ configDbUser conf - anon = cs $ configAnonRole conf - httpRequesterRole :: RequestHeaders -> H.Tx P.Postgres s LoginAttempt - httpRequesterRole hdrs = do - let auth = fromMaybe "" $ lookup hAuthorization hdrs - case split (==' ') (cs auth) of - ("Basic" : b64 : _) -> - case split (==':') (cs . decode . cs $ b64) of - (u:p:_) -> signInRole u p - _ -> return MalformedAuth - ("Bearer" : jwt : _) -> - return $ signInWithJWT jwtSecret jwt - _ -> return NoCredentials - - runInRole :: Text -> Text -> H.Tx P.Postgres s Response - runInRole r uid = do - setUserId uid - setRole r - app r req - - -redirectInsecure :: Application -> Application -redirectInsecure app req respond = do - let hdrs = requestHeaders req - host = lookup "host" hdrs - uriM = parseURI . cs =<< mconcat [ - Just "https://", - host, - Just $ rawPathInfo req, - Just $ rawQueryString req] - isHerokuSecure = lookup "x-forwarded-proto" hdrs == Just "https" - - if not (isSecure req || isHerokuSecure) - then case uriM of - Just uri -> - respond $ responseLBS status301 [ - (hLocation, cs . show $ uri { uriScheme = "https:" }) - ] "" - Nothing -> - respond $ responseLBS status400 [] "SSL is required" - else app req respond +runWithClaims conf app req = do + _ <- H.unitEx $ stmt setAnon + let time = unsafePerformIO getPOSIXTime + case split (== ' ') (cs auth) of + ("Bearer" : tokenStr : _) -> + case jwtClaims jwtSecret tokenStr time of + Just claims -> + if M.member "role" claims + then do + mapM_ H.unitEx $ stmt <$> claimsToSQL claims + app req + else invalidJWT + _ -> invalidJWT + _ -> app req + where + stmt c = B.Stmt c V.empty True + hdrs = requestHeaders req + jwtSecret = (cs $ configJwtSecret conf) :: Text + auth = fromMaybe "" $ lookup hAuthorization hdrs + anon = cs $ configAnonRole conf + setAnon = setRole anon + invalidJWT = return $ responseLBS status400 [("Content-Type","application/json")] "{\"message\":\"Invalid JWT\"}" unsupportedAccept :: Application -> Application unsupportedAccept app req respond = do @@ -98,8 +64,9 @@ unsupportedAccept app req respond = do then respond $ responseLBS status415 [] "Unsupported Accept header, try: application/json" else app req respond -defaultMiddle :: Bool -> Application -> Application -defaultMiddle secure = (if secure then redirectInsecure else id) - . gzip def . cors corsPolicy +defaultMiddle :: Application -> Application +defaultMiddle = + gzip def + . cors corsPolicy . staticPolicy (only [("favicon.ico", "static/favicon.ico")]) . unsupportedAccept diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs index 0892eba0b..19ed87e8a 100644 --- a/src/PostgREST/Parsers.hs +++ b/src/PostgREST/Parsers.hs @@ -1,48 +1,27 @@ module PostgREST.Parsers -( parseGetRequest -) +-- ( parseGetRequest +-- ) where import Control.Applicative hiding ((<$>)) ---lines needed for ghc 7.8 -import Data.Functor ((<$>)) -import Data.Traversable (traverse) - -import Control.Monad (join) -import Data.List (delete, find) -import Data.Maybe import Data.Monoid import Data.String.Conversions (cs) import Data.Text (Text) import Data.Tree -import Network.Wai (Request, pathInfo, queryString) import PostgREST.Types import Text.ParserCombinators.Parsec hiding (many, (<|>)) - -parseGetRequest :: Request -> Either ParseError ApiRequest -parseGetRequest httpRequest = - foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts - where - apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++selectStr++">>") $ cs selectStr - addOrder (Node r f) o = Node r{order=o} f - flts = mapM pRequestFilter whereFilters - rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head - qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest] - orderStr = join $ lookup "order" qString - ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderStr++">>")) orderStr - selectStr = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qString --in case the parametre is missing or empty we default to * - whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ] +import PostgREST.PgQuery (operators) pRequestSelect :: Text -> Parser ApiRequest pRequestSelect rootNodeName = do fieldTree <- pFieldForest - return $ foldr treeEntry (Node (Select rootNodeName [] [] [] Nothing Nothing) []) fieldTree + return $ foldr treeEntry (Node (Select [] [rootNodeName] [] Nothing, (rootNodeName, Nothing)) []) fieldTree where treeEntry :: Tree SelectItem -> ApiRequest -> ApiRequest - treeEntry (Node fld@((fn, _),_) fldForest) (Node rNode rForest) = + treeEntry (Node fld@((fn, _),_) fldForest) (Node (q, i) rForest) = case fldForest of - [] -> Node (rNode {fields=fld:fields rNode}) rForest - _ -> Node rNode (foldr treeEntry (Node (Select fn [] [] [] Nothing Nothing) []) fldForest:rForest) + [] -> Node (q {select=fld:select q}, i) rForest + _ -> Node (q, i) (foldr treeEntry (Node (Select [] [fn] [] Nothing, (fn, Nothing)) []) fldForest:rForest) pRequestFilter :: (String, String) -> Either ParseError (Path, Filter) pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val) @@ -54,21 +33,6 @@ pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val) op = fst <$> opVal val = snd <$> opVal -addFilter :: (Path, Filter) -> ApiRequest -> ApiRequest -addFilter ([], flt) (Node rn@(Select {filters=flts}) forest) = Node (rn {filters=flt:flts}) forest -addFilter (path, flt) (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) - where - targetNodeName:remainingPath = path - (targetNode,restForest) = splitForest targetNodeName forest - splitForest name forst = - case maybeNode of - Nothing -> (Nothing,forest) - Just node -> (Just node, delete node forest) - where maybeNode = find ((name==).mainTable.rootLabel) forst - ws :: Parser Text ws = cs <$> many (oneOf " \t") @@ -82,22 +46,20 @@ pTreePath = do let pp = map cs p jpp = map cs <$> jp return (init pp, (last pp, jpp)) - where - pFieldForest :: Parser [Tree SelectItem] pFieldForest = pFieldTree `sepBy1` lexeme (char ',') pFieldTree :: Parser (Tree SelectItem) -pFieldTree = try (Node <$> pSelect <*> ( char '(' *> pFieldForest <* char ')')) - <|> Node <$> pSelect <*> pure [] +pFieldTree = try (Node <$> pSelect <*> 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_])") + "field name (* or [a..z0..9_])") pJsonPathStep :: Parser Text pJsonPathStep = cs <$> try (string "->" *> pFieldName) @@ -116,22 +78,8 @@ pSelect = lexeme $ return ((s, Nothing), Nothing) pOperator :: Parser Operator -pOperator = cs <$> ( try (string "lte") -- has to be before lt - <|> try (string "lt") - <|> try (string "eq") - <|> try (string "gte") -- has to be before gh - <|> try (string "gt") - <|> try (string "lt") - <|> try (string "neq") - <|> try (string "like") - <|> try (string "ilike") - <|> try (string "in") - <|> try (string "notin") - <|> try (string "is" ) - <|> try (string "isnot") - <|> try (string "@@") - "operator (eq, gt, ...)" - ) +pOperator = cs <$> (pOp "operator (eq, gt, ...)") + where pOp = foldl (<|>) empty $ map (try . string . cs . fst) operators pValue :: Parser FValue pValue = VText <$> (cs <$> many anyChar) diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs index c8d14003c..b9da99a49 100644 --- a/src/PostgREST/PgQuery.hs +++ b/src/PostgREST/PgQuery.hs @@ -3,14 +3,48 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module PostgREST.PgQuery where +module PostgREST.PgQuery ( + fromQi +, insertableValue +, wrapQuery +, asJson +, callProc +, unquoted +, operators + +-- format functions +, pgFmtLit +, pgFmtIdent +, pgFmtValue +, pgFmtCondition +, pgFmtColumn +, pgFmtJsonPath +, pgFmtTable +, pgFmtField +, pgFmtSelectItem +, pgFmtAsJsonPath + +-- query fragments +, sourceSubqueryName +, orderF +, countNoneF +, countAllF +, countF +, locationF +, asCsvF +, asJsonSingleF +, asJsonF +, selectStarF + +, StatementT +) where import qualified Hasql as H import qualified Hasql.Backend as B import qualified Hasql.Postgres as P import PostgREST.RangeQuery -import PostgREST.Types (OrderTerm (..), QualifiedIdentifier(..)) +import PostgREST.Types import Control.Monad (join) import qualified Data.Aeson as JSON @@ -25,11 +59,10 @@ import Data.Scientific (FPFormat (..), formatScientific, import Data.String.Conversions (cs) import qualified Data.Text as T import Data.Vector (empty) -import qualified Data.Vector as V -import qualified Network.HTTP.Types.URI as Net import Text.Regex.TDFA ((=~)) import Prelude +import qualified Data.Map as M type PStmt = H.Stmt P.Postgres instance Monoid PStmt where @@ -37,81 +70,35 @@ instance Monoid PStmt where B.Stmt (query <> query') (params <> params') (prep && prep') mempty = B.Stmt "" empty True type StatementT = PStmt -> PStmt +data JsonbPath = + ColIdentifier T.Text + | KeyIdentifier T.Text + | SingleArrow JsonbPath JsonbPath + | DoubleArrow JsonbPath JsonbPath + deriving (Show) -limitT :: Maybe NonnegRange -> StatementT -limitT r q = - q <> B.Stmt (" LIMIT " <> limit <> " OFFSET " <> offset <> " ") empty True - where - limit = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r - offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r +operators :: [(T.Text, T.Text)] +operators = [ + ("eq", "="), + ("gte", ">="), -- has to be before gt (parsers) + ("gt", ">"), + ("lte", "<="), -- has to be before lt (parsers) + ("lt", "<"), + ("neq", "<>"), + ("like", "like"), + ("ilike", "ilike"), + ("in", "in"), + ("notin", "not in"), + ("isnot", "is not"), -- has to be before is (parsers) + ("is", "is"), + ("@@", "@@"), + ("@>", "@>"), + ("<@", "<@") + ] -whereT :: QualifiedIdentifier -> Net.Query -> StatementT -whereT table params q = - if L.null cols - then q - else q <> B.Stmt " where " empty True <> conjunction - where - cols = [ col | col <- params, fst col `notElem` ["order","select"] ] - wherePredTable = wherePred table - conjunction = mconcat $ L.intersperse andq (map wherePredTable cols) - -withT :: PStmt -> T.Text -> StatementT -withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) = - B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq <> " from " <> v) - (ep <> wp) - (epre && wpre) - -orderT :: [OrderTerm] -> StatementT -orderT ts q = - if L.null ts - then q - else q <> B.Stmt " order by " empty True <> clause - where - clause = mconcat $ L.intersperse commaq (map queryTerm ts) - queryTerm :: OrderTerm -> PStmt - queryTerm t = B.Stmt - (" " <> cs (pgFmtIdent $ otTerm t) <> " " - <> cs (otDirection t) <> " " - <> maybe "" cs (otNullOrder t) <> " ") - empty True - -parentheticT :: StatementT -parentheticT s = - s { B.stmtTemplate = " (" <> B.stmtTemplate s <> ") " } - -iffNotT :: PStmt -> StatementT -iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) = - B.Stmt - ("WITH aaa AS (" <> aq <> " returning *) " <> - bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)") - (ap <> bp) - (apre && bpre) - -countT :: StatementT -countT s = - s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" } - -countRows :: QualifiedIdentifier -> PStmt -countRows t = B.Stmt ("select pg_catalog.count(1) from " <> fromQi t) empty True - -countNone :: PStmt -countNone = B.Stmt "select null" empty True - -asCsvWithCount :: QualifiedIdentifier -> StatementT -asCsvWithCount table = withCount . asCsv table - -asCsv :: QualifiedIdentifier -> StatementT -asCsv table s = s { - B.stmtTemplate = - "(select string_agg(quote_ident(column_name::text), ',') from " - <> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '" - <> fromQi table <> "' order by ordinal_position) h) || '\r' || " - <> "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '') from (" - <> B.stmtTemplate s <> ") t" } - -asJsonWithCount :: StatementT -asJsonWithCount = withCount . asJson +operatorsMap :: M.Map T.Text T.Text +operatorsMap = M.fromList operators asJson :: StatementT asJson s = s { @@ -119,56 +106,6 @@ asJson s = s { "array_to_json(coalesce(array_agg(row_to_json(t)), '{}'))::character varying from (" <> B.stmtTemplate s <> ") t" } -withCount :: StatementT -withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s } - -asJsonRow :: StatementT -asJsonRow s = s { B.stmtTemplate = "row_to_json(t) from (" <> B.stmtTemplate s <> ") t" } - -returningStarT :: StatementT -returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" } - -deleteFrom :: QualifiedIdentifier -> PStmt -deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True - -insertInto :: QualifiedIdentifier - -> V.Vector T.Text - -> V.Vector (V.Vector JSON.Value) - -> PStmt -insertInto t cols vals - | V.null cols = B.Stmt ("insert into " <> fromQi t <> " default values returning *") empty True - | otherwise = B.Stmt - ("insert into " <> fromQi t <> " (" <> - T.intercalate ", " (V.toList $ V.map pgFmtIdent cols) <> - ") values " - <> T.intercalate ", " - (V.toList $ V.map (\v -> "(" - <> T.intercalate ", " (V.toList $ V.map insertableValue v) - <> ")" - ) vals - ) - <> " returning row_to_json(" <> fromQi t <> ".*)") - empty True - -insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt -insertSelect t [] _ = B.Stmt - ("insert into " <> fromQi t <> " default values returning *") empty True -insertSelect t cols vals = B.Stmt - ("insert into " <> fromQi t <> " (" - <> T.intercalate ", " (map pgFmtIdent cols) - <> ") select " - <> T.intercalate ", " (map insertableValue vals)) - empty True - -update :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt -update t cols vals = B.Stmt - ("update " <> fromQi t <> " set (" - <> T.intercalate ", " (map pgFmtIdent cols) - <> ") = (" - <> T.intercalate ", " (map insertableValue vals) - <> ")") - empty True - callProc :: QualifiedIdentifier -> JSON.Object -> PStmt callProc qi params = do let args = T.intercalate "," $ map assignment (H.toList params) @@ -176,116 +113,19 @@ callProc qi params = do where assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v -wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt -wherePred table (col, predicate) = - B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <> - if opCode `elem` ["is","isnot"] then whiteList value - else cs sqlValue) - empty True - - where - headPredicate:rest = T.split (=='.') $ cs $ fromMaybe "." predicate - hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse - opCode = hasNot (head rest) headPredicate - notOp = hasNot headPredicate "" - value = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest) - sqlValue = pgFmtValue opCode value - op = pgFmtOperator opCode - - whiteList :: T.Text -> T.Text whiteList val = fromMaybe (cs (pgFmtLit val) <> "::unknown ") (L.find ((==) . T.toLower $ val) ["null","true","false"]) -pgFmtValue :: T.Text -> T.Text -> T.Text -pgFmtValue opCode value = - case opCode of - "like" -> unknownLiteral $ T.map star value - "ilike" -> unknownLiteral $ T.map star value - "in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") " - "notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") " - "@@" -> "to_tsquery(" <> unknownLiteral value <> ") " - _ -> unknownLiteral value - where - star c = if c == '*' then '%' else c - unknownLiteral = (<> "::unknown ") . pgFmtLit - -pgFmtOperator :: T.Text -> T.Text -pgFmtOperator opCode = - case opCode of - "eq" -> "=" - "gt" -> ">" - "lt" -> "<" - "gte" -> ">=" - "lte" -> "<=" - "neq" -> "<>" - "like"-> "like" - "ilike"-> "ilike" - "in" -> "in" - "notin" -> "not in" - "is" -> "is" - "isnot" -> "is not" - "@@" -> "@@" - _ -> "=" - -commaq :: PStmt -commaq = B.Stmt ", " empty True - -andq :: PStmt -andq = B.Stmt " and " empty True - -data JsonbPath = - ColIdentifier T.Text - | KeyIdentifier T.Text - | SingleArrow JsonbPath JsonbPath - | DoubleArrow JsonbPath JsonbPath - deriving (Show) - -parseJsonbPath :: T.Text -> Maybe JsonbPath -parseJsonbPath p = - case T.splitOn "->>" p of - [a,b] -> - let i:is = T.splitOn "->" a in - Just $ DoubleArrow - (foldl SingleArrow (ColIdentifier i) (map KeyIdentifier is)) - (KeyIdentifier b) - _ -> Nothing - -pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text -pgFmtJsonbPath table p = - pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p) - where - pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i - pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i - pgFmtJsonbPath' (SingleArrow a b) = - pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b - pgFmtJsonbPath' (DoubleArrow a b) = - pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b - -pgFmtIdent :: T.Text -> T.Text -pgFmtIdent x = - let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in - if (cs escaped :: BS.ByteString) =~ danger - then "\"" <> escaped <> "\"" - else escaped - - where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString - -pgFmtLit :: T.Text -> T.Text -pgFmtLit x = - let trimmed = trimNullChars x - escaped = "'" <> T.replace "'" "''" trimmed <> "'" - slashed = T.replace "\\" "\\\\" escaped in - if T.isInfixOf "\\\\" escaped - then "E" <> slashed - else slashed - trimNullChars :: T.Text -> T.Text trimNullChars = T.takeWhile (/= '\x0') fromQi :: QualifiedIdentifier -> T.Text -fromQi t = pgFmtIdent (qiSchema t) <> "." <> pgFmtIdent (qiName t) +fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n + where + n = qiName t + s = qiSchema t unquoted :: JSON.Value -> T.Text unquoted (JSON.String t) = t @@ -301,6 +141,169 @@ insertableValue :: JSON.Value -> T.Text insertableValue JSON.Null = "null" insertableValue v = insertableText $ unquoted v -paramFilter :: JSON.Value -> T.Text -paramFilter JSON.Null = "is.null" -paramFilter v = "eq." <> unquoted v +wrapQuery :: T.Text -> [T.Text] -> T.Text -> Maybe NonnegRange -> T.Text +wrapQuery source selectColumns returnSelect range = + withSourceF source <> + " SELECT " <> + T.intercalate ", " selectColumns <> + " " <> + fromF returnSelect ( limitF range ) + + +-- query fragments +sourceSubqueryName :: T.Text +sourceSubqueryName = "pg_source" + +withSourceF :: T.Text -> T.Text +withSourceF s = "WITH " <> sourceSubqueryName <> " AS (" <> s <>")" + +countF :: T.Text +countF = "pg_catalog.count(t)" + +countAllF :: T.Text +countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )" + +countNoneF :: T.Text +countNoneF = "null" + +asJsonF :: T.Text +asJsonF = "array_to_json(array_agg(row_to_json(t)))::character varying" + +asJsonSingleF :: T.Text --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element +asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying " + +asCsvF :: T.Text +asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF + +asCsvHeaderF :: T.Text +asCsvHeaderF = + "(SELECT string_agg(a.k, ',')" <> + " FROM (" <> + " SELECT json_object_keys(r)::TEXT as k" <> + " FROM ( " <> + " SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <> + " ) s" <> + " ) a" <> + ")" + +asCsvBodyF :: T.Text +asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')" + +selectStarF :: T.Text +selectStarF = "SELECT * FROM " <> sourceSubqueryName + +fromF :: T.Text -> T.Text -> T.Text +fromF sel limit = "FROM (" <> sel <> " " <> limit <> ") t" + +limitF :: Maybe NonnegRange -> T.Text +limitF r = "LIMIT " <> limit <> " OFFSET " <> offset + where + limit = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r + offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r + +locationF :: [T.Text] -> T.Text +locationF pKeys = + "(" <> + " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss limit 1)" <> + " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <> + " FROM s, json_each_text(s.r) AS json_data" <> + ( + if null pKeys + then "" + else " WHERE json_data.key IN ('" <> T.intercalate "','" pKeys <> "')" + ) <> + ")" + +orderF :: [OrderTerm] -> T.Text +orderF ts = + if L.null ts + then "" + else "ORDER BY " <> clause + where + clause = T.intercalate "," (map queryTerm ts) + queryTerm :: OrderTerm -> T.Text + queryTerm t = " " + <> cs (pgFmtIdent $ otTerm t) <> " " + <> cs (otDirection t) <> " " + <> maybe "" cs (otNullOrder t) <> " " + +-- formating functions + +pgFmtValue :: T.Text -> T.Text -> T.Text +pgFmtValue opCode val = + case opCode of + "like" -> unknownLiteral $ T.map star val + "ilike" -> unknownLiteral $ T.map star val + "in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") " + "notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") " + "@@" -> "to_tsquery(" <> unknownLiteral val <> ") " + _ -> unknownLiteral val + where + star c = if c == '*' then '%' else c + unknownLiteral = (<> "::unknown ") . pgFmtLit + +pgFmtOperator :: T.Text -> T.Text +pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap + +pgFmtIdent :: T.Text -> T.Text +pgFmtIdent x = + let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in + if (cs escaped :: BS.ByteString) =~ danger + then "\"" <> escaped <> "\"" + else escaped + + where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString + +pgFmtLit :: T.Text -> T.Text +pgFmtLit x = + let trimmed = trimNullChars x + escaped = "'" <> T.replace "'" "''" trimmed <> "'" + slashed = T.replace "\\" "\\\\" escaped in + if T.isInfixOf "\\\\" escaped + then "E" <> slashed + else slashed + +pgFmtCondition :: QualifiedIdentifier -> Filter -> T.Text +pgFmtCondition table (Filter (col,jp) ops val) = + notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <> + if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue + where + headPredicate:rest = T.split (=='.') ops + hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse + opCode = hasNot (head rest) headPredicate + notOp = hasNot headPredicate "" + sqlCol = case val of + VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp + VForeignKey qi _ -> pgFmtColumn qi col + sqlValue = valToStr val + getInner v = case v of + VText s -> s + _ -> "" + valToStr v = case v of + VText s -> pgFmtValue opCode s + VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc + where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft + _ -> "" + +pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text +pgFmtColumn table "*" = fromQi table <> ".*" +pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c + +pgFmtJsonPath :: Maybe JsonPath -> T.Text +pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x +pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs ) +pgFmtJsonPath _ = "" + +pgFmtTable :: Table -> T.Text +pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n + +pgFmtField :: QualifiedIdentifier -> Field -> T.Text +pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp + +pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> T.Text +pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp +pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp + +pgFmtAsJsonPath :: Maybe JsonPath -> T.Text +pgFmtAsJsonPath Nothing = "" +pgFmtAsJsonPath (Just xx) = " AS " <> last xx diff --git a/src/PostgREST/PgStructure.hs b/src/PostgREST/PgStructure.hs deleted file mode 100644 index 4fa3d35be..000000000 --- a/src/PostgREST/PgStructure.hs +++ /dev/null @@ -1,264 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeSynonymInstances #-} -module PostgREST.PgStructure where - -import Control.Applicative -import Control.Monad (join) -import Data.Functor.Identity -import Data.List (elemIndex, find) -import Data.Maybe (fromMaybe, isJust, mapMaybe) -import Data.Monoid -import Data.Text (Text, split) -import qualified Hasql as H -import qualified Hasql.Postgres as P -import PostgREST.PgQuery () -import PostgREST.Types - -import GHC.Exts (groupWith) -import Prelude - - -doesProcExist :: Text -> Text -> H.Tx P.Postgres s Bool -doesProcExist schema proc = do - row :: Maybe (Identity Int) <- H.maybeEx $ [H.stmt| - SELECT 1 - FROM pg_catalog.pg_namespace n - JOIN pg_catalog.pg_proc p - ON pronamespace = n.oid - WHERE nspname = ? - AND proname = ? - |] schema proc - return $ isJust row - - -tableFromRow :: (Text, Text, Bool, Maybe Text) -> Table -tableFromRow (s, n, i, a) = Table s n i (parseAcl a) - where - parseAcl :: Maybe Text -> [Text] - parseAcl str = fromMaybe [] $ split (==',') <$> str - -columnFromRow :: (Text, Text, Text, - Int, Bool, Text, - Bool, Maybe Int, Maybe Int, - Maybe Text, Maybe Text) - -> Column -columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) = - Column s t n pos nul typ u l p d (parseEnum e) Nothing - - where - parseEnum :: Maybe Text -> [Text] - parseEnum str = fromMaybe [] $ split (==',') <$> str - - -relationFromRow :: (Text, Text, [Text], Text, [Text]) -> Relation -relationFromRow (s, t, cs, ft, fcs) = Relation s t cs ft fcs Child Nothing Nothing Nothing - -pkFromRow :: (Text, Text, Text) -> PrimaryKey -pkFromRow (s, t, n) = PrimaryKey s t n - - -addParentRelation :: Relation -> [Relation] -> [Relation] -addParentRelation rel@(Relation s t c ft fc _ _ _ _) rels = Relation s ft fc t c Parent Nothing Nothing Nothing:rel:rels - -allTables :: H.Tx P.Postgres s [Table] -allTables = do - rows <- H.listEx $ [H.stmt| - SELECT - n.nspname AS table_schema, - c.relname AS table_name, - c.relkind = 'r' OR (c.relkind IN ('v','f')) - AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8 - OR (EXISTS - ( SELECT 1 - FROM pg_trigger - WHERE pg_trigger.tgrelid = c.oid - AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable, - array_to_string(array_agg(r.rolname), ',') AS acl - FROM pg_class c - CROSS JOIN pg_roles r - JOIN pg_namespace n ON n.oid = c.relnamespace - WHERE c.relkind IN ('v','r','m') - AND n.nspname NOT IN ('pg_catalog', 'information_schema') - AND ( - pg_has_role(r.rolname, c.relowner, 'USAGE'::text) OR - has_table_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR - has_any_column_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text) ) - - GROUP BY table_schema, table_name, insertable - ORDER BY table_schema, table_name - |] - return $ map tableFromRow rows - -allRelations :: H.Tx P.Postgres s [Relation] -allRelations = do - rels <- H.listEx $ [H.stmt| - WITH table_fk AS ( - SELECT ns.nspname AS table_schema, - tab.relname AS table_name, - column_info.cols AS columns, - other.relname AS foreign_table_name, - column_info.refs AS foreign_columns - FROM pg_constraint, - LATERAL (SELECT array_agg(cols.attname) AS cols, - array_agg(cols.attnum) AS nums, - array_agg(refs.attname) AS refs - FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k, - LATERAL (SELECT * FROM pg_attribute - WHERE attrelid = conrelid AND attnum = col) - AS cols, - LATERAL (SELECT * FROM pg_attribute - WHERE attrelid = confrelid AND attnum = ref) - AS refs) - AS column_info, - LATERAL (SELECT * FROM pg_namespace - WHERE pg_namespace.oid = connamespace) AS ns, - LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab, - LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other - WHERE confrelid != 0 - ORDER BY (conrelid, column_info.nums) - ) - - SELECT * FROM table_fk - UNION - ( - SELECT - vcu.table_schema, - vcu.view_name AS table_name, - array_agg(vcu.column_name::text) AS columns, - table_fk.foreign_table_name, - table_fk.foreign_columns - FROM information_schema.view_column_usage as vcu - JOIN table_fk ON - table_fk.table_schema = vcu.view_schema AND - table_fk.table_name = vcu.table_name AND - vcu.column_name = ANY (table_fk.columns) - WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema') - AND columns = table_fk.columns - GROUP BY vcu.table_schema, vcu.view_name, table_fk.foreign_table_name, table_fk.foreign_columns - ) - UNION - ( - SELECT - vcu.view_schema as table_schema, - table_fk.table_name, - table_fk.columns, - vcu.view_name as foreign_table_name, - array_agg(vcu.column_name::text) as foreign_columns - FROM information_schema.view_column_usage as vcu - JOIN table_fk ON - table_fk.table_schema = vcu.view_schema AND - table_fk.foreign_table_name = vcu.table_name AND - vcu.column_name = ANY (table_fk.foreign_columns) - WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema') - AND foreign_columns = table_fk.foreign_columns - GROUP BY vcu.view_schema, table_fk.table_name, vcu.view_name, table_fk.columns - ) - |] - let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels - let links = filter ((==2).length) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations - return $ simpleRelations ++ mapMaybe link2Relation links - where - groupFn :: Relation -> Text - groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t - link2Relation [ - Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c}, - Relation{ relColumns=lc2, relFTable=ft, relFColumns=fc} - ] = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2) - link2Relation _ = Nothing - -allColumns :: [Relation] -> H.Tx P.Postgres s [Column] -allColumns rels = do - cols <- H.listEx $ [H.stmt| - SELECT - info.table_schema AS schema, - info.table_name AS table_name, - info.column_name AS name, - info.ordinal_position AS position, - info.is_nullable::boolean AS nullable, - info.data_type AS col_type, - info.is_updatable::boolean AS updatable, - info.character_maximum_length AS max_len, - info.numeric_precision AS precision, - info.column_default AS default_value, - array_to_string(enum_info.vals, ',') AS enum - FROM ( - SELECT - table_schema, - table_name, - column_name, - ordinal_position, - is_nullable, - data_type, - is_updatable, - character_maximum_length, - numeric_precision, - column_default, - udt_name - FROM information_schema.columns - WHERE table_schema NOT IN ('pg_catalog', 'information_schema') - ) AS info - LEFT OUTER JOIN ( - SELECT - n.nspname AS s, - t.typname AS n, - array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals - FROM pg_type t - JOIN pg_enum e ON t.oid = e.enumtypid - JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace - GROUP BY s,n - ) AS enum_info ON (info.udt_name = enum_info.n) - ORDER BY schema, position - |] - return $ map (addFK . columnFromRow) cols - - where - addFK col = col { colFK = fk col } - fk col = join $ relToFk (colName col) <$> find (lookupFn col) rels - lookupFn :: Column -> Relation -> Bool - lookupFn (Column{colSchema=cs, colTable=ct, colName=cn}) (Relation{relSchema=rs, relTable=rt, relColumns=rc, relType=rty}) = - cs==rs && ct==rt && cn `elem` rc && rty==Child - lookupFn _ _ = False - relToFk cName (Relation{relFTable=t, relColumns=cs, relFColumns=fcs}) = ForeignKey t <$> c - where - pos = elemIndex cName cs - c = (fcs !!) <$> pos - -allPrimaryKeys :: H.Tx P.Postgres s [PrimaryKey] -allPrimaryKeys = do - pks <- H.listEx $ [H.stmt| - WITH table_pk AS ( - SELECT - kc.table_schema, - kc.table_name, - kc.column_name - FROM - information_schema.table_constraints tc, - information_schema.key_column_usage kc - WHERE - tc.constraint_type = 'PRIMARY KEY' AND - kc.table_name = tc.table_name AND - kc.table_schema = tc.table_schema AND - kc.constraint_name = tc.constraint_name AND - kc.table_schema NOT IN ('pg_catalog', 'information_schema') - ) - SELECT table_schema, - table_name, - column_name - FROM table_pk - UNION ( - SELECT - vcu.view_schema, - vcu.view_name, - vcu.column_name - FROM information_schema.view_column_usage AS vcu - JOIN - table_pk ON table_pk.table_schema = vcu.view_schema AND - table_pk.table_name = vcu.table_name AND - table_pk.column_name = vcu.column_name - WHERE vcu.view_schema NOT IN ('pg_catalog','information_schema') - ) - |] - return $ map pkFromRow pks diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index 346786bcd..e80849091 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TupleSections #-} module PostgREST.QueryBuilder where @@ -6,160 +7,148 @@ import Control.Error import Data.List (find) import Data.Monoid import Data.Text hiding (filter, find, foldr, head, last, map, - null, zipWith) + null, zipWith, concatMap) import Control.Applicative import Data.Tree -import PostgREST.PgQuery (PStmt, fromQi, - orderT, pgFmtIdent, pgFmtLit, pgFmtOperator, - pgFmtValue, whiteList) +import PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem, + pgFmtIdent, pgFmtCondition, + insertableValue, orderF, sourceSubqueryName, pgFmtJsonPath) import PostgREST.Types -import qualified Data.Vector as V (empty) -import qualified Hasql.Backend as B +import qualified Data.Map as M -findRelation :: [Relation] -> Text -> Text -> Text -> Maybe Relation +findRelation :: [Relation] -> Schema -> Text -> Text -> Maybe Relation findRelation allRelations s t1 t2 = - find (\r -> s == relSchema r && t1 == relTable r && t2 == relFTable r) allRelations + find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations -addRelations :: Text -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest -addRelations schema allRelations parentNode node@(Node query@(Select {mainTable=table}) forest) = +addRelations :: Schema -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest +addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) = case parentNode of - Nothing -> Node query{relation=Nothing} <$> updatedForest - (Just (Node (Select{mainTable=parentTable}) _)) -> Node <$> (addRel query <$> rel) <*> updatedForest + Nothing -> Node (query, (table, Nothing)) <$> updatedForest + (Just (Node (_, (parentTable, _)) _)) -> Node <$> (addRel n <$> rel) <*> updatedForest where rel = note ("no relation between " <> table <> " and " <> parentTable) $ findRelation allRelations schema table parentTable <|> findRelation allRelations schema parentTable table - addRel :: Query -> Relation -> Query - addRel q r = q{relation = Just r} + addRel :: (Query, (NodeName, Maybe Relation)) -> Relation -> (Query, (NodeName, Maybe Relation)) + addRel (q, (t, _)) r = (q, (t, Just r)) where updatedForest = mapM (addRelations schema allRelations (Just node)) forest getJoinConditions :: Relation -> [Filter] -getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) = +getJoinConditions (Relation t cs ft fcs typ lt lc1 lc2) = case typ of - Child -> zipWith (toFilter t ft) cs fcs - Parent -> zipWith (toFilter t ft) cs fcs - Many -> zipWith (toFilter t (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" lt)) fcs (fromMaybe [] lc2) + Child -> zipWith (toFilter tN ftN) cs fcs + Parent -> zipWith (toFilter tN ftN) cs fcs + Many -> zipWith (toFilter tN ltN) cs (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2) where - toFilter :: Text -> Text -> FieldName -> FieldName -> Filter - toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc)) + s = tableSchema t + tN = tableName t + ftN = tableName ft + ltN = fromMaybe "" (tableName <$> lt) + toFilter :: Text -> Text -> Column -> Column -> Filter + toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}})) -addJoinConditions :: Text -> [Column] -> ApiRequest -> Either Text ApiRequest -addJoinConditions schema allColumns (Node query@(Select{relation=r}) forest) = +addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest +addJoinConditions schema (Node (query, (n, r)) forest) = case r of - Nothing -> Node updatedQuery <$> updatedForest -- this is the root node - Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel)) <$> updatedForest - Just (Relation{relType=Parent}) -> Node updatedQuery <$> updatedForest + 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 Just rel@(Relation{relType=Many, relLTable=(Just linkTable)}) -> - Node <$> pure qq <*> updatedForest + Node (qq, (n, r)) <$> updatedForest where q = addCond updatedQuery (getJoinConditions rel) - qq = q{joinTables=linkTable:joinTables q} - _ -> Left "unknow relation" + qq = q{from=tableName linkTable : from q} + _ -> Left "unknown relation" where -- add parentTable and parentJoinConditions to the query - updatedQuery = foldr (flip addCond) (query{joinTables = parentTables ++ joinTables query}) parentJoinConditions + updatedQuery = foldr (flip addCond) (query{from = parentTables ++ from query}) parentJoinConditions where - parentJoinConditions = map (getJoinConditions.snd) parents + parentJoinConditions = map (getJoinConditions . snd) parents parentTables = map fst parents - parents = mapMaybe (getParents.rootLabel) forest - getParents qq@(Select{relation=(Just rel@(Relation{relType=Parent}))}) = Just (mainTable qq, rel) + parents = mapMaybe (getParents . rootLabel) forest + getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel) getParents _ = Nothing - updatedForest = mapM (addJoinConditions schema allColumns) forest - addCond q con = q{filters=con ++ filters q} + updatedForest = mapM (addJoinConditions schema) forest + addCond q con = q{where_=con ++ where_ q} -requestToCountQuery :: Text -> ApiRequest -> PStmt -requestToCountQuery schema (Node (Select mainTbl _ _ conditions _ _) _) = - B.Stmt query V.empty True +emptyOnNull :: Text -> [a] -> Text +emptyOnNull val x = if null x then "" else val + +requestToQuery :: Text -> ApiRequest -> Text +requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest) = + query where + -- TODO! the folloing helper functions are just to remove the "schema" part when the table is "source" which is the name + -- of our WITH query part + tblSchema tbl = if tbl == sourceSubqueryName then "" else schema + qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl + toQi t = QualifiedIdentifier (tblSchema t) t query = Data.Text.unwords [ - "SELECT pg_catalog.count(1)", - "FROM ", fromQi $ QualifiedIdentifier schema mainTbl, - ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions - ] - emptyOnNull val x = if null x then "" else val - localConditions = filter fn conditions - where - fn (Filter{value=VText _}) = True - fn (Filter{value=VForeignKey _ _}) = False - -requestToQuery :: Text -> ApiRequest -> PStmt -requestToQuery schema (Node (Select mainTbl colSelects tbls conditions ord _) forest) = - orderT (fromMaybe [] ord) query - where - query = B.Stmt qStr V.empty True - qStr = Data.Text.unwords [ ("WITH " <> intercalate ", " withs) `emptyOnNull` withs, - "SELECT ", intercalate ", " (map (pgFmtSelectItem (QualifiedIdentifier schema mainTbl)) colSelects ++ selects), - "FROM ", intercalate ", " (map (fromQi . QualifiedIdentifier schema) (mainTbl:tbls)), - ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl) ) conditions )) `emptyOnNull` conditions + "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects), + "FROM ", intercalate ", " (map (fromQi . toQi) tbls), + ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, + orderF (fromMaybe [] ord) ] - emptyOnNull val x = if null x then "" else val (withs, selects) = foldr getQueryParts ([],[]) forest - getQueryParts :: Tree Query -> ([Text], [Text]) -> ([Text], [Text]) - getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation {relType=Child}))}) forst) (w,s) = (w,sel:s) + getQueryParts :: Tree ApiNode -> ([Text], [Text]) -> ([Text], [Text]) + getQueryParts (Node n@(_, (table, Just (Relation {relType=Child}))) forst) (w,s) = (w,sel:s) where sel = "(" <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) " <> "FROM (" <> subquery <> ") " <> table <> ") AS " <> table - where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst) - - getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation{relType=Parent}))}) forst) (w,s) = (wit:w,sel:s) + where subquery = requestToQuery schema (Node n forst) + getQueryParts (Node n@(_, (table, Just (Relation {relType=Parent}))) forst) (w,s) = (wit:w,sel:s) where sel = "row_to_json(" <> table <> ".*) AS "<>table --TODO must be singular wit = table <> " AS ( " <> subquery <> " )" - where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst) - - getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation {relType=Many}))}) forst) (w,s) = (w,sel:s) + where subquery = requestToQuery schema (Node n forst) + getQueryParts (Node n@(_, (table, Just (Relation {relType=Many}))) forst) (w,s) = (w,sel:s) where sel = "(" <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) " <> "FROM (" <> subquery <> ") " <> table <> ") AS " <> table - where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst) - - -- the following is just to remove the warning + where subquery = requestToQuery schema (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 (Select{relation=Nothing}) _) _ = undefined - -pgFmtCondition :: QualifiedIdentifier -> Filter -> Text -pgFmtCondition table (Filter (col,jp) ops val) = - notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <> - if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue + getQueryParts (Node (_,(_,Nothing)) _) _ = undefined +requestToQuery schema (Node (Insert _ flds vals, (mainTbl, _)) _) = + query where - headPredicate:rest = split (=='.') ops - hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse - opCode = hasNot (head rest) headPredicate - notOp = hasNot headPredicate "" - sqlCol = case val of - VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp - VForeignKey qi _ -> pgFmtColumn qi col - sqlValue = valToStr val - getInner v = case v of - VText s -> s - _ -> "" - valToStr v = case v of - VText s -> pgFmtValue opCode s - VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn (QualifiedIdentifier s ft) fc - -pgFmtColumn :: QualifiedIdentifier -> Text -> Text -pgFmtColumn table "*" = fromQi table <> ".*" -pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c - -pgFmtJsonPath :: Maybe JsonPath -> Text -pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x -pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs ) -pgFmtJsonPath _ = "" - -pgFmtTable :: Table -> Text -pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n - -pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Text -pgFmtSelectItem table ((c, jp), Nothing) = pgFmtColumn table c <> pgFmtJsonPath jp <> asJsonPath jp -pgFmtSelectItem table ((c, jp), Just cast ) = "CAST (" <> pgFmtColumn table c <> pgFmtJsonPath jp <> " AS " <> cast <> " )" <> asJsonPath jp - -asJsonPath :: Maybe JsonPath -> Text -asJsonPath Nothing = "" -asJsonPath (Just xx) = " AS " <> last xx + qi = QualifiedIdentifier schema mainTbl + query = Data.Text.unwords [ + "INSERT INTO ", fromQi qi, + " (" <> intercalate ", " (map (pgFmtIdent . fst) flds) <> ") ", + "VALUES " <> intercalate ", " + ( map (\v -> + "(" <> + intercalate ", " ( map insertableValue v ) <> + ")" + ) vals + ), + "RETURNING " <> fromQi qi <> ".*" + ] +requestToQuery schema (Node (Update _ setWith conditions, (mainTbl, _)) _) = + query + where + qi = QualifiedIdentifier schema mainTbl + query = Data.Text.unwords [ + "UPDATE ", fromQi qi, + " SET " <> intercalate ", " (map formatSet (M.toList setWith)) <> " ", + ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, + "RETURNING " <> fromQi qi <> ".*" + ] + formatSet ((c, jp), v) = pgFmtIdent c <> pgFmtJsonPath jp <> " = " <> insertableValue v +requestToQuery schema (Node (Delete _ conditions, (mainTbl, _)) _) = + query + where + qi = QualifiedIdentifier schema mainTbl + query = Data.Text.unwords [ + "DELETE FROM ", fromQi qi, + ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, + "RETURNING " <> fromQi qi <> ".*" + ] diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index fbe36d937..19a8d05b0 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -3,69 +3,71 @@ import Data.Text import Data.Tree import qualified Data.ByteString.Char8 as BS import Data.Aeson +import Data.Map data DbStructure = DbStructure { - tables :: [Table] -, columns :: [Column] -, relations :: [Relation] -, primaryKeys :: [PrimaryKey] -} - - -data Table = Table { - tableSchema :: Text -, tableName :: Text -, tableInsertable :: Bool -, tableAcl :: [Text] -} deriving (Show) - -data ForeignKey = ForeignKey { - fkTable::Text, fkCol::Text + dbTables :: [Table] +, dbColumns :: [Column] +, dbRelations :: [Relation] +, dbPrimaryKeys :: [PrimaryKey] } deriving (Show, Eq) +type Schema = Text -data Column = Column { - colSchema :: Text -, colTable :: Text -, colName :: Text -, colPosition :: Int -, colNullable :: Bool -, colType :: Text -, colUpdatable :: Bool -, colMaxLen :: Maybe Int -, colPrecision :: Maybe Int -, colDefault :: Maybe Text -, colEnum :: [Text] -, colFK :: Maybe ForeignKey -} | Star {colSchema :: Text, colTable :: Text } deriving (Show) +data Table = Table { + tableSchema :: Schema +, tableName :: Text +, tableInsertable :: Bool +} deriving (Show, Ord) + +data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord) + +data Column = + Column { + colTable :: Table + , colName :: Text + , colPosition :: Int + , colNullable :: Bool + , colType :: Text + , colUpdatable :: Bool + , colMaxLen :: Maybe Int + , colPrecision :: Maybe Int + , colDefault :: Maybe Text + , colEnum :: [Text] + , colFK :: Maybe ForeignKey + } + | Star { colTable :: Table } + deriving (Show, Ord) + +type Synonym = (Column,Column) data PrimaryKey = PrimaryKey { - pkSchema::Text, pkTable::Text, pkName::Text -} + pkTable :: Table + , pkName :: Text +} deriving (Show, Eq) data OrderTerm = OrderTerm { - otTerm :: Text + otTerm :: Text , otDirection :: BS.ByteString , otNullOrder :: Maybe BS.ByteString } deriving (Show, Eq) data QualifiedIdentifier = QualifiedIdentifier { - qiSchema :: Text + qiSchema :: Schema , qiName :: Text } deriving (Show, Eq) data RelationType = Child | Parent | Many deriving (Show, Eq) data Relation = Relation { - relSchema :: Text -, relTable :: Text -, relColumns :: [Text] -, relFTable :: Text -, relFColumns :: [Text] -, relType :: RelationType -, relLTable :: Maybe Text -, relLCols1 :: Maybe [Text] -, relLCols2 :: Maybe [Text] + relTable :: Table +, relColumns :: [Column] +, relFTable :: Table +, relFColumns :: [Column] +, relType :: RelationType +, relLTable :: Maybe Table +, relLCols1 :: Maybe [Column] +, relLCols2 :: Maybe [Column] } deriving (Show, Eq) @@ -75,23 +77,21 @@ type FieldName = Text type JsonPath = [Text] type Field = (FieldName, Maybe JsonPath) type Cast = Text +type NodeName = Text type SelectItem = (Field, Maybe Cast) type Path = [Text] -data Query = Select { - mainTable::Text -, fields::[SelectItem] -, joinTables::[Text] -, filters::[Filter] -, order::Maybe [OrderTerm] -, relation::Maybe Relation -} deriving (Show, Eq) +data Query = Select { select::[SelectItem], from::[Text], where_::[Filter], order::Maybe [OrderTerm] } + | Insert { into::Text, fields::[Field], values::[[Value]] } + | Delete { from::[Text], where_::[Filter] } + | Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq) data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq) -type ApiRequest = Tree Query +type ApiNode = (Query, (NodeName, Maybe Relation)) +type ApiRequest = Tree ApiNode instance ToJSON Column where toJSON c = object [ - "schema" .= colSchema c + "schema" .= tableSchema t , "name" .= colName c , "position" .= colPosition c , "nullable" .= colNullable c @@ -102,12 +102,27 @@ instance ToJSON Column where , "references".= colFK c , "default" .= colDefault c , "enum" .= colEnum c ] + where + t = colTable c instance ToJSON ForeignKey where - toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk] + toJSON fk = object [ + "schema" .= tableSchema t + , "table" .= tableName t + , "column" .= colName c ] + where + c = fkCol fk + t = colTable c instance ToJSON Table where toJSON v = object [ "schema" .= tableSchema v , "name" .= tableName v , "insertable" .= tableInsertable v ] + +instance Eq Table where + Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2 + +instance Eq Column where + Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2 + _ == _ = False diff --git a/stack.yaml b/stack.yaml index 338b245be..fb06a970b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,7 +1,7 @@ flags: {} packages: - '.' -extra-deps: +extra-deps: - Ranged-sets-0.3.0 - packdeps-0.4.1 -resolver: lts-3.10 +resolver: nightly-2015-10-27 diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs index 7362e7a15..136ae4549 100644 --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -18,55 +18,53 @@ spec = beforeAll it "hides tables that anonymous does not own" $ get "/authors_only" `shouldRespondWith` 404 - it "indicates login failure (BasicAuth)" $ do - let auth = authHeaderBasic "postgrest_test_author" "fakefake" - request methodGet "/authors_only" [auth] "" - `shouldRespondWith` 401 - - it "allows users with permissions to see their tables (BasicAuth)" $ do - _ <- post "/postgrest/users" [json| { "id": "jdoe", "pass": "1234", "role": "postgrest_test_author" } |] - let auth = authHeaderBasic "jdoe" "1234" - request methodGet "/authors_only" [auth] "" - `shouldRespondWith` 200 - - it "respects database constraints for role" $ - post "/postgrest/users" [json| { "id": "ssmith", "pass": "1234", "role": "SUPER_ADMIN_TRUNCATE_POWERS" } |] - `shouldRespondWith` 400 - - it "does not send a value when no role is provided" $ do - post "/postgrest/users" [json| { "id": "bdeey", "pass": "1234" } |] - `shouldRespondWith` 201 - let auth = authHeaderBasic "jdoe" "1234" - request methodGet "/authors_only" [auth] "" - `shouldRespondWith` 200 - - it "recovers after 400 error with logged in user" $ do - _ <- post "/postgrest/users" [json| { "id": "jdoe", "pass": "1234", "role": "postgrest_test_author" } |] - let auth = authHeaderBasic "jdoe" "1234" - _ <- request methodPost "/rpc/problem" [auth] "" - request methodGet "/authors_only" [auth] "" - `shouldRespondWith` 200 - - it "allows users to login (JWT)" $ do - _ <- post "/postgrest/users" [json| { "id": "jdoe", "pass": "1234", "role": "postgrest_test_author" } |] - post "/postgrest/tokens" [json| { "id": "jdoe", "pass": "1234" } |] + it "returns jwt functions as jwt tokens" $ + post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |] `shouldRespondWith` ResponseMatcher { matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"} |] - , matchStatus = 201 + , matchStatus = 200 , matchHeaders = ["Content-Type" <:> "application/json"] } - it "indicates login failure (JWT)" $ do - _ <- post "/postgrest/users" [json| { "id": "jdoe", "pass": "1234", "role": "postgrest_test_author" } |] - post "/postgrest/tokens" [json| { "id": "jdoe", "pass": "NOPE" } |] - `shouldRespondWith` ResponseMatcher { - matchBody = Just [json| {"message":"Failed authentication."} |] - , matchStatus = 401 - , matchHeaders = ["Content-Type" <:> "application/json"] - } - - it "allows users with permissions to see their tables (JWT)" $ do - _ <- post "/postgrest/users" [json| { "id": "jdoe", "pass": "1234", "role": "postgrest_test_author" } |] + it "allows users with permissions to see their tables" $ do let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" request methodGet "/authors_only" [auth] "" `shouldRespondWith` 200 + + it "works with tokens which have extra fields" $ do + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIiwia2V5MSI6InZhbHVlMSIsImtleTIiOiJ2YWx1ZTIiLCJrZXkzIjoidmFsdWUzIiwiYSI6MSwiYiI6MiwiYyI6M30.GfydCh-F4wnM379xs0n1zUgalwJIsb6YoBapCo8HlFk" + request methodGet "/authors_only" [auth] "" + `shouldRespondWith` 200 + + -- this test will stop working 9999999999s after the UNIX EPOCH + it "succeeds with an unexpired token" $ do + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.QaPPLWTuyydMu_q7H4noMT7Lk6P4muet1OpJXF6ofhc" + request methodGet "/authors_only" [auth] "" + `shouldRespondWith` 200 + + it "fails with an expired token" $ do + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.enk_qZ_u6gZsXY4R8bREKB_HNExRpM0lIWSLktk9JJQ" + request methodGet "/authors_only" [auth] "" + `shouldRespondWith` 400 + + it "hides tables from users with invalid JWT" $ do + let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" + request methodGet "/authors_only" [auth] "" + `shouldRespondWith` 400 + + it "should fail when jwt contains no claims" $ do + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.MKYc_lOECtB0LJOiykilAdlHodB-I0_id2qHKq35dmc" + request methodGet "/authors_only" [auth] "" + `shouldRespondWith` 400 + + it "hides tables from users with JWT that contain no claims about role" $ do + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.zyohGMnrDy4_8eJTl6I2AUXO3MeCCiwR24aGWRkTE9o" + request methodGet "/authors_only" [auth] "" + `shouldRespondWith` 400 + + it "recovers after 400 error with logged in user" $ do + _ <- post "/authors_only" [json| { "owner": "jdoe", "secret": "test content" } |] + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" + _ <- request methodPost "/rpc/problem" [auth] "" + request methodGet "/authors_only" [auth] "" + `shouldRespondWith` 200 diff --git a/test/Feature/CorsSpec.hs b/test/Feature/CorsSpec.hs index fa005dc22..35ff69982 100644 --- a/test/Feature/CorsSpec.hs +++ b/test/Feature/CorsSpec.hs @@ -41,7 +41,7 @@ spec = around withApp $ describe "CORS" $ do "true" respHeaders `shouldSatisfy` matchHeader "Access-Control-Allow-Methods" - "GET, POST, PUT, PATCH, DELETE, OPTIONS, HEAD" + "GET, POST, PATCH, DELETE, OPTIONS, HEAD" respHeaders `shouldSatisfy` matchHeader "Access-Control-Allow-Headers" "Authentication, Foo, Bar, Accept, Accept-Language, Content-Language" diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index 7d19e5683..0b86ede16 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -1,6 +1,6 @@ module Feature.InsertSpec where -import Test.Hspec +import Test.Hspec hiding (pendingWith) import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus)) @@ -19,16 +19,38 @@ import TestTypes(IncPK(..), CompoundPK(..)) spec :: Spec spec = afterAll_ resetDb $ around withApp $ do describe "Posting new record" $ do - after_ (clearTable "menagerie") . it "accepts disparate json types" $ do - p <- post "/menagerie" - [json| { - "integer": 13, "double": 3.14159, "varchar": "testing!" - , "boolean": false, "date": "1900-01-01", "money": "$3.99" - , "enum": "foo" - } |] - liftIO $ do - simpleBody p `shouldBe` "" - simpleStatus p `shouldBe` created201 + after_ (clearTable "menagerie") . context "disparate csv types" $ do + it "accepts disparate json types" $ do + p <- post "/menagerie" + [json| { + "integer": 13, "double": 3.14159, "varchar": "testing!" + , "boolean": false, "date": "1900-01-01", "money": "$3.99" + , "enum": "foo" + } |] + liftIO $ do + simpleBody p `shouldBe` "" + simpleStatus p `shouldBe` created201 + + it "filters columns in result using &select" $ + request methodPost "/menagerie?select=integer,varchar" [("Prefer", "return=representation")] + [json| { + "integer": 14, "double": 3.14159, "varchar": "testing!" + , "boolean": false, "date": "1900-01-01", "money": "$3.99" + , "enum": "foo" + } |] `shouldRespondWith` ResponseMatcher { + matchBody = Just [str|{"integer":14,"varchar":"testing!"}|] + , matchStatus = 201 + , matchHeaders = ["Content-Type" <:> "application/json"] + } + + it "includes related data after insert" $ + request methodPost "/projects?select=id,name,clients(id,name)" [("Prefer", "return=representation")] + [str|{"id":5,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher { + matchBody = Just [str|{"id":5,"name":"New Project","clients":{"id":2,"name":"Apple"}}|] + , matchStatus = 201 + , matchHeaders = ["Content-Type" <:> "application/json", "Location" <:> "/projects?id=eq.5"] + } + context "with no pk supplied" $ do context "into a table with auto-incrementing pk" . after_ (clearTable "auto_incrementing_pk") $ @@ -92,55 +114,99 @@ spec = afterAll_ resetDb $ around withApp $ do context "jsonb" . after_ (clearTable "json") $ do it "serializes nested object" $ do let inserted = [json| { "data": { "foo":"bar" } } |] - p <- request methodPost "json" [("Prefer", "return=representation")] inserted - liftIO $ do - simpleBody p `shouldBe` inserted - simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%7B%22foo%22%3A%22bar%22%7D" - simpleStatus p `shouldBe` created201 + request methodPost "/json" + [("Prefer", "return=representation")] + inserted + `shouldRespondWith` ResponseMatcher { + matchBody = Just inserted + , matchStatus = 201 + , matchHeaders = ["Location" <:> [str|/json?data=eq.{"foo":"bar"}|]] + } + + -- TODO! the test above seems right, why was the one below working before and not now + -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted + -- liftIO $ do + -- simpleBody p `shouldBe` inserted + -- simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%7B%22foo%22%3A%22bar%22%7D" + -- simpleStatus p `shouldBe` created201 + it "serializes nested array" $ do let inserted = [json| { "data": [1,2,3] } |] - p <- request methodPost "json" [("Prefer", "return=representation")] inserted - liftIO $ do - simpleBody p `shouldBe` inserted - simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%5B1%2C2%2C3%5D" - simpleStatus p `shouldBe` created201 + request methodPost "/json" + [("Prefer", "return=representation")] + inserted + `shouldRespondWith` ResponseMatcher { + matchBody = Just inserted + , matchStatus = 201 + , matchHeaders = ["Location" <:> [str|/json?data=eq.[1,2,3]|]] + } + -- TODO! the test above seems right, why was the one below working before and not now + -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted + -- liftIO $ do + -- simpleBody p `shouldBe` inserted + -- simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%5B1%2C2%2C3%5D" + -- simpleStatus p `shouldBe` created201 describe "CSV insert" $ do after_ (clearTable "menagerie") . context "disparate csv types" $ it "succeeds with multipart response" $ do - p <- request methodPost "/menagerie" [("Content-Type", "text/csv")] - [str|integer,double,varchar,boolean,date,money,enum - |13,3.14159,testing!,false,1900-01-01,$3.99,foo - |12,0.1,a string,true,1929-10-01,12,bar - |] - liftIO $ do - simpleBody p `shouldBe` "Content-Type: application/json\nLocation: /menagerie?integer=eq.13\n\n\n--postgrest_boundary\nContent-Type: application/json\nLocation: /menagerie?integer=eq.12\n\n" - simpleStatus p `shouldBe` created201 + pendingWith "Decide on what to do with CSV insert" + let inserted = [str|integer,double,varchar,boolean,date,money,enum + |13,3.14159,testing!,false,1900-01-01,$3.99,foo + |12,0.1,a string,true,1929-10-01,12,bar + |] + request methodPost "/menagerie" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] inserted + + `shouldRespondWith` ResponseMatcher { + matchBody = Just inserted + , matchStatus = 201 + , matchHeaders = ["Content-Type" <:> "text/csv"] + } + -- p <- request methodPost "/menagerie" [("Content-Type", "text/csv")] + -- [str|integer,double,varchar,boolean,date,money,enum + -- |13,3.14159,testing!,false,1900-01-01,$3.99,foo + -- |12,0.1,a string,true,1929-10-01,12,bar + -- |] + -- liftIO $ do + -- simpleBody p `shouldBe` "Content-Type: application/json\nLocation: /menagerie?integer=eq.13\n\n\n--postgrest_boundary\nContent-Type: application/json\nLocation: /menagerie?integer=eq.12\n\n" + -- simpleStatus p `shouldBe` created201 after_ (clearTable "no_pk") . context "requesting full representation" $ do it "returns full details of inserted record" $ request methodPost "/no_pk" - [("Content-Type", "text/csv"), ("Prefer", "return=representation")] + [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] "a,b\nbar,baz" `shouldRespondWith` ResponseMatcher { - matchBody = Just [json| { "a":"bar", "b":"baz" } |] + matchBody = Just "a,b\nbar,baz" , matchStatus = 201 - , matchHeaders = ["Content-Type" <:> "application/json", + , matchHeaders = ["Content-Type" <:> "text/csv", "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"] } + -- it "can post nulls (old way)" $ do + -- pendingWith "changed the response when in csv mode" + -- request methodPost "/no_pk" + -- [("Content-Type", "text/csv"), ("Prefer", "return=representation")] + -- "a,b\nNULL,foo" + -- `shouldRespondWith` ResponseMatcher { + -- matchBody = Just [json| { "a":null, "b":"foo" } |] + -- , matchStatus = 201 + -- , matchHeaders = ["Content-Type" <:> "application/json", + -- "Location" <:> "/no_pk?a=is.null&b=eq.foo"] + -- } it "can post nulls" $ request methodPost "/no_pk" - [("Content-Type", "text/csv"), ("Prefer", "return=representation")] + [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] "a,b\nNULL,foo" `shouldRespondWith` ResponseMatcher { - matchBody = Just [json| { "a":null, "b":"foo" } |] + matchBody = Just "a,b\n,foo" , matchStatus = 201 - , matchHeaders = ["Content-Type" <:> "application/json", + , matchHeaders = ["Content-Type" <:> "text/csv", "Location" <:> "/no_pk?a=is.null&b=eq.foo"] } + after_ (clearTable "no_pk") . context "with wrong number of columns" $ do it "fails for too few" $ do p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz" @@ -159,7 +225,8 @@ spec = afterAll_ resetDb $ around withApp $ do context "to a known uri" $ do context "without a fully-specified primary key" $ - it "is not an allowed operation" $ + it "is not an allowed operation" $ do + pendingWith "Decide on PUT usefullness" request methodPut "/compound_pk?k1=eq.12" [] [json| { "k1":12, "k2":42 } |] `shouldRespondWith` 405 @@ -167,13 +234,15 @@ spec = afterAll_ resetDb $ around withApp $ do context "with a fully-specified primary key" $ do context "not specifying every column in the table" $ - it "is rejected for lack of idempotence" $ + it "is rejected for lack of idempotence" $ do + pendingWith "Decide on PUT usefullness" request methodPut "/compound_pk?k1=eq.12&k2=eq.42" [] [json| { "k1":12, "k2":42 } |] `shouldRespondWith` 400 context "specifying every column in the table" . after_ (clearTable "compound_pk") $ do it "can create a new record" $ do + pendingWith "Decide on PUT usefullness" p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" [] [json| { "k1":12, "k2":42, "extra":3 } |] liftIO $ do @@ -190,6 +259,7 @@ spec = afterAll_ resetDb $ around withApp $ do compoundExtra record `shouldBe` Just 3 it "can update an existing record" $ do + pendingWith "Decide on PUT usefullness" _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" [] [json| { "k1":12, "k2":42, "extra":4 } |] _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" [] @@ -204,7 +274,8 @@ spec = afterAll_ resetDb $ around withApp $ do context "with an auto-incrementing primary key" . after_ (clearTable "auto_incrementing_pk") $ - it "succeeds with 204" $ + it "succeeds with 204" $ do + pendingWith "Decide on PUT usefullness" request methodPut "/auto_incrementing_pk?id=eq.1" [] [json| { "id":1, @@ -284,14 +355,15 @@ spec = afterAll_ resetDb $ around withApp $ do describe "Row level permission" $ it "set user_id when inserting rows" $ do + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |] _ <- post "/postgrest/users" [json| { "id":"jroe", "pass": "1234", "role": "postgrest_test_author" } |] p1 <- request methodPost "/authors_only" - [ authHeaderBasic "jdoe" "1234", ("Prefer", "return=representation") ] + [ auth, ("Prefer", "return=representation") ] [json| { "secret": "nyancat" } |] liftIO $ do - simpleBody p1 `shouldBe` [json| { "owner":"jdoe", "secret":"nyancat" } |] + simpleBody p1 `shouldBe` [str|{"owner":"jdoe","secret":"nyancat"}|] simpleStatus p1 `shouldBe` created201 p2 <- request methodPost "/authors_only" @@ -299,5 +371,5 @@ spec = afterAll_ resetDb $ around withApp $ do [ authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqcm9lIn0.YuF_VfmyIxWyuceT7crnNKEprIYXsJAyXid3rjPjIow", ("Prefer", "return=representation") ] [json| { "secret": "lolcat", "owner": "hacker" } |] liftIO $ do - simpleBody p2 `shouldBe` [json| { "owner":"jroe", "secret":"lolcat" } |] + simpleBody p2 `shouldBe` [str|{"owner":"jroe","secret":"lolcat"}|] simpleStatus p2 `shouldBe` created201 diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index b35ca639c..4f89307bf 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -7,10 +7,13 @@ import Network.HTTP.Types import Network.Wai.Test (SResponse(simpleHeaders)) import SpecHelper +import Text.Heredoc + spec :: Spec spec = beforeAll (clearTable "items" >> createItems 15) + . beforeAll clearProjectsTable . beforeAll (clearTable "complex_items" >> createComplexItems) . beforeAll (clearTable "nullable_integer" >> createNullInteger) . beforeAll ( @@ -134,11 +137,20 @@ spec = get "/clients?select=id,projects(id,tasks(id,name))&projects.tasks.name=like.Design*" `shouldRespondWith` "[{\"id\":1,\"projects\":[{\"id\":1,\"tasks\":[{\"id\":1,\"name\":\"Design w7\"}]},{\"id\":2,\"tasks\":[{\"id\":3,\"name\":\"Design w10\"}]}]},{\"id\":2,\"projects\":[{\"id\":3,\"tasks\":[{\"id\":5,\"name\":\"Design IOS\"}]},{\"id\":4,\"tasks\":[{\"id\":7,\"name\":\"Design OSX\"}]}]}]" + it "matches with @> operator" $ + get "/complex_items?select=id&arr_data=@>.{2}" `shouldRespondWith` + [str|[{"id":2},{"id":3}]|] + + it "matches with <@ operator" $ + get "/complex_items?select=id&arr_data=<@.{1,2,4}" `shouldRespondWith` + [str|[{"id":1},{"id":2}]|] + + describe "Shaping response with select parameter" $ do it "selectStar works in absense of parameter" $ get "/complex_items?id=eq.3" `shouldRespondWith` - "[{\"id\":3,\"name\":\"Three\",\"settings\":{\"foo\":{\"int\":1,\"bar\":\"baz\"}}}]" + [str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3]}]|] it "one simple column" $ get "/complex_items?select=id" `shouldRespondWith` @@ -272,7 +284,7 @@ spec = request methodGet "/simple_pk" (acceptHdrs "text/csv; version=1") "" `shouldRespondWith` ResponseMatcher { - matchBody = Just "k,extra\rxyyx,u\rxYYx,v" + matchBody = Just "k,extra\nxyyx,u\nxYYx,v" , matchStatus = 200 , matchHeaders = ["Content-Type" <:> "text/csv"] } diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index d68db8440..339a36044 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -14,42 +14,42 @@ spec = around withApp $ do it "lists views in schema" $ request methodGet "/" [] "" `shouldRespondWith` [json| [ - {"schema":"1","name":"auto_incrementing_pk","insertable":true} - , {"schema":"1","name":"clients","insertable":true} - , {"schema":"1","name":"comments","insertable":true} - , {"schema":"1","name":"complex_items","insertable":true} - , {"schema":"1","name":"compound_pk","insertable":true} - , {"schema":"1","name":"has_count_column","insertable":false} - , {"schema":"1","name":"has_fk","insertable":true} - , {"schema":"1","name":"insertable_view_with_join","insertable":true} - , {"schema":"1","name":"items","insertable":true} - , {"schema":"1","name":"json","insertable":true} - , {"schema":"1","name":"materialized_view","insertable":false} - , {"schema":"1","name":"menagerie","insertable":true} - , {"schema":"1","name":"no_pk","insertable":true} - , {"schema":"1","name":"nullable_integer","insertable":true} - , {"schema":"1","name":"projects","insertable":true} - , {"schema":"1","name":"projects_view","insertable":true} - , {"schema":"1","name":"simple_pk","insertable":true} - , {"schema":"1","name":"tasks","insertable":true} - , {"schema":"1","name":"tsearch","insertable":true} - , {"schema":"1","name":"users","insertable":true} - , {"schema":"1","name":"users_projects","insertable":true} - , {"schema":"1","name":"users_tasks","insertable":true} + {"schema":"test","name":"articleStars","insertable":true} + , {"schema":"test","name":"articles","insertable":true} + , {"schema":"test","name":"auto_incrementing_pk","insertable":true} + , {"schema":"test","name":"clients","insertable":true} + , {"schema":"test","name":"comments","insertable":true} + , {"schema":"test","name":"complex_items","insertable":true} + , {"schema":"test","name":"compound_pk","insertable":true} + , {"schema":"test","name":"has_count_column","insertable":false} + , {"schema":"test","name":"has_fk","insertable":true} + , {"schema":"test","name":"insertable_view_with_join","insertable":true} + , {"schema":"test","name":"items","insertable":true} + , {"schema":"test","name":"json","insertable":true} + , {"schema":"test","name":"materialized_view","insertable":false} + , {"schema":"test","name":"menagerie","insertable":true} + , {"schema":"test","name":"no_pk","insertable":true} + , {"schema":"test","name":"nullable_integer","insertable":true} + , {"schema":"test","name":"projects","insertable":true} + , {"schema":"test","name":"projects_view","insertable":true} + , {"schema":"test","name":"simple_pk","insertable":true} + , {"schema":"test","name":"tasks","insertable":true} + , {"schema":"test","name":"tsearch","insertable":true} + , {"schema":"test","name":"users","insertable":true} + , {"schema":"test","name":"users_projects","insertable":true} + , {"schema":"test","name":"users_tasks","insertable":true} ] |] {matchStatus = 200} it "lists only views user has permission to see" $ do - _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |] - let auth = authHeaderBasic "jdoe" "1234" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" request methodGet "/" [auth] "" `shouldRespondWith` [json| [ - {"schema":"1","name":"authors_only","insertable":true} + {"schema":"test","name":"authors_only","insertable":true} ] |] {matchStatus = 200} - describe "Table info" $ do it "is available with OPTIONS verb" $ request methodOptions "/menagerie" [] "" `shouldRespondWith` @@ -61,7 +61,7 @@ spec = around withApp $ do "default": null, "precision": 32, "updatable": true, - "schema": "1", + "schema": "test", "name": "integer", "type": "integer", "maxLen": null, @@ -74,7 +74,7 @@ spec = around withApp $ do "default": null, "precision": 53, "updatable": true, - "schema": "1", + "schema": "test", "name": "double", "type": "double precision", "maxLen": null, @@ -86,7 +86,7 @@ spec = around withApp $ do "default": null, "precision": null, "updatable": true, - "schema": "1", + "schema": "test", "name": "varchar", "type": "character varying", "maxLen": null, @@ -99,7 +99,7 @@ spec = around withApp $ do "default": null, "precision": null, "updatable": true, - "schema": "1", + "schema": "test", "name": "boolean", "type": "boolean", "maxLen": null, @@ -111,7 +111,7 @@ spec = around withApp $ do "default": null, "precision": null, "updatable": true, - "schema": "1", + "schema": "test", "name": "date", "type": "date", "maxLen": null, @@ -123,7 +123,7 @@ spec = around withApp $ do "default": null, "precision": null, "updatable": true, - "schema": "1", + "schema": "test", "name": "money", "type": "money", "maxLen": null, @@ -136,7 +136,7 @@ spec = around withApp $ do "default": null, "precision": null, "updatable": true, - "schema": "1", + "schema": "test", "name": "enum", "type": "USER-DEFINED", "maxLen": null, @@ -154,98 +154,57 @@ spec = around withApp $ do |] it "it includes primary and foreign keys for views" $ - request methodOptions "/insertable_view_with_join" [] "" `shouldRespondWith` + request methodOptions "/projects_view" [] "" `shouldRespondWith` [json| { "pkey":[ "id" ], "columns":[ - { - "references":null, - "default":null, - "precision":64, - "updatable":false, - "schema":"1", - "name":"id", - "type":"bigint", - "maxLen":null, - "enum":[], - "nullable":true, - "position":1 + { + "references":null, + "default":null, + "precision":32, + "updatable":true, + "schema":"test", + "name":"id", + "type":"integer", + "maxLen":null, + "enum":[], + "nullable":true, + "position":1 + }, + { + "references":null, + "default":null, + "precision":null, + "updatable":true, + "schema":"test", + "name":"name", + "type":"text", + "maxLen":null, + "enum":[], + "nullable":true, + "position":2 + }, + { + "references": { + "schema":"test", + "column":"id", + "table":"clients" }, - { - "references":{ - "column":"id", - "table":"auto_incrementing_pk" - }, - "default":null, - "precision":32, - "updatable":false, - "schema":"1", - "name":"auto_inc_fk", - "type":"integer", - "maxLen":null, - "enum":[], - "nullable":true, - "position":2 - }, - { - "references":{ - "column":"k", - "table":"simple_pk" - }, - "default":null, - "precision":null, - "updatable":false, - "schema":"1", - "name":"simple_fk", - "type":"character varying", - "maxLen":255, - "enum":[], - "nullable":true, - "position":3 - }, - { - "references":null, - "default":null, - "precision":null, - "updatable":false, - "schema":"1", - "name":"nullable_string", - "type":"character varying", - "maxLen":null, - "enum":[], - "nullable":true, - "position":4 - }, - { - "references":null, - "default":null, - "precision":null, - "updatable":false, - "schema":"1", - "name":"non_nullable_string", - "type":"character varying", - "maxLen":null, - "enum":[], - "nullable":true, - "position":5 - }, - { - "references":null, - "default":null, - "precision":null, - "updatable":false, - "schema":"1", - "name":"inserted_at", - "type":"timestamp with time zone", - "maxLen":null, - "enum":[], - "nullable":true, - "position":6 - } - ] + "default":null, + "precision":32, + "updatable":true, + "schema":"test", + "name":"client_id", + "type":"integer", + "maxLen":null, + "enum":[], + "nullable":true, + "position":3 + } + ] } |] @@ -261,7 +220,7 @@ spec = around withApp $ do "default": "nextval('\"1\".has_fk_id_seq'::regclass)", "precision": 64, "updatable": true, - "schema": "1", + "schema": "test", "name": "id", "type": "bigint", "maxLen": null, @@ -273,7 +232,7 @@ spec = around withApp $ do "default": null, "precision": 32, "updatable": true, - "schema": "1", + "schema": "test", "name": "auto_inc_fk", "type": "integer", "maxLen": null, @@ -285,7 +244,7 @@ spec = around withApp $ do "default": null, "precision": null, "updatable": true, - "schema": "1", + "schema": "test", "name": "simple_fk", "type": "character varying", "maxLen": 255, @@ -297,3 +256,63 @@ spec = around withApp $ do ] } |] + + it "includes all information on views for renamed columns, and raises relations to correct schema" $ + request methodOptions "/articleStars" [] "" + `shouldRespondWith` [json| + { + "pkey": [ + "articleId", + "userId" + ], + "columns": [ + { + "references": { + "schema": "test", + "column": "id", + "table": "articles" + }, + "default": null, + "precision": 32, + "updatable": true, + "schema": "test", + "name": "articleId", + "type": "integer", + "maxLen": null, + "enum": [], + "nullable": true, + "position": 1 + }, + { + "references": { + "schema": "test", + "column": "id", + "table": "users" + }, + "default": null, + "precision": 32, + "updatable": true, + "schema": "test", + "name": "userId", + "type": "integer", + "maxLen": null, + "enum": [], + "nullable": true, + "position": 2 + }, + { + "references": null, + "default": null, + "precision": null, + "updatable": true, + "schema": "test", + "name": "createdAt", + "type": "timestamp without time zone", + "maxLen": null, + "enum": [], + "nullable": true, + "position": 3 + } + ] + } + |] diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index f086bb0bc..691ec0696 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -30,25 +30,23 @@ import PostgREST.App (app) import PostgREST.Config (AppConfig(..)) import PostgREST.Middleware import PostgREST.Error(errResponse) -import PostgREST.PgStructure -import PostgREST.Types +import PostgREST.DbStructure + +dbString :: String +dbString = "postgres://postgrest_test@localhost:5432/postgrest_test" isLeft :: Either a b -> Bool isLeft (Left _ ) = True isLeft _ = False cfg :: AppConfig -cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10 "1" "safe" +cfg = AppConfig dbString 3000 "postgrest_anonymous" "test" "safe" 10 testPoolOpts :: PoolSettings testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30 pgSettings :: P.Settings -pgSettings = P.ParamSettings (cs $ configDbHost cfg) - (fromIntegral $ configDbPort cfg) - (cs $ configDbUser cfg) - (cs $ configDbPass cfg) - (cs $ configDbName cfg) +pgSettings = P.StringSettings $ cs dbString withApp :: ActionWith Application -> IO () withApp perform = do @@ -56,30 +54,16 @@ withApp perform = do <- H.acquirePool pgSettings testPoolOpts let txSettings = Just (H.ReadCommitted, Just True) - metadata <- H.session pool $ H.tx txSettings $ do - tabs <- allTables - rels <- allRelations - cols <- allColumns rels - keys <- allPrimaryKeys - return (tabs, rels, cols, keys) - - dbstructure <- case metadata of - Left e -> fail $ show e - Right (tabs, rels, cols, keys) -> - return $ DbStructure { - tables=tabs - , columns=cols - , relations=rels - , primaryKeys=keys - } + dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema cfg) + db <- either (fail . show) return dbOrError perform $ middle $ \req resp -> do body <- strictRequestBody req result <- liftIO $ H.session pool $ H.tx txSettings - $ authenticated cfg (app dbstructure cfg body) req + $ runWithClaims cfg (app db cfg body) req either (resp . errResponse) resp result - where middle = defaultMiddle False + where middle = defaultMiddle resetDb :: IO () @@ -88,7 +72,7 @@ resetDb = do <- H.acquirePool pgSettings testPoolOpts void . liftIO $ H.session pool $ H.tx Nothing $ do - H.unitEx [H.stmt| drop schema if exists "1" cascade |] + H.unitEx [H.stmt| drop schema if exists test cascade |] H.unitEx [H.stmt| drop schema if exists private cascade |] H.unitEx [H.stmt| drop schema if exists postgrest cascade |] @@ -129,7 +113,14 @@ clearTable :: Text -> IO () clearTable table = do pool <- testPool void . liftIO $ H.session pool $ H.tx Nothing $ - H.unitEx $ B.Stmt ("delete from \"1\"."<>table) V.empty True + H.unitEx $ B.Stmt ("delete from test."<>table) V.empty True + +clearProjectsTable :: IO () +clearProjectsTable = do + pool <- testPool + void . liftIO $ H.session pool $ H.tx Nothing $ + H.unitEx $ B.Stmt "delete from test.projects where id > 4" V.empty True + createItems :: Int -> IO () createItems n = do @@ -137,7 +128,7 @@ createItems n = do void . liftIO $ H.session pool $ H.tx Nothing txn where txn = mapM_ H.unitEx stmts - stmts = map [H.stmt|insert into "1".items (id) values (?)|] [1..n] + stmts = map [H.stmt|insert into test.items (id) values (?)|] [1..n] createComplexItems :: IO () createComplexItems = do @@ -145,11 +136,12 @@ createComplexItems = do void . liftIO $ H.session pool $ H.tx Nothing txn where txn = mapM_ H.unitEx stmts - stmts = getZipList $ [H.stmt|insert into "1".complex_items (id, name, settings) values (?,?,?)|] + stmts = getZipList $ [H.stmt|insert into test.complex_items (id, name, settings, arr_data) values (?,?,?,?)|] <$> ZipList ([1..3]::[Int]) <*> ZipList (["One", "Two", "Three"]::[Text]) - <*> ZipList ([jobj,jobj,jobj]) - jobj = (J.object [("foo", J.object [("int", J.Number 1),("bar", J.String "baz")])]) + <*> ZipList [jobj,jobj,jobj] + <*> ZipList ([[1], [1,2], [1,2,3]]::[[Int]]) + jobj = J.object [("foo", J.object [("int", J.Number 1),("bar", J.String "baz")])] createNulls :: Int -> IO () createNulls n = do @@ -157,14 +149,14 @@ createNulls n = do void . liftIO $ H.session pool $ H.tx Nothing txn where txn = mapM_ H.unitEx (stmt':stmts) - stmt' = [H.stmt|insert into "1".no_pk (a,b) values (null,null)|] - stmts = map [H.stmt|insert into "1".no_pk (a,b) values (?,0)|] [1..n] + stmt' = [H.stmt|insert into test.no_pk (a,b) values (null,null)|] + stmts = map [H.stmt|insert into test.no_pk (a,b) values (?,0)|] [1..n] createNullInteger :: IO () createNullInteger = do pool <- testPool void . liftIO $ H.session pool $ H.tx Nothing $ - H.unitEx $ [H.stmt| insert into "1".nullable_integer (a) values (null) |] + H.unitEx $ [H.stmt| insert into "test".nullable_integer (a) values (null) |] createLikableStrings :: IO () createLikableStrings = do @@ -174,7 +166,7 @@ createLikableStrings = do H.unitEx $ insertSimplePk "xYYx" "v" where insertSimplePk :: Text -> Text -> H.Stmt P.Postgres - insertSimplePk = [H.stmt|insert into "1".simple_pk (k, extra) values (?,?)|] + insertSimplePk = [H.stmt|insert into test.simple_pk (k, extra) values (?,?)|] createJsonData :: IO () createJsonData = do @@ -182,7 +174,7 @@ createJsonData = do void . liftIO $ H.session pool $ H.tx Nothing $ H.unitEx $ [H.stmt| - insert into "1".json (data) values (?) + insert into test.json (data) values (?) |] (J.object [("id", J.Number 1) ,("foo", J.object [("bar", J.String "baz")]) diff --git a/test/Unit/PgStructureSpec.hx b/test/Unit/DbStructureSpec.hx similarity index 79% rename from test/Unit/PgStructureSpec.hx rename to test/Unit/DbStructureSpec.hx index 0ca6279fb..6a8a9e4de 100644 --- a/test/Unit/PgStructureSpec.hx +++ b/test/Unit/DbStructureSpec.hx @@ -1,7 +1,7 @@ -module Unit.PgStructureSpec where +module Unit.DbStructureSpec where import Test.Hspec -import PgStructure (Table(..), tables, Column(..), columns, ForeignKey(..), +import DbStructure (Table(..), tables, Column(..), columns, ForeignKey(..), foreignKeys) import Database.HDBC (quickQuery) @@ -12,25 +12,25 @@ spec :: Spec spec = around dbWithSchema $ beforeWith setRole $ do describe "tables" $ it "shows all the tables" $ \conn -> do - ts <- tables "1" conn + ts <- tables "test" conn map tableName ts `shouldBe` ["authors_only","auto_incrementing_pk", "compound_pk","has_fk","insertable_view_with_join","items","menagerie","no_pk", "simple_pk"] describe "columns" $ do it "responds with each column for the table" $ \conn -> do - cs <- columns "1" "auto_incrementing_pk" conn + cs <- columns "test" "auto_incrementing_pk" conn map colName cs `shouldBe` ["id","nullable_string","non_nullable_string", "inserted_at"] it "includes foreign key data" $ \conn -> do - cs <- columns "1" "has_fk" conn + cs <- columns "test" "has_fk" conn map colFK cs `shouldBe` [Nothing, Just $ ForeignKey "auto_incrementing_pk" "id", Just $ ForeignKey "simple_pk" "k"] describe "foreignKeys" $ it "has a description of the foreign key columns" $ \conn -> - foreignKeys "1" "has_fk" conn `shouldReturn` M.fromList [ + foreignKeys "test" "has_fk" conn `shouldReturn` M.fromList [ ("auto_inc_fk", ForeignKey {fkTable="auto_incrementing_pk", fkCol="id"}), ("simple_fk", ForeignKey { fkTable="simple_pk", fkCol="k"})] diff --git a/test/Unit/PgQuerySpec.hx b/test/Unit/PgQuerySpec.hx index 0cc3de225..5842fe1ef 100644 --- a/test/Unit/PgQuerySpec.hx +++ b/test/Unit/PgQuerySpec.hx @@ -32,7 +32,7 @@ spec = around dbWithSchema $ do describe "insert" $ describe "with an auto-increment key" $ do it "inserts and responds with a full object description" $ \conn -> do - r <- insert "1" "auto_incrementing_pk" (SqlRow [ + r <- insert "test" "auto_incrementing_pk" (SqlRow [ ("non_nullable_string", toSql ("a string"::String))]) conn let returnRow = incFromList . toList $ r incStr returnRow `shouldBe` "a string" @@ -43,19 +43,19 @@ spec = around dbWithSchema $ do [returnRow] `shouldBe` map incFromList tRows it "throws an exception if the PK is not unique" $ \conn -> do - r <- insert "1" "auto_incrementing_pk" (SqlRow [ + r <- insert "test" "auto_incrementing_pk" (SqlRow [ ("non_nullable_string", toSql ("a string"::String))]) conn let row = SqlRow . map (Control.Arrow.first cs) . toList $ r - insert "1" "auto_incrementing_pk" row conn `shouldThrow` \e -> + insert "test" "auto_incrementing_pk" row conn `shouldThrow` \e -> seState e == "23505" -- uniqueness violation code it "throws an exception if a required value is missing" $ \conn -> - insert "1" "auto_incrementing_pk" (SqlRow [ + insert "test" "auto_incrementing_pk" (SqlRow [ ("nullable_string", toSql ("a string"::String))]) conn `shouldThrow` \e -> seState e == "23502" it "generates a default values query if no data is provided" $ \c -> do - r <- insert "1" "items" (SqlRow []) c + r <- insert "test" "items" (SqlRow []) c let [row] = toList r quickALQuery c "select * from \"1\".items where id = ?" [snd row] `shouldReturn` [[row]] diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index 6128beee5..1d65862a6 100755 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -5,10 +5,10 @@ SET check_function_bodies = false; SET client_min_messages = warning; -CREATE SCHEMA "1"; +CREATE SCHEMA test; -ALTER SCHEMA "1" OWNER TO postgrest_test; +ALTER SCHEMA test OWNER TO postgrest_test; CREATE SCHEMA postgrest; @@ -30,7 +30,7 @@ CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog; COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language'; -SET search_path = "1", pg_catalog; +SET search_path = test, pg_catalog; CREATE TYPE enum_menagerie_type AS ENUM ( @@ -39,7 +39,7 @@ CREATE TYPE enum_menagerie_type AS ENUM ( ); -ALTER TYPE "1".enum_menagerie_type OWNER TO postgrest_test; +ALTER TYPE test.enum_menagerie_type OWNER TO postgrest_test; SET search_path = postgrest, pg_catalog; @@ -76,25 +76,25 @@ CREATE FUNCTION set_authors_only_owner() RETURNS trigger LANGUAGE plpgsql AS $$ begin - NEW.owner = current_setting('user_vars.user_id'); + NEW.owner = current_setting('postgrest.claims.id'); RETURN NEW; end $$; ALTER FUNCTION postgrest.set_authors_only_owner() OWNER TO postgrest_test; -CREATE FUNCTION "1".insert_insertable_view_with_join() RETURNS trigger +CREATE FUNCTION test.insert_insertable_view_with_join() RETURNS trigger LANGUAGE plpgsql AS $$ begin - INSERT INTO "1".auto_incrementing_pk (nullable_string, non_nullable_string) VALUES (NEW.nullable_string, NEW.non_nullable_string); + INSERT INTO test.auto_incrementing_pk (nullable_string, non_nullable_string) VALUES (NEW.nullable_string, NEW.non_nullable_string); RETURN NEW; end; $$; -ALTER FUNCTION "1".insert_insertable_view_with_join() OWNER TO postgrest_test; +ALTER FUNCTION test.insert_insertable_view_with_join() OWNER TO postgrest_test; -SET search_path = "1", pg_catalog; +SET search_path = test, pg_catalog; SET default_tablespace = ''; @@ -107,7 +107,7 @@ CREATE TABLE authors_only ( ); -ALTER TABLE "1".authors_only OWNER TO postgrest_test_author; +ALTER TABLE test.authors_only OWNER TO postgrest_test_author; CREATE TABLE auto_incrementing_pk ( @@ -118,7 +118,7 @@ CREATE TABLE auto_incrementing_pk ( ); -ALTER TABLE "1".auto_incrementing_pk OWNER TO postgrest_test; +ALTER TABLE test.auto_incrementing_pk OWNER TO postgrest_test; CREATE SEQUENCE auto_incrementing_pk_id_seq @@ -129,7 +129,7 @@ CREATE SEQUENCE auto_incrementing_pk_id_seq CACHE 1; -ALTER TABLE "1".auto_incrementing_pk_id_seq OWNER TO postgrest_test; +ALTER TABLE test.auto_incrementing_pk_id_seq OWNER TO postgrest_test; ALTER SEQUENCE auto_incrementing_pk_id_seq OWNED BY auto_incrementing_pk.id; @@ -143,7 +143,7 @@ CREATE TABLE compound_pk ( ); -ALTER TABLE "1".compound_pk OWNER TO postgrest_test; +ALTER TABLE test.compound_pk OWNER TO postgrest_test; CREATE TABLE has_fk ( @@ -153,7 +153,7 @@ CREATE TABLE has_fk ( ); -ALTER TABLE "1".has_fk OWNER TO postgrest_test; +ALTER TABLE test.has_fk OWNER TO postgrest_test; CREATE SEQUENCE has_fk_id_seq @@ -164,18 +164,18 @@ CREATE SEQUENCE has_fk_id_seq CACHE 1; -ALTER TABLE "1".has_fk_id_seq OWNER TO postgrest_test; +ALTER TABLE test.has_fk_id_seq OWNER TO postgrest_test; ALTER SEQUENCE has_fk_id_seq OWNED BY has_fk.id; -CREATE MATERIALIZED VIEW "1".materialized_view AS +CREATE MATERIALIZED VIEW test.materialized_view AS SELECT version(); -ALTER TABLE "1".materialized_view OWNER TO postgrest_test; +ALTER TABLE test.materialized_view OWNER TO postgrest_test; -CREATE VIEW "1".insertable_view_with_join AS +CREATE VIEW test.insertable_view_with_join AS SELECT has_fk.id, has_fk.auto_inc_fk, has_fk.simple_fk, @@ -186,12 +186,12 @@ CREATE VIEW "1".insertable_view_with_join AS JOIN auto_incrementing_pk USING (id)); -ALTER TABLE "1".insertable_view_with_join OWNER TO postgrest_test; +ALTER TABLE test.insertable_view_with_join OWNER TO postgrest_test; -CREATE VIEW "1".has_count_column AS +CREATE VIEW test.has_count_column AS SELECT 1 AS count; -ALTER TABLE "1".insertable_view_with_join OWNER TO postgrest_test; +ALTER TABLE test.insertable_view_with_join OWNER TO postgrest_test; CREATE TABLE items ( @@ -199,50 +199,51 @@ CREATE TABLE items ( ); -ALTER TABLE "1".items OWNER TO postgrest_test; +ALTER TABLE test.items OWNER TO postgrest_test; CREATE TABLE complex_items ( id bigint NOT NULL, name text, - settings json + settings json, + arr_data INTEGER[] ); -ALTER TABLE "1".complex_items OWNER TO postgrest_test; +ALTER TABLE test.complex_items OWNER TO postgrest_test; --- Structure for testing table relations CREATE TABLE clients( id INT PRIMARY KEY NOT NULL, name TEXT NOT NULL ); -ALTER TABLE "1".clients OWNER TO postgrest_test; +ALTER TABLE test.clients OWNER TO postgrest_test; CREATE TABLE projects( id INT PRIMARY KEY NOT NULL, name TEXT NOT NULL, client_id INT REFERENCES clients(id) ); -ALTER TABLE "1".projects OWNER TO postgrest_test; +ALTER TABLE test.projects OWNER TO postgrest_test; CREATE TABLE tasks( id INT PRIMARY KEY NOT NULL, name TEXT NOT NULL, project_id INT REFERENCES projects(id) ); -ALTER TABLE "1".tasks OWNER TO postgrest_test; +ALTER TABLE test.tasks OWNER TO postgrest_test; CREATE TABLE users( id INT PRIMARY KEY NOT NULL, name TEXT NOT NULL ); -ALTER TABLE "1".users OWNER TO postgrest_test; +ALTER TABLE test.users OWNER TO postgrest_test; CREATE TABLE users_tasks( user_id INT REFERENCES users(id), task_id INT REFERENCES tasks(id), CONSTRAINT task_user PRIMARY KEY (task_id,user_id) ); -ALTER TABLE "1".users_tasks OWNER TO postgrest_test; +ALTER TABLE test.users_tasks OWNER TO postgrest_test; CREATE TABLE comments( id INT PRIMARY KEY NOT NULL, @@ -252,31 +253,22 @@ task_id INT NOT NULL, content TEXT NOT NULL, FOREIGN KEY (task_id,user_id) REFERENCES users_tasks (task_id,user_id) ); -ALTER TABLE "1".comments OWNER TO postgrest_test; +ALTER TABLE test.comments OWNER TO postgrest_test; CREATE TABLE users_projects( user_id INT REFERENCES users(id), project_id INT REFERENCES projects(id), CONSTRAINT project_user PRIMARY KEY (project_id, user_id) ); -ALTER TABLE "1".users_projects OWNER TO postgrest_test; +ALTER TABLE test.users_projects OWNER TO postgrest_test; -CREATE VIEW "1".projects_view AS +CREATE VIEW test.projects_view AS SELECT projects.id, projects.name, projects.client_id FROM projects; -ALTER TABLE "1".projects_view OWNER TO postgrest_test; -------- SAMPLE DATA ----- -INSERT INTO clients VALUES (1, 'Microsoft'),(2, 'Apple'); -INSERT INTO projects VALUES (1,'Windows 7', 1),(2,'Windows 10', 1),(3,'IOS', 2),(4,'OSX', 2); -INSERT INTO tasks VALUES (1,'Design w7',1),(2,'Code w7',1),(3,'Design w10',2),(4,'Code w10',2),(5,'Design IOS',3),(6,'Code IOS',3),(7,'Design OSX',4),(8,'Code OSX',4); -INSERT INTO users VALUES (1, 'Angela Martin'),(2, 'Michael Scott'),(3, 'Dwight Schrute'); -INSERT INTO users_projects VALUES(1,1),(1,2),(2,3),(2,4),(3,1),(3,3); -INSERT INTO users_tasks VALUES(1,1),(1,2),(1,3),(1,4),(2,5),(2,6),(2,7),(3,1),(3,5); -INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP'); ----------------- +ALTER TABLE test.projects_view OWNER TO postgrest_test; CREATE SEQUENCE items_id_seq START WITH 1 @@ -286,27 +278,36 @@ CREATE SEQUENCE items_id_seq CACHE 1; -ALTER TABLE "1".items_id_seq OWNER TO postgrest_test; +ALTER TABLE test.items_id_seq OWNER TO postgrest_test; ALTER SEQUENCE items_id_seq OWNED BY items.id; -CREATE FUNCTION "1".getitemrange(min bigint, max bigint) RETURNS SETOF "1".items AS $$ - SELECT * FROM "1".items WHERE id > $1 AND id <= $2; +CREATE FUNCTION test.getitemrange(min bigint, max bigint) RETURNS SETOF test.items AS $$ + SELECT * FROM test.items WHERE id > $1 AND id <= $2; $$ LANGUAGE SQL; -CREATE FUNCTION "1".test_empty_rowset() RETURNS SETOF int AS $$ +CREATE FUNCTION test_empty_rowset() RETURNS SETOF int AS $$ SELECT null::int FROM (SELECT 1) a WHERE false; $$ LANGUAGE SQL; -CREATE FUNCTION "1".sayhello(name text) RETURNS text AS $$ +CREATE TYPE public.jwt_claims AS (role text, id text); + +CREATE FUNCTION test.login(id text, pass text) +RETURNS public.jwt_claims +SECURITY DEFINER +AS $$ +SELECT rolname::text, id::text FROM postgrest.auth WHERE id = id AND pass = pass; +$$ LANGUAGE SQL; + +CREATE FUNCTION test.sayhello(name text) RETURNS text AS $$ SELECT 'Hello, ' || $1; $$ LANGUAGE SQL; -CREATE FUNCTION "1".problem() RETURNS void LANGUAGE plpgsql AS +CREATE FUNCTION test.problem() RETURNS void LANGUAGE plpgsql AS $$ BEGIN RAISE 'bad thing'; @@ -325,7 +326,7 @@ CREATE TABLE menagerie ( ); -ALTER TABLE "1".menagerie OWNER TO postgrest_test; +ALTER TABLE test.menagerie OWNER TO postgrest_test; CREATE TABLE no_pk ( @@ -334,7 +335,7 @@ CREATE TABLE no_pk ( ); -ALTER TABLE "1".no_pk OWNER TO postgrest_test; +ALTER TABLE test.no_pk OWNER TO postgrest_test; CREATE TABLE nullable_integer ( @@ -342,7 +343,7 @@ CREATE TABLE nullable_integer ( ); -ALTER TABLE "1".nullable_integer OWNER TO postgrest_test; +ALTER TABLE test.nullable_integer OWNER TO postgrest_test; CREATE TABLE simple_pk ( @@ -351,7 +352,7 @@ CREATE TABLE simple_pk ( ); -ALTER TABLE "1".simple_pk OWNER TO postgrest_test; +ALTER TABLE test.simple_pk OWNER TO postgrest_test; CREATE TABLE json @@ -360,14 +361,14 @@ CREATE TABLE json ); -ALTER TABLE "1".json OWNER TO postgrest_test; +ALTER TABLE test.json OWNER TO postgrest_test; CREATE TABLE tsearch ( text_search_vector tsvector ); -ALTER TABLE "1".tsearch OWNER TO postgrest_test; +ALTER TABLE test.tsearch OWNER TO postgrest_test; SET search_path = postgrest, pg_catalog; @@ -385,8 +386,8 @@ SET search_path = private, pg_catalog; CREATE TABLE articles ( + id integer PRIMARY KEY NOT NULL, body text, - id integer NOT NULL, owner name NOT NULL ); @@ -394,22 +395,32 @@ CREATE TABLE articles ( ALTER TABLE private.articles OWNER TO postgrest_test; -CREATE SEQUENCE articles_id_seq - START WITH 1 - INCREMENT BY 1 - NO MINVALUE - NO MAXVALUE - CACHE 1; +CREATE TABLE article_stars ( + article_id int REFERENCES articles(id), + user_id int REFERENCES test.users(id), + created_at timestamp NOT NULL DEFAULT now(), + CONSTRAINT user_article PRIMARY KEY (article_id, user_id) +); + +ALTER TABLE private.article_stars OWNER TO postgrest_test; -ALTER TABLE private.articles_id_seq OWNER TO postgrest_test; + +SET search_path = test, pg_catalog; -ALTER SEQUENCE articles_id_seq OWNED BY articles.id; +CREATE VIEW "articleStars" AS + SELECT article_id AS "articleId", user_id AS "userId", created_at AS "createdAt" + FROM private.article_stars; -SET search_path = "1", pg_catalog; +ALTER TABLE test."articleStars" OWNER TO postgrest_test; +CREATE VIEW articles AS + SELECT * + FROM private.articles; + +ALTER TABLE test.articles OWNER TO postgrest_test; ALTER TABLE ONLY auto_incrementing_pk ALTER COLUMN id SET DEFAULT nextval('auto_incrementing_pk_id_seq'::regclass); @@ -417,36 +428,10 @@ ALTER TABLE ONLY auto_incrementing_pk ALTER COLUMN id SET DEFAULT nextval('auto_ ALTER TABLE ONLY has_fk ALTER COLUMN id SET DEFAULT nextval('has_fk_id_seq'::regclass); - - ALTER TABLE ONLY items ALTER COLUMN id SET DEFAULT nextval('items_id_seq'::regclass); - -SET search_path = private, pg_catalog; - - -ALTER TABLE ONLY articles ALTER COLUMN id SET DEFAULT nextval('articles_id_seq'::regclass); - - -SET search_path = "1", pg_catalog; - - - - - - - - SELECT pg_catalog.setval('auto_incrementing_pk_id_seq', 1, true); - - - - - - - - SELECT pg_catalog.setval('has_fk_id_seq', 1, false); @@ -469,24 +454,20 @@ SET search_path = private, pg_catalog; +SET search_path = test, pg_catalog; -SELECT pg_catalog.setval('articles_id_seq', 1, false); - - -SET search_path = "1", pg_catalog; - -CREATE FUNCTION public.always_true("1".items) RETURNS boolean +CREATE FUNCTION public.always_true(test.items) RETURNS boolean LANGUAGE sql STABLE AS $$ SELECT true $$; -ALTER FUNCTION public.always_true("1".items) OWNER TO postgrest_test; +ALTER FUNCTION public.always_true(test.items) OWNER TO postgrest_test; ALTER TABLE ONLY authors_only ADD CONSTRAINT authors_only_pkey PRIMARY KEY (secret); -CREATE TRIGGER insert_insertable_view_with_join INSTEAD OF INSERT ON "1".insertable_view_with_join FOR EACH ROW EXECUTE PROCEDURE "1".insert_insertable_view_with_join(); +CREATE TRIGGER insert_insertable_view_with_join INSTEAD OF INSERT ON test.insertable_view_with_join FOR EACH ROW EXECUTE PROCEDURE test.insert_insertable_view_with_join(); CREATE TRIGGER secrets_owner_track BEFORE INSERT OR UPDATE ON authors_only FOR EACH ROW EXECUTE PROCEDURE postgrest.set_authors_only_owner(); @@ -533,10 +514,6 @@ ALTER TABLE ONLY auth SET search_path = private, pg_catalog; -ALTER TABLE ONLY articles - ADD CONSTRAINT articles_pkey PRIMARY KEY (id); - - SET search_path = postgrest, pg_catalog; @@ -549,7 +526,7 @@ SET search_path = private, pg_catalog; CREATE TRIGGER articles_owner_track BEFORE INSERT OR UPDATE ON articles FOR EACH ROW EXECUTE PROCEDURE postgrest.update_owner(); -SET search_path = "1", pg_catalog; +SET search_path = test, pg_catalog; ALTER TABLE ONLY has_fk @@ -562,11 +539,11 @@ ALTER TABLE ONLY has_fk -REVOKE ALL ON SCHEMA "1" FROM PUBLIC; -REVOKE ALL ON SCHEMA "1" FROM postgrest_test; -GRANT ALL ON SCHEMA "1" TO postgrest_test; -GRANT USAGE ON SCHEMA "1" TO postgrest_anonymous; -GRANT USAGE ON SCHEMA "1" TO postgrest_test_author; +REVOKE ALL ON SCHEMA test FROM PUBLIC; +REVOKE ALL ON SCHEMA test FROM postgrest_test; +GRANT ALL ON SCHEMA test TO postgrest_test; +GRANT USAGE ON SCHEMA test TO postgrest_anonymous; +GRANT USAGE ON SCHEMA test TO postgrest_test_author; @@ -657,6 +634,14 @@ REVOKE ALL ON TABLE projects_view FROM PUBLIC; REVOKE ALL ON TABLE projects_view FROM postgrest_test; GRANT ALL ON TABLE projects_view TO postgrest_test; GRANT ALL ON TABLE projects_view TO postgrest_anonymous; +REVOKE ALL ON TABLE articles FROM PUBLIC; +REVOKE ALL ON TABLE articles FROM postgrest_test; +GRANT ALL ON TABLE articles TO postgrest_test; +GRANT ALL ON TABLE articles TO postgrest_anonymous; +REVOKE ALL ON TABLE "articleStars" FROM PUBLIC; +REVOKE ALL ON TABLE "articleStars" FROM postgrest_test; +GRANT ALL ON TABLE "articleStars" TO postgrest_test; +GRANT ALL ON TABLE "articleStars" TO postgrest_anonymous; --------- @@ -670,6 +655,11 @@ REVOKE ALL ON FUNCTION test_empty_rowset() FROM postgrest_test; GRANT EXECUTE ON FUNCTION test_empty_rowset() TO postgrest_test; GRANT EXECUTE ON FUNCTION test_empty_rowset() TO postgrest_anonymous; +REVOKE ALL ON FUNCTION login(text, text) FROM PUBLIC; +REVOKE ALL ON FUNCTION login(text, text) FROM postgrest_test; +GRANT EXECUTE ON FUNCTION login(text, text) TO postgrest_test; +GRANT EXECUTE ON FUNCTION login(text, text) TO postgrest_anonymous; + REVOKE ALL ON FUNCTION sayhello(text) FROM PUBLIC; REVOKE ALL ON FUNCTION sayhello(text) FROM postgrest_test; GRANT EXECUTE ON FUNCTION sayhello(text) TO postgrest_test; @@ -743,10 +733,10 @@ REVOKE ALL ON TABLE has_count_column FROM postgrest_test; GRANT ALL ON TABLE has_count_column TO postgrest_test; GRANT ALL ON TABLE has_count_column TO postgrest_anonymous; -REVOKE ALL ON FUNCTION public.always_true("1".items) FROM PUBLIC; -REVOKE ALL ON FUNCTION public.always_true("1".items) FROM postgrest_test; -GRANT ALL ON FUNCTION public.always_true("1".items) TO postgrest_test; -GRANT ALL ON FUNCTION public.always_true("1".items) TO postgrest_anonymous; +REVOKE ALL ON FUNCTION public.always_true(test.items) FROM PUBLIC; +REVOKE ALL ON FUNCTION public.always_true(test.items) FROM postgrest_test; +GRANT ALL ON FUNCTION public.always_true(test.items) TO postgrest_test; +GRANT ALL ON FUNCTION public.always_true(test.items) TO postgrest_anonymous; SET search_path = postgrest, pg_catalog; @@ -764,3 +754,18 @@ SET search_path = private, pg_catalog; REVOKE ALL ON TABLE articles FROM PUBLIC; REVOKE ALL ON TABLE articles FROM postgrest_test; GRANT ALL ON TABLE articles TO postgrest_test; + +SET search_path = test, private, postgrest, public, pg_catalog; + +------- SAMPLE DATA ----- +INSERT INTO clients VALUES (1, 'Microsoft'),(2, 'Apple'); +INSERT INTO projects VALUES (1,'Windows 7', 1),(2,'Windows 10', 1),(3,'IOS', 2),(4,'OSX', 2); +INSERT INTO tasks VALUES (1,'Design w7',1),(2,'Code w7',1),(3,'Design w10',2),(4,'Code w10',2),(5,'Design IOS',3),(6,'Code IOS',3),(7,'Design OSX',4),(8,'Code OSX',4); +INSERT INTO users VALUES (1, 'Angela Martin'),(2, 'Michael Scott'),(3, 'Dwight Schrute'); +INSERT INTO users_projects VALUES(1,1),(1,2),(2,3),(2,4),(3,1),(3,3); +INSERT INTO users_tasks VALUES(1,1),(1,2),(1,3),(1,4),(2,5),(2,6),(2,7),(3,1),(3,5); +INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP'); +INSERT INTO postgrest.auth (id, pass, rolname) VALUES ('jdoe', '1234', 'postgrest_test_author'); +INSERT INTO private.articles (id, body, owner) VALUES (1, 'No… It''s a thing; it''s like a plan, but with more greatness.', 2), (2, 'Stop talking, brain thinking. Hush.', 3), (3, 'It''s a fez. I wear a fez now. Fezes are cool.', 1); +INSERT INTO private.article_stars (article_id, user_id) VALUES (1,1), (1,2), (2,3), (3,2), (1,3); +----------------