From ca40ba1fda52334e59dafd50bcfc56fd5d14d7f2 Mon Sep 17 00:00:00 2001 From: Diogo Biazus Date: Tue, 28 Jul 2015 14:31:12 -0400 Subject: [PATCH 1/3] Refactors app function to DRY header lookups --- src/PostgREST/App.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 50e524618..4744fd33d 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -129,9 +129,9 @@ app conf reqBody req = ([table], "POST") -> do let qt = qualify table - echoRequested = lookup "Prefer" hdrs == Just "return=representation" + echoRequested = lookupHeader "Prefer" == Just "return=representation" parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value)) - parsed = if lookup "Content-Type" hdrs == Just "text/csv" + parsed = if lookupHeader "Content-Type" == Just "text/csv" then do rows <- CSV.decode CSV.NoHeader reqBody if V.null rows then Left "CSV requires header" @@ -200,7 +200,7 @@ app conf reqBody req = let (queryTotal, body) = fromMaybe (0 :: Int, Just "" :: Maybe Text) row r = contentRangeH 0 (queryTotal-1) queryTotal - echoRequested = lookup "Prefer" hdrs == Just "return=representation" + echoRequested = lookupHeader "Prefer" == Just "return=representation" s = case () of _ | queryTotal == 0 -> status404 | echoRequested -> status200 | otherwise -> status204 @@ -232,6 +232,7 @@ app conf reqBody req = jwtSecret = cs $ configJwtSecret conf range = rangeRequested hdrs allOrigins = ("Access-Control-Allow-Origin", "*") :: Header + lookupHeader = flip lookup hdrs sqlError :: t sqlError = undefined From 9d5011e864bac2c7859d9d7a313710dc7d179504 Mon Sep 17 00:00:00 2001 From: Diogo Biazus Date: Fri, 31 Jul 2015 23:50:41 -0400 Subject: [PATCH 2/3] Implements CSV resnponse for the appropriate accept headers --- src/PostgREST/App.hs | 11 +++++++++-- src/PostgREST/PgQuery.hs | 23 ++++++++++++++++++++--- test/Feature/QuerySpec.hs | 7 +++++++ test/SpecHelper.hs | 5 ++++- 4 files changed, 40 insertions(+), 6 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 4744fd33d..b2b6b6326 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -62,11 +62,12 @@ app conf reqBody req = then return $ responseLBS status416 [] "HTTP Range error" else do let qt = qualify table + from = fromMaybe 0 $ rangeOffset <$> range select = B.Stmt "select " V.empty True <> parentheticT ( whereT qt qq $ countRows qt ) <> commaq <> ( - asJsonWithCount + bodyForAccept accept qt . limitT range . orderT (orderParse qq) . whereT qt qq @@ -75,7 +76,6 @@ app conf reqBody req = row <- H.maybeEx select let (tableTotal, queryTotal, body) = fromMaybe (0, 0, Just "" :: Maybe Text) row - from = fromMaybe 0 $ rangeOffset <$> range to = from+queryTotal-1 contentRange = contentRangeH from to tableTotal status = rangeStatus from to tableTotal @@ -233,6 +233,7 @@ app conf reqBody req = range = rangeRequested hdrs allOrigins = ("Access-Control-Allow-Origin", "*") :: Header lookupHeader = flip lookup hdrs + accept = lookupHeader hAccept sqlError :: t sqlError = undefined @@ -246,6 +247,12 @@ rangeStatus from to total | (1 + to - from) < total = status206 | otherwise = status200 +bodyForAccept :: Maybe BS.ByteString -> QualifiedTable -> StatementT +bodyForAccept accept table = + case accept of + Just "text/csv" -> asCsvWithCount table + _ -> asJsonWithCount -- defaults to JSON + contentRangeH :: Int -> Int -> Int -> Header contentRangeH from to total = ("Content-Range", diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs index b9dc71210..c84c1fab3 100644 --- a/src/PostgREST/PgQuery.hs +++ b/src/PostgREST/PgQuery.hs @@ -100,10 +100,27 @@ countT s = countRows :: QualifiedTable -> PStmt countRows t = B.Stmt ("select pg_catalog.count(1) from " <> fromQt t) empty True +asCsvWithCount :: QualifiedTable -> StatementT +asCsvWithCount table = withCount . asCsv table + +asCsv :: QualifiedTable -> StatementT +asCsv table s = s { B.stmtTemplate = + "(select string_agg(quote_ident(column_name::text), ',') from " + <> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '" + <> fromQt table <> "' order by ordinal_position) h) || '\r' || " + <> "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '') from (" + <> B.stmtTemplate s <> ") t" } + asJsonWithCount :: StatementT -asJsonWithCount s = s { B.stmtTemplate = - "pg_catalog.count(t), array_to_json(array_agg(row_to_json(t)))::character varying from (" - <> B.stmtTemplate s <> ") t" } +asJsonWithCount = withCount . asJson + +asJson :: StatementT +asJson s = s { B.stmtTemplate = + "array_to_json(array_agg(row_to_json(t)))::character varying from (" + <> B.stmtTemplate s <> ") t" } + +withCount :: StatementT +withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s } asJsonRow :: StatementT asJsonRow s = s { B.stmtTemplate = "row_to_json(t) from (" <> B.stmtTemplate s <> ") t" } diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 7cadff625..98f036e98 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -3,6 +3,7 @@ module Feature.QuerySpec where import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON +import Network.HTTP.Types import Network.Wai.Test (SResponse(simpleHeaders)) import SpecHelper @@ -121,6 +122,12 @@ spec = it "without other constraints" $ get "/items?order=asc.id" `shouldRespondWith` 200 + describe "Accept headers" $ + it "should respond with CSV to 'text/csv' request" $ + request methodGet "/simple_pk" + (acceptHdrs "text/csv") "" + `shouldRespondWith` "k,extra\rxyyx,u\rxYYx,v" + describe "Canonical location" $ do it "Sets Content-Location with alphabetized params" $ get "/no_pk?b=eq.1&a=eq.1" diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index a88da793e..345a9b561 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -15,7 +15,7 @@ import qualified Data.Vector as V import Control.Monad (void) import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange, - hRange, hAuthorization) + hRange, hAuthorization, hAccept) import Codec.Binary.Base64.String (encode) import Data.CaseInsensitive (CI(..)) import Data.Maybe (fromMaybe) @@ -84,6 +84,9 @@ loadFixture name = rangeHdrs :: ByteRange -> [Header] rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)] +acceptHdrs :: BS.ByteString -> [Header] +acceptHdrs mime = [(hAccept, mime)] + rangeUnit :: Header rangeUnit = ("Range-Unit" :: CI BS.ByteString, "items") From adac39bd7c127e571c0995f7d5ca444d6c02cbb9 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Sat, 15 Aug 2015 11:57:57 -0700 Subject: [PATCH 3/3] Use Content-Type text/csv for CSV responses --- src/PostgREST/App.hs | 7 +++++-- test/Feature/QuerySpec.hs | 6 +++++- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index b2b6b6326..3cc092b83 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -85,7 +85,7 @@ app conf reqBody req = . parseSimpleQuery $ rawQueryString req return $ responseLBS status - [jsonH, contentRange, + [if accept == Just "text/csv" then csvH else jsonH, contentRange, ("Content-Location", "/" <> cs table <> if Prelude.null canonical then "" else "?" <> cs canonical @@ -248,7 +248,7 @@ rangeStatus from to total | otherwise = status200 bodyForAccept :: Maybe BS.ByteString -> QualifiedTable -> StatementT -bodyForAccept accept table = +bodyForAccept accept table = case accept of Just "text/csv" -> asCsvWithCount table _ -> asJsonWithCount -- defaults to JSON @@ -276,6 +276,9 @@ requestedSchema v1schema hdrs = jsonH :: Header jsonH = (hContentType, "application/json") +csvH :: Header +csvH = (hContentType, "text/csv") + handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response) -> H.Tx P.Postgres s Response handleJsonObj reqBody handler = do diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 98f036e98..f00d74fa0 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -126,7 +126,11 @@ spec = it "should respond with CSV to 'text/csv' request" $ request methodGet "/simple_pk" (acceptHdrs "text/csv") "" - `shouldRespondWith` "k,extra\rxyyx,u\rxYYx,v" + `shouldRespondWith` ResponseMatcher { + matchBody = Just "k,extra\rxyyx,u\rxYYx,v" + , matchStatus = 200 + , matchHeaders = ["Content-Type" <:> "text/csv"] + } describe "Canonical location" $ do it "Sets Content-Location with alphabetized params" $