diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index cd14d332d..a3c5e833f 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -15,6 +15,7 @@ module PostgREST.ApiRequest ( ApiRequest(..) ) where import Protolude +import Data.Ranged.Ranges (emptyRange) import qualified Data.Aeson as JSON import qualified Data.ByteString as BS @@ -62,7 +63,10 @@ data PreferRepresentation = Full | HeadersOnly | None deriving Eq data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI | CTAny | CTOther BS.ByteString deriving Eq -data ApiRequestError = ErrorActionInappropriate | ErrorInvalidBody ByteString deriving (Show, Eq) +data ApiRequestError = ErrorActionInappropriate + | ErrorInvalidBody ByteString + | ErrorInvalidRange + deriving (Show, Eq) -- | Convert from ContentType to a full HTTP Header toHeader :: ContentType -> Header @@ -118,6 +122,7 @@ data ApiRequest = ApiRequest { userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest userApiRequest schema req reqBody | isTargetingProc && method /= "POST" = Left ErrorActionInappropriate + | topLevelRange == emptyRange = Left $ ErrorInvalidRange | isError = Left $ ErrorInvalidBody payloadError | otherwise = Right ApiRequest { iAction = action @@ -168,6 +173,7 @@ userApiRequest schema req reqBody $ toS reqBody ct -> PayloadParseError $ "Content-Type not acceptable: " <> toMime ct + topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges action = if isTargetingProc then ActionInvoke diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 4cc1010c5..6be81be51 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -11,7 +11,6 @@ import qualified Data.ByteString.Char8 as BS import Data.IORef (IORef, readIORef) import Data.List (delete, lookup) import Data.Maybe (fromJust) -import Data.Ranged.Ranges (emptyRange) import Data.Text (replace, strip, isInfixOf, dropWhile, drop, intercalate) import Data.Time.Clock.POSIX (POSIXTime) import Data.Tree @@ -99,6 +98,7 @@ postgrest conf refDbStructure pool getTime = case err of ErrorActionInappropriate -> errResponse status405 "Bad Request" ErrorInvalidBody errorMessage -> errResponse status400 $ toS errorMessage + ErrorInvalidRange -> errResponse status416 "HTTP Range error" transactionMode :: Action -> H.Mode transactionMode ActionRead = HT.Read @@ -115,7 +115,7 @@ app dbStructure conf apiRequest = (ActionRead, TargetIdent qi, Nothing) -> case readSqlParts of Left errorResponse -> return errorResponse - Right (q, cq) -> respondToRange $ do + Right (q, cq) -> do let singular = iPreferSingular apiRequest stm = createReadStatement q cq singular shouldCount (contentType == CTTextCSV) row <- H.query () stm @@ -219,7 +219,7 @@ app dbStructure conf apiRequest = (ActionInvoke, TargetProc qi, Just (PayloadJSON (UniformObjects payload))) -> case readSqlParts of Left errorResponse -> return errorResponse - Right (q, cq) -> respondToRange $ do + Right (q, cq) -> do let p = V.head payload singular = iPreferSingular apiRequest paramsAsSingleObject = iPreferSingleObjectParameter apiRequest @@ -276,10 +276,6 @@ app dbStructure conf apiRequest = countQuery = requestToCountQuery schema <$> readDbRequest readSqlParts = (,) <$> selectQuery <*> countQuery mutateSqlParts = (,) <$> selectQuery <*> mutateQuery - respondToRange response = - if topLevelRange == emptyRange - then return $ errResponse status416 "HTTP Range error" - else response responseContentTypeOrError :: [ContentType] -> Action -> Either Response ContentType responseContentTypeOrError accepts action = serves contentTypesForRequest accepts