Skip to content

Commit

Permalink
support dash in column names fix #462
Browse files Browse the repository at this point in the history
  • Loading branch information
Ruslan Talpa committed May 11, 2016
1 parent 0dc33db commit cacc725
Show file tree
Hide file tree
Showing 5 changed files with 60 additions and 33 deletions.
2 changes: 2 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
64 changes: 36 additions & 28 deletions src/PostgREST/App.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)

Expand Down Expand Up @@ -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)
Expand All @@ -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",
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
18 changes: 15 additions & 3 deletions src/PostgREST/Parsers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
6 changes: 5 additions & 1 deletion test/Feature/QuerySpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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`
Expand Down
3 changes: 2 additions & 1 deletion test/fixtures/schema.sql
Original file line number Diff line number Diff line change
Expand Up @@ -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
);


Expand Down

0 comments on commit cacc725

Please sign in to comment.