Add support for DELETE verb

Fixes #125

README.md

@@ -6,16 +6,18 @@ PostgREST serves a fully RESTful API from any existing PostgreSQL
 database. It provides a cleaner, more standards-compliant, faster
 API than you are likely to write from scratch.
 
-### Demo
+### Demo [postgrest.herokuapp.com](https://postgrest.herokuapp.com) | Watch [Video](https://begriffs.com/posts/2014-12-30-intro-to-postgrest.html)
 
-Try making requests to the live [demo server] with an HTTP client
-such as [postman](http://www.getpostman.com/).
-
-[video placeholder]
+Try making requests to the live demo server with an HTTP client
+such as [postman](http://www.getpostman.com/). The structure of the
+demo database is defined by
+[begriffs/postgrest-example](https://github.com/begriffs/postgrest-example).
+You can use it as inspiration for test-driven server migrations in
+your own projects.
 
 ### Usage
 
-Download [binaries for your platform] and invoke the program like so:
+Download the binary ([OS X](http://bin.begriffs.com/dbapi/osx/postgrest-0.2.5.0.tar.xz) /  [Ubuntu](http://bin.begriffs.com/dbapi/heroku/postgrest-0.2.5.0.tar.xz)) and invoke like so:
 
 ```bash
 postgrest  --db-host localhost  --db-port 5432     \
@@ -25,32 +27,13 @@ postgrest  --db-host localhost  --db-port 5432     \
            --port 3000
 ```
 
-### Security
-
-PostgREST handles authentication (HTTP Basic over SSL) and delegates
-authorization to the role information defined in the database. This
-ensures there is a single declarative source of truth for security.
-When dealing with the database the server assumes the identity of
-the currently authenticated user, and for the duration of the
-connection cannot do anything the user themselves couldn't.
-
-Postgres 9.5 will soon support true [row-level
-security](http://michael.otacoo.com/postgresql-2/postgres-9-5-feature-highlight-row-level-security/).
-In the meantime what isn't yet implemented can be simulated with
-triggers and security-barrier views. Because the possible queries
-to the database are limited to certain templates using
-[leakproof](http://blog.2ndquadrant.com/how-do-postgresql-security_barrier-views-work/)
-functions, the trigger workaround does not compromise row-level
-security.
-
-For example security patterns see the [security
-guide](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions).
-
 ### 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))
+
 If you're used to servers written in interpreted languages (or named
 after precious gems), prepare to be pleasantly surprised by PostgREST
-performance. ([see the load test](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling))
+performance.
 
 Three factors contribute to the speed. First the server is written
 in [Haskell](https://new-www.haskell.org/) using the
@@ -82,6 +65,27 @@ the [performance guide](https://github.com/begriffs/postgrest/wiki/Performance-a
 Other optimizations are possible, and some are outlined in the
 [Future Features](#future-features).
 
+### Security
+
+PostgREST handles authentication (HTTP Basic over SSL) and delegates
+authorization to the role information defined in the database. This
+ensures there is a single declarative source of truth for security.
+When dealing with the database the server assumes the identity of
+the currently authenticated user, and for the duration of the
+connection cannot do anything the user themselves couldn't.
+
+Postgres 9.5 will soon support true [row-level
+security](http://michael.otacoo.com/postgresql-2/postgres-9-5-feature-highlight-row-level-security/).
+In the meantime what isn't yet implemented can be simulated with
+triggers and security-barrier views. Because the possible queries
+to the database are limited to certain templates using
+[leakproof](http://blog.2ndquadrant.com/how-do-postgresql-security_barrier-views-work/)
+functions, the trigger workaround does not compromise row-level
+security.
+
+For example security patterns see the [security
+guide](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions).
+
 ### Versioning
 
 A robust long-lived API needs the freedom to exist in multiple
@@ -135,7 +139,18 @@ and the [guide to routing](https://github.com/begriffs/postgrest/wiki/Routing).
 * Add two-legged auth with OAuth 1.0a(?)
 * ... the other [issues](https://github.com/begriffs/postgrest/issues)
 
+### Guides
+
+* [Routing](https://github.com/begriffs/postgrest/wiki/Routing)
+* [Versioning](https://github.com/begriffs/postgrest/wiki/API-Versioning)
+* [Performance](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling)
+* [Security](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions)
+
 ### Thanks
 
-Thanks to [Adam Baker](https://github.com/adambaker) for code
-contributions and many fundamental design discussions.
+* [Adam Baker](https://github.com/adambaker) for code
+  contributions and many fundamental design discussions
+* [Nikita Volkov](https://github.com/nikita-volkov) for writing the
+  wonderful [Hasql](https://github.com/nikita-volkov/hasql) library
+  and helping me use it
+* [Mikey Casalaina](https://github.com/casalaina) for the cool logo

app.json

@@ -0,0 +1,45 @@
+{
+  "name": "PostgREST",
+  "description": "RESTful API for any PostgreSQL database.",
+  "logo": "https://halcyon.sh/logo.svg",
+  "repository": "https://github.com/begriffs/postgrest",
+  "env": {
+    "BUILDPACK_URL": {
+      "description": "Heroku buildpack for deploying Haskell applications",
+      "value": "https://github.com/mietek/haskell-on-heroku"
+    },
+    "DB_NAME": {
+      "description": "Database name"
+    },
+    "DB_AUTH_ROLE": {
+      "description": "Database role to use checking client authentication"
+    },
+    "DB_AUTH_PASS": {
+      "description": "Authentication password",
+      "required": false
+    },
+    "DB_ANON_ROLE": {
+      "description": "Database role for non-authenticated requests"
+    },
+    "DB_HOST": {
+      "description": "Database server hostname",
+      "required": false,
+      "value": "localhost"
+    },
+    "DB_PORT": {
+      "description": "Database server port",
+      "required": false,
+      "value": "5432"
+    },
+    "DB_POOL_SIZE": {
+      "description": "Maximum number of connections in database pool",
+      "required": false,
+      "value": "10"
+    },
+    "DB_SECURE": {
+      "description": "Redirect all requests to HTTPS",
+      "required": false,
+      "value": "1"
+    }
+  }
+}

postgrest.cabal

@@ -1,5 +1,5 @@
 name:                  postgrest
-version:               0.2.4.9
+version:               0.2.5.0
 synopsis:              The database is your api
 license:               MIT
 license-file:          LICENSE
@@ -56,9 +56,9 @@ Test-Suite spec
   other-extensions:    QuasiQuotes
   Hs-Source-Dirs:      test, src
   ghc-options:         -Wall -W -Werror
-  Main-Is:             Spec.hs
+  Main-Is:             Main.hs
   Other-Modules:       App, Auth, Config, Spec, SpecHelper
-  Build-Depends:       base, hspec >= 2.0, QuickCheck
+  Build-Depends:       base, hspec >= 2.1.2, QuickCheck
                      , hspec-wai >= 0.5.0, hspec-wai-json
                      , hasql == 0.4.*, hasql-backend
                      , hasql-postgres == 0.8.*

src/App.hs

@@ -153,6 +153,18 @@ app reqBody req =
           $ update qt (map cs $ keys obj) (elems obj)
         return $ responseLBS status204 [ jsonH ] ""
 
+    ([table], "DELETE") -> do
+      let qt = QualifiedTable schema (cs table)
+      let del = coerce $ countT
+            . returningStarT
+            . whereT qq
+            $ deleteFrom qt
+      row <- H.single del
+      let (Identity deletedCount) = fromMaybe (Identity 0 :: Identity Int) row
+      return $ if deletedCount == 0
+         then responseLBS status404 [] ""
+         else responseLBS status204 [("Content-Range", "*/"<> cs (show deletedCount))] ""
+
     (_, _) ->
       return $ responseLBS status404 [] ""
 

src/PgQuery.hs

@@ -43,7 +43,7 @@ limitT r q =
 
 whereT :: Net.Query -> StatementT
 whereT params q =
- if L.null params
+ if L.null cols
    then q
    else q <> (" where ",[],mempty) <> conjunction
  where
@@ -74,6 +74,12 @@ iffNotT (aq, ap, apre) (bq, bp, bpre) =
   , All $ getAll apre && getAll bpre
   )
 
+countT :: StatementT
+countT (sql, params, pre) =
+  ("WITH qqq AS (" <> sql <> ") SELECT count(1) FROM qqq"
+  , params
+  , pre)
+
 countRows :: QualifiedTable -> DynamicSQL
 countRows t =
   ("select count(1) from " <> fromQt t, [], mempty)
@@ -93,6 +99,14 @@ selectStar :: QualifiedTable -> DynamicSQL
 selectStar t =
   ("select * from " <> fromQt t, [], mempty)
 
+returningStarT :: StatementT
+returningStarT (sql, params, pre) =
+  (sql <> " RETURNING *", params, pre)
+
+deleteFrom :: QualifiedTable -> DynamicSQL
+deleteFrom t =
+  ("delete from " <> fromQt t, [], mempty)
+
 insertInto :: QualifiedTable -> [Text] -> [JSON.Value] -> DynamicSQL
 insertInto t [] _ =
   ("insert into " <> fromQt t <> " default values returning *", [], mempty)

test/Feature/AuthSpec.hs

@@ -11,8 +11,7 @@ import SpecHelper
 -- }}}
 
 spec :: Spec
-spec = before resetDb $ around withApp $
-  describe "authorization" $ do
+spec = around withApp $ describe "authorization" $ do
     it "hides tables that anonymous does not own" $
       get "/authors_only" `shouldRespondWith` 404
     it "indicates login failure" $ do

test/Feature/CorsSpec.hs

@@ -12,8 +12,7 @@ import Network.HTTP.Types
 -- }}}
 
 spec :: Spec
-spec = before resetDb $ around withApp $
-  describe "CORS" $ do
+spec = around withApp $ describe "CORS" $ do
     let preflightHeaders = [
           ("Accept", "*/*"),
           ("Origin", "http://example.com"),

test/Feature/DeleteSpec.hs

@@ -0,0 +1,37 @@
+module Feature.DeleteSpec where
+
+import Test.Hspec
+import Test.Hspec.Wai
+import SpecHelper
+
+import Network.HTTP.Types
+
+spec :: Spec
+spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable "items")
+  . around withApp $
+  describe "Deleting" $ do
+    context "existing record" $ do
+      it "succeeds with 204 and deletion count" $
+        request methodDelete "/items?id=eq.1" [] ""
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Nothing
+          , matchStatus  = 204
+          , matchHeaders = ["Content-Range" <:> "*/1"]
+          }
+
+      it "actually clears items ouf the db" $ do
+        _ <- request methodDelete "/items?id=lt.15" [] ""
+        get "/items"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just "[{\"id\":15}]"
+          , matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-0/1"]
+          }
+
+    context "known route, unknown record" $
+      it "fails with 404" $
+        request methodDelete "/items?id=eq.101" [] "" `shouldRespondWith` 404
+
+    context "totally unknown route" $
+      it "fails with 404" $
+        request methodDelete "/foozle?id=eq.101" [] "" `shouldRespondWith` 404

test/Feature/InsertSpec.hs

@@ -19,9 +19,9 @@ import TestTypes(IncPK(..), CompoundPK(..))
 --import Debug.Trace
 
 spec :: Spec
-spec = before resetDb $ around withApp $ do
+spec = around withApp $ do
   describe "Posting new record" $ do
-    it "accepts disparate json types" $ do
+    after_ (clearTable "menagerie") . it "accepts disparate json types" $ do
       p <- post "/menagerie"
         [json| {
           "integer": 13, "double": 3.14159, "varchar": "testing!"
@@ -33,7 +33,7 @@ spec = before resetDb $ around withApp $ do
         simpleStatus p `shouldBe` created201
 
     context "with no pk supplied" $ do
-      context "into a table with auto-incrementing pk" $
+      context "into a table with auto-incrementing pk" . after_ (clearTable "auto_incrementing_pk") $
         it "succeeds with 201 and link" $ do
           p <- post "/auto_incrementing_pk" [json| { "non_nullable_string":"not null"} |]
           liftIO $ do
@@ -52,7 +52,7 @@ spec = before resetDb $ around withApp $ do
           post "/simple_pk" [json| { "extra":"foo"} |]
             `shouldRespondWith` 400
 
-      context "into a table with no pk" $
+      context "into a table with no pk" . after_ (clearTable "no_pk") $
         it "succeeds with 201 and a link including all fields" $ do
           p <- post "/no_pk" [json| { "a":"foo", "b":"bar" } |]
           liftIO $ do
@@ -60,7 +60,7 @@ spec = before resetDb $ around withApp $ do
             simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.foo&b=eq.bar"
             simpleStatus p `shouldBe` created201
 
-    context "with compound pk supplied" $
+    context "with compound pk supplied" . after_ (clearTable "compound_pk") $
       it "builds response location header appropriately" $
         post "/compound_pk" [json| { "k1":12, "k2":42 } |]
           `shouldRespondWith` ResponseMatcher {
@@ -101,7 +101,7 @@ spec = before resetDb $ around withApp $ do
               [json| { "k1":12, "k2":42 } |]
                 `shouldRespondWith` 400
 
-        context "specifying every column in the table" $ do
+        context "specifying every column in the table" . after_ (clearTable "compound_pk") $ do
           it "can create a new record" $ do
             p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
                  [json| { "k1":12, "k2":42, "extra":3 } |]
@@ -131,7 +131,7 @@ spec = before resetDb $ around withApp $ do
               let record = head rows
               compoundExtra record `shouldBe` Just 5
 
-      context "with an auto-incrementing primary key" $
+      context "with an auto-incrementing primary key" . after_ (clearTable "auto_incrementing_pk") $
 
         it "succeeds with 204" $
           request methodPut "/auto_incrementing_pk?id=eq.1" []
@@ -161,7 +161,8 @@ spec = before resetDb $ around withApp $ do
           [json| { "extra":20 } |]
             `shouldRespondWith` 204
 
-    context "in a nonempty table" $ do
+    context "in a nonempty table" . before_ (clearTable "items" >> createItems 15) .
+      after_ (clearTable "items") $ do
       it "can update a single item" $ do
         g <- get "/items?id=eq.42"
         liftIO $ simpleHeaders g

test/Feature/QuerySpec.hs

@@ -6,7 +6,8 @@ import Test.Hspec.Wai
 import SpecHelper
 
 spec :: Spec
-spec = before resetDb $ around withApp $ do
+spec = beforeAll (clearTable "items" >> createItems 15)
+  . afterAll_ (clearTable "items") . around withApp $ do
   describe "Querying a nonexistent table" $
     it "causes a 404" $
       get "/faketable" `shouldRespondWith` 404
@@ -38,6 +39,9 @@ spec = before resetDb $ around withApp $ do
         , matchHeaders = ["Content-Range" <:> "0-1/2"]
         }
 
+    it "without other constraints" $
+      get "/items?order=asc.id" `shouldRespondWith` 200
+
   describe "Canonical location" $ do
     it "Sets Content-Location with alphabetized params" $
       get "/no_pk?b=eq.1&a=eq.1"

test/Feature/RangeSpec.hs

@@ -8,7 +8,8 @@ import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
 import SpecHelper
 
 spec :: Spec
-spec = before resetDb $ around withApp $
+spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable "items")
+  . around withApp $
   describe "GET /items" $ do
 
     context "without range headers" $

test/Feature/StructureSpec.hs

@@ -10,7 +10,7 @@ import SpecHelper
 import Network.HTTP.Types
 
 spec :: Spec
-spec = before resetDb $ around withApp $ do
+spec = around withApp $ do
   describe "GET /" $ do
     it "lists views in schema" $
       request methodGet "/" [] ""

test/Main.hs

@@ -0,0 +1,9 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Main where
+
+import Test.Hspec
+import SpecHelper
+import Spec
+
+main :: IO ()
+main = resetDb >> hspec spec

test/Spec.hs

@@ -1 +1 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}

test/SpecHelper.hs

@@ -10,6 +10,7 @@ import Hasql as H
 import Hasql.Postgres as H
 
 import Data.String.Conversions (cs)
+import Data.Monoid
 -- import Control.Exception.Base (bracket, finally)
 import Control.Monad (void)
 import Control.Exception
@@ -89,6 +90,16 @@ authHeader :: String -> String -> Header
 authHeader u p =
   (hAuthorization, cs $ "Basic " ++ encode (u ++ ":" ++ p))
 
+clearTable :: BS.ByteString -> IO ()
+clearTable table = H.session pgSettings testSettings $ H.tx Nothing $
+  H.unit ("delete from \"1\"."<>table, [], True)
+
+createItems :: Int -> IO ()
+createItems n = H.session pgSettings testSettings $ H.tx Nothing txn
+  where
+    txn = sequence_ $ map H.unit stmts
+    stmts = map [H.q|insert into "1".items (id) values (?)|] [1..n]
+
 -- for hspec-wai
 pending_ :: WaiSession ()
 pending_ = liftIO Test.Hspec.pending

test/fixtures/schema.sql

@@ -453,22 +453,6 @@ SELECT pg_catalog.setval('has_fk_id_seq', 1, false);
 --
 
 INSERT INTO items (id) VALUES (1);
-INSERT INTO items (id) VALUES (2);
-INSERT INTO items (id) VALUES (3);
-INSERT INTO items (id) VALUES (4);
-INSERT INTO items (id) VALUES (5);
-INSERT INTO items (id) VALUES (6);
-INSERT INTO items (id) VALUES (7);
-INSERT INTO items (id) VALUES (8);
-INSERT INTO items (id) VALUES (9);
-INSERT INTO items (id) VALUES (10);
-INSERT INTO items (id) VALUES (11);
-INSERT INTO items (id) VALUES (12);
-INSERT INTO items (id) VALUES (13);
-INSERT INTO items (id) VALUES (14);
-INSERT INTO items (id) VALUES (15);
-
-
 --
 -- TOC entry 2339 (class 0 OID 0)
 -- Dependencies: 198