Move range validation to userApiRequest.

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

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