diff --git a/CHANGELOG.md b/CHANGELOG.md index 71dc8ca9f..4c4ab1c19 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,7 +7,7 @@ This project adheres to [Semantic Versioning](http://semver.org/). ### Added - Allow test database to be on another host - @dsimunic -- New `Prefer` header value: `params=single-object` to pass all form values as a single json object to a stored procedure - @dsimunic +- `Prefer: params=single-object` to treat payload as single json argument in RPC - @dsimunic - Ability to generate an OpenAPI spec - @mainx07, @hudayou, @ruslantalpa, @begriffs - Ability to generate an OpenAPI spec behind a proxy - @hudayou - Ability to set addresses to listen on - @hudayou @@ -30,6 +30,9 @@ This project adheres to [Semantic Versioning](http://semver.org/). - Use specific columns in the RETURNING section - @ruslantalpa ### Changed +- Replace `Prefer: plurality=singular` with `Accept: application/vnd.pgrst.object` - @begriffs +- Standardize arrays in responses for `Prefer: return=representation` - @begriffs +- Calling unknown RPC gives 404, not 400 - @begriffs - Use HTTP 400 for raise\_exception - @begriffs - Remove non-OpenAPI schema description - @begriffs - Use comma rather than semicolon to separate Prefer header values - @begriffs diff --git a/postgrest.cabal b/postgrest.cabal index 2d0c937aa..2e68d77f8 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -60,7 +60,7 @@ library , either , hasql , hasql-pool == 0.4.1 - , hasql-transaction == 0.4.5.1 + , hasql-transaction == 0.5 , heredoc , HTTP , http-types @@ -120,6 +120,7 @@ Test-Suite spec , Feature.QueryLimitedSpec , Feature.QuerySpec , Feature.RangeSpec + , Feature.SingularSpec , Feature.StructureSpec , Feature.UnicodeSpec , SpecHelper @@ -133,6 +134,7 @@ Test-Suite spec , base64-bytestring , case-insensitive , cassava + , containers , contravariant , hasql , hasql-pool diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 26efe7f34..6992675bd 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -38,7 +38,7 @@ import Data.Ranged.Boundaries import PostgREST.Types (QualifiedIdentifier (..), Schema, PayloadJSON(..)) -import Data.Ranged.Ranges (Range(..), singletonRange, rangeIntersection, emptyRange) +import Data.Ranged.Ranges (Range(..), rangeIntersection, emptyRange) type RequestBody = BL.ByteString @@ -59,6 +59,7 @@ data PreferRepresentation = Full | HeadersOnly | None deriving Eq -- -- | Enumeration of currently supported response content types data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI + | CTSingularJSON | CTAny | CTOther BS.ByteString deriving Eq data ApiRequestError = ErrorActionInappropriate @@ -75,6 +76,7 @@ toMime :: ContentType -> ByteString toMime CTApplicationJSON = "application/json" toMime CTTextCSV = "text/csv" toMime CTOpenAPI = "application/openapi+json" +toMime CTSingularJSON = "application/vnd.pgrst.object+json" toMime CTAny = "*/*" toMime (CTOther ct) = ct @@ -98,8 +100,6 @@ data ApiRequest = ApiRequest { , iPayload :: Maybe PayloadJSON -- | If client wants created items echoed back , iPreferRepresentation :: PreferRepresentation - -- | If client wants first row as raw object - , iPreferSingular :: Bool -- | Pass all parameters as a single json object to a stored procedure , iPreferSingleObjectParameter :: Bool -- | Whether the client wants a result count (slower) @@ -130,9 +130,8 @@ userApiRequest schema req reqBody map decodeContentType . parseHttpAccept <$> lookupHeader "accept" , iPayload = relevantPayload , iPreferRepresentation = representation - , iPreferSingular = singular , iPreferSingleObjectParameter = singleObject - , iPreferCount = not singular && hasPrefer "count=exact" + , iPreferCount = hasPrefer "count=exact" , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset"] k) ] , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ] @@ -194,7 +193,6 @@ userApiRequest schema req reqBody where split :: BS.ByteString -> [Text] split = map T.strip . T.split (==',') . toS - singular = hasPrefer "plurality=singular" singleObject = hasPrefer "params=single-object" representation | hasPrefer "return=representation" = Full @@ -208,7 +206,7 @@ userApiRequest schema req reqBody endingIn xx key = lastWord `elem` xx where lastWord = last $ T.split (=='.') key - headerRange = if singular && method == "GET" then singletonRange 0 else rangeRequested hdrs + headerRange = rangeRequested hdrs replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) ++ [x] limitParams :: M.HashMap ByteString NonnegRange limitParams = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe =<< (toS <$> v)) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k] @@ -244,11 +242,13 @@ mutuallyAgreeable sProduces cAccepts = decodeContentType :: BS.ByteString -> ContentType decodeContentType ct = case BS.takeWhile (/= BS.c2w ';') ct of - "application/json" -> CTApplicationJSON - "text/csv" -> CTTextCSV - "application/openapi+json" -> CTOpenAPI - "*/*" -> CTAny - ct' -> CTOther ct' + "application/json" -> CTApplicationJSON + "text/csv" -> CTTextCSV + "application/openapi+json" -> CTOpenAPI + "application/vnd.pgrst.object+json" -> CTSingularJSON + "application/vnd.pgrst.object" -> CTSingularJSON + "*/*" -> CTAny + ct' -> CTOther ct' type CsvData = V.Vector (M.HashMap Text BL.ByteString) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index f0ceee70c..797624e48 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -11,19 +11,18 @@ import qualified Data.ByteString.Char8 as BS import Data.IORef (IORef, readIORef) import Data.List (delete, lookup) import Data.Maybe (fromJust) -import Data.Text (replace, strip, isInfixOf, dropWhile, drop, intercalate) +import Data.Text (isInfixOf, dropWhile, drop, intercalate) import Data.Time.Clock.POSIX (POSIXTime) import Data.Tree import Data.Either.Combinators (mapLeft) -import qualified Hasql.Pool as P -import qualified Hasql.Transaction as HT +import qualified Hasql.Pool as P +import qualified Hasql.Transaction as HT +import qualified Hasql.Transaction.Sessions as HT import Text.Parsec.Error import Text.ParserCombinators.Parsec (parse) -import qualified Text.InterpolatedString.Perl6 as P6 (q) - import Network.HTTP.Types.Header import Network.HTTP.Types.Status import Network.HTTP.Types.URI (renderSimpleQuery) @@ -31,8 +30,6 @@ import Network.Wai import Network.Wai.Middleware.RequestLogger (logStdout) import Web.JWT (binarySecret) -import Data.Aeson -import Data.Aeson.Types (emptyArray) import qualified Data.Vector as V import qualified Hasql.Transaction as H @@ -49,7 +46,7 @@ import PostgREST.ApiRequest ( ApiRequest(..), ContentType(..) import PostgREST.Auth (jwtClaims, containsRole) import PostgREST.Config (AppConfig (..)) import PostgREST.DbStructure -import PostgREST.Error (errResponse, pgErrResponse, apiRequestErrResponse) +import PostgREST.Error (errResponse, pgErrResponse, apiRequestErrResponse, singularityError, formatParserError) import PostgREST.Parsers import PostgREST.RangeQuery (NonnegRange, allRange, rangeOffset, restrictRange) import PostgREST.Middleware @@ -89,7 +86,7 @@ postgrest conf refDbStructure pool getTime = authed = containsRole eClaims handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest txMode = transactionMode $ iAction apiRequest - response <- P.use pool $ HT.run handleReq HT.ReadCommitted txMode + response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq return $ either (pgErrResponse authed) identity response respond response @@ -109,96 +106,102 @@ app dbStructure conf apiRequest = case readSqlParts of Left errorResponse -> return errorResponse Right (q, cq) -> do - let singular = iPreferSingular apiRequest - stm = createReadStatement q cq singular shouldCount (contentType == CTTextCSV) + let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount (contentType == CTTextCSV) row <- H.query () stm let (tableTotal, queryTotal, _ , body) = row - if singular - then return $ if queryTotal <= 0 - then notFound - else responseLBS status200 [toHeader contentType] (toS body) - else do - let (status, contentRange) = rangeHeader queryTotal tableTotal - canonical = iCanonicalQS apiRequest - --TargetIdent qi = iTarget apiRequest - return $ responseLBS status - [toHeader contentType, contentRange, - ("Content-Location", - "/" <> toS (qiName qi) <> - if BS.null canonical then "" else "?" <> toS canonical - ) - ] (toS body) + (status, contentRange) = rangeHeader queryTotal tableTotal + canonical = iCanonicalQS apiRequest + return $ + if contentType == CTSingularJSON && queryTotal /= 1 + then singularityError (toInteger queryTotal) + else responseLBS status + [toHeader contentType, contentRange, + ("Content-Location", + "/" <> toS (qiName qi) <> + if BS.null canonical then "" else "?" <> toS canonical + ) + ] (toS body) - (ActionCreate, TargetIdent qi@(QualifiedIdentifier _ table), Just payload@(PayloadJSON rows)) -> + (ActionCreate, TargetIdent (QualifiedIdentifier _ table), Just payload@(PayloadJSON rows)) -> case mutateSqlParts of Left errorResponse -> return errorResponse Right (sq, mq) -> do let isSingle = (==1) $ V.length rows - when (not isSingle && iPreferSingular apiRequest) $ - HT.sql [P6.q| DO $$ - BEGIN RAISE EXCEPTION cardinality_violation - USING MESSAGE = - 'plurality=singular specified, but more than one object would be inserted'; - END $$; - |] - let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself? - let stm = createWriteStatement qi sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == CTTextCSV) payload - row <- H.query payload stm - let (_, _, fs, body) = extractQueryResult row - headers = catMaybes [ - if null fs - then Nothing - else Just (hLocation, "/" <> toS table <> renderLocationFields fs) - , if iPreferRepresentation apiRequest == Full - then Just $ toHeader contentType - else Nothing - , Just . contentRangeH 1 0 $ - toInteger <$> if shouldCount then Just (V.length rows) else Nothing - ] + if contentType == CTSingularJSON + && not isSingle + && iPreferRepresentation apiRequest == Full + then return $ singularityError (toInteger $ V.length rows) + else do + let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself? + stm = createWriteStatement sq mq + (contentType == CTSingularJSON) isSingle + (contentType == CTTextCSV) (iPreferRepresentation apiRequest) + pKeys + row <- H.query payload stm + let (_, _, fs, body) = extractQueryResult row + headers = catMaybes [ + if null fs + then Nothing + else Just (hLocation, "/" <> toS table <> renderLocationFields fs) + , if iPreferRepresentation apiRequest == Full + then Just $ toHeader contentType + else Nothing + , Just . contentRangeH 1 0 $ + toInteger <$> if shouldCount then Just (V.length rows) else Nothing + ] - return . responseLBS status201 headers $ - if iPreferRepresentation apiRequest == Full - then toS body else "" + return . responseLBS status201 headers $ + if iPreferRepresentation apiRequest == Full + then toS body else "" - (ActionUpdate, TargetIdent qi, Just payload) -> + (ActionUpdate, TargetIdent _, Just payload) -> case mutateSqlParts of Left errorResponse -> return errorResponse Right (sq, mq) -> do - let singular = iPreferSingular apiRequest - stm = createWriteStatement qi sq mq singular (iPreferRepresentation apiRequest) [] (contentType == CTTextCSV) payload + let stm = createWriteStatement sq mq + (contentType == CTSingularJSON) False (contentType == CTTextCSV) + (iPreferRepresentation apiRequest) [] row <- H.query payload stm let (_, queryTotal, _, body) = extractQueryResult row - when (singular && queryTotal > 1) $ - HT.sql [P6.q| DO $$ - BEGIN RAISE EXCEPTION cardinality_violation - USING MESSAGE = - 'plurality=singular specified, but more than one object would be updated'; - END $$; - |] - let r = contentRangeH 0 (toInteger $ queryTotal-1) - (toInteger <$> if shouldCount then Just queryTotal else Nothing) - s = case () of _ | queryTotal == 0 -> status404 - | iPreferRepresentation apiRequest == Full -> status200 - | otherwise -> status204 - return $ if iPreferRepresentation apiRequest == Full - then responseLBS s [toHeader contentType, r] (toS body) - else responseLBS s [r] "" + if contentType == CTSingularJSON + && queryTotal /= 1 + && iPreferRepresentation apiRequest == Full + then do + HT.condemn + return $ singularityError (toInteger queryTotal) + else do + let r = contentRangeH 0 (toInteger $ queryTotal-1) + (toInteger <$> if shouldCount then Just queryTotal else Nothing) + s = if iPreferRepresentation apiRequest == Full + then status200 + else status204 + return $ if iPreferRepresentation apiRequest == Full + then responseLBS s [toHeader contentType, r] (toS body) + else responseLBS s [r] "" - (ActionDelete, TargetIdent qi, Nothing) -> + (ActionDelete, TargetIdent _, Nothing) -> case mutateSqlParts of Left errorResponse -> return errorResponse Right (sq, mq) -> do let emptyPayload = PayloadJSON V.empty - stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == CTTextCSV) emptyPayload + stm = createWriteStatement sq mq + (contentType == CTSingularJSON) False + (contentType == CTTextCSV) + (iPreferRepresentation apiRequest) [] row <- H.query emptyPayload stm let (_, queryTotal, _, body) = extractQueryResult row r = contentRangeH 1 0 $ toInteger <$> if shouldCount then Just queryTotal else Nothing - return $ if queryTotal == 0 - then notFound - else if iPreferRepresentation apiRequest == Full - then responseLBS status200 [toHeader contentType, r] (toS body) - else responseLBS status204 [r] "" + if contentType == CTSingularJSON + && queryTotal /= 1 + && iPreferRepresentation apiRequest == Full + then do + HT.condemn + return $ singularityError (toInteger queryTotal) + else + return $ if iPreferRepresentation apiRequest == Full + then responseLBS status200 [toHeader contentType, r] (toS body) + else responseLBS status204 [r] "" (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) -> let mTable = find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure) in @@ -213,13 +216,17 @@ app dbStructure conf apiRequest = Left errorResponse -> return errorResponse Right (q, cq) -> do let p = V.head payload - singular = iPreferSingular apiRequest + singular = contentType == CTSingularJSON paramsAsSingleObject = iPreferSingleObjectParameter apiRequest row <- H.query () (callProc qi p q cq topLevelRange shouldCount singular paramsAsSingleObject) let (tableTotal, queryTotal, body) = - fromMaybe (Just 0, 0, emptyArray) row + fromMaybe (Just 0, 0, "[]") row (status, contentRange) = rangeHeader queryTotal tableTotal - return $ responseLBS status [jsonH, contentRange] (toS . encode $ body) + if singular && queryTotal /= 1 + then do + HT.condemn + return $ singularityError (toInteger queryTotal) + else return $ responseLBS status [jsonH, contentRange] (toS body) (ActionInspect, TargetRoot, Nothing) -> do let host = configHost conf @@ -275,13 +282,13 @@ responseContentTypeOrError accepts action = serves contentTypesForRequest accept where contentTypesForRequest = case action of - ActionRead -> [CTApplicationJSON, CTTextCSV] - ActionCreate -> [CTApplicationJSON, CTTextCSV] - ActionUpdate -> [CTApplicationJSON, CTTextCSV] - ActionDelete -> [CTApplicationJSON, CTTextCSV] - ActionInvoke -> [CTApplicationJSON] + ActionRead -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] + ActionCreate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] + ActionUpdate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] + ActionDelete -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] + ActionInvoke -> [CTApplicationJSON, CTSingularJSON] ActionInspect -> [CTOpenAPI] - ActionInfo -> [CTTextCSV] + ActionInfo -> [CTTextCSV] serves sProduces cAccepts = case mutuallyAgreeable sProduces cAccepts of Nothing -> do @@ -318,23 +325,12 @@ contentRangeH lower upper total = totalNotZero = fromMaybe True ((/=) 0 <$> total) fromInRange = lower <= upper -formatParserError :: ParseError -> Text -formatParserError e = formatGeneralError message details - where - message = show $ errorPos e - details = strip $ replace "\n" " " $ toS - $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e) - -formatGeneralError :: Text -> Text -> Text -formatGeneralError message details = message <> ", " <> details - augumentRequestWithJoin :: Schema -> [Relation] -> ReadRequest -> Either Text ReadRequest augumentRequestWithJoin schema allRels request = (first formatRelationError . addRelations schema allRels Nothing) request >>= addJoinConditions schema where - formatRelationError = formatGeneralError - "could not find foreign keys between these entities" + formatRelationError = ("could not find foreign keys between these entities, " <>) addFiltersOrdersRanges :: ApiRequest -> Either ParseError (ReadRequest -> ReadRequest) addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [ diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index f48b031ce..3284ac57c 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -2,16 +2,18 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} -module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError) where +module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError, singularityError, formatGeneralError, formatParserError) where import Protolude import Data.Aeson ((.=)) import qualified Data.Aeson as JSON +import Data.Text (replace, strip, unwords) import qualified Hasql.Pool as P import qualified Hasql.Session as H import qualified Network.HTTP.Types.Status as HT import Network.Wai (Response, responseLBS) -import PostgREST.ApiRequest (toHeader, ContentType(..), ApiRequestError(..)) +import PostgREST.ApiRequest (toHeader, toMime, ContentType(..), ApiRequestError(..)) +import Text.Parsec.Error apiRequestErrResponse :: ApiRequestError -> Response apiRequestErrResponse err = @@ -41,6 +43,28 @@ prettyUsageError (P.ConnectionError e) = "Database connection error:\n" <> toS (fromMaybe "" e) prettyUsageError e = show $ JSON.encode e +singularityError :: Integer -> Response +singularityError numRows = + responseLBS HT.status406 + [toHeader CTSingularJSON] + $ toS . formatGeneralError + "JSON object requested, multiple (or no) rows returned" + $ unwords + [ "Results contain", show numRows, "rows," + , toS (toMime CTSingularJSON), "requires 1 row" + ] + +formatParserError :: ParseError -> Text +formatParserError e = formatGeneralError message details + where + message = show $ errorPos e + details = strip $ replace "\n" " " $ toS + $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e) + +formatGeneralError :: Text -> Text -> Text +formatGeneralError message details = toS . JSON.encode $ + JSON.object ["message" .= message, "details" .= details] + instance JSON.ToJSON P.UsageError where toJSON (P.ConnectionError e) = JSON.object [ "code" .= ("" :: Text), @@ -103,6 +127,7 @@ httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) = "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 _ -> HT.status400 diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs index 0503e5041..4cd0974e4 100644 --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -155,7 +155,7 @@ makeGetParams :: [Column] -> [Param] makeGetParams [] = makeRangeParams ++ [ makeSelectParam - , makePreferParam ["plurality=singular", "count=none"] + , makePreferParam ["count=none"] ] makeGetParams cs = makeRangeParams ++ @@ -168,12 +168,12 @@ makeGetParams cs = & in_ .~ ParamQuery & type_ .~ SwaggerString & enum_ .~ decode (encode $ makeOrderItems cs)) - , makePreferParam ["plurality=singular", "count=none"] + , makePreferParam ["count=none"] ] makePostParams :: Text -> [Param] makePostParams tn = - [ makePreferParam ["return=representation", "return=representation,plurality=singular", + [ makePreferParam ["return=representation", "return=minimal", "return=none"] , (mempty :: Param) & name .~ "body" @@ -200,17 +200,17 @@ makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t) where tOp = (mempty :: Operation) & tags .~ Set.fromList [tn] - & produces ?~ makeMimeList [CTApplicationJSON, CTTextCSV] + & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV] & at 200 ?~ "OK" getOp = tOp & parameters .~ map Inline (makeGetParams cs ++ rs) & at 206 ?~ "Partial Content" postOp = tOp - & consumes ?~ makeMimeList [CTApplicationJSON, CTTextCSV] + & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV] & parameters .~ map Inline (makePostParams tn) & at 201 ?~ "Created" patchOp = tOp - & consumes ?~ makeMimeList [CTApplicationJSON, CTTextCSV] + & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV] & parameters .~ map Inline (makePostParams tn ++ rs) & at 204 ?~ "No Content" deletOp = tOp @@ -228,7 +228,7 @@ makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe) postOp = (mempty :: Operation) & parameters .~ map Inline (makeProcParam $ "(rpc) " <> pdName pd) & tags .~ Set.fromList ["(rpc) " <> pdName pd] - & produces ?~ makeMimeList [CTApplicationJSON] + & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON] & at 200 ?~ "OK" pe = (mempty :: PathItem) & post ?~ postOp diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index 8ce0eafa9..1a78bc5c7 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -111,49 +111,40 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv = | isSingle = asJsonSingleF | otherwise = asJsonF -createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool -> - PreferRepresentation -> [Text] -> Bool -> PayloadJSON -> +createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> + PreferRepresentation -> [Text] -> H.Query PayloadJSON (Maybe ResultsWithCount) -createWriteStatement _ _ mutateQuery _ None - _ _ (PayloadJSON _) = +createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys = unicodeStatement sql encodeUniformObjs decodeStandardMay True + where - sql = [qc| + sql = case rep of + None -> [qc| WITH {sourceCTEName} AS ({mutateQuery}) SELECT '', 0, {noLocationF}, '' |] - -createWriteStatement _ _ mutateQuery isSingle HeadersOnly - pKeys _ (PayloadJSON _) = - unicodeStatement sql encodeUniformObjs decodeStandardMay True - where - sql = [qc| + HeadersOnly -> [qc| WITH {sourceCTEName} AS ({mutateQuery}) SELECT {cols} FROM (SELECT 1 FROM {sourceCTEName}) _postgrest_t |] - cols = intercalate ", " [ - "'' AS total_result_set", - "pg_catalog.count(_postgrest_t) AS page_total", - if isSingle then locationF pKeys else noLocationF, - "''" - ] - -createWriteStatement _ selectQuery mutateQuery isSingle Full - pKeys asCsv (PayloadJSON _) = - unicodeStatement sql encodeUniformObjs decodeStandardMay True - where - sql = [qc| + Full -> [qc| WITH {sourceCTEName} AS ({mutateQuery}) SELECT {cols} FROM ({selectQuery}) _postgrest_t |] + cols = intercalate ", " [ "'' AS total_result_set", -- when updateing it does not make sense "pg_catalog.count(_postgrest_t) AS page_total", - if isSingle then locationF pKeys else noLocationF <> " AS header", - bodyF <> " AS body" + if wantHdrs + then locationF pKeys + else noLocationF <> " AS header", + if rep == Full + then bodyF <> " AS body" + else "''" ] + bodyF | asCsv = asCsvF - | isSingle = asJsonSingleF + | wantSingle = asJsonSingleF | otherwise = asJsonF addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest @@ -237,7 +228,7 @@ addJoinConditions schema (Node nn@(query, (n, r, a)) forest) = updatedForest = mapM (addJoinConditions schema) forest addCond query' con = query'{flt_=con ++ flt_ query'} -type ProcResults = (Maybe Int64, Int64, JSON.Value) +type ProcResults = (Maybe Int64, Int64, ByteString) callProc :: QualifiedIdentifier -> JSON.Object -> SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool -> H.Query () (Maybe ProcResults) callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson = unicodeStatement sql HE.unit decodeProc True @@ -269,7 +260,7 @@ callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson = else "null::bigint" :: Text decodeProc = HD.maybeRow procRow procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8 - <*> HD.value HD.json + <*> HD.value HD.bytea bodyF | isSingle = asJsonSingleF | otherwise = asJsonF @@ -389,9 +380,10 @@ requestToQuery schema _ returningSql (DbMutate (Insert mainTbl (PayloadJSON rows insInto = unwords [ "INSERT INTO" , fromQi qi, if T.null colsString then "" else "(" <> colsString <> ")" ] - vals = unwords $ if T.null colsString - then ["DEFAULT VALUES"] - else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"] + vals = unwords $ + if T.null colsString + then if V.null rows then ["SELECT null WHERE false"] else ["DEFAULT VALUES"] + else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"] requestToQuery schema _ returningSql (DbMutate (Update mainTbl (PayloadJSON rows) conditions)) = case rows V.!? 0 of Just obj -> diff --git a/stack.yaml b/stack.yaml index ef12341ec..6424103c5 100644 --- a/stack.yaml +++ b/stack.yaml @@ -2,7 +2,7 @@ resolver: lts-7.4 extra-deps: - Ranged-sets-0.3.0 - hasql-pool-0.4.1 - - hasql-transaction-0.4.5.1 + - hasql-transaction-0.5 ghc-options: postgrest: -O2 -Werror -Wall -fwarn-identities nix: diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs index 6281a5866..008de11b7 100644 --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -15,7 +15,7 @@ import Protolude hiding (get) spec :: SpecWith Application spec = describe "authorization" $ do - let single = ("Prefer","plurality=singular") + let single = ("Accept","application/vnd.pgrst.object+json") it "denies access to tables that anonymous does not own" $ get "/authors_only" `shouldRespondWith` ResponseMatcher { @@ -61,10 +61,7 @@ spec = describe "authorization" $ do it "sql functions can read custom and standard claims variables" $ do let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6OTk5OTk5OTk5OSwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWF0IjoxMzAwODE5MzgwLCJhdWQiOiJldmVyeW9uZSJ9.AQmCA7CMScvfaDRMqRPeUY6eNf--69gpW-kxaWfq9X0" request methodPost "/rpc/reveal_big_jwt" [auth] "{}" - `shouldRespondWith` [json| [ - {"sub":"fun", "jti":"foo", "nbf":1300819380, "exp":9999999999, - "http://postgrest.com/foo":true, "iss":"joe", "iat":1300819380, - "aud":"everyone"}] |] + `shouldRespondWith` [str|[{"iss":"joe","sub":"fun","aud":"everyone","exp":9999999999,"nbf":1300819380,"iat":1300819380,"jti":"foo","http://postgrest.com/foo":true}]|] it "allows users with permissions to see their tables" $ do let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" diff --git a/test/Feature/DeleteSpec.hs b/test/Feature/DeleteSpec.hs index 685f5b09b..7b618a4f8 100644 --- a/test/Feature/DeleteSpec.hs +++ b/test/Feature/DeleteSpec.hs @@ -52,9 +52,15 @@ spec = , matchHeaders = ["Content-Range" <:> "0-0/*"] } - context "known route, unknown record" $ - it "fails with 404" $ - request methodDelete "/items?id=eq.101" [] "" `shouldRespondWith` 404 + context "known route, no records matched" $ + it "includes [] body if return=rep" $ + request methodDelete "/items?id=eq.101" + [("Prefer", "return=representation")] "" + `shouldRespondWith` ResponseMatcher { + matchBody = Just "[]" + , matchStatus = 200 + , matchHeaders = ["Content-Range" <:> "*/*"] + } context "totally unknown route" $ it "fails with 404" $ diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index 0ffa787ba..b0be2a141 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -39,12 +39,12 @@ spec = do it "filters columns in result using &select" $ request methodPost "/menagerie?select=integer,varchar" [("Prefer", "return=representation")] - [json| { + [json| [{ "integer": 14, "double": 3.14159, "varchar": "testing!" , "boolean": false, "date": "1900-01-01", "money": "$3.99" , "enum": "foo" - } |] `shouldRespondWith` ResponseMatcher { - matchBody = Just [str|{"integer":14,"varchar":"testing!"}|] + }] |] `shouldRespondWith` ResponseMatcher { + matchBody = Just [str|[{"integer":14,"varchar":"testing!"}]|] , matchStatus = 201 , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"] } @@ -53,7 +53,7 @@ spec = do request methodPost "/projects?select=id,name,clients{id,name}" [("Prefer", "return=representation"), ("Prefer", "count=exact")] [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher { - matchBody = Just [str|{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}|] + matchBody = Just [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|] , matchStatus = 201 , matchHeaders = [ "Content-Type" <:> "application/json; charset=utf-8" , "Location" <:> "/projects?id=eq.6" @@ -86,9 +86,11 @@ spec = do incNullableStr record `shouldBe` Nothing context "into a table with simple pk" $ - it "fails with 400 and error" $ - post "/simple_pk" [json| { "extra":"foo"} |] - `shouldRespondWith` 400 + it "fails with 400 and error" $ do + p <- post "/simple_pk" [json| { "extra":"foo"} |] + liftIO $ do + simpleStatus p `shouldBe` badRequest400 + isErrorFormat (simpleBody p) `shouldBe` True context "into a table with no pk" $ do it "succeeds with 201 and a link including all fields" $ do @@ -103,10 +105,18 @@ spec = do [("Prefer", "return=representation")] [json| { "a":"bar", "b":"baz" } |] liftIO $ do - simpleBody p `shouldBe` [json| { "a":"bar", "b":"baz" } |] + simpleBody p `shouldBe` [json| [{ "a":"bar", "b":"baz" }] |] simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.bar&b=eq.baz" simpleStatus p `shouldBe` created201 + it "returns empty array when no items inserted, and return=rep" $ do + p <- request methodPost "/no_pk" + [("Prefer", "return=representation")] + [json| [] |] + liftIO $ do + simpleBody p `shouldBe` [json| [] |] + simpleStatus p `shouldBe` created201 + it "can insert in tables with no select privileges" $ do p <- request methodPost "/insertonly" [("Prefer", "return=minimal")] @@ -121,7 +131,7 @@ spec = do [("Prefer", "return=representation")] [json| { "a":null, "b":"foo" } |] liftIO $ do - simpleBody p `shouldBe` [json| { "a":null, "b":"foo" } |] + simpleBody p `shouldBe` [json| [{ "a":null, "b":"foo" }] |] simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=is.null&b=eq.foo" simpleStatus p `shouldBe` created201 @@ -134,7 +144,7 @@ spec = do [("Prefer", "return=representation")] inserted liftIO $ do - JSON.decode (simpleBody p) `shouldBe` Just expectedObj + JSON.decode (simpleBody p) `shouldBe` Just [expectedObj] simpleStatus p `shouldBe` created201 lookup hLocation (simpleHeaders p) `shouldBe` Just expectedLoc @@ -154,8 +164,11 @@ spec = do lookup hLocation (simpleHeaders p) `shouldBe` Nothing context "with invalid json payload" $ - it "fails with 400 and error" $ - post "/simple_pk" "}{ x = 2" `shouldRespondWith` 400 + it "fails with 400 and error" $ do + p <- post "/simple_pk" "}{ x = 2" + liftIO $ do + simpleStatus p `shouldBe` badRequest400 + isErrorFormat (simpleBody p) `shouldBe` True context "with valid json payload" $ it "succeeds and returns 201 created" $ @@ -177,7 +190,7 @@ spec = do [("Prefer", "return=representation")] inserted `shouldRespondWith` ResponseMatcher { - matchBody = Just inserted + matchBody = Just [str|[{"data":{"foo":"bar"}}]|] , matchStatus = 201 , matchHeaders = ["Location" <:> location] } @@ -189,7 +202,7 @@ spec = do [("Prefer", "return=representation")] inserted `shouldRespondWith` ResponseMatcher { - matchBody = Just inserted + matchBody = Just [str|[{"data":[1,2,3]}]|] , matchStatus = 201 , matchHeaders = ["Location" <:> location] } @@ -205,7 +218,7 @@ spec = do it "succeeds if correct select is applied" $ request methodPost "/limited_article_stars?select=article_id,user_id" [("Prefer", "return=representation")] [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` ResponseMatcher { - matchBody = Just [str|{"article_id":2,"user_id":1}|] + matchBody = Just [str|[{"article_id":2,"user_id":1}]|] , matchStatus = 201 , matchHeaders = [] } @@ -264,11 +277,12 @@ spec = do "Location" <:> "/no_pk?a=is.null&b=eq.foo"] } - context "with wrong number of columns" $ it "fails for too few" $ do p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz" - liftIO $ simpleStatus p `shouldBe` badRequest400 + liftIO $ do + simpleStatus p `shouldBe` badRequest400 + isErrorFormat (simpleBody p) `shouldBe` True context "with unicode values" $ it "succeeds and returns usable location header" $ do @@ -277,7 +291,7 @@ spec = do [("Prefer", "return=representation")] payload liftIO $ do - simpleBody p `shouldBe` payload + simpleBody p `shouldBe` "["<>payload<>"]" simpleStatus p `shouldBe` created201 let Just location = lookup hLocation $ simpleHeaders p @@ -297,7 +311,11 @@ spec = do it "indicates no records found to update" $ request methodPatch "/empty_table" [] [json| { "extra":20 } |] - `shouldRespondWith` 404 + `shouldRespondWith` ResponseMatcher { + matchBody = Just "", + matchStatus = 204, + matchHeaders = ["Content-Range" <:> "*/*"] + } context "in a nonempty table" $ do it "can update a single item" $ do @@ -310,12 +328,32 @@ spec = do matchStatus = 204, matchHeaders = ["Content-Range" <:> "0-0/*"] } - liftIO $ - lookup hContentType (simpleHeaders p) `shouldBe` Nothing + liftIO $ lookup hContentType (simpleHeaders p) `shouldBe` Nothing + -- check it really got updated g' <- get "/items?id=eq.42" liftIO $ simpleHeaders g' `shouldSatisfy` matchHeader "Content-Range" "0-0/\\*" + -- put value back for other tests + void $ request methodPatch "/items?id=eq.42" [] [json| { "id":2 } |] + + it "returns empty array when no rows updated and return=rep" $ + request methodPatch "/items?id=eq.999999" + [("Prefer", "return=representation")] [json| { "id":999999 } |] + `shouldRespondWith` ResponseMatcher { + matchBody = Just "[]", + matchStatus = 200, + matchHeaders = ["Content-Range" <:> "*/*"] + } + + it "returns updated object as array when return=rep" $ + request methodPatch "/items?id=eq.2" + [("Prefer", "return=representation")] [json| { "id":2 } |] + `shouldRespondWith` ResponseMatcher { + matchBody = Just [str|[{"id":2}]|], + matchStatus = 200, + matchHeaders = ["Content-Range" <:> "0-0/*"] + } it "can update multiple items" $ do replicateM_ 10 $ post "/auto_incrementing_pk" @@ -335,50 +373,6 @@ spec = do get "/no_pk?a=eq.keepme" `shouldRespondWith` [json| [{ a: "keepme", b: null }] |] - it "can update based on a computed column" $ - request methodPatch - "/items?always_true=eq.false" - [("Prefer", "return=representation")] - [json| { id: 100 } |] - `shouldRespondWith` 404 - it "can provide a representation" $ do - _ <- post "/items" - [json| { id: 1 } |] - request methodPatch - "/items?id=eq.1" - [("Prefer", "return=representation")] - [json| { id: 99 } |] - `shouldRespondWith` [json| [{id:99}] |] - - context "in a table" $ do - it "can provide a singular representation when updating one entity" $ do - _ <- post "/addresses" [json| { id: 97, address: "A Street" } |] - p <- request methodPatch - "/addresses?id=eq.97" - [("Prefer", "return=representation,plurality=singular")] - [json| { address: "B Street" } |] - liftIO $ simpleBody p `shouldBe` [str|{"id":97,"address":"B Street"}|] - it "raises an error when attempting to update multiple entities with plurality=singular" $ do - _ <- post "/addresses" [json| { id: 98, address: "xxx" } |] - _ <- post "/addresses" [json| { id: 99, address: "yyy" } |] - p <- request methodPatch - "/addresses?id=gt.0" - [("Prefer", "return=representation,plurality=singular")] - [json| { address: "zzz" } |] - liftIO $ simpleStatus p `shouldBe` status400 - it "can provide a singular representation when creating one entity" $ do - p <- request methodPost - "/addresses" - [("Prefer", "return=representation,plurality=singular")] - [json| [ { id: 100, address: "xxx" } ] |] - liftIO $ simpleBody p `shouldBe` [str|{"id":100,"address":"xxx"}|] - it "raises an error when attempting to create multiple entities with plurality=singular" $ do - p <- request methodPost - "/addresses" - [("Prefer", "return=representation,plurality=singular")] - [json| [ { id: 100, address: "xxx" }, { id: 101, address: "xxx" } ] |] - liftIO $ simpleStatus p `shouldBe` status400 - it "can set a json column to escaped value" $ do _ <- post "/json" [json| { data: {"escaped":"bar"} } |] request methodPatch "/json?data->>escaped=eq.bar" @@ -390,6 +384,26 @@ spec = do , matchHeaders = [] } + it "can update based on a computed column" $ + request methodPatch + "/items?always_true=eq.false" + [("Prefer", "return=representation")] + [json| { id: 100 } |] + `shouldRespondWith` ResponseMatcher { + matchBody = Just "[]", + matchStatus = 200, + matchHeaders = ["Content-Range" <:> "*/*"] + } + + it "can provide a representation" $ do + _ <- post "/items" + [json| { id: 1 } |] + request methodPatch + "/items?id=eq.1" + [("Prefer", "return=representation")] + [json| { id: 99 } |] + `shouldRespondWith` [json| [{id:99}] |] + context "with unicode values" $ it "succeeds and returns values intact" $ do void $ request methodPost "/no_pk" [] @@ -411,13 +425,13 @@ spec = do [ auth, ("Prefer", "return=representation") ] [json| { "secret": "nyancat" } |] liftIO $ do - simpleBody p1 `shouldBe` [str|{"owner":"jdoe","secret":"nyancat"}|] - simpleStatus p1 `shouldBe` created201 + simpleBody p1 `shouldBe` [str|[{"owner":"jdoe","secret":"nyancat"}]|] + simpleStatus p1 `shouldBe` created201 p2 <- request methodPost "/authors_only" -- jwt token for jroe [ authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqcm9lIn0.YuF_VfmyIxWyuceT7crnNKEprIYXsJAyXid3rjPjIow", ("Prefer", "return=representation") ] [json| { "secret": "lolcat", "owner": "hacker" } |] liftIO $ do - simpleBody p2 `shouldBe` [str|{"owner":"jroe","secret":"lolcat"}|] - simpleStatus p2 `shouldBe` created201 + simpleBody p2 `shouldBe` [str|[{"owner":"jroe","secret":"lolcat"}]|] + simpleStatus p2 `shouldBe` created201 diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 9bb9c3dc5..af22b6011 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -4,7 +4,7 @@ import Test.Hspec hiding (pendingWith) import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Network.HTTP.Types -import Network.Wai.Test (SResponse(simpleHeaders)) +import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus,simpleBody)) import SpecHelper import Text.Heredoc @@ -302,44 +302,6 @@ spec = do get "/projects?id=in.1,3&select=id,name,client_id,client{id,name}" `shouldRespondWith` [str|[{"id":1,"name":"Windows 7","client_id":1,"client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client":{"id":2,"name":"Apple"}}]|] - - describe "Plurality singular" $ do - it "will select an existing object" $ - request methodGet "/items?id=eq.5" [("Prefer","plurality=singular")] "" - `shouldRespondWith` ResponseMatcher { - matchBody = Just [json| {"id":5} |] - , matchStatus = 200 - , matchHeaders = [] - } - - it "can combine multiple prefer values" $ - request methodGet "/items?id=eq.5" [("Prefer","plurality=singular , future=new, count=none")] "" - `shouldRespondWith` ResponseMatcher { - matchBody = Just [json| {"id":5} |] - , matchStatus = 200 - , matchHeaders = [] - } - - it "works in the presence of a range header" $ - let headers = ("Prefer","plurality=singular") : - rangeHdrs (ByteRangeFromTo 0 9) in - request methodGet "/items" headers "" - `shouldRespondWith` ResponseMatcher { - matchBody = Just [json| {"id":1} |] - , matchStatus = 200 - , matchHeaders = [] - } - - it "will respond with 404 when not found" $ - request methodGet "/items?id=eq.9999" [("Prefer","plurality=singular")] "" - `shouldRespondWith` 404 - - it "can shape plurality singular object routes" $ - request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [("Prefer","plurality=singular")] "" - `shouldRespondWith` - [str|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|] - - describe "ordering response" $ do it "by a column asc" $ get "/items?id=lte.2&order=id.asc" @@ -531,10 +493,14 @@ spec = do post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith` [json| [ {"id": 3}, {"id":4} ] |] + context "unknown function" $ + it "returns 404" $ + post "/rpc/fakefunc" [json| {} |] `shouldRespondWith` 404 + context "shaping the response returned by a proc" $ do it "returns a project" $ post "/rpc/getproject" [json| { "id": 1} |] `shouldRespondWith` - [json|[{"id":1,"name":"Windows 7","client_id":1}]|] + [str|[{"id":1,"name":"Windows 7","client_id":1}]|] it "can filter proc results" $ post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith` @@ -548,20 +514,13 @@ spec = do , matchHeaders = ["Content-Range" <:> "1-2/*"] } - - - it "prefer singular" $ - request methodPost "/rpc/getproject" - [("Prefer","plurality=singular")] [json| { "id": 1} |] `shouldRespondWith` - [json|{"id":1,"name":"Windows 7","client_id":1}|] - it "select works on the first level" $ post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith` - [json|[{"id":1,"name":"Windows 7"}]|] + [str|[{"id":1,"name":"Windows 7"}]|] it "can embed foreign entities to the items returned by a proc" $ post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith` - [json|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|] + [str|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|] context "a proc that returns an empty rowset" $ it "returns empty json array" $ @@ -582,17 +541,17 @@ spec = do request methodPost "/rpc/sayhello" (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |] `shouldRespondWith` 415 - it "rejects malformed json payload" $ - request methodPost "/rpc/sayhello" + it "rejects malformed json payload" $ do + p <- request methodPost "/rpc/sayhello" (acceptHdrs "application/json") "sdfsdf" - `shouldRespondWith` 400 - -- it used to be 404 and it makes sense but in another part we decided that it's good to return - -- PostgreSQL errors (and have the proxy handle them) and this saves us an aditional query on each rpc request - it "responds with 400 on an unexisting proc" $ - post "/rpc/fake" "{}" `shouldRespondWith` 400 - it "treats simple plpgsql raise as invalid input" $ - post "/rpc/problem" "{}" `shouldRespondWith` 400 - + liftIO $ do + simpleStatus p `shouldBe` badRequest400 + isErrorFormat (simpleBody p) `shouldBe` True + it "treats simple plpgsql raise as invalid input" $ do + p <- post "/rpc/problem" "{}" + liftIO $ do + simpleStatus p `shouldBe` badRequest400 + isErrorFormat (simpleBody p) `shouldBe` True context "unsupported verbs" $ do it "DELETE fails" $ @@ -623,7 +582,7 @@ spec = do [("Prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith` [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] - it "accepts parameters from an html form" $ + it "accepts parameters from an html form" $ request methodPost "/rpc/singlejsonparam" [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")] ("integer=7&double=2.71828&varchar=forms+are+fun&" <> diff --git a/test/Feature/SingularSpec.hs b/test/Feature/SingularSpec.hs new file mode 100644 index 000000000..521c05697 --- /dev/null +++ b/test/Feature/SingularSpec.hs @@ -0,0 +1,198 @@ +module Feature.SingularSpec where + +import Text.Heredoc +import Test.Hspec +import Test.Hspec.Wai +import Test.Hspec.Wai.JSON +import Network.HTTP.Types +import Network.Wai.Test (SResponse(..)) + +import Network.Wai (Application) + +import SpecHelper +import Protolude hiding (get) + + +spec :: SpecWith Application +spec = + describe "Requesting singular json object" $ do + let pgrstObj = "application/vnd.pgrst.object+json" + singular = ("Accept", pgrstObj) + + context "with GET request" $ do + it "fails for zero rows" $ + request methodGet "/items?id=gt.0&id=lt.0" [singular] "" + `shouldRespondWith` 406 + + it "will select an existing object" $ do + request methodGet "/items?id=eq.5" [singular] "" + `shouldRespondWith` [str|{"id":5}|] + -- also test without the +json suffix + request methodGet "/items?id=eq.5" + [("Accept", "application/vnd.pgrst.object")] "" + `shouldRespondWith` [str|{"id":5}|] + + it "can combine multiple prefer values" $ + request methodGet "/items?id=eq.5" [singular, ("Prefer","count=none")] "" + `shouldRespondWith` [str|{"id":5}|] + + it "can shape plurality singular object routes" $ + request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [singular] "" + `shouldRespondWith` + [str|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|] + + context "when updating rows" $ do + + it "works for one row" $ do + _ <- post "/addresses" [json| { id: 97, address: "A Street" } |] + request methodPatch + "/addresses?id=eq.97" + [("Prefer", "return=representation"), singular] + [json| { address: "B Street" } |] + `shouldRespondWith` + [str|{"id":97,"address":"B Street"}|] + + it "raises an error for multiple rows" $ do + _ <- post "/addresses" [json| { id: 98, address: "xxx" } |] + _ <- post "/addresses" [json| { id: 99, address: "yyy" } |] + p <- request methodPatch + "/addresses?id=gt.0" + [("Prefer", "return=representation"), singular] + [json| { address: "zzz" } |] + liftIO $ do + simpleStatus p `shouldBe` notAcceptable406 + isErrorFormat (simpleBody p) `shouldBe` True + + -- the rows should not be updated, either + get "/addresses?id=eq.98" `shouldRespondWith` [str|[{"id":98,"address":"xxx"}]|] + + it "raises an error for zero rows" $ do + p <- request methodPatch "/items?id=gt.0&id=lt.0" + [("Prefer", "return=representation"), singular] [json|{"id":1}|] + liftIO $ do + simpleStatus p `shouldBe` notAcceptable406 + isErrorFormat (simpleBody p) `shouldBe` True + + context "when creating rows" $ do + + it "works for one row" $ do + p <- request methodPost + "/addresses" + [("Prefer", "return=representation"), singular] + [json| [ { id: 100, address: "xxx" } ] |] + liftIO $ simpleBody p `shouldBe` [str|{"id":100,"address":"xxx"}|] + + it "works for one row even with return=minimal" $ do + request methodPost "/addresses" + [("Prefer", "return=minimal"), singular] + [json| [ { id: 101, address: "xxx" } ] |] + `shouldRespondWith` ResponseMatcher { + matchBody = Just "" + , matchStatus = 201 + , matchHeaders = ["Content-Range" <:> "*/*"] + } + -- and the element should exist + get "/addresses?id=eq.101" + `shouldRespondWith` ResponseMatcher { + matchBody = Just [str|[{"id":101,"address":"xxx"}]|] + , matchStatus = 200 + , matchHeaders = [] + } + + it "raises an error when attempting to create multiple entities" $ do + p <- request methodPost + "/addresses" + [("Prefer", "return=representation"), singular] + [json| [ { id: 200, address: "xxx" }, { id: 201, address: "yyy" } ] |] + liftIO $ simpleStatus p `shouldBe` notAcceptable406 + + -- the rows should not exist, either + get "/addresses?id=eq.200" `shouldRespondWith` "[]" + + it "return=minimal allows request to create multiple elements" $ + request methodPost "/addresses" + [("Prefer", "return=minimal"), singular] + [json| [ { id: 200, address: "xxx" }, { id: 201, address: "yyy" } ] |] + `shouldRespondWith` ResponseMatcher { + matchBody = Just "" + , matchStatus = 201 + , matchHeaders = ["Content-Range" <:> "*/*"] + } + + it "raises an error when creating zero entities" $ do + p <- request methodPost + "/addresses" + [("Prefer", "return=representation"), singular] + [json| [ ] |] + liftIO $ do + simpleStatus p `shouldBe` notAcceptable406 + isErrorFormat (simpleBody p) `shouldBe` True + + context "when deleting rows" $ do + + it "works for one row" $ do + p <- request methodDelete + "/items?id=eq.11" + [("Prefer", "return=representation"), singular] "" + liftIO $ simpleBody p `shouldBe` [str|{"id":11}|] + + it "raises an error when attempting to delete multiple entities" $ do + let firstItems = "/items?id=gt.0&id=lt.11" + request methodDelete firstItems + [("Prefer", "return=representation"), singular] "" + `shouldRespondWith` 406 + + -- the rows should not exist, either + get firstItems + `shouldRespondWith` ResponseMatcher { + matchBody = Nothing + , matchStatus = 200 + , matchHeaders = ["Content-Range" <:> "0-9/*"] + } + + it "raises an error when deleting zero entities" $ do + p <- request methodDelete "/items?id=lt.0" + [("Prefer", "return=representation"), singular] "" + liftIO $ do + simpleStatus p `shouldBe` notAcceptable406 + isErrorFormat (simpleBody p) `shouldBe` True + + context "when calling a stored proc" $ do + + it "fails for zero rows" $ do + p <- request methodPost "/rpc/getproject" + [singular] [json|{ "id": 9999999}|] + liftIO $ do + simpleStatus p `shouldBe` notAcceptable406 + isErrorFormat (simpleBody p) `shouldBe` True + + -- this one may be controversial, should vnd.pgrst.object include + -- the likes of 2 and "hello?" + it "succeeds for scalar result" $ + request methodPost "/rpc/sayhello" + [singular] [json|{ "name": "world"}|] + `shouldRespondWith` 200 + + it "returns a single object for json proc" $ + request methodPost "/rpc/getproject" + [singular] [json|{ "id": 1}|] `shouldRespondWith` + [str|{"id":1,"name":"Windows 7","client_id":1}|] + + it "fails for multiple rows" $ do + p <- request methodPost "/rpc/getallprojects" [singular] "{}" + liftIO $ do + simpleStatus p `shouldBe` notAcceptable406 + isErrorFormat (simpleBody p) `shouldBe` True + + it "executes the proc exactly once per request" $ do + request methodPost "/rpc/getproject?select=id,name" [] [json| {"id": 1} |] + `shouldRespondWith` [str|[{"id":1,"name":"Windows 7"}]|] + p <- request methodPost "/rpc/setprojects" [singular] + [json| {"id_l": 1, "id_h": 2, "name": "changed"} |] + liftIO $ do + simpleStatus p `shouldBe` notAcceptable406 + isErrorFormat (simpleBody p) `shouldBe` True + + -- should not actually have executed the function + request methodPost "/rpc/getproject?select=id,name" [] [json| {"id": 1} |] + `shouldRespondWith` [str|[{"id":1,"name":"Windows 7"}]|] diff --git a/test/Main.hs b/test/Main.hs index ce7f3494c..849a5072d 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -23,6 +23,7 @@ import qualified Feature.QueryLimitedSpec import qualified Feature.QuerySpec import qualified Feature.RangeSpec import qualified Feature.StructureSpec +import qualified Feature.SingularSpec import qualified Feature.UnicodeSpec import qualified Feature.ProxySpec @@ -81,5 +82,6 @@ main = do , ("Feature.InsertSpec" , Feature.InsertSpec.spec) , ("Feature.QuerySpec" , Feature.QuerySpec.spec) , ("Feature.RangeSpec" , Feature.RangeSpec.spec) + , ("Feature.SingularSpec" , Feature.SingularSpec.spec) , ("Feature.StructureSpec" , Feature.StructureSpec.spec) ] diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index d676163bf..6db022708 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -7,9 +7,12 @@ import System.Environment (getEnv) import qualified Data.ByteString.Base64 as B64 (encode, decodeLenient) import Data.CaseInsensitive (CI(..)) +import qualified Data.Set as S +import qualified Data.Map.Strict as M import Data.List (lookup) import Text.Regex.TDFA ((=~)) import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy as BL import System.Process (readProcess) import PostgREST.Config (AppConfig(..)) @@ -21,7 +24,7 @@ import Network.HTTP.Types import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody)) import Data.Maybe (fromJust) -import Data.Aeson (decode) +import Data.Aeson (decode, Value(..)) import qualified Data.JsonSchema.Draft4 as D4 import Protolude @@ -123,3 +126,15 @@ authHeaderBasic u p = authHeaderJWT :: BS.ByteString -> Header authHeaderJWT token = (hAuthorization, "Bearer " <> token) + +-- | Tests whether the text can be parsed as a json object comtaining +-- the key "message", and optional keys "details", "hint", "code", +-- and no extraneous keys +isErrorFormat :: BL.ByteString -> Bool +isErrorFormat s = + "message" `S.member` keys && + S.null (S.difference keys validKeys) + where + obj = decode s :: Maybe (M.Map Text Value) + keys = fromMaybe S.empty (M.keysSet <$> obj) + validKeys = S.fromList ["message", "details", "hint", "code"] diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index cf9cb0cb8..dc065b0f5 100755 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -1091,6 +1091,12 @@ CREATE FUNCTION getallprojects() RETURNS SETOF projects SELECT * FROM test.projects; $_$; +CREATE FUNCTION setprojects(id_l int, id_h int, name text) RETURNS SETOF projects + LANGUAGE sql + AS $_$ + update test.projects set name = $3 WHERE id >= $1 AND id <= $2 returning *; +$_$; + -- -- PostgreSQL database dump complete --