Merge pull request #489 from diogob/apply_range_headers_to_rpc

Apply range headers to rpc
This commit is contained in:
Joe Nelson
2016-02-26 12:10:33 -08:00
6 changed files with 150 additions and 30 deletions
+3
View File
@@ -17,6 +17,9 @@ This project adheres to [Semantic Versioning](http://semver.org/).
- Throw an error for OPTIONS on nonexistent tables - @calebmer
- Remove deadlock on simultaneous contentious updates - @ruslantalpa, @begriffs
### Added
- Applies range headers to RPC calls - @diogob
## [0.3.0.3] - 2016-01-08
### Fixed
+24 -18
View File
@@ -71,13 +71,10 @@ app dbStructure conf reqBody req =
case readSqlParts of
Left e -> return $ responseLBS status400 [jsonH] $ cs e
Right (q, cq) -> do
let range = restrictRange (configMaxRows conf) $ iRange apiRequest
singular = iPreferSingular apiRequest
let singular = iPreferSingular apiRequest
stm = createReadStatement q cq range singular
(iPreferCount apiRequest) (contentType == TextCSV)
if range == emptyRange
then return $ errResponse status416 "HTTP Range error"
else do
shouldCount (contentType == TextCSV)
respondToRange $ do
row <- H.query () stm
let (tableTotal, queryTotal, _ , body) = row
if singular
@@ -85,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)
@@ -165,14 +159,16 @@ app dbStructure conf reqBody req =
then do
let p = V.head payload
jwtSecret = configJwtSecret conf
bodyJson <- H.query () (callProc qi p)
returnJWT <- H.query qi doesProcReturnJWT
return $ responseLBS status200 [jsonH]
(let body = fromMaybe emptyArray bodyJson in
if returnJWT
then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
else cs $ encode body)
respondToRange $ do
row <- H.query () (callProc qi p range shouldCount)
returnJWT <- H.query qi doesProcReturnJWT
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
(ActionRead, TargetRoot, Nothing) -> do
@@ -196,6 +192,8 @@ 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
selectQuery = requestToQuery schema <$> readDbRequest
@@ -203,6 +201,14 @@ app dbStructure conf reqBody req =
mutateQuery = requestToQuery schema <$> mutateDbRequest
readSqlParts = (,) <$> selectQuery <*> countQuery
mutateSqlParts = (,) <$> selectQuery <*> mutateQuery
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
-2
View File
@@ -30,7 +30,6 @@ import System.IO (BufferMode (..),
hSetBuffering, stderr,
stdin, stdout)
import Web.JWT (secret)
#ifndef mingw32_HOST_OS
import System.Posix.Signals
import Control.Concurrent (myThreadId)
@@ -64,7 +63,6 @@ main = do
Prelude.putStrLn $ "Listening on port " ++
(show $ configPort conf :: String)
pool <- P.acquire (configPool conf, 10, pgSettings)
#ifndef mingw32_HOST_OS
+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 -> H.Query () (Maybe JSON.Value)
callProc qi params =
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}) |] :: 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 = [
+11 -1
View File
@@ -370,7 +370,17 @@ spec = do
[json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
describe "remote procedure call" $ do
context "a proc that returns a set" $
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` 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" $