Compare commits

...
31 Commits
Author SHA1 Message Date
Joe Nelson 6e6769ea16 Bump version 2015-03-03 23:29:22 -08:00
Joe Nelson 1e417aef90 Note schema override in changelog 2015-03-03 23:20:13 -08:00
Joe Nelson 60eb826cb0 Merge branch 'v1-schema-override'
Affects #155
Affects #158
Fixes #117
2015-03-03 23:18:59 -08:00
Joe Nelson 3d3c7277c7 Allow user to override schema used for v1 of api 2015-03-03 22:29:37 -08:00
Joe Nelson 5be0b5d5ae Return inserted object from POST when Prefer: return=representation
Fixes #27
Fixes #159
2015-03-01 21:42:05 -08:00
Joe Nelson 11e5918690 Merge branch 'select-in'
Fixes #98
Affects #158
2015-03-01 19:18:21 -08:00
Joe Nelson c207e7ee30 Add IN filter to changelog 2015-03-01 18:38:36 -08:00
Joe Nelson 6474a83221 Support IN query param operator 2015-03-01 18:30:08 -08:00
Joe Nelson 9b15071f23 Log requests
Fixes #141
2015-02-28 09:31:00 -08:00
Joe Nelson 51b379d78b Clarify the --secure command line option 2015-02-19 21:28:07 -08:00
Joe Nelson cac5daca01 Merge pull request #154 from brikou/patch-1
Fix URL to video
2015-02-19 10:30:20 -08:00
Brikou CARRE 4bc66c4ca3 Fix URL to video 2015-02-19 10:04:45 +01:00
Joe Nelson eafb1a848f Bump minor version, add changelog 2015-02-18 11:39:13 -08:00
Joe Nelson 328f27e7bd Merge pull request #152 from brikou/expose_location_header
Add 'Location' to exposed headers
2015-02-18 08:41:00 -08:00
Brikou Carré a93e6c050d Add 'Location' to exposed headers 2015-02-18 10:22:24 +01:00
Joe Nelson 337b49f386 Expose Content-Range response header (and others) in CORS
Fixes #148
2015-02-16 19:35:25 -08:00
Joe Nelson 92daa7d11a Merge branch 'like'
Fixes #132
2015-02-15 17:37:40 -08:00
Joe Nelson fa48c86195 Logically simplify (i)like test cases 2015-02-15 17:34:26 -08:00
Joe Nelson b88192f95a Remove lint 2015-02-15 16:31:53 -08:00
Joe Nelson 5a1ae934b9 Put array open bracket nearer to the json 2015-02-15 16:14:25 -08:00
Joe Nelson 58f18181c2 Update order by params to new style introduced from master 2015-02-15 16:13:06 -08:00
Joe Nelson eea1bc0cac Quasiquote json to fix vim syntax highlighting 2015-02-15 16:03:31 -08:00
Joe Nelson e37d5d9b25 Style tweak 2015-02-15 15:59:49 -08:00
Adam C. BakerandJoe Nelson 5cc77709ba Add like/ilike 2015-02-15 15:23:18 -08:00
Joe Nelson 5280b9fd6d Merge pull request #138 from jcristovao/patch-1
order does not work
2015-02-12 08:41:40 -08:00
João Cristóvão 9cb1ced010 Change order test to match docs 2015-02-12 09:44:49 +00:00
João Cristóvão 0a3057e92d Update PgQuery.hs
I'm a bit baffled nobody noticed this before :P

Anyhow, without it order does not work.

Thanks,
Cheers
2015-02-11 19:49:31 +00:00
Joe Nelson 699d6d78dc Bump patch version 2015-02-07 15:27:56 -08:00
Joe Nelson 942ba52f56 Merge branch 'update-deps' 2015-02-07 14:48:26 -08:00
Joe Nelson d77b6df851 Use new optparse-applicative and bcrypt
Fixes #131 and affects #129
2015-02-07 14:21:40 -08:00
Joe Nelson 3662c1d428 Lint and check for restrictive package locks on ci 2015-02-07 13:48:04 -08:00
16 changed files with 202 additions and 97 deletions
+22
View File
@@ -0,0 +1,22 @@
# Change Log
All notable changes to this project will be documented in this file.
This project adheres to [Semantic Versioning](http://semver.org/).
## [0.2.7.0] - 2015-03-03
### Added
- Server response logging
- Filter IN values, e.g. `?col=in.1,2,3`
- Return POSTed resource if header "Prefer: return=representation"
- Allow override of default (v1) schema
## [0.2.6.0] - 2015-02-18
### Added
- A changelog
- Filter by substring match, e.g. `?col=like.*hello*` (or ilike for
case insensitivity).
- Access-Control-Expose-Headers for CORS
### Fixed
- Make filter position match docs, e.g. `?order=col.asc` rather
than `?order=asc.col`.
+9 -4
View File
@@ -9,7 +9,7 @@ PostgREST serves a fully RESTful API from any existing PostgreSQL
database. It provides a cleaner, more standards-compliant, faster database. It provides a cleaner, more standards-compliant, faster
API than you are likely to write from scratch. API than you are likely to write from scratch.
### Demo [postgrest.herokuapp.com](https://postgrest.herokuapp.com) | Watch [Video](https://begriffs.com/posts/2014-12-30-intro-to-postgrest.html) ### Demo [postgrest.herokuapp.com](https://postgrest.herokuapp.com) | Watch [Video](http://begriffs.com/posts/2014-12-30-intro-to-postgrest.html)
Try making requests to the live demo server with an HTTP client Try making requests to the live demo server with an HTTP client
such as [postman](http://www.getpostman.com/). The structure of the such as [postman](http://www.getpostman.com/). The structure of the
@@ -20,16 +20,21 @@ your own projects.
### Usage ### Usage
Download the binary ([OS X](http://bin.begriffs.com/dbapi/osx/postgrest-0.2.5.1.tar.xz) / [Ubuntu](http://bin.begriffs.com/dbapi/heroku/postgrest-0.2.5.1.tar.xz)) and invoke like so: Download the binary ([OS X](http://bin.begriffs.com/dbapi/osx/postgrest-0.2.7.0.tar.xz) / [Linux](http://bin.begriffs.com/dbapi/heroku/postgrest-0.2.7.0.tar.xz)) and invoke like so:
```bash ```bash
postgrest --db-host localhost --db-port 5432 \ postgrest --db-host localhost --db-port 5432 \
--db-name my_db --db-user postgres \ --db-name my_db --db-user postgres \
--db-pass foobar --db-pool 200 \ --db-pass foobar --db-pool 200 \
--anonymous postgres --secure \ --anonymous postgres --port 3000 \
--port 3000 --v1schema public
``` ```
In production include the `--secure` option which redirects all
requests to HTTPS. Note that PostgREST does not handle the SSL
internally and must be put behind another server that does (such
as nginx or the Heroku load balancer).
### Performance ### Performance
TLDR; subsecond response times for up to 2000 requests/sec on Heroku free tier. ([see the load test](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling)) TLDR; subsecond response times for up to 2000 requests/sec on Heroku free tier. ([see the load test](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling))
+1 -1
View File
@@ -10,7 +10,7 @@
}, },
"POSTGREST_VER": { "POSTGREST_VER": {
"description": "Version of PostgREST to deploy", "description": "Version of PostgREST to deploy",
"value": "0.2.5.1" "value": "0.2.7.0"
}, },
"DB_NAME": { "DB_NAME": {
"description": "Database name", "description": "Database name",
+4
View File
@@ -4,3 +4,7 @@ machine:
- createdb -O postgrest_test -U ubuntu postgrest_test - createdb -O postgrest_test -U ubuntu postgrest_test
ghc: ghc:
version: 7.8.3 version: 7.8.3
test:
post:
- cabal exec hlint -- -X QuasiQuotes src/*.hs test/**/*.hs
- cabal exec packdeps postgrest.cabal
+12 -13
View File
@@ -2,7 +2,7 @@ name: postgrest
description: Reads the schema of a PostgreSQL database and creates RESTful routes description: Reads the schema of a PostgreSQL database and creates RESTful routes
for the tables and views, supporting all HTTP verbs that security for the tables and views, supporting all HTTP verbs that security
permits. permits.
version: 0.2.5.2 version: 0.2.7.0
synopsis: REST API for any Postgres database synopsis: REST API for any Postgres database
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
@@ -17,8 +17,7 @@ executable postgrest
main-is: Main.hs main-is: Main.hs
ghc-options: -Wall -W -O2 ghc-options: -Wall -W -O2
default-language: Haskell2010 default-language: Haskell2010
default-extensions: OverloadedStrings, ScopedTypeVariables default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
other-extensions: QuasiQuotes
build-depends: base >=4.6 && <5 build-depends: base >=4.6 && <5
, hasql == 0.7.*, hasql-backend , hasql == 0.7.*, hasql-backend
, hasql-postgres == 0.10.* , hasql-postgres == 0.10.*
@@ -32,12 +31,12 @@ executable postgrest
, bytestring, text, split, string-conversions , bytestring, text, split, string-conversions
, stringsearch , stringsearch
, containers, unordered-containers , containers, unordered-containers
, optparse-applicative >= 0.9.1 && < 0.10 , optparse-applicative == 0.11.*
, regex-base, regex-tdfa , regex-base, regex-tdfa
, regex-tdfa-text , regex-tdfa-text
, Ranged-sets , Ranged-sets
, transformers, MissingH , transformers, MissingH
, bcrypt, base64-string , bcrypt >= 0.0.6, base64-string
, network-uri >= 2.6 , network-uri >= 2.6
, resource-pool , resource-pool
, blaze-builder , blaze-builder
@@ -57,8 +56,7 @@ executable postgrest
Test-Suite spec Test-Suite spec
Type: exitcode-stdio-1.0 Type: exitcode-stdio-1.0
Default-Language: Haskell2010 Default-Language: Haskell2010
default-extensions: OverloadedStrings, ScopedTypeVariables default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
other-extensions: QuasiQuotes
Hs-Source-Dirs: test, src Hs-Source-Dirs: test, src
ghc-options: -Wall -W -Werror ghc-options: -Wall -W -Werror
Main-Is: Main.hs Main-Is: Main.hs
@@ -75,15 +73,16 @@ Test-Suite spec
, SpecHelper , SpecHelper
Build-Depends: base, hspec >= 2.1.2, QuickCheck Build-Depends: base, hspec >= 2.1.2, QuickCheck
, hspec-wai >= 0.5.0, hspec-wai-json , hspec-wai >= 0.5.0, hspec-wai-json
, hasql == 0.7.*, hasql-backend , hasql, hasql-backend
, hasql-postgres == 0.10.* , hasql-postgres
, warp >= 3.0.2, wai >= 3.0.1 , warp, wai
, packdeps, hlint
, HTTP, convertible , HTTP, convertible
, case-insensitive , case-insensitive
, wai-extra, wai-cors, containers , wai-extra, wai-cors, containers
, wai-middleware-static >= 0.6.0 , wai-middleware-static
, http-types, scientific, time , http-types, scientific, time
, bytestring, aeson, network >= 2.6 , bytestring, aeson, network
, text, optparse-applicative , text, optparse-applicative
, stringsearch , stringsearch
, unordered-containers , unordered-containers
@@ -94,7 +93,7 @@ Test-Suite spec
, Ranged-sets , Ranged-sets
, transformers, MissingH, split , transformers, MissingH, split
, bcrypt, base64-string , bcrypt, base64-string
, network-uri >= 2.6 , network-uri
, resource-pool , resource-pool
, blaze-builder , blaze-builder
, vector , vector
+9 -8
View File
@@ -35,8 +35,8 @@ import PgQuery
import RangeQuery import RangeQuery
import PgStructure import PgStructure
app :: BL.ByteString -> Request -> H.Tx P.Postgres s Response app :: Text -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
app reqBody req = app v1schema reqBody req =
case (path, verb) of case (path, verb) of
([], _) -> do ([], _) -> do
body <- encode <$> tables (cs schema) body <- encode <$> tables (cs schema)
@@ -102,6 +102,7 @@ app reqBody req =
handleJsonObj reqBody $ \obj -> do handleJsonObj reqBody $ \obj -> do
let qt = QualifiedTable schema (cs table) let qt = QualifiedTable schema (cs table)
query = insertInto qt (map cs $ keys obj) (elems obj) query = insertInto qt (map cs $ keys obj) (elems obj)
echoRequested = lookup "Prefer" hdrs == Just "return=representation"
row <- H.maybeEx query row <- H.maybeEx query
let (Identity insertedJson) = fromMaybe (Identity "{}" :: Identity Text) row let (Identity insertedJson) = fromMaybe (Identity "{}" :: Identity Text) row
Just inserted = decode (cs insertedJson) :: Maybe Object Just inserted = decode (cs insertedJson) :: Maybe Object
@@ -116,7 +117,7 @@ app reqBody req =
return $ responseLBS status201 return $ responseLBS status201
[ jsonH [ jsonH
, (hLocation, "/" <> cs table <> "?" <> cs params) , (hLocation, "/" <> cs table <> "?" <> cs params)
] "" ] $ if echoRequested then cs insertedJson else ""
([table], "PUT") -> ([table], "PUT") ->
handleJsonObj reqBody $ \obj -> do handleJsonObj reqBody $ \obj -> do
@@ -170,7 +171,7 @@ app reqBody req =
verb = requestMethod req verb = requestMethod req
qq = queryString req qq = queryString req
hdrs = requestHeaders req hdrs = requestHeaders req
schema = requestedSchema hdrs schema = requestedSchema v1schema hdrs
range = rangeRequested hdrs range = rangeRequested hdrs
allOrigins = ("Access-Control-Allow-Origin", "*") :: Header allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
@@ -196,11 +197,11 @@ contentRangeH from to total =
<> cs (show total) <> cs (show total)
) )
requestedSchema :: RequestHeaders -> Text requestedSchema :: Text -> RequestHeaders -> Text
requestedSchema hdrs = requestedSchema v1schema hdrs =
case verStr of case verStr of
Just [[_, ver]] -> ver Just [[_, ver]] -> if ver == "1" then v1schema else ver
_ -> "1" _ -> v1schema
where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String
accept = cs <$> lookup hAccept hdrs :: Maybe Text accept = cs <$> lookup hAccept hdrs :: Maybe Text
+15 -9
View File
@@ -20,20 +20,22 @@ data AppConfig = AppConfig {
, configAnonRole :: String , configAnonRole :: String
, configSecure :: Bool , configSecure :: Bool
, configPool :: Int , configPool :: Int
, configV1Schema :: String
} }
argParser :: Parser AppConfig argParser :: Parser AppConfig
argParser = AppConfig argParser = AppConfig
<$> strOption (long "db-name" <> short 'd' <> help "name of database") <$> strOption (long "db-name" <> short 'd' <> metavar "NAME" <> help "name of database")
<*> option (long "db-port" <> short 'P' <> value 5432 <> help "postgres server port") <*> option auto (long "db-port" <> short 'P' <> metavar "PORT" <> value 5432 <> help "postgres server port" <> showDefault)
<*> strOption (long "db-user" <> short 'U' <> help "postgres authenticator role") <*> strOption (long "db-user" <> short 'U' <> metavar "ROLE" <> help "postgres authenticator role")
<*> strOption (long "db-pass" <> value "" <> help "password for authenticator role") <*> strOption (long "db-pass" <> metavar "PASS" <> value "" <> help "password for authenticator role")
<*> strOption (long "db-host" <> short 'h' <> value "localhost" <> help "postgres server hostname") <*> strOption (long "db-host" <> metavar "HOST" <> value "localhost" <> help "postgres server hostname" <> showDefault)
<*> option (long "port" <> short 'p' <> value 3000 <> help "port number on which to run HTTP server") <*> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 3000 <> help "port number on which to run HTTP server" <> showDefault)
<*> strOption (long "anonymous" <> short 'a' <> help "postgres role to use for non-authenticated requests") <*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE" <> help "postgres role to use for non-authenticated requests")
<*> switch (long "secure" <> short 's' <> help "Redirect all requests to HTTPS") <*> switch (long "secure" <> short 's' <> help "Redirect all requests to HTTPS")
<*> option (long "db-pool" <> value 10 <> help "Max connections in database pool") <*> option auto (long "db-pool" <> metavar "COUNT" <> value 10 <> help "Max connections in database pool" <> showDefault)
<*> strOption (long "v1schema" <> metavar "NAME" <> value "1" <> help "Schema to use for nonspecified version (or explicit v1)" <> showDefault)
defaultCorsPolicy :: CorsResourcePolicy defaultCorsPolicy :: CorsResourcePolicy
defaultCorsPolicy = CorsResourcePolicy Nothing defaultCorsPolicy = CorsResourcePolicy Nothing
@@ -45,6 +47,10 @@ corsPolicy req = case lookup "origin" headers of
Just origin -> Just defaultCorsPolicy { Just origin -> Just defaultCorsPolicy {
corsOrigins = Just ([origin], True) corsOrigins = Just ([origin], True)
, corsRequestHeaders = "Authentication":accHeaders , corsRequestHeaders = "Authentication":accHeaders
, corsExposedHeaders = Just [
"Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
, "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
]
} }
Nothing -> Nothing Nothing -> Nothing
where where
+12 -5
View File
@@ -14,6 +14,7 @@ import Network.Wai.Middleware.Cors (cors)
import Network.Wai.Handler.Warp hiding (Connection) import Network.Wai.Handler.Warp hiding (Connection)
import Network.Wai.Middleware.Gzip (gzip, def) import Network.Wai.Middleware.Gzip (gzip, def)
import Network.Wai.Middleware.Static (staticPolicy, only) import Network.Wai.Middleware.Static (staticPolicy, only)
import Network.Wai.Middleware.RequestLogger (logStdout)
import Data.List (intercalate) import Data.List (intercalate)
import Data.Version (versionBranch) import Data.Version (versionBranch)
import qualified Hasql as H import qualified Hasql as H
@@ -24,7 +25,14 @@ import Config (AppConfig(..), argParser, corsPolicy)
main :: IO () main :: IO ()
main = do main = do
conf <- execParser (info (helper <*> argParser) describe) let opts = info (helper <*> argParser) $
fullDesc
<> progDesc (
"PostgREST "
<> prettyVersion
<> " / create a REST API to an existing Postgres database"
)
conf <- execParser opts
let port = configPort conf let port = configPort conf
unless (configSecure conf) $ unless (configSecure conf) $
@@ -40,8 +48,8 @@ main = do
appSettings = setPort port appSettings = setPort port
. setServerName (cs $ "postgrest/" <> prettyVersion) . setServerName (cs $ "postgrest/" <> prettyVersion)
$ defaultSettings $ defaultSettings
middle = middle = logStdout
(if configSecure conf then redirectInsecure else id) . (if configSecure conf then redirectInsecure else id)
. gzip def . cors corsPolicy . gzip def . cors corsPolicy
. staticPolicy (only [("favicon.ico", "static/favicon.ico")]) . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
anonRole = cs $ configAnonRole conf anonRole = cs $ configAnonRole conf
@@ -55,9 +63,8 @@ main = do
runSettings appSettings $ middle $ \req respond -> do runSettings appSettings $ middle $ \req respond -> do
body <- strictRequestBody req body <- strictRequestBody req
resOrError <- liftIO $ H.session pool $ H.tx Nothing $ resOrError <- liftIO $ H.session pool $ H.tx Nothing $
authenticated currRole anonRole (app body) req authenticated currRole anonRole (app (cs $ configV1Schema conf) body) req
either (respond . errResponse) respond resOrError either (respond . errResponse) respond resOrError
where where
describe = progDesc "create a REST API to an existing Postgres database"
prettyVersion = intercalate "." $ map show $ versionBranch version prettyVersion = intercalate "." $ map show $ versionBranch version
+44 -31
View File
@@ -9,7 +9,7 @@ import qualified Hasql as H
import qualified Hasql.Postgres as P import qualified Hasql.Postgres as P
import qualified Hasql.Backend as B import qualified Hasql.Backend as B
import Data.Text hiding (map, empty) import qualified Data.Text as T
import Text.Regex.TDFA ( (=~) ) import Text.Regex.TDFA ( (=~) )
import Text.Regex.TDFA.Text () import Text.Regex.TDFA.Text ()
import qualified Network.HTTP.Types.URI as Net import qualified Network.HTTP.Types.URI as Net
@@ -32,12 +32,12 @@ instance Monoid PStmt where
type StatementT = PStmt -> PStmt type StatementT = PStmt -> PStmt
data QualifiedTable = QualifiedTable { data QualifiedTable = QualifiedTable {
qtSchema :: Text qtSchema :: T.Text
, qtName :: Text , qtName :: T.Text
} deriving (Show) } deriving (Show)
data OrderTerm = OrderTerm { data OrderTerm = OrderTerm {
otTerm :: Text otTerm :: T.Text
, otDirection :: BS.ByteString , otDirection :: BS.ByteString
} }
@@ -106,44 +106,54 @@ returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
deleteFrom :: QualifiedTable -> PStmt deleteFrom :: QualifiedTable -> PStmt
deleteFrom t = B.Stmt ("delete from " <> fromQt t) empty True deleteFrom t = B.Stmt ("delete from " <> fromQt t) empty True
insertInto :: QualifiedTable -> [Text] -> [JSON.Value] -> PStmt insertInto :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt
insertInto t [] _ = B.Stmt insertInto t [] _ = B.Stmt
("insert into " <> fromQt t <> " default values returning *") empty True ("insert into " <> fromQt t <> " default values returning *") empty True
insertInto t cols vals = B.Stmt insertInto t cols vals = B.Stmt
("insert into " <> fromQt t <> " (" <> ("insert into " <> fromQt t <> " (" <>
intercalate ", " (map pgFmtIdent cols) <> T.intercalate ", " (map pgFmtIdent cols) <>
") values (" ") values ("
<> intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals) <> T.intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals)
<> ") returning row_to_json(" <> fromQt t <> ".*)") <> ") returning row_to_json(" <> fromQt t <> ".*)")
empty True empty True
insertSelect :: QualifiedTable -> [Text] -> [JSON.Value] -> PStmt insertSelect :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt
insertSelect t [] _ = B.Stmt insertSelect t [] _ = B.Stmt
("insert into " <> fromQt t <> " default values returning *") empty True ("insert into " <> fromQt t <> " default values returning *") empty True
insertSelect t cols vals = B.Stmt insertSelect t cols vals = B.Stmt
("insert into " <> fromQt t <> " (" ("insert into " <> fromQt t <> " ("
<> intercalate ", " (map pgFmtIdent cols) <> T.intercalate ", " (map pgFmtIdent cols)
<> ") select " <> ") select "
<> intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals)) <> T.intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals))
empty True empty True
update :: QualifiedTable -> [Text] -> [JSON.Value] -> PStmt update :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt
update t cols vals = B.Stmt update t cols vals = B.Stmt
("update " <> fromQt t <> " set (" ("update " <> fromQt t <> " set ("
<> intercalate ", " (map pgFmtIdent cols) <> T.intercalate ", " (map pgFmtIdent cols)
<> ") = (" <> ") = ("
<> intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals) <> T.intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals)
<> ")") <> ")")
empty True empty True
wherePred :: Net.QueryItem -> PStmt wherePred :: Net.QueryItem -> PStmt
wherePred (col, predicate) = B.Stmt wherePred (col, predicate) = B.Stmt
(" " <> cs (pgFmtIdent $ cs col) <> " " <> op <> " " <> cs (pgFmtLit value) <> "::unknown ") (" " <> cs (pgFmtIdent $ cs col) <> " " <> op <> " " <> cs sqlValue)
empty True empty True
where where
opCode:rest = split (=='.') $ cs $ fromMaybe "." predicate opCode:rest = T.split (=='.') $ cs $ fromMaybe "." predicate
value = intercalate "." rest value = T.intercalate "." rest
star c = if c == '*' then '%' else c
unknownLiteral = (<> "::unknown ") . pgFmtLit
sqlValue = case opCode of
"like" -> unknownLiteral $ T.map star value
"ilike" -> unknownLiteral $ T.map star value
"in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") "
_ -> unknownLiteral value
op = case opCode of op = case opCode of
"eq" -> "=" "eq" -> "="
"gt" -> ">" "gt" -> ">"
@@ -151,18 +161,21 @@ wherePred (col, predicate) = B.Stmt
"gte" -> ">=" "gte" -> ">="
"lte" -> "<=" "lte" -> "<="
"neq" -> "<>" "neq" -> "<>"
"like"-> "like"
"ilike"-> "ilike"
"in" -> "in"
_ -> "=" _ -> "="
orderParse :: Net.Query -> [OrderTerm] orderParse :: Net.Query -> [OrderTerm]
orderParse q = orderParse q =
mapMaybe orderParseTerm . split (==',') $ cs order mapMaybe orderParseTerm . T.split (==',') $ cs order
where where
order = fromMaybe "" $ join (lookup "order" q) order = fromMaybe "" $ join (lookup "order" q)
orderParseTerm :: Text -> Maybe OrderTerm orderParseTerm :: T.Text -> Maybe OrderTerm
orderParseTerm s = orderParseTerm s =
case split (=='.') s of case T.split (=='.') s of
[d,c] -> [c,d] ->
if d `elem` ["asc", "desc"] if d `elem` ["asc", "desc"]
then Just $ OrderTerm c $ then Just $ OrderTerm c $
if d == "asc" then "asc" else "desc" if d == "asc" then "asc" else "desc"
@@ -175,31 +188,31 @@ commaq = B.Stmt ", " empty True
andq :: PStmt andq :: PStmt
andq = B.Stmt " and " empty True andq = B.Stmt " and " empty True
pgFmtIdent :: Text -> Text pgFmtIdent :: T.Text -> T.Text
pgFmtIdent x = pgFmtIdent x =
let escaped = replace "\"" "\"\"" (trimNullChars $ cs x) in let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
if escaped =~ danger if escaped =~ danger
then "\"" <> escaped <> "\"" then "\"" <> escaped <> "\""
else escaped else escaped
where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: Text where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: T.Text
pgFmtLit :: Text -> Text pgFmtLit :: T.Text -> T.Text
pgFmtLit x = pgFmtLit x =
let trimmed = trimNullChars x let trimmed = trimNullChars x
escaped = "'" <> replace "'" "''" trimmed <> "'" escaped = "'" <> T.replace "'" "''" trimmed <> "'"
slashed = replace "\\" "\\\\" escaped in slashed = T.replace "\\" "\\\\" escaped in
cs $ if escaped =~ ("\\\\" :: Text) cs $ if escaped =~ ("\\\\" :: T.Text)
then "E" <> slashed then "E" <> slashed
else slashed else slashed
trimNullChars :: Text -> Text trimNullChars :: T.Text -> T.Text
trimNullChars = Data.Text.takeWhile (/= '\x0') trimNullChars = T.takeWhile (/= '\x0')
fromQt :: QualifiedTable -> Text fromQt :: QualifiedTable -> T.Text
fromQt t = pgFmtIdent (qtSchema t) <> "." <> pgFmtIdent (qtName t) fromQt t = pgFmtIdent (qtSchema t) <> "." <> pgFmtIdent (qtName t)
unquoted :: JSON.Value -> Text unquoted :: JSON.Value -> T.Text
unquoted (JSON.String t) = t unquoted (JSON.String t) = t
unquoted (JSON.Number n) = unquoted (JSON.Number n) =
cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
-1
View File
@@ -1,4 +1,3 @@
{-# LANGUAGE QuasiQuotes #-}
module Feature.AuthSpec where module Feature.AuthSpec where
-- {{{ Imports -- {{{ Imports
+8
View File
@@ -53,6 +53,14 @@ spec = around withApp $ describe "CORS" $ do
r <- request methodOptions "/" preflightHeaders "" r <- request methodOptions "/" preflightHeaders ""
liftIO $ simpleBody r `shouldBe` "" liftIO $ simpleBody r `shouldBe` ""
describe "regular request" $
it "exposes necesssary response headers" $ do
r <- request methodGet "/items" [("Origin", "http://example.com")] ""
liftIO $ simpleHeaders r `shouldSatisfy` matchHeader
"Access-Control-Expose-Headers"
"Content-Encoding, Content-Location, Content-Range, Content-Type, \
\Date, Location, Server, Transfer-Encoding, Range-Unit"
describe "postflight request" $ describe "postflight request" $
it "allows INFO body through even with CORS request headers present" $ do it "allows INFO body through even with CORS request headers present" $ do
r <- request methodOptions "/items" normalCors "" r <- request methodOptions "/items" normalCors ""
+10 -2
View File
@@ -1,4 +1,3 @@
{-# LANGUAGE QuasiQuotes #-}
module Feature.InsertSpec where module Feature.InsertSpec where
import Test.Hspec import Test.Hspec
@@ -50,7 +49,7 @@ spec = afterAll_ resetDb $ around withApp $ do
post "/simple_pk" [json| { "extra":"foo"} |] post "/simple_pk" [json| { "extra":"foo"} |]
`shouldRespondWith` 400 `shouldRespondWith` 400
context "into a table with no pk" . after_ (clearTable "no_pk") $ context "into a table with no pk" . after_ (clearTable "no_pk") $ do
it "succeeds with 201 and a link including all fields" $ do it "succeeds with 201 and a link including all fields" $ do
p <- post "/no_pk" [json| { "a":"foo", "b":"bar" } |] p <- post "/no_pk" [json| { "a":"foo", "b":"bar" } |]
liftIO $ do liftIO $ do
@@ -58,6 +57,15 @@ spec = afterAll_ resetDb $ around withApp $ do
simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.foo&b=eq.bar" simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.foo&b=eq.bar"
simpleStatus p `shouldBe` created201 simpleStatus p `shouldBe` created201
it "returns full details of inserted record if asked" $ do
p <- request methodPost "/no_pk"
[("Prefer", "return=representation")]
[json| { "a":"bar", "b":"baz" } |]
liftIO $ do
simpleBody p `shouldBe` [json| { "a":"bar", "b":"baz" } |]
simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.bar&b=eq.baz"
simpleStatus p `shouldBe` created201
context "with compound pk supplied" . after_ (clearTable "compound_pk") $ context "with compound pk supplied" . after_ (clearTable "compound_pk") $
it "builds response location header appropriately" $ it "builds response location header appropriately" $
post "/compound_pk" [json| { "k1":12, "k2":42 } |] post "/compound_pk" [json| { "k1":12, "k2":42 } |]
+54 -17
View File
@@ -2,39 +2,76 @@ module Feature.QuerySpec where
import Test.Hspec import Test.Hspec
import Test.Hspec.Wai import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Hasql as H
import Hasql.Postgres as H
import Control.Monad (void)
import Data.Text(Text)
import SpecHelper import SpecHelper
testSet :: IO ()
testSet = do
clearTable "items" >> clearTable "no_pk"
createItems 15
pool <- H.acquirePool pgSettings testPoolOpts
void . liftIO $ H.session pool $ H.tx Nothing $ do
H.unitEx $ insertNoPk "xyyx" "u"
H.unitEx $ insertNoPk "xYYx" "v"
where
insertNoPk :: Text -> Text -> H.Stmt H.Postgres
insertNoPk = [H.stmt|insert into "1".no_pk (a, b) values (?,?)|]
spec :: Spec spec :: Spec
spec = beforeAll (clearTable "items" >> createItems 15) spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do
. afterAll_ (clearTable "items") . around withApp $ do
describe "Querying a nonexistent table" $ describe "Querying a nonexistent table" $
it "causes a 404" $ it "causes a 404" $
get "/faketable" `shouldRespondWith` 404 get "/faketable" `shouldRespondWith` 404
describe "Filtering response" $ describe "Filtering response" $ do
context "column equality" $ it "matches with equality" $
get "/items?id=eq.5"
`shouldRespondWith` ResponseMatcher {
matchBody = Just [json| [{"id":5}] |]
, matchStatus = 200
, matchHeaders = ["Content-Range" <:> "0-0/1"]
}
it "matches the predicate" $ it "matches items IN" $
get "/items?id=eq.5" get "/items?id=in.1,3,5"
`shouldRespondWith` ResponseMatcher { `shouldRespondWith` ResponseMatcher {
matchBody = Just "[{\"id\":5}]" matchBody = Just [json| [{"id":1},{"id":3},{"id":5}] |]
, matchStatus = 200 , matchStatus = 200
, matchHeaders = ["Content-Range" <:> "0-0/1"] , matchHeaders = ["Content-Range" <:> "0-2/3"]
} }
it "matches with like" $ do
get "/no_pk?a=like.*yx" `shouldRespondWith` [json|
[{"a":"xyyx","b":"u"}]|]
get "/no_pk?a=like.xy*" `shouldRespondWith` [json|
[{"a":"xyyx","b":"u"}]|]
get "/no_pk?a=like.*YY*" `shouldRespondWith` [json|
[{"a":"xYYx","b":"v"}]|]
it "matches with ilike" $ do
get "/no_pk?a=ilike.xy*&order=b.asc" `shouldRespondWith` [json|
[{"a":"xyyx","b":"u"},{"a":"xYYx","b":"v"}]|]
get "/no_pk?a=ilike.*YY*&order=b.asc" `shouldRespondWith` [json|
[{"a":"xyyx","b":"u"},{"a":"xYYx","b":"v"}]|]
describe "ordering response" $ do describe "ordering response" $ do
it "by a column asc" $ it "by a column asc" $
get "/items?id=lte.2&order=asc.id" get "/items?id=lte.2&order=id.asc"
`shouldRespondWith` ResponseMatcher { `shouldRespondWith` ResponseMatcher {
matchBody = Just "[{\"id\":1},{\"id\":2}]" matchBody = Just [json| [{"id":1},{"id":2}] |]
, matchStatus = 200 , matchStatus = 200
, matchHeaders = ["Content-Range" <:> "0-1/2"] , matchHeaders = ["Content-Range" <:> "0-1/2"]
} }
it "by a column desc" $ it "by a column desc" $
get "/items?id=lte.2&order=desc.id" get "/items?id=lte.2&order=id.desc"
`shouldRespondWith` ResponseMatcher { `shouldRespondWith` ResponseMatcher {
matchBody = Just "[{\"id\":2},{\"id\":1}]" matchBody = Just [json| [{"id":2},{"id":1}] |]
, matchStatus = 200 , matchStatus = 200
, matchHeaders = ["Content-Range" <:> "0-1/2"] , matchHeaders = ["Content-Range" <:> "0-1/2"]
} }
@@ -52,9 +89,9 @@ spec = beforeAll (clearTable "items" >> createItems 15)
} }
it "Omits question mark when there are no params" $ it "Omits question mark when there are no params" $
get "/no_pk" get "/simple_pk"
`shouldRespondWith` ResponseMatcher { `shouldRespondWith` ResponseMatcher {
matchBody = Just "[]" matchBody = Just "[]"
, matchStatus = 200 , matchStatus = 200
, matchHeaders = ["Content-Location" <:> "/no_pk"] , matchHeaders = ["Content-Location" <:> "/simple_pk"]
} }
-1
View File
@@ -1,4 +1,3 @@
{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
module Feature.StructureSpec where module Feature.StructureSpec where
import Test.Hspec hiding (pendingWith) import Test.Hspec hiding (pendingWith)
-1
View File
@@ -1,4 +1,3 @@
{-# LANGUAGE QuasiQuotes #-}
module Main where module Main where
import Test.Hspec import Test.Hspec
+2 -4
View File
@@ -1,5 +1,3 @@
{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}
module SpecHelper where module SpecHelper where
import Network.Wai import Network.Wai
@@ -37,7 +35,7 @@ isLeft (Left _ ) = True
isLeft _ = False isLeft _ = False
cfg :: AppConfig cfg :: AppConfig
cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10 cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10 "1"
testPoolOpts :: PoolSettings testPoolOpts :: PoolSettings
testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30 testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30
@@ -59,7 +57,7 @@ withApp perform = do
perform $ middle $ \req resp -> do perform $ middle $ \req resp -> do
body <- strictRequestBody req body <- strictRequestBody req
result <- liftIO $ H.session pool $ H.tx Nothing result <- liftIO $ H.session pool $ H.tx Nothing
$ authenticated currRole anonRole (app body) req $ authenticated currRole anonRole (app (cs $ configV1Schema cfg) body) req
either (resp . errResponse) resp result either (resp . errResponse) resp result
where middle = cors corsPolicy where middle = cors corsPolicy