postgrest 8.0.0 → 9.0.0
raw patch · 43 files changed
+2394/−1137 lines, 43 filesdep +doctestdep +pretty-simpledep ~basedep ~hspecdep ~retry
Dependencies added: doctest, pretty-simple
Dependency ranges changed: base, hspec, retry
Files
- CHANGELOG.md +31/−0
- postgrest.cabal +32/−15
- src/PostgREST/App.hs +42/−47
- src/PostgREST/AppState.hs +19/−9
- src/PostgREST/CLI.hs +16/−10
- src/PostgREST/Config.hs +35/−31
- src/PostgREST/Config/Database.hs +13/−13
- src/PostgREST/Config/JSPath.hs +6/−14
- src/PostgREST/Config/PgVersion.hs +5/−5
- src/PostgREST/Config/Proxy.hs +5/−6
- src/PostgREST/DbStructure.hs +74/−107
- src/PostgREST/DbStructure/Identifiers.hs +4/−4
- src/PostgREST/DbStructure/Proc.hs +17/−29
- src/PostgREST/Error.hs +143/−125
- src/PostgREST/GucHeader.hs +6/−7
- src/PostgREST/Middleware.hs +51/−30
- src/PostgREST/OpenAPI.hs +30/−18
- src/PostgREST/Query/QueryBuilder.hs +91/−66
- src/PostgREST/Query/SqlFragment.hs +94/−79
- src/PostgREST/Query/Statements.hs +37/−38
- src/PostgREST/RangeQuery.hs +2/−3
- src/PostgREST/Request/ApiRequest.hs +115/−113
- src/PostgREST/Request/DbRequestBuilder.hs +34/−13
- src/PostgREST/Request/Parsers.hs +32/−14
- src/PostgREST/Request/Preferences.hs +172/−26
- src/PostgREST/Request/Types.hs +49/−25
- src/PostgREST/Version.hs +24/−11
- src/PostgREST/Workers.hs +24/−21
- test/Feature/EmbedDisambiguationSpec.hs +30/−51
- test/Feature/EmbedInnerJoinSpec.hs +356/−0
- test/Feature/InsertSpec.hs +12/−3
- test/Feature/JsonOperatorSpec.hs +41/−42
- test/Feature/LegacyGucsSpec.hs +68/−0
- test/Feature/MultipleSchemaSpec.hs +11/−14
- test/Feature/OpenApiSpec.hs +87/−2
- test/Feature/OptionsSpec.hs +18/−2
- test/Feature/QuerySpec.hs +176/−35
- test/Feature/RpcSpec.hs +272/−77
- test/Feature/UpsertSpec.hs +57/−2
- test/Main.hs +28/−19
- test/QueryCost.hs +14/−11
- test/SpecHelper.hs +4/−0
- test/doctests/Main.hs +17/−0
CHANGELOG.md view
@@ -9,6 +9,37 @@ ### Fixed +## [9.0.0] - 2021-11-25++### Added++ - #1783, Include partitioned tables into the schema cache. Allows embedding, UPSERT, INSERT with Location response, OPTIONS request and OpenAPI support for partitioned tables - @laurenceisla+ - #1878, Add Retry-After hint header when in recovery mode - @gautam1168+ - #1735, Allow calling function with single unnamed param through RPC POST. - @steve-chavez+ + Enables calling a function with a single json parameter without using `Prefer: params=single-object`+ + Enables uploading bytea to a function with `Content-Type: application/octet-stream`+ + Enables uploading raw text to a function with `Content-Type: text/plain`+ - #1938, Allow escaping inside double quotes with a backslash, e.g. `?col=in.("Double\"Quote")`, `?col=in.("Back\\slash")` - @steve-chavez+ - #1075, Allow filtering top-level resource based on embedded resources filters. This is enabled by adding `!inner` to the embedded resource, e.g. `/projects?select=*,clients!inner(*)&clients.id=eq.12`- @steve-chavez, @Iced-Sun+ - #1857, Make GUC names for headers, cookies and jwt claims compatible with PostgreSQL v14 - @laurenceisla, @robertsosinski+ + Getting the value for a header GUC on PostgreSQL 14 is done using `current_setting('request.headers')::json->>'name-of-header'` and in a similar way for `request.cookies` and `request.jwt.claims`+ + PostgreSQL versions below 14 can opt in to the new JSON GUCs by setting the `db-use-legacy-gucs` config option to false (true by default)+ - #1988, Allow specifying `unknown` for the `is` operator - @steve-chavez+ - #2031, Improve error message for ambiguous embedding and add a relevant hint that includes unambiguous embedding suggestions - @laurenceisla++### Fixed++ - #1871, Fix OpenAPI missing default values for String types and identify Array types as "array" instead of "string" - @laurenceisla+ - #1930, Fix RPC return type handling for `RETURNS TABLE` with a single column. Regression of #1615. - @wolfgangwalther+ - #1938, Fix using single double quotes(`"`) and backslashes(`/`) as values on the "in" operator - @steve-chavez+ - #1992, Fix schema cache query failing with standard_conforming_strings = off - @wolfgangwalther++### Changed++ - #1949, Drop support for embedding hints used with '.'(`select=projects.client_id(*)`), '!' should be used instead(`select=projects!client_id(*)`) - @steve-chavez+ - #1783, Partitions (created using `PARTITION OF`) are no longer included in the schema cache. - @laurenceisla+ - #2038, Dropped support for PostgreSQL 9.5 - @wolfgangwalther+ ## [8.0.0] - 2021-07-25 ### Added
postgrest.cabal view
@@ -1,5 +1,5 @@ name: postgrest-version: 8.0.0+version: 9.0.0 synopsis: REST API for any Postgres database description: Reads the schema of a PostgreSQL database and creates RESTful routes for the tables and views, supporting all HTTP verbs that security@@ -65,7 +65,7 @@ PostgREST.Version PostgREST.Workers other-modules: Paths_postgrest- build-depends: base >= 4.9 && < 4.15+ build-depends: base >= 4.9 && < 4.16 , HTTP >= 4000.3.7 && < 4000.4 , Ranged-sets >= 0.3 && < 0.5 , aeson >= 1.4.7 && < 1.6@@ -101,7 +101,7 @@ , parsec >= 3.1.11 && < 3.2 , protolude >= 0.3 && < 0.4 , regex-tdfa >= 1.2.2 && < 1.4- , retry >= 0.7.4 && < 0.9+ , retry >= 0.7.4 && < 0.10 , scientific >= 0.3.4 && < 0.4 , swagger2 >= 2.4 && < 2.7 , text >= 1.2.2 && < 1.3@@ -123,9 +123,9 @@ -fno-spec-constr -optP-Wno-nonportable-include-path if flag(dev)- ghc-options: --disable-optimizations+ ghc-options: -O0 if flag(hpc)- ghc-options: --enable-coverage -hpcdir .hpc+ ghc-options: -hpcdir .hpc else ghc-options: -O2 @@ -143,7 +143,7 @@ NoImplicitPrelude hs-source-dirs: main main-is: Main.hs- build-depends: base >= 4.9 && < 4.15+ build-depends: base >= 4.9 && < 4.16 , containers >= 0.5.7 && < 0.7 , postgrest , protolude >= 0.3 && < 0.4@@ -152,9 +152,9 @@ -fno-spec-constr -optP-Wno-nonportable-include-path if flag(dev)- ghc-options: --disable-optimizations+ ghc-options: -O0 if flag(hpc)- ghc-options: --enable-coverage -hpcdir .hpc+ ghc-options: -hpcdir .hpc else ghc-options: -O2 @@ -176,11 +176,13 @@ Feature.DeleteSpec Feature.DisabledOpenApiSpec Feature.EmbedDisambiguationSpec+ Feature.EmbedInnerJoinSpec Feature.ExtraSearchPathSpec Feature.HtmlRawOutputSpec Feature.InsertSpec Feature.IgnorePrivOpenApiSpec Feature.JsonOperatorSpec+ Feature.LegacyGucsSpec Feature.MultipleSchemaSpec Feature.NoJwtSpec Feature.NonexistentSchemaSpec@@ -201,7 +203,7 @@ Feature.UpsertSpec SpecHelper TestTypes- build-depends: base >= 4.9 && < 4.15+ build-depends: base >= 4.9 && < 4.16 , aeson >= 1.4.7 && < 1.6 , aeson-qq >= 0.8.1 && < 0.9 , async >= 2.1.1 && < 2.3@@ -216,7 +218,7 @@ , hasql-pool >= 0.5 && < 0.6 , hasql-transaction >= 1.0.1 && < 1.1 , heredoc >= 0.2 && < 0.3- , hspec >= 2.3 && < 2.8+ , hspec >= 2.3 && < 2.9 , hspec-wai >= 0.10 && < 0.12 , hspec-wai-json >= 0.10 && < 0.12 , http-types >= 0.12.3 && < 0.13@@ -232,11 +234,11 @@ , transformers-base >= 0.4.4 && < 0.5 , wai >= 3.2.1 && < 3.3 , wai-extra >= 3.0.19 && < 3.2- ghc-options: --disable-optimizations -Wall -fwarn-identities+ ghc-options: -O0 -Wall -fwarn-identities -fno-spec-constr -optP-Wno-nonportable-include-path -fno-warn-missing-signatures -test-suite spec-querycost+test-suite querycost type: exitcode-stdio-1.0 default-language: Haskell2010 default-extensions: OverloadedStrings@@ -245,7 +247,7 @@ hs-source-dirs: test main-is: QueryCost.hs other-modules: SpecHelper- build-depends: base >= 4.9 && < 4.15+ build-depends: base >= 4.9 && < 4.16 , aeson >= 1.4.7 && < 1.6 , aeson-qq >= 0.8.1 && < 0.9 , async >= 2.1.1 && < 2.3@@ -261,7 +263,7 @@ , hasql-pool >= 0.5 && < 0.6 , hasql-transaction >= 1.0.1 && < 1.1 , heredoc >= 0.2 && < 0.3- , hspec >= 2.3 && < 2.8+ , hspec >= 2.3 && < 2.9 , hspec-wai >= 0.10 && < 0.12 , hspec-wai-json >= 0.10 && < 0.12 , http-types >= 0.12.3 && < 0.13@@ -277,5 +279,20 @@ , transformers-base >= 0.4.4 && < 0.5 , wai >= 3.2.1 && < 3.3 , wai-extra >= 3.0.19 && < 3.2- ghc-options: --disable-optimizations -Wall -fwarn-identities+ ghc-options: -O0 -Wall -fwarn-identities+ -fno-spec-constr -optP-Wno-nonportable-include-path++test-suite doctests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ default-extensions: OverloadedStrings+ NoImplicitPrelude+ hs-source-dirs: test/doctests+ main-is: Main.hs+ build-depends: base >= 4.9 && < 4.16+ , doctest >= 0.8+ , postgrest+ , pretty-simple+ , protolude >= 0.3 && < 0.4+ ghc-options: -threaded -O0 -Wall -fwarn-identities -fno-spec-constr -optP-Wno-nonportable-include-path
src/PostgREST/App.hs view
@@ -26,10 +26,10 @@ setServerName) import System.Posix.Types (FileMode) -import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as LBS-import qualified Data.HashMap.Strict as Map-import qualified Data.Set as Set+import qualified Data.HashMap.Strict as M+import qualified Data.Set as S import qualified Hasql.DynamicStatements.Snippet as SQL import qualified Hasql.Pool as SQL import qualified Hasql.Transaction as SQL@@ -76,7 +76,8 @@ Target (..)) import PostgREST.Request.Preferences (PreferCount (..), PreferParameters (..),- PreferRepresentation (..))+ PreferRepresentation (..),+ toAppliedHeader) import PostgREST.Request.Types (ReadRequest, fstFieldNames) import PostgREST.Version (prettyVersion) import PostgREST.Workers (connectionWorker, listener)@@ -84,8 +85,7 @@ import qualified PostgREST.ContentType as ContentType import qualified PostgREST.DbStructure.Proc as Proc -import Protolude hiding (Handler, toS)-import Protolude.Conv (toS)+import Protolude hiding (Handler) data RequestContext = RequestContext@@ -133,7 +133,7 @@ defaultSettings & setHost (fromString $ toS configServerHost) & setPort configServerPort- & setServerName (toS $ "postgrest/" <> prettyVersion)+ & setServerName ("postgrest/" <> prettyVersion) -- | PostgREST application postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application@@ -152,13 +152,19 @@ runExceptT $ postgrestResponse conf maybeDbStructure jsonDbS pgVer (AppState.getPool appState) time req response <- either Error.errorResponseFor identity <$> eitherResponse- -- Launch the connWorker when the connection is down. The postgrest -- function can respond successfully (with a stale schema cache) before -- the connWorker is done.- when (Wai.responseStatus response == HTTP.status503) connWorker+ let isPGAway = Wai.responseStatus response == HTTP.status503+ when isPGAway connWorker+ resp <- addRetryHint isPGAway appState response+ respond resp - respond response+addRetryHint :: Bool -> AppState -> Wai.Response -> IO Wai.Response+addRetryHint shouldAdd appState response = do+ delay <- AppState.getRetryNextIn appState+ let h = ("Retry-After", BS.pack $ show delay)+ return $ Wai.mapResponseHeaders (\hs -> if shouldAdd then h:hs else hs) response postgrestResponse :: AppConfig@@ -184,7 +190,7 @@ ApiRequest.userApiRequest conf dbStructure req body -- The JWT must be checked before touching the db- jwtClaims <- Auth.jwtClaims conf (toS iJWT) time+ jwtClaims <- Auth.jwtClaims conf (toUtf8Lazy iJWT) time let handleReq apiReq =@@ -192,7 +198,7 @@ runDbHandler pool (txMode apiRequest) jwtClaims (configDbPreparedStatements conf) . Middleware.optionalRollback conf apiRequest $- Middleware.runPgLocals conf jwtClaims handleReq apiRequest jsonDbS+ Middleware.runPgLocals conf jwtClaims handleReq apiRequest jsonDbS pgVer runDbHandler :: SQL.Pool -> SQL.Mode -> Auth.JWTClaims -> Bool -> DbHandler a -> Handler IO a runDbHandler pool mode jwtClaims prepared handler = do@@ -252,7 +258,6 @@ (shouldCount iPreferCount) (iAcceptContentType == CTTextCSV) bField- ctxPgVersion configDbPreparedStatements total <- readTotal ctxConfig ctxApiRequest tableTotal countQuery@@ -264,14 +269,14 @@ [ contentRange , ( "Content-Location" , "/"- <> toS (qiName identifier)- <> if BS8.null iCanonicalQS then mempty else "?" <> toS iCanonicalQS+ <> toUtf8 (qiName identifier)+ <> if BS.null iCanonicalQS then mempty else "?" <> iCanonicalQS ) ] ++ contentTypeHeaders context failNotSingular iAcceptContentType queryTotal . response status headers $- if headersOnly then mempty else toS body+ if headersOnly then mempty else LBS.fromStrict body readTotal :: AppConfig -> ApiRequest -> Maybe Int64 -> SQL.Snippet -> DbHandler (Maybe Int64) readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery =@@ -308,7 +313,7 @@ Just ( HTTP.hLocation , "/"- <> toS qiName+ <> toUtf8 qiName <> HTTP.renderSimpleQuery True (splitKeyValue <$> resFields) ) , Just . RangeQuery.contentRangeH 1 0 $@@ -316,12 +321,12 @@ , if null pkCols && isNothing iOnConflict then Nothing else- (\x -> ("Preference-Applied", BS8.pack $ show x)) <$> iPreferResolution+ toAppliedHeader <$> iPreferResolution ] failNotSingular iAcceptContentType resQueryTotal $ if iPreferRepresentation == Full then- response HTTP.status201 (headers ++ contentTypeHeaders context) (toS resBody)+ response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict resBody) else response HTTP.status201 headers mempty @@ -332,7 +337,7 @@ let response = gucResponse resGucStatus resGucHeaders fullRepr = iPreferRepresentation == Full- updateIsNoOp = Set.null iColumns+ updateIsNoOp = S.null iColumns status | resQueryTotal == 0 && not updateIsNoOp = HTTP.status404 | fullRepr = HTTP.status200@@ -343,7 +348,7 @@ failNotSingular iAcceptContentType resQueryTotal $ if fullRepr then- response status (contentTypeHeaders context ++ [contentRangeHeader]) (toS resBody)+ response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict resBody) else response status [contentRangeHeader] mempty @@ -367,7 +372,7 @@ return $ if iPreferRepresentation == Full then- response HTTP.status200 (contentTypeHeaders context) (toS resBody)+ response HTTP.status200 (contentTypeHeaders context) (LBS.fromStrict resBody) else response HTTP.status204 (contentTypeHeaders context) mempty @@ -385,7 +390,7 @@ if iPreferRepresentation == Full then response HTTP.status200 (contentTypeHeaders context ++ [contentRangeHeader])- (toS resBody)+ (LBS.fromStrict resBody) else response HTTP.status204 [contentRangeHeader] mempty @@ -400,7 +405,7 @@ allOrigins = ("Access-Control-Allow-Origin", "*") allowH table = ( HTTP.hAllow- , BS8.intercalate "," $+ , BS.intercalate "," $ ["OPTIONS,GET,HEAD"] ++ ["POST" | tableInsertable table] ++ ["PUT" | tableInsertable table && tableUpdatable table && hasPK]@@ -423,25 +428,17 @@ (pdSchema proc) (fromMaybe (pdName proc) $ Proc.procTableName proc) - returnsSingle (ApiRequest.TargetProc target _) = Proc.procReturnsSingle target- returnsSingle _ = False- req <- readRequest identifier context bField <- binaryField context req + let callReq = ReqBuilder.callRequest proc ctxApiRequest req+ (tableTotal, queryTotal, body, gucHeaders, gucStatus) <- lift . SQL.statement mempty $ Statements.callProcStatement- (returnsScalar iTarget)- (returnsSingle iTarget)- (QueryBuilder.requestToCallProcQuery- (QualifiedIdentifier (pdSchema proc) (pdName proc))- (Proc.specifiedProcArgs iColumns proc)- iPayload- (returnsScalar iTarget)- iPreferParameters- (ReqBuilder.returningCols req [])- )+ (Proc.procReturnsScalar proc)+ (Proc.procReturnsSingle proc)+ (QueryBuilder.requestToCallProcQuery callReq) (QueryBuilder.readRequestToQuery req) (QueryBuilder.readRequestToCountQuery req) (shouldCount iPreferCount)@@ -449,7 +446,6 @@ (iAcceptContentType == CTTextCSV) (iPreferParameters == Just MultipleObjects) bField- ctxPgVersion (configDbPreparedStatements ctxConfig) response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders@@ -461,21 +457,21 @@ failNotSingular iAcceptContentType queryTotal $ response status (contentTypeHeaders context ++ [contentRange])- (if invMethod == InvHead then mempty else toS body)+ (if invMethod == InvHead then mempty else LBS.fromStrict body) handleOpenApi :: Bool -> Schema -> RequestContext -> DbHandler Wai.Response-handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest _) = do+handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure apiRequest ctxPgVersion) = do body <- lift $ case configOpenApiMode of OAFollowPriv -> OpenAPI.encode conf dbStructure- <$> SQL.statement tSchema (DbStructure.accessibleTables configDbPreparedStatements)+ <$> SQL.statement tSchema (DbStructure.accessibleTables ctxPgVersion configDbPreparedStatements) <*> SQL.statement tSchema (DbStructure.accessibleProcs configDbPreparedStatements) <*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements) OAIgnorePriv -> OpenAPI.encode conf dbStructure (filter (\x -> tableSchema x == tSchema) $ DbStructure.dbTables dbStructure)- (Map.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure)+ (M.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure) <$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements) OADisabled -> pure mempty@@ -483,7 +479,7 @@ return $ Wai.responseLBS HTTP.status200 (ContentType.toHeader CTOpenAPI : maybeToList (profileHeader apiRequest))- (if headersOnly then mempty else toS body)+ (if headersOnly then mempty else body) txMode :: ApiRequest -> SQL.Mode txMode ApiRequest{..} =@@ -534,7 +530,6 @@ (iAcceptContentType ctxApiRequest == CTTextCSV) (iPreferRepresentation ctxApiRequest) pkCols- ctxPgVersion (configDbPreparedStatements ctxConfig) liftEither $ WriteQueryResult queryTotal fields body <$> gucStatus <*> gucHeaders@@ -607,10 +602,10 @@ profileHeader :: ApiRequest -> Maybe HTTP.Header profileHeader ApiRequest{..} =- (,) "Content-Profile" <$> (toS <$> iProfile)+ (,) "Content-Profile" <$> (toUtf8 <$> iProfile) splitKeyValue :: ByteString -> (ByteString, ByteString) splitKeyValue kv =- (k, BS8.tail v)+ (k, BS.tail v) where- (k, v) = BS8.break (== '=') kv+ (k, v) = BS.break (== '=') kv
src/PostgREST/AppState.hs view
@@ -10,6 +10,7 @@ , getPgVersion , getPool , getTime+ , getRetryNextIn , init , initWithPool , logWithZTime@@ -18,12 +19,13 @@ , putIsWorkerOn , putJsonDbS , putPgVersion+ , putRetryNextIn , releasePool , signalListener , waitListener ) where -import qualified Hasql.Pool as P+import qualified Hasql.Pool as SQL import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction)@@ -37,12 +39,11 @@ import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion) import PostgREST.DbStructure (DbStructure) -import Protolude hiding (toS)-import Protolude.Conv (toS)+import Protolude data AppState = AppState- { statePool :: P.Pool -- | Connection pool, either a 'Connection' or a 'ConnectionError'+ { statePool :: SQL.Pool -- | Connection pool, either a 'Connection' or a 'ConnectionError' , statePgVersion :: IORef PgVersion -- | No schema cache at the start. Will be filled in by the connectionWorker , stateDbStructure :: IORef (Maybe DbStructure)@@ -60,6 +61,8 @@ , stateGetZTime :: IO ZonedTime -- | Used for killing the main thread in case a subthread fails , stateMainThreadId :: ThreadId+ -- | Keeps track of when the next retry for connecting to database is scheduled+ , stateRetryNextIn :: IORef Int } init :: AppConfig -> IO AppState@@ -67,7 +70,7 @@ newPool <- initPool conf initWithPool newPool conf -initWithPool :: P.Pool -> AppConfig -> IO AppState+initWithPool :: SQL.Pool -> AppConfig -> IO AppState initWithPool newPool conf = AppState newPool <$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step@@ -79,16 +82,17 @@ <*> mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime } <*> mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime } <*> myThreadId+ <*> newIORef 0 -initPool :: AppConfig -> IO P.Pool+initPool :: AppConfig -> IO SQL.Pool initPool AppConfig{..} =- P.acquire (configDbPoolSize, configDbPoolTimeout, toS configDbUri)+ SQL.acquire (configDbPoolSize, configDbPoolTimeout, toUtf8 configDbUri) -getPool :: AppState -> P.Pool+getPool :: AppState -> SQL.Pool getPool = statePool releasePool :: AppState -> IO ()-releasePool AppState{..} = P.release statePool >> throwTo stateMainThreadId UserInterrupt+releasePool AppState{..} = SQL.release statePool >> throwTo stateMainThreadId UserInterrupt getPgVersion :: AppState -> IO PgVersion getPgVersion = readIORef . statePgVersion@@ -114,6 +118,12 @@ putIsWorkerOn :: AppState -> Bool -> IO () putIsWorkerOn = atomicWriteIORef . stateIsWorkerOn++getRetryNextIn :: AppState -> IO Int+getRetryNextIn = readIORef . stateRetryNextIn++putRetryNextIn :: AppState -> Int -> IO ()+putRetryNextIn = atomicWriteIORef . stateRetryNextIn getConfig :: AppState -> IO AppConfig getConfig = readIORef . stateConf
src/PostgREST/CLI.hs view
@@ -8,12 +8,12 @@ , readCLIShowHelp ) where -import qualified Data.Aeson as Aeson+import qualified Data.Aeson as JSON+import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as LBS-import qualified Hasql.Pool as P-import qualified Hasql.Transaction.Sessions as HT+import qualified Hasql.Pool as SQL+import qualified Hasql.Transaction.Sessions as SQL import qualified Options.Applicative as O-import qualified Protolude.Conv as Conv import Data.Text.IO (hPutStrLn) import Text.Heredoc (str)@@ -53,20 +53,22 @@ dumpSchema :: AppState -> IO LBS.ByteString dumpSchema appState = do AppConfig{..} <- AppState.getConfig appState+ actualPgVersion <- AppState.getPgVersion appState result <-- let transaction = if configDbPreparedStatements then HT.transaction else HT.unpreparedTransaction in- P.use (AppState.getPool appState) $- transaction HT.ReadCommitted HT.Read $+ let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in+ SQL.use (AppState.getPool appState) $+ transaction SQL.ReadCommitted SQL.Read $ queryDbStructure (toList configDbSchemas) configDbExtraSearchPath+ actualPgVersion configDbPreparedStatements- P.release $ AppState.getPool appState+ SQL.release $ AppState.getPool appState case result of Left e -> do hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e exitFailure- Right dbStructure -> return $ Aeson.encode dbStructure+ Right dbStructure -> return $ JSON.encode dbStructure -- | Command line interface options data CLI = CLI@@ -91,7 +93,7 @@ progDesc = O.progDesc $ "PostgREST "- <> Conv.toS prettyVersion+ <> BS.unpack prettyVersion <> " / create a REST API to an existing Postgres database" footer =@@ -165,6 +167,10 @@ | |## Enable in-database configuration |db-config = true+ |+ |## Determine if GUC request settings for headers, cookies and jwt claims use the legacy names (string with dashes, invalid starting from PostgreSQL v14) with text values instead of the new names (string without dashes, valid on all PostgreSQL versions) with json values.+ |## For PostgreSQL v14 and up, this setting will be ignored.+ |db-use-legacy-gucs = true | |## how to terminate database transactions |## possible values are:
src/PostgREST/Config.hs view
@@ -29,19 +29,18 @@ import qualified Crypto.JOSE.Types as JOSE import qualified Crypto.JWT as JWT import qualified Data.Aeson as JSON-import qualified Data.ByteString as B+import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64-import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS import qualified Data.Configurator as C import qualified Data.Map.Strict as M import qualified Data.Text as T--import qualified GHC.Show (show)+import qualified Data.Text.Encoding as T import Control.Lens (preview) import Control.Monad (fail) import Crypto.JWT (JWK, JWKSet, StringOrURI, stringOrUri)-import Data.Aeson (encode, toJSON)+import Data.Aeson (toJSON) import Data.Either.Combinators (mapLeft) import Data.List (lookup) import Data.List.NonEmpty (fromList, toList)@@ -53,13 +52,13 @@ import System.Posix.Types (FileMode) import PostgREST.Config.JSPath (JSPath, JSPathExp (..),- pRoleClaimKey)+ dumpJSPath, pRoleClaimKey) import PostgREST.Config.Proxy (Proxy (..), isMalformedProxyUri, toURI)-import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, toQi)+import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi,+ toQi) -import Protolude hiding (Proxy, toList, toS)-import Protolude.Conv (toS)+import Protolude hiding (Proxy, toList) data AppConfig = AppConfig@@ -79,16 +78,17 @@ , configDbTxAllowOverride :: Bool , configDbTxRollbackAll :: Bool , configDbUri :: Text+ , configDbUseLegacyGucs :: Bool , configFilePath :: Maybe FilePath , configJWKS :: Maybe JWKSet , configJwtAudience :: Maybe StringOrURI , configJwtRoleClaimKey :: JSPath- , configJwtSecret :: Maybe B.ByteString+ , configJwtSecret :: Maybe BS.ByteString , configJwtSecretIsBase64 :: Bool , configLogLevel :: LogLevel , configOpenApiMode :: OpenAPIMode , configOpenApiServerProxyUri :: Maybe Text- , configRawMediaTypes :: [B.ByteString]+ , configRawMediaTypes :: [BS.ByteString] , configServerHost :: Text , configServerPort :: Int , configServerUnixSocket :: Maybe FilePath@@ -97,19 +97,21 @@ data LogLevel = LogCrit | LogError | LogWarn | LogInfo -instance Show LogLevel where- show LogCrit = "crit"- show LogError = "error"- show LogWarn = "warn"- show LogInfo = "info"+dumpLogLevel :: LogLevel -> Text+dumpLogLevel = \case+ LogCrit -> "crit"+ LogError -> "error"+ LogWarn -> "warn"+ LogInfo -> "info" data OpenAPIMode = OAFollowPriv | OAIgnorePriv | OADisabled deriving Eq -instance Show OpenAPIMode where- show OAFollowPriv = "follow-privileges"- show OAIgnorePriv = "ignore-privileges"- show OADisabled = "disabled"+dumpOpenApiMode :: OpenAPIMode -> Text+dumpOpenApiMode = \case+ OAFollowPriv -> "follow-privileges"+ OAIgnorePriv -> "ignore-privileges"+ OADisabled -> "disabled" -- | Dump the config toText :: AppConfig -> Text@@ -125,21 +127,22 @@ ,("db-max-rows", maybe "\"\"" show . configDbMaxRows) ,("db-pool", show . configDbPoolSize) ,("db-pool-timeout", show . floor . configDbPoolTimeout)- ,("db-pre-request", q . maybe mempty show . configDbPreRequest)+ ,("db-pre-request", q . maybe mempty dumpQi . configDbPreRequest) ,("db-prepared-statements", T.toLower . show . configDbPreparedStatements)- ,("db-root-spec", q . maybe mempty show . configDbRootSpec)+ ,("db-root-spec", q . maybe mempty dumpQi . configDbRootSpec) ,("db-schemas", q . T.intercalate "," . toList . configDbSchemas) ,("db-config", q . T.toLower . show . configDbConfig) ,("db-tx-end", q . showTxEnd) ,("db-uri", q . configDbUri)- ,("jwt-aud", toS . encode . maybe "" toJSON . configJwtAudience)- ,("jwt-role-claim-key", q . T.intercalate mempty . fmap show . configJwtRoleClaimKey)- ,("jwt-secret", q . toS . showJwtSecret)+ ,("db-use-legacy-gucs", T.toLower . show . configDbUseLegacyGucs)+ ,("jwt-aud", T.decodeUtf8 . LBS.toStrict . JSON.encode . maybe "" toJSON . configJwtAudience)+ ,("jwt-role-claim-key", q . T.intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey)+ ,("jwt-secret", q . T.decodeUtf8 . showJwtSecret) ,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)- ,("log-level", q . show . configLogLevel)- ,("openapi-mode", q . show . configOpenApiMode)+ ,("log-level", q . dumpLogLevel . configLogLevel)+ ,("openapi-mode", q . dumpOpenApiMode . configOpenApiMode) ,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)- ,("raw-media-types", q . toS . B.intercalate "," . configRawMediaTypes)+ ,("raw-media-types", q . T.decodeUtf8 . BS.intercalate "," . configRawMediaTypes) ,("server-host", q . configServerHost) ,("server-port", show . configServerPort) ,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)@@ -159,7 +162,7 @@ ( True , True ) -> "rollback-allow-override" showJwtSecret c | configJwtSecretIsBase64 c = B64.encode secret- | otherwise = toS secret+ | otherwise = secret where secret = fromMaybe mempty $ configJwtSecret c showSocketMode c = showOct (configServerUnixSocketMode c) mempty@@ -222,6 +225,7 @@ <*> parseTxEnd "db-tx-end" snd <*> parseTxEnd "db-tx-end" fst <*> reqString "db-uri"+ <*> (fromMaybe True <$> optBool "db-use-legacy-gucs") <*> pure optPath <*> pure Nothing <*> parseJwtAudience "jwt-aud"@@ -420,8 +424,8 @@ fromMaybe (maybe secret (\jwk' -> JWT.JWKSet [jwk']) maybeJWK) maybeJWKSet where- maybeJWKSet = JSON.decode (toS bytes) :: Maybe JWKSet- maybeJWK = JSON.decode (toS bytes) :: Maybe JWK+ maybeJWKSet = JSON.decodeStrict bytes :: Maybe JWKSet+ maybeJWK = JSON.decodeStrict bytes :: Maybe JWK secret = JWT.JWKSet [JWT.fromKeyMaterial keyMaterial] keyMaterial = JWT.OctKeyMaterial . JWT.OctKeyParameters $ JOSE.Base64Octets bytes
src/PostgREST/Config/Database.hs view
@@ -9,31 +9,31 @@ import qualified Hasql.Decoders as HD import qualified Hasql.Encoders as HE-import qualified Hasql.Pool as P-import qualified Hasql.Session as H-import qualified Hasql.Statement as H-import qualified Hasql.Transaction as HT-import qualified Hasql.Transaction.Sessions as HT+import qualified Hasql.Pool as SQL+import Hasql.Session (Session, statement)+import qualified Hasql.Statement as SQL+import qualified Hasql.Transaction as SQL+import qualified Hasql.Transaction.Sessions as SQL import Text.InterpolatedString.Perl6 (q) import Protolude -queryPgVersion :: H.Session PgVersion-queryPgVersion = H.statement mempty $ H.Statement sql HE.noParams versionRow False+queryPgVersion :: Session PgVersion+queryPgVersion = statement mempty $ SQL.Statement sql HE.noParams versionRow False where sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')" versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text -queryDbSettings :: P.Pool -> Bool -> IO (Either P.UsageError [(Text, Text)])+queryDbSettings :: SQL.Pool -> Bool -> IO (Either SQL.UsageError [(Text, Text)]) queryDbSettings pool prepared =- let transaction = if prepared then HT.transaction else HT.unpreparedTransaction in- P.use pool . transaction HT.ReadCommitted HT.Read $- HT.statement mempty dbSettingsStatement+ let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in+ SQL.use pool . transaction SQL.ReadCommitted SQL.Read $+ SQL.statement mempty dbSettingsStatement -- | Get db settings from the connection role. Global settings will be overridden by database specific settings.-dbSettingsStatement :: H.Statement () [(Text, Text)]-dbSettingsStatement = H.Statement sql HE.noParams decodeSettings False+dbSettingsStatement :: SQL.Statement () [(Text, Text)]+dbSettingsStatement = SQL.Statement sql HE.noParams decodeSettings False where sql = [q| with
src/PostgREST/Config/JSPath.hs view
@@ -1,12 +1,7 @@-{-|-Module : PostgREST.Types-Description : PostgREST common types and functions used by the rest of the modules--}-{-# LANGUAGE DuplicateRecordFields #-}- module PostgREST.Config.JSPath ( JSPath , JSPathExp(..)+ , dumpJSPath , pRoleClaimKey ) where @@ -16,10 +11,7 @@ import Text.ParserCombinators.Parsec ((<?>)) import Text.Read (read) -import qualified GHC.Show (show)--import Protolude hiding (toS)-import Protolude.Conv (toS)+import Protolude -- | full jspath, e.g. .property[0].attr.detail@@ -30,10 +22,10 @@ = JSPKey Text | JSPIdx Int -instance Show JSPathExp where- -- TODO: this needs to be quoted properly for special chars- show (JSPKey k) = "." <> show k- show (JSPIdx i) = "[" <> show i <> "]"+dumpJSPath :: JSPathExp -> Text+-- TODO: this needs to be quoted properly for special chars+dumpJSPath (JSPKey k) = "." <> show k+dumpJSPath (JSPIdx i) = "[" <> show i <> "]" -- Used for the config value "role-claim-key" pRoleClaimKey :: Text -> Either Text JSPath
src/PostgREST/Config/PgVersion.hs view
@@ -3,7 +3,6 @@ module PostgREST.Config.PgVersion ( PgVersion(..) , minimumPgVersion- , pgVersion95 , pgVersion96 , pgVersion100 , pgVersion109@@ -12,6 +11,7 @@ , pgVersion114 , pgVersion121 , pgVersion130+ , pgVersion140 ) where import qualified Data.Aeson as JSON@@ -30,10 +30,7 @@ -- | Tells the minimum PostgreSQL version required by this version of PostgREST minimumPgVersion :: PgVersion-minimumPgVersion = pgVersion95--pgVersion95 :: PgVersion-pgVersion95 = PgVersion 90500 "9.5"+minimumPgVersion = pgVersion96 pgVersion96 :: PgVersion pgVersion96 = PgVersion 90600 "9.6"@@ -58,3 +55,6 @@ pgVersion130 :: PgVersion pgVersion130 = PgVersion 130000 "13.0"++pgVersion140 :: PgVersion+pgVersion140 = PgVersion 140000 "14.0"
src/PostgREST/Config/Proxy.hs view
@@ -8,13 +8,12 @@ , toURI ) where +import qualified Data.Text as T+ import Data.Maybe (fromJust)-import Data.Text (pack, toLower) import Network.URI (URI (..), URIAuth (..), isAbsoluteURI, parseURI) -import Protolude hiding (Proxy, dropWhile, get, intercalate,- toLower, toS, (&))-import Protolude.Conv (toS)+import Protolude hiding (Proxy) data Proxy = Proxy { proxyScheme :: Text@@ -48,8 +47,8 @@ isSchemeValid :: URI -> Bool isSchemeValid URI {uriScheme = s}- | toLower (pack s) == "https:" = True- | toLower (pack s) == "http:" = True+ | T.toLower (T.pack s) == "https:" = True+ | T.toLower (T.pack s) == "http:" = True | otherwise = False isQueryValid :: URI -> Bool
src/PostgREST/DbStructure.hs view
@@ -33,18 +33,20 @@ import qualified Data.List as L import qualified Hasql.Decoders as HD import qualified Hasql.Encoders as HE-import qualified Hasql.Statement as H-import qualified Hasql.Transaction as HT+import qualified Hasql.Statement as SQL+import qualified Hasql.Transaction as SQL import Contravariant.Extras (contrazip2) import Data.Set as S (fromList) import Data.Text (split) import Text.InterpolatedString.Perl6 (q) +import PostgREST.Config.PgVersion (PgVersion, pgVersion100) import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..), Schema, TableName)-import PostgREST.DbStructure.Proc (PgArg (..), PgType (..),+import PostgREST.DbStructure.Proc (PgType (..), ProcDescription (..),+ ProcParam (..), ProcVolatility (..), ProcsMap, RetType (..)) import PostgREST.DbStructure.Relationship (Cardinality (..),@@ -53,8 +55,7 @@ Relationship (..)) import PostgREST.DbStructure.Table (Column (..), Table (..)) -import Protolude hiding (toS)-import Protolude.Conv (toS)+import Protolude import Protolude.Unsafe (unsafeHead) @@ -82,15 +83,15 @@ -- | A SQL query that can be executed independently type SqlQuery = ByteString -queryDbStructure :: [Schema] -> [Schema] -> Bool -> HT.Transaction DbStructure-queryDbStructure schemas extraSearchPath prepared = do- HT.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object- tabs <- HT.statement mempty $ allTables prepared- cols <- HT.statement schemas $ allColumns tabs prepared- srcCols <- HT.statement (schemas, extraSearchPath) $ pfkSourceColumns cols prepared- m2oRels <- HT.statement mempty $ allM2ORels tabs cols prepared- keys <- HT.statement mempty $ allPrimaryKeys tabs prepared- procs <- HT.statement schemas $ allProcs prepared+queryDbStructure :: [Schema] -> [Schema] -> PgVersion -> Bool -> SQL.Transaction DbStructure+queryDbStructure schemas extraSearchPath pgVer prepared = do+ SQL.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object+ tabs <- SQL.statement mempty $ allTables pgVer prepared+ cols <- SQL.statement schemas $ allColumns tabs prepared+ srcCols <- SQL.statement (schemas, extraSearchPath) $ pfkSourceColumns cols prepared+ m2oRels <- SQL.statement mempty $ allM2ORels tabs cols prepared+ keys <- SQL.statement mempty $ allPrimaryKeys tabs prepared+ procs <- SQL.statement schemas $ allProcs prepared let rels = addO2MRels . addM2MRels $ addViewM2ORels srcCols m2oRels keys' = addViewPrimaryKeys srcCols keys@@ -192,7 +193,7 @@ <*> column HD.text <*> nullableColumn HD.text <*> compositeArrayColumn- (PgArg+ (ProcParam <$> compositeField HD.text <*> compositeField HD.text <*> compositeField HD.bool@@ -223,13 +224,13 @@ | v == 's' = Stable | otherwise = Volatile -- only 'v' can happen here -allProcs :: Bool -> H.Statement [Schema] ProcsMap-allProcs = H.Statement (toS sql) (arrayParam HE.text) decodeProcs+allProcs :: Bool -> SQL.Statement [Schema] ProcsMap+allProcs = SQL.Statement sql (arrayParam HE.text) decodeProcs where sql = procsSqlQuery <> " WHERE pn.nspname = ANY($1)" -accessibleProcs :: Bool -> H.Statement Schema ProcsMap-accessibleProcs = H.Statement (toS sql) (param HE.text) decodeProcs+accessibleProcs :: Bool -> SQL.Statement Schema ProcsMap+accessibleProcs = SQL.Statement sql (param HE.text) decodeProcs where sql = procsSqlQuery <> " WHERE pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')" @@ -283,10 +284,8 @@ COALESCE(comp.relname, t.typname) AS name, p.proretset AS rettype_is_setof, (t.typtype = 'c'- -- Only pg pseudo type that is a row type is 'record'- or t.typtype = 'p' and t.typname = 'record'- -- if any INOUT or OUT arguments present, treat as composite- or COALESCE(proargmodes::text[] && '{b,o}', false)+ -- if any TABLE, INOUT or OUT arguments present, treat as composite+ or COALESCE(proargmodes::text[] && '{t,b,o}', false) ) AS rettype_is_composite, p.provolatile, p.provariadic > 0 as hasvariadic@@ -300,9 +299,9 @@ LEFT JOIN pg_catalog.pg_description as d ON d.objoid = p.oid |] -schemaDescription :: Bool -> H.Statement Schema (Maybe Text)+schemaDescription :: Bool -> SQL.Statement Schema (Maybe Text) schemaDescription =- H.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text))+ SQL.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text)) where sql = [q| select@@ -313,9 +312,9 @@ where n.nspname = $1 |] -accessibleTables :: Bool -> H.Statement Schema [Table]-accessibleTables =- H.Statement sql (param HE.text) decodeTables+accessibleTables :: PgVersion -> Bool -> SQL.Statement Schema [Table]+accessibleTables pgVer =+ SQL.Statement sql (param HE.text) decodeTables where sql = [q| select@@ -323,38 +322,27 @@ relname as table_name, d.description as table_description, (- c.relkind IN ('r', 'v','f')- AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8- OR EXISTS (- SELECT 1- FROM pg_trigger- WHERE- pg_trigger.tgrelid = c.oid- AND (pg_trigger.tgtype::integer & 69) = 69+ c.relkind IN ('r','p')+ OR (+ c.relkind IN ('v','f')+ -- CMD_INSERT - see allTables query below for explanation+ AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 8) = 8 ) ) AS insertable, (- c.relkind IN ('r', 'v','f')- AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 4) = 4- -- CMD_UPDATE- OR EXISTS (- SELECT 1- FROM pg_trigger- WHERE- pg_trigger.tgrelid = c.oid- and (pg_trigger.tgtype::integer & 81) = 81+ c.relkind IN ('r','p')+ OR (+ c.relkind IN ('v','f')+ -- CMD_UPDATE+ AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 4) = 4 ) ) as updatable, (- c.relkind IN ('r', 'v','f')- AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 16) = 16- -- CMD_DELETE- OR EXISTS (- SELECT 1- FROM pg_trigger- WHERE- pg_trigger.tgrelid = c.oid- and (pg_trigger.tgtype::integer & 73) = 73+ c.relkind IN ('r','p')+ OR (+ c.relkind IN ('v','f')+ -- CMD_DELETE+ AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 16) = 16 ) ) as deletable from@@ -362,8 +350,9 @@ join pg_namespace n on n.oid = c.relnamespace left join pg_catalog.pg_description as d on d.objoid = c.oid and d.objsubid = 0 where- c.relkind in ('v', 'r', 'm', 'f')- and n.nspname = $1+ c.relkind in ('v','r','m','f','p')+ and n.nspname = $1 |]+ <> relIsNotPartition pgVer <> [q| and ( pg_has_role(c.relowner, 'USAGE') or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER')@@ -458,9 +447,9 @@ filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) srcCols in pk : viewPks) -allTables :: Bool -> H.Statement () [Table]-allTables =- H.Statement sql HE.noParams decodeTables+allTables :: PgVersion -> Bool -> SQL.Statement () [Table]+allTables pgVer =+ SQL.Statement sql HE.noParams decodeTables where sql = [q| SELECT@@ -468,67 +457,45 @@ c.relname AS table_name, d.description AS table_description, (- c.relkind = 'r'+ c.relkind IN ('r','p') OR ( c.relkind in ('v','f')- AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8 -- The function `pg_relation_is_updateable` returns a bitmask where 8 -- corresponds to `1 << CMD_INSERT` in the PostgreSQL source code, i.e. -- it's possible to insert into the relation.- OR EXISTS (- SELECT 1- FROM pg_trigger- WHERE- pg_trigger.tgrelid = c.oid- AND (pg_trigger.tgtype::integer & 69) = 69- -- The trigger type `tgtype` is a bitmask where 69 corresponds to- -- TRIGGER_TYPE_ROW + TRIGGER_TYPE_INSTEAD + TRIGGER_TYPE_INSERT- -- in the PostgreSQL source code.- )+ AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 8) = 8 ) ) AS insertable, (- c.relkind = 'r'+ c.relkind IN ('r','p') OR ( c.relkind in ('v','f')- AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 4) = 4 -- CMD_UPDATE- OR EXISTS (- SELECT 1- FROM pg_trigger- WHERE- pg_trigger.tgrelid = c.oid- and (pg_trigger.tgtype::integer & 81) = 81- -- TRIGGER_TYPE_ROW + TRIGGER_TYPE_INSTEAD + TRIGGER_TYPE_UPDATE- )+ AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 4) = 4 ) ) AS updatable, (- c.relkind = 'r'+ c.relkind IN ('r','p') OR ( c.relkind in ('v','f')- AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 16) = 16 -- CMD_DELETE- OR EXISTS (- SELECT 1- FROM pg_trigger- WHERE- pg_trigger.tgrelid = c.oid- and (pg_trigger.tgtype::integer & 73) = 73- -- TRIGGER_TYPE_ROW + TRIGGER_TYPE_INSTEAD + TRIGGER_TYPE_DELETE- )+ AND (pg_relation_is_updatable(c.oid::regclass, TRUE) & 16) = 16 ) ) AS deletable FROM pg_class c JOIN pg_namespace n ON n.oid = c.relnamespace LEFT JOIN pg_catalog.pg_description as d on d.objoid = c.oid and d.objsubid = 0- WHERE c.relkind IN ('v','r','m','f')- AND n.nspname NOT IN ('pg_catalog', 'information_schema')+ WHERE c.relkind IN ('v','r','m','f','p')+ AND n.nspname NOT IN ('pg_catalog', 'information_schema') |]+ <> relIsNotPartition pgVer <> [q| ORDER BY table_schema, table_name |] -allColumns :: [Table] -> Bool -> H.Statement [Schema] [Column]+relIsNotPartition :: PgVersion -> SqlQuery+relIsNotPartition pgVer = if pgVer >= pgVersion100 then " AND not c.relispartition " else mempty++allColumns :: [Table] -> Bool -> SQL.Statement [Schema] [Column] allColumns tabs =- H.Statement sql (arrayParam HE.text) (decodeColumns tabs)+ SQL.Statement sql (arrayParam HE.text) (decodeColumns tabs) where sql = [q| SELECT DISTINCT@@ -559,7 +526,7 @@ pg_catalog.pg_namespace n WHERE r.contype IN ('f', 'p', 'u')- AND c.relkind IN ('r', 'v', 'f', 'm')+ AND c.relkind IN ('r', 'v', 'f', 'm', 'p') AND r.conrelid = c.oid AND c.relnamespace = n.oid AND n.nspname <> ANY (ARRAY['pg_catalog', 'information_schema'] || $1)@@ -617,7 +584,7 @@ NOT pg_is_other_temp_schema(nc.oid) AND a.attnum > 0 AND NOT a.attisdropped- AND c.relkind in ('r', 'v', 'f', 'm')+ AND c.relkind in ('r', 'v', 'f', 'm', 'p') -- Filter only columns that are FK/PK or in the api schema: AND (nc.nspname = ANY ($1) OR kc.r_oid IS NOT NULL) )@@ -659,9 +626,9 @@ parseEnum :: Maybe Text -> [Text] parseEnum = maybe [] (split (==',')) -allM2ORels :: [Table] -> [Column] -> Bool -> H.Statement () [Relationship]+allM2ORels :: [Table] -> [Column] -> Bool -> SQL.Statement () [Relationship] allM2ORels tabs cols =- H.Statement sql HE.noParams (decodeRels tabs cols)+ SQL.Statement sql HE.noParams (decodeRels tabs cols) where sql = [q| SELECT ns1.nspname AS table_schema,@@ -697,9 +664,9 @@ cols = mapM (findCol rs rt) rcs colsF = mapM (findCol frs frt) frcs -allPrimaryKeys :: [Table] -> Bool -> H.Statement () [PrimaryKey]+allPrimaryKeys :: [Table] -> Bool -> SQL.Statement () [PrimaryKey] allPrimaryKeys tabs =- H.Statement sql HE.noParams (decodePks tabs)+ SQL.Statement sql HE.noParams (decodePks tabs) where sql = [q| -- CTE to replace information_schema.table_constraints to remove owner limit@@ -716,7 +683,7 @@ nc.oid = c.connamespace AND nr.oid = r.relnamespace AND c.conrelid = r.oid- AND r.relkind = 'r'+ AND r.relkind IN ('r', 'p') AND NOT pg_is_other_temp_schema(nr.oid) AND c.contype = 'p' ),@@ -753,7 +720,7 @@ AND r.oid = c.conrelid AND nc.oid = c.connamespace AND c.contype in ('p', 'u', 'f')- AND r.relkind = 'r'+ AND r.relkind IN ('r', 'p') AND NOT pg_is_other_temp_schema(nr.oid) ) ss WHERE@@ -778,9 +745,9 @@ where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs -- returns all the primary and foreign key columns which are referenced in views-pfkSourceColumns :: [Column] -> Bool -> H.Statement ([Schema], [Schema]) [SourceColumn]+pfkSourceColumns :: [Column] -> Bool -> SQL.Statement ([Schema], [Schema]) [SourceColumn] pfkSourceColumns cols =- H.Statement sql (contrazip2 (arrayParam HE.text) (arrayParam HE.text)) (decodeSourceColumns cols)+ SQL.Statement sql (contrazip2 (arrayParam HE.text) (arrayParam HE.text)) (decodeSourceColumns cols) -- query explanation at: -- * rationale: https://gist.github.com/wolfgangwalther/5425d64e7b0d20aad71f6f68474d9f19 -- * json transformation: https://gist.github.com/wolfgangwalther/3a8939da680c24ad767e93ad2c183089@@ -852,8 +819,8 @@ ',' , '' -- The same applies for `{` and `}`, although those are used a lot in pg_node_tree. -- We remove the escaped ones, which might be part of column names again.- ), '\{' , ''- ), '\}' , ''+ ), E'\\{' , ''+ ), E'\\}' , '' -- The fields we need are formatted as json manually to protect them from the regex. ), ' :targetList ' , ',"targetList":' ), ' :resno ' , ',"resno":'
src/PostgREST/DbStructure/Identifiers.hs view
@@ -6,12 +6,12 @@ , Schema , TableName , FieldName+ , dumpQi , toQi ) where import qualified Data.Aeson as JSON import qualified Data.Text as T-import qualified GHC.Show import Protolude @@ -26,9 +26,9 @@ instance Hashable QualifiedIdentifier -instance Show QualifiedIdentifier where- show (QualifiedIdentifier s i) =- (if T.null s then mempty else toS s <> ".") <> toS i+dumpQi :: QualifiedIdentifier -> Text+dumpQi (QualifiedIdentifier s i) =+ (if T.null s then mempty else s <> ".") <> i -- TODO: Handle a case where the QI comes like this: "my.fav.schema"."my.identifier" -- Right now it only handles the schema.identifier case
src/PostgREST/DbStructure/Proc.hs view
@@ -2,37 +2,25 @@ {-# LANGUAGE DeriveGeneric #-} module PostgREST.DbStructure.Proc- ( PgArg(..)- , PgType(..)+ ( PgType(..) , ProcDescription(..)+ , ProcParam(..) , ProcVolatility(..) , ProcsMap , RetType(..) , procReturnsScalar , procReturnsSingle , procTableName- , specifiedProcArgs ) where import qualified Data.Aeson as JSON import qualified Data.HashMap.Strict as M-import qualified Data.Set as S -import PostgREST.DbStructure.Identifiers (FieldName,- QualifiedIdentifier (..),+import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..), Schema, TableName) import Protolude --data PgArg = PgArg- { pgaName :: Text- , pgaType :: Text- , pgaReq :: Bool- , pgaVar :: Bool- }- deriving (Eq, Ord, Generic, JSON.ToJSON)- data PgType = Scalar | Composite QualifiedIdentifier@@ -53,31 +41,31 @@ { pdSchema :: Schema , pdName :: Text , pdDescription :: Maybe Text- , pdArgs :: [PgArg]+ , pdParams :: [ProcParam] , pdReturnType :: RetType , pdVolatility :: ProcVolatility , pdHasVariadic :: Bool } deriving (Eq, Generic, JSON.ToJSON) --- Order by least number of args in the case of overloaded functions+data ProcParam = ProcParam+ { ppName :: Text+ , ppType :: Text+ , ppReq :: Bool+ , ppVar :: Bool+ }+ deriving (Eq, Ord, Generic, JSON.ToJSON)++-- Order by least number of params in the case of overloaded functions instance Ord ProcDescription where- ProcDescription schema1 name1 des1 args1 rt1 vol1 hasVar1 `compare` ProcDescription schema2 name2 des2 args2 rt2 vol2 hasVar2- | schema1 == schema2 && name1 == name2 && length args1 < length args2 = LT- | schema2 == schema2 && name1 == name2 && length args1 > length args2 = GT- | otherwise = (schema1, name1, des1, args1, rt1, vol1, hasVar1) `compare` (schema2, name2, des2, args2, rt2, vol2, hasVar2)+ ProcDescription schema1 name1 des1 prms1 rt1 vol1 hasVar1 `compare` ProcDescription schema2 name2 des2 prms2 rt2 vol2 hasVar2+ | schema1 == schema2 && name1 == name2 && length prms1 < length prms2 = LT+ | schema2 == schema2 && name1 == name2 && length prms1 > length prms2 = GT+ | otherwise = (schema1, name1, des1, prms1, rt1, vol1, hasVar1) `compare` (schema2, name2, des2, prms2, rt2, vol2, hasVar2) -- | A map of all procs, all of which can be overloaded(one entry will have more than one ProcDescription). -- | It uses a HashMap for a faster lookup. type ProcsMap = M.HashMap QualifiedIdentifier [ProcDescription]--{-|- Search the procedure parameters by matching them with the specified keys.- If the key doesn't match a parameter, a parameter with a default type "text" is assumed.--}-specifiedProcArgs :: S.Set FieldName -> ProcDescription -> [PgArg]-specifiedProcArgs keys proc =- (\k -> fromMaybe (PgArg k "text" True False) (find ((==) k . pgaName) (pdArgs proc))) <$> S.toList keys procReturnsScalar :: ProcDescription -> Bool procReturnsScalar proc = case proc of
src/PostgREST/Error.hs view
@@ -16,10 +16,13 @@ ) where import qualified Data.Aeson as JSON+import qualified Data.ByteString.Char8 as BS import qualified Data.Text as T-import qualified Hasql.Pool as P-import qualified Hasql.Session as H-import qualified Network.HTTP.Types.Status as HT+import qualified Data.Text.Encoding as T+import qualified Data.Text.Encoding.Error as T+import qualified Hasql.Pool as SQL+import qualified Hasql.Session as SQL+import qualified Network.HTTP.Types.Status as HTTP import Data.Aeson ((.=)) import Network.Wai (Response, responseLBS)@@ -29,19 +32,18 @@ import PostgREST.ContentType (ContentType (..)) import qualified PostgREST.ContentType as ContentType -import PostgREST.DbStructure.Proc (PgArg (..),- ProcDescription (..))+import PostgREST.DbStructure.Proc (ProcDescription (..),+ ProcParam (..)) import PostgREST.DbStructure.Relationship (Cardinality (..), Junction (..), Relationship (..)) import PostgREST.DbStructure.Table (Column (..), Table (..)) -import Protolude hiding (toS)-import Protolude.Conv (toS, toSL)+import Protolude class (JSON.ToJSON a) => PgrstError a where- status :: a -> HT.Status+ status :: a -> HTTP.Status headers :: a -> [Header] errorPayload :: a -> LByteString@@ -60,25 +62,25 @@ | NoRelBetween Text Text | AmbiguousRelBetween Text Text [Relationship] | AmbiguousRpc [ProcDescription]- | NoRpc Text Text [Text] Bool+ | NoRpc Text Text [Text] Bool ContentType Bool | InvalidFilters | UnacceptableSchema [Text] | ContentTypeError [ByteString] | UnsupportedVerb -- Unreachable? instance PgrstError ApiRequestError where- status InvalidRange = HT.status416- status InvalidFilters = HT.status405- status (InvalidBody _) = HT.status400- status UnsupportedVerb = HT.status405- status ActionInappropriate = HT.status405- status (ParseRequestError _ _) = HT.status400- status (NoRelBetween _ _) = HT.status400- status AmbiguousRelBetween{} = HT.status300- status (AmbiguousRpc _) = HT.status300- status NoRpc{} = HT.status404- status (UnacceptableSchema _) = HT.status406- status (ContentTypeError _) = HT.status415+ status InvalidRange = HTTP.status416+ status InvalidFilters = HTTP.status405+ status (InvalidBody _) = HTTP.status400+ status UnsupportedVerb = HTTP.status405+ status ActionInappropriate = HTTP.status405+ status (ParseRequestError _ _) = HTTP.status400+ status (NoRelBetween _ _) = HTTP.status400+ status AmbiguousRelBetween{} = HTTP.status300+ status (AmbiguousRpc _) = HTTP.status300+ status NoRpc{} = HTTP.status404+ status (UnacceptableSchema _) = HTTP.status406+ status (ContentTypeError _) = HTTP.status415 headers _ = [ContentType.toHeader CTApplicationJSON] @@ -88,22 +90,30 @@ toJSON ActionInappropriate = JSON.object [ "message" .= ("Bad Request" :: Text)] toJSON (InvalidBody errorMessage) = JSON.object [- "message" .= (toS errorMessage :: Text)]+ "message" .= T.decodeUtf8 errorMessage] toJSON InvalidRange = JSON.object [ "message" .= ("HTTP Range error" :: Text)] toJSON (NoRelBetween parent child) = JSON.object [ "hint" .= ("If a new foreign key between these entities was created in the database, try reloading the schema cache." :: Text), "message" .= ("Could not find a relationship between " <> parent <> " and " <> child <> " in the schema cache" :: Text)] toJSON (AmbiguousRelBetween parent child rels) = JSON.object [- "hint" .= ("By following the 'details' key, disambiguate the request by changing the url to /origin?select=relationship(*) or /origin?select=target!relationship(*)" :: Text),- "message" .= ("More than one relationship was found for " <> parent <> " and " <> child :: Text),+ "hint" .= ("Try changing '" <> child <> "' to one of the following: " <> relHint rels <> ". Find the desired relationship in the 'details' key." :: Text),+ "message" .= ("Could not embed because more than one relationship was found for '" <> parent <> "' and '" <> child <> "'" :: Text), "details" .= (compressedRel <$> rels) ] toJSON (AmbiguousRpc procs) = JSON.object [- "hint" .= ("Overloaded functions with the same argument name but different types are not supported" :: Text),- "message" .= ("Could not choose the best candidate function between: " <> T.intercalate ", " [pdSchema p <> "." <> pdName p <> "(" <> T.intercalate ", " [pgaName a <> " => " <> pgaType a | a <- pdArgs p] <> ")" | p <- procs])]- toJSON (NoRpc schema procName payloadKeys hasPreferSingleObject) = JSON.object [- "hint" .= ("If a new function was created in the database with this name and arguments, try reloading the schema cache." :: Text),- "message" .= ("Could not find the " <> schema <> "." <> procName <> (if hasPreferSingleObject then " function with a single json or jsonb argument" else "(" <> T.intercalate ", " payloadKeys <> ")" <> " function") <> " in the schema cache")]+ "hint" .= ("Try renaming the parameters or the function itself in the database so function overloading can be resolved" :: Text),+ "message" .= ("Could not choose the best candidate function between: " <> T.intercalate ", " [pdSchema p <> "." <> pdName p <> "(" <> T.intercalate ", " [ppName a <> " => " <> ppType a | a <- pdParams p] <> ")" | p <- procs])]+ toJSON (NoRpc schema procName argumentKeys hasPreferSingleObject contentType isInvPost) =+ let prms = "(" <> T.intercalate ", " argumentKeys <> ")" in JSON.object [+ "hint" .= ("If a new function was created in the database with this name and parameters, try reloading the schema cache." :: Text),+ "message" .= ("Could not find the " <> schema <> "." <> procName <>+ (case (hasPreferSingleObject, isInvPost, contentType) of+ (True, _, _) -> " function with a single json or jsonb parameter"+ (_, True, CTTextPlain) -> " function with a single unnamed text parameter"+ (_, True, CTOctetStream) -> " function with a single unnamed bytea parameter"+ (_, True, CTApplicationJSON) -> prms <> " function or the " <> schema <> "." <> procName <>" function with a single unnamed json or jsonb parameter"+ _ -> prms <> " function") <>+ " in the schema cache")] toJSON UnsupportedVerb = JSON.object [ "message" .= ("Unsupported HTTP verb" :: Text)] toJSON InvalidFilters = JSON.object [@@ -111,7 +121,7 @@ toJSON (UnacceptableSchema schemas) = JSON.object [ "message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas)] toJSON (ContentTypeError cts) = JSON.object [- "message" .= ("None of these Content-Types are available: " <> (toS . intercalate ", " . map toS) cts :: Text)]+ "message" .= ("None of these Content-Types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts))] compressedRel :: Relationship -> JSON.Value compressedRel Relationship{..} =@@ -119,140 +129,148 @@ fmtTbl Table{..} = tableSchema <> "." <> tableName fmtEls els = "[" <> T.intercalate ", " els <> "]" in- JSON.object $ [- "origin" .= fmtTbl relTable- , "target" .= fmtTbl relForeignTable- ] ++- case relCardinality of- M2M Junction{..} -> [- "cardinality" .= ("m2m" :: Text)- , "relationship" .= (fmtTbl junTable <> fmtEls [junConstraint1] <> fmtEls [junConstraint2])- ]- M2O cons -> [- "cardinality" .= ("m2o" :: Text)- , "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))- ]- O2M cons -> [- "cardinality" .= ("o2m" :: Text)- , "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))- ]+ JSON.object $+ ("embedding" .= (tableName relTable <> " with " <> tableName relForeignTable :: Text))+ : case relCardinality of+ M2M Junction{..} -> [+ "cardinality" .= ("many-to-many" :: Text)+ , "relationship" .= (fmtTbl junTable <> fmtEls [junConstraint1] <> fmtEls [junConstraint2])+ ]+ M2O cons -> [+ "cardinality" .= ("many-to-one" :: Text)+ , "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))+ ]+ O2M cons -> [+ "cardinality" .= ("one-to-many" :: Text)+ , "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))+ ] -data PgError = PgError Authenticated P.UsageError+relHint :: [Relationship] -> Text+relHint rels = T.intercalate ", " (hintList <$> rels)+ where+ hintList Relationship{..} =+ let buildHint rel = "'" <> tableName relForeignTable <> "!" <> rel <> "'" in+ case relCardinality of+ M2M Junction{..} -> buildHint (tableName junTable)+ M2O cons -> buildHint cons+ O2M cons -> buildHint cons++data PgError = PgError Authenticated SQL.UsageError type Authenticated = Bool instance PgrstError PgError where status (PgError authed usageError) = pgErrorStatus authed usageError headers err =- if status err == HT.status401+ if status err == HTTP.status401 then [ContentType.toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header] else [ContentType.toHeader CTApplicationJSON] instance JSON.ToJSON PgError where toJSON (PgError _ usageError) = JSON.toJSON usageError -instance JSON.ToJSON P.UsageError where- toJSON (P.ConnectionError e) = JSON.object [+instance JSON.ToJSON SQL.UsageError where+ toJSON (SQL.ConnectionError e) = JSON.object [ "code" .= ("" :: Text), "message" .= ("Database connection error. Retrying the connection." :: Text),- "details" .= (toSL $ fromMaybe "" e :: Text)]- toJSON (P.SessionError e) = JSON.toJSON e -- H.Error+ "details" .= (T.decodeUtf8With T.lenientDecode $ fromMaybe "" e :: Text)]+ toJSON (SQL.SessionError e) = JSON.toJSON e -- SQL.Error -instance JSON.ToJSON H.QueryError where- toJSON (H.QueryError _ _ e) = JSON.toJSON e+instance JSON.ToJSON SQL.QueryError where+ toJSON (SQL.QueryError _ _ e) = JSON.toJSON e -instance JSON.ToJSON H.CommandError where- toJSON (H.ResultError (H.ServerError c m d h)) = case toS c of+instance JSON.ToJSON SQL.CommandError where+ toJSON (SQL.ResultError (SQL.ServerError c m d h)) = case BS.unpack c of 'P':'T':_ -> JSON.object [- "details" .= (fmap toS d :: Maybe Text),- "hint" .= (fmap toS h :: Maybe Text)]+ "details" .= fmap T.decodeUtf8 d,+ "hint" .= fmap T.decodeUtf8 h] _ -> JSON.object [- "code" .= (toS c :: Text),- "message" .= (toS m :: Text),- "details" .= (fmap toS d :: Maybe Text),- "hint" .= (fmap toS h :: Maybe Text)]+ "code" .= (T.decodeUtf8 c :: Text),+ "message" .= (T.decodeUtf8 m :: Text),+ "details" .= (fmap T.decodeUtf8 d :: Maybe Text),+ "hint" .= (fmap T.decodeUtf8 h :: Maybe Text)] - toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [+ toJSON (SQL.ResultError (SQL.UnexpectedResult m)) = JSON.object [ "message" .= (m :: Text)]- toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [+ toJSON (SQL.ResultError (SQL.RowError i SQL.EndOfInput)) = JSON.object [ "message" .= ("Row error: end of input" :: Text), "details" .= ("Attempt to parse more columns than there are in the result" :: Text), "hint" .= (("Row number " <> show i) :: Text)]- toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [+ toJSON (SQL.ResultError (SQL.RowError i SQL.UnexpectedNull)) = JSON.object [ "message" .= ("Row error: unexpected null" :: Text), "details" .= ("Attempt to parse a NULL as some value." :: Text), "hint" .= (("Row number " <> show i) :: Text)]- toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [+ toJSON (SQL.ResultError (SQL.RowError i (SQL.ValueError d))) = JSON.object [ "message" .= ("Row error: Wrong value parser used" :: Text), "details" .= d, "hint" .= (("Row number " <> show i) :: Text)]- toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [+ toJSON (SQL.ResultError (SQL.UnexpectedAmountOfRows i)) = JSON.object [ "message" .= ("Unexpected amount of rows" :: Text), "details" .= i]- toJSON (H.ClientError d) = JSON.object [+ toJSON (SQL.ClientError d) = JSON.object [ "message" .= ("Database client error. Retrying the connection." :: Text),- "details" .= (fmap toS d :: Maybe Text)]+ "details" .= (fmap T.decodeUtf8 d :: Maybe Text)] -pgErrorStatus :: Bool -> P.UsageError -> HT.Status-pgErrorStatus _ (P.ConnectionError _) = HT.status503-pgErrorStatus _ (P.SessionError (H.QueryError _ _ (H.ClientError _))) = HT.status503-pgErrorStatus authed (P.SessionError (H.QueryError _ _ (H.ResultError rError))) =+pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status+pgErrorStatus _ (SQL.ConnectionError _) = HTTP.status503+pgErrorStatus _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503+pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rError))) = case rError of- (H.ServerError c m _ _) ->- case toS c of- '0':'8':_ -> HT.status503 -- pg connection err- '0':'9':_ -> HT.status500 -- triggered action exception- '0':'L':_ -> HT.status403 -- invalid grantor- '0':'P':_ -> HT.status403 -- invalid role specification- "23503" -> HT.status409 -- foreign_key_violation- "23505" -> HT.status409 -- unique_violation- "25006" -> HT.status405 -- read_only_sql_transaction- '2':'5':_ -> HT.status500 -- invalid tx state- '2':'8':_ -> HT.status403 -- invalid auth specification- '2':'D':_ -> HT.status500 -- invalid tx termination- '3':'8':_ -> HT.status500 -- external routine exception- '3':'9':_ -> HT.status500 -- external routine invocation- '3':'B':_ -> HT.status500 -- savepoint exception- '4':'0':_ -> HT.status500 -- tx rollback- '5':'3':_ -> HT.status503 -- insufficient resources- '5':'4':_ -> HT.status413 -- too complex- '5':'5':_ -> HT.status500 -- obj not on prereq state- '5':'7':_ -> HT.status500 -- operator intervention- '5':'8':_ -> HT.status500 -- system error- 'F':'0':_ -> HT.status500 -- conf file error- 'H':'V':_ -> HT.status500 -- foreign data wrapper error- "P0001" -> HT.status400 -- default code for "raise"- 'P':'0':_ -> HT.status500 -- PL/pgSQL Error- 'X':'X':_ -> HT.status500 -- internal Error- "42883" -> HT.status404 -- undefined function- "42P01" -> HT.status404 -- undefined table- "42501" -> if authed then HT.status403 else HT.status401 -- insufficient privilege- 'P':'T':n -> fromMaybe HT.status500 (HT.mkStatus <$> readMaybe n <*> pure m)- _ -> HT.status400+ (SQL.ServerError c m _ _) ->+ case BS.unpack c of+ '0':'8':_ -> HTTP.status503 -- pg connection err+ '0':'9':_ -> HTTP.status500 -- triggered action exception+ '0':'L':_ -> HTTP.status403 -- invalid grantor+ '0':'P':_ -> HTTP.status403 -- invalid role specification+ "23503" -> HTTP.status409 -- foreign_key_violation+ "23505" -> HTTP.status409 -- unique_violation+ "25006" -> HTTP.status405 -- read_only_sql_transaction+ '2':'5':_ -> HTTP.status500 -- invalid tx state+ '2':'8':_ -> HTTP.status403 -- invalid auth specification+ '2':'D':_ -> HTTP.status500 -- invalid tx termination+ '3':'8':_ -> HTTP.status500 -- external routine exception+ '3':'9':_ -> HTTP.status500 -- external routine invocation+ '3':'B':_ -> HTTP.status500 -- savepoint exception+ '4':'0':_ -> HTTP.status500 -- tx rollback+ '5':'3':_ -> HTTP.status503 -- insufficient resources+ '5':'4':_ -> HTTP.status413 -- too complex+ '5':'5':_ -> HTTP.status500 -- obj not on prereq state+ '5':'7':_ -> HTTP.status500 -- operator intervention+ '5':'8':_ -> HTTP.status500 -- system error+ 'F':'0':_ -> HTTP.status500 -- conf file error+ 'H':'V':_ -> HTTP.status500 -- foreign data wrapper error+ "P0001" -> HTTP.status400 -- default code for "raise"+ 'P':'0':_ -> HTTP.status500 -- PL/pgSQL Error+ 'X':'X':_ -> HTTP.status500 -- internal Error+ "42883" -> HTTP.status404 -- undefined function+ "42P01" -> HTTP.status404 -- undefined table+ "42501" -> if authed then HTTP.status403 else HTTP.status401 -- insufficient privilege+ 'P':'T':n -> fromMaybe HTTP.status500 (HTTP.mkStatus <$> readMaybe n <*> pure m)+ _ -> HTTP.status400 - _ -> HT.status500+ _ -> HTTP.status500 checkIsFatal :: PgError -> Maybe Text-checkIsFatal (PgError _ (P.ConnectionError e))+checkIsFatal (PgError _ (SQL.ConnectionError e)) | isAuthFailureMessage = Just $ toS failureMessage | otherwise = Nothing- where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` toS failureMessage- failureMessage = fromMaybe mempty e-checkIsFatal (PgError _ (P.SessionError (H.QueryError _ _ (H.ResultError serverError))))+ where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` failureMessage+ failureMessage = BS.unpack $ fromMaybe mempty e+checkIsFatal (PgError _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError serverError)))) = case serverError of -- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal.- H.ServerError "42601" _ _ _+ SQL.ServerError "42601" _ _ _ -> Just "Hint: This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues" -- Check for a "prepared statement <name> already exists" error (Code 42P05: duplicate_prepared_statement). -- This would mean that a connection pooler in transaction mode is being used -- while prepared statements are enabled in the PostgREST configuration, -- both of which are incompatible with each other.- H.ServerError "42P05" _ _ _+ SQL.ServerError "42P05" _ _ _ -> Just "Hint: If you are using connection poolers in transaction mode, try setting db-prepared-statements to false." -- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation). -- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.- H.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _+ SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _ -> Just "Hint: Connection poolers in statement mode are not supported." _ -> Nothing checkIsFatal _ = Nothing@@ -273,16 +291,16 @@ | PgErr PgError instance PgrstError Error where- status GucHeadersError = HT.status500- status GucStatusError = HT.status500- status (BinaryFieldError _) = HT.status406- status ConnectionLostError = HT.status503- status PutMatchingPkError = HT.status400- status PutRangeNotAllowedError = HT.status400- status JwtTokenMissing = HT.status500- status (JwtTokenInvalid _) = HT.unauthorized401- status (SingularityError _) = HT.status406- status NotFound = HT.status404+ status GucHeadersError = HTTP.status500+ status GucStatusError = HTTP.status500+ status (BinaryFieldError _) = HTTP.status406+ status ConnectionLostError = HTTP.status503+ status PutMatchingPkError = HTTP.status400+ status PutRangeNotAllowedError = HTTP.status400+ status JwtTokenMissing = HTTP.status500+ status (JwtTokenInvalid _) = HTTP.unauthorized401+ status (SingularityError _) = HTTP.status406+ status NotFound = HTTP.status404 status (PgErr err) = status err status (ApiRequestError err) = status err @@ -298,7 +316,7 @@ toJSON GucStatusError = JSON.object [ "message" .= ("response.status guc must be a valid status code" :: Text)] toJSON (BinaryFieldError ct) = JSON.object [- "message" .= ((toS (ContentType.toMime ct) <> " requested but more than one column was selected") :: Text)]+ "message" .= ((T.decodeUtf8 (ContentType.toMime ct) <> " requested but more than one column was selected") :: Text)] toJSON ConnectionLostError = JSON.object [ "message" .= ("Database connection lost. Retrying the connection." :: Text)] @@ -309,7 +327,7 @@ toJSON (SingularityError n) = JSON.object [ "message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),- "details" .= T.unwords ["Results contain", show n, "rows,", toS (ContentType.toMime CTSingularJSON), "requires 1 row"]]+ "details" .= T.unwords ["Results contain", show n, "rows,", T.decodeUtf8 (ContentType.toMime CTSingularJSON), "requires 1 row"]] toJSON JwtTokenMissing = JSON.object [ "message" .= ("Server lacks JWT secret" :: Text)]
src/PostgREST/GucHeader.hs view
@@ -10,8 +10,7 @@ import Network.HTTP.Types.Header (Header) -import Protolude hiding (toS)-import Protolude.Conv (toS)+import Protolude {-|@@ -21,11 +20,11 @@ newtype GucHeader = GucHeader (CI.CI ByteString, ByteString) instance JSON.FromJSON GucHeader where- parseJSON (JSON.Object o) = case headMay (M.toList o) of- Just (k, JSON.String s) | M.size o == 1 -> pure $ GucHeader (CI.mk $ toS k, toS s)- | otherwise -> mzero- _ -> mzero- parseJSON _ = mzero+ parseJSON (JSON.Object o) =+ case M.toList o of+ [(k, JSON.String s)] -> pure $ GucHeader (CI.mk $ toUtf8 k, toUtf8 s)+ _ -> mzero+ parseJSON _ = mzero unwrapGucHeader :: GucHeader -> Header unwrapGucHeader (GucHeader (k, v)) = (k, v)
src/PostgREST/Middleware.hs view
@@ -14,15 +14,16 @@ import qualified Data.Aeson as JSON import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Strict as M import qualified Data.Text as T+import qualified Data.Text.Encoding as T import qualified Hasql.Decoders as HD-import qualified Hasql.DynamicStatements.Snippet as H hiding- (sql)-import qualified Hasql.DynamicStatements.Statement as H-import qualified Hasql.Transaction as H-import qualified Network.HTTP.Types.Header as HTTP+import qualified Hasql.DynamicStatements.Snippet as SQL hiding+ (sql)+import qualified Hasql.DynamicStatements.Statement as SQL+import qualified Hasql.Transaction as SQL import qualified Network.Wai as Wai import qualified Network.Wai.Logger as Wai import qualified Network.Wai.Middleware.Cors as Wai@@ -30,6 +31,8 @@ import qualified Network.Wai.Middleware.RequestLogger as Wai import qualified Network.Wai.Middleware.Static as Wai +import Control.Arrow ((***))+ import Data.Function (id) import Data.List (lookup) import Data.Scientific (FPFormat (..), formatScientific,@@ -40,6 +43,7 @@ import System.Log.FastLogger (toLogStr) import PostgREST.Config (AppConfig (..), LogLevel (..))+import PostgREST.Config.PgVersion (PgVersion (..), pgVersion140) import PostgREST.Error (Error, errorResponseFor) import PostgREST.GucHeader (addHeadersIfNotIncluded) import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet,@@ -48,41 +52,43 @@ import PostgREST.Request.Preferences -import Protolude hiding (head, toS)-import Protolude.Conv (toS)+import Protolude -- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function runPgLocals :: AppConfig -> M.HashMap Text JSON.Value ->- (ApiRequest -> ExceptT Error H.Transaction Wai.Response) ->- ApiRequest -> ByteString -> ExceptT Error H.Transaction Wai.Response-runPgLocals conf claims app req jsonDbS = do- lift $ H.statement mempty $ H.dynamicallyParameterized+ (ApiRequest -> ExceptT Error SQL.Transaction Wai.Response) ->+ ApiRequest -> ByteString -> PgVersion -> ExceptT Error SQL.Transaction Wai.Response+runPgLocals conf claims app req jsonDbS actualPgVersion = do+ lift $ SQL.statement mempty $ SQL.dynamicallyParameterized ("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql ++ specSql)) HD.noResult (configDbPreparedStatements conf)- lift $ traverse_ H.sql preReqSql+ lift $ traverse_ SQL.sql preReqSql app req where methodSql = setConfigLocal mempty ("request.method", iMethod req) pathSql = setConfigLocal mempty ("request.path", iPath req)- headersSql = setConfigLocal "request.header." <$> iHeaders req- cookiesSql = setConfigLocal "request.cookie." <$> iCookies req+ headersSql = if usesLegacyGucs+ then setConfigLocal "request.header." <$> iHeaders req+ else setConfigLocalJson "request.headers" (iHeaders req)+ cookiesSql = if usesLegacyGucs+ then setConfigLocal "request.cookie." <$> iCookies req+ else setConfigLocalJson "request.cookies" (iCookies req) claimsWithRole = let anon = JSON.String . toS $ configDbAnonRole conf in -- role claim defaults to anon if not specified in jwt M.union claims (M.singleton "role" anon)- claimsSql = setConfigLocal "request.jwt.claim." <$> [(toS c, toS $ unquoted v) | (c,v) <- M.toList claimsWithRole]- roleSql = maybeToList $ (\x -> setConfigLocal mempty ("role", toS $ unquoted x)) <$> M.lookup "role" claimsWithRole- appSettingsSql = setConfigLocal mempty <$> (join bimap toS <$> configAppSettings conf)+ claimsSql = if usesLegacyGucs+ then setConfigLocal "request.jwt.claim." <$> [(toUtf8 c, toUtf8 $ unquoted v) | (c,v) <- M.toList claimsWithRole]+ else [setConfigLocal mempty ("request.jwt.claims", LBS.toStrict $ JSON.encode claimsWithRole)]+ roleSql = maybeToList $ (\x -> setConfigLocal mempty ("role", toUtf8 $ unquoted x)) <$> M.lookup "role" claimsWithRole+ appSettingsSql = setConfigLocal mempty <$> (join bimap toUtf8 <$> configAppSettings conf) searchPathSql = let schemas = T.intercalate ", " (iSchema req : configDbExtraSearchPath conf) in- setConfigLocal mempty ("search_path", toS schemas)+ setConfigLocal mempty ("search_path", toUtf8 schemas) preReqSql = (\f -> "select " <> fromQi f <> "();") <$> configDbPreRequest conf specSql = case iTarget req of TargetProc{tpIsRootSpec=True} -> [setConfigLocal mempty ("request.spec", jsonDbS)] _ -> mempty- -- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.- setConfigLocal :: ByteString -> (ByteString, ByteString) -> H.Snippet- setConfigLocal prefix (k, v) =- "set_config(" <> unknownEncoder (prefix <> k) <> ", " <> unknownEncoder v <> ", true)"+ usesLegacyGucs = configDbUseLegacyGucs conf && actualPgVersion < pgVersion140 -- | Log in apache format. Only requests that have a status greater than minStatus are logged. -- | There's no way to filter logs in the apache format on wai-extra: https://hackage.haskell.org/package/wai-extra-3.0.29.2/docs/Network-Wai-Middleware-RequestLogger.html#t:OutputFormat.@@ -145,27 +151,27 @@ where headers = Wai.requestHeaders req accHeaders = case lookup "access-control-request-headers" headers of- Just hdrs -> map (CI.mk . toS . T.strip . toS) $ BS.split ',' hdrs- Nothing -> []+ Just hdrs -> map (CI.mk . BS.strip) $ BS.split ',' hdrs+ Nothing -> [] unquoted :: JSON.Value -> Text unquoted (JSON.String t) = t unquoted (JSON.Number n) = toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n unquoted (JSON.Bool b) = show b-unquoted v = toS $ JSON.encode v+unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v -- | Set a transaction to eventually roll back if requested and set respective -- headers on the response. optionalRollback :: AppConfig -> ApiRequest- -> ExceptT Error H.Transaction Wai.Response- -> ExceptT Error H.Transaction Wai.Response+ -> ExceptT Error SQL.Transaction Wai.Response+ -> ExceptT Error SQL.Transaction Wai.Response optionalRollback AppConfig{..} ApiRequest{..} transaction = do resp <- catchError transaction $ return . errorResponseFor when (shouldRollback || (configDbTxRollbackAll && not shouldCommit))- (lift H.condemn)+ (lift SQL.condemn) return $ Wai.mapResponseHeaders preferenceApplied resp where shouldCommit =@@ -175,9 +181,24 @@ preferenceApplied | shouldCommit = addHeadersIfNotIncluded- [(HTTP.hPreferenceApplied, BS.pack (show Commit))]+ [toAppliedHeader Commit] | shouldRollback = addHeadersIfNotIncluded- [(HTTP.hPreferenceApplied, BS.pack (show Rollback))]+ [toAppliedHeader Rollback] | otherwise = identity++-- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.+setConfigLocal :: ByteString -> (ByteString, ByteString) -> SQL.Snippet+setConfigLocal prefix (k, v) =+ "set_config(" <> unknownEncoder (prefix <> k) <> ", " <> unknownEncoder v <> ", true)"++-- | Starting from PostgreSQL v14, some characters are not allowed for config names (mostly affecting headers with "-").+-- | A JSON format string is used to avoid this problem. See https://github.com/PostgREST/postgrest/issues/1857+setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [SQL.Snippet]+setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)]+ where+ gucJsonVal :: [(ByteString, ByteString)] -> ByteString+ gucJsonVal = LBS.toStrict . JSON.encode . M.fromList . arrayByteStringToText+ arrayByteStringToText :: [(ByteString, ByteString)] -> [(Text,Text)]+ arrayByteStringToText keyVal = (T.decodeUtf8 *** T.decodeUtf8) <$> keyVal
src/PostgREST/OpenAPI.hs view
@@ -7,11 +7,13 @@ {-# LANGUAGE RecordWildCards #-} module PostgREST.OpenAPI (encode) where -import qualified Data.Aeson as JSON-import qualified Data.ByteString.Lazy as LBS-import qualified Data.HashMap.Strict as HashMap-import qualified Data.HashSet.InsOrd as Set-import qualified Data.Text as T+import qualified Data.Aeson as JSON+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.HashMap.Strict as M+import qualified Data.HashSet.InsOrd as Set+import qualified Data.Text as T+import qualified Data.Text.Encoding as T import Control.Arrow ((&&&)) import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)@@ -27,8 +29,8 @@ isMalformedProxyUri, toURI) import PostgREST.DbStructure (DbStructure (..), tableCols, tablePKCols)-import PostgREST.DbStructure.Proc (PgArg (..),- ProcDescription (..))+import PostgREST.DbStructure.Proc (ProcDescription (..),+ ProcParam (..)) import PostgREST.DbStructure.Relationship (Cardinality (..), PrimaryKey (..), Relationship (..))@@ -37,22 +39,21 @@ import PostgREST.ContentType -import Protolude hiding (Proxy, get, toS)-import Protolude.Conv (toS)+import Protolude hiding (Proxy, get) -encode :: AppConfig -> DbStructure -> [Table] -> HashMap.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString+encode :: AppConfig -> DbStructure -> [Table] -> M.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString encode conf dbStructure tables procs schemaDescription = JSON.encode $ postgrestSpec (dbRelationships dbStructure)- (concat $ HashMap.elems procs)+ (concat $ M.elems procs) (openApiTableInfo dbStructure <$> tables) (proxyUri conf) schemaDescription (dbPrimaryKeys dbStructure) makeMimeList :: [ContentType] -> MimeList-makeMimeList cs = MimeList $ fmap (fromString . toS . toMime) cs+makeMimeList cs = MimeList $ fmap (fromString . BS.unpack . toMime) cs toSwaggerType :: Text -> SwaggerType t toSwaggerType "character varying" = SwaggerString@@ -65,8 +66,19 @@ toSwaggerType "numeric" = SwaggerNumber toSwaggerType "real" = SwaggerNumber toSwaggerType "double precision" = SwaggerNumber+toSwaggerType "ARRAY" = SwaggerArray toSwaggerType _ = SwaggerString +parseDefault :: Text -> Text -> Text+parseDefault colType colDefault =+ case toSwaggerType colType of+ SwaggerString -> wrapInQuotations $ case T.stripSuffix ("::" <> colType) colDefault of+ Just def -> T.dropAround (=='\'') def+ Nothing -> colDefault+ _ -> colDefault+ where+ wrapInQuotations text = "\"" <> text <> "\""+ makeTableDef :: [Relationship] -> [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema) makeTableDef rels pks (t, cs, _) = let tn = tableName t in@@ -107,7 +119,7 @@ colDescription c s = (mempty :: Schema)- & default_ .~ (JSON.decode . toS =<< colDefault c)+ & default_ .~ (JSON.decode . toUtf8Lazy . parseDefault (colType c) =<< colDefault c) & description .~ d & enum_ .~ e & format ?~ colType c@@ -119,11 +131,11 @@ (mempty :: Schema) & description .~ pdDescription pd & type_ ?~ SwaggerObject- & properties .~ fromList (fmap makeProcProperty (pdArgs pd))- & required .~ fmap pgaName (filter pgaReq (pdArgs pd))+ & properties .~ fromList (fmap makeProcProperty (pdParams pd))+ & required .~ fmap ppName (filter ppReq (pdParams pd)) -makeProcProperty :: PgArg -> (Text, Referenced Schema)-makeProcProperty (PgArg n t _ _) = (n, Inline s)+makeProcProperty :: ProcParam -> (Text, Referenced Schema)+makeProcProperty (ProcParam n t _ _) = (n, Inline s) where s = (mempty :: Schema) & type_ ?~ toSwaggerType t@@ -313,7 +325,7 @@ & basePath ?~ T.unpack b & schemes ?~ [s'] & info .~ ((mempty :: Info)- & version .~ prettyVersion+ & version .~ T.decodeUtf8 prettyVersion & title .~ "PostgREST API" & description ?~ d) & externalDocs ?~ ((mempty :: ExternalDocs)
src/PostgREST/Query/QueryBuilder.hs view
@@ -17,30 +17,27 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.Set as S-import qualified Hasql.DynamicStatements.Snippet as H+import qualified Hasql.DynamicStatements.Snippet as SQL import Data.Tree (Tree (..)) -import PostgREST.DbStructure.Identifiers (FieldName,- QualifiedIdentifier (..))-import PostgREST.DbStructure.Proc (PgArg (..))+import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))+import PostgREST.DbStructure.Proc (ProcParam (..)) import PostgREST.DbStructure.Relationship (Cardinality (..), Relationship (..)) import PostgREST.DbStructure.Table (Table (..))-import PostgREST.Request.ApiRequest (PayloadJSON (..))-import PostgREST.Request.Preferences (PreferParameters (..),- PreferResolution (..))+import PostgREST.Request.Preferences (PreferResolution (..)) import PostgREST.Query.SqlFragment import PostgREST.Request.Types import Protolude -readRequestToQuery :: ReadRequest -> H.Snippet+readRequestToQuery :: ReadRequest -> SQL.Snippet readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) = "SELECT " <> intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <>- "FROM " <> H.sql (BS.intercalate ", " (tabl : implJs)) <> " " <>+ "FROM " <> SQL.sql (BS.intercalate ", " (tabl : implJs)) <> " " <> intercalateSnippet " " joins <> " " <> (if null logicForest && null joinConditions_ then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_)) <> " " <>@@ -52,33 +49,46 @@ qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias (joins, selects) = foldr getJoinsSelects ([],[]) forest -getJoinsSelects :: ReadRequest -> ([H.Snippet], [H.Snippet]) -> ([H.Snippet], [H.Snippet])-getJoinsSelects rr@(Node (_, (name, Just Relationship{relCardinality=card,relTable=Table{tableName=table}}, alias, _, _)) _) (j,s) =+getJoinsSelects :: ReadRequest -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])+getJoinsSelects rr@(Node (_, (name, Just Relationship{relCardinality=card,relTable=Table{tableName=table}}, alias, _, joinType, _)) _) (joins,selects) = let subquery = readRequestToQuery rr in case card of M2O _ -> let aliasOrName = fromMaybe name alias localTableName = pgFmtIdent $ table <> "_" <> aliasOrName- sel = H.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)- joi = " LEFT JOIN LATERAL( " <> subquery <> " ) AS " <> H.sql localTableName <> " ON TRUE " in- (joi:j,sel:s)- _ ->- let sel = "COALESCE (("- <> "SELECT json_agg(" <> H.sql (pgFmtIdent table) <> ".*) "- <> "FROM (" <> subquery <> ") " <> H.sql (pgFmtIdent table) <> " "- <> "), '[]') AS " <> H.sql (pgFmtIdent (fromMaybe name alias)) in- (j,sel:s)-getJoinsSelects (Node (_, (_, Nothing, _, _, _)) _) _ = ([], [])+ sel = SQL.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)+ joi = (if joinType == Just JTInner then " INNER" else " LEFT")+ <> " JOIN LATERAL( " <> subquery <> " ) AS " <> SQL.sql localTableName <> " ON TRUE " in+ (joi:joins,sel:selects)+ _ -> case joinType of+ Just JTInner ->+ let aliasOrName = fromMaybe name alias+ locTblName = table <> "_" <> aliasOrName+ localTableName = pgFmtIdent locTblName+ internalTableName = pgFmtIdent $ "_" <> locTblName+ sel = SQL.sql $ localTableName <> "." <> internalTableName <> " AS " <> pgFmtIdent aliasOrName+ joi = "INNER JOIN LATERAL(" <>+ "SELECT json_agg(" <> SQL.sql internalTableName <> ") AS " <> SQL.sql internalTableName <>+ "FROM (" <> subquery <> " ) AS " <> SQL.sql internalTableName <>+ ") AS " <> SQL.sql localTableName <> " ON " <> SQL.sql localTableName <> "IS NOT NULL" in+ (joi:joins,sel:selects)+ _ ->+ let sel = "COALESCE (("+ <> "SELECT json_agg(" <> SQL.sql (pgFmtIdent table) <> ".*) "+ <> "FROM (" <> subquery <> ") " <> SQL.sql (pgFmtIdent table) <> " "+ <> "), '[]') AS " <> SQL.sql (pgFmtIdent (fromMaybe name alias)) in+ (joins,sel:selects)+getJoinsSelects (Node (_, (_, Nothing, _, _, _, _)) _) _ = ([], []) -mutateRequestToQuery :: MutateRequest -> H.Snippet+mutateRequestToQuery :: MutateRequest -> SQL.Snippet mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) = "WITH " <> normalizedBody body <> " " <>- "INSERT INTO " <> H.sql (fromQi mainQi) <> H.sql (if S.null iCols then " " else "(" <> cols <> ") ") <>- "SELECT " <> H.sql cols <> " " <>- H.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <>+ "INSERT INTO " <> SQL.sql (fromQi mainQi) <> SQL.sql (if S.null iCols then " " else "(" <> cols <> ") ") <>+ "SELECT " <> SQL.sql cols <> " " <>+ SQL.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <> -- Only used for PUT (if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) <>- H.sql (BS.unwords [+ SQL.sql (BS.unwords [ maybe "" (\(oncDo, oncCols) -> if null oncCols then mempty@@ -100,13 +110,13 @@ -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax -- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select= -- the select has to be based on "returnings" to make computed overloaded functions not throw- then H.sql ("SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false")+ then SQL.sql ("SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false") else "WITH " <> normalizedBody body <> " " <>- "UPDATE " <> H.sql (fromQi mainQi) <> " SET " <> H.sql cols <> " " <>- "FROM (SELECT * FROM json_populate_recordset (null::" <> H.sql (fromQi mainQi) <> " , " <> H.sql selectBody <> " )) _ " <>+ "UPDATE " <> SQL.sql (fromQi mainQi) <> " SET " <> SQL.sql cols <> " " <>+ "FROM (SELECT * FROM json_populate_recordset (null::" <> SQL.sql (fromQi mainQi) <> " , " <> SQL.sql selectBody <> " )) _ " <> (if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)) <> " " <>- H.sql (returningF mainQi returnings)+ SQL.sql (returningF mainQi returnings) where cols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols) emptyBodyReturnedColumns :: SqlFragment@@ -114,42 +124,39 @@ | null returnings = "NULL" | otherwise = BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings) mutateRequestToQuery (Delete mainQi logicForest returnings) =- "DELETE FROM " <> H.sql (fromQi mainQi) <> " " <>+ "DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <> (if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree mainQi) logicForest)) <> " " <>- H.sql (returningF mainQi returnings)+ SQL.sql (returningF mainQi returnings) -requestToCallProcQuery :: QualifiedIdentifier -> [PgArg] -> Maybe PayloadJSON -> Bool -> Maybe PreferParameters -> [FieldName] -> H.Snippet-requestToCallProcQuery qi pgArgs pj returnsScalar preferParams returnings =- argsCTE <> sourceBody+requestToCallProcQuery :: CallRequest -> SQL.Snippet+requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall returnings) =+ prmsCTE <> argsBody where- body = pjRaw <$> pj- paramsAsSingleObject = preferParams == Just SingleObject- paramsAsMultipleObjects = preferParams == Just MultipleObjects-- (argsCTE, args)- | null pgArgs = (mempty, mempty)- | paramsAsSingleObject = ("WITH pgrst_args AS (SELECT NULL)", jsonPlaceHolder body)- | otherwise = (- "WITH " <> normalizedBody body <> ", " <>- H.sql (+ (prmsCTE, argFrag) = case params of+ OnePosParam prm -> ("WITH pgrst_args AS (SELECT NULL)", singleParameter args (encodeUtf8 $ ppType prm))+ KeyParams [] -> (mempty, mempty)+ KeyParams prms -> (+ "WITH " <> normalizedBody args <> ", " <>+ SQL.sql ( BS.unwords [ "pgrst_args AS (",- "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtArgs (const mempty) (\a -> " " <> encodeUtf8 (pgaType a)) <> ")",+ "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtParams prms (const mempty) (\a -> " " <> encodeUtf8 (ppType a)) <> ")", ")"])- , H.sql $ if paramsAsMultipleObjects- then fmtArgs varadicPrefix (\a -> " := pgrst_args." <> pgFmtIdent (pgaName a))- else fmtArgs varadicPrefix (\a -> " := (SELECT " <> pgFmtIdent (pgaName a) <> " FROM pgrst_args LIMIT 1)")+ , SQL.sql $ if multipleCall+ then fmtParams prms varadicPrefix (\a -> " := pgrst_args." <> pgFmtIdent (ppName a))+ else fmtParams prms varadicPrefix (\a -> " := (SELECT " <> pgFmtIdent (ppName a) <> " FROM pgrst_args LIMIT 1)") ) - fmtArgs :: (PgArg -> SqlFragment) -> (PgArg -> SqlFragment) -> SqlFragment- fmtArgs argFragPre argFragSuf = BS.intercalate ", " ((\a -> argFragPre a <> pgFmtIdent (pgaName a) <> argFragSuf a) <$> pgArgs)+ fmtParams :: [ProcParam] -> (ProcParam -> SqlFragment) -> (ProcParam -> SqlFragment) -> SqlFragment+ fmtParams prms prmFragPre prmFragSuf = BS.intercalate ", "+ ((\a -> prmFragPre a <> pgFmtIdent (ppName a) <> prmFragSuf a) <$> prms) - varadicPrefix :: PgArg -> SqlFragment- varadicPrefix a = if pgaVar a then "VARIADIC " else mempty+ varadicPrefix :: ProcParam -> SqlFragment+ varadicPrefix a = if ppVar a then "VARIADIC " else mempty - sourceBody :: H.Snippet- sourceBody- | paramsAsMultipleObjects =+ argsBody :: SQL.Snippet+ argsBody+ | multipleCall = if returnsScalar then "SELECT " <> callIt <> " AS pgrst_scalar FROM pgrst_args" else "SELECT pgrst_lat_args.* FROM pgrst_args, " <>@@ -159,23 +166,41 @@ then "SELECT " <> callIt <> " AS pgrst_scalar" else "SELECT " <> returnedColumns <> " FROM " <> callIt - callIt :: H.Snippet- callIt = H.sql (fromQi qi) <> "(" <> args <> ")"+ callIt :: SQL.Snippet+ callIt = SQL.sql (fromQi qi) <> "(" <> argFrag <> ")" - returnedColumns :: H.Snippet+ returnedColumns :: SQL.Snippet returnedColumns | null returnings = "*"- | otherwise = H.sql $ BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings)+ | otherwise = SQL.sql $ BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings) -- | SQL query meant for COUNTing the root node of the Tree. -- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT. -- SELECT 1 is done instead of SELECT * to prevent doing expensive operations(like functions based on the columns) -- inside the FROM target.-readRequestToCountQuery :: ReadRequest -> H.Snippet-readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) =- "SELECT 1 " <> "FROM " <> H.sql (fromQi qi) <> " " <>- if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest)+-- If the request contains INNER JOINs, then the COUNT of the root node will change.+-- For this case, we use a WHERE EXISTS instead of an INNER JOIN on the count query.+-- See https://github.com/PostgREST/postgrest/issues/2009#issuecomment-977473031+-- Only for the nodes that have an INNER JOIN linked to the root level.+readRequestToCountQuery :: ReadRequest -> SQL.Snippet+readRequestToCountQuery (Node (Select{from=qi, implicitJoins=implJoins, where_=logicForest, joinConditions=joinConditions_}, _) forest) =+ "SELECT 1 FROM " <> SQL.sql (BS.intercalate ", " (fromQi qi:(fromQi <$> implJoins))) <>+ (if null logicForest && null joinConditions_ && null subQueries+ then mempty+ else " WHERE " ) <>+ intercalateSnippet " AND " (+ map (pgFmtLogicTree qi) logicForest +++ map pgFmtJoinCondition joinConditions_ +++ subQueries+ )+ where+ subQueries = foldr existsSubquery [] forest+ existsSubquery :: ReadRequest -> [SQL.Snippet] -> [SQL.Snippet]+ existsSubquery readReq@(Node (_, (_, _, _, _, joinType, _)) _) rest =+ if joinType == Just JTInner+ then ("EXISTS (" <> readRequestToCountQuery readReq <> " )"):rest+ else mempty -limitedQuery :: H.Snippet -> Maybe Integer -> H.Snippet-limitedQuery query maxRows = query <> H.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)+limitedQuery :: SQL.Snippet -> Maybe Integer -> SQL.Snippet+limitedQuery query maxRows = query <> SQL.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
src/PostgREST/Query/SqlFragment.hs view
@@ -16,7 +16,6 @@ , countF , fromQi , ftsOperators- , jsonPlaceHolder , limitOffsetF , locationF , normalizedBody@@ -31,22 +30,22 @@ , responseStatusF , returningF , selectBody+ , singleParameter , sourceCTEName , unknownEncoder , intercalateSnippet ) where import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy as BL-import qualified Data.HashMap.Strict as HM+import qualified Data.ByteString.Lazy as LBS+import qualified Data.HashMap.Strict as M import qualified Data.Text as T-import qualified Hasql.DynamicStatements.Snippet as H+import qualified Hasql.DynamicStatements.Snippet as SQL import qualified Hasql.Encoders as HE import Data.Foldable (foldr1) import Text.InterpolatedString.Perl6 (qc) -import PostgREST.Config.PgVersion (PgVersion, pgVersion96) import PostgREST.DbStructure.Identifiers (FieldName, QualifiedIdentifier (..)) import PostgREST.RangeQuery (NonnegRange, allRange,@@ -55,12 +54,16 @@ JoinCondition (..), JsonOperand (..), JsonOperation (..),- JsonPath, LogicTree (..),- OpExpr (..), Operation (..),- OrderTerm (..), SelectItem)+ JsonPath,+ LogicOperator (..),+ LogicTree (..), OpExpr (..),+ Operation (..),+ OrderDirection (..),+ OrderNulls (..),+ OrderTerm (..), SelectItem,+ TrileanVal (..)) -import Protolude hiding (cast, toS)-import Protolude.Conv (toS)+import Protolude hiding (cast) -- | A part of a SQL query that cannot be executed independently@@ -72,8 +75,8 @@ sourceCTEName :: SqlFragment sourceCTEName = "pgrst_source" -operators :: HM.HashMap Text SqlFragment-operators = HM.union (HM.fromList [+operators :: M.HashMap Text SqlFragment+operators = M.union (M.fromList [ ("eq", "="), ("gte", ">="), ("gt", ">"),@@ -93,8 +96,8 @@ ("nxl", "&>"), ("adj", "-|-")]) ftsOperators -ftsOperators :: HM.HashMap Text SqlFragment-ftsOperators = HM.fromList [+ftsOperators :: M.HashMap Text SqlFragment+ftsOperators = M.fromList [ ("fts", "@@ to_tsquery"), ("plfts", "@@ plainto_tsquery"), ("phfts", "@@ phraseto_tsquery"),@@ -105,10 +108,11 @@ -- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads -- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays -- We do this in SQL to avoid processing the JSON in application code-normalizedBody :: Maybe BL.ByteString -> H.Snippet+-- TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body+normalizedBody :: Maybe LBS.ByteString -> SQL.Snippet normalizedBody body =- "pgrst_payload AS (SELECT " <> jsonPlaceHolder body <> " AS json_data), " <>- H.sql (BS.unwords [+ "pgrst_payload AS (SELECT " <> jsonPlaceHolder <> " AS json_data), " <>+ SQL.sql (BS.unwords [ "pgrst_body AS (", "SELECT", "CASE WHEN json_typeof(json_data) = 'array'",@@ -116,24 +120,31 @@ "ELSE json_build_array(json_data)", "END AS val", "FROM pgrst_payload)"])+ where+ jsonPlaceHolder = SQL.encoderAndParam (HE.nullable HE.unknown) (LBS.toStrict <$> body) <> "::json" --- | Equivalent to "$1::json"--- | TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body-jsonPlaceHolder :: Maybe BL.ByteString -> H.Snippet-jsonPlaceHolder body =- H.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::json"+singleParameter :: Maybe LBS.ByteString -> ByteString -> SQL.Snippet+singleParameter body typ =+ if typ == "bytea"+ -- TODO: Hasql fails when using HE.unknown with bytea(pg tries to utf8 encode).+ then SQL.encoderAndParam (HE.nullable HE.bytea) (LBS.toStrict <$> body)+ else SQL.encoderAndParam (HE.nullable HE.unknown) (LBS.toStrict <$> body) <> "::" <> SQL.sql typ selectBody :: SqlFragment selectBody = "(SELECT val FROM pgrst_body)" -pgFmtLit :: Text -> SqlFragment-pgFmtLit x =- let trimmed = trimNullChars x- escaped = "'" <> T.replace "'" "''" trimmed <> "'"- slashed = T.replace "\\" "\\\\" escaped in- encodeUtf8 $ if "\\" `T.isInfixOf` escaped- then "E" <> slashed- else slashed+-- Here we build the pg array literal, e.g '{"Hebdon, John","Other","Another"}', manually.+-- This is necessary to pass an "unknown" array and let pg infer the type.+-- There are backslashes here, but since this value is parametrized and is not a string constant+-- https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-STRINGS+-- we don't need to use the E'string' form for C-style escapes+-- https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-STRINGS-ESCAPE+pgBuildArrayLiteral :: [Text] -> Text+pgBuildArrayLiteral vals =+ let trimmed = trimNullChars+ slashed = T.replace "\\" "\\\\" . trimmed+ escaped x = "\"" <> T.replace "\"" "\\\"" (slashed x) <> "\"" in+ "{" <> T.intercalate "," (escaped <$> vals) <> "}" -- TODO: refactor by following https://github.com/PostgREST/postgrest/pull/1631#issuecomment-711070833 pgFmtIdent :: Text -> SqlFragment@@ -189,67 +200,77 @@ pgFmtColumn table "*" = fromQi table <> ".*" pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c -pgFmtField :: QualifiedIdentifier -> Field -> H.Snippet-pgFmtField table (c, jp) = H.sql (pgFmtColumn table c) <> pgFmtJsonPath jp+pgFmtField :: QualifiedIdentifier -> Field -> SQL.Snippet+pgFmtField table (c, jp) = SQL.sql (pgFmtColumn table c) <> pgFmtJsonPath jp -pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> H.Snippet-pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _) = pgFmtField table f <> H.sql (pgFmtAs fName jp alias)+pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet+pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias) -- Ideally we'd quote the cast with "pgFmtIdent cast". However, that would invalidate common casts such as "int", "bigint", etc. -- Try doing: `select 1::"bigint"` - it'll err, using "int8" will work though. There's some parser magic that pg does that's invalidated when quoting. -- Not quoting should be fine, we validate the input on Parsers.-pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _) = "CAST (" <> pgFmtField table f <> " AS " <> H.sql (encodeUtf8 cast) <> " )" <> H.sql (pgFmtAs fName jp alias)+pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _, _) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias) -pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> H.Snippet+pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SQL.Snippet pgFmtOrderTerm qi ot = pgFmtField qi (otTerm ot) <> " " <>- H.sql (BS.unwords [- BS.pack $ maybe mempty show $ otDirection ot,- BS.pack $ maybe mempty show $ otNullOrder ot])+ SQL.sql (BS.unwords [+ maybe mempty direction $ otDirection ot,+ maybe mempty nullOrder $ otNullOrder ot])+ where+ direction OrderAsc = "ASC"+ direction OrderDesc = "DESC" -pgFmtFilter :: QualifiedIdentifier -> Filter -> H.Snippet+ nullOrder OrderNullsFirst = "NULLS FIRST"+ nullOrder OrderNullsLast = "NULLS LAST"+++pgFmtFilter :: QualifiedIdentifier -> Filter -> SQL.Snippet pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of Op op val -> pgFmtFieldOp op <> " " <> case op of "like" -> unknownLiteral (T.map star val) "ilike" -> unknownLiteral (T.map star val)- "is" -> isAllowed val _ -> unknownLiteral val + -- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error.+ -- The above can be fixed by using `PREPARE boolplan AS SELECT * FROM projects where id IS NOT DISTINCT FROM $1;`+ -- However that would not accept the TRUE/FALSE/NULL/UNKNOWN keywords. See: https://stackoverflow.com/questions/6133525/proper-way-to-set-preparedstatement-parameter-to-null-under-postgres.+ -- This is why `IS` operands are whitelisted at the Parsers.hs level+ Is triVal -> pgFmtField table fld <> " IS " <> case triVal of+ TriTrue -> "TRUE"+ TriFalse -> "FALSE"+ TriNull -> "NULL"+ TriUnknown -> "UNKNOWN"+ -- We don't use "IN", we use "= ANY". IN has the following disadvantages: -- + No way to use an empty value on IN: "col IN ()" is invalid syntax. With ANY we can do "= ANY('{}')" -- + Can invalidate prepared statements: multiple parameters on an IN($1, $2, $3) will lead to using different prepared statements and not take advantage of caching.- In vals -> pgFmtField table fld <> " " <>- case vals of+ In vals -> pgFmtField table fld <> " " <> case vals of [""] -> "= ANY('{}') "- -- Here we build the pg array, e.g '{"Hebdon, John","Other","Another"}', manually. We quote the values to prevent the "," being treated as an element separator.- -- TODO: Ideally this would be done on Hasql with an encoder, but the "array unknown" is not working(Hasql doesn't pass any value).- _ -> "= ANY (" <> unknownLiteral ("{" <> T.intercalate "," ((\x -> "\"" <> x <> "\"") <$> vals) <> "}") <> ")"+ _ -> "= ANY (" <> unknownLiteral (pgBuildArrayLiteral vals) <> ") " Fts op lang val -> pgFmtFieldOp op <> "(" <> ftsLang lang <> unknownLiteral val <> ") " where ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ") pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op- sqlOperator o = H.sql $ HM.lookupDefault "=" o operators+ sqlOperator o = SQL.sql $ M.lookupDefault "=" o operators notOp = if hasNot then "NOT" else mempty star c = if c == '*' then '%' else c- -- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error.- -- The above can be fixed by using `PREPARE boolplan AS SELECT * FROM projects where id IS NOT DISTINCT FROM $1;`- -- However that would not accept the TRUE/FALSE/NULL keywords. See: https://stackoverflow.com/questions/6133525/proper-way-to-set-preparedstatement-parameter-to-null-under-postgres.- isAllowed :: Text -> H.Snippet- isAllowed v = H.sql $ maybe- (pgFmtLit v <> "::unknown") encodeUtf8- (find ((==) . T.toLower $ v) ["null","true","false"]) -pgFmtJoinCondition :: JoinCondition -> H.Snippet+pgFmtJoinCondition :: JoinCondition -> SQL.Snippet pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) =- H.sql $ pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2+ SQL.sql $ pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2 -pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> H.Snippet-pgFmtLogicTree qi (Expr hasNot op forest) = H.sql notOp <> " (" <> intercalateSnippet (" " <> BS.pack (show op) <> " ") (pgFmtLogicTree qi <$> forest) <> ")"- where notOp = if hasNot then "NOT" else mempty+pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SQL.Snippet+pgFmtLogicTree qi (Expr hasNot op forest) = SQL.sql notOp <> " (" <> intercalateSnippet (opSql op) (pgFmtLogicTree qi <$> forest) <> ")"+ where+ notOp = if hasNot then "NOT" else mempty++ opSql And = " AND "+ opSql Or = " OR " pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt -pgFmtJsonPath :: JsonPath -> H.Snippet+pgFmtJsonPath :: JsonPath -> SQL.Snippet pgFmtJsonPath = \case [] -> mempty (JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs@@ -270,7 +291,7 @@ Nothing -> mempty pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias -countF :: H.Snippet -> Bool -> (H.Snippet, SqlFragment)+countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SqlFragment) countF countQuery shouldCount = if shouldCount then (@@ -286,37 +307,31 @@ then "RETURNING 1" -- For mutation cases where there's no ?select, we return 1 to know how many rows were modified else "RETURNING " <> BS.intercalate ", " (pgFmtColumn qi <$> returnings) -limitOffsetF :: NonnegRange -> H.Snippet+limitOffsetF :: NonnegRange -> SQL.Snippet limitOffsetF range = if range == allRange then mempty else "LIMIT " <> limit <> " OFFSET " <> offset where limit = maybe "ALL" (\l -> unknownEncoder (BS.pack $ show l)) $ rangeLimit range offset = unknownEncoder (BS.pack . show $ rangeOffset range) -responseHeadersF :: PgVersion -> SqlFragment-responseHeadersF pgVer =- if pgVer >= pgVersion96- then currentSettingF "response.headers"- else "null"+responseHeadersF :: SqlFragment+responseHeadersF = currentSettingF "response.headers" -responseStatusF :: PgVersion -> SqlFragment-responseStatusF pgVer =- if pgVer >= pgVersion96- then currentSettingF "response.status"- else "null"+responseStatusF :: SqlFragment+responseStatusF = currentSettingF "response.status" -currentSettingF :: Text -> SqlFragment+currentSettingF :: SqlFragment -> SqlFragment currentSettingF setting = -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15- "nullif(current_setting(" <> pgFmtLit setting <> ", true), '')"+ "nullif(current_setting('" <> setting <> "', true), '')" -- Hasql Snippet utilities-unknownEncoder :: ByteString -> H.Snippet-unknownEncoder = H.encoderAndParam (HE.nonNullable HE.unknown)+unknownEncoder :: ByteString -> SQL.Snippet+unknownEncoder = SQL.encoderAndParam (HE.nonNullable HE.unknown) -unknownLiteral :: Text -> H.Snippet+unknownLiteral :: Text -> SQL.Snippet unknownLiteral = unknownEncoder . encodeUtf8 -intercalateSnippet :: ByteString -> [H.Snippet] -> H.Snippet+intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet intercalateSnippet _ [] = mempty-intercalateSnippet frag snippets = foldr1 (\a b -> a <> H.sql frag <> b) snippets+intercalateSnippet frag snippets = foldr1 (\a b -> a <> SQL.sql frag <> b) snippets
src/PostgREST/Query/Statements.hs view
@@ -19,26 +19,25 @@ import qualified Data.Aeson as JSON import qualified Data.Aeson.Lens as L import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS import qualified Hasql.Decoders as HD-import qualified Hasql.DynamicStatements.Snippet as H-import qualified Hasql.DynamicStatements.Statement as H-import qualified Hasql.Statement as H+import qualified Hasql.DynamicStatements.Snippet as SQL+import qualified Hasql.DynamicStatements.Statement as SQL+import qualified Hasql.Statement as SQL import Control.Lens ((^?)) import Data.Maybe (fromJust) import Data.Text.Read (decimal) import Network.HTTP.Types.Status (Status) -import PostgREST.Config.PgVersion (PgVersion)-import PostgREST.Error (Error (..))-import PostgREST.GucHeader (GucHeader)+import PostgREST.Error (Error (..))+import PostgREST.GucHeader (GucHeader) import PostgREST.DbStructure.Identifiers (FieldName) import PostgREST.Query.SqlFragment import PostgREST.Request.Preferences -import Protolude hiding (toS)-import Protolude.Conv (toS)+import Protolude {-| The generic query result format used by API responses. The location header is represented as a list of strings containing variable bindings like@@ -46,22 +45,22 @@ -} type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Error [GucHeader], Either Error (Maybe Status)) -createWriteStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool ->- PreferRepresentation -> [Text] -> PgVersion -> Bool ->- H.Statement () ResultsWithCount-createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys pgVer =- H.dynamicallyParameterized snippet decodeStandard+createWriteStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool ->+ PreferRepresentation -> [Text] -> Bool ->+ SQL.Statement () ResultsWithCount+createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys =+ SQL.dynamicallyParameterized snippet decodeStandard where snippet =- "WITH " <> H.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>- H.sql (+ "WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>+ SQL.sql ( "SELECT " <> "'' AS total_result_set, " <> "pg_catalog.count(_postgrest_t) AS page_total, " <> locF <> " AS header, " <> bodyF <> " AS body, " <>- responseHeadersF pgVer <> " AS response_headers, " <>- responseStatusF pgVer <> " AS response_status "+ responseHeadersF <> " AS response_headers, " <>+ responseStatusF <> " AS response_status " ) <> "FROM (" <> selectF <> ") _postgrest_t" @@ -82,29 +81,29 @@ selectF -- prevent using any of the column names in ?select= when no response is returned from the CTE- | rep `elem` [None, HeadersOnly] = H.sql ("SELECT * FROM " <> sourceCTEName)+ | rep `elem` [None, HeadersOnly] = SQL.sql ("SELECT * FROM " <> sourceCTEName) | otherwise = selectQuery decodeStandard :: HD.Result ResultsWithCount decodeStandard = fromMaybe (Nothing, 0, [], mempty, Right [], Right Nothing) <$> HD.rowMaybe standardRow -createReadStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->- H.Statement () ResultsWithCount-createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField pgVer =- H.dynamicallyParameterized snippet decodeStandard+createReadStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool ->+ SQL.Statement () ResultsWithCount+createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =+ SQL.dynamicallyParameterized snippet decodeStandard where snippet = "WITH " <>- H.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <>+ SQL.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <> countCTEF <> " " <>- H.sql ("SELECT " <>+ SQL.sql ("SELECT " <> countResultF <> " AS total_result_set, " <> "pg_catalog.count(_postgrest_t) AS page_total, " <> noLocationF <> " AS header, " <> bodyF <> " AS body, " <>- responseHeadersF pgVer <> " AS response_headers, " <>- responseStatusF pgVer <> " AS response_status " <>+ responseHeadersF <> " AS response_headers, " <>+ responseStatusF <> " AS response_status " <> "FROM ( SELECT * FROM " <> sourceCTEName <> " ) _postgrest_t") (countCTEF, countResultF) = countF countQuery countTotal@@ -131,22 +130,22 @@ type ProcResults = (Maybe Int64, Int64, ByteString, Either Error [GucHeader], Either Error (Maybe Status)) -callProcStatement :: Bool -> Bool -> H.Snippet -> H.Snippet -> H.Snippet -> Bool ->- Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->- H.Statement () ProcResults-callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal asSingle asCsv multObjects binaryField pgVer =- H.dynamicallyParameterized snippet decodeProc+callProcStatement :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->+ Bool -> Bool -> Bool -> Maybe FieldName -> Bool ->+ SQL.Statement () ProcResults+callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal asSingle asCsv multObjects binaryField =+ SQL.dynamicallyParameterized snippet decodeProc where snippet =- "WITH " <> H.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>+ "WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <> countCTEF <>- H.sql (+ SQL.sql ( "SELECT " <> countResultF <> " AS total_result_set, " <> "pg_catalog.count(_postgrest_t) AS page_total, " <> bodyF <> " AS body, " <>- responseHeadersF pgVer <> " AS response_headers, " <>- responseStatusF pgVer <> " AS response_status ") <>+ responseHeadersF <> " AS response_headers, " <>+ responseStatusF <> " AS response_status ") <> "FROM (" <> selectQuery <> ") _postgrest_t" (countCTEF, countResultF) = countF countQuery countTotal@@ -170,9 +169,9 @@ <*> (fromMaybe defGucHeaders <$> nullableColumn decodeGucHeaders) <*> (fromMaybe defGucStatus <$> nullableColumn decodeGucStatus) -createExplainStatement :: H.Snippet -> Bool -> H.Statement () (Maybe Int64)+createExplainStatement :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64) createExplainStatement countQuery =- H.dynamicallyParameterized snippet decodeExplain+ SQL.dynamicallyParameterized snippet decodeExplain where snippet = "EXPLAIN (FORMAT JSON) " <> countQuery -- |@@ -189,7 +188,7 @@ (^? L.nth 0 . L.key "Plan" . L.key "Plan Rows" . L._Integral) <$> row decodeGucHeaders :: HD.Value (Either Error [GucHeader])-decodeGucHeaders = first (const GucHeadersError) . JSON.eitherDecode . toS <$> HD.bytea+decodeGucHeaders = first (const GucHeadersError) . JSON.eitherDecode . LBS.fromStrict <$> HD.bytea decodeGucStatus :: HD.Value (Either Error (Maybe Status)) decodeGucStatus = first (const GucStatusError) . fmap (Just . toEnum . fst) . decimal <$> HD.text
src/PostgREST/RangeQuery.hs view
@@ -26,8 +26,7 @@ import Network.HTTP.Types.Header import Network.HTTP.Types.Status -import Protolude hiding (toS)-import Protolude.Conv (toS)+import Protolude type NonnegRange = Range Integer @@ -37,7 +36,7 @@ case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of Just parsedRange ->- let [_, mLower, mUpper] = readMaybe . toS <$> parsedRange+ let [_, mLower, mUpper] = readMaybe . BS.unpack <$> parsedRange lower = maybe emptyRange rangeGeq mLower upper = maybe allRange rangeLeq mUpper in rangeIntersection lower upper
src/PostgREST/Request/ApiRequest.hs view
@@ -3,7 +3,6 @@ Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest. -} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} @@ -13,25 +12,26 @@ , ContentType(..) , Action(..) , Target(..)- , PayloadJSON(..)+ , Payload(..) , userApiRequest ) where -import qualified Data.Aeson as JSON-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BL-import qualified Data.CaseInsensitive as CI-import qualified Data.Csv as CSV-import qualified Data.HashMap.Strict as M-import qualified Data.List as L-import qualified Data.Set as S-import qualified Data.Text as T-import qualified Data.Vector as V+import qualified Data.Aeson as JSON+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.CaseInsensitive as CI+import qualified Data.Csv as CSV+import qualified Data.HashMap.Strict as M+import qualified Data.List as L+import qualified Data.List.NonEmpty as NonEmptyList+import qualified Data.Set as S+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Vector as V import Control.Arrow ((***)) import Data.Aeson.Types (emptyArray, emptyObject) import Data.List (last, lookup, partition, union)-import Data.List.NonEmpty (head) import Data.Maybe (fromJust) import Data.Ranged.Boundaries (Boundary (..)) import Data.Ranged.Ranges (Range (..), emptyRange,@@ -51,9 +51,8 @@ import PostgREST.DbStructure.Identifiers (FieldName, QualifiedIdentifier (..), Schema)-import PostgREST.DbStructure.Proc (PgArg (..),- ProcDescription (..),- ProcsMap)+import PostgREST.DbStructure.Proc (ProcDescription (..),+ ProcParam (..), ProcsMap) import PostgREST.Error (ApiRequestError (..)) import PostgREST.Query.SqlFragment (ftsOperators, operators) import PostgREST.RangeQuery (NonnegRange, allRange,@@ -67,26 +66,27 @@ PreferResolution (..), PreferTransaction (..)) -import qualified PostgREST.ContentType as ContentType+import qualified PostgREST.ContentType as ContentType+import qualified PostgREST.Request.Preferences as Preferences -import Protolude hiding (head, toS)-import Protolude.Conv (toS)+import Protolude -type RequestBody = BL.ByteString+type RequestBody = LBS.ByteString -data PayloadJSON+data Payload = ProcessedJSON -- ^ Cached attributes of a JSON payload- { pjRaw :: BL.ByteString+ { payRaw :: LBS.ByteString -- ^ This is the raw ByteString that comes from the request body. We -- cache this instead of an Aeson Value because it was detected that for -- large payloads the encoding had high memory usage, see -- https://github.com/PostgREST/postgrest/pull/1005 for more details- , pjKeys :: S.Set Text+ , payKeys :: S.Set Text -- ^ Keys of the object or if it's an array these keys are guaranteed to -- be the same across all its objects }- | RawJSON { pjRaw :: BL.ByteString }+ | RawJSON { payRaw :: LBS.ByteString }+ | RawPay { payRaw :: LBS.ByteString } data InvokeMethod = InvHead | InvGet | InvPost deriving Eq -- | Types of things a user wants to do to tables/views/procs@@ -119,15 +119,15 @@ toJSON (Variadic v) = JSON.toJSON v toRpcParamValue :: ProcDescription -> (Text, Text) -> (Text, RpcParamValue)-toRpcParamValue proc (k, v) | argIsVariadic k = (k, Variadic [v])+toRpcParamValue proc (k, v) | prmIsVariadic k = (k, Variadic [v]) | otherwise = (k, Fixed v) where- argIsVariadic arg = isJust $ find (\PgArg{pgaName, pgaVar} -> pgaName == arg && pgaVar) $ pdArgs proc+ prmIsVariadic prm = isJust $ find (\ProcParam{ppName, ppVar} -> ppName == prm && ppVar) $ pdParams proc -- | Convert rpc params `/rpc/func?a=val1&b=val2` to json `{"a": "val1", "b": "val2"}-jsonRpcParams :: ProcDescription -> [(Text, Text)] -> PayloadJSON+jsonRpcParams :: ProcDescription -> [(Text, Text)] -> Payload jsonRpcParams proc prms =- if not $ pdHasVariadic proc then -- if proc has no variadic arg, save steps and directly convert to json+ if not $ pdHasVariadic proc then -- if proc has no variadic param, save steps and directly convert to json ProcessedJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> prms) (S.fromList $ fst <$> prms) else let paramsMap = M.fromListWith mergeParams $ toRpcParamValue proc <$> prms in@@ -135,9 +135,9 @@ where mergeParams :: RpcParamValue -> RpcParamValue -> RpcParamValue mergeParams (Variadic a) (Variadic b) = Variadic $ b ++ a- mergeParams v _ = v -- repeated params for non-variadic arguments are not merged+ mergeParams v _ = v -- repeated params for non-variadic parameters are not merged -targetToJsonRpcParams :: Maybe Target -> [(Text, Text)] -> Maybe PayloadJSON+targetToJsonRpcParams :: Maybe Target -> [(Text, Text)] -> Maybe Payload targetToJsonRpcParams target params = case target of Just TargetProc{tProc} -> Just $ jsonRpcParams tProc params@@ -152,10 +152,10 @@ -} data ApiRequest = ApiRequest { iAction :: Action -- ^ Similar but not identical to HTTP verb, e.g. Create/Invoke both POST- , iRange :: M.HashMap ByteString NonnegRange -- ^ Requested range of rows within response+ , iRange :: M.HashMap Text NonnegRange -- ^ Requested range of rows within response , iTopLevelRange :: NonnegRange -- ^ Requested range of rows from the top level , iTarget :: Target -- ^ The target, be it calling a proc or accessing a table- , iPayload :: Maybe PayloadJSON -- ^ Data sent by client and used for mutation actions+ , iPayload :: Maybe Payload -- ^ Data sent by client and used for mutation actions , iPreferRepresentation :: PreferRepresentation -- ^ If client wants created items echoed back , iPreferParameters :: Maybe PreferParameters -- ^ How to pass parameters to a stored procedure , iPreferCount :: Maybe PreferCount -- ^ Whether the client wants a result count@@ -184,7 +184,7 @@ | isJust profile && fromJust profile `notElem` configDbSchemas = Left $ UnacceptableSchema $ toList configDbSchemas | isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate | topLevelRange == emptyRange = Left InvalidRange- | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) witness payload+ | shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload | isLeft parsedColumns = either Left witness parsedColumns | otherwise = do acceptContentType <- findAcceptContentType conf action path accepts@@ -195,29 +195,20 @@ , iRange = ranges , iTopLevelRange = topLevelRange , iPayload = relevantPayload- , iPreferRepresentation = representation- , iPreferParameters = if | hasPrefer (show SingleObject) -> Just SingleObject- | hasPrefer (show MultipleObjects) -> Just MultipleObjects- | otherwise -> Nothing- , iPreferCount = if | hasPrefer (show ExactCount) -> Just ExactCount- | hasPrefer (show PlannedCount) -> Just PlannedCount- | hasPrefer (show EstimatedCount) -> Just EstimatedCount- | otherwise -> Nothing- , iPreferResolution = if | hasPrefer (show MergeDuplicates) -> Just MergeDuplicates- | hasPrefer (show IgnoreDuplicates) -> Just IgnoreDuplicates- | otherwise -> Nothing- , iPreferTransaction = if | hasPrefer (show Commit) -> Just Commit- | hasPrefer (show Rollback) -> Just Rollback- | otherwise -> Nothing+ , iPreferRepresentation = fromMaybe None preferRepresentation+ , iPreferParameters = preferParameters+ , iPreferCount = preferCount+ , iPreferResolution = preferResolution+ , iPreferTransaction = preferTransaction , iFilters = filters , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ] , iSelect = toS <$> join (lookup "select" qParams) , iOnConflict = toS <$> join (lookup "on_conflict" qParams) , iColumns = payloadColumns , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]- , iCanonicalQS = toS $ urlEncodeVars+ , iCanonicalQS = BS.pack $ urlEncodeVars . L.sortOn fst- . map (join (***) toS . second (fromMaybe BS.empty))+ . map (join (***) BS.unpack . second (fromMaybe mempty)) $ qString , iJWT = tokenStr , iHeaders = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]@@ -254,7 +245,7 @@ isTargetingDefaultSpec = case path of PathInfo{pIsDefaultSpec=True} -> True _ -> False- contentType = ContentType.decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type"+ contentType = maybe CTApplicationJSON ContentType.decodeContentType $ lookupHeader "content-type" columns | action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams) | otherwise = Nothing@@ -263,27 +254,30 @@ case (contentType, action) of (_, ActionInvoke InvGet) -> S.fromList $ fst <$> rpcQParams (_, ActionInvoke InvHead) -> S.fromList $ fst <$> rpcQParams- (CTUrlEncoded, _) -> S.fromList $ map (toS . fst) $ parseSimpleQuery $ toS reqBody+ (CTUrlEncoded, _) -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody _ -> case (relevantPayload, fromRight Nothing parsedColumns) of- (Just ProcessedJSON{pjKeys}, _) -> pjKeys- (Just RawJSON{}, Just cls) -> cls- _ -> S.empty+ (Just ProcessedJSON{payKeys}, _) -> payKeys+ (Just RawJSON{}, Just cls) -> cls+ _ -> S.empty+ payload :: Either ByteString Payload payload = case contentType of CTApplicationJSON -> if isJust columns then Right $ RawJSON reqBody else note "All object keys must match" . payloadAttributes reqBody- =<< if BL.null reqBody && isTargetingProc+ =<< if LBS.null reqBody && isTargetingProc then Right emptyObject- else JSON.eitherDecode reqBody+ else first BS.pack $ JSON.eitherDecode reqBody CTTextCSV -> do- json <- csvToJson <$> CSV.decodeByName reqBody+ json <- csvToJson <$> first BS.pack (CSV.decodeByName reqBody) note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json CTUrlEncoded ->- let paramsMap = M.fromList $ (toS *** JSON.String . toS) <$> parseSimpleQuery (toS reqBody) in+ let paramsMap = M.fromList $ (T.decodeUtf8 *** JSON.String . T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) in Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (M.keys paramsMap) ct ->- Left $ toS $ "Content-Type not acceptable: " <> ContentType.toMime ct+ if isTargetingProc && ct `elem` [CTTextPlain, CTOctetStream]+ then Right $ RawPay reqBody+ else Left $ "Content-Type not acceptable: " <> ContentType.toMime ct topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges -- if no limit is specified, get all the request rows action = case method of@@ -304,7 +298,7 @@ "OPTIONS" -> ActionInfo _ -> ActionInspect{isHead=False} - defaultSchema = head configDbSchemas+ defaultSchema = NonEmptyList.head configDbSchemas profile | length configDbSchemas <= 1 -- only enable content negotiation by profile when there are multiple schemas specified in the config = Nothing@@ -317,12 +311,14 @@ ActionInvoke InvPost -> contentProfile _ -> acceptProfile where- contentProfile = Just $ maybe defaultSchema toS $ lookupHeader "Content-Profile"- acceptProfile = Just $ maybe defaultSchema toS $ lookupHeader "Accept-Profile"+ contentProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Content-Profile"+ acceptProfile = Just $ maybe defaultSchema T.decodeUtf8 $ lookupHeader "Accept-Profile" schema = fromMaybe defaultSchema profile target = let- callFindProc procSch procNam = findProc (QualifiedIdentifier procSch procNam) payloadColumns (hasPrefer (show SingleObject)) $ dbProcs dbStructure+ callFindProc procSch procNam = findProc+ (QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs dbStructure)+ contentType (action == ActionInvoke InvPost) in case path of PathInfo{pSchema, pName, pHasRpc, pIsRootSpec, pIsDefaultSpec}@@ -339,7 +335,7 @@ -- to store the query string arguments to the function. (_, ActionInvoke InvGet) -> targetToJsonRpcParams (rightToMaybe target) rpcQParams (_, ActionInvoke InvHead) -> targetToJsonRpcParams (rightToMaybe target) rpcQParams- (CTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (toS *** toS) <$> parseSimpleQuery (toS reqBody)+ (CTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody) _ | shouldParsePayload -> rightToMaybe payload | otherwise -> Nothing path =@@ -353,20 +349,11 @@ _ -> PathUnknown method = requestMethod req hdrs = requestHeaders req- qParams = [(toS k, v)|(k,v) <- qString]+ qParams = [(T.decodeUtf8 k, T.decodeUtf8 <$> v)|(k,v) <- qString] lookupHeader = flip lookup hdrs- hasPrefer :: Text -> Bool- hasPrefer val = any (\(h,v) -> h == "Prefer" && val `elem` split v) hdrs- where- split :: BS.ByteString -> [Text]- split = map T.strip . T.split (==',') . toS- representation- | hasPrefer (show Full) = Full- | hasPrefer (show None) = None- | hasPrefer (show HeadersOnly) = HeadersOnly- | otherwise = None+ Preferences.Preferences{..} = Preferences.fromHeaders hdrs auth = fromMaybe "" $ lookupHeader hAuthorization- tokenStr = case T.split (== ' ') (toS auth) of+ tokenStr = case T.split (== ' ') (T.decodeUtf8 auth) of ("Bearer" : t : _) -> t ("bearer" : t : _) -> t _ -> ""@@ -376,9 +363,9 @@ headerRange = rangeRequested hdrs replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) ++ [x]- limitParams :: M.HashMap ByteString NonnegRange+ limitParams :: M.HashMap Text NonnegRange limitParams = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe . toS =<< v) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]- offsetParams :: M.HashMap ByteString NonnegRange+ offsetParams :: M.HashMap Text NonnegRange offsetParams = M.fromList [(toS (replaceLast "limit" k), maybe allRange rangeGeq (readMaybe . toS =<< v)) | (k,v) <- qParams, isJust v, endingIn ["offset"] k] urlRange = M.unionWith f limitParams offsetParams@@ -402,7 +389,7 @@ then listToMaybe sProduces else exact -type CsvData = V.Vector (M.HashMap Text BL.ByteString)+type CsvData = V.Vector (M.HashMap Text LBS.ByteString) {-| Converts CSV like@@ -424,10 +411,10 @@ M.map (\str -> if str == "NULL" then JSON.Null- else JSON.String $ toS str+ else JSON.String . T.decodeUtf8 $ LBS.toStrict str ) -payloadAttributes :: RequestBody -> JSON.Value -> Maybe PayloadJSON+payloadAttributes :: RequestBody -> JSON.Value -> Maybe Payload payloadAttributes raw json = -- Test that Array contains only Objects having the same keys case json of@@ -480,37 +467,52 @@ (ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain] {-|- Search a pg procedure by its parameters. Since a function can be overloaded, the name is not enough to find it.- An overloaded function can have a different volatility or even a different return type.+ Search a pg proc by matching name and arguments keys to parameters. Since a function can be overloaded,+ the name is not enough to find it. An overloaded function can have a different volatility or even a different return type. -}-findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> Either ApiRequestError ProcDescription-findProc qi payloadKeys paramsAsSingleObject allProcs =- case bestMatch of- [] -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList payloadKeys) paramsAsSingleObject- [proc] -> Right proc- procs -> Left $ AmbiguousRpc (toList procs)+findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> ContentType -> Bool -> Either ApiRequestError ProcDescription+findProc qi argumentsKeys paramsAsSingleObject allProcs contentType isInvPost =+ case matchProc of+ ([], []) -> Left $ NoRpc (qiSchema qi) (qiName qi) (S.toList argumentsKeys) paramsAsSingleObject contentType isInvPost+ -- If there are no functions with named arguments, fallback to the single unnamed argument function+ ([], [proc]) -> Right proc+ ([], procs) -> Left $ AmbiguousRpc (toList procs)+ -- Matches the functions with named arguments+ ([proc], _) -> Right proc+ (procs, _) -> Left $ AmbiguousRpc (toList procs) where- bestMatch =- case M.lookup qi allProcs of- Nothing -> []- Just [proc] -> [proc | matches proc]- Just procs -> filter matches procs- -- Find the exact arguments match- matches proc- | paramsAsSingleObject = case pdArgs proc of- [arg] -> pgaType arg `elem` ["json", "jsonb"]- _ -> False- | otherwise = case pdArgs proc of- [] -> null payloadKeys- args -> matchesArg args- matchesArg args =- -- The function's required arguments are separated from the ones with a default value assigned.- -- The set of names of those arguments is compared to the set of keys supplied by the client- -- 1. If only required arguments are found, the keys must be exactly the same as those arguments- -- 2. If only optional arguments are found, the keys must be a subset of those arguments- -- 3. If both required and optional arguments are found, the result of taking away the optional arguments- -- from the keys must be exactly the same as the required arguments- case L.partition pgaReq args of- (reqArgs, []) -> payloadKeys == S.fromList (pgaName <$> reqArgs)- ([], defArgs) -> payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> defArgs)- (reqArgs, defArgs) -> payloadKeys `S.difference` S.fromList (pgaName <$> defArgs) == S.fromList (pgaName <$> reqArgs)+ matchProc = overloadedProcPartition $ M.lookupDefault mempty qi allProcs -- first find the proc by name+ -- The partition obtained has the form (overloadedProcs,fallbackProcs)+ -- where fallbackProcs are functions with a single unnamed parameter+ overloadedProcPartition procs = foldr select ([],[]) procs+ select proc ~(ts,fs)+ | matchesParams proc = (proc:ts,fs)+ | hasSingleUnnamedParam proc = (ts,proc:fs)+ | otherwise = (ts,fs)+ -- If the function is called with post and has a single unnamed parameter+ -- it can be called depending on content type and the parameter type+ hasSingleUnnamedParam proc = isInvPost && case pdParams proc of+ [ProcParam "" ppType _ _]+ | contentType == CTApplicationJSON -> ppType `elem` ["json", "jsonb"]+ | contentType == CTTextPlain -> ppType == "text"+ | contentType == CTOctetStream -> ppType == "bytea"+ | otherwise -> False+ _ -> False+ matchesParams proc =+ let params = pdParams proc in+ -- exceptional case for Prefer: params=single-object+ if paramsAsSingleObject+ then length params == 1 && (ppType <$> headMay params) `elem` [Just "json", Just "jsonb"]+ -- If the function has no parameters, the arguments keys must be empty as well+ else if null params+ then null argumentsKeys && contentType `notElem` [CTTextPlain, CTOctetStream]+ -- A function has optional and required parameters. Optional parameters have a default value and+ -- don't require arguments for the function to be executed, required parameters must have an argument present.+ else case L.partition ppReq params of+ -- If the function only has required parameters, the arguments keys must match those parameters+ (reqParams, []) -> argumentsKeys == S.fromList (ppName <$> reqParams)+ -- If the function only has optional parameters, the arguments keys can match none or any of them(a subset)+ ([], optParams) -> argumentsKeys `S.isSubsetOf` S.fromList (ppName <$> optParams)+ -- If the function has required and optional parameters, the arguments keys have to match the required parameters+ -- and can match any or none of the default parameters.+ (reqParams, optParams) -> argumentsKeys `S.difference` S.fromList (ppName <$> optParams) == S.fromList (ppName <$> reqParams)
src/PostgREST/Request/DbRequestBuilder.hs view
@@ -18,7 +18,7 @@ module PostgREST.Request.DbRequestBuilder ( readRequest , mutateRequest- , returningCols+ , callRequest ) where import qualified Data.HashMap.Strict as M@@ -33,6 +33,9 @@ import PostgREST.DbStructure.Identifiers (FieldName, QualifiedIdentifier (..), Schema, TableName)+import PostgREST.DbStructure.Proc (ProcDescription (..),+ ProcParam (..),+ procReturnsScalar) import PostgREST.DbStructure.Relationship (Cardinality (..), Junction (..), Relationship (..))@@ -45,7 +48,7 @@ restrictRange) import PostgREST.Request.ApiRequest (Action (..), ApiRequest (..),- PayloadJSON (..))+ Payload (..)) import PostgREST.Request.Parsers import PostgREST.Request.Preferences@@ -97,16 +100,16 @@ rootDepth = 0 rootSchema = qiSchema rootQi rootName = qiName rootQi- initial = Node (Select [] rootQi Nothing [] [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, rootDepth)) []+ initial = Node (Select [] rootQi Nothing [] [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, Nothing, rootDepth)) [] treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest- treeEntry depth (Node fld@((fn, _),_,alias, embedHint) fldForest) (Node (q, i) rForest) =+ treeEntry depth (Node fld@((fn, _),_,alias, hint, joinType) fldForest) (Node (q, i) rForest) = let nxtDepth = succ depth in case fldForest of [] -> Node (q {select=fld:select q}, i) rForest _ -> Node (q, i) $ foldr (treeEntry nxtDepth) (Node (Select [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] [] allRange,- (fn, Nothing, alias, embedHint, nxtDepth)) [])+ (fn, Nothing, alias, hint, joinType, nxtDepth)) []) fldForest:rForest -- | Enforces the `max-rows` config on the result@@ -122,16 +125,16 @@ >>= addJoinConditions Nothing addRels :: Schema -> [Relationship] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest-addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, depth)) forest) =+addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, joinType, depth)) forest) = case parentNode of Just (Node (Select{from=parentNodeQi}, _) _) -> let newFrom r = if qiName tbl == nodeName then tableQi (relForeignTable r) else tbl- newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, Nothing, depth))) <$> rel+ newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, hint, joinType, depth))) <$> rel rel = findRel schema allRels (qiName parentNodeQi) nodeName hint in Node <$> newReadNode <*> (updateForest . hush $ Node <$> newReadNode <*> pure forest) _ ->- let rn = (query, (nodeName, Nothing, alias, Nothing, depth)) in+ let rn = (query, (nodeName, Nothing, alias, Nothing, joinType, depth)) in Node rn <$> updateForest (Just $ Node rn forest) where updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]@@ -147,7 +150,7 @@ -- target = table / view / constraint / column-from-origin -- hint = table / view / constraint / column-from-origin / column-from-target -- (hint can take table / view values to aid in finding the junction in an m2m relationship)-findRel :: Schema -> [Relationship] -> NodeName -> NodeName -> Maybe EmbedHint -> Either ApiRequestError Relationship+findRel :: Schema -> [Relationship] -> NodeName -> NodeName -> Maybe Hint -> Either ApiRequestError Relationship findRel schema allRels origin target hint = case rel of [] -> Left $ NoRelBetween origin target@@ -207,7 +210,7 @@ -- previousAlias is only used for the case of self joins addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest-addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, rel, _, _, depth)) forest) =+addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, rel, _, _, _, depth)) forest) = case rel of Just r@Relationship{relCardinality=M2M Junction{junTable}} -> let rq = augmentQuery r in@@ -304,7 +307,7 @@ Nothing -> Node rn forest -- the property is silenty dropped in the Request does not contain the required path Just tn -> Node rn (addProperty f (remainingPath, a) tn:delete tn forest) where- pathNode = find (\(Node (_,(nodeName,_,alias,_,_)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest+ pathNode = find (\(Node (_,(nodeName,_,alias,_,_, _)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest mutateRequest :: Schema -> TableName -> ApiRequest -> [FieldName] -> ReadRequest -> Either Error MutateRequest mutateRequest schema tName apiRequest pkCols readReq = mapLeft ApiRequestError $@@ -341,8 +344,26 @@ -- update/delete filters can be only on the root table (mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest) onlyRoot = filter (not . ( "." `isInfixOf` ) . fst)- body = pjRaw <$> iPayload apiRequest+ body = payRaw <$> iPayload apiRequest -- the body is assumed to be json at this stage(ApiRequest validates) +callRequest :: ProcDescription -> ApiRequest -> ReadRequest -> CallRequest+callRequest proc apiReq readReq = FunctionCall {+ funCQi = QualifiedIdentifier (pdSchema proc) (pdName proc)+, funCParams = callParams+, funCArgs = payRaw <$> iPayload apiReq+, funCScalar = procReturnsScalar proc+, funCMultipleCall = iPreferParameters apiReq == Just MultipleObjects+, funCReturning = returningCols readReq []+}+ where+ paramsAsSingleObject = iPreferParameters apiReq == Just SingleObject+ callParams = case pdParams proc of+ [prm] | paramsAsSingleObject -> OnePosParam prm+ | ppName prm == mempty -> OnePosParam prm+ | otherwise -> KeyParams $ specifiedParams [prm]+ prms -> KeyParams $ specifiedParams prms+ specifiedParams params = filter (\x -> ppName x `S.member` iColumns apiReq) params+ returningCols :: ReadRequest -> [FieldName] -> [FieldName] returningCols rr@(Node _ forest) pkCols -- if * is part of the select, we must not add pk or fk columns manually -@@ -358,7 +379,7 @@ -- projects. So this adds the foreign key columns to ensure the embedding -- succeeds, result would be `RETURNING name, client_id`. fkCols = concat $ mapMaybe (\case- Node (_, (_, Just Relationship{relColumns=cols}, _, _, _)) _ -> Just cols+ Node (_, (_, Just Relationship{relColumns=cols}, _, _, _, _)) _ -> Just cols _ -> Nothing ) forest -- However if the "client_id" is present, e.g. mutateRequest to
src/PostgREST/Request/Parsers.hs view
@@ -47,8 +47,7 @@ import PostgREST.Request.Types -import Protolude hiding (intercalate, option, replace, toS, try)-import Protolude.Conv (toS)+import Protolude hiding (intercalate, option, replace, try) pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem] pRequestSelect selStr =@@ -73,7 +72,7 @@ path = fst <$> treePath ord' = parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v -pRequestRange :: (ByteString, NonnegRange) -> Either ApiRequestError (EmbedPath, NonnegRange)+pRequestRange :: (Text, NonnegRange) -> Either ApiRequestError (EmbedPath, NonnegRange) pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v where treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k@@ -117,7 +116,7 @@ Node <$> pFieldSelect <*> pure [] pStar :: Parser Text-pStar = toS <$> (string "*" $> ("*"::ByteString))+pStar = string "*" $> "*" pFieldName :: Parser Text pFieldName =@@ -158,13 +157,23 @@ pRelationSelect = lexeme $ try ( do alias <- optionMaybe ( try(pFieldName <* aliasSeparator) ) fld <- pField- hint <- optionMaybe (- try ( char '!' *> pFieldName) <|>- -- deprecated, remove in next major version- try ( char '.' *> pFieldName)- )- return (fld, Nothing, alias, hint)+ prm1 <- optionMaybe pEmbedParam+ prm2 <- optionMaybe pEmbedParam+ return (fld, Nothing, alias, embedParamHint prm1 <|> embedParamHint prm2, embedParamJoin prm1 <|> embedParamJoin prm2) )+ where+ pEmbedParam :: Parser EmbedParam+ pEmbedParam =+ char '!' *> (+ try (string "left" $> EPJoinType JTLeft) <|>+ try (string "inner" $> EPJoinType JTInner) <|>+ try (EPHint <$> pFieldName))+ embedParamHint prm = case prm of+ Just (EPHint hint) -> Just hint+ _ -> Nothing+ embedParamJoin prm = case prm of+ Just (EPJoinType jt) -> Just jt+ _ -> Nothing pFieldSelect :: Parser SelectItem pFieldSelect = lexeme $@@ -173,11 +182,11 @@ alias <- optionMaybe ( try(pFieldName <* aliasSeparator) ) fld <- pField cast' <- optionMaybe (string "::" *> many letter)- return (fld, toS <$> cast', alias, Nothing)+ return (fld, toS <$> cast', alias, Nothing, Nothing) ) <|> do s <- pStar- return ((s, []), Nothing, Nothing, Nothing)+ return ((s, []), Nothing, Nothing, Nothing, Nothing) pOpExpr :: Parser SingleVal -> Parser OpExpr pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation@@ -186,15 +195,22 @@ pOperation = Op . toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys ops) <*> pSVal <|> In <$> (try (string "in" *> pDelimiter) *> pListVal)+ <|> Is <$> (try (string "is" *> pDelimiter) *> pTriVal) <|> pFts <?> "operator (eq, gt, ...)" + pTriVal = try (string "null" $> TriNull)+ <|> try (string "unknown" $> TriUnknown)+ <|> try (string "true" $> TriTrue)+ <|> try (string "false" $> TriFalse)+ <?> "null or trilean value (unknown, true, false)"+ pFts = do op <- foldl1 (<|>) (try . string . toS <$> ftsOps) lang <- optionMaybe $ try (between (char '(') (char ')') (many (letter <|> digit <|> oneOf "_"))) pDelimiter >> Fts (toS op) (toS <$> lang) <$> pSVal - ops = M.filterWithKey (const . flip notElem ("in":ftsOps)) operators+ ops = M.filterWithKey (const . flip notElem ("in":"is":ftsOps)) operators ftsOps = M.keys ftsOperators pSingleVal :: Parser SingleVal@@ -207,7 +223,9 @@ pListElement = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)")) pQuotedValue :: Parser Text-pQuotedValue = toS <$> (char '"' *> many (noneOf "\"") <* char '"')+pQuotedValue = toS <$> (char '"' *> many pCharsOrSlashed <* char '"')+ where+ pCharsOrSlashed = noneOf "\\\"" <|> (char '\\' *> anyChar) pDelimiter :: Parser Char pDelimiter = char '.' <?> "delimiter (.)"
src/PostgREST/Request/Preferences.hs view
@@ -1,54 +1,200 @@-module PostgREST.Request.Preferences where+-- |+-- Module: PostgREST.Request.Preferences+-- Description: Track client preferences to be employed when processing requests+--+-- Track client prefences set in HTTP 'Prefer' headers according to RFC7240[1].+--+-- [1] https://datatracker.ietf.org/doc/html/rfc7240+--+module PostgREST.Request.Preferences+ ( Preferences(..)+ , PreferCount(..)+ , PreferParameters(..)+ , PreferRepresentation(..)+ , PreferResolution(..)+ , PreferTransaction(..)+ , fromHeaders+ , ToAppliedHeader(..)+ ) where -import GHC.Show+import qualified Data.ByteString.Char8 as BS+import qualified Data.Map as Map+import qualified Network.HTTP.Types.Header as HTTP+ import Protolude +-- $setup+-- Setup for doctests+-- >>> import Text.Pretty.Simple (pPrint)+-- >>> deriving instance Show PreferResolution+-- >>> deriving instance Show PreferRepresentation+-- >>> deriving instance Show PreferParameters+-- >>> deriving instance Show PreferCount+-- >>> deriving instance Show PreferTransaction+-- >>> deriving instance Show Preferences++-- | Preferences recognized by the application.+data Preferences+ = Preferences+ { preferResolution :: Maybe PreferResolution+ , preferRepresentation :: Maybe PreferRepresentation+ , preferParameters :: Maybe PreferParameters+ , preferCount :: Maybe PreferCount+ , preferTransaction :: Maybe PreferTransaction+ }++-- |+-- Parse HTTP headers based on RFC7240[1] to identify preferences.+--+-- One header with comma-separated values can be used to set multiple preferences:+--+-- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates, count=exact")]+-- Preferences+-- { preferResolution = Just IgnoreDuplicates+-- , preferRepresentation = Nothing+-- , preferParameters = Nothing+-- , preferCount = Just ExactCount+-- , preferTransaction = Nothing+-- }+--+-- Multiple headers can also be used:+--+-- >>> pPrint $ fromHeaders [("Prefer", "resolution=ignore-duplicates"), ("Prefer", "count=exact")]+-- Preferences+-- { preferResolution = Just IgnoreDuplicates+-- , preferRepresentation = Nothing+-- , preferParameters = Nothing+-- , preferCount = Just ExactCount+-- , preferTransaction = Nothing+-- }+--+-- If a preference is set more than once, only the first is used:+--+-- >>> preferTransaction $ fromHeaders [("Prefer", "tx=commit, tx=rollback")]+-- Just Commit+--+-- This is also the case across multiple headers:+--+-- >>> :{+-- preferResolution . fromHeaders $+-- [ ("Prefer", "resolution=ignore-duplicates")+-- , ("Prefer", "resolution=merge-duplicates")+-- ]+-- :}+-- Just IgnoreDuplicates+--+-- Preferences not recognized by the application are ignored:+--+-- >>> preferResolution $ fromHeaders [("Prefer", "resolution=foo")]+-- Nothing+--+-- Preferences can be separated by arbitrary amounts of space, lower-case header is also recognized:+--+-- >>> pPrint $ fromHeaders [("prefer", "count=exact, tx=commit ,return=minimal")]+-- Preferences+-- { preferResolution = Nothing+-- , preferRepresentation = Just None+-- , preferParameters = Nothing+-- , preferCount = Just ExactCount+-- , preferTransaction = Just Commit+-- }+--+fromHeaders :: [HTTP.Header] -> Preferences+fromHeaders headers =+ Preferences+ { preferResolution = parsePrefs [MergeDuplicates, IgnoreDuplicates]+ , preferRepresentation = parsePrefs [Full, None, HeadersOnly]+ , preferParameters = parsePrefs [SingleObject, MultipleObjects]+ , preferCount = parsePrefs [ExactCount, PlannedCount, EstimatedCount]+ , preferTransaction = parsePrefs [Commit, Rollback]+ }+ where+ prefHeaders = filter ((==) HTTP.hPrefer . fst) headers+ prefs = fmap BS.strip . concatMap (BS.split ',' . snd) $ prefHeaders++ parsePrefs :: ToHeaderValue a => [a] -> Maybe a+ parsePrefs vals =+ head $ mapMaybe (flip Map.lookup $ prefMap vals) prefs++ prefMap :: ToHeaderValue a => [a] -> Map.Map ByteString a+ prefMap = Map.fromList . fmap (\pref -> (toHeaderValue pref, pref))++-- |+-- Convert a preference into the value that we look for in the 'Prefer' headers.+--+-- >>> toHeaderValue MergeDuplicates+-- "resolution=merge-duplicates"+--+class ToHeaderValue a where+ toHeaderValue :: a -> ByteString++-- |+-- Header to indicate that a preference has been applied.+--+-- >>> toAppliedHeader MergeDuplicates+-- ("Preference-Applied","resolution=merge-duplicates")+--+class ToHeaderValue a => ToAppliedHeader a where+ toAppliedHeader :: a -> HTTP.Header+ toAppliedHeader x = (HTTP.hPreferenceApplied, toHeaderValue x)++-- | How to handle duplicate values. data PreferResolution = MergeDuplicates | IgnoreDuplicates -instance Show PreferResolution where- show MergeDuplicates = "resolution=merge-duplicates"- show IgnoreDuplicates = "resolution=ignore-duplicates"+instance ToHeaderValue PreferResolution where+ toHeaderValue MergeDuplicates = "resolution=merge-duplicates"+ toHeaderValue IgnoreDuplicates = "resolution=ignore-duplicates" --- | How to return the mutated data. From https://tools.ietf.org/html/rfc7240#section-4.2+instance ToAppliedHeader PreferResolution++-- |+-- How to return the mutated data.+--+-- From https://tools.ietf.org/html/rfc7240#section-4.2 data PreferRepresentation = Full -- ^ Return the body plus the Location header(in case of POST). | HeadersOnly -- ^ Return the Location header(in case of POST). This needs a SELECT privilege on the pk. | None -- ^ Return nothing from the mutated data. deriving Eq -instance Show PreferRepresentation where- show Full = "return=representation"- show None = "return=minimal"- show HeadersOnly = "return=headers-only"+instance ToHeaderValue PreferRepresentation where+ toHeaderValue Full = "return=representation"+ toHeaderValue None = "return=minimal"+ toHeaderValue HeadersOnly = "return=headers-only" +-- | How to pass parameters to stored procedures. data PreferParameters- = SingleObject -- ^ Pass all parameters as a single json object to a stored procedure- | MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure+ = SingleObject -- ^ Pass all parameters as a single json object to a stored procedure.+ | MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure. deriving Eq -instance Show PreferParameters where- show SingleObject = "params=single-object"- show MultipleObjects = "params=multiple-objects"+instance ToHeaderValue PreferParameters where+ toHeaderValue SingleObject = "params=single-object"+ toHeaderValue MultipleObjects = "params=multiple-objects" +-- | How to determine the count of (expected) results data PreferCount- = ExactCount -- ^ exact count(slower)+ = ExactCount -- ^ Exact count (slower). | PlannedCount -- ^ PostgreSQL query planner rows count guess. Done by using EXPLAIN {query}.- | EstimatedCount -- ^ use the query planner rows if the count is superior to max-rows, otherwise get the exact count.+ | EstimatedCount -- ^ Use the query planner rows if the count is superior to max-rows, otherwise get the exact count. deriving Eq -instance Show PreferCount where- show ExactCount = "count=exact"- show PlannedCount = "count=planned"- show EstimatedCount = "count=estimated"+instance ToHeaderValue PreferCount where+ toHeaderValue ExactCount = "count=exact"+ toHeaderValue PlannedCount = "count=planned"+ toHeaderValue EstimatedCount = "count=estimated" +-- | Whether to commit or roll back transactions. data PreferTransaction- = Commit -- Commit transaction - the default.- | Rollback -- Rollback transaction after sending the response - does not persist changes, e.g. for running tests.+ = Commit -- ^ Commit transaction - the default.+ | Rollback -- ^ Rollback transaction after sending the response - does not persist changes, e.g. for running tests. deriving Eq -instance Show PreferTransaction where- show Commit = "tx=commit"- show Rollback = "tx=rollback"+instance ToHeaderValue PreferTransaction where+ toHeaderValue Commit = "tx=commit"+ toHeaderValue Rollback = "tx=rollback"++instance ToAppliedHeader PreferTransaction
src/PostgREST/Request/Types.hs view
@@ -2,11 +2,16 @@ module PostgREST.Request.Types ( Alias , Depth- , EmbedHint+ , EmbedParam(..) , EmbedPath , Field , Filter(..)+ , Hint+ , CallQuery(..)+ , CallParams(..)+ , CallRequest , JoinCondition(..)+ , JoinType(..) , JsonOperand(..) , JsonOperation(..) , JsonPath@@ -26,18 +31,18 @@ , ReadRequest , SelectItem , SingleVal+ , TrileanVal(..) , fstFieldNames ) where -import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy as LBS import qualified Data.Set as S import Data.Tree (Tree (..)) -import qualified GHC.Show (show)- import PostgREST.DbStructure.Identifiers (FieldName, QualifiedIdentifier)+import PostgREST.DbStructure.Proc (ProcParam (..)) import PostgREST.DbStructure.Relationship (Relationship) import PostgREST.RangeQuery (NonnegRange) import PostgREST.Request.Preferences (PreferResolution)@@ -47,9 +52,10 @@ type ReadRequest = Tree ReadNode type MutateRequest = MutateQuery+type CallRequest = CallQuery type ReadNode =- (ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe EmbedHint, Depth))+ (ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe Hint, Maybe JoinType, Depth)) type NodeName = Text type Depth = Integer@@ -86,24 +92,16 @@ | OrderDesc deriving (Eq) -instance Show OrderDirection where- show OrderAsc = "ASC"- show OrderDesc = "DESC"- data OrderNulls = OrderNullsFirst | OrderNullsLast deriving (Eq) -instance Show OrderNulls where- show OrderNullsFirst = "NULLS FIRST"- show OrderNullsLast = "NULLS LAST"- data MutateQuery = Insert { in_ :: QualifiedIdentifier , insCols :: S.Set FieldName- , insBody :: Maybe BL.ByteString+ , insBody :: Maybe LBS.ByteString , onConflict :: Maybe (PreferResolution, [FieldName]) , where_ :: [LogicTree] , returning :: [FieldName]@@ -111,7 +109,7 @@ | Update { in_ :: QualifiedIdentifier , updCols :: S.Set FieldName- , updBody :: Maybe BL.ByteString+ , updBody :: Maybe LBS.ByteString , where_ :: [LogicTree] , returning :: [FieldName] }@@ -121,18 +119,39 @@ , returning :: [FieldName] } +data CallQuery = FunctionCall+ { funCQi :: QualifiedIdentifier+ , funCParams :: CallParams+ , funCArgs :: Maybe LBS.ByteString+ , funCScalar :: Bool+ , funCMultipleCall :: Bool+ , funCReturning :: [FieldName]+ }++data CallParams+ = KeyParams [ProcParam] -- ^ Call with key params: func(a := val1, b:= val2)+ | OnePosParam ProcParam -- ^ Call with positional params(only one supported): func(val)+ -- | The select value in `/tbl?select=alias:field::cast`-type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe EmbedHint)+type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType) type Field = (FieldName, JsonPath) type Cast = Text type Alias = Text+type Hint = Text --- | Disambiguates an embedding operation when there's multiple relationships--- between two tables. Can be the name of a foreign key constraint, column--- name or the junction in an m2m relationship.-type EmbedHint = Text+data EmbedParam+ -- | Disambiguates an embedding operation when there's multiple relationships+ -- between two tables. Can be the name of a foreign key constraint, column+ -- name or the junction in an m2m relationship.+ = EPHint Hint+ | EPJoinType JoinType +data JoinType+ = JTInner+ | JTLeft+ deriving Eq+ -- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path -- ["clients", "projects"] type EmbedPath = [Text]@@ -158,7 +177,7 @@ -- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d)) fstFieldNames :: ReadRequest -> [FieldName] fstFieldNames (Node (sel, _) _) =- fst . (\(f, _, _, _) -> f) <$> select sel+ fst . (\(f, _, _, _, _) -> f) <$> select sel -- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:@@ -178,10 +197,6 @@ | Or deriving Eq -instance Show LogicOperator where- show And = "AND"- show Or = "OR"- data Filter = Filter { field :: Field , opExpr :: OpExpr@@ -195,6 +210,7 @@ data Operation = Op Operator SingleVal | In ListVal+ | Is TrileanVal | Fts Operator (Maybe Language) SingleVal deriving (Eq) @@ -206,3 +222,11 @@ -- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3) type ListVal = [Text]++-- | Three-valued logic values+data TrileanVal+ = TriTrue+ | TriFalse+ | TriNull+ | TriUnknown+ deriving Eq
src/PostgREST/Version.hs view
@@ -1,29 +1,42 @@ {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-} module PostgREST.Version ( docsVersion , prettyVersion ) where -import qualified Data.Text as T+import qualified Data.ByteString as BS+import qualified Data.Text as T -import Data.Version (versionBranch)+import Data.Version (showVersion, versionBranch) import Development.GitRev (gitHash) import Paths_postgrest (version) import Protolude --- | User friendly version number-prettyVersion :: Text+-- | User friendly version number such as '1.1.1'.+-- Pre-release versions are tagged as such, e.g., '1.1.1.1 (pre-release)'.+-- If a git hash is available, it's added to the version, e.g., '1.1.1 (abcdef0)'.+prettyVersion :: ByteString prettyVersion =- T.intercalate "." (map show $ versionBranch version) <> gitRev+ toUtf8 (showVersion version) <> preRelease <> gitRev where gitRev =- if $(gitHash) == "UNKNOWN"- then mempty- else " (" <> T.take 7 $(gitHash) <> ")"+ if $(gitHash) == ("UNKNOWN" :: Text) then+ mempty+ else+ " (" <> BS.take 7 $(gitHash) <> ")"+ preRelease = if isPreRelease then " (pre-release)" else mempty --- | Version number used in docs++-- | Version number used in docs.+-- Uses only the two first components of the version. Example: 'v1.1' docsVersion :: Text-docsVersion = "v" <> T.dropEnd 1 (T.dropWhileEnd (/= '.') prettyVersion)+docsVersion =+ "v" <> (T.intercalate "." . map show . take 2 $ versionBranch version)+++-- | Versions with four components (e.g., '1.1.1.1') are treated as pre-releases.+isPreRelease :: Bool+isPreRelease =+ length (versionBranch version) == 4
src/PostgREST/Workers.hs view
@@ -9,13 +9,15 @@ import qualified Data.Aeson as JSON import qualified Data.ByteString as BS-import qualified Hasql.Connection as C-import qualified Hasql.Notifications as N-import qualified Hasql.Pool as P-import qualified Hasql.Transaction.Sessions as HT+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Text.Encoding as T+import qualified Hasql.Notifications as SQL+import qualified Hasql.Pool as SQL+import qualified Hasql.Transaction.Sessions as SQL -import Control.Retry (RetryStatus, capDelay, exponentialBackoff,- retrying, rsPreviousDelay)+import Control.Retry (RetryStatus, capDelay, exponentialBackoff,+ retrying, rsPreviousDelay)+import Hasql.Connection (acquire) import PostgREST.AppState (AppState) import PostgREST.Config (AppConfig (..), readAppConfig)@@ -27,8 +29,7 @@ import qualified PostgREST.AppState as AppState -import Protolude hiding (head, toS)-import Protolude.Conv (toS)+import Protolude -- | Current database connection status data ConnectionStatus@@ -108,7 +109,7 @@ connectionStatus :: AppState -> IO ConnectionStatus connectionStatus appState = retrying retrySettings shouldRetry $- const $ P.release pool >> getConnectionStatus+ const $ SQL.release pool >> getConnectionStatus where pool = AppState.getPool appState retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds@@ -117,11 +118,11 @@ getConnectionStatus :: IO ConnectionStatus getConnectionStatus = do- pgVersion <- P.use pool queryPgVersion+ pgVersion <- SQL.use pool queryPgVersion case pgVersion of Left e -> do let err = PgError False e- AppState.logWithZTime appState . toS $ errorPayload err+ AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err case checkIsFatal err of Just reason -> return $ FatalConnectionError reason@@ -144,21 +145,23 @@ "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..."+ when itShould $ AppState.putRetryNextIn appState delay return itShould -- | Load the DbStructure by using a connection from the pool. loadSchemaCache :: AppState -> IO SCacheStatus loadSchemaCache appState = do AppConfig{..} <- AppState.getConfig appState+ actualPgVersion <- AppState.getPgVersion appState result <-- let transaction = if configDbPreparedStatements then HT.transaction else HT.unpreparedTransaction in- P.use (AppState.getPool appState) . transaction HT.ReadCommitted HT.Read $- queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements+ let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in+ SQL.use (AppState.getPool appState) . transaction SQL.ReadCommitted SQL.Read $+ queryDbStructure (toList configDbSchemas) configDbExtraSearchPath actualPgVersion configDbPreparedStatements case result of Left e -> do let err = PgError False e- putErr = AppState.logWithZTime appState . toS $ errorPayload err+ putErr = AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err case checkIsFatal err of Just hint -> do AppState.logWithZTime appState "A fatal error ocurred when loading the schema cache"@@ -172,8 +175,8 @@ Right dbStructure -> do AppState.putDbStructure appState dbStructure- when (isJust configDbRootSpec) $- AppState.putJsonDbS appState $ toS $ JSON.encode dbStructure+ when (isJust configDbRootSpec) .+ AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode dbStructure AppState.logWithZTime appState "Schema cache loaded" return SCLoaded @@ -193,12 +196,12 @@ -- forkFinally allows to detect if the thread dies void . flip forkFinally (handleFinally dbChannel) $ do- dbOrError <- C.acquire $ toS configDbUri+ dbOrError <- acquire $ toUtf8 configDbUri case dbOrError of Right db -> do AppState.logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel"- N.listen db $ N.toPgIdentifier dbChannel- N.waitForNotifications handleNotification db+ SQL.listen db $ SQL.toPgIdentifier dbChannel+ SQL.waitForNotifications handleNotification db _ -> die $ "Could not listen for notifications on the " <> dbChannel <> " channel" where@@ -233,7 +236,7 @@ Left e -> do let err = PgError False e- putErr = AppState.logWithZTime appState . toS $ errorPayload err+ putErr = AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err AppState.logWithZTime appState "An error ocurred when trying to query database settings for the config parameters" case checkIsFatal err of
test/Feature/EmbedDisambiguationSpec.hs view
@@ -19,20 +19,18 @@ { "details": [ {- "cardinality": "m2o",+ "cardinality": "many-to-one", "relationship": "message_sender_fkey[sender][id]",- "origin": "test.message",- "target": "test.person"+ "embedding": "message with person" }, {- "cardinality": "m2o",+ "cardinality": "many-to-one", "relationship": "message_sender_fkey[sender][id]",- "origin": "test.message",- "target": "test.person_detail"+ "embedding": "message with person_detail" } ],- "hint": "By following the 'details' key, disambiguate the request by changing the url to /origin?select=relationship(*) or /origin?select=target!relationship(*)",- "message": "More than one relationship was found for message and sender"+ "hint": "Try changing 'sender' to one of the following: 'person!message_sender_fkey', 'person_detail!message_sender_fkey'. Find the desired relationship in the 'details' key.",+ "message": "Could not embed because more than one relationship was found for 'message' and 'sender'" } |] { matchStatus = 300@@ -45,26 +43,23 @@ { "details": [ {- "cardinality": "m2o",+ "cardinality": "many-to-one", "relationship": "main_project[main_project_id][big_project_id]",- "origin": "test.sites",- "target": "test.big_projects"+ "embedding": "sites with big_projects" }, {- "cardinality": "m2m",+ "cardinality": "many-to-many", "relationship": "test.jobs[jobs_site_id_fkey][jobs_big_project_id_fkey]",- "origin": "test.sites",- "target": "test.big_projects"+ "embedding": "sites with big_projects" }, {- "cardinality": "m2m",+ "cardinality": "many-to-many", "relationship": "test.main_jobs[jobs_site_id_fkey][jobs_big_project_id_fkey]",- "origin": "test.sites",- "target": "test.big_projects"+ "embedding": "sites with big_projects" } ],- "hint": "By following the 'details' key, disambiguate the request by changing the url to /origin?select=relationship(*) or /origin?select=target!relationship(*)",- "message": "More than one relationship was found for sites and big_projects"+ "hint": "Try changing 'big_projects' to one of the following: 'big_projects!main_project', 'big_projects!jobs', 'big_projects!main_jobs'. Find the desired relationship in the 'details' key.",+ "message": "Could not embed because more than one relationship was found for 'sites' and 'big_projects'" } |] { matchStatus = 300@@ -77,20 +72,18 @@ { "details": [ {- "cardinality": "m2o",+ "cardinality": "many-to-one", "relationship": "agents_department_id_fkey[department_id][id]",- "origin": "test.agents",- "target": "test.departments"+ "embedding": "agents with departments" }, {- "cardinality": "o2m",+ "cardinality": "one-to-many", "relationship": "departments_head_id_fkey[id][head_id]",- "origin": "test.agents",- "target": "test.departments"+ "embedding": "agents with departments" } ],- "hint": "By following the 'details' key, disambiguate the request by changing the url to /origin?select=relationship(*) or /origin?select=target!relationship(*)",- "message": "More than one relationship was found for agents and departments"+ "hint": "Try changing 'departments' to one of the following: 'departments!agents_department_id_fkey', 'departments!departments_head_id_fkey'. Find the desired relationship in the 'details' key.",+ "message": "Could not embed because more than one relationship was found for 'agents' and 'departments'" } |] { matchStatus = 300@@ -106,32 +99,28 @@ { "details": [ {- "cardinality": "m2m",+ "cardinality": "many-to-many", "relationship": "test.whatev_jobs[whatev_jobs_site_id_1_fkey][whatev_jobs_project_id_1_fkey]",- "origin": "test.whatev_sites",- "target": "test.whatev_projects"+ "embedding": "whatev_sites with whatev_projects" }, {- "cardinality": "m2m",+ "cardinality": "many-to-many", "relationship": "test.whatev_jobs[whatev_jobs_site_id_1_fkey][whatev_jobs_project_id_2_fkey]",- "origin": "test.whatev_sites",- "target": "test.whatev_projects"+ "embedding": "whatev_sites with whatev_projects" }, {- "cardinality": "m2m",+ "cardinality": "many-to-many", "relationship": "test.whatev_jobs[whatev_jobs_site_id_2_fkey][whatev_jobs_project_id_1_fkey]",- "origin": "test.whatev_sites",- "target": "test.whatev_projects"+ "embedding": "whatev_sites with whatev_projects" }, {- "cardinality": "m2m",+ "cardinality": "many-to-many", "relationship": "test.whatev_jobs[whatev_jobs_site_id_2_fkey][whatev_jobs_project_id_2_fkey]",- "origin": "test.whatev_sites",- "target": "test.whatev_projects"+ "embedding": "whatev_sites with whatev_projects" } ],- "hint": "By following the 'details' key, disambiguate the request by changing the url to /origin?select=relationship(*) or /origin?select=target!relationship(*)",- "message": "More than one relationship was found for whatev_sites and whatev_projects"+ "hint": "Try changing 'whatev_projects' to one of the following: 'whatev_projects!whatev_jobs', 'whatev_projects!whatev_jobs', 'whatev_projects!whatev_jobs', 'whatev_projects!whatev_jobs'. Find the desired relationship in the 'details' key.",+ "message": "Could not embed because more than one relationship was found for 'whatev_sites' and 'whatev_projects'" } |] { matchStatus = 300@@ -422,16 +411,6 @@ "manager":{"name":"Umbrella Manager"}, "refereeds":[]}] }]|] { matchHeaders = [matchContentTypeJson] }-- -- TODO Remove in next major version- describe "old dot '.' symbol, deprecated" $- it "still works" $ do- get "/clients?id=eq.1&select=id,projects:projects.client_id(id,tasks(id))" `shouldRespondWith`- [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]- { matchHeaders = [matchContentTypeJson] }- get "/tasks?select=id,users:users.users_tasks(id)" `shouldRespondWith`- [json|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|]- { matchHeaders = [matchContentTypeJson] } context "m2m embed when there's a junction in an internal schema" $ do -- https://github.com/PostgREST/postgrest/issues/1736
+ test/Feature/EmbedInnerJoinSpec.hs view
@@ -0,0 +1,356 @@+module Feature.EmbedInnerJoinSpec where++import Network.HTTP.Types+import Network.Wai (Application)++import Test.Hspec+import Test.Hspec.Wai+import Test.Hspec.Wai.JSON++import Protolude hiding (get)+import SpecHelper++spec :: SpecWith ((), Application)+spec =+ describe "Embedding with an inner join" $ do+ context "many-to-one relationships" $ do+ it "ignores null embeddings while the default left join doesn't" $ do+ get "/projects?select=id,clients!inner(id)" `shouldRespondWith`+ [json|[+ {"id":1,"clients":{"id":1}}, {"id":2,"clients":{"id":1}},+ {"id":3,"clients":{"id":2}}, {"id":4,"clients":{"id":2}}]|]+ { matchHeaders = [matchContentTypeJson] }+ get "/projects?select=id,clients!left(id)" `shouldRespondWith`+ [json|[+ {"id":1,"clients":{"id":1}}, {"id":2,"clients":{"id":1}},+ {"id":3,"clients":{"id":2}}, {"id":4,"clients":{"id":2}},+ {"id":5,"clients":null}]|]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/projects?select=id,clients!inner(id)" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-3/4" ]+ }++ it "filters source tables when the embedded table is filtered" $ do+ get "/projects?select=id,clients!inner(id)&clients.id=eq.1" `shouldRespondWith`+ [json|[+ {"id":1,"clients":{"id":1}},+ {"id":2,"clients":{"id":1}}]|]+ { matchHeaders = [matchContentTypeJson] }+ get "/projects?select=id,clients!inner(id)&clients.id=eq.2" `shouldRespondWith`+ [json|[+ {"id":3,"clients":{"id":2}},+ {"id":4,"clients":{"id":2}}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/projects?select=id,clients!inner(id)&clients.id=eq.0" `shouldRespondWith`+ [json|[]|]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/projects?select=id,clients!inner(id)&clients.id=eq.1" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-1/2" ]+ }++ it "filters source tables when a two levels below embedded table is filtered" $ do+ get "/tasks?select=id,projects!inner(id,clients!inner(id))&projects.clients.id=eq.1" `shouldRespondWith`+ [json|[+ {"id":1,"projects":{"id":1,"clients":{"id":1}}},+ {"id":2,"projects":{"id":1,"clients":{"id":1}}},+ {"id":3,"projects":{"id":2,"clients":{"id":1}}},+ {"id":4,"projects":{"id":2,"clients":{"id":1}}}]|]+ { matchHeaders = [matchContentTypeJson] }+ get "/tasks?select=id,projects!inner(id,clients!inner(id))&projects.clients.id=eq.2" `shouldRespondWith`+ [json|[+ {"id":5,"projects":{"id":3,"clients":{"id":2}}},+ {"id":6,"projects":{"id":3,"clients":{"id":2}}},+ {"id":7,"projects":{"id":4,"clients":{"id":2}}},+ {"id":8,"projects":{"id":4,"clients":{"id":2}}}]|]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/tasks?select=id,projects!inner(id,clients!inner(id))&projects.clients.id=eq.1" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-3/4" ]+ }++ it "only affects the source table rows if his direct embedding is an inner join" $ do+ get "/tasks?select=id,projects(id,clients!inner(id))&projects.clients.id=eq.2" `shouldRespondWith`+ [json|[+ {"id":1,"projects":null},+ {"id":2,"projects":null},+ {"id":3,"projects":null},+ {"id":4,"projects":null},+ {"id":5,"projects":{"id":3,"clients":{"id":2}}},+ {"id":6,"projects":{"id":3,"clients":{"id":2}}},+ {"id":7,"projects":{"id":4,"clients":{"id":2}}},+ {"id":8,"projects":{"id":4,"clients":{"id":2}}}]|]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/tasks?select=id,projects(id,clients!inner(id))&projects.clients.id=eq.2" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-7/8" ]+ }++ it "works with views" $ do+ get "/books?select=title,authors!inner(name)&authors.name=eq.George%20Orwell" `shouldRespondWith`+ [json| [{"title":"1984","authors":{"name":"George Orwell"}}] |]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/books?select=title,authors!inner(name)&authors.name=eq.George%20Orwell" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-0/1" ]+ }++ context "one-to-many relationships" $ do+ it "ignores empty array embeddings while the default left join doesn't" $ do+ get "/entities?select=id,child_entities!inner(id)" `shouldRespondWith`+ [json|[+ {"id":1,"child_entities":[{"id":1}, {"id":2}, {"id":4}, {"id":5}]},+ {"id":2,"child_entities":[{"id":3}, {"id":6}]}]|]+ { matchHeaders = [matchContentTypeJson] }+ get "/entities?select=id,child_entities!left(id)" `shouldRespondWith`+ [json| [+ {"id":1,"child_entities":[{"id":1}, {"id":2}, {"id":4}, {"id":5}]},+ {"id":2,"child_entities":[{"id":3}, {"id":6}]},+ {"id":3,"child_entities":[]},+ {"id":4,"child_entities":[]}] |]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/entities?select=id,child_entities!inner(id)" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-1/2" ]+ }++ it "filters source tables when the embedded table is filtered" $ do+ get "/entities?select=id,child_entities!inner(id)&child_entities.id=eq.1" `shouldRespondWith`+ [json|[{"id":1,"child_entities":[{"id":1}]}]|]+ { matchHeaders = [matchContentTypeJson] }+ get "/entities?select=id,child_entities!inner(id)&child_entities.id=eq.3" `shouldRespondWith`+ [json|[{"id":2,"child_entities":[{"id":3}]}]|]+ { matchHeaders = [matchContentTypeJson] }+ get "/entities?select=id,child_entities!inner(id)&child_entities.id=eq.0" `shouldRespondWith`+ [json|[]|]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/entities?select=id,child_entities!inner(id)&child_entities.id=eq.1" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-0/1" ]+ }++ it "filters source tables when a two levels below embedded table is filtered" $ do+ get "/entities?select=id,child_entities!inner(id,grandchild_entities!inner(id))&child_entities.grandchild_entities.id=in.(1,5)"+ `shouldRespondWith`+ [json|[+ {+ "id": 1,+ "child_entities": [+ { "id": 1, "grandchild_entities": [ { "id": 1 } ] },+ { "id": 2, "grandchild_entities": [ { "id": 5 } ] }]+ }+ ]|]+ { matchHeaders = [matchContentTypeJson] }+ get "/entities?select=id,child_entities!inner(id,grandchild_entities!inner(id))&child_entities.grandchild_entities.id=eq.2" `shouldRespondWith`+ [json|[+ {+ "id": 1,+ "child_entities": [+ { "id": 1, "grandchild_entities": [ { "id": 2 } ] } ]+ }+ ]|]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/entities?select=id,child_entities!inner(id,grandchild_entities!inner(id))&child_entities.grandchild_entities.id=in.(1,5)" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-0/1" ]+ }++ it "only affects the source table rows if his direct embedding is an inner join" $ do+ get "/entities?select=id,child_entities!inner(id,grandchild_entities(id))&child_entities.grandchild_entities.id=eq.2" `shouldRespondWith`+ [json|[+ {+ "id": 1,+ "child_entities": [+ { "id": 1, "grandchild_entities": [ { "id": 2 } ] },+ { "id": 2, "grandchild_entities": [] },+ { "id": 4, "grandchild_entities": [] },+ { "id": 5, "grandchild_entities": [] } ]+ },+ {+ "id": 2,+ "child_entities": [+ { "id": 3, "grandchild_entities": [] },+ { "id": 6, "grandchild_entities": [] } ]+ }+ ]|]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/entities?select=id,child_entities!inner(id,grandchild_entities(id))&child_entities.grandchild_entities.id=eq.2" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-1/2" ]+ }++ it "works with views" $ do+ get "/authors?select=*,books!inner(*)&books.title=eq.1984" `shouldRespondWith`+ [json| [{"id":1,"name":"George Orwell","books":[{"id":1,"title":"1984","publication_year":1949,"author_id":1}]}] |]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/authors?select=*,books!inner(*)&books.title=eq.1984" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-0/1" ]+ }++ context "many-to-many relationships" $ do+ it "ignores empty array embeddings while the default left join doesn't" $ do+ get "/products?select=id,suppliers!inner(id)" `shouldRespondWith`+ [json| [+ {"id":1,"suppliers":[{"id":1}, {"id":2}]},+ {"id":2,"suppliers":[{"id":1}, {"id":3}]}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/products?select=id,suppliers!left(id)" `shouldRespondWith`+ [json| [+ {"id":1,"suppliers":[{"id":1}, {"id":2}]},+ {"id":2,"suppliers":[{"id":1}, {"id":3}]},+ {"id":3,"suppliers":[]}] |]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/products?select=id,suppliers!inner(id)" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-1/2" ]+ }++ it "filters source tables when the embedded table is filtered" $ do+ get "/products?select=id,suppliers!inner(id)&suppliers.id=eq.2" `shouldRespondWith`+ [json| [{"id":1,"suppliers":[{"id":2}]}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/products?select=id,suppliers!inner(id)&suppliers.id=eq.3" `shouldRespondWith`+ [json| [{"id":2,"suppliers":[{"id":3}]}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/products?select=id,suppliers!inner(id)&suppliers.id=eq.0" `shouldRespondWith`+ [json| [] |]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/products?select=id,suppliers!inner(id)&suppliers.id=eq.2" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-0/1" ]+ }++ it "filters source tables when a two levels below embedded table is filtered" $ do+ get "/products?select=id,suppliers!inner(id,trade_unions!inner(id))&suppliers.trade_unions.id=eq.3"+ `shouldRespondWith`+ [json|[{"id":1,"suppliers":[{"id":2,"trade_unions":[{"id":3}]}]}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/products?select=id,suppliers!inner(id,trade_unions!inner(id))&suppliers.trade_unions.id=eq.4"+ `shouldRespondWith`+ [json|[{"id":1,"suppliers":[{"id":2,"trade_unions":[{"id":4}]}]}] |]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/products?select=id,suppliers!inner(id,trade_unions!inner(id))&suppliers.trade_unions.id=eq.3" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-0/1" ]+ }++ it "only affects the source table rows if his direct embedding is an inner join" $ do+ get "/products?select=id,suppliers!inner(id,trade_unions(id))&suppliers.trade_unions.id=eq.3" `shouldRespondWith`+ [json|[+ {"id":1,"suppliers":[{"id":1,"trade_unions":[]}, {"id":2,"trade_unions":[{"id":3}]}]},+ {"id":2,"suppliers":[{"id":1,"trade_unions":[]}, {"id":3,"trade_unions":[]}]}]|]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/products?select=id,suppliers!inner(id,trade_unions(id))&suppliers.trade_unions.id=eq.3" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-1/2" ]+ }++ it "works with views" $ do+ get "/actors?select=*,films!inner(*)&films.title=eq.douze%20commandements" `shouldRespondWith`+ [json| [{"id":1,"name":"john","films":[{"id":12,"title":"douze commandements"}]}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/films?select=*,actors!inner(*)&actors.name=eq.john" `shouldRespondWith`+ [json| [{"id":12,"title":"douze commandements","actors":[{"id":1,"name":"john"}]}] |]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/actors?select=*,films!inner(*)&films.title=eq.douze%20commandements" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-0/1" ]+ }++ it "works with m2o and m2m relationships combined" $ do+ get "/projects?select=name,clients!inner(name),users!inner(name)" `shouldRespondWith`+ [json| [+ {"name":"Windows 7","clients":{"name":"Microsoft"},"users":[{"name":"Angela Martin"}, {"name":"Dwight Schrute"}]},+ {"name":"Windows 10","clients":{"name":"Microsoft"},"users":[{"name":"Angela Martin"}]},+ {"name":"IOS","clients":{"name":"Apple"},"users":[{"name":"Michael Scott"}, {"name":"Dwight Schrute"}]},+ {"name":"OSX","clients":{"name":"Apple"},"users":[{"name":"Michael Scott"}]}]|]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/projects?select=name,clients!inner(name),users!inner(name)" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-3/4" ]+ }++ it "works with rpc" $ do+ get "/rpc/getallprojects?select=id,clients!inner(id)&clients.id=eq.1" `shouldRespondWith`+ [json| [{"id":1,"clients":{"id":1}}, {"id":2,"clients":{"id":1}}] |]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/rpc/getallprojects?select=id,clients!inner(id)&clients.id=eq.1" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-1/2" ]+ }++ it "works when using hints" $ do+ get "/projects?select=id,clients!client!inner(id)&clients.id=eq.2" `shouldRespondWith`+ [json| [{"id":3,"clients":{"id":2}}, {"id":4,"clients":{"id":2}}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/projects?select=id,client!inner(id)&client.id=eq.2" `shouldRespondWith`+ [json| [{"id":3,"client":{"id":2}}, {"id":4,"client":{"id":2}}] |]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/projects?select=id,clients!client!inner(id)&clients.id=eq.2" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-1/2" ]+ }++ it "works with many one-to-many relationships" $ do+ -- https://github.com/PostgREST/postgrest/issues/1977+ get "/client?select=id,name,contact!inner(name),clientinfo!inner(other)" `shouldRespondWith`+ [json|[+ {"id":1,"name":"Walmart","contact":[{"name":"Wally Walton"}, {"name":"Wilma Wellers"}],"clientinfo":[{"other":"123 Main St"}]},+ {"id":2,"name":"Target", "contact":[{"name":"Tabby Targo"}],"clientinfo":[{"other":"456 South 3rd St"}]},+ {"id":3,"name":"Big Lots","contact":[{"name":"Bobby Bots"}, {"name":"Bonnie Bits"}, {"name":"Billy Boats"}],"clientinfo":[{"other":"789 Palm Tree Ln"}]}+ ]|]+ { matchHeaders = [matchContentTypeJson] }+ get "/client?select=id,name,contact!inner(name),clientinfo!inner(other)&contact.name=eq.Wally%20Walton" `shouldRespondWith`+ [json|[+ {"id":1,"name":"Walmart","contact":[{"name":"Wally Walton"}],"clientinfo":[{"other":"123 Main St"}]}+ ]|]+ { matchHeaders = [matchContentTypeJson] }+ get "/client?select=id,name,contact!inner(name),clientinfo!inner(other)&clientinfo.other=eq.456%20South%203rd%20St" `shouldRespondWith`+ [json|[+ {"id":2,"name":"Target","clientinfo":[{"other":"456 South 3rd St"}],"contact":[{"name":"Tabby Targo"}]}+ ]|]+ { matchHeaders = [matchContentTypeJson] }+ request methodHead "/client?select=id,name,contact!inner(name),clientinfo!inner(other)" [("Prefer", "count=exact")] mempty+ `shouldRespondWith` ""+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson+ , "Content-Range" <:> "0-2/3" ]+ }
test/Feature/InsertSpec.hs view
@@ -11,8 +11,8 @@ import Test.Hspec.Wai.JSON import Text.Heredoc -import PostgREST.Config.PgVersion (PgVersion, pgVersion112,- pgVersion130)+import PostgREST.Config.PgVersion (PgVersion, pgVersion110,+ pgVersion112, pgVersion130) import Protolude hiding (get) import SpecHelper@@ -111,7 +111,7 @@ , "Content-Range" <:> "*/*" ] } - context "requesting headers only representation" $+ context "requesting headers only representation" $ do it "should not throw and return location header when selecting without PK" $ request methodPost "/projects?select=name,client_id" [("Prefer", "return=headers-only")] [json|{"id":11,"name":"New Project","client_id":2}|] `shouldRespondWith` ""@@ -119,6 +119,15 @@ , matchHeaders = [ "Location" <:> "/projects?id=eq.11" , "Content-Range" <:> "*/*" ] }++ when (actualPgVersion >= pgVersion110) $+ it "should not throw and return location header for partitioned tables when selecting without PK" $+ request methodPost "/car_models" [("Prefer", "return=headers-only")]+ [json|{"name":"Enzo","year":2021}|] `shouldRespondWith` ""+ { matchStatus = 201+ , matchHeaders = [ "Location" <:> "/car_models?name=eq.Enzo&year=eq.2021"+ , "Content-Range" <:> "*/*" ]+ } context "requesting no representation" $ it "should not throw and return no location header when selecting without PK" $
test/Feature/JsonOperatorSpec.hs view
@@ -8,7 +8,7 @@ import Test.Hspec.Wai.JSON import PostgREST.Config.PgVersion (PgVersion, pgVersion112,- pgVersion121, pgVersion95)+ pgVersion121) import Protolude hiding (get) import SpecHelper@@ -209,46 +209,45 @@ `shouldRespondWith` [json| [{ "data": { "id":" \"escaped" } }] |] - when (actualPgVersion >= pgVersion95) $- context "json array negative index" $ do- it "can select with negative indexes" $ do- get "/json_arr?select=data->>-1::int&id=in.(1,2)" `shouldRespondWith`- [json| [{"data":3}, {"data":6}] |]- { matchHeaders = [matchContentTypeJson] }- get "/json_arr?select=data->0->>-2::int&id=in.(3,4)" `shouldRespondWith`- [json| [{"data":8}, {"data":7}] |]- { matchHeaders = [matchContentTypeJson] }- get "/json_arr?select=data->-2->>a&id=in.(5,6)" `shouldRespondWith`- [json| [{"a":"A"}, {"a":"[1,2,3]"}] |]- { matchHeaders = [matchContentTypeJson] }+ context "json array negative index" $ do+ it "can select with negative indexes" $ do+ get "/json_arr?select=data->>-1::int&id=in.(1,2)" `shouldRespondWith`+ [json| [{"data":3}, {"data":6}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/json_arr?select=data->0->>-2::int&id=in.(3,4)" `shouldRespondWith`+ [json| [{"data":8}, {"data":7}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/json_arr?select=data->-2->>a&id=in.(5,6)" `shouldRespondWith`+ [json| [{"a":"A"}, {"a":"[1,2,3]"}] |]+ { matchHeaders = [matchContentTypeJson] } - it "can filter with negative indexes" $ do- get "/json_arr?select=data&data->>-3=eq.1" `shouldRespondWith`- [json| [{"data":[1, 2, 3]}] |]- { matchHeaders = [matchContentTypeJson] }- get "/json_arr?select=data&data->-1->>-3=eq.11" `shouldRespondWith`- [json| [{"data":[[9, 8, 7], [11, 12, 13]]}] |]- { matchHeaders = [matchContentTypeJson] }- get "/json_arr?select=data&data->-1->>b=eq.B" `shouldRespondWith`- [json| [{"data":[{"a": "A"}, {"b": "B"}]}] |]- { matchHeaders = [matchContentTypeJson] }- get "/json_arr?select=data&data->-1->b->>-1=eq.5" `shouldRespondWith`- [json| [{"data":[{"a": [1,2,3]}, {"b": [4,5]}]}] |]- { matchHeaders = [matchContentTypeJson] }+ it "can filter with negative indexes" $ do+ get "/json_arr?select=data&data->>-3=eq.1" `shouldRespondWith`+ [json| [{"data":[1, 2, 3]}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/json_arr?select=data&data->-1->>-3=eq.11" `shouldRespondWith`+ [json| [{"data":[[9, 8, 7], [11, 12, 13]]}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/json_arr?select=data&data->-1->>b=eq.B" `shouldRespondWith`+ [json| [{"data":[{"a": "A"}, {"b": "B"}]}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/json_arr?select=data&data->-1->b->>-1=eq.5" `shouldRespondWith`+ [json| [{"data":[{"a": [1,2,3]}, {"b": [4,5]}]}] |]+ { matchHeaders = [matchContentTypeJson] } - it "should fail on badly formed negatives" $ do- get "/json_arr?select=data->>-78xy" `shouldRespondWith`- [json|- {"details": "unexpected 'x' expecting digit, \"->\", \"::\" or end of input",- "message": "\"failed to parse select parameter (data->>-78xy)\" (line 1, column 11)"} |]- { matchStatus = 400, matchHeaders = [matchContentTypeJson] }- get "/json_arr?select=data->>--34" `shouldRespondWith`- [json|- {"details": "unexpected \"-\" expecting digit",- "message": "\"failed to parse select parameter (data->>--34)\" (line 1, column 9)"} |]- { matchStatus = 400, matchHeaders = [matchContentTypeJson] }- get "/json_arr?select=data->>-xy-4" `shouldRespondWith`- [json|- {"details":"unexpected \"x\" expecting digit",- "message":"\"failed to parse select parameter (data->>-xy-4)\" (line 1, column 9)"} |]- { matchStatus = 400, matchHeaders = [matchContentTypeJson] }+ it "should fail on badly formed negatives" $ do+ get "/json_arr?select=data->>-78xy" `shouldRespondWith`+ [json|+ {"details": "unexpected 'x' expecting digit, \"->\", \"::\" or end of input",+ "message": "\"failed to parse select parameter (data->>-78xy)\" (line 1, column 11)"} |]+ { matchStatus = 400, matchHeaders = [matchContentTypeJson] }+ get "/json_arr?select=data->>--34" `shouldRespondWith`+ [json|+ {"details": "unexpected \"-\" expecting digit",+ "message": "\"failed to parse select parameter (data->>--34)\" (line 1, column 9)"} |]+ { matchStatus = 400, matchHeaders = [matchContentTypeJson] }+ get "/json_arr?select=data->>-xy-4" `shouldRespondWith`+ [json|+ {"details":"unexpected \"x\" expecting digit",+ "message":"\"failed to parse select parameter (data->>-xy-4)\" (line 1, column 9)"} |]+ { matchStatus = 400, matchHeaders = [matchContentTypeJson] }
+ test/Feature/LegacyGucsSpec.hs view
@@ -0,0 +1,68 @@+module Feature.LegacyGucsSpec where++import Network.Wai (Application)++import Network.HTTP.Types+import Test.Hspec hiding (pendingWith)+import Test.Hspec.Wai+import Test.Hspec.Wai.JSON++import Protolude hiding (get)+import SpecHelper++spec :: SpecWith ((), Application)+spec =+ describe "remote procedure call with legacy gucs disabled" $ do+ it "custom header is set" $+ request methodPost "/rpc/get_guc_value" [("Custom-Header", "test")]+ [json| { "prefix": "request.headers", "name": "custom-header" } |]+ `shouldRespondWith`+ [json|"test"|]+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson ]+ }++ it "standard header is set" $+ request methodPost "/rpc/get_guc_value" [("Origin", "http://example.com")]+ [json| { "prefix": "request.headers", "name": "origin" } |]+ `shouldRespondWith`+ [json|"http://example.com"|]+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson ]+ }++ it "current role is available as GUC claim" $+ request methodPost "/rpc/get_guc_value" []+ [json| { "prefix": "request.jwt.claims", "name": "role" } |]+ `shouldRespondWith`+ [json|"postgrest_test_anonymous"|]+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson ]+ }++ it "single cookie ends up as claims" $+ request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue")]+ [json| {"prefix": "request.cookies", "name":"acookie"} |]+ `shouldRespondWith`+ [json|"cookievalue"|]+ { matchStatus = 200+ , matchHeaders = []+ }++ it "multiple cookies ends up as claims" $+ request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue;secondcookie=anothervalue")]+ [json| {"prefix": "request.cookies", "name":"secondcookie"} |]+ `shouldRespondWith`+ [json|"anothervalue"|]+ { matchStatus = 200+ , matchHeaders = []+ }++ it "gets the Authorization value" $+ request methodPost "/rpc/get_guc_value" [authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"]+ [json| {"prefix": "request.headers", "name":"authorization"} |]+ `shouldRespondWith`+ [json|"Bearer eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"|]+ { matchStatus = 200+ , matchHeaders = []+ }
test/Feature/MultipleSchemaSpec.hs view
@@ -15,10 +15,8 @@ import Protolude import SpecHelper -import PostgREST.Config.PgVersion (PgVersion, pgVersion96)--spec :: PgVersion -> SpecWith ((), Application)-spec actualPgVersion =+spec :: SpecWith ((), Application)+spec = describe "multiple schemas in single instance" $ do context "Reading tables on different schemas" $ do it "succeeds in reading table from default schema v1 if no schema is selected via header" $@@ -191,16 +189,15 @@ [json|[{"id": 1, "name": "child v2-3", "parent_id": 3}]|] { matchHeaders = ["Content-Profile" <:> "v2"] } - when (actualPgVersion >= pgVersion96) $- it "succeeds on PUT on the v2 schema" $- request methodPut "/children?id=eq.111" [("Content-Profile", "v2"), ("Prefer", "return=representation")]- [json| [ { "id": 111, "name": "child v2-111", "parent_id": null } ]|]- `shouldRespondWith`- [json|[{ "id": 111, "name": "child v2-111", "parent_id": null }]|]- {- matchStatus = 200- , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v2"]- }+ it "succeeds on PUT on the v2 schema" $+ request methodPut "/children?id=eq.111" [("Content-Profile", "v2"), ("Prefer", "return=representation")]+ [json| [ { "id": 111, "name": "child v2-111", "parent_id": null } ]|]+ `shouldRespondWith`+ [json|[{ "id": 111, "name": "child v2-111", "parent_id": null }]|]+ {+ matchStatus = 200+ , matchHeaders = [matchContentTypeJson, "Content-Profile" <:> "v2"]+ } context "OpenAPI output" $ do it "succeeds in reading table definition from default schema v1 if no schema is selected via header" $ do
test/Feature/OpenApiSpec.hs view
@@ -11,12 +11,15 @@ import Test.Hspec hiding (pendingWith) import Test.Hspec.Wai +import PostgREST.Config.PgVersion (PgVersion, pgVersion100,+ pgVersion110)+ import PostgREST.Version (docsVersion) import Protolude hiding (get) import SpecHelper -spec :: SpecWith ((), Application)-spec = describe "OpenAPI" $ do+spec :: PgVersion -> SpecWith ((), Application)+spec actualPgVersion = describe "OpenAPI" $ do it "root path returns a valid openapi spec" $ do validateOpenApiResponse [("Accept", "application/openapi+json")] request methodHead "/" (acceptHdrs "application/openapi+json") ""@@ -195,6 +198,32 @@ ] |] + when (actualPgVersion >= pgVersion100) $ do+ describe "Partitioned table" $++ it "includes partitioned table properties" $ do+ r <- simpleBody <$> get "/"++ let method s = key "paths" . key "/car_models" . key s+ getSummary = r ^? method "get" . key "summary"+ getDescription = r ^? method "get" . key "description"+ getParameterName = r ^? method "get" . key "parameters" . nth 0 . key "$ref"+ getParameterYear = r ^? method "get" . key "parameters" . nth 1 . key "$ref"+ getParameterRef = r ^? method "get" . key "parameters" . nth 2 . key "$ref"++ liftIO $ do++ getSummary `shouldBe` Just "A partitioned table"++ getDescription `shouldBe` Just "A test for partitioned tables"++ getParameterName `shouldBe` Just "#/parameters/rowFilter.car_models.name"++ getParameterYear `shouldBe` Just "#/parameters/rowFilter.car_models.year"++ when (actualPgVersion >= pgVersion110) $+ getParameterRef `shouldBe` Just "#/parameters/rowFilter.car_models.car_brand_name"+ describe "Materialized view" $ it "includes materialized view properties" $ do@@ -395,6 +424,62 @@ "type": "number" } |]++ describe "Detects default values" $ do++ it "text" $ do+ r <- simpleBody <$> get "/"++ let defaultValue = r ^? key "definitions" . key "openapi_defaults" . key "properties" . key "text" . key "default"++ liftIO $++ defaultValue `shouldBe` Just "default"++ it "boolean" $ do+ r <- simpleBody <$> get "/"++ let types = r ^? key "definitions" . key "openapi_defaults" . key "properties" . key "boolean" . key "default"++ liftIO $++ types `shouldBe` Just (Bool False)++ it "integer" $ do+ r <- simpleBody <$> get "/"++ let types = r ^? key "definitions" . key "openapi_defaults" . key "properties" . key "integer" . key "default"++ liftIO $++ types `shouldBe` Just (Number 42)++ it "numeric" $ do+ r <- simpleBody <$> get "/"++ let types = r ^? key "definitions" . key "openapi_defaults" . key "properties" . key "numeric" . key "default"++ liftIO $++ types `shouldBe` Just (Number 42.2)++ it "date" $ do+ r <- simpleBody <$> get "/"++ let types = r ^? key "definitions" . key "openapi_defaults" . key "properties" . key "date" . key "default"++ liftIO $++ types `shouldBe` Just "1900-01-01"++ it "time" $ do+ r <- simpleBody <$> get "/"++ let types = r ^? key "definitions" . key "openapi_defaults" . key "properties" . key "time" . key "default"++ liftIO $++ types `shouldBe` Just "13:00:00" describe "RPC" $ do
test/Feature/OptionsSpec.hs view
@@ -7,17 +7,33 @@ import Test.Hspec import Test.Hspec.Wai +import PostgREST.Config.PgVersion (PgVersion, pgVersion100,+ pgVersion110)+ import Protolude import SpecHelper -spec :: SpecWith ((), Application)-spec = describe "Allow header" $ do+spec :: PgVersion -> SpecWith ((), Application)+spec actualPgVersion = describe "Allow header" $ do context "a table" $ do it "includes read/write verbs for writeable table" $ do r <- request methodOptions "/items" [] "" liftIO $ simpleHeaders r `shouldSatisfy` matchHeader "Allow" "OPTIONS,GET,HEAD,POST,PUT,PATCH,DELETE"++ when (actualPgVersion >= pgVersion100) $+ context "a partitioned table" $ do+ it "includes read/write verbs for writeable partitioned tables" $ do+ r <- request methodOptions "/car_models" [] ""+ liftIO $+ simpleHeaders r `shouldSatisfy`+ matchHeader "Allow" (+ if actualPgVersion >= pgVersion110 then+ "OPTIONS,GET,HEAD,POST,PUT,PATCH,DELETE"+ else+ "OPTIONS,GET,HEAD,POST,PATCH,DELETE"+ ) context "a view" $ do context "auto updatable" $ do
test/Feature/QuerySpec.hs view
@@ -8,8 +8,8 @@ import Test.Hspec.Wai import Test.Hspec.Wai.JSON -import PostgREST.Config.PgVersion (PgVersion, pgVersion112,- pgVersion121, pgVersion96)+import PostgREST.Config.PgVersion (PgVersion, pgVersion110,+ pgVersion112, pgVersion121) import Protolude hiding (get) import SpecHelper @@ -72,6 +72,23 @@ get "/nullable_integer?a=is.null" `shouldRespondWith` [json|[{"a":null}]|] + it "matches with trilean values" $ do+ get "/chores?done=is.true" `shouldRespondWith`+ [json| [{"id": 1, "name": "take out the garbage", "done": true }] |]+ { matchHeaders = [matchContentTypeJson] }++ get "/chores?done=is.false" `shouldRespondWith`+ [json| [{"id": 2, "name": "do the laundry", "done": false }] |]+ { matchHeaders = [matchContentTypeJson] }++ get "/chores?done=is.unknown" `shouldRespondWith`+ [json| [{"id": 3, "name": "wash the dishes", "done": null }] |]+ { matchHeaders = [matchContentTypeJson] }++ it "fails if 'is' used and there's no null or trilean value" $ do+ get "/chores?done=is.nil" `shouldRespondWith` 400+ get "/chores?done=is.ok" `shouldRespondWith` 400+ it "matches with like" $ do get "/simple_pk?k=like.*yx" `shouldRespondWith` [json|[{"k":"xyyx","extra":"u"}]|]@@ -182,34 +199,33 @@ {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|] { matchHeaders = [matchContentTypeJson] } - when (actualPgVersion >= pgVersion96) $- context "Use of the phraseto_tsquery function" $ do- it "finds matches" $- get "/tsearch?text_search_vector=phfts.The%20Fat%20Cats" `shouldRespondWith`- [json| [{"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" }] |]- { matchHeaders = [matchContentTypeJson] }+ context "Use of the phraseto_tsquery function" $ do+ it "finds matches" $+ get "/tsearch?text_search_vector=phfts.The%20Fat%20Cats" `shouldRespondWith`+ [json| [{"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" }] |]+ { matchHeaders = [matchContentTypeJson] } - it "finds matches with different dictionaries" $- get "/tsearch?text_search_vector=phfts(german).Art%20Spass" `shouldRespondWith`- [json| [{"text_search_vector": "'art':4 'spass':5 'unmog':7" }] |]- { matchHeaders = [matchContentTypeJson] }+ it "finds matches with different dictionaries" $+ get "/tsearch?text_search_vector=phfts(german).Art%20Spass" `shouldRespondWith`+ [json| [{"text_search_vector": "'art':4 'spass':5 'unmog':7" }] |]+ { matchHeaders = [matchContentTypeJson] } - it "can be negated with not operator" $- get "/tsearch?text_search_vector=not.phfts(english).The%20Fat%20Cats" `shouldRespondWith`- [json| [- {"text_search_vector": "'fun':5 'imposs':9 'kind':3"},- {"text_search_vector": "'also':2 'fun':3 'possibl':8"},- {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},- {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]- { matchHeaders = [matchContentTypeJson] }+ it "can be negated with not operator" $+ get "/tsearch?text_search_vector=not.phfts(english).The%20Fat%20Cats" `shouldRespondWith`+ [json| [+ {"text_search_vector": "'fun':5 'imposs':9 'kind':3"},+ {"text_search_vector": "'also':2 'fun':3 'possibl':8"},+ {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},+ {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]+ { matchHeaders = [matchContentTypeJson] } - it "can be used with or query param" $- get "/tsearch?or=(text_search_vector.phfts(german).Art%20Spass, text_search_vector.phfts(french).amusant, text_search_vector.fts(english).impossible)" `shouldRespondWith`- [json|[- {"text_search_vector": "'fun':5 'imposs':9 'kind':3" },- {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" },- {"text_search_vector": "'art':4 'spass':5 'unmog':7"}- ]|] { matchHeaders = [matchContentTypeJson] }+ it "can be used with or query param" $+ get "/tsearch?or=(text_search_vector.phfts(german).Art%20Spass, text_search_vector.phfts(french).amusant, text_search_vector.fts(english).impossible)" `shouldRespondWith`+ [json|[+ {"text_search_vector": "'fun':5 'imposs':9 'kind':3" },+ {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" },+ {"text_search_vector": "'art':4 'spass':5 'unmog':7"}+ ]|] { matchHeaders = [matchContentTypeJson] } it "matches with computed column" $ get "/items?always_true=eq.true&order=id.asc" `shouldRespondWith`@@ -395,6 +411,100 @@ [json|[{"id":1,"computed_overload":true}]|] { matchHeaders = [matchContentTypeJson] } + when (actualPgVersion >= pgVersion110) $ do+ describe "partitioned tables embedding" $ do+ it "can request a table as parent from a partitioned table" $+ get "/car_models?name=in.(DeLorean,Murcielago)&select=name,year,car_brands(name)&order=name.asc" `shouldRespondWith`+ [json|+ [{"name":"DeLorean","year":1981,"car_brands":{"name":"DMC"}},+ {"name":"Murcielago","year":2001,"car_brands":{"name":"Lamborghini"}}] |]+ { matchHeaders = [matchContentTypeJson] }++ it "can request partitioned tables as children from a table" $+ get "/car_brands?select=name,car_models(name,year)&order=name.asc&car_models.order=name.asc" `shouldRespondWith`+ [json|+ [{"name":"DMC","car_models":[{"name":"DeLorean","year":1981}]},+ {"name":"Ferrari","car_models":[{"name":"F310-B","year":1997}]},+ {"name":"Lamborghini","car_models":[{"name":"Murcielago","year":2001},{"name":"Veneno","year":2013}]}] |]+ { matchHeaders = [matchContentTypeJson] }++ when (actualPgVersion >= pgVersion121) $ do+ it "can request tables as children from a partitioned table" $+ get "/car_models?name=in.(DeLorean,F310-B)&select=name,year,car_racers(name)&order=name.asc" `shouldRespondWith`+ [json|+ [{"name":"DeLorean","year":1981,"car_racers":[]},+ {"name":"F310-B","year":1997,"car_racers":[{"name":"Michael Schumacher"}]}] |]+ { matchHeaders = [matchContentTypeJson] }++ it "can request a partitioned table as parent from a table" $+ get "/car_racers?select=name,car_models(name,year)&order=name.asc" `shouldRespondWith`+ [json|+ [{"name":"Alain Prost","car_models":null},+ {"name":"Michael Schumacher","car_models":{"name":"F310-B","year":1997}}] |]+ { matchHeaders = [matchContentTypeJson] }++ it "can request partitioned tables as children from a partitioned table" $+ get "/car_models?name=in.(DeLorean,Murcielago,Veneno)&select=name,year,car_model_sales(date,quantity)&order=name.asc" `shouldRespondWith`+ [json|+ [{"name":"DeLorean","year":1981,"car_model_sales":[{"date":"2021-01-14","quantity":7},{"date":"2021-01-15","quantity":9}]},+ {"name":"Murcielago","year":2001,"car_model_sales":[{"date":"2021-02-11","quantity":1},{"date":"2021-02-12","quantity":3}]},+ {"name":"Veneno","year":2013,"car_model_sales":[]}] |]+ { matchHeaders = [matchContentTypeJson] }++ it "can request a partitioned table as parent from a partitioned table" $ do+ get "/car_model_sales?date=in.(2021-01-15,2021-02-11)&select=date,quantity,car_models(name,year)&order=date.asc" `shouldRespondWith`+ [json|+ [{"date":"2021-01-15","quantity":9,"car_models":{"name":"DeLorean","year":1981}},+ {"date":"2021-02-11","quantity":1,"car_models":{"name":"Murcielago","year":2001}}] |]+ { matchHeaders = [matchContentTypeJson] }++ it "can request many to many relationships between partitioned tables ignoring the intermediate table partitions" $+ get "/car_models?select=name,year,car_dealers(name,city)&order=name.asc&limit=4" `shouldRespondWith`+ [json|+ [{"name":"DeLorean","year":1981,"car_dealers":[{"name":"Springfield Cars S.A.","city":"Springfield"}]},+ {"name":"F310-B","year":1997,"car_dealers":[]},+ {"name":"Murcielago","year":2001,"car_dealers":[{"name":"The Best Deals S.A.","city":"Franklin"}]},+ {"name":"Veneno","year":2013,"car_dealers":[]}] |]+ { matchStatus = 200+ , matchHeaders = [matchContentTypeJson]+ }++ it "cannot request partitions as children from a partitioned table" $+ get "/car_models?id=in.(1,2,4)&select=id,name,car_model_sales_202101(id)&order=id.asc" `shouldRespondWith`+ [json|+ {"hint":"If a new foreign key between these entities was created in the database, try reloading the schema cache.",+ "message":"Could not find a relationship between car_models and car_model_sales_202101 in the schema cache"} |]+ { matchStatus = 400+ , matchHeaders = [matchContentTypeJson]+ }++ it "cannot request a partitioned table as parent from a partition" $+ get "/car_model_sales_202101?select=id,name,car_models(id,name)&order=id.asc" `shouldRespondWith`+ [json|+ {"hint":"If a new foreign key between these entities was created in the database, try reloading the schema cache.",+ "message":"Could not find a relationship between car_model_sales_202101 and car_models in the schema cache"} |]+ { matchStatus = 400+ , matchHeaders = [matchContentTypeJson]+ }++ it "cannot request a partition as parent from a partitioned table" $+ get "/car_model_sales?id=in.(1,3,4)&select=id,name,car_models_default(id,name)&order=id.asc" `shouldRespondWith`+ [json|+ {"hint":"If a new foreign key between these entities was created in the database, try reloading the schema cache.",+ "message":"Could not find a relationship between car_model_sales and car_models_default in the schema cache"} |]+ { matchStatus = 400+ , matchHeaders = [matchContentTypeJson]+ }++ it "cannot request partitioned tables as children from a partition" $+ get "/car_models_default?select=id,name,car_model_sales(id,name)&order=id.asc" `shouldRespondWith`+ [json|+ {"hint":"If a new foreign key between these entities was created in the database, try reloading the schema cache.",+ "message":"Could not find a relationship between car_models_default and car_model_sales in the schema cache"} |]+ { matchStatus = 400+ , matchHeaders = [matchContentTypeJson]+ }+ describe "view embedding" $ do it "can detect fk relations through views to tables in the public schema" $ get "/consumers_view?select=*,orders_view(*)" `shouldRespondWith` 200@@ -861,25 +971,56 @@ get "/w_or_wo_comma_names?name=in.(\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\")" `shouldRespondWith` [json| [{"name":"Hebdon, John"},{"name":"Williams, Mary"},{"name":"Smith, Joseph"}] |] { matchHeaders = [matchContentTypeJson] }- get "/w_or_wo_comma_names?name=not.in.(\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\")" `shouldRespondWith`- [json| [{"name":"David White"},{"name":"Larry Thompson"},{"name":"Double O Seven(007)"}] |]+ get "/w_or_wo_comma_names?name=not.in.(\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\")&limit=3" `shouldRespondWith`+ [json| [ { "name": "David White" }, { "name": "Larry Thompson" }, { "name": "Double O Seven(007)" }] |] { matchHeaders = [matchContentTypeJson] } it "succeeds w/ and w/o quoted values" $ do get "/w_or_wo_comma_names?name=in.(David White,\"Hebdon, John\")" `shouldRespondWith` [json| [{"name":"Hebdon, John"},{"name":"David White"}] |] { matchHeaders = [matchContentTypeJson] }- get "/w_or_wo_comma_names?name=not.in.(\"Hebdon, John\",Larry Thompson,\"Smith, Joseph\")" `shouldRespondWith`- [json| [{"name":"Williams, Mary"},{"name":"David White"},{"name":"Double O Seven(007)"}] |]+ get "/w_or_wo_comma_names?name=not.in.(\"Hebdon, John\",Larry Thompson,\"Smith, Joseph\")&limit=3" `shouldRespondWith`+ [json| [ { "name": "Williams, Mary" }, { "name": "David White" }, { "name": "Double O Seven(007)" }] |] { matchHeaders = [matchContentTypeJson] } get "/w_or_wo_comma_names?name=in.(\"Double O Seven(007)\")" `shouldRespondWith` [json| [{"name":"Double O Seven(007)"}] |] { matchHeaders = [matchContentTypeJson] } - it "fails on malformed quoted values" $ do- get "/w_or_wo_comma_names?name=in.(\"\"Hebdon, John\")" `shouldRespondWith` 400- get "/w_or_wo_comma_names?name=in.(\"\"Hebdon, John\"\"Mary)" `shouldRespondWith` 400- get "/w_or_wo_comma_names?name=in.(Williams\"Hebdon, John\")" `shouldRespondWith` 400+ context "escaped chars" $ do+ it "accepts escaped double quotes" $+ get "/w_or_wo_comma_names?name=in.(\"Double\\\"Quote\\\"McGraw\\\"\")" `shouldRespondWith`+ [json| [ { "name": "Double\"Quote\"McGraw\"" } ] |]+ { matchHeaders = [matchContentTypeJson] }++ it "accepts escaped backslashes" $ do+ get "/w_or_wo_comma_names?name=in.(\"\\\\\")" `shouldRespondWith`+ [json| [{ "name": "\\" }] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/w_or_wo_comma_names?name=in.(\"/\\\\Slash/\\\\Beast/\\\\\")" `shouldRespondWith`+ [json| [ { "name": "/\\Slash/\\Beast/\\" } ] |]+ { matchHeaders = [matchContentTypeJson] }++ it "passes any escaped char as the same char" $+ get "/w_or_wo_comma_names?name=in.(\"D\\a\\vid W\\h\\ite\")" `shouldRespondWith`+ [json| [{ "name": "David White" }] |]+ { matchHeaders = [matchContentTypeJson] }++ describe "IN values without quotes" $ do+ it "accepts single double quotes as values" $ do+ get "/w_or_wo_comma_names?name=in.(\")" `shouldRespondWith`+ [json| [{ "name": "\"" }] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/w_or_wo_comma_names?name=in.(Double\"Quote\"McGraw\")" `shouldRespondWith`+ [json| [ { "name": "Double\"Quote\"McGraw\"" } ] |]+ { matchHeaders = [matchContentTypeJson] }++ it "accepts backslashes as values" $ do+ get "/w_or_wo_comma_names?name=in.(\\)" `shouldRespondWith`+ [json| [{ "name": "\\" }] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/w_or_wo_comma_names?name=in.(/\\Slash/\\Beast/\\)" `shouldRespondWith`+ [json| [ { "name": "/\\Slash/\\Beast/\\" } ] |]+ { matchHeaders = [matchContentTypeJson] } describe "IN and NOT IN empty set" $ do context "returns an empty result for IN when no value is present" $ do
test/Feature/RpcSpec.hs view
@@ -1,11 +1,12 @@ module Feature.RpcSpec where -import qualified Data.ByteString.Lazy as BL (empty)+import qualified Data.ByteString.Lazy as BL (empty, readFile) import Network.Wai (Application) import Network.Wai.Test (SResponse (simpleBody, simpleHeaders, simpleStatus)) import Network.HTTP.Types+import System.IO.Unsafe (unsafePerformIO) import Test.Hspec hiding (pendingWith) import Test.Hspec.Wai import Test.Hspec.Wai.JSON@@ -14,7 +15,7 @@ import PostgREST.Config.PgVersion (PgVersion, pgVersion100, pgVersion109, pgVersion110, pgVersion112, pgVersion114,- pgVersion96)+ pgVersion140) import Protolude hiding (get) import SpecHelper@@ -107,7 +108,7 @@ it "should not ignore unknown args and fail with 404" $ get "/rpc/add_them?a=1&b=2&smthelse=blabla" `shouldRespondWith` [json| {- "hint":"If a new function was created in the database with this name and arguments, try reloading the schema cache.",+ "hint":"If a new function was created in the database with this name and parameters, try reloading the schema cache.", "message":"Could not find the test.add_them(a, b, smthelse) function in the schema cache" } |] { matchStatus = 404 , matchHeaders = [matchContentTypeJson]@@ -119,8 +120,8 @@ [json|{}|] `shouldRespondWith` [json| {- "hint":"If a new function was created in the database with this name and arguments, try reloading the schema cache.",- "message":"Could not find the test.sayhello function with a single json or jsonb argument in the schema cache" } |]+ "hint":"If a new function was created in the database with this name and parameters, try reloading the schema cache.",+ "message":"Could not find the test.sayhello function with a single json or jsonb parameter in the schema cache" } |] { matchStatus = 404 , matchHeaders = [matchContentTypeJson] }@@ -128,25 +129,25 @@ it "should fail with 404 for overloaded functions with unknown args" $ do get "/rpc/overloaded?wrong_arg=value" `shouldRespondWith` [json| {- "hint":"If a new function was created in the database with this name and arguments, try reloading the schema cache.",+ "hint":"If a new function was created in the database with this name and parameters, try reloading the schema cache.", "message":"Could not find the test.overloaded(wrong_arg) function in the schema cache" } |] { matchStatus = 404 , matchHeaders = [matchContentTypeJson] } get "/rpc/overloaded?a=1&b=2&wrong_arg=value" `shouldRespondWith` [json| {- "hint":"If a new function was created in the database with this name and arguments, try reloading the schema cache.",+ "hint":"If a new function was created in the database with this name and parameters, try reloading the schema cache.", "message":"Could not find the test.overloaded(a, b, wrong_arg) function in the schema cache" } |] { matchStatus = 404 , matchHeaders = [matchContentTypeJson] } - context "ambiguous overloaded functions with same arguments but different types" $ do- it "should fail with 300 Multiple Choices without explicit argument type casts" $+ context "ambiguous overloaded functions with same parameters' names but different types" $ do+ it "should fail with 300 Multiple Choices without explicit type casts" $ get "/rpc/overloaded_same_args?arg=value" `shouldRespondWith` [json| {- "hint":"Overloaded functions with the same argument name but different types are not supported",- "message":"Could not choose the best candidate function between: test.overloaded_same_args(arg => integer), test.overloaded_same_args(arg => xml), test.overloaded_same_args(arg => text, num => integer)" } |]+ "hint":"Try renaming the parameters or the function itself in the database so function overloading can be resolved",+ "message":"Could not choose the best candidate function between: test.overloaded_same_args(arg => integer), test.overloaded_same_args(arg => xml), test.overloaded_same_args(arg => text, num => integer)"}|] { matchStatus = 300 , matchHeaders = [matchContentTypeJson] }@@ -177,11 +178,11 @@ { matchHeaders = [matchContentTypeJson] } it "can limit proc results" $ do- post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1" [json| {} |]+ post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id&limit=2&offset=1" [json| {} |] `shouldRespondWith` [json|[{"id":3},{"id":4}]|] { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "1-2/*"] }- get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1"+ get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id&limit=2&offset=1" `shouldRespondWith` [json|[{"id":3},{"id":4}]|] { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "1-2/*"] }@@ -493,6 +494,11 @@ liftIO $ do simpleStatus p `shouldBe` badRequest400 isErrorFormat (simpleBody p) `shouldBe` True+ it "treats plpgsql assert as internal server error" $ do+ p <- post "/rpc/assert" "{}"+ liftIO $ do+ simpleStatus p `shouldBe` internalServerError500+ isErrorFormat (simpleBody p) `shouldBe` True context "unsupported verbs" $ do it "DELETE fails" $@@ -571,6 +577,17 @@ `shouldRespondWith` [json|{"num":1,"str":"two","b":false}|] + context "procs with TABLE return" $ do+ it "returns an object result when there is a single-column TABLE return type" $+ get "/rpc/single_column_table_return"+ `shouldRespondWith`+ [json|[{"a": "A"}]|]++ it "returns an object result when there is a multi-column TABLE return type" $+ get "/rpc/multi_column_table_return"+ `shouldRespondWith`+ [json|[{"a": "A", "b": "B"}]|]+ context "procs with VARIADIC params" $ do when (actualPgVersion < pgVersion100) $ it "works with POST (Postgres < 10)" $@@ -726,6 +743,36 @@ `shouldRespondWith` [json|"123"|] + -- https://github.com/PostgREST/postgrest/issues/1672+ context "embedding overloaded functions with the same signature except for the last param with a default value" $ do+ it "overloaded_default(text default)" $ do+ request methodPost "/rpc/overloaded_default?select=id,name,users(name)"+ [("Content-Type", "application/json")]+ [json|{}|]+ `shouldRespondWith`+ [json|[{"id": 2, "name": "Code w7", "users": [{"name": "Angela Martin"}]}] |]++ it "overloaded_default(int)" $+ request methodPost "/rpc/overloaded_default"+ [("Content-Type", "application/json")]+ [json|{"must_param":1}|]+ `shouldRespondWith`+ [json|{"val":1}|]++ it "overloaded_default(int, text default)" $ do+ request methodPost "/rpc/overloaded_default?select=id,name,users(name)"+ [("Content-Type", "application/json")]+ [json|{"a":4}|]+ `shouldRespondWith`+ [json|[{"id": 5, "name": "Design IOS", "users": [{"name": "Michael Scott"}, {"name": "Dwight Schrute"}]}] |]++ it "overloaded_default(int, int)" $+ request methodPost "/rpc/overloaded_default"+ [("Content-Type", "application/json")]+ [json|{"a":2,"must_param":4}|]+ `shouldRespondWith`+ [json|{"a":2,"val":4}|]+ context "only for POST rpc" $ do it "gives a parse filter error if GET style proc args are specified" $ post "/rpc/sayhello?name=John" [json|{name: "John"}|] `shouldRespondWith` 400@@ -786,7 +833,12 @@ it "custom header is set" $ request methodPost "/rpc/get_guc_value" [("Custom-Header", "test")]- [json| { "name": "request.header.custom-header" } |]+ (+ if actualPgVersion >= pgVersion140 then+ [json| { "prefix": "request.headers", "name": "custom-header" } |]+ else+ [json| { "name": "request.header.custom-header" } |]+ ) `shouldRespondWith` [json|"test"|] { matchStatus = 200@@ -795,7 +847,12 @@ it "standard header is set" $ request methodPost "/rpc/get_guc_value" [("Origin", "http://example.com")]- [json| { "name": "request.header.origin" } |]+ (+ if actualPgVersion >= pgVersion140 then+ [json| { "prefix": "request.headers", "name": "origin" } |]+ else+ [json| { "name": "request.header.origin" } |]+ ) `shouldRespondWith` [json|"http://example.com"|] { matchStatus = 200@@ -803,7 +860,12 @@ } it "current role is available as GUC claim" $ request methodPost "/rpc/get_guc_value" []- [json| { "name": "request.jwt.claim.role" } |]+ (+ if actualPgVersion >= pgVersion140 then+ [json| { "prefix": "request.jwt.claims", "name": "role" } |]+ else+ [json| { "name": "request.jwt.claim.role" } |]+ ) `shouldRespondWith` [json|"postgrest_test_anonymous"|] { matchStatus = 200@@ -811,7 +873,12 @@ } it "single cookie ends up as claims" $ request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue")]- [json| {"name":"request.cookie.acookie"} |]+ (+ if actualPgVersion >= pgVersion140 then+ [json| {"prefix": "request.cookies", "name":"acookie"} |]+ else+ [json| {"name":"request.cookie.acookie"} |]+ ) `shouldRespondWith` [json|"cookievalue"|] { matchStatus = 200@@ -819,7 +886,12 @@ } it "multiple cookies ends up as claims" $ request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue;secondcookie=anothervalue")]- [json| {"name":"request.cookie.secondcookie"} |]+ (+ if actualPgVersion >= pgVersion140 then+ [json| {"prefix": "request.cookies", "name":"secondcookie"} |]+ else+ [json| {"name":"request.cookie.secondcookie"} |]+ ) `shouldRespondWith` [json|"anothervalue"|] { matchStatus = 200@@ -835,7 +907,12 @@ } it "gets the Authorization value" $ request methodPost "/rpc/get_guc_value" [authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"]- [json| {"name":"request.header.authorization"} |]+ (+ if actualPgVersion >= pgVersion140 then+ [json| {"prefix": "request.headers", "name":"authorization"} |]+ else+ [json| {"name":"request.header.authorization"} |]+ ) `shouldRespondWith` [json|"Bearer eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"|] { matchStatus = 200@@ -933,72 +1010,70 @@ [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|] { matchHeaders = [matchContentTypeJson] } - when (actualPgVersion >= pgVersion96) $- it "should work with the phraseto_tsquery function" $- get "/rpc/get_tsearch?text_search_vector=phfts(english).impossible" `shouldRespondWith`- [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]- { matchHeaders = [matchContentTypeJson] }+ it "should work with the phraseto_tsquery function" $+ get "/rpc/get_tsearch?text_search_vector=phfts(english).impossible" `shouldRespondWith`+ [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]+ { matchHeaders = [matchContentTypeJson] } it "should work with an argument of custom type in public schema" $ get "/rpc/test_arg?my_arg=something" `shouldRespondWith` [json|"foobar"|] { matchHeaders = [matchContentTypeJson] } - when (actualPgVersion >= pgVersion96) $ do- context "GUC headers on function calls" $ do- it "succeeds setting the headers" $ do- get "/rpc/get_projects_and_guc_headers?id=eq.2&select=id"- `shouldRespondWith` [json|[{"id": 2}]|]- {matchHeaders = [- matchContentTypeJson,- "X-Test" <:> "key1=val1; someValue; key2=val2",- "X-Test-2" <:> "key1=val1"]}- get "/rpc/get_int_and_guc_headers?num=1"- `shouldRespondWith` [json|1|]- {matchHeaders = [- matchContentTypeJson,- "X-Test" <:> "key1=val1; someValue; key2=val2",- "X-Test-2" <:> "key1=val1"]}- post "/rpc/get_int_and_guc_headers" [json|{"num": 1}|]- `shouldRespondWith` [json|1|]- {matchHeaders = [- matchContentTypeJson,- "X-Test" <:> "key1=val1; someValue; key2=val2",- "X-Test-2" <:> "key1=val1"]}+ context "GUC headers on function calls" $ do+ it "succeeds setting the headers" $ do+ get "/rpc/get_projects_and_guc_headers?id=eq.2&select=id"+ `shouldRespondWith` [json|[{"id": 2}]|]+ {matchHeaders = [+ matchContentTypeJson,+ "X-Test" <:> "key1=val1; someValue; key2=val2",+ "X-Test-2" <:> "key1=val1"]}+ get "/rpc/get_int_and_guc_headers?num=1"+ `shouldRespondWith` [json|1|]+ {matchHeaders = [+ matchContentTypeJson,+ "X-Test" <:> "key1=val1; someValue; key2=val2",+ "X-Test-2" <:> "key1=val1"]}+ post "/rpc/get_int_and_guc_headers" [json|{"num": 1}|]+ `shouldRespondWith` [json|1|]+ {matchHeaders = [+ matchContentTypeJson,+ "X-Test" <:> "key1=val1; someValue; key2=val2",+ "X-Test-2" <:> "key1=val1"]} - it "fails when setting headers with wrong json structure" $ do- get "/rpc/bad_guc_headers_1"- `shouldRespondWith`- [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]- { matchStatus = 500- , matchHeaders = [ matchContentTypeJson ]- }- get "/rpc/bad_guc_headers_2"- `shouldRespondWith`- [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]- { matchStatus = 500- , matchHeaders = [ matchContentTypeJson ]- }- get "/rpc/bad_guc_headers_3"- `shouldRespondWith`- [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]- { matchStatus = 500- , matchHeaders = [ matchContentTypeJson ]- }- post "/rpc/bad_guc_headers_1" [json|{}|]- `shouldRespondWith`- [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]- { matchStatus = 500- , matchHeaders = [ matchContentTypeJson ]- }+ it "fails when setting headers with wrong json structure" $ do+ get "/rpc/bad_guc_headers_1"+ `shouldRespondWith`+ [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]+ { matchStatus = 500+ , matchHeaders = [ matchContentTypeJson ]+ }+ get "/rpc/bad_guc_headers_2"+ `shouldRespondWith`+ [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]+ { matchStatus = 500+ , matchHeaders = [ matchContentTypeJson ]+ }+ get "/rpc/bad_guc_headers_3"+ `shouldRespondWith`+ [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]+ { matchStatus = 500+ , matchHeaders = [ matchContentTypeJson ]+ }+ post "/rpc/bad_guc_headers_1" [json|{}|]+ `shouldRespondWith`+ [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]+ { matchStatus = 500+ , matchHeaders = [ matchContentTypeJson ]+ } - it "can set the same http header twice" $- get "/rpc/set_cookie_twice"- `shouldRespondWith`- "null"- { matchHeaders = [ matchContentTypeJson- , "Set-Cookie" <:> "sessionid=38afes7a8; HttpOnly; Path=/"- , "Set-Cookie" <:> "id=a3fWa; Expires=Wed, 21 Oct 2015 07:28:00 GMT; Secure; HttpOnly" ]}+ it "can set the same http header twice" $+ get "/rpc/set_cookie_twice"+ `shouldRespondWith`+ "null"+ { matchHeaders = [ matchContentTypeJson+ , "Set-Cookie" <:> "sessionid=38afes7a8; HttpOnly; Path=/"+ , "Set-Cookie" <:> "id=a3fWa; Expires=Wed, 21 Oct 2015 07:28:00 GMT; Secure; HttpOnly" ]} it "can override the Location header on a trigger" $ post "/stuff"@@ -1059,3 +1134,123 @@ { matchStatus = 500 , matchHeaders = [ matchContentTypeJson ] }++ context "single unnamed param" $ do+ it "can insert json directly" $+ post "/rpc/unnamed_json_param"+ [json|{"A": 1, "B": 2, "C": 3}|]+ `shouldRespondWith`+ [json|{"A": 1, "B": 2, "C": 3}|]++ it "can insert text directly" $+ request methodPost "/rpc/unnamed_text_param"+ [("Content-Type", "text/plain"), ("Accept", "text/plain")]+ [str|unnamed text arg|]+ `shouldRespondWith`+ [str|unnamed text arg|]++ it "can insert bytea directly" $ do+ let file = unsafePerformIO $ BL.readFile "test/C.png"+ r <- request methodPost "/rpc/unnamed_bytea_param"+ [("Content-Type", "application/octet-stream"), ("Accept", "application/octet-stream")]+ file+ liftIO $ do+ let respBody = simpleBody r+ respBody `shouldBe` file++ it "will err when no function with single unnamed json parameter exists and application/json is specified" $+ request methodPost "/rpc/unnamed_int_param" [("Content-Type", "application/json")]+ [json|{"x": 1, "y": 2}|]+ `shouldRespondWith`+ [json|{+ "hint": "If a new function was created in the database with this name and parameters, try reloading the schema cache.",+ "message": "Could not find the test.unnamed_int_param(x, y) function or the test.unnamed_int_param function with a single unnamed json or jsonb parameter in the schema cache"+ }|]+ { matchStatus = 404+ , matchHeaders = [ matchContentTypeJson ]+ }++ it "will err when no function with single unnamed text parameter exists and text/plain is specified" $+ request methodPost "/rpc/unnamed_int_param"+ [("Content-Type", "text/plain")]+ [str|a simple text|]+ `shouldRespondWith`+ [json|{+ "hint": "If a new function was created in the database with this name and parameters, try reloading the schema cache.",+ "message": "Could not find the test.unnamed_int_param function with a single unnamed text parameter in the schema cache"+ }|]+ { matchStatus = 404+ , matchHeaders = [ matchContentTypeJson ]+ }++ it "will err when no function with single unnamed bytea parameter exists and application/octet-stream is specified" $+ let file = unsafePerformIO $ BL.readFile "test/C.png" in+ request methodPost "/rpc/unnamed_int_param"+ [("Content-Type", "application/octet-stream")]+ file+ `shouldRespondWith`+ [json|{+ "hint": "If a new function was created in the database with this name and parameters, try reloading the schema cache.",+ "message": "Could not find the test.unnamed_int_param function with a single unnamed bytea parameter in the schema cache"+ }|]+ { matchStatus = 404+ , matchHeaders = [ matchContentTypeJson ]+ }++ it "should be able to resolve when a single unnamed json parameter exists and other overloaded functions are found" $ do+ request methodPost "/rpc/overloaded_unnamed_param" [("Content-Type", "application/json")]+ [json|{}|]+ `shouldRespondWith`+ [json| 1 |]+ { matchStatus = 200+ , matchHeaders = [matchContentTypeJson]+ }+ request methodPost "/rpc/overloaded_unnamed_param" [("Content-Type", "application/json")]+ [json|{"x": 1, "y": 2}|]+ `shouldRespondWith`+ [json| 3 |]+ { matchStatus = 200+ , matchHeaders = [matchContentTypeJson]+ }++ it "should be able to fallback to the single unnamed parameter function when other overloaded functions are not found" $ do+ request methodPost "/rpc/overloaded_unnamed_param"+ [("Content-Type", "application/json")]+ [json|{"A": 1, "B": 2, "C": 3}|]+ `shouldRespondWith`+ [json|{"A": 1, "B": 2, "C": 3}|]+ request methodPost "/rpc/overloaded_unnamed_param"+ [("Content-Type", "text/plain"), ("Accept", "text/plain")]+ [str|unnamed text arg|]+ `shouldRespondWith`+ [str|unnamed text arg|]+ let file = unsafePerformIO $ BL.readFile "test/C.png"+ r <- request methodPost "/rpc/overloaded_unnamed_param"+ [("Content-Type", "application/octet-stream"), ("Accept", "application/octet-stream")]+ file+ liftIO $ do+ let respBody = simpleBody r+ respBody `shouldBe` file++ it "should fail to fallback to any single unnamed parameter function when using an unsupported Content-Type header" $ do+ request methodPost "/rpc/overloaded_unnamed_param"+ [("Content-Type", "text/csv")]+ "a,b\n1,2\n4,6\n100,200"+ `shouldRespondWith`+ [json| {+ "hint":"If a new function was created in the database with this name and parameters, try reloading the schema cache.",+ "message":"Could not find the test.overloaded_unnamed_param(a, b) function in the schema cache"}|]+ { matchStatus = 404+ , matchHeaders = [matchContentTypeJson]+ }++ it "should fail with multiple choices when two fallback functions with single unnamed json and jsonb parameters exist" $ do+ request methodPost "/rpc/overloaded_unnamed_json_jsonb_param" [("Content-Type", "application/json")]+ [json|{"A": 1, "B": 2, "C": 3}|]+ `shouldRespondWith`+ [json| {+ "hint":"Try renaming the parameters or the function itself in the database so function overloading can be resolved",+ "message":"Could not choose the best candidate function between: test.overloaded_unnamed_json_jsonb_param( => json), test.overloaded_unnamed_json_jsonb_param( => jsonb)"}|]+ { matchStatus = 300+ , matchHeaders = [matchContentTypeJson]+ }
test/Feature/UpsertSpec.hs view
@@ -7,11 +7,13 @@ import Test.Hspec.Wai import Test.Hspec.Wai.JSON +import PostgREST.Config.PgVersion (PgVersion, pgVersion110)+ import Protolude hiding (get, put) import SpecHelper -spec :: SpecWith ((), Application)-spec =+spec :: PgVersion -> SpecWith ((), Application)+spec actualPgVersion = describe "UPSERT" $ do context "with POST" $ do context "when Prefer: resolution=merge-duplicates is specified" $ do@@ -43,6 +45,20 @@ , matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates", matchContentTypeJson] } + when (actualPgVersion >= pgVersion110) $+ it "INSERTs and UPDATEs rows on composite pk conflict for partitioned tables" $+ request methodPost "/car_models" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]+ [json| [+ { "name": "Murcielago", "year": 2001, "car_brand_name": null},+ { "name": "Roma", "year": 2021, "car_brand_name": "Ferrari" }+ ]|] `shouldRespondWith` [json| [+ { "name": "Murcielago", "year": 2001, "car_brand_name": null},+ { "name": "Roma", "year": 2021, "car_brand_name": "Ferrari" }+ ]|]+ { matchStatus = 201+ , matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates", matchContentTypeJson]+ }+ it "succeeds when the payload has no elements" $ request methodPost "/articles" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")] [json|[]|] `shouldRespondWith`@@ -99,6 +115,19 @@ , matchHeaders = ["Preference-Applied" <:> "resolution=ignore-duplicates", matchContentTypeJson] } + when (actualPgVersion >= pgVersion110) $+ it "INSERTs and ignores rows on composite pk conflict for partitioned tables" $+ request methodPost "/car_models" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]+ [json| [+ { "name": "Murcielago", "year": 2001, "car_brand_name": "Ferrari" },+ { "name": "Huracán", "year": 2021, "car_brand_name": "Lamborghini" }+ ]|] `shouldRespondWith` [json| [+ { "name": "Huracán", "year": 2021, "car_brand_name": "Lamborghini" }+ ]|]+ { matchStatus = 201+ , matchHeaders = ["Preference-Applied" <:> "resolution=ignore-duplicates", matchContentTypeJson]+ }+ it "INSERTs and ignores rows on single unique key conflict" $ request methodPost "/single_unique?on_conflict=unique_key" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]@@ -264,6 +293,19 @@ `shouldRespondWith` [json| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "$48,000.00", "company": "GEX", "occupation": "Railroad engineer" } ]|] + when (actualPgVersion >= pgVersion110) $+ it "succeeds on a partitioned table with composite pk" $ do+ -- assert that the next request will indeed be an insert+ get "/car_models?name=eq.Supra&year=eq.2021"+ `shouldRespondWith`+ [json|[]|]++ request methodPut "/car_models?name=eq.Supra&year=eq.2021"+ [("Prefer", "return=representation")]+ [json| [ { "name": "Supra", "year": 2021 } ]|]+ `shouldRespondWith`+ [json| [ { "name": "Supra", "year": 2021, "car_brand_name": null } ]|]+ it "succeeds if the table has only PK cols and no other cols" $ do -- assert that the next request will indeed be an insert get "/only_pk?id=eq.10"@@ -314,6 +356,19 @@ [json| [ { "first_name": "Frances M.", "last_name": "Roe", "salary": "60000", "company": "Gamma Gas", "occupation": "Railroad engineer" } ]|] `shouldRespondWith` [json| [ { "first_name": "Frances M.", "last_name": "Roe", "salary": "$60,000.00", "company": "Gamma Gas", "occupation": "Railroad engineer" } ]|]++ when (actualPgVersion >= pgVersion110) $+ it "succeeds on a partitioned table with composite pk" $ do+ -- assert that the next request will indeed be an update+ get "/car_models?name=eq.DeLorean&year=eq.1981"+ `shouldRespondWith`+ [json| [ { "name": "DeLorean", "year": 1981, "car_brand_name": "DMC" } ]|]++ request methodPut "/car_models?name=eq.DeLorean&year=eq.1981"+ [("Prefer", "return=representation")]+ [json| [ { "name": "DeLorean", "year": 1981, "car_brand_name": null } ]|]+ `shouldRespondWith`+ [json| [ { "name": "DeLorean", "year": 1981, "car_brand_name": null } ]|] it "succeeds if the table has only PK cols and no other cols" $ do -- assert that the next request will indeed be an update
test/Main.hs view
@@ -9,13 +9,12 @@ import Test.Hspec -import PostgREST.App (postgrest)-import PostgREST.Config (AppConfig (..), LogLevel (..))-import PostgREST.Config.Database (queryPgVersion)-import PostgREST.Config.PgVersion (pgVersion96)-import PostgREST.DbStructure (queryDbStructure)-import Protolude hiding (toList, toS)-import Protolude.Conv (toS)+import PostgREST.App (postgrest)+import PostgREST.Config (AppConfig (..), LogLevel (..))+import PostgREST.Config.Database (queryPgVersion)+import PostgREST.DbStructure (queryDbStructure)+import Protolude hiding (toList, toS)+import Protolude.Conv (toS) import SpecHelper import qualified PostgREST.AppState as AppState@@ -30,11 +29,13 @@ import qualified Feature.DeleteSpec import qualified Feature.DisabledOpenApiSpec import qualified Feature.EmbedDisambiguationSpec+import qualified Feature.EmbedInnerJoinSpec import qualified Feature.ExtraSearchPathSpec import qualified Feature.HtmlRawOutputSpec import qualified Feature.IgnorePrivOpenApiSpec import qualified Feature.InsertSpec import qualified Feature.JsonOperatorSpec+import qualified Feature.LegacyGucsSpec import qualified Feature.MultipleSchemaSpec import qualified Feature.NoJwtSpec import qualified Feature.NonexistentSchemaSpec@@ -67,6 +68,7 @@ loadDbStructure pool (configDbSchemas $ testCfg testDbConn) (configDbExtraSearchPath $ testCfg testDbConn)+ actualPgVersion let -- For tests that run with the same refDbStructure@@ -86,7 +88,9 @@ loadDbStructure pool (configDbSchemas config) (configDbExtraSearchPath config)+ actualPgVersion appState <- AppState.initWithPool pool config+ AppState.putPgVersion appState actualPgVersion AppState.putDbStructure appState customDbStructure when (isJust $ configDbRootSpec config) $ AppState.putJsonDbS appState $ toS $ JSON.encode baseDbStructure@@ -106,6 +110,7 @@ responseHeadersApp = app testCfgResponseHeaders disallowRollbackApp = app testCfgDisallowRollback forceRollbackApp = app testCfgForceRollback+ testCfgLegacyGucsApp = app testCfgLegacyGucs extraSearchPathApp = appDbs testCfgExtraSearchPath unicodeApp = appDbs testUnicodeCfg@@ -125,16 +130,17 @@ , ("Feature.CorsSpec" , Feature.CorsSpec.spec) , ("Feature.DeleteSpec" , Feature.DeleteSpec.spec) , ("Feature.EmbedDisambiguationSpec" , Feature.EmbedDisambiguationSpec.spec)+ , ("Feature.EmbedInnerJoinSpec" , Feature.EmbedInnerJoinSpec.spec) , ("Feature.InsertSpec" , Feature.InsertSpec.spec actualPgVersion) , ("Feature.JsonOperatorSpec" , Feature.JsonOperatorSpec.spec actualPgVersion)- , ("Feature.OpenApiSpec" , Feature.OpenApiSpec.spec)- , ("Feature.OptionsSpec" , Feature.OptionsSpec.spec)+ , ("Feature.OpenApiSpec" , Feature.OpenApiSpec.spec actualPgVersion)+ , ("Feature.OptionsSpec" , Feature.OptionsSpec.spec actualPgVersion) , ("Feature.QuerySpec" , Feature.QuerySpec.spec actualPgVersion) , ("Feature.RawOutputTypesSpec" , Feature.RawOutputTypesSpec.spec) , ("Feature.RpcSpec" , Feature.RpcSpec.spec actualPgVersion) , ("Feature.SingularSpec" , Feature.SingularSpec.spec) , ("Feature.UpdateSpec" , Feature.UpdateSpec.spec)- , ("Feature.UpsertSpec" , Feature.UpsertSpec.spec)+ , ("Feature.UpsertSpec" , Feature.UpsertSpec.spec actualPgVersion) ] hspec $ do@@ -196,17 +202,20 @@ parallel $ before extraSearchPathApp $ describe "Feature.ExtraSearchPathSpec" Feature.ExtraSearchPathSpec.spec - when (actualPgVersion >= pgVersion96) $ do- -- this test runs with a root spec function override- parallel $ before rootSpecApp $- describe "Feature.RootSpec" Feature.RootSpec.spec- parallel $ before responseHeadersApp $- describe "Feature.RpcPreRequestGucsSpec" Feature.RpcPreRequestGucsSpec.spec+ -- this test runs with a root spec function override+ parallel $ before rootSpecApp $+ describe "Feature.RootSpec" Feature.RootSpec.spec+ parallel $ before responseHeadersApp $+ describe "Feature.RpcPreRequestGucsSpec" Feature.RpcPreRequestGucsSpec.spec -- this test runs with multiple schemas parallel $ before multipleSchemaApp $- describe "Feature.MultipleSchemaSpec" $ Feature.MultipleSchemaSpec.spec actualPgVersion+ describe "Feature.MultipleSchemaSpec" Feature.MultipleSchemaSpec.spec + -- this test runs with db-uses-legacy-gucs = false+ parallel $ before testCfgLegacyGucsApp $+ describe "Feature.LegacyGucsSpec" Feature.LegacyGucsSpec.spec+ -- Note: the rollback tests can not run in parallel, because they test persistance and -- this results in race conditions @@ -223,5 +232,5 @@ describe "Feature.RollbackForcedSpec" Feature.RollbackSpec.forced where- loadDbStructure pool schemas extraSearchPath =- either (panic.show) id <$> P.use pool (HT.transaction HT.ReadCommitted HT.Read $ queryDbStructure (toList schemas) extraSearchPath True)+ loadDbStructure pool schemas extraSearchPath actualPgVersion =+ either (panic.show) id <$> P.use pool (HT.transaction HT.ReadCommitted HT.Read $ queryDbStructure (toList schemas) extraSearchPath actualPgVersion True)
test/QueryCost.hs view
@@ -15,11 +15,10 @@ import Protolude.Conv (toS) import PostgREST.Query.QueryBuilder (requestToCallProcQuery)-import PostgREST.Request.ApiRequest (PayloadJSON (..))+import PostgREST.Request.Types import PostgREST.DbStructure.Identifiers import PostgREST.DbStructure.Proc-import PostgREST.Request.Preferences import SpecHelper (getEnvVarWithDefault) @@ -34,29 +33,32 @@ context "call proc query" $ do it "should not exceed cost when calling setof composite proc" $ do cost <- exec pool $- requestToCallProcQuery (QualifiedIdentifier "test" "get_projects_below") [PgArg "id" "int" True False]- (Just $ RawJSON [str| {"id": 3} |]) False Nothing []+ requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below")+ (KeyParams [ProcParam "id" "int" True False])+ (Just [str| {"id": 3} |]) False False []) liftIO $ cost `shouldSatisfy` (< Just 40) it "should not exceed cost when calling setof composite proc with empty params" $ do cost <- exec pool $- requestToCallProcQuery (QualifiedIdentifier "test" "getallprojects") [] Nothing False Nothing []+ requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "getallprojects") (KeyParams []) Nothing False False []) liftIO $ cost `shouldSatisfy` (< Just 30) it "should not exceed cost when calling scalar proc" $ do cost <- exec pool $- requestToCallProcQuery (QualifiedIdentifier "test" "add_them") [PgArg "a" "int" True False, PgArg "b" "int" True False]- (Just $ RawJSON [str| {"a": 3, "b": 4} |]) True Nothing []+ requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "add_them")+ (KeyParams [ProcParam "a" "int" True False, ProcParam "b" "int" True False])+ (Just [str| {"a": 3, "b": 4} |]) True False []) liftIO $ cost `shouldSatisfy` (< Just 10) context "params=multiple-objects" $ do it "should not exceed cost when calling setof composite proc" $ do cost <- exec pool $- requestToCallProcQuery (QualifiedIdentifier "test" "get_projects_below") [PgArg "id" "int" True False]- (Just $ RawJSON [str| [{"id": 1}, {"id": 4}] |]) False (Just MultipleObjects) []+ requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below")+ (KeyParams [ProcParam "id" "int" True False])+ (Just [str| [{"id": 1}, {"id": 4}] |]) False True []) liftIO $ do -- lower bound needed for now to make sure that cost is not Nothing cost `shouldSatisfy` (> Just 2000)@@ -64,8 +66,9 @@ it "should not exceed cost when calling scalar proc" $ do cost <- exec pool $- requestToCallProcQuery (QualifiedIdentifier "test" "add_them") [PgArg "a" "int" True False, PgArg "b" "int" True False]- (Just $ RawJSON [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |]) True Nothing []+ requestToCallProcQuery (FunctionCall (QualifiedIdentifier "test" "add_them")+ (KeyParams [ProcParam "a" "int" True False, ProcParam "b" "int" True False])+ (Just [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |]) True False []) liftIO $ cost `shouldSatisfy` (< Just 10)
test/SpecHelper.hs view
@@ -89,6 +89,7 @@ , configDbSchemas = fromList ["test"] , configDbConfig = False , configDbUri = mempty+ , configDbUseLegacyGucs = True , configFilePath = Nothing , configJWKS = parseSecret <$> secret , configJwtAudience = Nothing@@ -184,6 +185,9 @@ testMultipleSchemaCfg :: Text -> AppConfig testMultipleSchemaCfg testDbConn = (testCfg testDbConn) { configDbSchemas = fromList ["v1", "v2"] }++testCfgLegacyGucs :: Text -> AppConfig+testCfgLegacyGucs testDbConn = (testCfg testDbConn) { configDbUseLegacyGucs = False } resetDb :: Text -> IO () resetDb dbConn = loadFixture dbConn "data"
+ test/doctests/Main.hs view
@@ -0,0 +1,17 @@+module Main (main) where++import Test.DocTest (doctest)++import Protolude+++main :: IO ()+main =+ doctest+ [ "--verbose"+ , "-XOverloadedStrings"+ , "-XNoImplicitPrelude"+ , "-XStandaloneDeriving"+ , "-isrc"+ , "src/PostgREST/Request/Preferences.hs"+ ]