Add support for DELETE verb

Fixes #125

README.md

@@ -1,56 +1,156 @@
-## Serve a RESTful API from any Postgres database
+![Logo](static/logo.png "Logo")
 
 [![Build Status](https://circleci.com/gh/begriffs/postgrest.png?circle-token=f723c01686abf0364de1e2eaae5aff1f68bd3ff2)](https://circleci.com/gh/begriffs/postgrest/tree/master)
 
-### Installation
+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.
 
-```sh
-brew install postgres
-cabal install -j --enable-tests
+### 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/). 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 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     \
+           --db-name my_db      --db-user postgres \
+           --db-pass foobar     --db-pool 200      \
+           --anonymous postgres --secure           \
+           --port 3000
 ```
 
-Example usage:
+### Performance
 
-```sh
-cabal run -d [database] -U [auth-role] -a [anonymous-role]
-```
+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))
 
-This will connect to a postgres DB at the url
-`postgres://[auth-role]:@localhost:5432/[database]`.
+If you're used to servers written in interpreted languages (or named
+after precious gems), prepare to be pleasantly surprised by PostgREST
+performance.
 
-You will need to provide two database roles (which are allowed to
-be the same). One is called the authenticator role (`auth-role`
-above) which should have enough privileges to read the `auth` table
-in the `postgrest` schema if you intend to support multi-user
-applications.
+Three factors contribute to the speed. First the server is written
+in [Haskell](https://new-www.haskell.org/) using the
+[Warp](http://www.yesodweb.com/blog/2011/03/preliminary-warp-cross-language-benchmarks)
+HTTP server (aka a compiled language with lightweight threads).
+Next it delegates as much calculation as possible to the database
+including
 
-The other role is for anonymous access (`anonymous-role` above).
-Immediately upon acceping any unauthenticated HTTP connection postgrest
-assumes this role in its queries to postgres. Give this role as
-much or little permissions as you would like.
+* Serializing JSON responses directly in SQL
+* Data validation
+* Authorization
+* Combined row counting and retrieval
+* Data post in single command (`returning *`)
 
-### Running tests
+Finally it uses the database efficiently with the
+[Hasql](https://nikita-volkov.github.io/hasql-benchmarks/) library
+by
 
-```sh
-createuser --superuser --no-password postgrest_test
-createdb -O postgrest_test -U postgres postgrest_test
+* Reusing prepared statements
+* Keeping a pool of db connections
+* Using the Postgres binary protocol
+* Being stateless to allow horizontal scaling
 
-cabal test --show-details=always --test-options="--color"
-```
+Ultimately the server (when load balanced) is constrained by database
+performance. This may make it inappropriate for very large traffic
+load. To learn more about scaling with Heroku and Amazon RDS see
+the [performance guide](https://github.com/begriffs/postgrest/wiki/Performance-and-Scaling).
 
-### Distributing Heroku build
+Other optimizations are possible, and some are outlined in the
+[Future Features](#future-features).
 
-```sh
-heroku create --stack=cedar --buildpack https://github.com/begriffs/heroku-buildpack-ghc.git
-git push heroku master
+### Security
 
-heroku config:set S3_ACCESS_KEY=abc
-heroku config:set S3_SECRET_KEY=123
-heroku config:set S3_BUCKET=s3://foo/bar
+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.
 
-heroku run scripts/release_s3.sh
-```
+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.
 
-### Acknowledgements
+For example security patterns see the [security
+guide](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions).
 
-Thanks to [Adam Baker](https://github.com/adambaker) for code contributions and many fundamental design discussions. Also thanks to [Loop/Recur](https://looprecur.com) for open-source Fridays to advance the code, and for their courage to use this thing in real projects.
+### Versioning
+
+A robust long-lived API needs the freedom to exist in multiple
+versions. PostgREST supports versioning through HTTP content
+negotiation. Requests for a certain version translate into switching
+which database schema to search for tables. PostgreSQL schema search
+paths allow tables from earlier versions to be reused verbatim in
+later versions.
+
+To learn more, see the [guide to versioning](https://github.com/begriffs/postgrest/wiki/API-Versioning).
+
+### Self-documention
+
+Rather than writing and maintaining separate docs yourself let the
+API explain its own affordances using HTTP. All PostgREST endpoints
+respond to the OPTIONS verb and explain what they support as well
+as the data format of their JSON payload.
+
+The number of rows returned by an endpoint is reported by - and
+limited with - range headers. More about
+[that](http://begriffs.com/posts/2014-03-06-beyond-http-header-links.html).
+
+There are more opportunities for self-documentation listed in [Future
+Features](#future-features).
+
+### Data Integrity
+
+Rather than relying on an Object Relational Mapper and custom
+imperative coding, this system requires you put declarative constraints
+directly into your database. Hence no application can corrupt your
+data (including your API server).
+
+The PostgREST exposes HTTP interface with safeguards to prevent
+surprises, such as enforcing idempotent PUT requests, and
+
+See examples of [Postgres
+constraints](http://www.tutorialspoint.com/postgresql/postgresql_constraints.htm)
+and the [guide to routing](https://github.com/begriffs/postgrest/wiki/Routing).
+
+### Future Features
+
+* Watching endpoint changes with sockets and Postgres pubsub
+* Specifying per-view HTTP caching
+* Inferring good default caching policies from the Postgres stats collector
+* Generating mock data for test clients
+* Maintaining separate connection pools per role to avoid "set/reset
+  role" performance penalty
+* Describe more relationships with Link headers
+* Depending on accept headers, render OPTIONS as [RAML](http://raml.org/) or a
+  relational diagram
+* 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
+
+* [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.7
+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 [] ""
 
@@ -173,26 +185,28 @@ isSqlError = Just
 sqlError :: H.Error -> Response
 sqlError err =
   let inside = case err of
-        H.CantConnect t -> t
+        H.CantConnect _ ->
+          "Message: \"Cannot connect to postgres server\""
         H.ConnectionLost t -> t
         H.ErroneousResult t -> t
         H.UnexpectedResult t -> t
         H.UnparsableTemplate t -> t
         H.UnparsableRow t -> t
         H.NotInTransaction -> "An operation which requires a"
-          <> "database transaction was executed without one"
-      p = parse message
-        "{\"message\": \"failed to parse exception\" }" inside in
+          <> "database transaction was executed without one" in
   either
-    (\nope ->
+    (\hint ->
       responseLBS status500
       [(hContentType, "application/json")]
-      (cs . show $ nope))
+      (cs . encode . object $ [
+          ("message", String $
+            "Failed to parse exception:" <> inside)
+        , ("hint", String . cs . show $ hint)]))
     (\msg ->
       responseLBS (httpStatus msg)
       [(hContentType, "application/json")]
       (encode msg))
-    p
+    (parse message "" inside)
 
 
 rangeStatus :: Int -> Int -> Int -> Status

src/Main.hs

@@ -49,13 +49,14 @@ main = do
         . gzip def . cors corsPolicy
         . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
       anonRole = cs $ configAnonRole conf
+      currRole = cs $ configDbUser conf
 
   H.session pgSettings sessSettings $ H.sessionUnlifter >>= \unlift ->
     liftIO $ runSettings appSettings $ middle $ \req respond -> do
       body <- strictRequestBody req
       respond =<< catchJust isSqlError
         (unlift $ H.tx Nothing
-                $ authenticated anonRole (app body) req)
+                $ authenticated currRole anonRole (app body) req)
         (return . sqlError)
 
   where

src/Middleware.hs

@@ -22,30 +22,18 @@ import Network.URI (URI(..), parseURI)
 import Auth (LoginAttempt(..), signInRole, setRole, resetRole)
 import Codec.Binary.Base64.String (decode)
 
--- data Environment = Test | Production deriving (Eq)
-
--- safeAction :: Request -> Bool
--- safeAction = (`notElem` ["PATCH", "PUT"]) . requestMethod
-
--- withSavepoint :: Environment -> (Connection -> Application) ->
---                  Connection -> Application
--- withSavepoint env app conn req respond =
---   if env == Production && safeAction req
---     then go
---     else Database.PostgreSQL.Simple.withSavepoint conn go
---   where go = app conn req respond
-
-authenticated :: forall s. Text -> (Request -> H.Tx H.Postgres s Response) ->
-       Request -> H.Tx H.Postgres s Response
-authenticated anon app req = do
+authenticated :: forall s. Text -> Text ->
+                 (Request -> H.Tx H.Postgres s Response) ->
+                 Request -> H.Tx H.Postgres s Response
+authenticated currentRole anon app req = do
   attempt <- httpRequesterRole (requestHeaders req)
   case attempt of
     MalformedAuth ->
       return $ responseLBS status400 [] "Malformed basic auth header"
     LoginFailed ->
       return $ responseLBS status401 [] "Invalid username or password"
-    LoginSuccess role -> runInRole role
-    NoCredentials -> runInRole anon
+    LoginSuccess role -> if role /= currentRole then runInRole role else app req
+    NoCredentials ->     if anon /= currentRole then runInRole anon else app req
 
  where
    httpRequesterRole :: RequestHeaders -> H.Tx H.Postgres s LoginAttempt

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
@@ -44,14 +45,15 @@ pgSettings = H.ParamSettings "localhost" 5432 "postgrest_test" "" "postgrest_tes
 
 withApp :: ActionWith Application -> IO ()
 withApp perform =
-  let anonRole = cs $ configAnonRole cfg in
+  let anonRole = cs $ configAnonRole cfg
+      currRole = cs $ configDbUser cfg in
   perform $ middle $ \req resp ->
     H.session pgSettings testSettings $ H.sessionUnlifter >>= \unlift ->
       liftIO $ do
         body <- strictRequestBody req
         resp =<< catchJust isSqlError
           (unlift $ H.tx Nothing
-                  $ authenticated anonRole (app body) req)
+                  $ authenticated currRole anonRole (app body) req)
           (return . sqlError)
 
   where middle = cors corsPolicy
@@ -88,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