Merge branch 'master' into skin

This commit is contained in:
Ruslan Talpa
2015-09-25 22:45:49 +03:00
7 changed files with 64 additions and 30 deletions
+1
View File
@@ -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
+1 -1
View File
@@ -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
+26 -19
View File
@@ -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 (
cqs
) <> commaq <> (
parentheticT count
<> 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
echoRequested = lookupHeader "Prefer" == Just "return=representation"
r = contentRangeH 0 (queryTotal-1) (Just queryTotal)
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 from to total
rangeStatus :: Int -> Int -> Maybe Int -> Status
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",
if total == 0 || from > total
then "*/" <> cs (show total)
else cs (show from)
<> "-" <> cs (show to)
<> "/" <> cs (show total)
)
("Content-Range", cs headerValue)
where
headerValue = rangeString <> "/" <> totalString
rangeString
| totalNotZero && fromInRange = show from <> "-" <> cs (show to)
| otherwise = "*"
totalString = fromMaybe "*" (show <$> total)
totalNotZero = fromMaybe True ((/=) 0 <$> total)
fromInRange = from <= to
requestedSchema :: Text -> Maybe BS.ByteString -> Text
requestedSchema v1schema accept =
+11 -8
View File
@@ -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
c <- pFieldName
_ <- pDelimiter
d <- string "asc" <|> string "desc"
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)
pOrderTerm =
try ( do
c <- pFieldName
_ <- pDelimiter
d <- string "asc" <|> string "desc"
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
+3
View File
@@ -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
+1 -1
View File
@@ -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" $
+21 -1
View File
@@ -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