diff --git a/CHANGELOG.md b/CHANGELOG.md index a339beed42..bd05825c95 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,8 +8,10 @@ This project adheres to [Semantic Versioning](http://semver.org/). ### Added - Reload database schema on SIGHUP - @begriffs +- Support "-" in column names - @ruslantalpa ### Fixed +- Set transaction mode to READ when possible to support connecting to read replicas - @ruslantalpa - Omit Content-Type header for empty body - @begriffs - Prevent role from being changed twice - @begriffs diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 422eb52c35..54156f53ba 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -7,10 +7,12 @@ module PostgREST.App ( ) where import Control.Applicative +import Control.Arrow ((***)) +import Control.Monad (join) import Data.Bifunctor (first) -import Data.IORef (IORef, readIORef) -import Data.List (find, delete) +import Data.List (find, sortBy, delete) import Data.Maybe (isJust, fromMaybe, fromJust, mapMaybe) +import Data.Ord (comparing) import Data.Ranged.Ranges (emptyRange) import Data.String.Conversions (cs) import Data.Text (Text, replace, strip) @@ -22,8 +24,10 @@ import qualified Hasql.Transaction as HT import Text.Parsec.Error import Text.ParserCombinators.Parsec (parse) +import Network.HTTP.Base (urlEncodeVars) import Network.HTTP.Types.Header import Network.HTTP.Types.Status +import Network.HTTP.Types.URI (parseSimpleQuery) import Network.Wai import Network.Wai.Middleware.RequestLogger (logStdout) @@ -60,31 +64,29 @@ import PostgREST.Types import Prelude -postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> Application -postgrest conf refDbStructure pool = +transactionMode :: Action -> H.Mode +transactionMode ActionRead = HT.Read +transactionMode ActionInfo = HT.Read +transactionMode _ = HT.Write + +postgrest :: AppConfig -> DbStructure -> P.Pool -> Application +postgrest conf dbStructure pool = let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in middle $ \ req respond -> do time <- getPOSIXTime body <- strictRequestBody req - dbStructure <- readIORef refDbStructure let schema = cs $ configSchema conf apiRequest = userApiRequest schema req body - handleReq = runWithClaims conf time (app dbStructure conf) apiRequest - txMode = transactionMode $ iAction apiRequest + handleReq = runWithClaims conf time (app dbStructure conf apiRequest) req resp <- either pgErrResponse id <$> P.use pool - (HT.run handleReq HT.ReadCommitted txMode) + (HT.run handleReq HT.ReadCommitted (transactionMode $ iAction apiRequest)) respond resp -transactionMode :: Action -> H.Mode -transactionMode ActionRead = HT.Read -transactionMode ActionInfo = HT.Read -transactionMode _ = HT.Write - -app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response -app dbStructure conf apiRequest = +app :: DbStructure -> AppConfig -> ApiRequest -> Request -> H.Transaction Response +app dbStructure conf apiRequest req = let -- TODO: blow up for Left values (there is a middleware that checks the headers) contentType = either (const ApplicationJSON) id (iAccepts apiRequest) @@ -108,7 +110,11 @@ app dbStructure conf apiRequest = else responseLBS status200 [contentTypeH] (cs body) else do let (status, contentRange) = rangeHeader queryTotal tableTotal - canonical = iCanonicalQS apiRequest + canonical = urlEncodeVars -- should this be moved to the dbStructure (location)? + . sortBy (comparing fst) + . map (join (***) cs) + . parseSimpleQuery + $ rawQueryString req return $ responseLBS status [contentTypeH, contentRange, ("Content-Location", @@ -127,14 +133,12 @@ app dbStructure conf apiRequest = let stm = createWriteStatement qi sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == TextCSV) payload row <- H.query uniform stm let (_, _, location, body) = extractQueryResult row - - return $ if iPreferRepresentation apiRequest == Full - then responseLBS status201 [ - contentTypeH, - (hLocation, "/" <> cs table <> "?" <> cs location) - ] (cs body) - else responseLBS status201 - [(hLocation, "/" <> cs table <> "?" <> cs location)] "" + return $ responseLBS status201 + [ + contentTypeH, + (hLocation, "/" <> cs table <> "?" <> cs location) + ] + $ if iPreferRepresentation apiRequest == Full then cs body else "" (ActionUpdate, TargetIdent qi, Just payload@(PayloadJSON uniform)) -> case mutateSqlParts of @@ -147,9 +151,8 @@ app dbStructure conf apiRequest = s = case () of _ | queryTotal == 0 -> status404 | iPreferRepresentation apiRequest == Full -> status200 | otherwise -> status204 - return $ if iPreferRepresentation apiRequest == Full - then responseLBS s [contentTypeH, r] (cs body) - else responseLBS s [r] "" + return $ responseLBS s [contentTypeH, r] + $ if iPreferRepresentation apiRequest == Full then cs body else "" (ActionDelete, TargetIdent qi, Nothing) -> case mutateSqlParts of @@ -333,11 +336,16 @@ addFilter (path, flt) (Node rn forest) = where targetNodeName:remainingPath = path (targetNode,restForest) = splitForest targetNodeName forest + splitForest :: NodeName -> Forest ReadNode -> (Maybe ReadRequest, Forest ReadNode) splitForest name forst = case maybeNode of Nothing -> (Nothing,forest) Just node -> (Just node, delete node forest) - where maybeNode = find ((name==).fst.snd.rootLabel) forst + where + maybeNode :: Maybe ReadRequest + maybeNode = find fnd forst + where + fnd :: ReadRequest -> Bool -- in a relation where one of the tables mathces "TableName" -- replace the name to that table with pg_source diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs index 391e38647f..a887675fd1 100644 --- a/src/PostgREST/Parsers.hs +++ b/src/PostgREST/Parsers.hs @@ -6,7 +6,7 @@ where import Control.Applicative hiding ((<$>)) import Data.Monoid import Data.String.Conversions (cs) -import Data.Text (Text) +import Data.Text (Text, intercalate) import Data.Tree import PostgREST.QueryBuilder (operators) import PostgREST.Types @@ -57,9 +57,21 @@ pFieldTree = try (Node <$> pSelect <*> between (char '{') (char '}') pFieldFores pStar :: Parser Text pStar = cs <$> (string "*" *> pure ("*"::String)) + + pFieldName :: Parser Text -pFieldName = cs <$> (many1 (letter <|> digit <|> oneOf "_") - "field name (* or [a..z0..9_])") +pFieldName = do + matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) "field name (* or [a..z0..9_])" + return $ intercalate "-" $ map cs matches + where + isDash :: GenParser Char st () + isDash = try (do{ + _ <- char '-' + ; notFollowedBy (char '>') + }) + dash :: Parser Char + dash = isDash *> pure '-' + pJsonPathStep :: Parser Text pJsonPathStep = cs <$> try (string "->" *> pFieldName) diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index f450f7b062..12364b4e60 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -143,7 +143,11 @@ spec = do it "selectStar works in absense of parameter" $ get "/complex_items?id=eq.3" `shouldRespondWith` - [str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3]}]|] + [str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3],"field-with_sep":1}]|] + + it "dash `-` in column names is accepted" $ + get "/complex_items?id=eq.3&select=id,field-with_sep" `shouldRespondWith` + [str|[{"id":3,"field-with_sep":1}]|] it "one simple column" $ get "/complex_items?select=id" `shouldRespondWith` diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index b627759dd4..3214f4fde1 100755 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -432,7 +432,8 @@ CREATE TABLE complex_items ( id bigint NOT NULL, name text, settings pg_catalog.json, - arr_data integer[] + arr_data integer[], + "field-with_sep" integer default 1 not null );