Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

fix: compliant range headers #2204

Draft
wants to merge 1 commit into
base: main
Choose a base branch
from
Draft

fix: compliant range headers #2204

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
26 changes: 12 additions & 14 deletions src/PostgREST/RangeQuery.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,8 +3,7 @@ Module : PostgREST.RangeQuery
Description : Logic regarding the `Range`/`Content-Range` headers and `limit`/`offset` querystring arguments.
-}
module PostgREST.RangeQuery (
rangeParse
, rangeRequested
rangeRequested
, rangeLimit
, rangeOffset
, restrictRange
Expand All @@ -17,8 +16,7 @@ module PostgREST.RangeQuery (

import qualified Data.ByteString.Char8 as BS

import Data.List (lookup)
import Text.Regex.TDFA ((=~))
import Data.List (lookup)

import Control.Applicative
import Data.Ranged.Boundaries
Expand All @@ -30,17 +28,17 @@ import Protolude

type NonnegRange = Range Integer

rangeUnit :: ByteString
rangeUnit = "items"

rangeParse :: BS.ByteString -> NonnegRange
rangeParse range = do
let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString

case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of
Just parsedRange ->
let [_, mLower, mUpper] = readMaybe . BS.unpack <$> parsedRange
lower = maybe emptyRange rangeGeq mLower
upper = maybe allRange rangeLeq mUpper in
rangeParse range =
case BS.split '-' <$> BS.stripPrefix (rangeUnit <> "=") range of
Just [mLower, mUpper] ->
let lower = maybe emptyRange rangeGeq $ readMaybe $ BS.unpack mLower
upper = maybe allRange rangeLeq $ readMaybe $ BS.unpack mUpper in
rangeIntersection lower upper
Nothing -> allRange
_ -> allRange

rangeRequested :: RequestHeaders -> NonnegRange
rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers
Expand Down Expand Up @@ -91,7 +89,7 @@ rangeStatusHeader topLevelRange queryTotal tableTotal =

contentRangeH :: (Integral a, Show a) => a -> a -> Maybe a -> Header
contentRangeH lower upper total =
("Content-Range", toUtf8 headerValue)
("Content-Range", rangeUnit <> " " <> toUtf8 headerValue)
where
headerValue = rangeString <> "/" <> totalString :: Text
rangeString
Expand Down