Bump minor version, add changelog

Add 'Location' to exposed headers

CHANGELOG.md

@@ -0,0 +1,15 @@
+# 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.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`.

README.md

@@ -20,7 +20,7 @@ your own projects.
 
 ### 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.6.0.tar.xz) / [Linux](http://bin.begriffs.com/dbapi/heroku/postgrest-0.2.6.0.tar.xz)) and invoke like so:
 
 ```bash
 postgrest  --db-host localhost  --db-port 5432     \

app.json

@@ -10,7 +10,7 @@
     },
     "POSTGREST_VER": {
       "description": "Version of PostgREST to deploy",
-      "value": "0.2.5.1"
+      "value": "0.2.6.0"
     },
     "DB_NAME": {
       "description": "Database name",

circle.yml

@@ -4,3 +4,7 @@ machine:
     - createdb -O postgrest_test -U ubuntu postgrest_test
   ghc:
     version: 7.8.3
+test:
+  post:
+    - cabal exec hlint -- -X QuasiQuotes src/*.hs test/**/*.hs
+    - cabal exec packdeps postgrest.cabal

postgrest.cabal

@@ -2,7 +2,7 @@ name:                  postgrest
 description:           Reads the schema of a PostgreSQL database and creates RESTful routes
                        for the tables and views, supporting all HTTP verbs that security
                        permits.
-version:               0.2.5.2
+version:               0.2.6.0
 synopsis:              REST API for any Postgres database
 license:               MIT
 license-file:          LICENSE
@@ -17,8 +17,7 @@ executable postgrest
   main-is:             Main.hs
   ghc-options:         -Wall -W -O2
   default-language:    Haskell2010
-  default-extensions:  OverloadedStrings, ScopedTypeVariables
-  other-extensions:    QuasiQuotes
+  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
   build-depends:       base >=4.6 && <5
                      , hasql == 0.7.*, hasql-backend
                      , hasql-postgres == 0.10.*
@@ -32,12 +31,12 @@ executable postgrest
                      , bytestring, text, split, string-conversions
                      , stringsearch
                      , containers, unordered-containers
-                     , optparse-applicative >= 0.9.1 && < 0.10
+                     , optparse-applicative == 0.11.*
                      , regex-base, regex-tdfa
                      , regex-tdfa-text
                      , Ranged-sets
                      , transformers, MissingH
-                     , bcrypt, base64-string
+                     , bcrypt >= 0.0.6, base64-string
                      , network-uri >= 2.6
                      , resource-pool
                      , blaze-builder
@@ -57,8 +56,7 @@ executable postgrest
 Test-Suite spec
   Type:                exitcode-stdio-1.0
   Default-Language:    Haskell2010
-  default-extensions:  OverloadedStrings, ScopedTypeVariables
-  other-extensions:    QuasiQuotes
+  default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
   Hs-Source-Dirs:      test, src
   ghc-options:         -Wall -W -Werror
   Main-Is:             Main.hs
@@ -75,15 +73,16 @@ Test-Suite spec
                      , SpecHelper
   Build-Depends:       base, hspec >= 2.1.2, QuickCheck
                      , hspec-wai >= 0.5.0, hspec-wai-json
-                     , hasql == 0.7.*, hasql-backend
-                     , hasql-postgres == 0.10.*
-                     , warp >= 3.0.2, wai >= 3.0.1
+                     , hasql, hasql-backend
+                     , hasql-postgres
+                     , warp, wai
+                     , packdeps, hlint
                      , HTTP, convertible
                      , case-insensitive
                      , wai-extra, wai-cors, containers
-                     , wai-middleware-static >= 0.6.0
+                     , wai-middleware-static
                      , http-types, scientific, time
-                     , bytestring, aeson, network >= 2.6
+                     , bytestring, aeson, network
                      , text, optparse-applicative
                      , stringsearch
                      , unordered-containers
@@ -94,7 +93,7 @@ Test-Suite spec
                      , Ranged-sets
                      , transformers, MissingH, split
                      , bcrypt, base64-string
-                     , network-uri >= 2.6
+                     , network-uri
                      , resource-pool
                      , blaze-builder
                      , vector

src/Config.hs

@@ -24,16 +24,16 @@ data AppConfig = AppConfig {
 
 argParser :: Parser AppConfig
 argParser = AppConfig
-  <$> strOption (long "db-name" <> short 'd'                     <> help "name of database")
-  <*> option    (long "db-port" <> short 'P' <> value 5432        <> help "postgres server port")
-  <*> strOption (long "db-user" <> short 'U'                     <> help "postgres authenticator role")
-  <*> strOption (long "db-pass"             <> value ""          <> help "password for authenticator role")
-  <*> strOption (long "db-host" <> short 'h' <> value "localhost" <> help "postgres server hostname")
+  <$> strOption (long "db-name" <> short 'd' <> metavar "NAME" <> help "name of database")
+  <*> option auto (long "db-port" <> short 'P' <> metavar "PORT" <> value 5432 <> help "postgres server port" <> showDefault)
+  <*> strOption (long "db-user" <> short 'U' <> metavar "ROLE" <> help "postgres authenticator role")
+  <*> strOption (long "db-pass" <> metavar "PASS" <> value "" <> help "password for authenticator role")
+  <*> 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")
-  <*> strOption (long "anonymous" <> short 'a' <> help "postgres role to use for non-authenticated requests")
-  <*> 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 "port" <> short 'p' <> metavar "PORT" <> value 3000 <> help "port number on which to run HTTP server" <> showDefault)
+  <*> 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")
+  <*> option auto (long "db-pool" <> metavar "COUNT" <> value 10 <> help "Max connections in database pool" <> showDefault)
 
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing
@@ -45,6 +45,10 @@ corsPolicy req = case lookup "origin" headers of
   Just origin -> Just defaultCorsPolicy {
       corsOrigins = Just ([origin], True)
     , corsRequestHeaders = "Authentication":accHeaders
+    , corsExposedHeaders = Just [
+          "Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
+        , "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
+        ]
     }
   Nothing -> Nothing
   where

src/Main.hs

@@ -24,7 +24,14 @@ import Config (AppConfig(..), argParser, corsPolicy)
 
 main :: IO ()
 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
 
   unless (configSecure conf) $
@@ -59,5 +66,4 @@ main = do
     either (respond . errResponse) respond resOrError
 
   where
-    describe = progDesc "create a REST API to an existing Postgres database"
     prettyVersion = intercalate "." $ map show $ versionBranch version

src/PgQuery.hs

@@ -9,7 +9,7 @@ import qualified Hasql as H
 import qualified Hasql.Postgres as P
 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.Text ()
 import qualified Network.HTTP.Types.URI as Net
@@ -32,12 +32,12 @@ instance Monoid PStmt where
 type StatementT = PStmt -> PStmt
 
 data QualifiedTable = QualifiedTable {
-  qtSchema :: Text
-, qtName   :: Text
+  qtSchema :: T.Text
+, qtName   :: T.Text
 } deriving (Show)
 
 data OrderTerm = OrderTerm {
-  otTerm :: Text
+  otTerm :: T.Text
 , otDirection :: BS.ByteString
 }
 
@@ -106,33 +106,33 @@ returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
 deleteFrom :: QualifiedTable -> PStmt
 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
   ("insert into " <> fromQt t <> " default values returning *") empty True
 insertInto t cols vals = B.Stmt
   ("insert into " <> fromQt t <> " (" <>
-    intercalate ", " (map pgFmtIdent cols) <>
+    T.intercalate ", " (map pgFmtIdent cols) <>
     ") values ("
-    <> intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals)
+    <> T.intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals)
     <> ") returning row_to_json(" <> fromQt t <> ".*)")
   empty True
 
-insertSelect :: QualifiedTable -> [Text] -> [JSON.Value] -> PStmt
+insertSelect :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt
 insertSelect t [] _ = B.Stmt
   ("insert into " <> fromQt t <> " default values returning *") empty True
 insertSelect t cols vals = B.Stmt
   ("insert into " <> fromQt t <> " ("
-    <> intercalate ", " (map pgFmtIdent cols)
+    <> T.intercalate ", " (map pgFmtIdent cols)
     <> ") select "
-    <> intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals))
+    <> T.intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals))
   empty True
 
-update :: QualifiedTable -> [Text] -> [JSON.Value] -> PStmt
+update :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt
 update t cols vals = B.Stmt
   ("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
 
@@ -142,8 +142,11 @@ wherePred (col, predicate) = B.Stmt
   empty True
 
   where
-    opCode:rest = split (=='.') $ cs $ fromMaybe "." predicate
-    value = intercalate "." rest
+    opCode:rest = T.split (=='.') $ cs $ fromMaybe "." predicate
+    unStarredVal = T.intercalate "." rest
+    star c = if c == '*' then '%' else c
+    value = if opCode == "like" || opCode == "ilike"
+              then T.map star unStarredVal else unStarredVal
     op = case opCode of
          "eq"  -> "="
          "gt"  -> ">"
@@ -151,18 +154,20 @@ wherePred (col, predicate) = B.Stmt
          "gte" -> ">="
          "lte" -> "<="
          "neq" -> "<>"
+         "like"-> "like"
+         "ilike"-> "ilike"
          _     -> "="
 
 orderParse :: Net.Query -> [OrderTerm]
 orderParse q =
-  mapMaybe orderParseTerm . split (==',') $ cs order
+  mapMaybe orderParseTerm . T.split (==',') $ cs order
   where
     order = fromMaybe "" $ join (lookup "order" q)
 
-orderParseTerm :: Text -> Maybe OrderTerm
+orderParseTerm :: T.Text -> Maybe OrderTerm
 orderParseTerm s =
-  case split (=='.') s of
-       [d,c] ->
+  case T.split (=='.') s of
+       [c,d] ->
          if d `elem` ["asc", "desc"]
             then Just $ OrderTerm c $
               if d == "asc" then "asc" else "desc"
@@ -175,31 +180,31 @@ commaq  = B.Stmt ", " empty True
 andq :: PStmt
 andq = B.Stmt " and " empty True
 
-pgFmtIdent :: Text -> Text
+pgFmtIdent :: T.Text -> T.Text
 pgFmtIdent x =
-  let escaped = replace "\"" "\"\"" (trimNullChars $ cs x) in
+  let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
   if escaped =~ danger
     then "\"" <> 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 =
   let trimmed = trimNullChars x
-      escaped = "'" <> replace "'" "''" trimmed <> "'"
-      slashed = replace "\\" "\\\\" escaped in
-  cs $ if escaped =~ ("\\\\" :: Text)
+      escaped = "'" <> T.replace "'" "''" trimmed <> "'"
+      slashed = T.replace "\\" "\\\\" escaped in
+  cs $ if escaped =~ ("\\\\" :: T.Text)
     then "E" <> slashed
     else slashed
 
-trimNullChars :: Text -> Text
-trimNullChars = Data.Text.takeWhile (/= '\x0')
+trimNullChars :: T.Text -> T.Text
+trimNullChars = T.takeWhile (/= '\x0')
 
-fromQt :: QualifiedTable -> Text
+fromQt :: QualifiedTable -> T.Text
 fromQt t = pgFmtIdent (qtSchema t) <> "." <> pgFmtIdent (qtName t)
 
-unquoted :: JSON.Value -> Text
+unquoted :: JSON.Value -> T.Text
 unquoted (JSON.String t) = t
 unquoted (JSON.Number n) =
   cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n

test/Feature/AuthSpec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE QuasiQuotes #-}
 module Feature.AuthSpec where
 
 -- {{{ Imports

test/Feature/CorsSpec.hs

@@ -53,6 +53,14 @@ spec = around withApp $ describe "CORS" $ do
         r <- request methodOptions "/" preflightHeaders ""
         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" $
       it "allows INFO body through even with CORS request headers present" $ do
         r <- request methodOptions "/items" normalCors ""

test/Feature/InsertSpec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE QuasiQuotes #-}
 module Feature.InsertSpec where
 
 import Test.Hspec

test/Feature/QuerySpec.hs

@@ -2,39 +2,68 @@ module Feature.QuerySpec where
 
 import Test.Hspec
 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
 
+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 = beforeAll (clearTable "items" >> createItems 15)
-  . afterAll_ (clearTable "items") . around withApp $ do
+spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do
   describe "Querying a nonexistent table" $
     it "causes a 404" $
       get "/faketable" `shouldRespondWith` 404
 
-  describe "Filtering response" $
-    context "column equality" $
+  describe "Filtering response" $ do
+    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" $
-        get "/items?id=eq.5"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "[{\"id\":5}]"
-          , matchStatus  = 200
-          , matchHeaders = ["Content-Range" <:> "0-0/1"]
-          }
+    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
     it "by a column asc" $
-      get "/items?id=lte.2&order=asc.id"
+      get "/items?id=lte.2&order=id.asc"
         `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just "[{\"id\":1},{\"id\":2}]"
+          matchBody    = Just [json| [{"id":1},{"id":2}] |]
         , matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/2"]
         }
     it "by a column desc" $
-      get "/items?id=lte.2&order=desc.id"
+      get "/items?id=lte.2&order=id.desc"
         `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just "[{\"id\":2},{\"id\":1}]"
+          matchBody    = Just [json| [{"id":2},{"id":1}] |]
         , matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/2"]
         }
@@ -52,9 +81,9 @@ spec = beforeAll (clearTable "items" >> createItems 15)
         }
 
     it "Omits question mark when there are no params" $
-      get "/no_pk"
+      get "/simple_pk"
         `shouldRespondWith` ResponseMatcher {
           matchBody    = Just "[]"
         , matchStatus  = 200
-        , matchHeaders = ["Content-Location" <:> "/no_pk"]
+        , matchHeaders = ["Content-Location" <:> "/simple_pk"]
         }

test/Feature/StructureSpec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
 module Feature.StructureSpec where
 
 import Test.Hspec hiding (pendingWith)

test/Main.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE QuasiQuotes #-}
 module Main where
 
 import Test.Hspec

test/SpecHelper.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}
-
 module SpecHelper where
 
 import Network.Wai