Merge branch 'master' into skin

CHANGELOG.md

@@ -7,6 +7,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 ### Added
 - Filter columns, e.g. `?select=col1,col2` - @ruslantalpa
+- Does not execute the count total if header "Prefer: count=none" - @diogob
 
 ## [0.2.11.1] - 2015-09-01
 

postgrest.cabal

@@ -40,7 +40,7 @@ executable postgrest
                      , bytestring, text, split, string-conversions
                      , stringsearch
                      , containers, unordered-containers
-                     , optparse-applicative == 0.11.*
+                     , optparse-applicative >= 0.11 && < 0.13
                      , regex-base, regex-tdfa
                      , Ranged-sets
                      , transformers, MissingH

src/PostgREST/App.hs

@@ -14,7 +14,7 @@ import Control.Monad (join)
 import Control.Arrow ((***), second)
 import Control.Applicative
 import           Data.Bifunctor             (first)
-import Data.Text hiding (map, find, filter)
+import Data.Text (Text, pack)
 import Data.Maybe (fromMaybe, mapMaybe, isJust, isNothing)
 import Text.Regex.TDFA ((=~))
 import Data.Ord (comparing)
@@ -61,7 +61,7 @@ app dbstructure conf reqBody dbrole req =
   case (path, verb) of
 
     ([], _) -> do
-      let body = encode $ filter (filterTableAcl dbrole) $ filter (((cs schema)==).tableSchema) allTables
+      let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTables
       return $ responseLBS status200 [jsonH] $ cs body
 
     ([table], "OPTIONS") -> do
@@ -80,17 +80,20 @@ app dbstructure conf reqBody dbrole req =
           Left e -> return $ responseLBS status200 [("Content-Type", "text/plain")] $ cs e
           Right (qs, cqs) -> do
             let qt = qualify table
+                count = if hasPrefer "count=none"
+                      then countNone
+                      else cqs
+
                 q = B.Stmt "select " V.empty True <>
-                    parentheticT (
+                    parentheticT count
-                      cqs
+                    <> commaq <> (
-                    ) <> commaq <> (
                     bodyForAccept contentType qt -- TODO! when in csv mode, the first row (columns) is not correct when requesting sub tables
                     . limitT range
                     $ qs
                   )
             -- return $ responseLBS status200 [contentTypeH] (cs $ show $ B.stmtTemplate q)
             row <- H.maybeEx q
-            let (tableTotal, queryTotal, body) = fromMaybe (0::Int, 0::Int, Just "" :: Maybe Text) row
+            let (tableTotal, queryTotal, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe Text) row
                 to = from+queryTotal-1
                 contentRange = contentRangeH from to tableTotal
                 status = rangeStatus from to tableTotal
@@ -158,7 +161,7 @@ app dbstructure conf reqBody dbrole req =
 
     ([table], "POST") -> do
       let qt = qualify table
-          echoRequested = lookupHeader "Prefer" == Just "return=representation"
+          echoRequested = hasPrefer "return=representation"
           parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value))
           parsed = if lookupHeader "Content-Type" == Just csvMT
             then do
@@ -247,8 +250,8 @@ app dbstructure conf reqBody dbrole req =
         row <- H.maybeEx patch
         let (queryTotal, body) =
               fromMaybe (0 :: Int, Just "" :: Maybe Text) row
-            r = contentRangeH 0 (queryTotal-1) queryTotal
+            r = contentRangeH 0 (queryTotal-1) (Just queryTotal)
-            echoRequested = lookupHeader "Prefer" == Just "return=representation"
+            echoRequested = hasPrefer "return=representation"
             s = case () of _ | queryTotal == 0 -> status404
                              | echoRequested -> status200
                              | otherwise -> status204
@@ -287,6 +290,7 @@ app dbstructure conf reqBody dbrole req =
     qualify       = QualifiedIdentifier schema
     hdrs          = requestHeaders req
     lookupHeader  = flip lookup hdrs
+    hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
     accept        = lookupHeader hAccept
     schema        = requestedSchema (cs $ configV1Schema conf) accept
     authenticator = cs $ configDbUser conf
@@ -302,21 +306,24 @@ sqlError = undefined
 isSqlError :: t
 isSqlError = undefined
 
-rangeStatus :: Int -> Int -> Int -> Status
+rangeStatus :: Int -> Int -> Maybe Int -> Status
-rangeStatus from to total
+rangeStatus _ _ Nothing = status200
+rangeStatus from to (Just total)
   | from > total            = status416
   | (1 + to - from) < total = status206
   | otherwise               = status200
 
-contentRangeH :: Int -> Int -> Int -> Header
+contentRangeH :: Int -> Int -> Maybe Int -> Header
 contentRangeH from to total =
-  ("Content-Range",
+    ("Content-Range", cs headerValue)
-    if total == 0 || from > total
+    where
-    then "*/" <> cs (show total)
+      headerValue   = rangeString <> "/" <> totalString
-    else cs (show from)
+      rangeString
-      <> "-" <> cs (show to)
+        | totalNotZero && fromInRange = show from <> "-" <> cs (show to)
-      <> "/" <> cs (show total)
+        | otherwise = "*"
-  )
+      totalString   = fromMaybe "*" (show <$> total)
+      totalNotZero  = fromMaybe True ((/=) 0 <$> total)
+      fromInRange   = from <= to
 
 requestedSchema :: Text -> Maybe BS.ByteString -> Text
 requestedSchema v1schema accept =

src/PostgREST/Parsers.hs

@@ -1,7 +1,7 @@
 --{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings, FlexibleContexts #-}
 module PostgREST.Parsers
-( parseGetRequest
+-- ( parseGetRequest
-)
+-- )
 where
 
 import           Control.Applicative
@@ -145,9 +145,12 @@ pOrder :: Parser [OrderTerm]
 pOrder = lexeme pOrderTerm `sepBy` char ','
 
 pOrderTerm :: Parser OrderTerm
-pOrderTerm =  do
+pOrderTerm =
-  c <- pFieldName
+  try ( do
-  _ <- pDelimiter
+    c <- pFieldName
-  d <- string "asc" <|> string "desc"
+    _ <- pDelimiter
-  nls <- optionMaybe (pDelimiter *> ( try(string "nullslast" *> pure ("nulls last"::String)) <|> try(string "nullsfirst" *> pure ("nulls first"::String))))
+    d <- string "asc" <|> string "desc"
-  return $ OrderTerm (cs c) (cs d) (cs <$> nls)
+    nls <- optionMaybe (pDelimiter *> ( try(string "nullslast" *> pure ("nulls last"::String)) <|> try(string "nullsfirst" *> pure ("nulls first"::String))))
+    return $ OrderTerm (cs c) (cs d) (cs <$> nls)
+  )
+  <|> OrderTerm <$> (cs <$> pFieldName) <*> pure "asc" <*> pure Nothing

src/PostgREST/PgQuery.hs

@@ -100,6 +100,9 @@ countT s =
 countRows :: QualifiedIdentifier  -> PStmt
 countRows t = B.Stmt ("select pg_catalog.count(1) from " <> fromQi t) empty True
 
+countNone :: PStmt
+countNone = B.Stmt "select null" empty True
+
 asCsvWithCount :: QualifiedIdentifier -> StatementT
 asCsvWithCount table = withCount . asCsv table
 

test/Feature/QuerySpec.hs

@@ -226,7 +226,7 @@ spec =
         }
 
     it "without other constraints" $
-      get "/items?order=asc.id" `shouldRespondWith` 200
+      get "/items?order=id.asc" `shouldRespondWith` 200
 
   describe "Accept headers" $ do
     it "should respond an unknown accept type with 415" $

test/Feature/RangeSpec.hs

@@ -2,6 +2,7 @@ module Feature.RangeSpec where
 
 import Test.Hspec
 import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
 
@@ -12,11 +13,30 @@ spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable
   . around withApp $
   describe "GET /items" $ do
 
-    context "without range headers" $
+    context "without range headers" $ do
       context "with response under server size limit" $
         it "returns whole range with status 200" $
           get "/items" `shouldRespondWith` 200
 
+      context "when I don't want the count" $ do
+        it "returns range Content-Range with /*" $
+          request methodGet "/menagerie"
+                  [("Prefer", "count=none")] ""
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Just "[]"
+            , matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "*/*"]
+            }
+
+        it "returns range Content-Range with range/*" $
+          request methodGet "/items?order=id"
+                  [("Prefer", "count=none")] ""
+            `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