Implements query counting in proc call and adds Content-Rage to response
headers in /rpc calls.
This commit is contained in:
+14
-9
@@ -73,7 +73,7 @@ app dbStructure conf reqBody req =
|
||||
Right (q, cq) -> do
|
||||
let singular = iPreferSingular apiRequest
|
||||
stm = createReadStatement q cq range singular
|
||||
(iPreferCount apiRequest) (contentType == TextCSV)
|
||||
shouldCount (contentType == TextCSV)
|
||||
respondToRange $ do
|
||||
row <- H.query () stm
|
||||
let (tableTotal, queryTotal, _ , body) = row
|
||||
@@ -82,10 +82,7 @@ app dbStructure conf reqBody req =
|
||||
then responseLBS status404 [] ""
|
||||
else responseLBS status200 [contentTypeH] (cs body)
|
||||
else do
|
||||
let frm = rangeOffset range
|
||||
to = frm + toInteger queryTotal - 1
|
||||
contentRange = contentRangeH frm to (toInteger <$> tableTotal)
|
||||
status = rangeStatus frm to (toInteger <$> tableTotal)
|
||||
let (status, contentRange) = rangeHeader queryTotal tableTotal
|
||||
canonical = urlEncodeVars -- should this be moved to the dbStructure (location)?
|
||||
. sortBy (comparing fst)
|
||||
. map (join (***) cs)
|
||||
@@ -163,11 +160,13 @@ app dbStructure conf reqBody req =
|
||||
let p = V.head payload
|
||||
jwtSecret = configJwtSecret conf
|
||||
respondToRange $ do
|
||||
bodyJson <- H.query () (callProc qi p range)
|
||||
row <- H.query () (callProc qi p range shouldCount)
|
||||
returnJWT <- H.query qi doesProcReturnJWT
|
||||
return $ responseLBS status200 [jsonH]
|
||||
(let body = fromMaybe emptyArray bodyJson in
|
||||
if returnJWT
|
||||
let (tableTotal, queryTotal, body) = fromMaybe (Just 0, 0, emptyArray) row
|
||||
(status, contentRange) = rangeHeader queryTotal tableTotal
|
||||
in
|
||||
return $ responseLBS status [jsonH, contentRange]
|
||||
(if returnJWT
|
||||
then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
|
||||
else cs $ encode body)
|
||||
else return notFound
|
||||
@@ -193,6 +192,7 @@ app dbStructure conf reqBody req =
|
||||
allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
|
||||
schema = cs $ configSchema conf
|
||||
apiRequest = userApiRequest schema req reqBody
|
||||
shouldCount = iPreferCount apiRequest
|
||||
range = restrictRange (configMaxRows conf) $ iRange apiRequest
|
||||
readDbRequest = DbRead <$> buildReadRequest (dbRelations dbStructure) apiRequest
|
||||
mutateDbRequest = DbMutate <$> buildMutateRequest apiRequest
|
||||
@@ -204,6 +204,11 @@ app dbStructure conf reqBody req =
|
||||
respondToRange response = if range == emptyRange
|
||||
then return $ errResponse status416 "HTTP Range error"
|
||||
else response
|
||||
rangeHeader queryTotal tableTotal = let frm = rangeOffset range
|
||||
to = frm + toInteger queryTotal - 1
|
||||
contentRange = contentRangeH frm to (toInteger <$> tableTotal)
|
||||
status = rangeStatus frm to (toInteger <$> tableTotal)
|
||||
in (status, contentRange)
|
||||
|
||||
rangeStatus :: Integer -> Integer -> Maybe Integer -> Status
|
||||
rangeStatus _ _ Nothing = status200
|
||||
|
||||
@@ -203,18 +203,26 @@ addJoinConditions schema (Node (query, (n, r)) forest) =
|
||||
updatedForest = mapM (addJoinConditions schema) forest
|
||||
addCond query' con = query'{flt_=con ++ flt_ query'}
|
||||
|
||||
callProc :: QualifiedIdentifier -> JSON.Object -> NonnegRange -> H.Query () (Maybe JSON.Value)
|
||||
callProc qi params range =
|
||||
H.statement sql HE.unit decodeObj True
|
||||
type ProcResults = (Maybe Int64, Int64, JSON.Value)
|
||||
callProc :: QualifiedIdentifier -> JSON.Object -> NonnegRange -> Bool -> H.Query () (Maybe ProcResults)
|
||||
callProc qi params range countTotal =
|
||||
H.statement sql HE.unit decodeProc True
|
||||
where
|
||||
sql = [qc| SELECT array_to_json(
|
||||
sql = [qc| SELECT
|
||||
{countQuery} as countTotal,
|
||||
{countResult} as countResult,
|
||||
array_to_json(
|
||||
coalesce(array_agg(row_to_json(t)), '\{}')
|
||||
)::character varying
|
||||
from ({_callSql}) t |]
|
||||
from (select * {_callSql} {limitF range}) t |]
|
||||
_args = intercalate "," $ map _assignment (HM.toList params)
|
||||
_assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
|
||||
_callSql = [qc| select * from {fromQi qi}({_args}) {limitF range} |] :: BS.ByteString
|
||||
decodeObj = HD.maybeRow (HD.value HD.json)
|
||||
_callSql = [qc| from {fromQi qi}({_args}) |] :: BS.ByteString
|
||||
countQuery = if countTotal then [qc| (select pg_catalog.count(1) {_callSql} c) |] else "null::bigint" :: BS.ByteString
|
||||
countResult = "pg_catalog.count(t)" :: BS.ByteString
|
||||
decodeProc = HD.maybeRow procRow
|
||||
procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
|
||||
<*> HD.value HD.json
|
||||
|
||||
operators :: [(Text, SqlFragment)]
|
||||
operators = [
|
||||
|
||||
@@ -372,8 +372,15 @@ spec = do
|
||||
describe "remote procedure call" $ do
|
||||
context "a proc that returns a set" $ do
|
||||
it "returns paginated results" $
|
||||
request methodPost "/rpc/getitemrange" (rangeHdrs (ByteRangeFromTo 0 0)) [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
|
||||
[json| [ {"id": 3} ] |]
|
||||
request methodPost "/rpc/getitemrange"
|
||||
(rangeHdrs (ByteRangeFromTo 0 0)) [json| { "min": 2, "max": 4 } |]
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [json| [{"id":3}] |]
|
||||
, matchStatus = 206
|
||||
, matchHeaders = ["Content-Range" <:> "0-0/2"]
|
||||
}
|
||||
|
||||
|
||||
it "returns proper json" $
|
||||
post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
|
||||
[json| [ {"id": 3}, {"id":4} ] |]
|
||||
|
||||
@@ -6,14 +6,109 @@ import Test.Hspec.Wai.JSON
|
||||
import Network.HTTP.Types
|
||||
import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
|
||||
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
|
||||
import SpecHelper
|
||||
import Network.Wai (Application)
|
||||
|
||||
defaultRange :: BL.ByteString
|
||||
defaultRange = [json| { "min": 0, "max": 15 } |]
|
||||
|
||||
emptyRange :: BL.ByteString
|
||||
emptyRange = [json| { "min": 2, "max": 2 } |]
|
||||
|
||||
spec :: SpecWith Application
|
||||
spec =
|
||||
spec = do
|
||||
describe "POST /rpc/getitemrange" $ do
|
||||
context "without range headers" $ do
|
||||
context "with response under server size limit" $
|
||||
it "returns whole range with status 200" $
|
||||
post "/rpc/getitemrange" defaultRange `shouldRespondWith` 200
|
||||
|
||||
context "when I don't want the count" $ do
|
||||
it "returns range Content-Range with */* for empty range" $
|
||||
request methodPost "/rpc/getitemrange"
|
||||
[("Prefer", "count=none")] emptyRange
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [json| [] |]
|
||||
, matchStatus = 200
|
||||
, matchHeaders = ["Content-Range" <:> "*/*"]
|
||||
}
|
||||
|
||||
it "returns range Content-Range with range/*" $
|
||||
request methodPost "/rpc/getitemrange"
|
||||
[("Prefer", "count=none")] defaultRange
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
|
||||
, matchStatus = 200
|
||||
, matchHeaders = ["Content-Range" <:> "0-14/*"]
|
||||
}
|
||||
|
||||
context "with range headers" $ do
|
||||
|
||||
context "of acceptable range" $ do
|
||||
it "succeeds with partial content" $ do
|
||||
r <- request methodPost "/rpc/getitemrange"
|
||||
(rangeHdrs $ ByteRangeFromTo 0 1) defaultRange
|
||||
liftIO $ do
|
||||
simpleHeaders r `shouldSatisfy`
|
||||
matchHeader "Content-Range" "0-1/15"
|
||||
simpleStatus r `shouldBe` partialContent206
|
||||
|
||||
it "understands open-ended ranges" $
|
||||
request methodPost "/rpc/getitemrange"
|
||||
(rangeHdrs $ ByteRangeFrom 0) defaultRange
|
||||
`shouldRespondWith` 200
|
||||
|
||||
it "returns an empty body when there are no results" $
|
||||
request methodPost "/rpc/getitemrange"
|
||||
(rangeHdrs $ ByteRangeFromTo 0 1) emptyRange
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Just "[]"
|
||||
, matchStatus = 200
|
||||
, matchHeaders = ["Content-Range" <:> "*/0"]
|
||||
}
|
||||
|
||||
it "allows one-item requests" $ do
|
||||
r <- request methodPost "/rpc/getitemrange"
|
||||
(rangeHdrs $ ByteRangeFromTo 0 0) defaultRange
|
||||
liftIO $ do
|
||||
simpleHeaders r `shouldSatisfy`
|
||||
matchHeader "Content-Range" "0-0/15"
|
||||
simpleStatus r `shouldBe` partialContent206
|
||||
|
||||
it "handles ranges beyond collection length via truncation" $ do
|
||||
r <- request methodPost "/rpc/getitemrange"
|
||||
(rangeHdrs $ ByteRangeFromTo 10 100) defaultRange
|
||||
liftIO $ do
|
||||
simpleHeaders r `shouldSatisfy`
|
||||
matchHeader "Content-Range" "10-14/15"
|
||||
simpleStatus r `shouldBe` partialContent206
|
||||
|
||||
context "of invalid range" $ do
|
||||
it "fails with 416 for offside range" $
|
||||
request methodPost "/rpc/getitemrange"
|
||||
(rangeHdrs $ ByteRangeFromTo 1 0) emptyRange
|
||||
`shouldRespondWith` 416
|
||||
|
||||
it "refuses a range with nonzero start when there are no items" $
|
||||
request methodPost "/rpc/getitemrange"
|
||||
(rangeHdrs $ ByteRangeFromTo 1 2) emptyRange
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Nothing
|
||||
, matchStatus = 416
|
||||
, matchHeaders = ["Content-Range" <:> "*/0"]
|
||||
}
|
||||
|
||||
it "refuses a range requesting start past last item" $
|
||||
request methodPost "/rpc/getitemrange"
|
||||
(rangeHdrs $ ByteRangeFromTo 100 199) defaultRange
|
||||
`shouldRespondWith` ResponseMatcher {
|
||||
matchBody = Nothing
|
||||
, matchStatus = 416
|
||||
, matchHeaders = ["Content-Range" <:> "*/15"]
|
||||
}
|
||||
describe "GET /items" $ do
|
||||
|
||||
context "without range headers" $ do
|
||||
context "with response under server size limit" $
|
||||
it "returns whole range with status 200" $
|
||||
|
||||
Reference in New Issue
Block a user