Merge pull request #489 from diogob/apply_range_headers_to_rpc

Apply range headers to rpc

CHANGELOG.md

@@ -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

src/PostgREST/App.hs

@@ -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
+          let singular = iPreferSingular apiRequest
-              singular = iPreferSingular apiRequest
               stm = createReadStatement q cq range singular
-                    (iPreferCount apiRequest) (contentType == TextCSV)
+                    shouldCount (contentType == TextCSV)
-          if range == emptyRange
+          respondToRange $ do
-          then return $ errResponse status416 "HTTP Range error"
-          else 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
+              let (status, contentRange) = rangeHeader queryTotal tableTotal
-                  to = frm + toInteger queryTotal - 1
-                  contentRange = contentRangeH frm to (toInteger <$> tableTotal)
-                  status = rangeStatus frm to (toInteger <$> 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
-
+          respondToRange $ do
-          bodyJson <- H.query () (callProc qi p)
+            row <- H.query () (callProc qi p range shouldCount)
-          returnJWT <- H.query qi doesProcReturnJWT
+            returnJWT <- H.query qi doesProcReturnJWT
-          return $ responseLBS status200 [jsonH]
+            let (tableTotal, queryTotal, body) = fromMaybe (Just 0, 0, emptyArray) row
-                 (let body = fromMaybe emptyArray bodyJson in
+                (status, contentRange) = rangeHeader queryTotal tableTotal
-                    if returnJWT
+              in
-                    then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
+              return $ responseLBS status [jsonH, contentRange]
-                    else cs $ encode body)
+                      (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

src/PostgREST/Main.hs

@@ -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

src/PostgREST/QueryBuilder.hs

@@ -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)
+type ProcResults = (Maybe Int64, Int64, JSON.Value)
-callProc qi params =
+callProc :: QualifiedIdentifier -> JSON.Object -> NonnegRange -> Bool -> H.Query () (Maybe ProcResults)
-  H.statement sql HE.unit decodeObj True
+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
+    _callSql = [qc| from {fromQi qi}({_args}) |] :: BS.ByteString
-    decodeObj = HD.maybeRow (HD.value HD.json)
+    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 = [

test/Feature/QuerySpec.hs

@@ -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} ] |]

test/Feature/RangeSpec.hs

@@ -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" $