{-|
Module      : PostgREST.RangeQuery
Description : Logic regarding the `Range`/`Content-Range` headers and `limit`/`offset` querystring arguments.
-}
module PostgREST.RangeQuery (
  rangeParse
, rangeRequested
, rangeLimit
, rangeOffset
, restrictRange
, rangeGeq
, allRange
, NonnegRange
, rangeStatusHeader
, contentRangeH
) where

import qualified Data.ByteString.Char8 as BS

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

import Control.Applicative
import Data.Ranged.Boundaries
import Data.Ranged.Ranges
import Network.HTTP.Types.Header
import Network.HTTP.Types.Status

import Protolude      hiding (toS)
import Protolude.Conv (toS)

type NonnegRange = Range Integer

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

  case [[ByteString]] -> Maybe [ByteString]
forall a. [a] -> Maybe a
listToMaybe (ByteString
range ByteString -> ByteString -> [[ByteString]]
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ ByteString
rangeRegex :: [[BS.ByteString]]) of
    Just [ByteString]
parsedRange ->
      let [Maybe Integer
_, Maybe Integer
mLower, Maybe Integer
mUpper] = String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer)
-> (ByteString -> String) -> ByteString -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a b. StringConv a b => a -> b
toS (ByteString -> Maybe Integer) -> [ByteString] -> [Maybe Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
parsedRange
          lower :: NonnegRange
lower         = NonnegRange
-> (Integer -> NonnegRange) -> Maybe Integer -> NonnegRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NonnegRange
forall v. DiscreteOrdered v => Range v
emptyRange Integer -> NonnegRange
rangeGeq Maybe Integer
mLower
          upper :: NonnegRange
upper         = NonnegRange
-> (Integer -> NonnegRange) -> Maybe Integer -> NonnegRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NonnegRange
allRange Integer -> NonnegRange
rangeLeq Maybe Integer
mUpper in
      NonnegRange -> NonnegRange -> NonnegRange
forall v. DiscreteOrdered v => Range v -> Range v -> Range v
rangeIntersection NonnegRange
lower NonnegRange
upper
    Maybe [ByteString]
Nothing -> NonnegRange
allRange

rangeRequested :: RequestHeaders -> NonnegRange
rangeRequested :: RequestHeaders -> NonnegRange
rangeRequested RequestHeaders
headers = NonnegRange
-> (ByteString -> NonnegRange) -> Maybe ByteString -> NonnegRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NonnegRange
allRange ByteString -> NonnegRange
rangeParse (Maybe ByteString -> NonnegRange)
-> Maybe ByteString -> NonnegRange
forall a b. (a -> b) -> a -> b
$ HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hRange RequestHeaders
headers

restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange
restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange
restrictRange Maybe Integer
Nothing NonnegRange
r = NonnegRange
r
restrictRange (Just Integer
limit) NonnegRange
r =
   NonnegRange -> NonnegRange -> NonnegRange
forall v. DiscreteOrdered v => Range v -> Range v -> Range v
rangeIntersection NonnegRange
r (NonnegRange -> NonnegRange) -> NonnegRange -> NonnegRange
forall a b. (a -> b) -> a -> b
$
     Boundary Integer -> Boundary Integer -> NonnegRange
forall v. Boundary v -> Boundary v -> Range v
Range Boundary Integer
forall a. Boundary a
BoundaryBelowAll (Integer -> Boundary Integer
forall a. a -> Boundary a
BoundaryAbove (Integer -> Boundary Integer) -> Integer -> Boundary Integer
forall a b. (a -> b) -> a -> b
$ NonnegRange -> Integer
rangeOffset NonnegRange
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
limit Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)

rangeLimit :: NonnegRange -> Maybe Integer
rangeLimit :: NonnegRange -> Maybe Integer
rangeLimit NonnegRange
range =
  case [NonnegRange -> Boundary Integer
forall v. Ord v => Range v -> Boundary v
rangeLower NonnegRange
range, NonnegRange -> Boundary Integer
forall v. Ord v => Range v -> Boundary v
rangeUpper NonnegRange
range] of
    [BoundaryBelow Integer
lower, BoundaryAbove Integer
upper] -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
upper Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
lower)
    [Boundary Integer]
_ -> Maybe Integer
forall a. Maybe a
Nothing

rangeOffset :: NonnegRange -> Integer
rangeOffset :: NonnegRange -> Integer
rangeOffset NonnegRange
range =
  case NonnegRange -> Boundary Integer
forall v. Ord v => Range v -> Boundary v
rangeLower NonnegRange
range of
    BoundaryBelow Integer
lower -> Integer
lower
    Boundary Integer
_                   -> Text -> Integer
forall a. HasCallStack => Text -> a
panic Text
"range without lower bound" -- should never happen

rangeGeq :: Integer -> NonnegRange
rangeGeq :: Integer -> NonnegRange
rangeGeq Integer
n =
  Boundary Integer -> Boundary Integer -> NonnegRange
forall v. Boundary v -> Boundary v -> Range v
Range (Integer -> Boundary Integer
forall a. a -> Boundary a
BoundaryBelow Integer
n) Boundary Integer
forall a. Boundary a
BoundaryAboveAll

allRange :: NonnegRange
allRange :: NonnegRange
allRange = Integer -> NonnegRange
rangeGeq Integer
0

rangeLeq :: Integer -> NonnegRange
rangeLeq :: Integer -> NonnegRange
rangeLeq Integer
n =
  Boundary Integer -> Boundary Integer -> NonnegRange
forall v. Boundary v -> Boundary v -> Range v
Range Boundary Integer
forall a. Boundary a
BoundaryBelowAll (Integer -> Boundary Integer
forall a. a -> Boundary a
BoundaryAbove Integer
n)

rangeStatusHeader :: NonnegRange -> Int64 -> Maybe Int64 -> (Status, Header)
rangeStatusHeader :: NonnegRange -> Int64 -> Maybe Int64 -> (Status, Header)
rangeStatusHeader NonnegRange
topLevelRange Int64
queryTotal Maybe Int64
tableTotal =
  let lower :: Integer
lower = NonnegRange -> Integer
rangeOffset NonnegRange
topLevelRange
      upper :: Integer
upper = Integer
lower Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
queryTotal Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
      contentRange :: Header
contentRange = Integer -> Integer -> Maybe Integer -> Header
forall a. (Integral a, Show a) => a -> a -> Maybe a -> Header
contentRangeH Integer
lower Integer
upper (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Integer) -> Maybe Int64 -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
tableTotal)
      status :: Status
status = Integer -> Integer -> Maybe Integer -> Status
rangeStatus Integer
lower Integer
upper (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Integer) -> Maybe Int64 -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
tableTotal)
  in (Status
status, Header
contentRange)
  where
    rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
    rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
rangeStatus Integer
_ Integer
_ Maybe Integer
Nothing = Status
status200
    rangeStatus Integer
lower Integer
upper (Just Integer
total)
      | Integer
lower Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
total               = Status
status416 -- 416 Range Not Satisfiable
      | (Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
upper Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
lower) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
total = Status
status206 -- 206 Partial Content
      | Bool
otherwise                   = Status
status200 -- 200 OK

contentRangeH :: (Integral a, Show a) => a -> a -> Maybe a -> Header
contentRangeH :: a -> a -> Maybe a -> Header
contentRangeH a
lower a
upper Maybe a
total =
    (HeaderName
"Content-Range", Text -> ByteString
forall a. ConvertText a Text => a -> ByteString
toUtf8 Text
headerValue)
    where
      headerValue :: Text
headerValue   = Text
rangeString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
totalString :: Text
      rangeString :: Text
rangeString
        | Bool
totalNotZero Bool -> Bool -> Bool
&& Bool
fromInRange = a -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show a
lower Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show a
upper
        | Bool
otherwise = Text
"*"
      totalString :: Text
totalString   = Text -> (a -> Text) -> Maybe a -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"*" a -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Maybe a
total
      totalNotZero :: Bool
totalNotZero  = a -> Maybe a
forall a. a -> Maybe a
Just a
0 Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe a
total
      fromInRange :: Bool
fromInRange   = a
lower a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
upper