Add support for DELETE verb

Fixes #125

README.md

@@ -17,7 +17,7 @@ your own projects.
 
 ### Usage
 
-Download the binary ([OS X](http://bin.begriffs.com/dbapi/osx/postgrest-0.2.4.10.tar.xz) /  [Ubuntu](http://bin.begriffs.com/dbapi/heroku/postgrest-0.2.4.10.tar.xz)) and invoke 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     \
@@ -148,5 +148,9 @@ and the [guide to routing](https://github.com/begriffs/postgrest/wiki/Routing).
 
 ### 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.10
+version:               0.2.5.0
 synopsis:              The database is your api
 license:               MIT
 license-file:          LICENSE

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

@@ -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/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