Implements query counting in proc call and adds Content-Rage to response

headers in /rpc calls.
This commit is contained in:
Diogo Biazus
2016-02-26 14:51:35 -05:00
parent 4496a95014
commit 9d0f3573c6
4 changed files with 135 additions and 20 deletions
+14 -9
View File
@@ -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
+15 -7
View File
@@ -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 = [
+9 -2
View File
@@ -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} ] |]
+97 -2
View File
@@ -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" $