From 02c405ad809629195e04800124547ec475fcf5cd Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Sun, 11 Oct 2015 13:16:59 -0400
Subject: [PATCH 01/81] Remove versioning feature

---
 CHANGELOG.md                  |   3 +
 README.md                     |  16 ++---
 debian/postgrest.init.d       |  12 ++--
 src/PostgREST/App.hs          |  17 +----
 src/PostgREST/Config.hs       |   4 +-
 test/Feature/StructureSpec.hs |  78 +++++++++++------------
 test/SpecHelper.hs            |  26 ++++----
 test/Unit/PgQuerySpec.hx      |  10 +--
 test/Unit/PgStructureSpec.hx  |   8 +--
 test/fixtures/schema.sql      | 116 +++++++++++++++++-----------------
 10 files changed, 140 insertions(+), 150 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 8badef4d0..8a4653af7 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -10,6 +10,9 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - Filter columns, e.g. `?select=col1,col2` - @ruslantalpa
 - Does not execute the count total if header "Prefer: count=none" - @diogob
 
+### Removed
+- API versioning feature - @calebmer
+
 ### Fixed
 - Tolerate a missing role in user creation - @calebmer
 
diff --git a/README.md b/README.md
index c7d8858d5..4cd691b14 100644
--- a/README.md
+++ b/README.md
@@ -28,7 +28,7 @@ postgrest  --db-host localhost  --db-port 5432     \
            --db-name my_db      --db-user postgres \
            --db-pass foobar     --db-pool 200      \
            --anonymous postgres --port 3000        \
-           --v1schema public
+           --schema public
 ```
 
 In production include the `--secure` option which redirects all
@@ -100,13 +100,14 @@ guide](https://github.com/begriffs/postgrest/wiki/Security-and-Permissions).
 ### 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.
+versions. Therefore it is a best practice that you version the database
+schema exposed to PostgREST (e.g. `public1` or `api2`). This way you
+future proof your API by allowing it to be backwards compatible when
+you want to publish breaking API changes (e.g. a later version could
+be `public2` or `api3`).
 
-To learn more, see the [guide to versioning](https://github.com/begriffs/postgrest/wiki/API-Versioning).
+For routing to different versions of a PostgREST API use a request
+proxy (such as [nginx](http://nginx.org)).
 
 ### Self-documention
 
@@ -153,7 +154,6 @@ and the [guide to routing](https://github.com/begriffs/postgrest/wiki/Routing).
 ### 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)
 * [Tutorial](http://blog.jonharrington.org/postgrest-introduction/) (external)
diff --git a/debian/postgrest.init.d b/debian/postgrest.init.d
index cacf528a4..2227d8c07 100755
--- a/debian/postgrest.init.d
+++ b/debian/postgrest.init.d
@@ -2,12 +2,12 @@
 ### BEGIN INIT INFO
 # Provides:          postgrest
 # Required-Start:    $local_fs $network postgresql
-# Required-Stop:     $local_fs $network 
+# Required-Stop:     $local_fs $network
 # Default-Start:     2 3 4 5
 # Default-Stop:      0 1 6
 # Description:       PostgreSQL REST API daemon
 ### END INIT INFO
- 
+
 . /lib/lsb/init-functions
 if test -f /etc/default/postgrest; then
     . /etc/default/postgrest
@@ -32,8 +32,8 @@ fi
 if [ -n "$POSTGREST_DBPOOL" ]; then
 	POSTGREST_OPTS="$POSTGREST_OPTS --db-pool $POSTGREST_DBPOOL"
 fi
-POSTGREST_OPTS="$POSTGREST_OPTS --v1schema public"
- 
+POSTGREST_OPTS="$POSTGREST_OPTS --schema public"
+
 start()
 {
 	log_daemon_msg "Starting PostgreSQL REST API daemon" "postgrest" || true
@@ -43,7 +43,7 @@ start()
 		log_end_msg 1 || true
 	fi
 }
- 
+
 stop()
 {
 	log_daemon_msg "Stopping PostgreSQL REST API daemon" "postgrest" || true
@@ -53,7 +53,7 @@ stop()
 		log_end_msg 1 || true
 	fi
 }
- 
+
 status()
 {
 	status_of_proc $POSTGREST postgrest && exit 0 || exit $?
diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index f9044832d..0729f337c 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -6,7 +6,6 @@ module PostgREST.App (
 , isSqlError
 , contentTypeForAccept
 , jsonH
-, requestedSchema
 , TableOptions(..)
 ) where
 
@@ -29,7 +28,6 @@ import           Data.Ranged.Ranges        (emptyRange)
 import qualified Data.Set                  as S
 import           Data.String.Conversions   (cs)
 import           Data.Text                 (Text, replace, strip)
-import           Text.Regex.TDFA           ((=~))
 
 import           Text.Parsec.Error
 
@@ -216,7 +214,7 @@ app dbstructure conf reqBody dbrole req =
 
       -- check that proc exists
       -- check that arg names are all specified
-      -- select * from "1".proc(a := "foo"::undefined) where whereT limit limitT
+      -- select * from public.proc(a := "foo"::undefined) where whereT limit limitT
 
     ([table], "PUT") ->
       handleJsonObj reqBody $ \obj -> do
@@ -296,7 +294,7 @@ app dbstructure conf reqBody dbrole req =
     lookupHeader  = flip lookup hdrs
     hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
     accept        = lookupHeader hAccept
-    schema        = requestedSchema (cs $ configV1Schema conf) accept
+    schema        = cs $ configSchema conf
     authenticator = cs $ configDbUser conf
     jwtSecret     = cs $ configJwtSecret conf
     range         = rangeRequested hdrs
@@ -329,17 +327,6 @@ contentRangeH from to total =
       totalNotZero  = fromMaybe True ((/=) 0 <$> total)
       fromInRange   = from <= to
 
-requestedSchema :: Text -> Maybe BS.ByteString -> Text
-requestedSchema v1schema accept =
-  case verStr of
-    Just [[_, ver]] -> if ver == "1" then v1schema else cs ver
-    _ -> v1schema
-
-  where
-    verRegex = "version[ ]*=[ ]*([0-9]+)" :: BS.ByteString
-    verStr = (=~ verRegex) <$> accept :: Maybe [[BS.ByteString]]
-
-
 jsonMT :: BS.ByteString
 jsonMT = "application/json"
 
diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs
index a268f1626..03fdd05b2 100644
--- a/src/PostgREST/Config.hs
+++ b/src/PostgREST/Config.hs
@@ -44,7 +44,7 @@ data AppConfig = AppConfig {
   , configAnonRole  :: String
   , configSecure    :: Bool
   , configPool      :: Int
-  , configV1Schema  :: String
+  , configSchema    :: String
   , configJwtSecret :: String
   }
 
@@ -60,7 +60,7 @@ argParser = AppConfig
   <*> 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)
-  <*> strOption (long "v1schema" <> metavar "NAME" <> value "1" <> help "Schema to use for nonspecified version (or explicit v1)" <> showDefault)
+  <*> strOption (long "schema" <> short 'S' <> metavar "NAME" <> value "public" <> help "Schema to use for API routes" <> showDefault)
   <*> strOption (long "jwt-secret" <> metavar "SECRET" <> value "secret" <> help "Secret used to encrypt and decrypt JWT tokens)" <> showDefault)
 
 defaultCorsPolicy :: CorsResourcePolicy
diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs
index d68db8440..187584f28 100644
--- a/test/Feature/StructureSpec.hs
+++ b/test/Feature/StructureSpec.hs
@@ -14,28 +14,28 @@ spec = around withApp $ do
     it "lists views in schema" $
       request methodGet "/" [] ""
         `shouldRespondWith` [json| [
-          {"schema":"1","name":"auto_incrementing_pk","insertable":true}
-        , {"schema":"1","name":"clients","insertable":true}
-        , {"schema":"1","name":"comments","insertable":true}
-        , {"schema":"1","name":"complex_items","insertable":true}
-        , {"schema":"1","name":"compound_pk","insertable":true}
-        , {"schema":"1","name":"has_count_column","insertable":false}
-        , {"schema":"1","name":"has_fk","insertable":true}
-        , {"schema":"1","name":"insertable_view_with_join","insertable":true}
-        , {"schema":"1","name":"items","insertable":true}
-        , {"schema":"1","name":"json","insertable":true}
-        , {"schema":"1","name":"materialized_view","insertable":false}
-        , {"schema":"1","name":"menagerie","insertable":true}
-        , {"schema":"1","name":"no_pk","insertable":true}
-        , {"schema":"1","name":"nullable_integer","insertable":true}
-        , {"schema":"1","name":"projects","insertable":true}
-        , {"schema":"1","name":"projects_view","insertable":true}
-        , {"schema":"1","name":"simple_pk","insertable":true}
-        , {"schema":"1","name":"tasks","insertable":true}
-        , {"schema":"1","name":"tsearch","insertable":true}
-        , {"schema":"1","name":"users","insertable":true}
-        , {"schema":"1","name":"users_projects","insertable":true}
-        , {"schema":"1","name":"users_tasks","insertable":true}
+          {"schema":"test","name":"auto_incrementing_pk","insertable":true}
+        , {"schema":"test","name":"clients","insertable":true}
+        , {"schema":"test","name":"comments","insertable":true}
+        , {"schema":"test","name":"complex_items","insertable":true}
+        , {"schema":"test","name":"compound_pk","insertable":true}
+        , {"schema":"test","name":"has_count_column","insertable":false}
+        , {"schema":"test","name":"has_fk","insertable":true}
+        , {"schema":"test","name":"insertable_view_with_join","insertable":true}
+        , {"schema":"test","name":"items","insertable":true}
+        , {"schema":"test","name":"json","insertable":true}
+        , {"schema":"test","name":"materialized_view","insertable":false}
+        , {"schema":"test","name":"menagerie","insertable":true}
+        , {"schema":"test","name":"no_pk","insertable":true}
+        , {"schema":"test","name":"nullable_integer","insertable":true}
+        , {"schema":"test","name":"projects","insertable":true}
+        , {"schema":"test","name":"projects_view","insertable":true}
+        , {"schema":"test","name":"simple_pk","insertable":true}
+        , {"schema":"test","name":"tasks","insertable":true}
+        , {"schema":"test","name":"tsearch","insertable":true}
+        , {"schema":"test","name":"users","insertable":true}
+        , {"schema":"test","name":"users_projects","insertable":true}
+        , {"schema":"test","name":"users_tasks","insertable":true}
         ] |]
         {matchStatus = 200}
 
@@ -45,7 +45,7 @@ spec = around withApp $ do
 
       request methodGet "/" [auth] ""
         `shouldRespondWith` [json| [
-            {"schema":"1","name":"authors_only","insertable":true}
+            {"schema":"test","name":"authors_only","insertable":true}
         ] |]
         {matchStatus = 200}
 
@@ -61,7 +61,7 @@ spec = around withApp $ do
             "default": null,
             "precision": 32,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "integer",
             "type": "integer",
             "maxLen": null,
@@ -74,7 +74,7 @@ spec = around withApp $ do
             "default": null,
             "precision": 53,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "double",
             "type": "double precision",
             "maxLen": null,
@@ -86,7 +86,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "varchar",
             "type": "character varying",
             "maxLen": null,
@@ -99,7 +99,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "boolean",
             "type": "boolean",
             "maxLen": null,
@@ -111,7 +111,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "date",
             "type": "date",
             "maxLen": null,
@@ -123,7 +123,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "money",
             "type": "money",
             "maxLen": null,
@@ -136,7 +136,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "enum",
             "type": "USER-DEFINED",
             "maxLen": null,
@@ -166,7 +166,7 @@ spec = around withApp $ do
                "default":null,
                "precision":64,
                "updatable":false,
-               "schema":"1",
+               "schema":"test",
                "name":"id",
                "type":"bigint",
                "maxLen":null,
@@ -182,7 +182,7 @@ spec = around withApp $ do
                "default":null,
                "precision":32,
                "updatable":false,
-               "schema":"1",
+               "schema":"test",
                "name":"auto_inc_fk",
                "type":"integer",
                "maxLen":null,
@@ -198,7 +198,7 @@ spec = around withApp $ do
                "default":null,
                "precision":null,
                "updatable":false,
-               "schema":"1",
+               "schema":"test",
                "name":"simple_fk",
                "type":"character varying",
                "maxLen":255,
@@ -211,7 +211,7 @@ spec = around withApp $ do
                "default":null,
                "precision":null,
                "updatable":false,
-               "schema":"1",
+               "schema":"test",
                "name":"nullable_string",
                "type":"character varying",
                "maxLen":null,
@@ -224,7 +224,7 @@ spec = around withApp $ do
                "default":null,
                "precision":null,
                "updatable":false,
-               "schema":"1",
+               "schema":"test",
                "name":"non_nullable_string",
                "type":"character varying",
                "maxLen":null,
@@ -237,7 +237,7 @@ spec = around withApp $ do
                "default":null,
                "precision":null,
                "updatable":false,
-               "schema":"1",
+               "schema":"test",
                "name":"inserted_at",
                "type":"timestamp with time zone",
                "maxLen":null,
@@ -261,7 +261,7 @@ spec = around withApp $ do
             "default": "nextval('\"1\".has_fk_id_seq'::regclass)",
             "precision": 64,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "id",
             "type": "bigint",
             "maxLen": null,
@@ -273,7 +273,7 @@ spec = around withApp $ do
             "default": null,
             "precision": 32,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "auto_inc_fk",
             "type": "integer",
             "maxLen": null,
@@ -285,7 +285,7 @@ spec = around withApp $ do
             "default": null,
             "precision": null,
             "updatable": true,
-            "schema": "1",
+            "schema": "test",
             "name": "simple_fk",
             "type": "character varying",
             "maxLen": 255,
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index f47f23b6d..1587dabd3 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -38,7 +38,7 @@ isLeft (Left _ ) = True
 isLeft _ = False
 
 cfg :: AppConfig
-cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10 "1" "safe"
+cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10 "test" "safe"
 
 testPoolOpts :: PoolSettings
 testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30
@@ -66,7 +66,7 @@ withApp perform = do
   dbstructure <- case metadata of
     Left e -> fail $ show e
     Right (tabs, rels, cols, keys) ->
-      return $ DbStructure {
+      return DbStructure {
           tables=tabs
         , columns=cols
         , relations=rels
@@ -88,7 +88,7 @@ resetDb = do
     <- H.acquirePool pgSettings testPoolOpts
   void . liftIO $ H.session pool $
     H.tx Nothing $ do
-      H.unitEx [H.stmt| drop schema if exists "1" cascade |]
+      H.unitEx [H.stmt| drop schema if exists test cascade |]
       H.unitEx [H.stmt| drop schema if exists private cascade |]
       H.unitEx [H.stmt| drop schema if exists postgrest cascade |]
 
@@ -129,7 +129,7 @@ clearTable :: Text -> IO ()
 clearTable table = do
   pool <- testPool
   void . liftIO $ H.session pool $ H.tx Nothing $
-    H.unitEx $ B.Stmt ("delete from \"1\"."<>table) V.empty True
+    H.unitEx $ B.Stmt ("delete from test."<>table) V.empty True
 
 createItems :: Int -> IO ()
 createItems n = do
@@ -137,7 +137,7 @@ createItems n = do
   void . liftIO $ H.session pool $ H.tx Nothing txn
   where
     txn = mapM_ H.unitEx stmts
-    stmts = map [H.stmt|insert into "1".items (id) values (?)|] [1..n]
+    stmts = map [H.stmt|insert into test.items (id) values (?)|] [1..n]
 
 createComplexItems :: IO ()
 createComplexItems = do
@@ -145,11 +145,11 @@ createComplexItems = do
   void . liftIO $ H.session pool $ H.tx Nothing txn
   where
     txn = mapM_ H.unitEx stmts
-    stmts = getZipList $ [H.stmt|insert into "1".complex_items (id, name, settings) values (?,?,?)|]
+    stmts = getZipList $ [H.stmt|insert into test.complex_items (id, name, settings) values (?,?,?)|]
         <$> ZipList ([1..3]::[Int])
         <*> ZipList (["One", "Two", "Three"]::[Text])
-        <*> ZipList ([jobj,jobj,jobj])
-    jobj = (J.object [("foo", J.object [("int", J.Number 1),("bar", J.String "baz")])])
+        <*> ZipList [jobj,jobj,jobj]
+    jobj = J.object [("foo", J.object [("int", J.Number 1),("bar", J.String "baz")])]
 
 createNulls :: Int -> IO ()
 createNulls n = do
@@ -157,14 +157,14 @@ createNulls n = do
   void . liftIO $ H.session pool $ H.tx Nothing txn
   where
     txn = mapM_ H.unitEx (stmt':stmts)
-    stmt' = [H.stmt|insert into "1".no_pk (a,b) values (null,null)|]
-    stmts = map [H.stmt|insert into "1".no_pk (a,b) values (?,0)|] [1..n]
+    stmt' = [H.stmt|insert into test.no_pk (a,b) values (null,null)|]
+    stmts = map [H.stmt|insert into test.no_pk (a,b) values (?,0)|] [1..n]
 
 createNullInteger :: IO ()
 createNullInteger = do
   pool <- testPool
   void . liftIO $ H.session pool $ H.tx Nothing $
-    H.unitEx $ [H.stmt| insert into "1".nullable_integer (a) values (null) |]
+    H.unitEx $ [H.stmt| insert into "test".nullable_integer (a) values (null) |]
 
 createLikableStrings :: IO ()
 createLikableStrings = do
@@ -174,7 +174,7 @@ createLikableStrings = do
     H.unitEx $ insertSimplePk "xYYx" "v"
   where
     insertSimplePk :: Text -> Text -> H.Stmt P.Postgres
-    insertSimplePk = [H.stmt|insert into "1".simple_pk (k, extra) values (?,?)|]
+    insertSimplePk = [H.stmt|insert into test.simple_pk (k, extra) values (?,?)|]
 
 createJsonData :: IO ()
 createJsonData = do
@@ -182,6 +182,6 @@ createJsonData = do
   void . liftIO $ H.session pool $ H.tx Nothing $
     H.unitEx $
       [H.stmt|
-        insert into "1".json (data) values (?)
+        insert into test.json (data) values (?)
       |]
       (J.object [("foo", J.object [("bar", J.String "baz")])])
diff --git a/test/Unit/PgQuerySpec.hx b/test/Unit/PgQuerySpec.hx
index 0cc3de225..5842fe1ef 100644
--- a/test/Unit/PgQuerySpec.hx
+++ b/test/Unit/PgQuerySpec.hx
@@ -32,7 +32,7 @@ spec = around dbWithSchema $ do
   describe "insert" $
     describe "with an auto-increment key" $ do
       it "inserts and responds with a full object description" $ \conn -> do
-        r <- insert "1" "auto_incrementing_pk" (SqlRow [
+        r <- insert "test" "auto_incrementing_pk" (SqlRow [
             ("non_nullable_string", toSql ("a string"::String))]) conn
         let returnRow = incFromList . toList $ r
         incStr returnRow `shouldBe` "a string"
@@ -43,19 +43,19 @@ spec = around dbWithSchema $ do
         [returnRow] `shouldBe` map incFromList tRows
 
       it "throws an exception if the PK is not unique" $ \conn -> do
-        r <- insert "1" "auto_incrementing_pk" (SqlRow [
+        r <- insert "test" "auto_incrementing_pk" (SqlRow [
             ("non_nullable_string", toSql ("a string"::String))]) conn
         let row = SqlRow .  map (Control.Arrow.first cs) . toList $ r
-        insert "1" "auto_incrementing_pk" row conn `shouldThrow` \e ->
+        insert "test" "auto_incrementing_pk" row conn `shouldThrow` \e ->
           seState e == "23505" -- uniqueness violation code
 
       it "throws an exception if a required value is missing" $ \conn ->
-        insert "1" "auto_incrementing_pk" (SqlRow [
+        insert "test" "auto_incrementing_pk" (SqlRow [
           ("nullable_string", toSql ("a string"::String))]) conn
           `shouldThrow` \e -> seState e == "23502"
 
       it "generates a default values query if no data is provided" $ \c -> do
-        r <- insert "1" "items" (SqlRow []) c
+        r <- insert "test" "items" (SqlRow []) c
         let [row] = toList r
         quickALQuery c "select * from \"1\".items where id = ?" [snd row]
           `shouldReturn` [[row]]
diff --git a/test/Unit/PgStructureSpec.hx b/test/Unit/PgStructureSpec.hx
index 0ca6279fb..b1c1570dd 100644
--- a/test/Unit/PgStructureSpec.hx
+++ b/test/Unit/PgStructureSpec.hx
@@ -12,25 +12,25 @@ spec :: Spec
 spec = around dbWithSchema $ beforeWith setRole $ do
   describe "tables" $
     it "shows all the tables" $ \conn -> do
-      ts <- tables "1" conn
+      ts <- tables "test" conn
       map tableName ts `shouldBe` ["authors_only","auto_incrementing_pk",
         "compound_pk","has_fk","insertable_view_with_join","items","menagerie","no_pk", "simple_pk"]
 
   describe "columns" $ do
     it "responds with each column for the table" $ \conn -> do
-      cs <- columns "1" "auto_incrementing_pk" conn
+      cs <- columns "test" "auto_incrementing_pk" conn
       map colName cs `shouldBe` ["id","nullable_string","non_nullable_string",
         "inserted_at"]
 
     it "includes foreign key data" $ \conn -> do
-      cs <- columns "1" "has_fk" conn
+      cs <- columns "test" "has_fk" conn
       map colFK cs `shouldBe` [Nothing,
         Just $ ForeignKey "auto_incrementing_pk" "id",
         Just $ ForeignKey "simple_pk" "k"]
 
   describe "foreignKeys" $
     it "has a description of the foreign key columns" $ \conn ->
-      foreignKeys "1" "has_fk" conn `shouldReturn` M.fromList [
+      foreignKeys "test" "has_fk" conn `shouldReturn` M.fromList [
         ("auto_inc_fk", ForeignKey {fkTable="auto_incrementing_pk", fkCol="id"}),
         ("simple_fk", ForeignKey { fkTable="simple_pk", fkCol="k"})]
 
diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql
index b69e45d38..2066c4f68 100755
--- a/test/fixtures/schema.sql
+++ b/test/fixtures/schema.sql
@@ -5,10 +5,10 @@ SET check_function_bodies = false;
 SET client_min_messages = warning;
 
 
-CREATE SCHEMA "1";
+CREATE SCHEMA test;
 
 
-ALTER SCHEMA "1" OWNER TO postgrest_test;
+ALTER SCHEMA test OWNER TO postgrest_test;
 
 
 CREATE SCHEMA postgrest;
@@ -30,7 +30,7 @@ CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;
 COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language';
 
 
-SET search_path = "1", pg_catalog;
+SET search_path = test, pg_catalog;
 
 
 CREATE TYPE enum_menagerie_type AS ENUM (
@@ -39,7 +39,7 @@ CREATE TYPE enum_menagerie_type AS ENUM (
 );
 
 
-ALTER TYPE "1".enum_menagerie_type OWNER TO postgrest_test;
+ALTER TYPE test.enum_menagerie_type OWNER TO postgrest_test;
 
 SET search_path = postgrest, pg_catalog;
 
@@ -83,18 +83,18 @@ $$;
 
 ALTER FUNCTION postgrest.set_authors_only_owner() OWNER TO postgrest_test;
 
-CREATE FUNCTION "1".insert_insertable_view_with_join() RETURNS trigger
+CREATE FUNCTION test.insert_insertable_view_with_join() RETURNS trigger
     LANGUAGE plpgsql
     AS $$
 begin
-  INSERT INTO "1".auto_incrementing_pk (nullable_string, non_nullable_string) VALUES (NEW.nullable_string, NEW.non_nullable_string);
+  INSERT INTO test.auto_incrementing_pk (nullable_string, non_nullable_string) VALUES (NEW.nullable_string, NEW.non_nullable_string);
   RETURN NEW;
 end;
 $$;
 
-ALTER FUNCTION "1".insert_insertable_view_with_join() OWNER TO postgrest_test;
+ALTER FUNCTION test.insert_insertable_view_with_join() OWNER TO postgrest_test;
 
-SET search_path = "1", pg_catalog;
+SET search_path = test, pg_catalog;
 
 SET default_tablespace = '';
 
@@ -107,7 +107,7 @@ CREATE TABLE authors_only (
 );
 
 
-ALTER TABLE "1".authors_only OWNER TO postgrest_test_author;
+ALTER TABLE test.authors_only OWNER TO postgrest_test_author;
 
 
 CREATE TABLE auto_incrementing_pk (
@@ -118,7 +118,7 @@ CREATE TABLE auto_incrementing_pk (
 );
 
 
-ALTER TABLE "1".auto_incrementing_pk OWNER TO postgrest_test;
+ALTER TABLE test.auto_incrementing_pk OWNER TO postgrest_test;
 
 
 CREATE SEQUENCE auto_incrementing_pk_id_seq
@@ -129,7 +129,7 @@ CREATE SEQUENCE auto_incrementing_pk_id_seq
     CACHE 1;
 
 
-ALTER TABLE "1".auto_incrementing_pk_id_seq OWNER TO postgrest_test;
+ALTER TABLE test.auto_incrementing_pk_id_seq OWNER TO postgrest_test;
 
 
 ALTER SEQUENCE auto_incrementing_pk_id_seq OWNED BY auto_incrementing_pk.id;
@@ -143,7 +143,7 @@ CREATE TABLE compound_pk (
 );
 
 
-ALTER TABLE "1".compound_pk OWNER TO postgrest_test;
+ALTER TABLE test.compound_pk OWNER TO postgrest_test;
 
 
 CREATE TABLE has_fk (
@@ -153,7 +153,7 @@ CREATE TABLE has_fk (
 );
 
 
-ALTER TABLE "1".has_fk OWNER TO postgrest_test;
+ALTER TABLE test.has_fk OWNER TO postgrest_test;
 
 
 CREATE SEQUENCE has_fk_id_seq
@@ -164,18 +164,18 @@ CREATE SEQUENCE has_fk_id_seq
     CACHE 1;
 
 
-ALTER TABLE "1".has_fk_id_seq OWNER TO postgrest_test;
+ALTER TABLE test.has_fk_id_seq OWNER TO postgrest_test;
 
 
 ALTER SEQUENCE has_fk_id_seq OWNED BY has_fk.id;
 
-CREATE MATERIALIZED VIEW "1".materialized_view AS
+CREATE MATERIALIZED VIEW test.materialized_view AS
  SELECT
     version();
 
-ALTER TABLE "1".materialized_view OWNER TO postgrest_test;
+ALTER TABLE test.materialized_view OWNER TO postgrest_test;
 
-CREATE VIEW "1".insertable_view_with_join AS
+CREATE VIEW test.insertable_view_with_join AS
  SELECT has_fk.id,
     has_fk.auto_inc_fk,
     has_fk.simple_fk,
@@ -186,12 +186,12 @@ CREATE VIEW "1".insertable_view_with_join AS
      JOIN auto_incrementing_pk USING (id));
 
 
-ALTER TABLE "1".insertable_view_with_join OWNER TO postgrest_test;
+ALTER TABLE test.insertable_view_with_join OWNER TO postgrest_test;
 
-CREATE VIEW "1".has_count_column AS
+CREATE VIEW test.has_count_column AS
  SELECT 1 AS count;
 
-ALTER TABLE "1".insertable_view_with_join OWNER TO postgrest_test;
+ALTER TABLE test.insertable_view_with_join OWNER TO postgrest_test;
 
 
 CREATE TABLE items (
@@ -199,7 +199,7 @@ CREATE TABLE items (
 );
 
 
-ALTER TABLE "1".items OWNER TO postgrest_test;
+ALTER TABLE test.items OWNER TO postgrest_test;
 
 CREATE TABLE complex_items (
     id bigint NOT NULL,
@@ -208,41 +208,41 @@ CREATE TABLE complex_items (
 );
 
 
-ALTER TABLE "1".complex_items OWNER TO postgrest_test;
+ALTER TABLE test.complex_items OWNER TO postgrest_test;
 
 --- Structure for testing table relations
 CREATE TABLE clients(
     id INT PRIMARY KEY     NOT NULL,
     name           TEXT    NOT NULL
 );
-ALTER TABLE "1".clients OWNER TO postgrest_test;
+ALTER TABLE test.clients OWNER TO postgrest_test;
 
 CREATE TABLE projects(
     id INT PRIMARY KEY     NOT NULL,
     name           TEXT    NOT NULL,
     client_id      INT     REFERENCES clients(id)
 );
-ALTER TABLE "1".projects OWNER TO postgrest_test;
+ALTER TABLE test.projects OWNER TO postgrest_test;
 
 CREATE TABLE tasks(
     id INT PRIMARY KEY     NOT NULL,
     name           TEXT    NOT NULL,
     project_id      INT     REFERENCES projects(id)
 );
-ALTER TABLE "1".tasks OWNER TO postgrest_test;
+ALTER TABLE test.tasks OWNER TO postgrest_test;
 
 CREATE TABLE users(
     id INT PRIMARY KEY     NOT NULL,
     name           TEXT    NOT NULL
 );
-ALTER TABLE "1".users OWNER TO postgrest_test;
+ALTER TABLE test.users OWNER TO postgrest_test;
 
 CREATE TABLE users_tasks(
     user_id      INT     REFERENCES users(id),
     task_id      INT     REFERENCES tasks(id),
     CONSTRAINT task_user PRIMARY KEY (task_id,user_id)
 );
-ALTER TABLE "1".users_tasks OWNER TO postgrest_test;
+ALTER TABLE test.users_tasks OWNER TO postgrest_test;
 
 CREATE TABLE comments(
 id INT PRIMARY KEY   NOT NULL,
@@ -252,22 +252,22 @@ task_id      INT     NOT NULL,
 content      TEXT    NOT NULL,
 FOREIGN KEY (task_id,user_id) REFERENCES users_tasks (task_id,user_id)
 );
-ALTER TABLE "1".comments OWNER TO postgrest_test;
+ALTER TABLE test.comments OWNER TO postgrest_test;
 
 CREATE TABLE users_projects(
     user_id         INT     REFERENCES users(id),
     project_id      INT     REFERENCES projects(id),
     CONSTRAINT project_user PRIMARY KEY (project_id, user_id)
 );
-ALTER TABLE "1".users_projects OWNER TO postgrest_test;
+ALTER TABLE test.users_projects OWNER TO postgrest_test;
 
-CREATE VIEW "1".projects_view AS
+CREATE VIEW test.projects_view AS
   SELECT
       projects.id,
       projects.name,
       projects.client_id
   FROM projects;
-ALTER TABLE "1".projects_view OWNER TO postgrest_test;
+ALTER TABLE test.projects_view OWNER TO postgrest_test;
 ------- SAMPLE DATA -----
 INSERT INTO clients VALUES (1, 'Microsoft'),(2, 'Apple');
 INSERT INTO projects VALUES (1,'Windows 7', 1),(2,'Windows 10', 1),(3,'IOS', 2),(4,'OSX', 2);
@@ -286,25 +286,25 @@ CREATE SEQUENCE items_id_seq
     CACHE 1;
 
 
-ALTER TABLE "1".items_id_seq OWNER TO postgrest_test;
+ALTER TABLE test.items_id_seq OWNER TO postgrest_test;
 
 
 ALTER SEQUENCE items_id_seq OWNED BY items.id;
 
 
 
-CREATE FUNCTION "1".getitemrange(min bigint, max bigint) RETURNS SETOF "1".items AS $$
-    SELECT * FROM "1".items WHERE id > $1 AND id <= $2;
+CREATE FUNCTION test.getitemrange(min bigint, max bigint) RETURNS SETOF test.items AS $$
+    SELECT * FROM test.items WHERE id > $1 AND id <= $2;
 $$ LANGUAGE SQL;
 
 
 
-CREATE FUNCTION "1".sayhello(name text) RETURNS text AS $$
+CREATE FUNCTION test.sayhello(name text) RETURNS text AS $$
     SELECT 'Hello, ' || $1;
 $$ LANGUAGE SQL;
 
 
-CREATE FUNCTION "1".problem() RETURNS void LANGUAGE plpgsql AS
+CREATE FUNCTION test.problem() RETURNS void LANGUAGE plpgsql AS
 $$
 BEGIN
       RAISE 'bad thing';
@@ -323,7 +323,7 @@ CREATE TABLE menagerie (
 );
 
 
-ALTER TABLE "1".menagerie OWNER TO postgrest_test;
+ALTER TABLE test.menagerie OWNER TO postgrest_test;
 
 
 CREATE TABLE no_pk (
@@ -332,7 +332,7 @@ CREATE TABLE no_pk (
 );
 
 
-ALTER TABLE "1".no_pk OWNER TO postgrest_test;
+ALTER TABLE test.no_pk OWNER TO postgrest_test;
 
 
 CREATE TABLE nullable_integer (
@@ -340,7 +340,7 @@ CREATE TABLE nullable_integer (
 );
 
 
-ALTER TABLE "1".nullable_integer OWNER TO postgrest_test;
+ALTER TABLE test.nullable_integer OWNER TO postgrest_test;
 
 
 CREATE TABLE simple_pk (
@@ -349,7 +349,7 @@ CREATE TABLE simple_pk (
 );
 
 
-ALTER TABLE "1".simple_pk OWNER TO postgrest_test;
+ALTER TABLE test.simple_pk OWNER TO postgrest_test;
 
 
 CREATE TABLE json
@@ -358,14 +358,14 @@ CREATE TABLE json
 );
 
 
-ALTER TABLE "1".json OWNER TO postgrest_test;
+ALTER TABLE test.json OWNER TO postgrest_test;
 
 
 CREATE TABLE tsearch (
     text_search_vector tsvector
 );
 
-ALTER TABLE "1".tsearch OWNER TO postgrest_test;
+ALTER TABLE test.tsearch OWNER TO postgrest_test;
 
 SET search_path = postgrest, pg_catalog;
 
@@ -406,7 +406,7 @@ ALTER TABLE private.articles_id_seq OWNER TO postgrest_test;
 ALTER SEQUENCE articles_id_seq OWNED BY articles.id;
 
 
-SET search_path = "1", pg_catalog;
+SET search_path = test, pg_catalog;
 
 
 ALTER TABLE ONLY auto_incrementing_pk ALTER COLUMN id SET DEFAULT nextval('auto_incrementing_pk_id_seq'::regclass);
@@ -426,7 +426,7 @@ SET search_path = private, pg_catalog;
 ALTER TABLE ONLY articles ALTER COLUMN id SET DEFAULT nextval('articles_id_seq'::regclass);
 
 
-SET search_path = "1", pg_catalog;
+SET search_path = test, pg_catalog;
 
 
 
@@ -471,20 +471,20 @@ SET search_path = private, pg_catalog;
 SELECT pg_catalog.setval('articles_id_seq', 1, false);
 
 
-SET search_path = "1", pg_catalog;
+SET search_path = test, pg_catalog;
 
-CREATE FUNCTION public.always_true("1".items) RETURNS boolean
+CREATE FUNCTION public.always_true(test.items) RETURNS boolean
     LANGUAGE sql STABLE
     AS $$ SELECT true $$;
 
-ALTER FUNCTION public.always_true("1".items) OWNER TO postgrest_test;
+ALTER FUNCTION public.always_true(test.items) OWNER TO postgrest_test;
 
 
 
 ALTER TABLE ONLY authors_only
     ADD CONSTRAINT authors_only_pkey PRIMARY KEY (secret);
 
-CREATE TRIGGER insert_insertable_view_with_join INSTEAD OF INSERT ON "1".insertable_view_with_join FOR EACH ROW EXECUTE PROCEDURE "1".insert_insertable_view_with_join();
+CREATE TRIGGER insert_insertable_view_with_join INSTEAD OF INSERT ON test.insertable_view_with_join FOR EACH ROW EXECUTE PROCEDURE test.insert_insertable_view_with_join();
 
 
 CREATE TRIGGER secrets_owner_track BEFORE INSERT OR UPDATE ON authors_only FOR EACH ROW EXECUTE PROCEDURE postgrest.set_authors_only_owner();
@@ -547,7 +547,7 @@ SET search_path = private, pg_catalog;
 CREATE TRIGGER articles_owner_track BEFORE INSERT OR UPDATE ON articles FOR EACH ROW EXECUTE PROCEDURE postgrest.update_owner();
 
 
-SET search_path = "1", pg_catalog;
+SET search_path = test, pg_catalog;
 
 
 ALTER TABLE ONLY has_fk
@@ -560,11 +560,11 @@ ALTER TABLE ONLY has_fk
 
 
 
-REVOKE ALL ON SCHEMA "1" FROM PUBLIC;
-REVOKE ALL ON SCHEMA "1" FROM postgrest_test;
-GRANT ALL ON SCHEMA "1" TO postgrest_test;
-GRANT USAGE ON SCHEMA "1" TO postgrest_anonymous;
-GRANT USAGE ON SCHEMA "1" TO postgrest_test_author;
+REVOKE ALL ON SCHEMA test FROM PUBLIC;
+REVOKE ALL ON SCHEMA test FROM postgrest_test;
+GRANT ALL ON SCHEMA test TO postgrest_test;
+GRANT USAGE ON SCHEMA test TO postgrest_anonymous;
+GRANT USAGE ON SCHEMA test TO postgrest_test_author;
 
 
 
@@ -737,10 +737,10 @@ REVOKE ALL ON TABLE has_count_column FROM postgrest_test;
 GRANT ALL ON TABLE has_count_column TO postgrest_test;
 GRANT ALL ON TABLE has_count_column TO postgrest_anonymous;
 
-REVOKE ALL ON FUNCTION public.always_true("1".items) FROM PUBLIC;
-REVOKE ALL ON FUNCTION public.always_true("1".items) FROM postgrest_test;
-GRANT ALL ON FUNCTION public.always_true("1".items) TO postgrest_test;
-GRANT ALL ON FUNCTION public.always_true("1".items) TO postgrest_anonymous;
+REVOKE ALL ON FUNCTION public.always_true(test.items) FROM PUBLIC;
+REVOKE ALL ON FUNCTION public.always_true(test.items) FROM postgrest_test;
+GRANT ALL ON FUNCTION public.always_true(test.items) TO postgrest_test;
+GRANT ALL ON FUNCTION public.always_true(test.items) TO postgrest_anonymous;
 
 
 SET search_path = postgrest, pg_catalog;

From 5feb334191cc8c278b40c72f0028f8770b0b79c4 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Sun, 11 Oct 2015 16:26:29 -0400
Subject: [PATCH 02/81] Use postgres connection string

---
 src/PostgREST/App.hs        |  5 ++---
 src/PostgREST/Config.hs     | 29 ++++++++++-------------------
 src/PostgREST/Main.hs       | 15 +++++++--------
 src/PostgREST/Middleware.hs |  9 ++++-----
 test/SpecHelper.hs          | 18 +++++++++++-------
 5 files changed, 34 insertions(+), 42 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 0729f337c..916098229 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -57,8 +57,8 @@ import           PostgREST.Types
 
 import           Prelude
 
-app :: DbStructure -> AppConfig -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
-app dbstructure conf reqBody dbrole req =
+app :: DbStructure -> AppConfig -> Text -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
+app dbstructure conf authenticator reqBody dbrole req =
   case (path, verb) of
 
     ([], _) -> do
@@ -295,7 +295,6 @@ app dbstructure conf reqBody dbrole req =
     hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
     accept        = lookupHeader hAccept
     schema        = cs $ configSchema conf
-    authenticator = cs $ configDbUser conf
     jwtSecret     = cs $ configJwtSecret conf
     range         = rangeRequested hdrs
     allOrigins    = ("Access-Control-Allow-Origin", "*") :: Header
diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs
index 03fdd05b2..e57ce7128 100644
--- a/src/PostgREST/Config.hs
+++ b/src/PostgREST/Config.hs
@@ -34,34 +34,25 @@ import           Prelude
 
 -- | Data type to store all command line options
 data AppConfig = AppConfig {
-    configDbName    :: String
-  , configDbPort    :: Int
-  , configDbUser    :: String
-  , configDbPass    :: String
-  , configDbHost    :: String
-
+    configDatabase  :: String
   , configPort      :: Int
   , configAnonRole  :: String
-  , configSecure    :: Bool
-  , configPool      :: Int
   , configSchema    :: String
+  , configSecure    :: Bool
   , configJwtSecret :: String
+  , configPool      :: Int
   }
 
 argParser :: Parser AppConfig
 argParser = AppConfig
-  <$> 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)
+  <$> argument str (help "database connection string" <> metavar "URL")
 
-  <*> 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)
-  <*> strOption (long "schema" <> short 'S' <> metavar "NAME" <> value "public" <> help "Schema to use for API routes" <> showDefault)
-  <*> strOption (long "jwt-secret" <> metavar "SECRET" <> value "secret" <> help "Secret used to encrypt and decrypt JWT tokens)" <> showDefault)
+  <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)
+  <*> strOption    (long "anonymous"  <> short 'a' <> help "postgres role to use for non-authenticated requests" <> metavar "ROLE")
+  <*> strOption    (long "schema"     <> short 'S' <> help "schema to use for API routes" <> metavar "NAME" <> value "1" <> showDefault)
+  <*> switch       (long "secure"     <> short 's' <> help "redirect all requests to HTTPS")
+  <*> strOption    (long "jwt-secret" <> short 'j' <> help "secret used to encrypt and decrypt JWT tokens" <> metavar "SECRET" <> value "secret" <> showDefault)
+  <*> option auto  (long "pool"       <> short 'o' <> help "max connections in database pool" <> metavar "COUNT" <> value 10 <> showDefault)
 
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index 2c1567c51..180bde91a 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -31,7 +31,7 @@ import           PostgREST.Config                     (AppConfig (..),
 
 isServerVersionSupported :: H.Session P.Postgres IO Bool
 isServerVersionSupported = do
-  Identity (row :: Text) <- H.tx Nothing $ H.singleEx $ [H.stmt|SHOW server_version_num|]
+  Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|]
   return $ read (cs row) >= minimumPgVersion
 
 main :: IO ()
@@ -50,11 +50,7 @@ main = do
   Prelude.putStrLn $ "Listening on port " ++
     (show $ configPort conf :: String)
 
-  let pgSettings = P.ParamSettings (cs $ configDbHost conf)
-                     (fromIntegral $ configDbPort conf)
-                     (cs $ configDbUser conf)
-                     (cs $ configDbPass conf)
-                     (cs $ configDbName conf)
+  let pgSettings = P.StringSettings $ cs (configDatabase conf)
       appSettings = setPort port
                   . setServerName (cs $ "postgrest/" <> prettyVersion)
                   $ defaultSettings
@@ -71,6 +67,10 @@ main = do
         fail "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0"
     ) supportedOrError
 
+  Right authenticator <- H.session pool $ do
+    Identity (role :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SELECT SESSION_USER|]
+    return role
+
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
     tabs <- allTables
@@ -89,9 +89,8 @@ main = do
         , primaryKeys=keys
         }
 
-
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      authenticated conf (app dbstructure conf body) req
+      authenticated conf authenticator (app dbstructure conf authenticator body) req
     either (respond . errResponse) respond resOrError
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index b2dfee16a..e841c592c 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -33,22 +33,21 @@ import           PostgREST.Config              (AppConfig (..), corsPolicy)
 
 import           Prelude
 
-authenticated :: forall s. AppConfig ->
+authenticated :: forall s. AppConfig -> Text ->
                  (DbRole -> Request -> H.Tx P.Postgres s Response) ->
                  Request -> H.Tx P.Postgres s Response
-authenticated conf app req = do
+authenticated conf authenticator 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 uid -> if role /= currentRole then runInRole role uid else app currentRole req
-    NoCredentials         -> if anon /= currentRole then runInRole anon "" else app currentRole req
+    LoginSuccess role uid -> if role /= authenticator then runInRole role uid else app authenticator req
+    NoCredentials         -> if anon /= authenticator then runInRole anon "" else app authenticator req
 
  where
    jwtSecret = cs $ configJwtSecret conf
-   currentRole = cs $ configDbUser conf
    anon = cs $ configAnonRole conf
    httpRequesterRole :: RequestHeaders -> H.Tx P.Postgres s LoginAttempt
    httpRequesterRole hdrs = do
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index 1587dabd3..c4b8727cc 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -20,6 +20,7 @@ import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
 import Codec.Binary.Base64.String (encode)
 import Data.CaseInsensitive (CI(..))
 import Data.Maybe (fromMaybe)
+import Data.Functor.Identity
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
 import System.Process (readProcess)
@@ -33,28 +34,31 @@ import PostgREST.Error(errResponse)
 import PostgREST.PgStructure
 import PostgREST.Types
 
+dbString :: String
+dbString = "postgres://postgrest_test@localhost:5432/postgrest_test"
+
 isLeft :: Either a b -> Bool
 isLeft (Left _ ) = True
 isLeft _ = False
 
 cfg :: AppConfig
-cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10 "test" "safe"
+cfg = AppConfig dbString 3000 "postgrest_anonymous" "test" False "safe" 10
 
 testPoolOpts :: PoolSettings
 testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30
 
 pgSettings :: P.Settings
-pgSettings = P.ParamSettings (cs $ configDbHost cfg)
-                             (fromIntegral $ configDbPort cfg)
-                             (cs $ configDbUser cfg)
-                             (cs $ configDbPass cfg)
-                             (cs $ configDbName cfg)
+pgSettings = P.StringSettings $ cs dbString
 
 withApp :: ActionWith Application -> IO ()
 withApp perform = do
   pool :: H.Pool P.Postgres
     <- H.acquirePool pgSettings testPoolOpts
 
+  Right authenticator <- H.session pool $ do
+    Identity (role :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SELECT SESSION_USER|]
+    return role
+
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
     tabs <- allTables
@@ -76,7 +80,7 @@ withApp perform = do
   perform $ middle $ \req resp -> do
     body <- strictRequestBody req
     result <- liftIO $ H.session pool $ H.tx txSettings
-      $ authenticated cfg (app dbstructure cfg body) req
+      $ authenticated cfg authenticator (app dbstructure cfg authenticator body) req
     either (resp . errResponse) resp result
 
   where middle = defaultMiddle False

From f6aa93f09437c99fd2bac188be8d5901595ca5e6 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Sun, 11 Oct 2015 16:46:51 -0400
Subject: [PATCH 03/81] Add details to changelog

---
 CHANGELOG.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 8a4653af7..b52223031 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -9,9 +9,11 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - Embed associations, e.g. `/film?select=*,director(*)` - @ruslantalpa
 - Filter columns, e.g. `?select=col1,col2` - @ruslantalpa
 - Does not execute the count total if header "Prefer: count=none" - @diogob
+- Postgres connection string argument - @calebmer
 
 ### Removed
 - API versioning feature - @calebmer
+- `--db-x` command line arguments - @calebmer
 
 ### Fixed
 - Tolerate a missing role in user creation - @calebmer

From de43ac52c4f55cc2fffdb8517b569c938800e0e1 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Sun, 11 Oct 2015 16:47:09 -0400
Subject: [PATCH 04/81] Rename connection string metavar

---
 src/PostgREST/Config.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs
index e57ce7128..b83768da8 100644
--- a/src/PostgREST/Config.hs
+++ b/src/PostgREST/Config.hs
@@ -45,7 +45,7 @@ data AppConfig = AppConfig {
 
 argParser :: Parser AppConfig
 argParser = AppConfig
-  <$> argument str (help "database connection string" <> metavar "URL")
+  <$> argument str (help "database connection string" <> metavar "STRING")
 
   <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)
   <*> strOption    (long "anonymous"  <> short 'a' <> help "postgres role to use for non-authenticated requests" <> metavar "ROLE")

From fdcf074dfd518c09958e644a6654f46da4c10e6e Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Sun, 11 Oct 2015 16:50:47 -0400
Subject: [PATCH 05/81] Update readme

---
 README.md | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/README.md b/README.md
index 4cd691b14..dd8d92c10 100644
--- a/README.md
+++ b/README.md
@@ -24,13 +24,16 @@ your own projects.
 Download the binary ([latest release](https://github.com/begriffs/postgrest/releases/latest)) 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 --port 3000        \
-           --schema public
+postgrest postgres://postgres:foobar@localhost:5432/my_db
+          --port 3000          \
+          --schema public      \
+          --anonymous postgres \
+          --pool 200
 ```
 
+For more information on valid connection strings see the
+[Postgres docs](http://www.postgresql.org/docs/9.4/static/libpq-connect.html#LIBPQ-CONNSTRING).
+
 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

From 2cbf2af6c79769c3276161275c51b848c2d06efa Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Sun, 11 Oct 2015 16:51:52 -0400
Subject: [PATCH 06/81] Fix readme bash syntax

---
 README.md | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/README.md b/README.md
index dd8d92c10..121c4f38d 100644
--- a/README.md
+++ b/README.md
@@ -24,9 +24,9 @@ your own projects.
 Download the binary ([latest release](https://github.com/begriffs/postgrest/releases/latest)) and invoke like so:
 
 ```bash
-postgrest postgres://postgres:foobar@localhost:5432/my_db
-          --port 3000          \
-          --schema public      \
+postgrest postgres://postgres:foobar@localhost:5432/my_db \
+          --port 3000 \
+          --schema public \
           --anonymous postgres \
           --pool 200
 ```

From e37b2d8c5947d38cecbd6c99bfcc8ba8cdd9b327 Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Mon, 12 Oct 2015 16:58:15 -0700
Subject: [PATCH 07/81] Provide detailed logging for any db errors caused
 internally by postgrest

---
 postgrest.cabal       |  1 +
 src/PostgREST/Main.hs | 38 +++++++++++++++++++++-----------------
 2 files changed, 22 insertions(+), 17 deletions(-)

diff --git a/postgrest.cabal b/postgrest.cabal
index af08f499e..55d5fcc68 100644
--- a/postgrest.cabal
+++ b/postgrest.cabal
@@ -37,6 +37,7 @@ executable postgrest
                      , case-insensitive
                      , scientific, time
                      , aeson >= 0.8, network >= 2.6
+                     , aeson-pretty >= 0.7 && < 0.8
                      , bytestring, text, split, string-conversions
                      , stringsearch
                      , containers, unordered-containers
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index 180bde91a..565eef737 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -1,39 +1,41 @@
 module Main where
 
 
+import           PostgREST.App
+import           PostgREST.Config                     (AppConfig (..),
+                                                       minimumPgVersion,
+                                                       prettyVersion,
+                                                       readOptions)
+import           PostgREST.Error                      (errResponse, PgError)
+import           PostgREST.Middleware
 import           PostgREST.PgStructure
 import           PostgREST.Types
-import           Network.Wai
-
-import           PostgREST.App
-import           PostgREST.Error                      (errResponse)
-import           PostgREST.Middleware
 
 import           Control.Monad                        (unless)
 import           Control.Monad.IO.Class               (liftIO)
+import           Data.Aeson.Encode.Pretty             (encodePretty)
 import           Data.Functor.Identity
 import           Data.Monoid                          ((<>))
 import           Data.String.Conversions              (cs)
 import           Data.Text                            (Text)
 import qualified Hasql                                as H
 import qualified Hasql.Postgres                       as P
+import           Network.Wai
 import           Network.Wai.Handler.Warp             hiding (Connection)
 import           Network.Wai.Middleware.RequestLogger (logStdout)
-
 import           System.IO                            (BufferMode (..),
                                                        hSetBuffering, stderr,
                                                        stdin, stdout)
 
-import           PostgREST.Config                     (AppConfig (..),
-                                                       prettyVersion,
-                                                       readOptions,
-                                                       minimumPgVersion)
 
 isServerVersionSupported :: H.Session P.Postgres IO Bool
 isServerVersionSupported = do
   Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|]
   return $ read (cs row) >= minimumPgVersion
 
+hasqlError :: PgError -> IO a
+hasqlError = error . cs . encodePretty
+
 main :: IO ()
 main = do
   hSetBuffering stdout LineBuffering
@@ -61,15 +63,17 @@ main = do
   pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
 
   supportedOrError <- H.session pool isServerVersionSupported
-  either (fail . show)
+  either hasqlError
     (\supported ->
       unless supported $
-        fail "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0"
+        error "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0"
     ) supportedOrError
 
-  Right authenticator <- H.session pool $ do
-    Identity (role :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SELECT SESSION_USER|]
+  roleOrError <- H.session pool $ do
+    Identity (role :: Text) <- H.tx Nothing $ H.singleEx
+      [H.stmt|SELECT SESSION_USER|]
     return role
+  authenticator <- either hasqlError return roleOrError
 
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
@@ -79,15 +83,15 @@ main = do
     keys <- allPrimaryKeys
     return (tabs, rels, cols, keys)
 
-  dbstructure <- case metadata of
-    Left e -> fail $ show e
-    Right (tabs, rels, cols, keys) ->
+  dbstructure <- either hasqlError
+    (\(tabs, rels, cols, keys) ->
       return DbStructure {
           tables=tabs
         , columns=cols
         , relations=rels
         , primaryKeys=keys
         }
+    ) metadata
 
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req

From 3733a84a38e7d8866a954a2c3b0369a155400a1d Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Mon, 12 Oct 2015 17:02:33 -0700
Subject: [PATCH 08/81] Use type alias for clarity

---
 src/PostgREST/App.hs        | 2 +-
 src/PostgREST/Middleware.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 916098229..40c86babd 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -57,7 +57,7 @@ import           PostgREST.Types
 
 import           Prelude
 
-app :: DbStructure -> AppConfig -> Text -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
+app :: DbStructure -> AppConfig -> DbRole -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
 app dbstructure conf authenticator reqBody dbrole req =
   case (path, verb) of
 
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index e841c592c..9dd3a5c48 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -33,7 +33,7 @@ import           PostgREST.Config              (AppConfig (..), corsPolicy)
 
 import           Prelude
 
-authenticated :: forall s. AppConfig -> Text ->
+authenticated :: forall s. AppConfig -> DbRole ->
                  (DbRole -> Request -> H.Tx P.Postgres s Response) ->
                  Request -> H.Tx P.Postgres s Response
 authenticated conf authenticator app req = do

From 6dbb69a8283d0843eeb7a0b16adac4576049da92 Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Mon, 12 Oct 2015 17:03:02 -0700
Subject: [PATCH 09/81] Ensure that version error message tracks changing
 requirements

---
 src/PostgREST/Main.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index 565eef737..86e710424 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -66,7 +66,9 @@ main = do
   either hasqlError
     (\supported ->
       unless supported $
-        error "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0"
+        error (
+          "Cannot run in this PostgreSQL version, PostgREST needs at least "
+          <> show minimumPgVersion)
     ) supportedOrError
 
   roleOrError <- H.session pool $ do

From 1f80b806bdbcc2f8d61abecd294cdb953e3cd4eb Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Fri, 16 Oct 2015 15:21:31 +0300
Subject: [PATCH 10/81] data types refactoring

---
 src/PostgREST/App.hs          | 20 ++++++-------
 src/PostgREST/Parsers.hs      | 14 ++++-----
 src/PostgREST/QueryBuilder.hs | 53 ++++++++++++++++++-----------------
 src/PostgREST/Types.hs        | 12 ++++----
 4 files changed, 51 insertions(+), 48 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 297883d71..201a75aa0 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -91,9 +91,9 @@ app dbstructure conf authenticator reqBody dbrole req =
                   )
             row <- H.maybeEx q
             let (tableTotal, queryTotal, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString) row
-                to = from+queryTotal-1
-                contentRange = contentRangeH from to tableTotal
-                status = rangeStatus from to tableTotal
+                to = frm+queryTotal-1
+                contentRange = contentRangeH frm to tableTotal
+                status = rangeStatus frm to tableTotal
                 canonical = urlEncodeVars
                   . sortBy (comparing fst)
                   . map (join (***) cs)
@@ -108,7 +108,7 @@ app dbstructure conf authenticator reqBody dbrole req =
               ] (fromMaybe "[]" body)
 
         where
-            from = fromMaybe 0 $ rangeOffset <$> range
+            frm = fromMaybe 0 $ rangeOffset <$> range
             apiRequest = first formatParserError (parseGetRequest req)
                      >>= first formatRelationError . addRelations schema allRels Nothing
                      >>= addJoinConditions schema allCols
@@ -309,22 +309,22 @@ isSqlError = undefined
 
 rangeStatus :: Int -> Int -> Maybe Int -> Status
 rangeStatus _ _ Nothing = status200
-rangeStatus from to (Just total)
-  | from > total            = status416
-  | (1 + to - from) < total = status206
+rangeStatus frm to (Just total)
+  | frm > total            = status416
+  | (1 + to - frm) < total = status206
   | otherwise               = status200
 
 contentRangeH :: Int -> Int -> Maybe Int -> Header
-contentRangeH from to total =
+contentRangeH frm to total =
     ("Content-Range", cs headerValue)
     where
       headerValue   = rangeString <> "/" <> totalString
       rangeString
-        | totalNotZero && fromInRange = show from <> "-" <> cs (show to)
+        | totalNotZero && fromInRange = show frm <> "-" <> cs (show to)
         | otherwise = "*"
       totalString   = fromMaybe "*" (show <$> total)
       totalNotZero  = fromMaybe True ((/=) 0 <$> total)
-      fromInRange   = from <= to
+      fromInRange   = frm <= to
 
 jsonMT :: BS.ByteString
 jsonMT = "application/json"
diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs
index 235962811..5a59163d2 100644
--- a/src/PostgREST/Parsers.hs
+++ b/src/PostgREST/Parsers.hs
@@ -23,7 +23,7 @@ parseGetRequest httpRequest =
   foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
   where
     apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++selectStr++">>") $ cs selectStr
-    addOrder (Node r f) o = Node r{order=o} f
+    addOrder (Node (q,i) f) o = Node (q{order=o}, i) f
     flts = mapM pRequestFilter whereFilters
     rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
     qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
@@ -35,13 +35,13 @@ parseGetRequest httpRequest =
 pRequestSelect :: Text -> Parser ApiRequest
 pRequestSelect rootNodeName = do
   fieldTree <- pFieldForest
-  return $ foldr treeEntry (Node (Select rootNodeName [] [] [] Nothing Nothing) []) fieldTree
+  return $ foldr treeEntry (Node (Select [] [rootNodeName] [] Nothing, (rootNodeName, Nothing)) []) fieldTree
   where
     treeEntry :: Tree SelectItem -> ApiRequest -> ApiRequest
-    treeEntry (Node fld@((fn, _),_) fldForest) (Node rNode rForest) =
+    treeEntry (Node fld@((fn, _),_) fldForest) (Node (q, i) rForest) =
       case fldForest of
-        [] -> Node (rNode {fields=fld:fields rNode}) rForest
-        _  -> Node rNode (foldr treeEntry (Node (Select fn [] [] [] Nothing Nothing) []) fldForest:rForest)
+        [] -> Node (q {select=fld:select q}, i) rForest
+        _  -> Node (q, i) (foldr treeEntry (Node (Select [] [fn] [] Nothing, (fn, Nothing)) []) fldForest:rForest)
 
 pRequestFilter :: (String, String) -> Either ParseError (Path, Filter)
 pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
@@ -54,7 +54,7 @@ pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
     val = snd <$> opVal
 
 addFilter :: (Path, Filter) -> ApiRequest -> ApiRequest
-addFilter ([], flt) (Node rn@(Select {filters=flts}) forest) = Node (rn {filters=flt:flts}) forest
+addFilter ([], flt) (Node (q@(Select {where_=flts}), i) forest) = Node (q {where_=flt:flts}, i) forest
 addFilter (path, flt) (Node rn forest) =
   case targetNode of
     Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
@@ -66,7 +66,7 @@ addFilter (path, flt) (Node rn forest) =
       case maybeNode of
         Nothing -> (Nothing,forest)
         Just node -> (Just node, delete node forest)
-      where maybeNode = find ((name==).mainTable.rootLabel) forst
+      where maybeNode = find ((name==).fst.snd.rootLabel) forst
 
 ws :: Parser Text
 ws = cs <$> many (oneOf " \t")
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index 346786bcd..96ce5079f 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 module PostgREST.QueryBuilder
 where
 
@@ -20,17 +21,19 @@ findRelation :: [Relation] -> Text -> Text -> Text -> Maybe Relation
 findRelation allRelations s t1 t2 =
   find (\r -> s == relSchema r && t1 == relTable r && t2 == relFTable r) allRelations
 
+
+
 addRelations :: Text -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
-addRelations schema allRelations parentNode node@(Node query@(Select {mainTable=table}) forest) =
+addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) =
   case parentNode of
-    Nothing -> Node query{relation=Nothing} <$> updatedForest
-    (Just (Node (Select{mainTable=parentTable}) _)) -> Node <$> (addRel query <$> rel) <*> updatedForest
+    Nothing -> Node (query, (table, Nothing)) <$> updatedForest
+    (Just (Node (_, (parentTable, _)) _)) -> Node <$> (addRel n <$> rel) <*> updatedForest
       where
         rel = note ("no relation between " <> table <> " and " <> parentTable)
             $  findRelation allRelations schema table parentTable
            <|> findRelation allRelations schema parentTable table
-        addRel :: Query -> Relation -> Query
-        addRel q r = q{relation = Just r}
+        addRel :: (Query, (NodeName, Maybe Relation)) -> Relation -> (Query, (NodeName, Maybe Relation))
+        addRel (q, (t, _)) r = (q, (t, Just r))
   where
     updatedForest = mapM (addRelations schema allRelations (Just node)) forest
 
@@ -45,31 +48,31 @@ getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) =
     toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc))
 
 addJoinConditions :: Text -> [Column] -> ApiRequest -> Either Text ApiRequest
-addJoinConditions schema allColumns (Node query@(Select{relation=r}) forest) =
+addJoinConditions schema allColumns (Node (query, (t, r)) forest) =
   case r of
-    Nothing -> Node updatedQuery  <$> updatedForest -- this is the root node
-    Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel)) <$> updatedForest
-    Just (Relation{relType=Parent}) -> Node updatedQuery <$> updatedForest
+    Nothing -> Node (updatedQuery, (t, r))  <$> updatedForest -- this is the root node
+    Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(t,r)) <$> updatedForest
+    Just (Relation{relType=Parent}) -> Node (updatedQuery, (t,r)) <$> updatedForest
     Just rel@(Relation{relType=Many, relLTable=(Just linkTable)}) ->
-      Node <$> pure qq <*> updatedForest
+      Node (qq, (t, r)) <$> updatedForest
       where
          q = addCond updatedQuery (getJoinConditions rel)
-         qq = q{joinTables=linkTable:joinTables q}
+         qq = q{from=linkTable:from q}
     _ -> Left "unknow relation"
   where
     -- add parentTable and parentJoinConditions to the query
-    updatedQuery = foldr (flip addCond) (query{joinTables = parentTables ++ joinTables query}) parentJoinConditions
+    updatedQuery = foldr (flip addCond) (query{from = parentTables ++ from query}) parentJoinConditions
       where
         parentJoinConditions = map (getJoinConditions.snd) parents
         parentTables = map fst parents
         parents = mapMaybe (getParents.rootLabel) forest
-        getParents qq@(Select{relation=(Just rel@(Relation{relType=Parent}))}) = Just (mainTable qq, rel)
+        getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel)
         getParents _ = Nothing
     updatedForest = mapM (addJoinConditions schema allColumns) forest
-    addCond q con = q{filters=con ++ filters q}
+    addCond q con = q{where_=con ++ where_ q}
 
 requestToCountQuery :: Text -> ApiRequest -> PStmt
-requestToCountQuery schema (Node (Select mainTbl _ _ conditions _ _) _) =
+requestToCountQuery schema (Node (Select _ _ conditions _, (mainTbl, _)) _) =
   B.Stmt query V.empty True
   where
     query = Data.Text.unwords [
@@ -84,45 +87,45 @@ requestToCountQuery schema (Node (Select mainTbl _ _ conditions _ _) _) =
         fn  (Filter{value=VForeignKey _ _}) = False
 
 requestToQuery :: Text -> ApiRequest -> PStmt
-requestToQuery schema (Node (Select mainTbl colSelects tbls conditions ord _) forest) =
+requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest) =
   orderT (fromMaybe [] ord)  query
   where
     query = B.Stmt qStr V.empty True
     qStr = Data.Text.unwords [
       ("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
       "SELECT ", intercalate ", " (map (pgFmtSelectItem (QualifiedIdentifier schema mainTbl)) colSelects ++ selects),
-      "FROM ", intercalate ", " (map (fromQi . QualifiedIdentifier schema) (mainTbl:tbls)),
+      "FROM ", intercalate ", " (map (fromQi . QualifiedIdentifier schema) tbls),
       ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl) ) conditions )) `emptyOnNull` conditions
       ]
     emptyOnNull val x = if null x then "" else val
     (withs, selects) = foldr getQueryParts ([],[]) forest
-    getQueryParts :: Tree Query -> ([Text], [Text]) -> ([Text], [Text])
-    getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation {relType=Child}))}) forst) (w,s) = (w,sel:s)
+    getQueryParts :: Tree ApiNode -> ([Text], [Text]) -> ([Text], [Text])
+    getQueryParts (Node n@(_, (table, Just (Relation {relType=Child}))) forst) (w,s) = (w,sel:s)
       where
         sel = "("
            <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
            <> "FROM (" <> subquery <> ") " <> table
            <> ") AS " <> table
-           where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst)
+           where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
 
-    getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation{relType=Parent}))}) forst) (w,s) = (wit:w,sel:s)
+    getQueryParts (Node n@(_, (table, Just (Relation {relType=Parent}))) forst) (w,s) = (wit:w,sel:s)
       where
         sel = "row_to_json(" <> table <> ".*) AS "<>table --TODO must be singular
         wit = table <> " AS ( " <> subquery <> " )"
-          where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst)
+          where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
 
-    getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation {relType=Many}))}) forst) (w,s) = (w,sel:s)
+    getQueryParts (Node n@(_, (table, Just (Relation {relType=Many}))) forst) (w,s) = (w,sel:s)
       where
         sel = "("
            <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
            <> "FROM (" <> subquery <> ") " <> table
            <> ") AS " <> table
-           where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst)
+           where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
 
     -- the following is just to remove the warning
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
     --posible relations are Child Parent Many
-    getQueryParts (Node (Select{relation=Nothing}) _) _ = undefined
+    getQueryParts (Node (_,(_,Nothing)) _) _ = undefined
 
 pgFmtCondition :: QualifiedIdentifier -> Filter -> Text
 pgFmtCondition table (Filter (col,jp) ops val) =
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
index fbe36d937..51f219cf4 100644
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -75,18 +75,18 @@ type FieldName = Text
 type JsonPath = [Text]
 type Field = (FieldName, Maybe JsonPath)
 type Cast = Text
+type NodeName = Text
 type SelectItem = (Field, Maybe Cast)
 type Path = [Text]
 data Query = Select {
-  mainTable::Text
-, fields::[SelectItem]
-, joinTables::[Text]
-, filters::[Filter]
+  select::[SelectItem]
+, from::[Text]
+, where_::[Filter]
 , order::Maybe [OrderTerm]
-, relation::Maybe Relation
 } deriving (Show, Eq)
 data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
-type ApiRequest = Tree Query
+type ApiNode = (Query, (NodeName, Maybe Relation))
+type ApiRequest = Tree ApiNode
 
 
 instance ToJSON Column where

From 3add3f5b6c8a2ec3052336f12584326de4fce5a4 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Thu, 8 Oct 2015 23:40:21 -0400
Subject: [PATCH 11/81] First draft of big auth simplification

---
 src/PostgREST/App.hs        | 43 +++----------------------
 src/PostgREST/Auth.hs       | 63 ++++++++++---------------------------
 src/PostgREST/Main.hs       |  2 +-
 src/PostgREST/Middleware.hs | 53 +++++++++++--------------------
 test/SpecHelper.hs          |  2 +-
 5 files changed, 42 insertions(+), 121 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 40c86babd..680fe62a3 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -57,12 +57,12 @@ import           PostgREST.Types
 
 import           Prelude
 
-app :: DbStructure -> AppConfig -> DbRole -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
-app dbstructure conf authenticator reqBody dbrole req =
+app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
+app dbstructure conf reqBody req =
   case (path, verb) of
 
     ([], _) -> do
-      let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTabs
+      let body = encode $ filter ((cs schema==).tableSchema) allTabs
       return $ responseLBS status200 [jsonH] $ cs body
 
     ([table], "OPTIONS") -> do
@@ -130,41 +130,6 @@ app dbstructure conf authenticator reqBody dbrole req =
             countQuery = requestToCountQuery schema <$> apiRequest
             queries = (,) <$> query <*> countQuery
 
-
-    (["postgrest", "users"], "POST") -> do
-      let user = decode reqBody :: Maybe AuthUser
-
-      case user of
-        Nothing -> return $ responseLBS status400 [jsonH] $
-          encode . object $ [("message", String "Failed to parse user.")]
-        Just u -> do
-          _ <- addUser (cs $ userId u)
-            (cs $ userPass u) (cs <$> userRole u)
-          return $ responseLBS status201
-            [ jsonH
-            , (hLocation, "/postgrest/users?id=eq." <> cs (userId u))
-            ] ""
-
-    (["postgrest", "tokens"], "POST") ->
-      case jwtSecret of
-        "secret" -> return $ responseLBS status500 [jsonH] $
-          encode . object $ [("message", String "JWT Secret is set as \"secret\" which is an unsafe default.")]
-        _ -> do
-          let user = decode reqBody :: Maybe AuthUser
-
-          case user of
-            Nothing -> return $ responseLBS status400 [jsonH] $
-              encode . object $ [("message", String "Failed to parse user.")]
-            Just u -> do
-              setRole authenticator
-              login <- signInRole (cs $ userId u) (cs $ userPass u)
-              case login of
-                LoginSuccess role uid ->
-                  return $ responseLBS status201 [ jsonH ] $
-                    encode . object $ [("token", String $ tokenJWT jwtSecret uid role)]
-                _  -> return $ responseLBS status401 [jsonH] $
-                  encode . object $ [("message", String "Failed authentication.")]
-
     ([table], "POST") -> do
       let qt = qualify table
           echoRequested = hasPrefer "return=representation"
@@ -295,7 +260,7 @@ app dbstructure conf authenticator reqBody dbrole req =
     hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
     accept        = lookupHeader hAccept
     schema        = cs $ configSchema conf
-    jwtSecret     = cs $ configJwtSecret conf
+    jwtSecret     = (cs $ configJwtSecret conf) :: Text
     range         = rangeRequested hdrs
     allOrigins    = ("Access-Control-Allow-Origin", "*") :: Header
     contentType   = fromMaybe "application/json" $ contentTypeForAccept accept
diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index edcf86cf9..4ced51892 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -1,23 +1,24 @@
+{-# LANGUAGE FlexibleContexts #-}
 module PostgREST.Auth where
 
 import           Control.Applicative
 import           Control.Monad           (mzero)
-import           Crypto.BCrypt
+
 import           Data.Aeson
-import           Data.Map
+import           Data.Map (lookup, fromList, toList)
 import           Data.Monoid
 import           Data.String.Conversions (cs)
-import           Data.Text
 import           Data.Maybe (isNothing)
+import           Data.Text (Text)
 import qualified Data.Vector             as V
 import qualified Hasql                   as H
 import qualified Hasql.Backend           as B
 import qualified Hasql.Postgres          as P
 import           PostgREST.PgQuery       (pgFmtLit)
-import           Prelude
+import           Prelude 
 import qualified Web.JWT                 as JWT
 
-import           System.IO.Unsafe
+
 
 data AuthUser = AuthUser {
     userId   :: String
@@ -48,51 +49,21 @@ data LoginAttempt =
   | LoginSuccess DbRole UserId
   deriving (Eq, Show)
 
-checkPass :: Text -> Text -> Bool
-checkPass = (. cs) . validatePassword . cs
+setJWTEnv :: Text -> Text -> Maybe [Text]
+setJWTEnv secret input = setDBEnv $ jwtClaims secret input
 
-setRole :: Text -> H.Tx P.Postgres s ()
-setRole role = H.unitEx $ B.Stmt ("set local role " <> cs (pgFmtLit role)) V.empty True
+setDBEnv :: Maybe JWT.ClaimsMap -> Maybe [Text]
+setDBEnv maybeClaims =
+  (map setVar . toList) <$> maybeClaims
+  where
+    setVar ("role", String val) = setRole val
+    setVar (key, String val) = "set local postgrest." <> key <> " = " <> cs (pgFmtLit val) <> ";"
 
-setUserId :: Text -> H.Tx P.Postgres s ()
-setUserId uid =
-  if uid /= ""
-    then H.unitEx $ B.Stmt ("set local user_vars.user_id = " <> cs (pgFmtLit uid)) V.empty True
-    else resetUserId
+setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
 
-resetUserId :: H.Tx P.Postgres s ()
-resetUserId = H.unitEx [H.stmt|reset user_vars.user_id|]
-
-addUser :: Text -> Text -> Maybe Text -> H.Tx P.Postgres s ()
-addUser identity pass role =
-  H.unitEx $
-    if isNothing role
-      then [H.stmt|insert into postgrest.auth (id, pass) values (?, ?)|]
-        identity hashedText
-      else [H.stmt|insert into postgrest.auth (id, pass, rolname) values (?, ?, ?)|]
-        identity hashedText role
-  where Just hashed = unsafePerformIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
-        hashedText = cs hashed :: Text
-
-signInRole :: Text -> Text -> H.Tx P.Postgres s LoginAttempt
-signInRole user pass = do
-  u <- H.maybeEx $ [H.stmt|select id, pass, rolname from postgrest.auth where id = ?|] user
-  return $ maybe LoginFailed (\r ->
-      let (uid, hashed, role) = r in
-      if checkPass hashed pass
-         then LoginSuccess role uid
-         else LoginFailed
-    ) u
-
-signInWithJWT :: Text -> Text -> LoginAttempt
-signInWithJWT secret input = case maybeRole of
-    Just (Just (String role)) -> case maybeUserId of
-      Just (Just (String uid)) -> LoginSuccess (cs role) (cs uid)
-      _   -> LoginFailed
-    _   -> LoginFailed
+jwtClaims :: Text -> Text -> Maybe JWT.ClaimsMap
+jwtClaims secret input = claims
   where
-    maybeRole = (Data.Map.lookup "role" <$> claims) ::Maybe (Maybe Value)
-    maybeUserId = (Data.Map.lookup "id" <$> claims) ::Maybe (Maybe Value)
     claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
     decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index 86e710424..fd6bf26a5 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -98,5 +98,5 @@ main = do
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      authenticated conf authenticator (app dbstructure conf authenticator body) req
+      runWithClaims conf (app dbstructure conf body) req
     either (respond . errResponse) respond resOrError
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index 9dd3a5c48..0f6e379bf 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -27,46 +27,31 @@ import           Network.Wai.Middleware.Static (only, staticPolicy)
 import           Codec.Binary.Base64.String    (decode)
 import           PostgREST.App                 (contentTypeForAccept)
 import           PostgREST.Auth                (DbRole, LoginAttempt (..),
-                                                setRole, setUserId, signInRole,
-                                                signInWithJWT)
+                                                setRole, setJWTEnv)
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 
-import           Prelude
+import           Prelude hiding(concat)
+import qualified Web.JWT                 as JWT
 
-authenticated :: forall s. AppConfig -> DbRole ->
-                 (DbRole -> Request -> H.Tx P.Postgres s Response) ->
+import qualified Data.Vector             as V
+import qualified Hasql.Backend           as B
+
+runWithClaims :: forall s. AppConfig ->
+                 (Request -> H.Tx P.Postgres s Response) ->
                  Request -> H.Tx P.Postgres s Response
-authenticated conf authenticator 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 uid -> if role /= authenticator then runInRole role uid else app authenticator req
-    NoCredentials         -> if anon /= authenticator then runInRole anon "" else app authenticator req
-
+runWithClaims conf app req = do
+    H.unitEx $ B.Stmt env V.empty True
+    app req
  where
-   jwtSecret = cs $ configJwtSecret conf
+   hdrs = requestHeaders req
+   jwtSecret = (cs $ configJwtSecret conf) :: Text
+   auth = fromMaybe "" $ lookup hAuthorization hdrs
    anon = cs $ configAnonRole conf
-   httpRequesterRole :: RequestHeaders -> H.Tx P.Postgres s LoginAttempt
-   httpRequesterRole hdrs = do
-    let auth = fromMaybe "" $ lookup hAuthorization hdrs
-    case split (==' ') (cs auth) of
-      ("Basic" : b64 : _) ->
-        case split (==':') (cs . decode . cs $ b64) of
-          (u:p:_) -> signInRole u p
-          _ -> return MalformedAuth
-      ("Bearer" : jwt : _) ->
-        return $ signInWithJWT jwtSecret jwt
-      _ -> return NoCredentials
-
-   runInRole :: Text -> Text -> H.Tx P.Postgres s Response
-   runInRole r uid = do
-     setUserId uid
-     setRole r
-     app r req
-
+   jwtEnv =
+     case split (==' ') (cs auth) of
+       ("Bearer" : jwt : _) -> fromMaybe [] (setJWTEnv jwtSecret jwt)
+       _ -> []
+   env = concat $ setRole anon : jwtEnv
 
 redirectInsecure :: Application -> Application
 redirectInsecure app req respond = do
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index c4b8727cc..52e2387f5 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -80,7 +80,7 @@ withApp perform = do
   perform $ middle $ \req resp -> do
     body <- strictRequestBody req
     result <- liftIO $ H.session pool $ H.tx txSettings
-      $ authenticated cfg authenticator (app dbstructure cfg authenticator body) req
+      $ runWithClaims cfg (app dbstructure cfg body) req
     either (resp . errResponse) resp result
 
   where middle = defaultMiddle False

From 275002e25d9771fd25230d4bd4186867d21879ae Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Mon, 12 Oct 2015 16:37:02 -0400
Subject: [PATCH 12/81] Adds dbrole filter back to root path querying the
 database

---
 src/PostgREST/App.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 680fe62a3..77fabf02b 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -62,7 +62,8 @@ app dbstructure conf reqBody req =
   case (path, verb) of
 
     ([], _) -> do
-      let body = encode $ filter ((cs schema==).tableSchema) allTabs
+      Identity (dbrole :: Text) <- H.singleEx $ [H.stmt|SELECT current_user|]
+      let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTabs
       return $ responseLBS status200 [jsonH] $ cs body
 
     ([table], "OPTIONS") -> do

From 31f1a30d6fb9399e01c740055208e2cb039c70aa Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Thu, 15 Oct 2015 21:20:51 -0400
Subject: [PATCH 13/81] Cleans imports in Middleware and define exports in Auth

---
 src/PostgREST/App.hs        |  1 -
 src/PostgREST/Auth.hs       | 17 +++++++++--------
 src/PostgREST/Middleware.hs |  9 ++-------
 3 files changed, 11 insertions(+), 16 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 77fabf02b..b5fe77c81 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -46,7 +46,6 @@ import qualified Hasql                     as H
 import qualified Hasql.Backend             as B
 import qualified Hasql.Postgres            as P
 
-import           PostgREST.Auth
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.Parsers
 import           PostgREST.PgQuery
diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index 4ced51892..16949c2a2 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -1,19 +1,19 @@
 {-# LANGUAGE FlexibleContexts #-}
-module PostgREST.Auth where
+module PostgREST.Auth (
+    DbRole
+  , LoginAttempt (..)
+  , setRole
+  , setJWTEnv
+  ) where
 
 import           Control.Applicative
 import           Control.Monad           (mzero)
 
 import           Data.Aeson
-import           Data.Map (lookup, fromList, toList)
+import           Data.Map (fromList, toList)
 import           Data.Monoid
 import           Data.String.Conversions (cs)
-import           Data.Maybe (isNothing)
 import           Data.Text (Text)
-import qualified Data.Vector             as V
-import qualified Hasql                   as H
-import qualified Hasql.Backend           as B
-import qualified Hasql.Postgres          as P
 import           PostgREST.PgQuery       (pgFmtLit)
 import           Prelude 
 import qualified Web.JWT                 as JWT
@@ -57,8 +57,9 @@ setDBEnv maybeClaims =
   (map setVar . toList) <$> maybeClaims
   where
     setVar ("role", String val) = setRole val
-    setVar (key, String val) = "set local postgrest." <> key <> " = " <> cs (pgFmtLit val) <> ";"
+    setVar (key, String val) = "set local postgrest.claims" <> key <> " = " <> cs (pgFmtLit val) <> ";"
 
+setRole :: Text -> Text
 setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
 
 jwtClaims :: Text -> Text -> Maybe JWT.ClaimsMap
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index 0f6e379bf..cabe54303 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -10,11 +10,9 @@ import           Data.String.Conversions       (cs)
 import qualified Hasql                         as H
 import qualified Hasql.Postgres                as P
 
-import           Network.HTTP.Types            (RequestHeaders)
 import           Network.HTTP.Types.Header     (hAccept, hAuthorization,
                                                 hLocation)
-import           Network.HTTP.Types.Status     (status301, status400, status401,
-                                                status415)
+import           Network.HTTP.Types.Status     (status301, status400, status415)
 import           Network.URI                   (URI (..), parseURI)
 import           Network.Wai                   (Application, Request (..),
                                                 Response, isSecure, rawPathInfo,
@@ -24,14 +22,11 @@ import           Network.Wai.Middleware.Cors   (cors)
 import           Network.Wai.Middleware.Gzip   (def, gzip)
 import           Network.Wai.Middleware.Static (only, staticPolicy)
 
-import           Codec.Binary.Base64.String    (decode)
 import           PostgREST.App                 (contentTypeForAccept)
-import           PostgREST.Auth                (DbRole, LoginAttempt (..),
-                                                setRole, setJWTEnv)
+import           PostgREST.Auth                (setRole, setJWTEnv)
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 
 import           Prelude hiding(concat)
-import qualified Web.JWT                 as JWT
 
 import qualified Data.Vector             as V
 import qualified Hasql.Backend           as B

From aae55e028261980f36c7a69ca9b9174fea36fef5 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Sat, 17 Oct 2015 20:41:42 -0400
Subject: [PATCH 14/81] Make complete match agains ClaimsMap in setVar

---
 src/PostgREST/Auth.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index 16949c2a2..3a5d75209 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -57,7 +57,12 @@ setDBEnv maybeClaims =
   (map setVar . toList) <$> maybeClaims
   where
     setVar ("role", String val) = setRole val
-    setVar (key, String val) = "set local postgrest.claims" <> key <> " = " <> cs (pgFmtLit val) <> ";"
+    setVar (key, String val) = "set local postgrest.claims" <> key <> " = " <> pgFmtLit val <> ";"
+    setVar (key, Bool val) = "set local postgrest.claims" <> key <> " = " <> showText val <> ";"
+    setVar (key, Number val) = "set local postgrest.claims" <> key <> " = " <> showText val <> ";"
+    setVar _ = ""
+    showText :: Show a => a -> Text
+    showText = cs . show
 
 setRole :: Text -> Text
 setRole role = "set local role " <> cs (pgFmtLit role) <> ";"

From 241a38e9585ea1a9588bfa3a9fbf60d3ca05eff7 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Sun, 18 Oct 2015 00:17:49 -0400
Subject: [PATCH 15/81] Makes JWT generation possible in RPC endpoints Fixes
 SET execution to execute in separate statements as Hasql uses prepared
 statements we need to send 1 commend per statement.

---
 postgrest.cabal             | 72 +++++++++++++++++++++++--------------
 src/PostgREST/App.hs        |  8 +++--
 src/PostgREST/Auth.hs       | 57 ++++++++---------------------
 src/PostgREST/Middleware.hs |  5 +--
 4 files changed, 69 insertions(+), 73 deletions(-)

diff --git a/postgrest.cabal b/postgrest.cabal
index 55d5fcc68..2b3642b6c 100644
--- a/postgrest.cabal
+++ b/postgrest.cabal
@@ -53,6 +53,8 @@ executable postgrest
                      , mtl
                      , cassava
                      , jwt
+                     , lens
+                     , lens-aeson >= 1.0.0.5
                      , parsec
                      , errors
                      , bifunctors
@@ -66,34 +68,50 @@ library
 
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
-  build-depends:       base >=4.6 && <5
-                     , hasql, hasql-backend
-                     , hasql-postgres
-                     , warp, wai
-                     , wai-extra, wai-cors
-                     , wai-middleware-static
-                     , HTTP, convertible, http-types
-                     , case-insensitive
-                     , scientific, time
-                     , aeson, network
-                     , bytestring, text, split, string-conversions
-                     , stringsearch
-                     , containers, unordered-containers
-                     , optparse-applicative
-                     , regex-base, regex-tdfa
+  build-depends:       HTTP
+                     , MissingH
                      , Ranged-sets
-                     , transformers, MissingH
-                     , bcrypt, base64-string
-                     , network-uri
-                     , resource-pool
-                     , blaze-builder
-                     , vector
-                     , mtl
-                     , cassava
-                     , jwt
-                     , parsec
-                     , errors
+                     , aeson
+                     , base >=4.6 && <5
+                     , base64-string
+                     , bcrypt
                      , bifunctors
+                     , blaze-builder
+                     , bytestring
+                     , case-insensitive
+                     , cassava
+                     , containers
+                     , convertible
+                     , errors
+                     , hasql
+                     , hasql-backend
+                     , hasql-postgres
+                     , http-types
+                     , jwt
+                     , lens
+                     , lens-aeson >= 1.0.0.5
+                     , mtl
+                     , network
+                     , network-uri
+                     , optparse-applicative
+                     , parsec
+                     , regex-base
+                     , regex-tdfa
+                     , resource-pool
+                     , scientific
+                     , split
+                     , string-conversions
+                     , stringsearch
+                     , text
+                     , time
+                     , transformers
+                     , unordered-containers
+                     , vector
+                     , wai
+                     , wai-cors
+                     , wai-extra
+                     , wai-middleware-static
+                     , warp
 
   Other-Modules:       Paths_postgrest
   Exposed-Modules:     PostgREST.App
@@ -163,6 +181,8 @@ Test-Suite spec
                      , process
                      , heredoc
                      , jwt
+                     , lens
+                     , lens-aeson >= 1.0.0.5
                      , parsec
                      , errors
                      , bifunctors
diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index b5fe77c81..18248ddff 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -40,6 +40,7 @@ import           Network.Wai.Internal      (Response (..))
 import           Network.Wai.Parse         (parseHttpAccept)
 
 import           Data.Aeson
+import           Data.Aeson.Types (emptyArray)
 import           Data.Monoid
 import qualified Data.Vector               as V
 import qualified Hasql                     as H
@@ -53,6 +54,7 @@ import           PostgREST.PgStructure
 import           PostgREST.QueryBuilder
 import           PostgREST.RangeQuery
 import           PostgREST.Types
+import           PostgREST.Auth (tokenJWT)
 
 import           Prelude
 
@@ -172,9 +174,11 @@ app dbstructure conf reqBody req =
         then do
           let call = B.Stmt "select " V.empty True <>
                 asJson (callProc qi $ fromMaybe M.empty (decode reqBody))
-          body :: Maybe (Identity Text) <- H.maybeEx call
+          bodyJson :: Maybe (Identity Value) <- H.maybeEx call
           return $ responseLBS status200 [jsonH]
-            (cs $ fromMaybe "[]" $ runIdentity <$> body)
+                (if hasPrefer "return=jwt"
+                   then ("{\"token\":\"" <> (cs $ tokenJWT jwtSecret $ fromMaybe "[]" $ runIdentity <$> bodyJson) <> "\"}")
+                   else (cs $ encode $ fromMaybe emptyArray $ runIdentity <$> bodyJson))
         else return $ responseLBS status404 [] ""
 
       -- check that proc exists
diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index 3a5d75209..43c3e99c9 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -1,53 +1,23 @@
 {-# LANGUAGE FlexibleContexts #-}
 module PostgREST.Auth (
-    DbRole
-  , LoginAttempt (..)
-  , setRole
+  setRole
   , setJWTEnv
+  , tokenJWT
   ) where
 
 import           Control.Applicative
-import           Control.Monad           (mzero)
-
 import           Data.Aeson
 import           Data.Map (fromList, toList)
+import           Data.Maybe (fromMaybe)
 import           Data.Monoid
 import           Data.String.Conversions (cs)
 import           Data.Text (Text)
 import           PostgREST.PgQuery       (pgFmtLit)
-import           Prelude 
+import           Prelude
 import qualified Web.JWT                 as JWT
-
-
-
-data AuthUser = AuthUser {
-    userId   :: String
-  , userPass :: String
-  , userRole :: Maybe String
-  } deriving (Show)
-
-instance FromJSON AuthUser where
-  parseJSON (Object v) = AuthUser <$>
-                         v .: "id" <*>
-                         v .: "pass" <*>
-                         v .:? "role"
-  parseJSON _ = mzero
-
-instance ToJSON AuthUser where
-  toJSON u = object [
-      "id" .= userId u
-    , "pass" .= userPass u
-    , "role" .= userRole u ]
-
-type DbRole = Text
-type UserId = Text
-
-data LoginAttempt =
-    NoCredentials
-  | MalformedAuth
-  | LoginFailed
-  | LoginSuccess DbRole UserId
-  deriving (Eq, Show)
+import qualified Data.HashMap.Lazy       as HashMap
+import Data.Aeson.Lens
+import Control.Lens.Operators
 
 setJWTEnv :: Text -> Text -> Maybe [Text]
 setJWTEnv secret input = setDBEnv $ jwtClaims secret input
@@ -57,9 +27,9 @@ setDBEnv maybeClaims =
   (map setVar . toList) <$> maybeClaims
   where
     setVar ("role", String val) = setRole val
-    setVar (key, String val) = "set local postgrest.claims" <> key <> " = " <> pgFmtLit val <> ";"
-    setVar (key, Bool val) = "set local postgrest.claims" <> key <> " = " <> showText val <> ";"
-    setVar (key, Number val) = "set local postgrest.claims" <> key <> " = " <> showText val <> ";"
+    setVar (k, String val) = "set local postgrest.claims." <> k <> " = " <> pgFmtLit val <> ";"
+    setVar (k, Bool val) = "set local postgrest.claims." <> k <> " = " <> showText val <> ";"
+    setVar (k, Number val) = "set local postgrest.claims." <> k <> " = " <> showText val <> ";"
     setVar _ = ""
     showText :: Show a => a -> Text
     showText = cs . show
@@ -73,9 +43,10 @@ jwtClaims secret input = claims
     claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
     decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
-tokenJWT :: Text -> Text -> Text -> Text
-tokenJWT secret uid role = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet
+tokenJWT :: Text -> Value -> Text
+tokenJWT secret claims = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet
   where
     claimsSet = JWT.def {
-      JWT.unregisteredClaims = Data.Map.fromList [("id", String uid), ("role", String role)]
+      JWT.unregisteredClaims = Data.Map.fromList claimsList
     }
+    claimsList =  fromMaybe [] $ HashMap.toList <$> (claims ^? nth 0 . _Object)
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index cabe54303..119f5f939 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -35,7 +35,7 @@ runWithClaims :: forall s. AppConfig ->
                  (Request -> H.Tx P.Postgres s Response) ->
                  Request -> H.Tx P.Postgres s Response
 runWithClaims conf app req = do
-    H.unitEx $ B.Stmt env V.empty True
+    mapM_ H.unitEx $ stmt <$> env
     app req
  where
    hdrs = requestHeaders req
@@ -46,7 +46,8 @@ runWithClaims conf app req = do
      case split (==' ') (cs auth) of
        ("Bearer" : jwt : _) -> fromMaybe [] (setJWTEnv jwtSecret jwt)
        _ -> []
-   env = concat $ setRole anon : jwtEnv
+   env = setRole anon : jwtEnv
+   stmt = (flip $ flip B.Stmt V.empty) True
 
 redirectInsecure :: Application -> Application
 redirectInsecure app req respond = do

From 7ef5b7b43a7c28d5096d1ab0ad1de1b0434ea979 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Sun, 18 Oct 2015 14:03:43 -0400
Subject: [PATCH 16/81] Simplifies pattern matching using insertableValue and
 quote variable as identifier.

---
 src/PostgREST/Auth.hs | 10 +++-------
 1 file changed, 3 insertions(+), 7 deletions(-)

diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index 43c3e99c9..f7cce5fec 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -12,7 +12,7 @@ import           Data.Maybe (fromMaybe)
 import           Data.Monoid
 import           Data.String.Conversions (cs)
 import           Data.Text (Text)
-import           PostgREST.PgQuery       (pgFmtLit)
+import           PostgREST.PgQuery       (pgFmtLit, pgFmtIdent, insertableValue)
 import           Prelude
 import qualified Web.JWT                 as JWT
 import qualified Data.HashMap.Lazy       as HashMap
@@ -27,12 +27,8 @@ setDBEnv maybeClaims =
   (map setVar . toList) <$> maybeClaims
   where
     setVar ("role", String val) = setRole val
-    setVar (k, String val) = "set local postgrest.claims." <> k <> " = " <> pgFmtLit val <> ";"
-    setVar (k, Bool val) = "set local postgrest.claims." <> k <> " = " <> showText val <> ";"
-    setVar (k, Number val) = "set local postgrest.claims." <> k <> " = " <> showText val <> ";"
-    setVar _ = ""
-    showText :: Show a => a -> Text
-    showText = cs . show
+    setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
+                  " = " <> insertableValue val <> ";"
 
 setRole :: Text -> Text
 setRole role = "set local role " <> cs (pgFmtLit role) <> ";"

From 8b5f4e8556101caf4e6c8c707e412a7d9c5a6cd2 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Sun, 18 Oct 2015 17:14:11 -0400
Subject: [PATCH 17/81] Removes lenses and uses simpler approach to generate
 JWT claims. Also fixes the setVar to avoid the ::unknown type cast from
 insertableValue

---
 postgrest.cabal       |  6 ------
 src/PostgREST/Auth.hs | 28 +++++++++++++++-------------
 2 files changed, 15 insertions(+), 19 deletions(-)

diff --git a/postgrest.cabal b/postgrest.cabal
index 2b3642b6c..38f5bf364 100644
--- a/postgrest.cabal
+++ b/postgrest.cabal
@@ -53,8 +53,6 @@ executable postgrest
                      , mtl
                      , cassava
                      , jwt
-                     , lens
-                     , lens-aeson >= 1.0.0.5
                      , parsec
                      , errors
                      , bifunctors
@@ -88,8 +86,6 @@ library
                      , hasql-postgres
                      , http-types
                      , jwt
-                     , lens
-                     , lens-aeson >= 1.0.0.5
                      , mtl
                      , network
                      , network-uri
@@ -181,8 +177,6 @@ Test-Suite spec
                      , process
                      , heredoc
                      , jwt
-                     , lens
-                     , lens-aeson >= 1.0.0.5
                      , parsec
                      , errors
                      , bifunctors
diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index f7cce5fec..8b8f6e32b 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -7,17 +7,16 @@ module PostgREST.Auth (
 
 import           Control.Applicative
 import           Data.Aeson
-import           Data.Map (fromList, toList)
-import           Data.Maybe (fromMaybe)
+import           Data.Aeson.Types (emptyObject, emptyArray)
+import           Data.Vector as V (null, head)
+import           Data.Map as M (fromList, toList)
 import           Data.Monoid
 import           Data.String.Conversions (cs)
 import           Data.Text (Text)
-import           PostgREST.PgQuery       (pgFmtLit, pgFmtIdent, insertableValue)
+import           PostgREST.PgQuery       (pgFmtLit, pgFmtIdent, unquoted)
 import           Prelude
 import qualified Web.JWT                 as JWT
-import qualified Data.HashMap.Lazy       as HashMap
-import Data.Aeson.Lens
-import Control.Lens.Operators
+import qualified Data.HashMap.Lazy       as H
 
 setJWTEnv :: Text -> Text -> Maybe [Text]
 setJWTEnv secret input = setDBEnv $ jwtClaims secret input
@@ -28,7 +27,8 @@ setDBEnv maybeClaims =
   where
     setVar ("role", String val) = setRole val
     setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
-                  " = " <> insertableValue val <> ";"
+                  " = " <> valueToVariable val <> ";"
+    valueToVariable = pgFmtLit . unquoted
 
 setRole :: Text -> Text
 setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
@@ -40,9 +40,11 @@ jwtClaims secret input = claims
     decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
 tokenJWT :: Text -> Value -> Text
-tokenJWT secret claims = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet
-  where
-    claimsSet = JWT.def {
-      JWT.unregisteredClaims = Data.Map.fromList claimsList
-    }
-    claimsList =  fromMaybe [] $ HashMap.toList <$> (claims ^? nth 0 . _Object)
+tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 (JWT.secret secret)
+                               JWT.def { JWT.unregisteredClaims = fromHashMap o }
+                          where
+                            Object o = if V.null a then emptyObject else V.head a
+tokenJWT secret _          = tokenJWT secret emptyArray
+
+fromHashMap :: Object -> JWT.ClaimsMap
+fromHashMap = M.fromList . H.toList

From f56efeb039783dbfcf546c4d3ca95833657f6988 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Sun, 18 Oct 2015 20:02:33 -0400
Subject: [PATCH 18/81] Reduces conde duplication assimbling response vody for
 RPC

---
 src/PostgREST/App.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 18248ddff..bcd0627e1 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -176,9 +176,10 @@ app dbstructure conf reqBody req =
                 asJson (callProc qi $ fromMaybe M.empty (decode reqBody))
           bodyJson :: Maybe (Identity Value) <- H.maybeEx call
           return $ responseLBS status200 [jsonH]
-                (if hasPrefer "return=jwt"
-                   then ("{\"token\":\"" <> (cs $ tokenJWT jwtSecret $ fromMaybe "[]" $ runIdentity <$> bodyJson) <> "\"}")
-                   else (cs $ encode $ fromMaybe emptyArray $ runIdentity <$> bodyJson))
+                 (let body = fromMaybe emptyArray $ runIdentity <$> bodyJson in
+                    if hasPrefer "return=jwt"
+                    then ("{\"token\":\"" <> (cs $ tokenJWT jwtSecret $ body) <> "\"}")
+                    else (cs $ encode $ body))
         else return $ responseLBS status404 [] ""
 
       -- check that proc exists

From 4e9afc8096253caa1f9428a11b5baf8399486958 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Sun, 18 Oct 2015 20:05:34 -0400
Subject: [PATCH 19/81] Adds import needed by ghc 7.8

---
 src/PostgREST/Middleware.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index 119f5f939..164b37a15 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -3,6 +3,9 @@
 
 module PostgREST.Middleware where
 
+-- needed for ghc 7.8
+import           Data.Functor ((<$>))
+
 import           Data.Maybe                    (fromMaybe, isNothing)
 import           Data.Monoid
 import           Data.Text

From a3aba84ba8485328fc8444cc7d217c57ed0c8810 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Sun, 18 Oct 2015 20:10:26 -0400
Subject: [PATCH 20/81] Fixes linter suggestions

---
 src/PostgREST/App.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index bcd0627e1..be2f366ea 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -178,8 +178,8 @@ app dbstructure conf reqBody req =
           return $ responseLBS status200 [jsonH]
                  (let body = fromMaybe emptyArray $ runIdentity <$> bodyJson in
                     if hasPrefer "return=jwt"
-                    then ("{\"token\":\"" <> (cs $ tokenJWT jwtSecret $ body) <> "\"}")
-                    else (cs $ encode $ body))
+                    then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
+                    else cs $ encode body)
         else return $ responseLBS status404 [] ""
 
       -- check that proc exists

From 2ea7bc29c64e165003a4a672e031e375f005c390 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Tue, 20 Oct 2015 00:43:21 -0400
Subject: [PATCH 21/81] Moves function from top level to where

---
 src/PostgREST/Auth.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index 8b8f6e32b..20a7d0285 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -44,7 +44,7 @@ tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 (JWT.secret secret)
                                JWT.def { JWT.unregisteredClaims = fromHashMap o }
                           where
                             Object o = if V.null a then emptyObject else V.head a
+                            fromHashMap :: Object -> JWT.ClaimsMap
+                            fromHashMap = M.fromList . H.toList
 tokenJWT secret _          = tokenJWT secret emptyArray
 
-fromHashMap :: Object -> JWT.ClaimsMap
-fromHashMap = M.fromList . H.toList

From 044e3865acf1adc8e3ee916db04b56ef5a124521 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Tue, 20 Oct 2015 01:03:11 -0400
Subject: [PATCH 22/81] Removes 'Prefer: return=jwt' header and chooses jwt
 return based on function type

---
 src/PostgREST/App.hs         |  3 ++-
 src/PostgREST/PgStructure.hs | 22 ++++++++++++++++++----
 2 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index be2f366ea..50106fac2 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -175,9 +175,10 @@ app dbstructure conf reqBody req =
           let call = B.Stmt "select " V.empty True <>
                 asJson (callProc qi $ fromMaybe M.empty (decode reqBody))
           bodyJson :: Maybe (Identity Value) <- H.maybeEx call
+          returnJWT <- doesProcReturnJWT schema proc
           return $ responseLBS status200 [jsonH]
                  (let body = fromMaybe emptyArray $ runIdentity <$> bodyJson in
-                    if hasPrefer "return=jwt"
+                    if returnJWT
                     then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
                     else cs $ encode body)
         else return $ responseLBS status404 [] ""
diff --git a/src/PostgREST/PgStructure.hs b/src/PostgREST/PgStructure.hs
index 8ed08873b..a33d7829d 100644
--- a/src/PostgREST/PgStructure.hs
+++ b/src/PostgREST/PgStructure.hs
@@ -13,25 +13,39 @@ import           Data.Monoid
 import           Data.Text             (Text, split)
 import qualified Hasql                 as H
 import qualified Hasql.Postgres        as P
+import qualified Hasql.Backend         as B
 import           PostgREST.PgQuery     ()
 import           PostgREST.Types
 
 import           GHC.Exts              (groupWith)
 import           Prelude
 
+doesProc :: forall c s. B.CxValue c Int =>
+            (Text -> Text -> B.Stmt c) -> Text -> Text -> H.Tx c s Bool
+doesProc stmt schema proc = do
+  row :: Maybe (Identity Int) <- H.maybeEx $ stmt schema proc
+  return $ isJust row
 
 doesProcExist :: Text -> Text -> H.Tx P.Postgres s Bool
-doesProcExist schema proc = do
-  row :: Maybe (Identity Int) <- H.maybeEx $ [H.stmt|
+doesProcExist = doesProc [H.stmt|
       SELECT 1
       FROM   pg_catalog.pg_namespace n
       JOIN   pg_catalog.pg_proc p
       ON     pronamespace = n.oid
       WHERE  nspname = ?
       AND    proname = ?
-    |] schema proc
-  return $ isJust row
+    |]
 
+doesProcReturnJWT :: Text -> Text -> H.Tx P.Postgres s Bool
+doesProcReturnJWT = doesProc [H.stmt|
+      SELECT 1
+      FROM   pg_catalog.pg_namespace n
+      JOIN   pg_catalog.pg_proc p
+      ON     pronamespace = n.oid
+      WHERE  nspname = ?
+      AND    proname = ?
+      AND    pg_catalog.pg_get_function_result(p.oid) = 'jwt'
+    |]
 
 tableFromRow :: (Text, Text, Bool, Maybe Text) -> Table
 tableFromRow (s, n, i, a) = Table s n i (parseAcl a)

From a192cadcedf93c5f7c61b0865591c33a31249190 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Tue, 20 Oct 2015 19:20:53 -0400
Subject: [PATCH 23/81] All green :D

---
 src/PostgREST/PgStructure.hs  |  4 ++--
 test/Feature/AuthSpec.hs      | 45 +++--------------------------------
 test/Feature/InsertSpec.hs    |  3 ++-
 test/Feature/StructureSpec.hs |  3 +--
 test/fixtures/schema.sql      | 35 +++++++++++++++++++--------
 5 files changed, 33 insertions(+), 57 deletions(-)

diff --git a/src/PostgREST/PgStructure.hs b/src/PostgREST/PgStructure.hs
index a33d7829d..df736cf3a 100644
--- a/src/PostgREST/PgStructure.hs
+++ b/src/PostgREST/PgStructure.hs
@@ -44,7 +44,7 @@ doesProcReturnJWT = doesProc [H.stmt|
       ON     pronamespace = n.oid
       WHERE  nspname = ?
       AND    proname = ?
-      AND    pg_catalog.pg_get_function_result(p.oid) = 'jwt'
+      AND    pg_catalog.pg_get_function_result(p.oid) = 'jwt_claims'
     |]
 
 tableFromRow :: (Text, Text, Bool, Maybe Text) -> Table
@@ -167,7 +167,7 @@ allRelations = do
 allColumns :: [Relation] -> H.Tx P.Postgres s [Column]
 allColumns rels = do
   cols <- H.listEx $ [H.stmt|
-      SELECT
+      SELECT DISTINCT
           info.table_schema AS schema,
           info.table_name AS table_name,
           info.column_name AS name,
diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs
index 7362e7a15..c12bcdee0 100644
--- a/test/Feature/AuthSpec.hs
+++ b/test/Feature/AuthSpec.hs
@@ -18,50 +18,11 @@ spec = beforeAll
   it "hides tables that anonymous does not own" $
     get "/authors_only" `shouldRespondWith` 404
 
-  it "indicates login failure (BasicAuth)" $ do
-    let auth = authHeaderBasic "postgrest_test_author" "fakefake"
-    request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 401
-
-  it "allows users with permissions to see their tables (BasicAuth)" $ do
-    _ <- post "/postgrest/users" [json| { "id": "jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
-    let auth = authHeaderBasic "jdoe" "1234"
-    request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 200
-
-  it "respects database constraints for role" $
-    post "/postgrest/users" [json| { "id": "ssmith", "pass": "1234", "role": "SUPER_ADMIN_TRUNCATE_POWERS" } |]
-      `shouldRespondWith` 400
-
-  it "does not send a value when no role is provided" $ do
-    post "/postgrest/users" [json| { "id": "bdeey", "pass": "1234" } |]
-      `shouldRespondWith` 201
-    let auth = authHeaderBasic "jdoe" "1234"
-    request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 200
-
-  it "recovers after 400 error with logged in user" $ do
-    _ <- post "/postgrest/users" [json| { "id": "jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
-    let auth = authHeaderBasic "jdoe" "1234"
-    _ <- request methodPost "/rpc/problem" [auth] ""
-    request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 200
-
-  it "allows users to login (JWT)" $ do
-    _ <- post "/postgrest/users" [json| { "id": "jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
-    post "/postgrest/tokens" [json| { "id": "jdoe", "pass": "1234" } |]
+  it "returns jwt functions as jwt tokens" $ do
+    post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |]
       `shouldRespondWith` ResponseMatcher {
           matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"} |]
-        , matchStatus = 201
-        , matchHeaders = ["Content-Type" <:> "application/json"]
-        }
-
-  it "indicates login failure (JWT)" $ do
-    _ <- post "/postgrest/users" [json| { "id": "jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
-    post "/postgrest/tokens" [json| { "id": "jdoe", "pass": "NOPE" } |]
-      `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| {"message":"Failed authentication."} |]
-        , matchStatus = 401
+        , matchStatus = 200
         , matchHeaders = ["Content-Type" <:> "application/json"]
         }
 
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index 7d19e5683..91c5c0b04 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -284,11 +284,12 @@ spec = afterAll_ resetDb $ around withApp $ do
 
   describe "Row level permission" $
     it "set user_id when inserting rows" $ do
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
       _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
       _ <- post "/postgrest/users" [json| { "id":"jroe", "pass": "1234", "role": "postgrest_test_author" } |]
 
       p1 <- request methodPost "/authors_only"
-        [ authHeaderBasic "jdoe" "1234", ("Prefer", "return=representation") ]
+        [ auth, ("Prefer", "return=representation") ]
         [json| { "secret": "nyancat" } |]
       liftIO $ do
           simpleBody p1 `shouldBe` [json| { "owner":"jdoe", "secret":"nyancat" } |]
diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs
index 187584f28..2a28f43db 100644
--- a/test/Feature/StructureSpec.hs
+++ b/test/Feature/StructureSpec.hs
@@ -40,8 +40,7 @@ spec = around withApp $ do
         {matchStatus = 200}
 
     it "lists only views user has permission to see" $ do
-      _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
-      let auth = authHeaderBasic "jdoe" "1234"
+      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
 
       request methodGet "/" [auth] ""
         `shouldRespondWith` [json| [
diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql
index 2066c4f68..61ab265c6 100755
--- a/test/fixtures/schema.sql
+++ b/test/fixtures/schema.sql
@@ -76,7 +76,7 @@ CREATE FUNCTION set_authors_only_owner() RETURNS trigger
     LANGUAGE plpgsql
     AS $$
 begin
-  NEW.owner = current_setting('user_vars.user_id');
+  NEW.owner = current_setting('postgrest.claims.id');
   RETURN NEW;
 end
 $$;
@@ -268,15 +268,6 @@ CREATE VIEW test.projects_view AS
       projects.client_id
   FROM projects;
 ALTER TABLE test.projects_view OWNER TO postgrest_test;
-------- SAMPLE DATA -----
-INSERT INTO clients VALUES (1, 'Microsoft'),(2, 'Apple');
-INSERT INTO projects VALUES (1,'Windows 7', 1),(2,'Windows 10', 1),(3,'IOS', 2),(4,'OSX', 2);
-INSERT INTO tasks VALUES (1,'Design w7',1),(2,'Code w7',1),(3,'Design w10',2),(4,'Code w10',2),(5,'Design IOS',3),(6,'Code IOS',3),(7,'Design OSX',4),(8,'Code OSX',4);
-INSERT INTO users VALUES (1, 'Angela Martin'),(2, 'Michael Scott'),(3, 'Dwight Schrute');
-INSERT INTO users_projects VALUES(1,1),(1,2),(2,3),(2,4),(3,1),(3,3);
-INSERT INTO users_tasks VALUES(1,1),(1,2),(1,3),(1,4),(2,5),(2,6),(2,7),(3,1),(3,5);
-INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP');
-----------------
 
 CREATE SEQUENCE items_id_seq
     START WITH 1
@@ -298,6 +289,13 @@ CREATE FUNCTION test.getitemrange(min bigint, max bigint) RETURNS SETOF test.ite
 $$ LANGUAGE SQL;
 
 
+CREATE TYPE public.jwt_claims AS (role text, id text);
+CREATE FUNCTION test.login(id text, pass text)
+RETURNS public.jwt_claims
+SECURITY DEFINER
+AS $$
+SELECT rolname::text, id::text FROM postgrest.auth WHERE id = id AND pass = pass;
+$$ LANGUAGE SQL;
 
 CREATE FUNCTION test.sayhello(name text) RETURNS text AS $$
     SELECT 'Hello, ' || $1;
@@ -663,6 +661,10 @@ REVOKE ALL ON FUNCTION getitemrange(bigint, bigint) FROM postgrest_test;
 GRANT EXECUTE ON FUNCTION getitemrange(bigint, bigint) TO postgrest_test;
 GRANT EXECUTE ON FUNCTION getitemrange(bigint, bigint) TO postgrest_anonymous;
 
+REVOKE ALL ON FUNCTION login(text, text) FROM PUBLIC;
+REVOKE ALL ON FUNCTION login(text, text) FROM postgrest_test;
+GRANT EXECUTE ON FUNCTION login(text, text) TO postgrest_test;
+GRANT EXECUTE ON FUNCTION login(text, text) TO postgrest_anonymous;
 
 REVOKE ALL ON FUNCTION sayhello(text) FROM PUBLIC;
 REVOKE ALL ON FUNCTION sayhello(text) FROM postgrest_test;
@@ -758,3 +760,16 @@ SET search_path = private, pg_catalog;
 REVOKE ALL ON TABLE articles FROM PUBLIC;
 REVOKE ALL ON TABLE articles FROM postgrest_test;
 GRANT ALL ON TABLE articles TO postgrest_test;
+
+SET search_path = test, private, postgrest, public, pg_catalog;
+
+------- SAMPLE DATA -----
+INSERT INTO clients VALUES (1, 'Microsoft'),(2, 'Apple');
+INSERT INTO projects VALUES (1,'Windows 7', 1),(2,'Windows 10', 1),(3,'IOS', 2),(4,'OSX', 2);
+INSERT INTO tasks VALUES (1,'Design w7',1),(2,'Code w7',1),(3,'Design w10',2),(4,'Code w10',2),(5,'Design IOS',3),(6,'Code IOS',3),(7,'Design OSX',4),(8,'Code OSX',4);
+INSERT INTO users VALUES (1, 'Angela Martin'),(2, 'Michael Scott'),(3, 'Dwight Schrute');
+INSERT INTO users_projects VALUES(1,1),(1,2),(2,3),(2,4),(3,1),(3,3);
+INSERT INTO users_tasks VALUES(1,1),(1,2),(1,3),(1,4),(2,5),(2,6),(2,7),(3,1),(3,5);
+INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP');
+INSERT INTO postgrest.auth (id, pass, rolname) VALUES ('jdoe', '1234', 'postgrest_test_author');
+----------------

From 6e55017f9687063c0d7ea1604f7b23f6a3a2c4cc Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Tue, 20 Oct 2015 19:48:54 -0400
Subject: [PATCH 24/81] Cleans and adds haddock comments

---
 src/PostgREST/Auth.hs | 56 +++++++++++++++++++++++++++----------------
 test/SpecHelper.hs    |  5 ----
 2 files changed, 36 insertions(+), 25 deletions(-)

diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index 20a7d0285..8ddfa1dea 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -1,3 +1,15 @@
+{-|
+Module      : PostgREST.Auth
+Description : PostgREST authorization functions.
+
+This module provides functions to deal with the JWT authorization (http://jwt.io).
+It also can be used to define other authorization functions,
+in the future Oauth, LDAP and similar integrations can be coded here.
+
+Authentication should always be implemented in an external service.
+In the test suite there is an example of simple login function that can be used for a
+very simple authentication system inside the PostgreSQL database.
+-}
 {-# LANGUAGE FlexibleContexts #-}
 module PostgREST.Auth (
   setRole
@@ -5,40 +17,45 @@ module PostgREST.Auth (
   , tokenJWT
   ) where
 
-import           Control.Applicative
-import           Data.Aeson
-import           Data.Aeson.Types (emptyObject, emptyArray)
-import           Data.Vector as V (null, head)
-import           Data.Map as M (fromList, toList)
-import           Data.Monoid
+import           Data.Aeson              (Value (..), Object)
+import           Data.Aeson.Types        (emptyObject, emptyArray)
+import           Data.Vector             as V (null, head)
+import           Data.Map                as M (fromList, toList)
+import           Data.Monoid             ((<>))
 import           Data.String.Conversions (cs)
-import           Data.Text (Text)
+import           Data.Text               (Text)
 import           PostgREST.PgQuery       (pgFmtLit, pgFmtIdent, unquoted)
-import           Prelude
 import qualified Web.JWT                 as JWT
 import qualified Data.HashMap.Lazy       as H
 
+{-|
+  Receives the JWT secret (from config) and a JWT and
+  returns a list of PostgreSQL statements to set the claims
+  as user defined GUCs.
+  Except if we have a claim called role, this one is mapped to
+  a SET ROLE statement.
+  In case there is any problem decoding the JWT it returns Nothing.
+-}
 setJWTEnv :: Text -> Text -> Maybe [Text]
-setJWTEnv secret input = setDBEnv $ jwtClaims secret input
-
-setDBEnv :: Maybe JWT.ClaimsMap -> Maybe [Text]
-setDBEnv maybeClaims =
-  (map setVar . toList) <$> maybeClaims
+setJWTEnv secret input = setDBEnv jwtClaims
   where
+    setDBEnv maybeClaims = (map setVar . toList) <$> maybeClaims
     setVar ("role", String val) = setRole val
     setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
-                  " = " <> valueToVariable val <> ";"
+                      " = " <> valueToVariable val <> ";"
     valueToVariable = pgFmtLit . unquoted
+    jwtClaims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
+    decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
+-- | Receives the name of a role and returns a SET ROLE statement
 setRole :: Text -> Text
 setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
 
-jwtClaims :: Text -> Text -> Maybe JWT.ClaimsMap
-jwtClaims secret input = claims
-  where
-    claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
-    decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
+{-|
+  Receives the JWT secret (from config) and a JWT and a JSON value
+  and returns a signed JWT.
+-}
 tokenJWT :: Text -> Value -> Text
 tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 (JWT.secret secret)
                                JWT.def { JWT.unregisteredClaims = fromHashMap o }
@@ -47,4 +64,3 @@ tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 (JWT.secret secret)
                             fromHashMap :: Object -> JWT.ClaimsMap
                             fromHashMap = M.fromList . H.toList
 tokenJWT secret _          = tokenJWT secret emptyArray
-
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index 52e2387f5..bf7042c11 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -20,7 +20,6 @@ import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
 import Codec.Binary.Base64.String (encode)
 import Data.CaseInsensitive (CI(..))
 import Data.Maybe (fromMaybe)
-import Data.Functor.Identity
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
 import System.Process (readProcess)
@@ -55,10 +54,6 @@ withApp perform = do
   pool :: H.Pool P.Postgres
     <- H.acquirePool pgSettings testPoolOpts
 
-  Right authenticator <- H.session pool $ do
-    Identity (role :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SELECT SESSION_USER|]
-    return role
-
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
     tabs <- allTables

From 250a4dcfb29950cfd2e77abf7e57c44cab188ba4 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Tue, 20 Oct 2015 19:51:25 -0400
Subject: [PATCH 25/81] Adds back import to make GHC 7.8 happy

---
 src/PostgREST/Auth.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index 8ddfa1dea..daa75b4af 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -17,6 +17,9 @@ module PostgREST.Auth (
   , tokenJWT
   ) where
 
+--line needed for ghc 7.8
+import           Data.Functor            ((<$>))
+ 
 import           Data.Aeson              (Value (..), Object)
 import           Data.Aeson.Types        (emptyObject, emptyArray)
 import           Data.Vector             as V (null, head)

From 81ee7cbd5e929caf2af351b1285f975c18d19eeb Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Tue, 20 Oct 2015 19:54:29 -0400
Subject: [PATCH 26/81] Removes redundant do

---
 test/Feature/AuthSpec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs
index c12bcdee0..8c593a42b 100644
--- a/test/Feature/AuthSpec.hs
+++ b/test/Feature/AuthSpec.hs
@@ -18,7 +18,7 @@ spec = beforeAll
   it "hides tables that anonymous does not own" $
     get "/authors_only" `shouldRespondWith` 404
 
-  it "returns jwt functions as jwt tokens" $ do
+  it "returns jwt functions as jwt tokens" $
     post "/rpc/login" [json| { "id": "jdoe", "pass": "1234" } |]
       `shouldRespondWith` ResponseMatcher {
           matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"} |]

From 71ef03070e665c43d5b69b3eb31913bcc841704c Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Wed, 21 Oct 2015 12:46:01 +0300
Subject: [PATCH 27/81] POST path modified with internal data type but tests
 failing (no Location and data returned as array)

---
 src/PostgREST/App.hs          | 237 +++++++++++++++++++++++++---------
 src/PostgREST/Parsers.hs      |  39 +-----
 src/PostgREST/QueryBuilder.hs |  37 +++++-
 src/PostgREST/Types.hs        |  10 +-
 src/mock.hs                   |  43 ++++++
 5 files changed, 266 insertions(+), 100 deletions(-)
 create mode 100644 src/mock.hs

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 201a75aa0..e89357c62 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -1,13 +1,18 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-module PostgREST.App (
-  app
-, sqlError
-, isSqlError
-, contentTypeForAccept
-, jsonH
-, TableOptions(..)
-) where
+{-# LANGUAGE TupleSections #-}
+module PostgREST.App where
+-- module PostgREST.App (
+--   app
+-- , sqlError
+-- , isSqlError
+-- , contentTypeForAccept
+-- , jsonH
+-- , TableOptions(..)
+-- , parsePostRequest
+-- , rr
+-- , bb
+-- ) where
 
 import qualified Blaze.ByteString.Builder  as BB
 import           Control.Applicative
@@ -20,24 +25,29 @@ import           Data.CaseInsensitive      (original)
 import qualified Data.Csv                  as CSV
 import           Data.Functor.Identity
 import qualified Data.HashMap.Strict       as M
-import           Data.List                 (find, sortBy)
-import           Data.Maybe                (fromMaybe, isJust, isNothing,
+import           Data.List                 (find, sortBy, delete, transpose)
+import           Data.Maybe                (fromMaybe, fromJust, isJust, isNothing,
                                             mapMaybe)
 import           Data.Ord                  (comparing)
 import           Data.Ranged.Ranges        (emptyRange)
 import qualified Data.Set                  as S
 import           Data.String.Conversions   (cs)
 import           Data.Text                 (Text, replace, strip)
+import           Data.Tree
+--import           Data.Foldable             (forlrM)
 
 import           Text.Parsec.Error
+import           Text.ParserCombinators.Parsec (parse)
 
 import           Network.HTTP.Base         (urlEncodeVars)
 import           Network.HTTP.Types.Header
 import           Network.HTTP.Types.Status
 import           Network.HTTP.Types.URI    (parseSimpleQuery)
 import           Network.Wai
-import           Network.Wai.Internal      (Response (..))
+--import           Network.Wai.Internal
+import           Network.Wai.Internal      (Response (..), Request (..))
 import           Network.Wai.Parse         (parseHttpAccept)
+import Text.Heredoc
 
 import           Data.Aeson
 import           Data.Monoid
@@ -112,25 +122,12 @@ app dbstructure conf authenticator reqBody dbrole req =
             apiRequest = first formatParserError (parseGetRequest req)
                      >>= first formatRelationError . addRelations schema allRels Nothing
                      >>= addJoinConditions schema allCols
-                     where
-                       formatRelationError :: Text -> Text
-                       formatRelationError e = cs $ encode $ object [
-                         "mesage" .= ("could not find foreign keys between these entities"::String),
-                         "details" .= e]
-                       formatParserError :: ParseError -> Text
-                       formatParserError e = cs $ encode $ object [
-                         "message" .= message,
-                         "details" .= details]
-                         where
-                           message = show (errorPos e)
-                           details = strip $ replace "\n" " " $ cs
-                             $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+
 
             query = requestToQuery schema <$> apiRequest
             countQuery = requestToCountQuery schema <$> apiRequest
             queries = (,) <$> query <*> countQuery
 
-
     (["postgrest", "users"], "POST") -> do
       let user = decode reqBody :: Maybe AuthUser
 
@@ -166,39 +163,57 @@ app dbstructure conf authenticator reqBody dbrole req =
                   encode . object $ [("message", String "Failed authentication.")]
 
     ([table], "POST") -> do
-      let qt = qualify table
-          echoRequested = hasPrefer "return=representation"
-          parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value))
-          parsed = if lookupHeader "Content-Type" == Just csvMT
-            then do
-              rows <- CSV.decode CSV.NoHeader reqBody
-              if V.null rows then Left "CSV requires header"
-                else Right (V.head rows, (V.map $ V.map $ parseCsvCell . cs) (V.tail rows))
-            else eitherDecode reqBody >>= \val ->
-              case val of
-                Object obj -> Right .  second V.singleton .  V.unzip .  V.fromList $
-                  M.toList obj
-                _ -> Left "Expecting single JSON object or CSV rows"
-      case parsed of
-        Left err -> return $ responseLBS status400 [] $
-          encode . object $ [("message", String $ "Failed to parse JSON payload. " <> cs err)]
-        Right toBeInserted -> do
-          rows :: [Identity Text] <- H.listEx $ uncurry (insertInto qt) toBeInserted
-          let inserted :: [Object] = mapMaybe (decode . cs . runIdentity) rows
-              pKeys = map pkName $ filter (filterPk schema table) allPrKeys
-              responses = flip map inserted $ \obj -> do
-                let primaries =
-                      if Prelude.null pKeys
-                        then obj
-                        else M.filterWithKey (const . (`elem` pKeys)) obj
-                let params = urlEncodeVars
-                      $ map (\t -> (cs $ fst t, cs (paramFilter $ snd t)))
-                      $ sortBy (comparing fst) $ M.toList primaries
-                responseLBS status201
-                  [ jsonH
-                  , (hLocation, "/" <> cs table <> "?" <> cs params)
-                  ] $ if echoRequested then encode obj else ""
-          return $ multipart status201 responses
+      let echoRequested = hasPrefer "return=representation"
+      case query of
+        Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
+        Right q -> do
+          row <- H.maybeEx q
+          let (queryTotal, body) = fromMaybe (Just (0::Int), Just "" :: Maybe BL.ByteString) row
+          return $ responseLBS status201
+            [jsonH]
+            $ if echoRequested then (fromMaybe "[]" body) else ""
+        -- let qt = qualify table
+      --     echoRequested = hasPrefer "return=representation"
+      --     parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value))
+      --     parsed = if lookupHeader "Content-Type" == Just csvMT
+      --       then do
+      --         rows <- CSV.decode CSV.NoHeader reqBody
+      --         if V.null rows then Left "CSV requires header"
+      --           else Right (V.head rows, (V.map $ V.map $ parseCsvCell . cs) (V.tail rows))
+      --       else eitherDecode reqBody >>= \val ->
+      --         case val of
+      --           Object obj -> Right .  second V.singleton .  V.unzip .  V.fromList $
+      --             M.toList obj
+      --           _ -> Left "Expecting single JSON object or CSV rows"
+      -- case parsed of
+      --   Left err -> return $ responseLBS status400 [] $
+      --     encode . object $ [("message", String $ "Failed to parse JSON payload. " <> cs err)]
+      --   Right toBeInserted -> do
+      --     rows :: [Identity Text] <- H.listEx $ uncurry (insertInto qt) toBeInserted
+      --     let inserted :: [Object] = mapMaybe (decode . cs . runIdentity) rows
+      --         pKeys = map pkName $ filter (filterPk schema table) allPrKeys
+      --         responses = flip map inserted $ \obj -> do
+      --           let primaries =
+      --                 if Prelude.null pKeys
+      --                   then obj
+      --                   else M.filterWithKey (const . (`elem` pKeys)) obj
+      --           let params = urlEncodeVars
+      --                 $ map (\t -> (cs $ fst t, cs (paramFilter $ snd t)))
+      --                 $ sortBy (comparing fst) $ M.toList primaries
+      --           responseLBS status201
+      --             [ jsonH
+      --             , (hLocation, "/" <> cs table <> "?" <> cs params)
+      --             ] $ if echoRequested then encode obj else ""
+      --     return $ multipart status201 responses
+
+      where
+        apiRequest = parsePostRequest req reqBody
+        insertQuery = requestToQuery schema <$> apiRequest
+        query = withT
+            <$> insertQuery
+            <*> pure "t"
+            <*> pure (B.Stmt "select count(t), array_to_json(array_agg(row_to_json(t)))::character varying" V.empty True)
+
 
     (["rpc", proc], "POST") -> do
       let qi = QualifiedIdentifier schema (cs proc)
@@ -391,6 +406,112 @@ multipart s rs =
     renderResponseBody _ = error
       "Unable to create multipart response from non-ResponseBuilder"
 
+
+formatRelationError :: Text -> Text
+formatRelationError e = cs $ encode $ object [
+  "mesage" .= ("could not find foreign keys between these entities"::String),
+  "details" .= e]
+formatParserError :: ParseError -> Text
+formatParserError e = cs $ encode $ object [
+  "message" .= message,
+  "details" .= details]
+  where
+     message = show (errorPos e)
+     details = strip $ replace "\n" " " $ cs
+       $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+--parsePostRequest :: Request -> BL.ByteString -> Either String (V.Vector Text, V.Vector (V.Vector Value))
+parsePostRequest :: Request -> BL.ByteString -> Either Text ApiRequest
+parsePostRequest httpRequest reqBody =
+  Node <$> apiNode <*> pure []
+  where
+    apiNode = (,) <$> (Insert rootTableName <$> flds <*> vals) <*> pure (rootTableName, Nothing)
+    flds =  join $ first formatParserError . (mapM (parseField . cs)) <$> (fst <$> parsed)
+    vals = snd <$> parsed
+    parseField f = parse pField ("failed to parse field <<"++f++">>") f
+    parsed :: Either Text ([Text],[[Value]])
+    parsed = first cs $
+      (\v->
+        if headerMatchesContent v
+        then Right v
+        else
+          if isCsv
+          then Left "CSV header does not match rows length"
+          else Left "The number of keys in objects do not match"
+      ) =<<
+      if isCsv
+      then do
+        rows <- (map (V.toList) . V.toList) <$> CSV.decode CSV.NoHeader reqBody
+        if null rows then Left "CSV requires header"
+          else Right (head rows, (map $ map $ parseCsvCell . cs) (tail rows))
+      else eitherDecode reqBody >>= \val -> convertJson val
+    hdrs          = requestHeaders httpRequest
+    lookupHeader  = flip lookup hdrs
+    rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
+    isCsv = lookupHeader "Content-Type" == Just csvMT
+
+headerMatchesContent :: ([Text], [[Value]]) -> Bool
+headerMatchesContent (header, vals) = all ( (headerLength ==) . length) vals
+  where headerLength = length header
+
+convertJson :: Value -> Either String ([Text],[[Value]])
+convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
+  where
+    invalidMsg = "Expecting single JSON object or JSON array of objects"
+    normalized :: Either String [(Text, [Value])]
+    normalized = groupByKey =<< normalizeValue v
+
+    vals :: [(Text, [Value])] -> [[Value]]
+    vals a = transpose $ map snd a
+
+    header :: [(Text, [Value])] -> [Text]
+    header = map fst
+
+    groupByKey :: Value -> Either String [(Text,[Value])]
+    groupByKey (Array a) = M.toList . foldr (M.unionWith (++)) (M.fromList []) <$> maps
+      where
+        maps :: Either String [M.HashMap Text [Value]]
+        maps = mapM getElems $ V.toList a
+        getElems (Object o) = Right $ M.map (\x->[x]) o
+        getElems _ = Left invalidMsg
+    groupByKey _ = Left invalidMsg
+
+    normalizeValue :: Value -> Either String Value
+    normalizeValue val =
+      case val of
+        Object obj  -> Right $ Array (V.fromList[Object obj])
+        a@(Array _) -> Right a
+        _ -> Left invalidMsg
+
+parseGetRequest :: Request -> Either ParseError ApiRequest
+parseGetRequest httpRequest =
+  foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
+  where
+    apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++selectStr++">>") $ cs selectStr
+    addOrder (Node (q,i) f) o = Node (q{order=o}, i) f
+    flts = mapM pRequestFilter whereFilters
+    rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
+    qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
+    orderStr = join $ lookup "order" qString
+    ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderStr++">>")) orderStr
+    selectStr = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qString --in case the parametre is missing or empty we default to *
+    whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ]
+
+addFilter :: (Path, Filter) -> ApiRequest -> ApiRequest
+addFilter ([], flt) (Node (q@(Select {where_=flts}), i) forest) = Node (q {where_=flt:flts}, i) forest
+addFilter (path, flt) (Node rn forest) =
+  case targetNode of
+    Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
+    Just tn -> Node rn (addFilter (remainingPath, flt) tn:restForest)
+  where
+    targetNodeName:remainingPath = path
+    (targetNode,restForest) = splitForest targetNodeName forest
+    splitForest name forst =
+      case maybeNode of
+        Nothing -> (Nothing,forest)
+        Just node -> (Just node, delete node forest)
+      where maybeNode = find ((name==).fst.snd.rootLabel) forst
+
+
 data TableOptions = TableOptions {
   tblOptcolumns :: [Column]
 , tblOptpkey    :: [Text]
diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs
index 5a59163d2..ba0d2bc24 100644
--- a/src/PostgREST/Parsers.hs
+++ b/src/PostgREST/Parsers.hs
@@ -1,6 +1,6 @@
 module PostgREST.Parsers
-( parseGetRequest
-)
+-- ( parseGetRequest
+-- )
 where
 
 import           Control.Applicative hiding ((<$>))
@@ -8,29 +8,16 @@ import           Control.Applicative hiding ((<$>))
 import           Data.Functor ((<$>))
 import           Data.Traversable (traverse)
 
-import           Control.Monad                 (join)
-import           Data.List                     (delete, find)
-import           Data.Maybe
+--import           Control.Monad                 (join)
+--import           Data.List                     (delete, find)
+--import           Data.Maybe
 import           Data.Monoid
 import           Data.String.Conversions       (cs)
 import           Data.Text                     (Text)
 import           Data.Tree
-import           Network.Wai                   (Request, pathInfo, queryString)
+--import           Network.Wai                   (Request, pathInfo, queryString)
 import           PostgREST.Types
 import           Text.ParserCombinators.Parsec hiding (many, (<|>))
-parseGetRequest :: Request -> Either ParseError ApiRequest
-parseGetRequest httpRequest =
-  foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
-  where
-    apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++selectStr++">>") $ cs selectStr
-    addOrder (Node (q,i) f) o = Node (q{order=o}, i) f
-    flts = mapM pRequestFilter whereFilters
-    rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
-    qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
-    orderStr = join $ lookup "order" qString
-    ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderStr++">>")) orderStr
-    selectStr = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qString --in case the parametre is missing or empty we default to *
-    whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ]
 
 pRequestSelect :: Text -> Parser ApiRequest
 pRequestSelect rootNodeName = do
@@ -53,20 +40,6 @@ pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
     op = fst <$> opVal
     val = snd <$> opVal
 
-addFilter :: (Path, Filter) -> ApiRequest -> ApiRequest
-addFilter ([], flt) (Node (q@(Select {where_=flts}), i) forest) = Node (q {where_=flt:flts}, i) forest
-addFilter (path, flt) (Node rn forest) =
-  case targetNode of
-    Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
-    Just tn -> Node rn (addFilter (remainingPath, flt) tn:restForest)
-  where
-    targetNodeName:remainingPath = path
-    (targetNode,restForest) = splitForest targetNodeName forest
-    splitForest name forst =
-      case maybeNode of
-        Nothing -> (Nothing,forest)
-        Just node -> (Just node, delete node forest)
-      where maybeNode = find ((name==).fst.snd.rootLabel) forst
 
 ws :: Parser Text
 ws = cs <$> many (oneOf " \t")
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index 96ce5079f..c0194b508 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -12,7 +12,7 @@ import           Control.Applicative
 import           Data.Tree
 import           PostgREST.PgQuery (PStmt, fromQi,
                                     orderT, pgFmtIdent, pgFmtLit, pgFmtOperator,
-                                    pgFmtValue, whiteList)
+                                    pgFmtValue, whiteList, insertableValue)
 import           PostgREST.Types
 import qualified Data.Vector       as V (empty)
 import qualified Hasql.Backend     as B
@@ -126,6 +126,34 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
     --posible relations are Child Parent Many
     getQueryParts (Node (_,(_,Nothing)) _) _ = undefined
+requestToQuery schema (Node (Insert tbl flds vals, (mainTbl, _)) forest) =
+  query
+  where
+    query = B.Stmt qStr V.empty True
+    qi = QualifiedIdentifier schema mainTbl
+    qStr = Data.Text.unwords [
+      "INSERT INTO ", fromQi qi,
+      " (" <> intercalate ", " (map (pgFmtIdent . fst) flds) <> ") ",
+      "VALUES " <> intercalate ", "
+        ( map (\v ->
+            "(" <>
+            intercalate ", " ( map insertableValue v ) <>
+            ")"
+          ) vals
+        ),
+      "RETURNING " <> fromQi qi <> ".*"
+      ]
+    -- ("insert into " <> fromQi t <> " (" <>
+    --   T.intercalate ", " (V.toList $ V.map pgFmtIdent cols) <>
+    --   ") values "
+    --   <> T.intercalate ", "
+    --     (V.toList $ V.map (\v -> "("
+    --         <> T.intercalate ", " (V.toList $ V.map insertableValue v)
+    --         <> ")"
+    --       ) vals
+    --     )
+    --   <> " returning row_to_json(" <> fromQi t <> ".*)")
+
 
 pgFmtCondition :: QualifiedIdentifier -> Filter -> Text
 pgFmtCondition table (Filter (col,jp) ops val) =
@@ -159,9 +187,12 @@ pgFmtJsonPath _ = ""
 pgFmtTable :: Table -> Text
 pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n
 
+pgFmtField :: QualifiedIdentifier -> Field -> Text
+pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
+
 pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Text
-pgFmtSelectItem table ((c, jp), Nothing) = pgFmtColumn table c <> pgFmtJsonPath jp <> asJsonPath jp
-pgFmtSelectItem table ((c, jp), Just cast ) = "CAST (" <> pgFmtColumn table c <> pgFmtJsonPath jp <> " AS " <> cast <> " )" <> asJsonPath jp
+pgFmtSelectItem table (f@(c, jp), Nothing) = pgFmtField table f <> asJsonPath jp
+pgFmtSelectItem table (f@(c, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> asJsonPath jp
 
 asJsonPath :: Maybe JsonPath -> Text
 asJsonPath Nothing = ""
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
index 51f219cf4..2dac663c1 100644
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -3,6 +3,7 @@ import Data.Text
 import Data.Tree
 import qualified Data.ByteString.Char8 as BS
 import Data.Aeson
+import Data.Map
 
 data DbStructure = DbStructure {
   tables :: [Table]
@@ -78,12 +79,9 @@ type Cast = Text
 type NodeName = Text
 type SelectItem = (Field, Maybe Cast)
 type Path = [Text]
-data Query = Select {
-  select::[SelectItem]
-, from::[Text]
-, where_::[Filter]
-, order::Maybe [OrderTerm]
-} deriving (Show, Eq)
+data Query = Select { select::[SelectItem], from::[Text], where_::[Filter], order::Maybe [OrderTerm] }
+           | Insert { into::Text, fields::[Field], values::[[Value]] }
+           | Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq)
 data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
 type ApiNode = (Query, (NodeName, Maybe Relation))
 type ApiRequest = Tree ApiNode
diff --git a/src/mock.hs b/src/mock.hs
new file mode 100644
index 000000000..411b3c309
--- /dev/null
+++ b/src/mock.hs
@@ -0,0 +1,43 @@
+arr = eitherDecode "[{\"a\":10},{\"a\":20}]" :: Either String Value
+ob = eitherDecode "{\"a\":10}"::Either String Value
+
+rc :: Request
+rc =  Request {
+  -- | Request method such as GET.
+     requestMethod = "POST"
+  ,  pathInfo = ["menagerie"]
+  ,  requestHeaders = [("Content-Type", "text/csv")] --      :: H.RequestHeaders
+  }
+bc :: BL.ByteString
+bc = [str|integer->sub->sub2,double,varchar,boolean,date,money,enum
+         |13,3.14159,testing!,false,1900-01-01,$3.99,foo
+         |12,0.1,NULL,true,1929-10-01,12,bar
+         |]
+
+rj :: Request
+rj =  Request {
+ -- | Request method such as GET.
+     requestMethod = "POST"
+  ,  pathInfo = ["menagerie"]
+  ,  requestHeaders = [("Content-Type", "application/json")] --      :: H.RequestHeaders
+  }
+bj :: BL.ByteString
+bj = [str|{
+         |  "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
+         |  , "boolean": false, "date": "1900-01-01", "money": "$3.99"
+         |  , "enum": "foo"
+         |}
+         |]
+bj2 :: BL.ByteString
+bj2 = [str|[
+          |{
+          |  "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
+          |  , "boolean": false, "date": "1900-01-01", "money": "$3.99"
+          |  , "enum": "foo"
+          |},
+          |{
+          |  "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
+          |  , "boolean": false, "date": "1900-01-01", "money": "$3.99"
+          |  , "enum": "foo"
+          |}]
+          |]

From d000a6c61a2fd8e080480f41a9409c331c2a68fe Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Thu, 22 Oct 2015 00:01:15 -0400
Subject: [PATCH 28/81] Eliminates SET role duplication and changes Auth module
 interface

---
 src/PostgREST/Auth.hs       | 29 ++++++++++++++++++-----------
 src/PostgREST/Middleware.hs | 17 +++++++++++------
 2 files changed, 29 insertions(+), 17 deletions(-)

diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index daa75b4af..94e36d90b 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-|
 Module      : PostgREST.Auth
 Description : PostgREST authorization functions.
@@ -10,10 +11,10 @@ Authentication should always be implemented in an external service.
 In the test suite there is an example of simple login function that can be used for a
 very simple authentication system inside the PostgreSQL database.
 -}
-{-# LANGUAGE FlexibleContexts #-}
 module PostgREST.Auth (
   setRole
-  , setJWTEnv
+  , claimsToSQL
+  , jwtClaims
   , tokenJWT
   ) where
 
@@ -32,22 +33,28 @@ import qualified Web.JWT                 as JWT
 import qualified Data.HashMap.Lazy       as H
 
 {-|
-  Receives the JWT secret (from config) and a JWT and
-  returns a list of PostgreSQL statements to set the claims
-  as user defined GUCs.
-  Except if we have a claim called role, this one is mapped to
-  a SET ROLE statement.
+  Receives a map of JWT claims and returns a list
+  of PostgreSQL statements to set the claims as user defined GUCs.
+  Except if we have a claim called role,
+  this one is mapped to a SET ROLE statement.
   In case there is any problem decoding the JWT it returns Nothing.
 -}
-setJWTEnv :: Text -> Text -> Maybe [Text]
-setJWTEnv secret input = setDBEnv jwtClaims
+claimsToSQL :: JWT.ClaimsMap -> [Text]
+claimsToSQL = map setVar . toList
   where
-    setDBEnv maybeClaims = (map setVar . toList) <$> maybeClaims
     setVar ("role", String val) = setRole val
     setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
                       " = " <> valueToVariable val <> ";"
     valueToVariable = pgFmtLit . unquoted
-    jwtClaims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
+
+{-|
+  Receives the JWT secret (from config) and a JWT and
+  returns a map of JWT claims
+  In case there is any problem decoding the JWT it returns Nothing.
+-}
+jwtClaims :: Text -> Text -> Maybe JWT.ClaimsMap
+jwtClaims secret input = JWT.unregisteredClaims <$> JWT.claims <$> decoded
+  where
     decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
 -- | Receives the name of a role and returns a SET ROLE statement
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index 164b37a15..90b71a40e 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -26,13 +26,14 @@ import           Network.Wai.Middleware.Gzip   (def, gzip)
 import           Network.Wai.Middleware.Static (only, staticPolicy)
 
 import           PostgREST.App                 (contentTypeForAccept)
-import           PostgREST.Auth                (setRole, setJWTEnv)
+import           PostgREST.Auth                (setRole, jwtClaims, claimsToSQL)
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 
 import           Prelude hiding(concat)
 
 import qualified Data.Vector             as V
 import qualified Hasql.Backend           as B
+import qualified Data.Map.Lazy           as M
 
 runWithClaims :: forall s. AppConfig ->
                  (Request -> H.Tx P.Postgres s Response) ->
@@ -41,16 +42,20 @@ runWithClaims conf app req = do
     mapM_ H.unitEx $ stmt <$> env
     app req
  where
+   stmt = (flip $ flip B.Stmt V.empty) True
    hdrs = requestHeaders req
    jwtSecret = (cs $ configJwtSecret conf) :: Text
    auth = fromMaybe "" $ lookup hAuthorization hdrs
    anon = cs $ configAnonRole conf
-   jwtEnv =
+   claims =
+     fromMaybe (M.fromList []) $
      case split (==' ') (cs auth) of
-       ("Bearer" : jwt : _) -> fromMaybe [] (setJWTEnv jwtSecret jwt)
-       _ -> []
-   env = setRole anon : jwtEnv
-   stmt = (flip $ flip B.Stmt V.empty) True
+       ("Bearer" : jwt : _) -> jwtClaims jwtSecret jwt
+       _ -> Nothing
+   env = if M.member "role" claims
+            then jwtEnv
+            else setRole anon : jwtEnv
+   jwtEnv = claimsToSQL claims
 
 redirectInsecure :: Application -> Application
 redirectInsecure app req respond = do

From 2b8f5f791a842ddd17102fa6f586c3d69024b817 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Thu, 22 Oct 2015 13:47:34 +0300
Subject: [PATCH 29/81] using query fragments instead of query transformers o
 generate queries

---
 src/PostgREST/App.hs          | 110 +++++++++++++++++++++++++---------
 src/PostgREST/PgQuery.hs      |  97 +++++++++++++++++++++++++++++-
 src/PostgREST/QueryBuilder.hs |  30 ++++++----
 3 files changed, 198 insertions(+), 39 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index e89357c62..dca5a2262 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -88,17 +88,32 @@ app dbstructure conf authenticator reqBody dbrole req =
         case queries of
           Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
           Right (qs, cqs) -> do
-            let qt = qualify table
-                count = if hasPrefer "count=none"
-                      then countNone
-                      else cqs
-                q = B.Stmt "select " V.empty True <>
-                    parentheticT count
-                    <> commaq <> (
-                    bodyForAccept contentType qt -- TODO! when in csv mode, the first row (columns) is not correct when requesting sub tables
-                    . limitT range
-                    $ qs
-                  )
+            -- let qt = qualify table
+            --     count = if hasPrefer "count=none"
+            --           then countNone
+            --           else cqs
+            --     q = B.Stmt "select " V.empty True <>
+            --         parentheticT count
+            --         <> commaq <> (
+            --         bodyForAccept contentType qt -- TODO! when in csv mode, the first row (columns) is not correct when requesting sub tables
+            --         . limitT range
+            --         $ qs
+            --       )
+
+            let q = B.Stmt
+                    (withSourceF qs <>
+                    " SELECT " <>
+                      (if hasPrefer "count=none" then countNoneF else countAllF) <>
+                      "," <>
+                      countF <>
+                      "," <>
+                      (case contentType of
+                        "text/csv" -> asCsvF
+                        _     -> asJsonF
+                      ) <>
+                    " " <>
+                    fromF ( limitF range ))
+                    V.empty True
             row <- H.maybeEx q
             let (tableTotal, queryTotal, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString) row
                 to = frm+queryTotal-1
@@ -163,15 +178,37 @@ app dbstructure conf authenticator reqBody dbrole req =
                   encode . object $ [("message", String "Failed authentication.")]
 
     ([table], "POST") -> do
-      let echoRequested = hasPrefer "return=representation"
-      case query of
+      let echoRequested = hasPrefer "return=representation" --TODO!! do not request content at all in query if not echoRequested
+      case insertQuery of
         Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
         Right q -> do
-          row <- H.maybeEx q
-          let (queryTotal, body) = fromMaybe (Just (0::Int), Just "" :: Maybe BL.ByteString) row
+          let isSingle = either (const False) id returnSingle
+              pKeys = map pkName $ filter (filterPk schema table) allPrKeys
+              qq = B.Stmt
+                   (withSourceF q <>
+                   " SELECT " <>
+                     (if isSingle then (locationF pKeys) else "null") <>
+                     "," <>
+                     countF <>
+                     "," <>
+                     (case contentType of
+                        "text/csv" -> asCsvF
+                        _     -> (if isSingle then asJsonSingleF else asJsonF)
+                     ) <>
+                   " " <>
+                   fromF ( limitF Nothing ))
+                   V.empty True
+
+          row <- H.maybeEx qq
+          let (locationRaw, queryTotal, bodyRaw) = fromMaybe (Just "" :: Maybe BL.ByteString, Just (0::Int), Just "" :: Maybe BL.ByteString) row
+              body = fromMaybe "[]" bodyRaw
+              locationH = fromMaybe "" locationRaw
           return $ responseLBS status201
-            [jsonH]
-            $ if echoRequested then (fromMaybe "[]" body) else ""
+            [
+              jsonH,
+              (hLocation, "/" <> cs table <> "?" <> cs locationH)
+            ]
+            $ if echoRequested then body else ""
         -- let qt = qualify table
       --     echoRequested = hasPrefer "return=representation"
       --     parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value))
@@ -207,12 +244,24 @@ app dbstructure conf authenticator reqBody dbrole req =
       --     return $ multipart status201 responses
 
       where
-        apiRequest = parsePostRequest req reqBody
+        res = parsePostRequest req reqBody
+        apiRequest = snd <$> res
+        returnSingle = fst <$> res
         insertQuery = requestToQuery schema <$> apiRequest
-        query = withT
-            <$> insertQuery
-            <*> pure "t"
-            <*> pure (B.Stmt "select count(t), array_to_json(array_agg(row_to_json(t)))::character varying" V.empty True)
+
+        -- localWithT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
+        --   B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq)
+        --     (ep <> wp)
+        --     (epre && wpre)
+        --
+        -- query = localWithT
+        --     <$> insertQuery
+        --     <*> pure "k"
+        --     <*> pure (
+        --       B.Stmt "SELECT " V.empty True <>
+        --       bodyForAccept contentType (QualifiedIdentifier "" "k") (B.Stmt "SELECT * FROM k" V.empty True)
+        --       )
+        --       -- TODO! csv does not work because k is not a real table
 
 
     (["rpc", proc], "POST") -> do
@@ -420,12 +469,13 @@ formatParserError e = cs $ encode $ object [
      details = strip $ replace "\n" " " $ cs
        $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
 --parsePostRequest :: Request -> BL.ByteString -> Either String (V.Vector Text, V.Vector (V.Vector Value))
-parsePostRequest :: Request -> BL.ByteString -> Either Text ApiRequest
+parsePostRequest :: Request -> BL.ByteString -> Either Text (Bool, ApiRequest)
 parsePostRequest httpRequest reqBody =
-  Node <$> apiNode <*> pure []
+  (,) <$> returnSingle <*> node
   where
+    node = Node <$> apiNode <*> pure []
     apiNode = (,) <$> (Insert rootTableName <$> flds <*> vals) <*> pure (rootTableName, Nothing)
-    flds =  join $ first formatParserError . (mapM (parseField . cs)) <$> (fst <$> parsed)
+    flds =  join $ first formatParserError . mapM (parseField . cs) <$> (fst <$> parsed)
     vals = snd <$> parsed
     parseField f = parse pField ("failed to parse field <<"++f++">>") f
     parsed :: Either Text ([Text],[[Value]])
@@ -440,10 +490,16 @@ parsePostRequest httpRequest reqBody =
       ) =<<
       if isCsv
       then do
-        rows <- (map (V.toList) . V.toList) <$> CSV.decode CSV.NoHeader reqBody
+        rows <- (map V.toList . V.toList) <$> CSV.decode CSV.NoHeader reqBody
         if null rows then Left "CSV requires header"
           else Right (head rows, (map $ map $ parseCsvCell . cs) (tail rows))
-      else eitherDecode reqBody >>= \val -> convertJson val
+      else jsn >>= \val -> convertJson val
+    jsn = eitherDecode reqBody
+    returnSingle = first cs $ jsn >>= (\v->
+      case v of
+        Object _  -> Right True
+        _         -> Right False
+      )
     hdrs          = requestHeaders httpRequest
     lookupHeader  = flip lookup hdrs
     rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index 9d3d43a01..4997786e7 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -101,6 +101,27 @@ countNone = B.Stmt "select null" empty True
 asCsvWithCount :: QualifiedIdentifier -> StatementT
 asCsvWithCount table = withCount . asCsv table
 
+{--
+WITH source AS (
+	SELECT * FROM projects
+)
+SELECT
+  (
+  	SELECT string_agg(k.kk, ',')
+  	FROM (
+  		SELECT json_object_keys(j)::TEXT as kk
+  		FROM (
+  			SELECT row_to_json(source) as j from source limit 1
+  		) l
+  	) k
+  )
+  || '\r' ||
+  coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '')
+FROM (
+	SELECT * FROM source
+) t;
+--}
+
 asCsv :: QualifiedIdentifier -> StatementT
 asCsv table s = s {
   B.stmtTemplate =
@@ -285,7 +306,10 @@ trimNullChars :: T.Text -> T.Text
 trimNullChars = T.takeWhile (/= '\x0')
 
 fromQi :: QualifiedIdentifier -> T.Text
-fromQi t = pgFmtIdent (qiSchema t) <> "." <> pgFmtIdent (qiName t)
+fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
+  where
+    n = qiName t
+    s = qiSchema t
 
 unquoted :: JSON.Value -> T.Text
 unquoted (JSON.String t) = t
@@ -304,3 +328,74 @@ insertableValue v = insertableText $ unquoted v
 paramFilter :: JSON.Value -> T.Text
 paramFilter JSON.Null = "is.null"
 paramFilter v = "eq." <> unquoted v
+
+
+withSourceF :: T.Text -> T.Text
+withSourceF s = "WITH source AS (" <> s <>")"
+
+countF :: T.Text
+countF = "pg_catalog.count(t)"
+
+countAllF :: T.Text
+countAllF = "(SELECT pg_catalog.count(a) FROM (SELECT * FROM source) a )"
+
+countNoneF :: T.Text
+countNoneF = "null"
+
+asJsonF :: T.Text
+asJsonF = "array_to_json(array_agg(row_to_json(t)))::character varying"
+
+asJsonSingleF :: T.Text --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
+asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying "
+
+asCsvF :: T.Text
+asCsvF = asCsvHeaderF <> " || '\r' || " <> asCsvBodyF
+
+asCsvHeaderF :: T.Text
+asCsvHeaderF =
+  "(SELECT string_agg(a.k, ',')" <>
+  "  FROM (" <>
+  "    SELECT json_object_keys(r)::TEXT as k" <>
+  "    FROM ( " <>
+  "      SELECT row_to_json(source) as r from source limit 1" <>
+  "    ) s" <>
+  "  ) a" <>
+  ")"
+
+asCsvBodyF :: T.Text
+asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '')"
+
+fromF :: T.Text -> T.Text
+fromF limit = "FROM (SELECT * FROM source " <> limit <> ") t"
+
+limitF :: Maybe NonnegRange -> T.Text
+limitF r  = "LIMIT " <> limit <> " OFFSET " <> offset
+  where
+    limit  = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
+    offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
+
+locationF :: [T.Text] -> T.Text
+locationF pKeys =
+    "(" <>
+    " WITH s AS (SELECT row_to_json(source) as r from source limit 1)" <>
+    " SELECT string_agg(json_data.key || '=eq.' || json_data.value, '&')" <>
+    " FROM s, json_each_text(s.r) AS json_data" <>
+    (
+      if null pKeys
+      then ""
+      else " WHERE json_data.key IN ('" <> T.intercalate "','" pKeys <> "')"
+    ) <>
+    ")"
+
+orderF :: [OrderTerm] -> T.Text
+orderF ts =
+  if L.null ts
+    then ""
+    else "ORDER BY " <> clause
+  where
+    clause = T.intercalate "," (map queryTerm ts)
+    queryTerm :: OrderTerm -> T.Text
+    queryTerm t = " "
+           <> cs (pgFmtIdent $ otTerm t) <> " "
+           <> cs (otDirection t)         <> " "
+           <> maybe "" cs (otNullOrder t) <> " "
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index c0194b508..8c66712d0 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -12,7 +12,7 @@ import           Control.Applicative
 import           Data.Tree
 import           PostgREST.PgQuery (PStmt, fromQi,
                                     orderT, pgFmtIdent, pgFmtLit, pgFmtOperator,
-                                    pgFmtValue, whiteList, insertableValue)
+                                    pgFmtValue, whiteList, insertableValue, orderF)
 import           PostgREST.Types
 import qualified Data.Vector       as V (empty)
 import qualified Hasql.Backend     as B
@@ -86,16 +86,20 @@ requestToCountQuery schema (Node (Select _ _ conditions _, (mainTbl, _)) _) =
         fn  (Filter{value=VText _}) = True
         fn  (Filter{value=VForeignKey _ _}) = False
 
-requestToQuery :: Text -> ApiRequest -> PStmt
+--requestToQuery :: Text -> ApiRequest -> PStmt
+requestToQuery :: Text -> ApiRequest -> Text
 requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest) =
-  orderT (fromMaybe [] ord)  query
+  --orderT (fromMaybe [] ord)  query
+  query
   where
-    query = B.Stmt qStr V.empty True
-    qStr = Data.Text.unwords [
+    --query = B.Stmt qStr V.empty True
+    --qStr = Data.Text.unwords [
+    query = Data.Text.unwords [
       ("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
       "SELECT ", intercalate ", " (map (pgFmtSelectItem (QualifiedIdentifier schema mainTbl)) colSelects ++ selects),
       "FROM ", intercalate ", " (map (fromQi . QualifiedIdentifier schema) tbls),
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl) ) conditions )) `emptyOnNull` conditions
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl) ) conditions )) `emptyOnNull` conditions,
+      orderF (fromMaybe [] ord)
       ]
     emptyOnNull val x = if null x then "" else val
     (withs, selects) = foldr getQueryParts ([],[]) forest
@@ -106,13 +110,15 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
            <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
            <> "FROM (" <> subquery <> ") " <> table
            <> ") AS " <> table
-           where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
+           --where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
+           where subquery = requestToQuery schema (Node n forst)
 
     getQueryParts (Node n@(_, (table, Just (Relation {relType=Parent}))) forst) (w,s) = (wit:w,sel:s)
       where
         sel = "row_to_json(" <> table <> ".*) AS "<>table --TODO must be singular
         wit = table <> " AS ( " <> subquery <> " )"
-          where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
+          --where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
+          where subquery = requestToQuery schema (Node n forst)
 
     getQueryParts (Node n@(_, (table, Just (Relation {relType=Many}))) forst) (w,s) = (w,sel:s)
       where
@@ -120,7 +126,8 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
            <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
            <> "FROM (" <> subquery <> ") " <> table
            <> ") AS " <> table
-           where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
+           --where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
+           where subquery = requestToQuery schema (Node n forst)
 
     -- the following is just to remove the warning
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
@@ -129,9 +136,10 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
 requestToQuery schema (Node (Insert tbl flds vals, (mainTbl, _)) forest) =
   query
   where
-    query = B.Stmt qStr V.empty True
+    --query = B.Stmt qStr V.empty True
     qi = QualifiedIdentifier schema mainTbl
-    qStr = Data.Text.unwords [
+    --qStr = Data.Text.unwords [
+    query = Data.Text.unwords [
       "INSERT INTO ", fromQi qi,
       " (" <> intercalate ", " (map (pgFmtIdent . fst) flds) <> ") ",
       "VALUES " <> intercalate ", "

From 2662e24991914123bec592e85c62fd7ce6cbe53c Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Thu, 22 Oct 2015 16:17:23 +0300
Subject: [PATCH 30/81] a few more tests fixed

---
 src/PostgREST/App.hs       | 17 +++++++++--------
 src/PostgREST/PgQuery.hs   |  3 ++-
 test/Feature/InsertSpec.hs | 22 +++++++++++++++++-----
 3 files changed, 28 insertions(+), 14 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index dca5a2262..111ad490a 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -205,7 +205,7 @@ app dbstructure conf authenticator reqBody dbrole req =
               locationH = fromMaybe "" locationRaw
           return $ responseLBS status201
             [
-              jsonH,
+              contentTypeH,
               (hLocation, "/" <> cs table <> "?" <> cs locationH)
             ]
             $ if echoRequested then body else ""
@@ -493,13 +493,14 @@ parsePostRequest httpRequest reqBody =
         rows <- (map V.toList . V.toList) <$> CSV.decode CSV.NoHeader reqBody
         if null rows then Left "CSV requires header"
           else Right (head rows, (map $ map $ parseCsvCell . cs) (tail rows))
-      else jsn >>= \val -> convertJson val
-    jsn = eitherDecode reqBody
-    returnSingle = first cs $ jsn >>= (\v->
-      case v of
-        Object _  -> Right True
-        _         -> Right False
-      )
+      else eitherDecode reqBody >>= \val -> convertJson val
+    -- jsn = eitherDecode reqBody
+    -- returnSingle = first cs $ jsn >>= (\v->
+    --   case v of
+    --     Object _  -> Right True
+    --     _         -> Right False
+    --   )
+    returnSingle = (==1) . length . snd <$> parsed
     hdrs          = requestHeaders httpRequest
     lookupHeader  = flip lookup hdrs
     rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index 4997786e7..87cd58a85 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -378,7 +378,8 @@ locationF :: [T.Text] -> T.Text
 locationF pKeys =
     "(" <>
     " WITH s AS (SELECT row_to_json(source) as r from source limit 1)" <>
-    " SELECT string_agg(json_data.key || '=eq.' || json_data.value, '&')" <>
+--    " SELECT string_agg(json_data.key || '=eq.' || json_data.value, '&')" <>
+    " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
     " FROM s, json_each_text(s.r) AS json_data" <>
     (
       if null pKeys
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index 7d19e5683..e4f042e04 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -1,6 +1,6 @@
 module Feature.InsertSpec where
 
-import Test.Hspec
+import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
@@ -130,17 +130,29 @@ spec = afterAll_ resetDb $ around withApp $ do
                             "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"]
           }
 
-      it "can post nulls" $
+      -- it "can post nulls (old way)" $ do
+      --   pendingWith "changed the response when in csv mode"
+      --   request methodPost "/no_pk"
+      --                [("Content-Type", "text/csv"), ("Prefer", "return=representation")]
+      --                "a,b\nNULL,foo"
+      --     `shouldRespondWith` ResponseMatcher {
+      --       matchBody    = Just [json| { "a":null, "b":"foo" } |]
+      --     , matchStatus  = 201
+      --     , matchHeaders = ["Content-Type" <:> "application/json",
+      --                       "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
+      --     }
+      it "can post nulls" $ do
         request methodPost "/no_pk"
-                     [("Content-Type", "text/csv"), ("Prefer", "return=representation")]
+                     [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                      "a,b\nNULL,foo"
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| { "a":null, "b":"foo" } |]
+            matchBody    = Just "a,b\n,foo"
           , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json",
+          , matchHeaders = ["Content-Type" <:> "text/csv",
                             "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
           }
 
+
     after_ (clearTable "no_pk") . context "with wrong number of columns" $ do
       it "fails for too few" $ do
         p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"

From ca4014f751e81c712d3014775a9c72079724605f Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Thu, 22 Oct 2015 17:03:06 +0300
Subject: [PATCH 31/81] a few more tests fixed (2)

---
 src/PostgREST/PgQuery.hs   |  2 +-
 test/Feature/InsertSpec.hs | 12 ++++++------
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index 87cd58a85..966ec8243 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -337,7 +337,7 @@ countF :: T.Text
 countF = "pg_catalog.count(t)"
 
 countAllF :: T.Text
-countAllF = "(SELECT pg_catalog.count(a) FROM (SELECT * FROM source) a )"
+countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM source) a )"
 
 countNoneF :: T.Text
 countNoneF = "null"
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index e4f042e04..dc7e835fb 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -121,12 +121,12 @@ spec = afterAll_ resetDb $ around withApp $ do
     after_ (clearTable "no_pk") . context "requesting full representation" $ do
       it "returns full details of inserted record" $
         request methodPost "/no_pk"
-                     [("Content-Type", "text/csv"), ("Prefer", "return=representation")]
+                     [("Content-Type", "text/csv"), ("Accept", "text/csv"),  ("Prefer", "return=representation")]
                      "a,b\nbar,baz"
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| { "a":"bar", "b":"baz" } |]
+            matchBody    = Just "a,b\rbar,baz"
           , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json",
+          , matchHeaders = ["Content-Type" <:> "text/csv",
                             "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"]
           }
 
@@ -146,7 +146,7 @@ spec = afterAll_ resetDb $ around withApp $ do
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                      "a,b\nNULL,foo"
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "a,b\n,foo"
+            matchBody    = Just "a,b\r,foo"
           , matchStatus  = 201
           , matchHeaders = ["Content-Type" <:> "text/csv",
                             "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
@@ -303,7 +303,7 @@ spec = afterAll_ resetDb $ around withApp $ do
         [ authHeaderBasic "jdoe" "1234", ("Prefer", "return=representation") ]
         [json| { "secret": "nyancat" } |]
       liftIO $ do
-          simpleBody p1 `shouldBe` [json| { "owner":"jdoe", "secret":"nyancat" } |]
+          simpleBody p1 `shouldBe` [str|{"owner":"jdoe","secret":"nyancat"}|]
           simpleStatus p1 `shouldBe` created201
 
       p2 <- request methodPost "/authors_only"
@@ -311,5 +311,5 @@ spec = afterAll_ resetDb $ around withApp $ do
         [ authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqcm9lIn0.YuF_VfmyIxWyuceT7crnNKEprIYXsJAyXid3rjPjIow", ("Prefer", "return=representation") ]
         [json| { "secret": "lolcat", "owner": "hacker" } |]
       liftIO $ do
-          simpleBody p2 `shouldBe` [json| { "owner":"jroe", "secret":"lolcat" } |]
+          simpleBody p2 `shouldBe` [str|{"owner":"jroe","secret":"lolcat"}|]
           simpleStatus p2 `shouldBe` created201

From cea4cc586003c5505df73690668840d9165bddd9 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Thu, 22 Oct 2015 18:01:47 +0300
Subject: [PATCH 32/81] a bit of warning cleanup

---
 src/PostgREST/App.hs          | 33 +++++++++++++--------------
 src/PostgREST/QueryBuilder.hs | 42 +++++++++++++++++------------------
 src/PostgREST/Types.hs        |  6 ++---
 3 files changed, 40 insertions(+), 41 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 111ad490a..3870ea9bf 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -16,7 +16,7 @@ module PostgREST.App where
 
 import qualified Blaze.ByteString.Builder  as BB
 import           Control.Applicative
-import           Control.Arrow             (second, (***))
+import           Control.Arrow             ((***))
 import           Control.Monad             (join)
 import           Data.Bifunctor            (first)
 import qualified Data.ByteString.Char8     as BS
@@ -26,8 +26,7 @@ import qualified Data.Csv                  as CSV
 import           Data.Functor.Identity
 import qualified Data.HashMap.Strict       as M
 import           Data.List                 (find, sortBy, delete, transpose)
-import           Data.Maybe                (fromMaybe, fromJust, isJust, isNothing,
-                                            mapMaybe)
+import           Data.Maybe                (fromMaybe, fromJust, isJust, isNothing)
 import           Data.Ord                  (comparing)
 import           Data.Ranged.Ranges        (emptyRange)
 import qualified Data.Set                  as S
@@ -45,9 +44,8 @@ import           Network.HTTP.Types.Status
 import           Network.HTTP.Types.URI    (parseSimpleQuery)
 import           Network.Wai
 --import           Network.Wai.Internal
-import           Network.Wai.Internal      (Response (..), Request (..))
+import           Network.Wai.Internal      (Response (..))
 import           Network.Wai.Parse         (parseHttpAccept)
-import Text.Heredoc
 
 import           Data.Aeson
 import           Data.Monoid
@@ -85,9 +83,9 @@ app dbstructure conf authenticator reqBody dbrole req =
       if range == Just emptyRange
       then return $ responseLBS status416 [] "HTTP Range error"
       else
-        case queries of
+        case query of
           Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
-          Right (qs, cqs) -> do
+          Right qs -> do
             -- let qt = qualify table
             --     count = if hasPrefer "count=none"
             --           then countNone
@@ -140,8 +138,8 @@ app dbstructure conf authenticator reqBody dbrole req =
 
 
             query = requestToQuery schema <$> apiRequest
-            countQuery = requestToCountQuery schema <$> apiRequest
-            queries = (,) <$> query <*> countQuery
+            --countQuery = requestToCountQuery schema <$> apiRequest
+            --queries = (,) <$> query <*> countQuery
 
     (["postgrest", "users"], "POST") -> do
       let user = decode reqBody :: Maybe AuthUser
@@ -177,30 +175,31 @@ app dbstructure conf authenticator reqBody dbrole req =
                 _  -> return $ responseLBS status401 [jsonH] $
                   encode . object $ [("message", String "Failed authentication.")]
 
+
     ([table], "POST") -> do
       let echoRequested = hasPrefer "return=representation" --TODO!! do not request content at all in query if not echoRequested
       case insertQuery of
         Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
-        Right q -> do
+        Right qs -> do
           let isSingle = either (const False) id returnSingle
               pKeys = map pkName $ filter (filterPk schema table) allPrKeys
-              qq = B.Stmt
-                   (withSourceF q <>
+              q = B.Stmt
+                   (withSourceF qs <>
                    " SELECT " <>
-                     (if isSingle then (locationF pKeys) else "null") <>
+                     (if isSingle then locationF pKeys else "null") <>
                      "," <>
                      countF <>
                      "," <>
                      (case contentType of
                         "text/csv" -> asCsvF
-                        _     -> (if isSingle then asJsonSingleF else asJsonF)
+                        _     -> if isSingle then asJsonSingleF else asJsonF
                      ) <>
                    " " <>
                    fromF ( limitF Nothing ))
                    V.empty True
 
-          row <- H.maybeEx qq
-          let (locationRaw, queryTotal, bodyRaw) = fromMaybe (Just "" :: Maybe BL.ByteString, Just (0::Int), Just "" :: Maybe BL.ByteString) row
+          row <- H.maybeEx q
+          let (locationRaw, _ {-- queryTotal --}, bodyRaw) = fromMaybe (Just "" :: Maybe BL.ByteString, Just (0::Int), Just "" :: Maybe BL.ByteString) row
               body = fromMaybe "[]" bodyRaw
               locationH = fromMaybe "" locationRaw
           return $ responseLBS status201
@@ -528,7 +527,7 @@ convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
       where
         maps :: Either String [M.HashMap Text [Value]]
         maps = mapM getElems $ V.toList a
-        getElems (Object o) = Right $ M.map (\x->[x]) o
+        getElems (Object o) = Right $ M.map (:[]) o
         getElems _ = Left invalidMsg
     groupByKey _ = Left invalidMsg
 
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index 8c66712d0..1044cdf8a 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -10,12 +10,12 @@ import           Data.Text         hiding (filter, find, foldr, head, last, map,
                                     null, zipWith)
 import           Control.Applicative
 import           Data.Tree
-import           PostgREST.PgQuery (PStmt, fromQi,
-                                    orderT, pgFmtIdent, pgFmtLit, pgFmtOperator,
+import           PostgREST.PgQuery (fromQi,
+                                    pgFmtIdent, pgFmtLit, pgFmtOperator,
                                     pgFmtValue, whiteList, insertableValue, orderF)
 import           PostgREST.Types
-import qualified Data.Vector       as V (empty)
-import qualified Hasql.Backend     as B
+--import qualified Data.Vector       as V (empty)
+--import qualified Hasql.Backend     as B
 
 findRelation :: [Relation] -> Text -> Text -> Text -> Maybe Relation
 findRelation allRelations s t1 t2 =
@@ -71,20 +71,20 @@ addJoinConditions schema allColumns (Node (query, (t, r)) forest) =
     updatedForest = mapM (addJoinConditions schema allColumns) forest
     addCond q con = q{where_=con ++ where_ q}
 
-requestToCountQuery :: Text -> ApiRequest -> PStmt
-requestToCountQuery schema (Node (Select _ _ conditions _, (mainTbl, _)) _) =
-  B.Stmt query V.empty True
-  where
-    query = Data.Text.unwords [
-      "SELECT pg_catalog.count(1)",
-      "FROM ", fromQi $ QualifiedIdentifier schema mainTbl,
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
-      ]
-    emptyOnNull val x = if null x then "" else val
-    localConditions = filter fn conditions
-      where
-        fn  (Filter{value=VText _}) = True
-        fn  (Filter{value=VForeignKey _ _}) = False
+-- requestToCountQuery :: Text -> ApiRequest -> PStmt
+-- requestToCountQuery schema (Node (Select _ _ conditions _, (mainTbl, _)) _) =
+--   B.Stmt query V.empty True
+--   where
+--     query = Data.Text.unwords [
+--       "SELECT pg_catalog.count(1)",
+--       "FROM ", fromQi $ QualifiedIdentifier schema mainTbl,
+--       ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
+--       ]
+--     emptyOnNull val x = if null x then "" else val
+--     localConditions = filter fn conditions
+--       where
+--         fn  (Filter{value=VText _}) = True
+--         fn  (Filter{value=VForeignKey _ _}) = False
 
 --requestToQuery :: Text -> ApiRequest -> PStmt
 requestToQuery :: Text -> ApiRequest -> Text
@@ -133,7 +133,7 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
     --posible relations are Child Parent Many
     getQueryParts (Node (_,(_,Nothing)) _) _ = undefined
-requestToQuery schema (Node (Insert tbl flds vals, (mainTbl, _)) forest) =
+requestToQuery schema (Node (Insert _ flds vals, (mainTbl, _)) _) =
   query
   where
     --query = B.Stmt qStr V.empty True
@@ -199,8 +199,8 @@ pgFmtField :: QualifiedIdentifier -> Field -> Text
 pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
 
 pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Text
-pgFmtSelectItem table (f@(c, jp), Nothing) = pgFmtField table f <> asJsonPath jp
-pgFmtSelectItem table (f@(c, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> asJsonPath jp
+pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> asJsonPath jp
+pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> asJsonPath jp
 
 asJsonPath :: Maybe JsonPath -> Text
 asJsonPath Nothing = ""
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
index 2dac663c1..4bd0a5df1 100644
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -3,7 +3,7 @@ import Data.Text
 import Data.Tree
 import qualified Data.ByteString.Char8 as BS
 import Data.Aeson
-import Data.Map
+--import Data.Map
 
 data DbStructure = DbStructure {
   tables :: [Table]
@@ -80,8 +80,8 @@ type NodeName = Text
 type SelectItem = (Field, Maybe Cast)
 type Path = [Text]
 data Query = Select { select::[SelectItem], from::[Text], where_::[Filter], order::Maybe [OrderTerm] }
-           | Insert { into::Text, fields::[Field], values::[[Value]] }
-           | Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq)
+           | Insert { into::Text, fields::[Field], values::[[Value]] } deriving (Show, Eq)
+--           | Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq)
 data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
 type ApiNode = (Query, (NodeName, Maybe Relation))
 type ApiRequest = Tree ApiNode

From aad19b53c7bb26253087e146eb0f746dfa8cd04f Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Thu, 22 Oct 2015 23:12:14 -0400
Subject: [PATCH 33/81] Includes one test case for recovering from from 400
 error and another for invalid JWT tokens

---
 test/Feature/AuthSpec.hs | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs
index 8c593a42b..b02d9a334 100644
--- a/test/Feature/AuthSpec.hs
+++ b/test/Feature/AuthSpec.hs
@@ -26,8 +26,19 @@ spec = beforeAll
         , matchHeaders = ["Content-Type" <:> "application/json"]
         }
 
-  it "allows users with permissions to see their tables (JWT)" $ do
-    _ <- post "/postgrest/users" [json| { "id": "jdoe", "pass": "1234", "role": "postgrest_test_author" } |]
+  it "allows users with permissions to see their tables" $ do
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 200
+
+  it "hides tables from users with invalid JWT" $ do
+    let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 404
+
+  it "recovers after 400 error with logged in user" $ do
+    _ <- post "/authors_only" [json| { "owner": "jdoe", "secret": "test content" } |]
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
+    _ <- request methodPost "/rpc/problem" [auth] ""
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200

From 91dfd47f1d157bd1ffc6026a69b24edd11a90bb2 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Thu, 22 Oct 2015 23:20:16 -0400
Subject: [PATCH 34/81] Adds another test case for jwt with empty claims

---
 test/Feature/AuthSpec.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs
index b02d9a334..992ca1d9e 100644
--- a/test/Feature/AuthSpec.hs
+++ b/test/Feature/AuthSpec.hs
@@ -36,6 +36,11 @@ spec = beforeAll
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 404
 
+  it "hides tables from users with JWT that contain no claims about role" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.MKYc_lOECtB0LJOiykilAdlHodB-I0_id2qHKq35dmc"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 404
+
   it "recovers after 400 error with logged in user" $ do
     _ <- post "/authors_only" [json| { "owner": "jdoe", "secret": "test content" } |]
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"

From d4a8716a0ef9bc7480992bc7d984662327a1d123 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Fri, 23 Oct 2015 10:13:51 +0300
Subject: [PATCH 35/81] code cleanup

---
 src/PostgREST/App.hs     | 161 +++++++++------------------------------
 src/PostgREST/PgQuery.hs |   8 +-
 2 files changed, 43 insertions(+), 126 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index b686ed38f..aebee36a3 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -14,14 +14,12 @@ module PostgREST.App where
 -- , bb
 -- ) where
 
-import qualified Blaze.ByteString.Builder  as BB
 import           Control.Applicative
 import           Control.Arrow             ((***))
 import           Control.Monad             (join)
 import           Data.Bifunctor            (first)
 import qualified Data.ByteString.Char8     as BS
 import qualified Data.ByteString.Lazy      as BL
-import           Data.CaseInsensitive      (original)
 import qualified Data.Csv                  as CSV
 import           Data.Functor.Identity
 import qualified Data.HashMap.Strict       as M
@@ -43,8 +41,6 @@ import           Network.HTTP.Types.Header
 import           Network.HTTP.Types.Status
 import           Network.HTTP.Types.URI    (parseSimpleQuery)
 import           Network.Wai
---import           Network.Wai.Internal
-import           Network.Wai.Internal      (Response (..))
 import           Network.Wai.Parse         (parseHttpAccept)
 
 import           Data.Aeson
@@ -88,31 +84,17 @@ app dbstructure conf reqBody req =
         case query of
           Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
           Right qs -> do
-            -- let qt = qualify table
-            --     count = if hasPrefer "count=none"
-            --           then countNone
-            --           else cqs
-            --     q = B.Stmt "select " V.empty True <>
-            --         parentheticT count
-            --         <> commaq <> (
-            --         bodyForAccept contentType qt -- TODO! when in csv mode, the first row (columns) is not correct when requesting sub tables
-            --         . limitT range
-            --         $ qs
-            --       )
-
             let q = B.Stmt
-                    (withSourceF qs <>
-                    " SELECT " <>
-                      (if hasPrefer "count=none" then countNoneF else countAllF) <>
-                      "," <>
-                      countF <>
-                      "," <>
-                      (case contentType of
-                        "text/csv" -> asCsvF
-                        _     -> asJsonF
-                      ) <>
-                    " " <>
-                    fromF ( limitF range ))
+                    (
+                      wrapQuery qs [
+                        (if hasPrefer "count=none" then countNoneF else countAllF),
+                        countF,
+                        (case contentType of
+                          "text/csv" -> asCsvF -- TODO check when in csv mode if the header is correct when requesting nested data
+                          _     -> asJsonF
+                        )
+                      ] range
+                    )
                     V.empty True
             row <- H.maybeEx q
             let (tableTotal, queryTotal, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString) row
@@ -134,37 +116,34 @@ app dbstructure conf reqBody req =
 
         where
             frm = fromMaybe 0 $ rangeOffset <$> range
-            apiRequest = first formatParserError (parseGetRequest req)
+            apiRequest = first formatParserError (parseGetRequest table req)
                      >>= first formatRelationError . addRelations schema allRels Nothing
                      >>= addJoinConditions schema allCols
-
-
-
             query = requestToQuery schema <$> apiRequest
-            --countQuery = requestToCountQuery schema <$> apiRequest
-            --queries = (,) <$> query <*> countQuery
 
     ([table], "POST") -> do
-      let echoRequested = hasPrefer "return=representation" --TODO!! do not request content at all in query if not echoRequested
+      let echoRequested = hasPrefer "return=representation"
       case insertQuery of
         Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
         Right qs -> do
           let isSingle = either (const False) id returnSingle
               pKeys = map pkName $ filter (filterPk schema table) allPrKeys
               q = B.Stmt
-                   (withSourceF qs <>
-                   " SELECT " <>
-                     (if isSingle then locationF pKeys else "null") <>
-                     "," <>
-                     countF <>
-                     "," <>
-                     (case contentType of
-                        "text/csv" -> asCsvF
-                        _     -> if isSingle then asJsonSingleF else asJsonF
-                     ) <>
-                   " " <>
-                   fromF ( limitF Nothing ))
-                   V.empty True
+                    (
+                      wrapQuery qs [
+                        (if isSingle then locationF pKeys else "null"),
+                        "null", -- countF,
+                        (
+                          if echoRequested
+                          then
+                            case contentType of
+                               "text/csv" -> asCsvF
+                               _     -> if isSingle then asJsonSingleF else asJsonF
+                          else "null"
+                        )
+                      ] Nothing
+                    )
+                    V.empty True
 
           row <- H.maybeEx q
           let (locationRaw, _ {-- queryTotal --}, bodyRaw) = fromMaybe (Just "" :: Maybe BL.ByteString, Just (0::Int), Just "" :: Maybe BL.ByteString) row
@@ -176,61 +155,12 @@ app dbstructure conf reqBody req =
               (hLocation, "/" <> cs table <> "?" <> cs locationH)
             ]
             $ if echoRequested then body else ""
-        -- let qt = qualify table
-      --     echoRequested = hasPrefer "return=representation"
-      --     parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value))
-      --     parsed = if lookupHeader "Content-Type" == Just csvMT
-      --       then do
-      --         rows <- CSV.decode CSV.NoHeader reqBody
-      --         if V.null rows then Left "CSV requires header"
-      --           else Right (V.head rows, (V.map $ V.map $ parseCsvCell . cs) (V.tail rows))
-      --       else eitherDecode reqBody >>= \val ->
-      --         case val of
-      --           Object obj -> Right .  second V.singleton .  V.unzip .  V.fromList $
-      --             M.toList obj
-      --           _ -> Left "Expecting single JSON object or CSV rows"
-      -- case parsed of
-      --   Left err -> return $ responseLBS status400 [] $
-      --     encode . object $ [("message", String $ "Failed to parse JSON payload. " <> cs err)]
-      --   Right toBeInserted -> do
-      --     rows :: [Identity Text] <- H.listEx $ uncurry (insertInto qt) toBeInserted
-      --     let inserted :: [Object] = mapMaybe (decode . cs . runIdentity) rows
-      --         pKeys = map pkName $ filter (filterPk schema table) allPrKeys
-      --         responses = flip map inserted $ \obj -> do
-      --           let primaries =
-      --                 if Prelude.null pKeys
-      --                   then obj
-      --                   else M.filterWithKey (const . (`elem` pKeys)) obj
-      --           let params = urlEncodeVars
-      --                 $ map (\t -> (cs $ fst t, cs (paramFilter $ snd t)))
-      --                 $ sortBy (comparing fst) $ M.toList primaries
-      --           responseLBS status201
-      --             [ jsonH
-      --             , (hLocation, "/" <> cs table <> "?" <> cs params)
-      --             ] $ if echoRequested then encode obj else ""
-      --     return $ multipart status201 responses
-
       where
-        res = parsePostRequest req reqBody
+        res = parsePostRequest table req reqBody
         apiRequest = snd <$> res
         returnSingle = fst <$> res
         insertQuery = requestToQuery schema <$> apiRequest
 
-        -- localWithT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
-        --   B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq)
-        --     (ep <> wp)
-        --     (epre && wpre)
-        --
-        -- query = localWithT
-        --     <$> insertQuery
-        --     <*> pure "k"
-        --     <*> pure (
-        --       B.Stmt "SELECT " V.empty True <>
-        --       bodyForAccept contentType (QualifiedIdentifier "" "k") (B.Stmt "SELECT * FROM k" V.empty True)
-        --       )
-        --       -- TODO! csv does not work because k is not a real table
-
-
     (["rpc", proc], "POST") -> do
       let qi = QualifiedIdentifier schema (cs proc)
       exists <- doesProcExist schema proc
@@ -408,25 +338,6 @@ handleJsonObj reqBody handler = do
 parseCsvCell :: BL.ByteString -> Value
 parseCsvCell s = if s == "NULL" then Null else String $ cs s
 
-multipart :: Status -> [Response] -> Response
-multipart _ [] = responseLBS status204 [] ""
-multipart _ [r] = r
-multipart s rs =
-  responseLBS s [(hContentType, "multipart/mixed; boundary=\"postgrest_boundary\"")] $
-    BL.intercalate "\n--postgrest_boundary\n" (map renderResponseBody rs)
-
-  where
-    renderHeader :: Header -> BL.ByteString
-    renderHeader (k, v) = cs (original k) <> ": " <> cs v
-
-    renderResponseBody :: Response -> BL.ByteString
-    renderResponseBody (ResponseBuilder _ headers b) =
-      BL.intercalate "\n" (map renderHeader headers)
-        <> "\n\n" <> BB.toLazyByteString b
-    renderResponseBody _ = error
-      "Unable to create multipart response from non-ResponseBuilder"
-
-
 formatRelationError :: Text -> Text
 formatRelationError e = cs $ encode $ object [
   "mesage" .= ("could not find foreign keys between these entities"::String),
@@ -439,9 +350,9 @@ formatParserError e = cs $ encode $ object [
      message = show (errorPos e)
      details = strip $ replace "\n" " " $ cs
        $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
---parsePostRequest :: Request -> BL.ByteString -> Either String (V.Vector Text, V.Vector (V.Vector Value))
-parsePostRequest :: Request -> BL.ByteString -> Either Text (Bool, ApiRequest)
-parsePostRequest httpRequest reqBody =
+
+parsePostRequest :: NodeName -> Request -> BL.ByteString -> Either Text (Bool, ApiRequest)
+parsePostRequest rootTableName httpRequest reqBody =
   (,) <$> returnSingle <*> node
   where
     node = Node <$> apiNode <*> pure []
@@ -471,10 +382,10 @@ parsePostRequest httpRequest reqBody =
     --     Object _  -> Right True
     --     _         -> Right False
     --   )
-    returnSingle = (==1) . length . snd <$> parsed
+    returnSingle = (==1) . length . snd <$> parsed -- not quite correct qhen the user send single row but in an array
     hdrs          = requestHeaders httpRequest
     lookupHeader  = flip lookup hdrs
-    rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
+    --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
     isCsv = lookupHeader "Content-Type" == Just csvMT
 
 headerMatchesContent :: ([Text], [[Value]]) -> Bool
@@ -510,14 +421,14 @@ convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
         a@(Array _) -> Right a
         _ -> Left invalidMsg
 
-parseGetRequest :: Request -> Either ParseError ApiRequest
-parseGetRequest httpRequest =
+parseGetRequest :: NodeName -> Request -> Either ParseError ApiRequest
+parseGetRequest rootTableName httpRequest =
   foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
   where
     apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++selectStr++">>") $ cs selectStr
     addOrder (Node (q,i) f) o = Node (q{order=o}, i) f
     flts = mapM pRequestFilter whereFilters
-    rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
+    --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
     qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
     orderStr = join $ lookup "order" qString
     ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderStr++">>")) orderStr
diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index 966ec8243..d0e3d2533 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -329,6 +329,13 @@ paramFilter :: JSON.Value -> T.Text
 paramFilter JSON.Null = "is.null"
 paramFilter v = "eq." <> unquoted v
 
+wrapQuery :: T.Text -> [T.Text] -> Maybe NonnegRange -> T.Text
+wrapQuery source selectColumns range =
+  withSourceF source <>
+  " SELECT " <>
+  T.intercalate ", " selectColumns <>
+  " " <>
+  fromF ( limitF range )
 
 withSourceF :: T.Text -> T.Text
 withSourceF s = "WITH source AS (" <> s <>")"
@@ -378,7 +385,6 @@ locationF :: [T.Text] -> T.Text
 locationF pKeys =
     "(" <>
     " WITH s AS (SELECT row_to_json(source) as r from source limit 1)" <>
---    " SELECT string_agg(json_data.key || '=eq.' || json_data.value, '&')" <>
     " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
     " FROM s, json_each_text(s.r) AS json_data" <>
     (

From c606149c436ad19a2786856a9b7aecdd5e15d4a7 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Fri, 23 Oct 2015 10:45:35 +0300
Subject: [PATCH 36/81] code cleanup 2

---
 src/PostgREST/App.hs | 53 ++++++++++++++++++++++----------------------
 1 file changed, 26 insertions(+), 27 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index aebee36a3..f1c875120 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -116,7 +116,7 @@ app dbstructure conf reqBody req =
 
         where
             frm = fromMaybe 0 $ rangeOffset <$> range
-            apiRequest = first formatParserError (parseGetRequest table req)
+            apiRequest = parseGetRequest table req
                      >>= first formatRelationError . addRelations schema allRels Nothing
                      >>= addJoinConditions schema allCols
             query = requestToQuery schema <$> apiRequest
@@ -361,36 +361,35 @@ parsePostRequest rootTableName httpRequest reqBody =
     vals = snd <$> parsed
     parseField f = parse pField ("failed to parse field <<"++f++">>") f
     parsed :: Either Text ([Text],[[Value]])
-    parsed = first cs $
-      (\v->
-        if headerMatchesContent v
-        then Right v
-        else
-          if isCsv
-          then Left "CSV header does not match rows length"
-          else Left "The number of keys in objects do not match"
-      ) =<<
-      if isCsv
-      then do
-        rows <- (map V.toList . V.toList) <$> CSV.decode CSV.NoHeader reqBody
-        if null rows then Left "CSV requires header"
-          else Right (head rows, (map $ map $ parseCsvCell . cs) (tail rows))
-      else eitherDecode reqBody >>= \val -> convertJson val
-    -- jsn = eitherDecode reqBody
-    -- returnSingle = first cs $ jsn >>= (\v->
-    --   case v of
-    --     Object _  -> Right True
-    --     _         -> Right False
-    --   )
+    parsed = parseRequestBody isCsv reqBody
     returnSingle = (==1) . length . snd <$> parsed -- not quite correct qhen the user send single row but in an array
     hdrs          = requestHeaders httpRequest
     lookupHeader  = flip lookup hdrs
     --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
     isCsv = lookupHeader "Content-Type" == Just csvMT
 
-headerMatchesContent :: ([Text], [[Value]]) -> Bool
-headerMatchesContent (header, vals) = all ( (headerLength ==) . length) vals
-  where headerLength = length header
+parseRequestBody :: Bool -> BL.ByteString -> Either Text ([Text],[[Value]])
+parseRequestBody isCsv reqBody = first cs $
+  checkStructure =<<
+  if isCsv
+  then do
+    rows <- (map V.toList . V.toList) <$> CSV.decode CSV.NoHeader reqBody
+    if null rows then Left "CSV requires header" -- TODO! should check if length rows > 1 (header and 1 row)
+      else Right (head rows, (map $ map $ parseCsvCell . cs) (tail rows))
+  else eitherDecode reqBody >>= convertJson
+  where
+    checkStructure :: ([Text], [[Value]]) -> Either String ([Text], [[Value]])
+    checkStructure v =
+      if headerMatchesContent v
+      then Right v
+      else
+        if isCsv
+        then Left "CSV header does not match rows length"
+        else Left "The number of keys in objects do not match"
+
+    headerMatchesContent :: ([Text], [[Value]]) -> Bool
+    headerMatchesContent (header, vals) = all ( (headerLength ==) . length) vals
+      where headerLength = length header
 
 convertJson :: Value -> Either String ([Text],[[Value]])
 convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
@@ -421,9 +420,9 @@ convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
         a@(Array _) -> Right a
         _ -> Left invalidMsg
 
-parseGetRequest :: NodeName -> Request -> Either ParseError ApiRequest
+parseGetRequest :: NodeName -> Request -> Either Text ApiRequest
 parseGetRequest rootTableName httpRequest =
-  foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
+  first formatParserError $ foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
   where
     apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++selectStr++">>") $ cs selectStr
     addOrder (Node (q,i) f) o = Node (q{order=o}, i) f

From f5fb78ec99387459eec1d95b7d79ec47a8648bf9 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Fri, 23 Oct 2015 12:23:46 +0300
Subject: [PATCH 37/81] version changed to 3, circle ci to use ghc 7.10.1,
 stricter import/export in PgQuery and remove of dead code

---
 circle.yml                    |   2 +-
 postgrest.cabal               |   7 +-
 src/PostgREST/Auth.hs         |   4 +-
 src/PostgREST/Main.hs         |  15 +-
 src/PostgREST/Middleware.hs   |   2 +-
 src/PostgREST/Parsers.hs      |   4 +-
 src/PostgREST/PgQuery.hs      | 317 +++++++++++++++++-----------------
 src/PostgREST/QueryBuilder.hs |  50 +-----
 8 files changed, 184 insertions(+), 217 deletions(-)

diff --git a/circle.yml b/circle.yml
index 84c32bb12..74c1982c8 100644
--- a/circle.yml
+++ b/circle.yml
@@ -3,7 +3,7 @@ machine:
     - createuser --superuser --no-password postgrest_test
     - createdb -O postgrest_test -U ubuntu postgrest_test
   ghc:
-    version: 7.8.3
+    version: 7.10.1
 dependencies:
   override:
     - cabal update
diff --git a/postgrest.cabal b/postgrest.cabal
index 38f5bf364..943aa0513 100644
--- a/postgrest.cabal
+++ b/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.11.1
+version:               0.3.0.0
 synopsis:              REST API for any Postgres database
 license:               MIT
 license-file:          LICENSE
@@ -22,6 +22,11 @@ Flag CI
   Default:     False
 
 executable postgrest
+  if flag(ci)
+    ghc-options:       -Wall -W -Werror
+  else
+    ghc-options:       -Wall -W -O2
+
   main-is:             PostgREST/Main.hs
   default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
   default-language:    Haskell2010
diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index 94e36d90b..c5c09714f 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -19,8 +19,8 @@ module PostgREST.Auth (
   ) where
 
 --line needed for ghc 7.8
-import           Data.Functor            ((<$>))
- 
+--import           Data.Functor            ((<$>))
+
 import           Data.Aeson              (Value (..), Object)
 import           Data.Aeson.Types        (emptyObject, emptyArray)
 import           Data.Vector             as V (null, head)
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index fd6bf26a5..c83d304d6 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -13,7 +13,7 @@ import           PostgREST.Types
 
 import           Control.Monad                        (unless)
 import           Control.Monad.IO.Class               (liftIO)
-import           Data.Aeson.Encode.Pretty             (encodePretty)
+import           Data.Aeson                           (encode)
 import           Data.Functor.Identity
 import           Data.Monoid                          ((<>))
 import           Data.String.Conversions              (cs)
@@ -34,7 +34,7 @@ isServerVersionSupported = do
   return $ read (cs row) >= minimumPgVersion
 
 hasqlError :: PgError -> IO a
-hasqlError = error . cs . encodePretty
+hasqlError = error . cs . encode
 
 main :: IO ()
 main = do
@@ -71,11 +71,12 @@ main = do
           <> show minimumPgVersion)
     ) supportedOrError
 
-  roleOrError <- H.session pool $ do
-    Identity (role :: Text) <- H.tx Nothing $ H.singleEx
-      [H.stmt|SELECT SESSION_USER|]
-    return role
-  authenticator <- either hasqlError return roleOrError
+  -- what was this code for?
+  -- roleOrError <- H.session pool $ do
+  --   Identity (role :: Text) <- H.tx Nothing $ H.singleEx
+  --     [H.stmt|SELECT SESSION_USER|]
+  --   return role
+  -- authenticator <- either hasqlError return roleOrError
 
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index 90b71a40e..5fa540a9b 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -4,7 +4,7 @@
 module PostgREST.Middleware where
 
 -- needed for ghc 7.8
-import           Data.Functor ((<$>))
+-- import           Data.Functor ((<$>))
 
 import           Data.Maybe                    (fromMaybe, isNothing)
 import           Data.Monoid
diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs
index ba0d2bc24..f3d393c72 100644
--- a/src/PostgREST/Parsers.hs
+++ b/src/PostgREST/Parsers.hs
@@ -5,8 +5,8 @@ where
 
 import           Control.Applicative hiding ((<$>))
 --lines needed for ghc 7.8
-import           Data.Functor ((<$>))
-import           Data.Traversable (traverse)
+-- import           Data.Functor ((<$>))
+-- import           Data.Traversable (traverse)
 
 --import           Control.Monad                 (join)
 --import           Data.List                     (delete, find)
diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index d0e3d2533..1ea572a59 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -3,14 +3,57 @@
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module PostgREST.PgQuery where
+module PostgREST.PgQuery (
+  fromQi
+, insertableValue
+, wrapQuery
+, asJson
+, callProc
+, iffNotT
+, update
+, insertSelect
+, deleteFrom
+, asCsvWithCount
+, asJsonWithCount
+, unquoted
+
+-- format functions
+, pgFmtLit
+, pgFmtIdent
+, pgFmtValue
+, pgFmtCondition
+, pgFmtColumn
+, pgFmtJsonPath
+, pgFmtTable
+, pgFmtField
+, pgFmtSelectItem
+, pgFmtAsJsonPath
+
+-- query transformers (to be removed)
+, withT
+, countT
+, returningStarT
+, whereT
+
+-- query fragments
+, orderF
+, countNoneF
+, countAllF
+, countF
+, locationF
+, asCsvF
+, asJsonSingleF
+, asJsonF
+
+, StatementT
+) where
 
 
 import qualified Hasql                   as H
 import qualified Hasql.Backend           as B
 import qualified Hasql.Postgres          as P
 import           PostgREST.RangeQuery
-import           PostgREST.Types         (OrderTerm (..), QualifiedIdentifier(..))
+import           PostgREST.Types
 
 import           Control.Monad           (join)
 import qualified Data.Aeson              as JSON
@@ -25,7 +68,6 @@ import           Data.Scientific         (FPFormat (..), formatScientific,
 import           Data.String.Conversions (cs)
 import qualified Data.Text               as T
 import           Data.Vector             (empty)
-import qualified Data.Vector             as V
 import qualified Network.HTTP.Types.URI  as Net
 import           Text.Regex.TDFA         ((=~))
 
@@ -37,14 +79,12 @@ instance Monoid PStmt where
     B.Stmt (query <> query') (params <> params') (prep && prep')
   mempty = B.Stmt "" empty True
 type StatementT = PStmt -> PStmt
-
-
-limitT :: Maybe NonnegRange -> StatementT
-limitT r q =
-  q <> B.Stmt (" LIMIT " <> limit <> " OFFSET " <> offset <> " ") empty True
-  where
-    limit  = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
-    offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
+data JsonbPath =
+    ColIdentifier T.Text
+  | KeyIdentifier T.Text
+  | SingleArrow JsonbPath JsonbPath
+  | DoubleArrow JsonbPath JsonbPath
+  deriving (Show)
 
 whereT :: QualifiedIdentifier -> Net.Query -> StatementT
 whereT table params q =
@@ -62,24 +102,6 @@ withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
     (ep <> wp)
     (epre && wpre)
 
-orderT :: [OrderTerm] -> StatementT
-orderT ts q =
-  if L.null ts
-    then q
-    else q <> B.Stmt " order by " empty True <> clause
-  where
-    clause = mconcat $ L.intersperse commaq (map queryTerm ts)
-    queryTerm :: OrderTerm -> PStmt
-    queryTerm t = B.Stmt
-      (" " <> cs (pgFmtIdent $ otTerm t) <> " "
-           <> cs (otDirection t)         <> " "
-           <> maybe "" cs (otNullOrder t) <> " ")
-      empty True
-
-parentheticT :: StatementT
-parentheticT s =
-  s { B.stmtTemplate = " (" <> B.stmtTemplate s <> ") " }
-
 iffNotT :: PStmt -> StatementT
 iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) =
   B.Stmt
@@ -92,36 +114,9 @@ countT :: StatementT
 countT s =
   s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" }
 
-countRows :: QualifiedIdentifier  -> PStmt
-countRows t = B.Stmt ("select pg_catalog.count(1) from " <> fromQi t) empty True
-
-countNone :: PStmt
-countNone = B.Stmt "select null" empty True
-
 asCsvWithCount :: QualifiedIdentifier -> StatementT
 asCsvWithCount table = withCount . asCsv table
 
-{--
-WITH source AS (
-	SELECT * FROM projects
-)
-SELECT
-  (
-  	SELECT string_agg(k.kk, ',')
-  	FROM (
-  		SELECT json_object_keys(j)::TEXT as kk
-  		FROM (
-  			SELECT row_to_json(source) as j from source limit 1
-  		) l
-  	) k
-  )
-  || '\r' ||
-  coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '')
-FROM (
-	SELECT * FROM source
-) t;
---}
-
 asCsv :: QualifiedIdentifier -> StatementT
 asCsv table s = s {
   B.stmtTemplate =
@@ -143,34 +138,12 @@ asJson s = s {
 withCount :: StatementT
 withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s }
 
-asJsonRow :: StatementT
-asJsonRow s = s { B.stmtTemplate = "row_to_json(t) from (" <> B.stmtTemplate s <> ") t" }
-
 returningStarT :: StatementT
 returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
 
 deleteFrom :: QualifiedIdentifier -> PStmt
 deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True
 
-insertInto :: QualifiedIdentifier
-              -> V.Vector T.Text
-              -> V.Vector (V.Vector JSON.Value)
-              -> PStmt
-insertInto t cols vals
-  | V.null cols = B.Stmt ("insert into " <> fromQi t <> " default values returning *") empty True
-  | otherwise   = B.Stmt
-    ("insert into " <> fromQi t <> " (" <>
-      T.intercalate ", " (V.toList $ V.map pgFmtIdent cols) <>
-      ") values "
-      <> T.intercalate ", "
-        (V.toList $ V.map (\v -> "("
-            <> T.intercalate ", " (V.toList $ V.map insertableValue v)
-            <> ")"
-          ) vals
-        )
-      <> " returning row_to_json(" <> fromQi t <> ".*)")
-    empty True
-
 insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
 insertSelect t [] _ = B.Stmt
   ("insert into " <> fromQi t <> " default values returning *") empty True
@@ -200,7 +173,7 @@ callProc qi params = do
 wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt
 wherePred table (col, predicate) =
   B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <>
-      if opCode `elem` ["is","isnot"] then whiteList value
+      if opCode `elem` ["is","isnot"] then whiteList val
                                  else cs sqlValue)
       empty True
 
@@ -209,60 +182,18 @@ wherePred table (col, predicate) =
     hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
     opCode        = hasNot (head rest) headPredicate
     notOp         = hasNot headPredicate ""
-    value         = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest)
-    sqlValue = pgFmtValue opCode value
+    val         = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest)
+    sqlValue = pgFmtValue opCode val
     op = pgFmtOperator opCode
 
-
 whiteList :: T.Text -> T.Text
 whiteList val = fromMaybe
   (cs (pgFmtLit val) <> "::unknown ")
   (L.find ((==) . T.toLower $ val) ["null","true","false"])
 
-pgFmtValue :: T.Text -> T.Text -> T.Text
-pgFmtValue opCode value =
-  case opCode of
-    "like" -> unknownLiteral $ T.map star value
-    "ilike" -> unknownLiteral $ T.map star value
-    "in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") "
-    "notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") "
-    "@@" -> "to_tsquery(" <> unknownLiteral value <> ") "
-    _    -> unknownLiteral value
-  where
-    star c = if c == '*' then '%' else c
-    unknownLiteral = (<> "::unknown ") . pgFmtLit
-
-pgFmtOperator :: T.Text -> T.Text
-pgFmtOperator opCode =
-  case opCode of
-    "eq"  -> "="
-    "gt"  -> ">"
-    "lt"  -> "<"
-    "gte" -> ">="
-    "lte" -> "<="
-    "neq" -> "<>"
-    "like"-> "like"
-    "ilike"-> "ilike"
-    "in"  -> "in"
-    "notin" -> "not in"
-    "is"    -> "is"
-    "isnot" -> "is not"
-    "@@" -> "@@"
-    _     -> "="
-
-commaq :: PStmt
-commaq  = B.Stmt ", " empty True
-
 andq :: PStmt
 andq = B.Stmt " and " empty True
 
-data JsonbPath =
-    ColIdentifier T.Text
-  | KeyIdentifier T.Text
-  | SingleArrow JsonbPath JsonbPath
-  | DoubleArrow JsonbPath JsonbPath
-  deriving (Show)
-
 parseJsonbPath :: T.Text -> Maybe JsonbPath
 parseJsonbPath p =
   case T.splitOn "->>" p of
@@ -273,35 +204,6 @@ parseJsonbPath p =
         (KeyIdentifier b)
     _ -> Nothing
 
-pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
-pgFmtJsonbPath table p =
-  pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
-  where
-    pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
-    pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
-    pgFmtJsonbPath' (SingleArrow a b) =
-      pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
-    pgFmtJsonbPath' (DoubleArrow a b) =
-      pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
-
-pgFmtIdent :: T.Text -> T.Text
-pgFmtIdent x =
-  let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
-  if (cs escaped :: BS.ByteString) =~ danger
-    then "\"" <> escaped <> "\""
-    else escaped
-
-  where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
-
-pgFmtLit :: T.Text -> T.Text
-pgFmtLit x =
-  let trimmed = trimNullChars x
-      escaped = "'" <> T.replace "'" "''" trimmed <> "'"
-      slashed = T.replace "\\" "\\\\" escaped in
-  if T.isInfixOf "\\\\" escaped
-    then "E" <> slashed
-    else slashed
-
 trimNullChars :: T.Text -> T.Text
 trimNullChars = T.takeWhile (/= '\x0')
 
@@ -325,10 +227,6 @@ insertableValue :: JSON.Value -> T.Text
 insertableValue JSON.Null = "null"
 insertableValue v = insertableText $ unquoted v
 
-paramFilter :: JSON.Value -> T.Text
-paramFilter JSON.Null = "is.null"
-paramFilter v = "eq." <> unquoted v
-
 wrapQuery :: T.Text -> [T.Text] -> Maybe NonnegRange -> T.Text
 wrapQuery source selectColumns range =
   withSourceF source <>
@@ -337,6 +235,8 @@ wrapQuery source selectColumns range =
   " " <>
   fromF ( limitF range )
 
+
+-- query fragments
 withSourceF :: T.Text -> T.Text
 withSourceF s = "WITH source AS (" <> s <>")"
 
@@ -406,3 +306,108 @@ orderF ts =
            <> cs (pgFmtIdent $ otTerm t) <> " "
            <> cs (otDirection t)         <> " "
            <> maybe "" cs (otNullOrder t) <> " "
+
+-- formating functions
+
+pgFmtValue :: T.Text -> T.Text -> T.Text
+pgFmtValue opCode val =
+ case opCode of
+   "like" -> unknownLiteral $ T.map star val
+   "ilike" -> unknownLiteral $ T.map star val
+   "in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
+   "notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
+   "@@" -> "to_tsquery(" <> unknownLiteral val <> ") "
+   _    -> unknownLiteral val
+ where
+   star c = if c == '*' then '%' else c
+   unknownLiteral = (<> "::unknown ") . pgFmtLit
+
+pgFmtOperator :: T.Text -> T.Text
+pgFmtOperator opCode =
+ case opCode of
+   "eq"  -> "="
+   "gt"  -> ">"
+   "lt"  -> "<"
+   "gte" -> ">="
+   "lte" -> "<="
+   "neq" -> "<>"
+   "like"-> "like"
+   "ilike"-> "ilike"
+   "in"  -> "in"
+   "notin" -> "not in"
+   "is"    -> "is"
+   "isnot" -> "is not"
+   "@@" -> "@@"
+   _     -> "="
+
+pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
+pgFmtJsonbPath table p =
+ pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
+ where
+   pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
+   pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
+   pgFmtJsonbPath' (SingleArrow a b) =
+     pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
+   pgFmtJsonbPath' (DoubleArrow a b) =
+     pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
+
+pgFmtIdent :: T.Text -> T.Text
+pgFmtIdent x =
+ let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
+ if (cs escaped :: BS.ByteString) =~ danger
+   then "\"" <> escaped <> "\""
+   else escaped
+
+ where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
+
+pgFmtLit :: T.Text -> T.Text
+pgFmtLit x =
+ let trimmed = trimNullChars x
+     escaped = "'" <> T.replace "'" "''" trimmed <> "'"
+     slashed = T.replace "\\" "\\\\" escaped in
+ if T.isInfixOf "\\\\" escaped
+   then "E" <> slashed
+   else slashed
+
+pgFmtCondition :: QualifiedIdentifier -> Filter -> T.Text
+pgFmtCondition table (Filter (col,jp) ops val) =
+ notOp <> " " <> sqlCol  <> " " <> pgFmtOperator opCode <> " " <>
+   if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
+ where
+   headPredicate:rest = T.split (=='.') ops
+   hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
+   opCode      = hasNot (head rest) headPredicate
+   notOp       = hasNot headPredicate ""
+   sqlCol = case val of
+     VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
+     VForeignKey qi _ -> pgFmtColumn qi col
+   sqlValue = valToStr val
+   getInner v = case v of
+     VText s -> s
+     _      -> ""
+   valToStr v = case v of
+     VText s -> pgFmtValue opCode s
+     VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn (QualifiedIdentifier s ft) fc
+
+pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
+pgFmtColumn table "*" = fromQi table <> ".*"
+pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
+
+pgFmtJsonPath :: Maybe JsonPath -> T.Text
+pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
+pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
+pgFmtJsonPath _ = ""
+
+pgFmtTable :: Table -> T.Text
+pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n
+
+pgFmtField :: QualifiedIdentifier -> Field -> T.Text
+pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
+
+pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> T.Text
+pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp
+pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp
+
+pgFmtAsJsonPath :: Maybe JsonPath -> T.Text
+pgFmtAsJsonPath Nothing = ""
+pgFmtAsJsonPath (Just xx) = " AS " <> last xx
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index 1044cdf8a..60521839b 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -10,9 +10,9 @@ import           Data.Text         hiding (filter, find, foldr, head, last, map,
                                     null, zipWith)
 import           Control.Applicative
 import           Data.Tree
-import           PostgREST.PgQuery (fromQi,
-                                    pgFmtIdent, pgFmtLit, pgFmtOperator,
-                                    pgFmtValue, whiteList, insertableValue, orderF)
+import           PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem,
+                                    pgFmtIdent, pgFmtCondition,
+                                    insertableValue, orderF)
 import           PostgREST.Types
 --import qualified Data.Vector       as V (empty)
 --import qualified Hasql.Backend     as B
@@ -161,47 +161,3 @@ requestToQuery schema (Node (Insert _ flds vals, (mainTbl, _)) _) =
     --       ) vals
     --     )
     --   <> " returning row_to_json(" <> fromQi t <> ".*)")
-
-
-pgFmtCondition :: QualifiedIdentifier -> Filter -> Text
-pgFmtCondition table (Filter (col,jp) ops val) =
-  notOp <> " " <> sqlCol  <> " " <> pgFmtOperator opCode <> " " <>
-    if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
-  where
-    headPredicate:rest = split (=='.') ops
-    hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
-    opCode      = hasNot (head rest) headPredicate
-    notOp       = hasNot headPredicate ""
-    sqlCol = case val of
-      VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
-      VForeignKey qi _ -> pgFmtColumn qi col
-    sqlValue = valToStr val
-    getInner v = case v of
-      VText s -> s
-      _      -> ""
-    valToStr v = case v of
-      VText s -> pgFmtValue opCode s
-      VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn (QualifiedIdentifier s ft) fc
-
-pgFmtColumn :: QualifiedIdentifier -> Text -> Text
-pgFmtColumn table "*" = fromQi table <> ".*"
-pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
-
-pgFmtJsonPath :: Maybe JsonPath -> Text
-pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
-pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
-pgFmtJsonPath _ = ""
-
-pgFmtTable :: Table -> Text
-pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n
-
-pgFmtField :: QualifiedIdentifier -> Field -> Text
-pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
-
-pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Text
-pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> asJsonPath jp
-pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> asJsonPath jp
-
-asJsonPath :: Maybe JsonPath -> Text
-asJsonPath Nothing = ""
-asJsonPath (Just xx) = " AS " <> last xx

From 826de74a5d22c3ca561467a7a82a3a2859adf331 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Fri, 23 Oct 2015 12:31:46 +0300
Subject: [PATCH 38/81] rearange paths to put the most used ones at the top in
 the case expression

---
 src/PostgREST/App.hs | 62 ++++++++++++++++++++++----------------------
 1 file changed, 31 insertions(+), 31 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index f1c875120..80919ed94 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -66,17 +66,6 @@ app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s
 app dbstructure conf reqBody req =
   case (path, verb) of
 
-    ([], _) -> do
-      Identity (dbrole :: Text) <- H.singleEx $ [H.stmt|SELECT current_user|]
-      let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTabs
-      return $ responseLBS status200 [jsonH] $ cs body
-
-    ([table], "OPTIONS") -> do
-      let cols = filter (filterCol schema table) allCols
-          pkeys = map pkName $ filter (filterPk schema table) allPrKeys
-          body = encode (TableOptions cols pkeys)
-      return $ responseLBS status200 [jsonH, allOrigins] $ cs body
-
     ([table], "GET") ->
       if range == Just emptyRange
       then return $ responseLBS status416 [] "HTTP Range error"
@@ -161,26 +150,6 @@ app dbstructure conf reqBody req =
         returnSingle = fst <$> res
         insertQuery = requestToQuery schema <$> apiRequest
 
-    (["rpc", proc], "POST") -> do
-      let qi = QualifiedIdentifier schema (cs proc)
-      exists <- doesProcExist schema proc
-      if exists
-        then do
-          let call = B.Stmt "select " V.empty True <>
-                asJson (callProc qi $ fromMaybe M.empty (decode reqBody))
-          bodyJson :: Maybe (Identity Value) <- H.maybeEx call
-          returnJWT <- doesProcReturnJWT schema proc
-          return $ responseLBS status200 [jsonH]
-                 (let body = fromMaybe emptyArray $ runIdentity <$> bodyJson in
-                    if returnJWT
-                    then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
-                    else cs $ encode body)
-        else return $ responseLBS status404 [] ""
-
-      -- check that proc exists
-      -- check that arg names are all specified
-      -- select * from public.proc(a := "foo"::undefined) where whereT limit limitT
-
     ([table], "PUT") ->
       handleJsonObj reqBody $ \obj -> do
         let qt = qualify table
@@ -237,6 +206,37 @@ app dbstructure conf reqBody req =
         then responseLBS status404 [] ""
         else responseLBS status204 [("Content-Range", "*/"<> cs (show deletedCount))] ""
 
+    (["rpc", proc], "POST") -> do
+      let qi = QualifiedIdentifier schema (cs proc)
+      exists <- doesProcExist schema proc
+      if exists
+        then do
+          let call = B.Stmt "select " V.empty True <>
+                asJson (callProc qi $ fromMaybe M.empty (decode reqBody))
+          bodyJson :: Maybe (Identity Value) <- H.maybeEx call
+          returnJWT <- doesProcReturnJWT schema proc
+          return $ responseLBS status200 [jsonH]
+                 (let body = fromMaybe emptyArray $ runIdentity <$> bodyJson in
+                    if returnJWT
+                    then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
+                    else cs $ encode body)
+        else return $ responseLBS status404 [] ""
+
+      -- check that proc exists
+      -- check that arg names are all specified
+      -- select * from public.proc(a := "foo"::undefined) where whereT limit limitT
+
+    ([], _) -> do
+      Identity (dbrole :: Text) <- H.singleEx $ [H.stmt|SELECT current_user|]
+      let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTabs
+      return $ responseLBS status200 [jsonH] $ cs body
+
+    ([table], "OPTIONS") -> do
+      let cols = filter (filterCol schema table) allCols
+          pkeys = map pkName $ filter (filterPk schema table) allPrKeys
+          body = encode (TableOptions cols pkeys)
+      return $ responseLBS status200 [jsonH, allOrigins] $ cs body
+
     (_, _) ->
       return $ responseLBS status404 [] ""
 

From e40dcb13245d397ea4c0dc149d1af191095a0e4d Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Fri, 23 Oct 2015 12:53:31 +0300
Subject: [PATCH 39/81] simplify operator formatting function

---
 src/PostgREST/PgQuery.hs | 36 ++++++++++++++++++++----------------
 1 file changed, 20 insertions(+), 16 deletions(-)

diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index 1ea572a59..62cb78327 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -72,6 +72,7 @@ import qualified Network.HTTP.Types.URI  as Net
 import           Text.Regex.TDFA         ((=~))
 
 import           Prelude
+import qualified Data.Map                as M
 
 type PStmt = H.Stmt P.Postgres
 instance Monoid PStmt where
@@ -86,6 +87,24 @@ data JsonbPath =
   | DoubleArrow JsonbPath JsonbPath
   deriving (Show)
 
+operators :: M.Map T.Text T.Text
+operators = M.fromList [
+  ("eq", "="),
+  ("gt", ">"),
+  ("lt", "<"),
+  ("gte", ">="),
+  ("lte", "<="),
+  ("neq", "<>"),
+  ("like", "like"),
+  ("ilike", "ilike"),
+  ("in", "in"),
+  ("notin", "not in"),
+  ("is", "is"),
+  ("isnot", "is not"),
+  ("@@", "@@")
+  ]
+
+
 whereT :: QualifiedIdentifier -> Net.Query -> StatementT
 whereT table params q =
   if L.null cols
@@ -323,22 +342,7 @@ pgFmtValue opCode val =
    unknownLiteral = (<> "::unknown ") . pgFmtLit
 
 pgFmtOperator :: T.Text -> T.Text
-pgFmtOperator opCode =
- case opCode of
-   "eq"  -> "="
-   "gt"  -> ">"
-   "lt"  -> "<"
-   "gte" -> ">="
-   "lte" -> "<="
-   "neq" -> "<>"
-   "like"-> "like"
-   "ilike"-> "ilike"
-   "in"  -> "in"
-   "notin" -> "not in"
-   "is"    -> "is"
-   "isnot" -> "is not"
-   "@@" -> "@@"
-   _     -> "="
+pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operators
 
 pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
 pgFmtJsonbPath table p =

From 7692693aaecb9b29e9af1d55055d4475e2e750af Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Fri, 23 Oct 2015 10:33:27 -0700
Subject: [PATCH 40/81] Enforce GHC >= 7.10 and fix Stack warnings

---
 circle.yml                  |  2 +-
 postgrest.cabal             | 38 ++++++++++++++++++++++++++++---------
 src/PostgREST/Auth.hs       |  3 ---
 src/PostgREST/Middleware.hs |  3 ---
 src/PostgREST/Parsers.hs    |  4 ----
 5 files changed, 30 insertions(+), 20 deletions(-)

diff --git a/circle.yml b/circle.yml
index 84c32bb12..74c1982c8 100644
--- a/circle.yml
+++ b/circle.yml
@@ -3,7 +3,7 @@ machine:
     - createuser --superuser --no-password postgrest_test
     - createdb -O postgrest_test -U ubuntu postgrest_test
   ghc:
-    version: 7.8.3
+    version: 7.10.1
 dependencies:
   override:
     - cabal update
diff --git a/postgrest.cabal b/postgrest.cabal
index 38f5bf364..d4a01c176 100644
--- a/postgrest.cabal
+++ b/postgrest.cabal
@@ -25,7 +25,7 @@ executable postgrest
   main-is:             PostgREST/Main.hs
   default-extensions:  OverloadedStrings, ScopedTypeVariables, QuasiQuotes
   default-language:    Haskell2010
-  build-depends:       base >=4.6 && <5
+  build-depends:       base >= 4.8 && < 5
                      , postgrest
                      , hasql >= 0.7.3 && < 0.8
                      , hasql-backend >= 0.4.1 && < 0.5
@@ -57,6 +57,18 @@ executable postgrest
                      , errors
                      , bifunctors
   hs-source-dirs:      src
+  other-modules:       Paths_postgrest
+                     , PostgREST.App
+                     , PostgREST.Auth
+                     , PostgREST.Config
+                     , PostgREST.Error
+                     , PostgREST.Middleware
+                     , PostgREST.Parsers
+                     , PostgREST.PgQuery
+                     , PostgREST.PgStructure
+                     , PostgREST.QueryBuilder
+                     , PostgREST.RangeQuery
+                     , PostgREST.Types
 
 library
   if flag(ci)
@@ -111,16 +123,16 @@ library
 
   Other-Modules:       Paths_postgrest
   Exposed-Modules:     PostgREST.App
-                     , PostgREST.Types
-                     , PostgREST.Parsers
-                     , PostgREST.QueryBuilder
                      , PostgREST.Auth
                      , PostgREST.Config
                      , PostgREST.Error
                      , PostgREST.Middleware
+                     , PostgREST.Parsers
                      , PostgREST.PgQuery
                      , PostgREST.PgStructure
+                     , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
+                     , PostgREST.Types
   hs-source-dirs:      src
 
 Test-Suite spec
@@ -133,20 +145,28 @@ Test-Suite spec
   else
     ghc-options:       -Wall -W -O2
   Main-Is:             Main.hs
-  Other-Modules:       PostgREST.App
-                     , PostgREST.Types
-                     , PostgREST.Parsers
-                     , PostgREST.QueryBuilder
+  Other-Modules:       Feature.AuthSpec
+                     , Feature.CorsSpec
+                     , Feature.DeleteSpec
+                     , Feature.InsertSpec
+                     , Feature.QuerySpec
+                     , Feature.RangeSpec
+                     , Feature.StructureSpec
+                     , Paths_postgrest
+                     , PostgREST.App
                      , PostgREST.Auth
                      , PostgREST.Config
                      , PostgREST.Error
                      , PostgREST.Middleware
+                     , PostgREST.Parsers
                      , PostgREST.PgQuery
                      , PostgREST.PgStructure
+                     , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
+                     , PostgREST.Types
                      , Spec
                      , SpecHelper
-                     , Paths_postgrest
+                     , TestTypes
   Build-Depends:       base, hspec == 2.1.*, QuickCheck
                      , hspec-wai, hspec-wai-json
                      , hasql, hasql-backend
diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index 94e36d90b..4bf13dc59 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -18,9 +18,6 @@ module PostgREST.Auth (
   , tokenJWT
   ) where
 
---line needed for ghc 7.8
-import           Data.Functor            ((<$>))
- 
 import           Data.Aeson              (Value (..), Object)
 import           Data.Aeson.Types        (emptyObject, emptyArray)
 import           Data.Vector             as V (null, head)
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index 90b71a40e..5787ca3a2 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -3,9 +3,6 @@
 
 module PostgREST.Middleware where
 
--- needed for ghc 7.8
-import           Data.Functor ((<$>))
-
 import           Data.Maybe                    (fromMaybe, isNothing)
 import           Data.Monoid
 import           Data.Text
diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs
index 235962811..b1f2a77a4 100644
--- a/src/PostgREST/Parsers.hs
+++ b/src/PostgREST/Parsers.hs
@@ -4,10 +4,6 @@ module PostgREST.Parsers
 where
 
 import           Control.Applicative hiding ((<$>))
---lines needed for ghc 7.8
-import           Data.Functor ((<$>))
-import           Data.Traversable (traverse)
-
 import           Control.Monad                 (join)
 import           Data.List                     (delete, find)
 import           Data.Maybe

From af15046d3f977f641720827cd1b4dd655b6117ea Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Fri, 23 Oct 2015 11:08:59 -0700
Subject: [PATCH 41/81] Use newer hspec

---
 postgrest.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/postgrest.cabal b/postgrest.cabal
index d4a01c176..40140e9ca 100644
--- a/postgrest.cabal
+++ b/postgrest.cabal
@@ -167,7 +167,7 @@ Test-Suite spec
                      , Spec
                      , SpecHelper
                      , TestTypes
-  Build-Depends:       base, hspec == 2.1.*, QuickCheck
+  Build-Depends:       base, hspec == 2.2.*, QuickCheck
                      , hspec-wai, hspec-wai-json
                      , hasql, hasql-backend
                      , hasql-postgres

From 5de9db0ca194ce2531be84ef0b0c25eb433d6f6f Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Fri, 23 Oct 2015 15:44:18 -0400
Subject: [PATCH 42/81] Updates stack resolver to 3.10 and adds new hspec to
 custom build plan

---
 stack.yaml | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/stack.yaml b/stack.yaml
index be8f9f2d6..2dc4d15b6 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -4,4 +4,8 @@ packages:
 extra-deps: 
   - Ranged-sets-0.3.0
   - packdeps-0.4.1
-resolver: lts-3.7
+  - hspec-2.2.0
+  - hspec-core-2.2.0
+  - hspec-discover-2.2.0
+  - hspec-expectations-0.7.2
+resolver: lts-3.10

From 5390fb702de78e9d76bf4cd38154de265d2dab67 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Sat, 24 Oct 2015 23:06:19 +0300
Subject: [PATCH 43/81] Fix for #321

---
 src/PostgREST/PgStructure.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/PostgREST/PgStructure.hs b/src/PostgREST/PgStructure.hs
index fe5c039a2..7a1cf6147 100644
--- a/src/PostgREST/PgStructure.hs
+++ b/src/PostgREST/PgStructure.hs
@@ -119,7 +119,7 @@ allRelations = do
            LATERAL (SELECT array_agg(cols.attname) AS cols,
                            array_agg(cols.attnum)  AS nums,
                            array_agg(refs.attname) AS refs
-                      FROM unnest(conkey, confkey) AS _(col, ref),
+                      FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
                            LATERAL (SELECT * FROM pg_attribute
                                      WHERE attrelid = conrelid AND attnum = col)
                                 AS cols,

From 1fdb700bc8e5a5d1a8e7d65baf643076c4388541 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Mon, 26 Oct 2015 13:50:56 +0200
Subject: [PATCH 44/81] Fix a few tests

---
 src/PostgREST/Parsers.hs   |  6 ++--
 src/PostgREST/PgQuery.hs   |  4 +--
 test/Feature/InsertSpec.hs | 71 +++++++++++++++++++++++++++-----------
 test/Feature/QuerySpec.hs  |  2 +-
 4 files changed, 57 insertions(+), 26 deletions(-)

diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs
index 6e2ffe4c0..753067567 100644
--- a/src/PostgREST/Parsers.hs
+++ b/src/PostgREST/Parsers.hs
@@ -4,9 +4,9 @@ module PostgREST.Parsers
 where
 
 import           Control.Applicative hiding ((<$>))
-import           Control.Monad                 (join)
-import           Data.List                     (delete, find)
-import           Data.Maybe
+--import           Control.Monad                 (join)
+--import           Data.List                     (delete, find)
+--import           Data.Maybe
 import           Data.Monoid
 import           Data.String.Conversions       (cs)
 import           Data.Text                     (Text)
diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index 62cb78327..2b9cb71ca 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -275,7 +275,7 @@ asJsonSingleF :: T.Text --TODO! unsafe when the query actually returns multiple
 asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying "
 
 asCsvF :: T.Text
-asCsvF = asCsvHeaderF <> " || '\r' || " <> asCsvBodyF
+asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
 
 asCsvHeaderF :: T.Text
 asCsvHeaderF =
@@ -289,7 +289,7 @@ asCsvHeaderF =
   ")"
 
 asCsvBodyF :: T.Text
-asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '')"
+asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')"
 
 fromF :: T.Text -> T.Text
 fromF limit = "FROM (SELECT * FROM source " <> limit <> ") t"
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index 5bf3db354..51db4fb56 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -92,31 +92,62 @@ spec = afterAll_ resetDb $ around withApp $ do
     context "jsonb" . after_ (clearTable "json") $ do
       it "serializes nested object" $ do
         let inserted = [json| { "data": { "foo":"bar" } } |]
-        p <- request methodPost "json" [("Prefer", "return=representation")] inserted
-        liftIO $ do
-          simpleBody p `shouldBe` inserted
-          simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%7B%22foo%22%3A%22bar%22%7D"
-          simpleStatus p `shouldBe` created201
+        request methodPost "/json"
+                     [("Prefer", "return=representation")]
+                     inserted
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just inserted
+          , matchStatus  = 201
+          , matchHeaders = ["Location" <:> [str|/json?data=eq.{"foo":"bar"}|]]
+          }
+
+        -- TODO! the test above seems right, why was the one below working before and not now
+        -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted
+        -- liftIO $ do
+        --   simpleBody p `shouldBe` inserted
+        --   simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%7B%22foo%22%3A%22bar%22%7D"
+        --   simpleStatus p `shouldBe` created201
+
       it "serializes nested array" $ do
         let inserted = [json| { "data": [1,2,3] } |]
-        p <- request methodPost "json" [("Prefer", "return=representation")] inserted
-        liftIO $ do
-          simpleBody p `shouldBe` inserted
-          simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%5B1%2C2%2C3%5D"
-          simpleStatus p `shouldBe` created201
+        request methodPost "/json"
+                     [("Prefer", "return=representation")]
+                     inserted
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just inserted
+          , matchStatus  = 201
+          , matchHeaders = ["Location" <:> [str|/json?data=eq.[1,2,3]|]]
+          }
+        -- TODO! the test above seems right, why was the one below working before and not now
+        -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted
+        -- liftIO $ do
+        --   simpleBody p `shouldBe` inserted
+        --   simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%5B1%2C2%2C3%5D"
+        --   simpleStatus p `shouldBe` created201
 
   describe "CSV insert" $ do
 
     after_ (clearTable "menagerie") . context "disparate csv types" $
       it "succeeds with multipart response" $ do
-        p <- request methodPost "/menagerie" [("Content-Type", "text/csv")]
-               [str|integer,double,varchar,boolean,date,money,enum
-                   |13,3.14159,testing!,false,1900-01-01,$3.99,foo
-                   |12,0.1,a string,true,1929-10-01,12,bar
-                   |]
-        liftIO $ do
-          simpleBody p `shouldBe` "Content-Type: application/json\nLocation: /menagerie?integer=eq.13\n\n\n--postgrest_boundary\nContent-Type: application/json\nLocation: /menagerie?integer=eq.12\n\n"
-          simpleStatus p `shouldBe` created201
+        let inserted = [str|integer,double,varchar,boolean,date,money,enum
+            |13,3.14159,testing!,false,1900-01-01,$3.99,foo
+            |12,0.1,a string,true,1929-10-01,12,bar
+            |]
+        request methodPost "/menagerie" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] inserted
+
+           `shouldRespondWith` ResponseMatcher {
+             matchBody    = Just inserted
+           , matchStatus  = 201
+           , matchHeaders = ["Content-Type" <:> "text/csv"]
+           }
+        -- p <- request methodPost "/menagerie" [("Content-Type", "text/csv")]
+        --        [str|integer,double,varchar,boolean,date,money,enum
+        --            |13,3.14159,testing!,false,1900-01-01,$3.99,foo
+        --            |12,0.1,a string,true,1929-10-01,12,bar
+        --            |]
+        -- liftIO $ do
+        --   simpleBody p `shouldBe` "Content-Type: application/json\nLocation: /menagerie?integer=eq.13\n\n\n--postgrest_boundary\nContent-Type: application/json\nLocation: /menagerie?integer=eq.12\n\n"
+        --   simpleStatus p `shouldBe` created201
 
     after_ (clearTable "no_pk") . context "requesting full representation" $ do
       it "returns full details of inserted record" $
@@ -124,7 +155,7 @@ spec = afterAll_ resetDb $ around withApp $ do
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"),  ("Prefer", "return=representation")]
                      "a,b\nbar,baz"
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "a,b\rbar,baz"
+            matchBody    = Just "a,b\nbar,baz"
           , matchStatus  = 201
           , matchHeaders = ["Content-Type" <:> "text/csv",
                             "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"]
@@ -146,7 +177,7 @@ spec = afterAll_ resetDb $ around withApp $ do
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                      "a,b\nNULL,foo"
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "a,b\r,foo"
+            matchBody    = Just "a,b\n,foo"
           , matchStatus  = 201
           , matchHeaders = ["Content-Type" <:> "text/csv",
                             "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs
index 04bdfee88..c094934cc 100644
--- a/test/Feature/QuerySpec.hs
+++ b/test/Feature/QuerySpec.hs
@@ -272,7 +272,7 @@ spec =
       request methodGet "/simple_pk"
               (acceptHdrs "text/csv; version=1") ""
         `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just "k,extra\rxyyx,u\rxYYx,v"
+          matchBody    = Just "k,extra\nxyyx,u\nxYYx,v"
         , matchStatus  = 200
         , matchHeaders = ["Content-Type" <:> "text/csv"]
         }

From d8b7332acc83216c7f2f5f4363789be8ccbb1fc7 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Mon, 26 Oct 2015 15:27:28 +0200
Subject: [PATCH 45/81] Code cleanup (lint suggestions)

---
 src/PostgREST/App.hs       | 24 ++++++++++++++----------
 test/Feature/InsertSpec.hs |  2 +-
 2 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 4b1358747..6a49cd06f 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -78,10 +78,9 @@ app dbstructure conf reqBody req =
                       wrapQuery qs [
                         (if hasPrefer "count=none" then countNoneF else countAllF),
                         countF,
-                        (case contentType of
+                        case contentType of
                           "text/csv" -> asCsvF -- TODO check when in csv mode if the header is correct when requesting nested data
                           _     -> asJsonF
-                        )
                       ] range
                     )
                     V.empty True
@@ -120,7 +119,7 @@ app dbstructure conf reqBody req =
               q = B.Stmt
                     (
                       wrapQuery qs [
-                        (if isSingle then locationF pKeys else "null"),
+                        if isSingle then locationF pKeys else "null",
                         "null", -- countF,
                         (
                           if echoRequested
@@ -368,6 +367,7 @@ parsePostRequest rootTableName httpRequest reqBody =
     --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
     isCsv = lookupHeader "Content-Type" == Just csvMT
 
+
 parseRequestBody :: Bool -> BL.ByteString -> Either Text ([Text],[[Value]])
 parseRequestBody isCsv reqBody = first cs $
   checkStructure =<<
@@ -379,13 +379,17 @@ parseRequestBody isCsv reqBody = first cs $
   else eitherDecode reqBody >>= convertJson
   where
     checkStructure :: ([Text], [[Value]]) -> Either String ([Text], [[Value]])
-    checkStructure v =
-      if headerMatchesContent v
-      then Right v
-      else
-        if isCsv
-        then Left "CSV header does not match rows length"
-        else Left "The number of keys in objects do not match"
+    checkStructure v
+    | headerMatchesContent v = Right v
+    | isCsv = Left "CSV header does not match rows length"
+    | otherwise = Left "The number of keys in objects do not match"
+    -- checkStructure v =
+    --   if headerMatchesContent v
+    --   then Right v
+    --   else
+    --     if isCsv
+    --     then Left "CSV header does not match rows length"
+    --     else Left "The number of keys in objects do not match"
 
     headerMatchesContent :: ([Text], [[Value]]) -> Bool
     headerMatchesContent (header, vals) = all ( (headerLength ==) . length) vals
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index 51db4fb56..c0775150b 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -172,7 +172,7 @@ spec = afterAll_ resetDb $ around withApp $ do
       --     , matchHeaders = ["Content-Type" <:> "application/json",
       --                       "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
       --     }
-      it "can post nulls" $ do
+      it "can post nulls" $
         request methodPost "/no_pk"
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                      "a,b\nNULL,foo"

From d43bac6e8f69bb1628b582702052a7c85e778757 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Mon, 26 Oct 2015 15:27:28 +0200
Subject: [PATCH 46/81] Code cleanup (lint suggestions)

---
 src/PostgREST/App.hs       | 24 ++++++++++++++----------
 test/Feature/InsertSpec.hs |  2 +-
 2 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 4b1358747..c1a247bc0 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -78,10 +78,9 @@ app dbstructure conf reqBody req =
                       wrapQuery qs [
                         (if hasPrefer "count=none" then countNoneF else countAllF),
                         countF,
-                        (case contentType of
+                        case contentType of
                           "text/csv" -> asCsvF -- TODO check when in csv mode if the header is correct when requesting nested data
                           _     -> asJsonF
-                        )
                       ] range
                     )
                     V.empty True
@@ -120,7 +119,7 @@ app dbstructure conf reqBody req =
               q = B.Stmt
                     (
                       wrapQuery qs [
-                        (if isSingle then locationF pKeys else "null"),
+                        if isSingle then locationF pKeys else "null",
                         "null", -- countF,
                         (
                           if echoRequested
@@ -368,6 +367,7 @@ parsePostRequest rootTableName httpRequest reqBody =
     --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
     isCsv = lookupHeader "Content-Type" == Just csvMT
 
+
 parseRequestBody :: Bool -> BL.ByteString -> Either Text ([Text],[[Value]])
 parseRequestBody isCsv reqBody = first cs $
   checkStructure =<<
@@ -379,13 +379,17 @@ parseRequestBody isCsv reqBody = first cs $
   else eitherDecode reqBody >>= convertJson
   where
     checkStructure :: ([Text], [[Value]]) -> Either String ([Text], [[Value]])
-    checkStructure v =
-      if headerMatchesContent v
-      then Right v
-      else
-        if isCsv
-        then Left "CSV header does not match rows length"
-        else Left "The number of keys in objects do not match"
+    checkStructure v
+      | headerMatchesContent v = Right v
+      | isCsv = Left "CSV header does not match rows length"
+      | otherwise = Left "The number of keys in objects do not match"
+    -- checkStructure v =
+    --   if headerMatchesContent v
+    --   then Right v
+    --   else
+    --     if isCsv
+    --     then Left "CSV header does not match rows length"
+    --     else Left "The number of keys in objects do not match"
 
     headerMatchesContent :: ([Text], [[Value]]) -> Bool
     headerMatchesContent (header, vals) = all ( (headerLength ==) . length) vals
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index 51db4fb56..c0775150b 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -172,7 +172,7 @@ spec = afterAll_ resetDb $ around withApp $ do
       --     , matchHeaders = ["Content-Type" <:> "application/json",
       --                       "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
       --     }
-      it "can post nulls" $ do
+      it "can post nulls" $
         request methodPost "/no_pk"
                      [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                      "a,b\nNULL,foo"

From f02b8381eaeb8b1a26872e8be4e1c9f8830201db Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Tue, 27 Oct 2015 13:14:02 +0200
Subject: [PATCH 47/81] shape the response after inserting

---
 src/PostgREST/App.hs          | 102 +++++++++++++++++++++++-----------
 src/PostgREST/Main.hs         |  10 +++-
 src/PostgREST/PgQuery.hs      |  61 +++++++++++---------
 src/PostgREST/QueryBuilder.hs |  27 ++++++---
 test/Feature/InsertSpec.hs    |  42 ++++++++++----
 test/Feature/QuerySpec.hs     |   1 +
 test/SpecHelper.hs            |   7 +++
 7 files changed, 174 insertions(+), 76 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index c1a247bc0..7509cf790 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -24,7 +24,7 @@ import qualified Data.Csv                  as CSV
 import           Data.Functor.Identity
 import qualified Data.HashMap.Strict       as M
 import           Data.List                 (find, sortBy, delete, transpose)
-import           Data.Maybe                (fromMaybe, fromJust, isJust, isNothing)
+import           Data.Maybe                (fromMaybe, fromJust, isJust, isNothing, mapMaybe)
 import           Data.Ord                  (comparing)
 import           Data.Ranged.Ranges        (emptyRange)
 import qualified Data.Set                  as S
@@ -61,6 +61,7 @@ import           PostgREST.Types
 import           PostgREST.Auth (tokenJWT)
 
 import           Prelude
+import           Debug.Trace
 
 app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
 app dbstructure conf reqBody req =
@@ -76,12 +77,12 @@ app dbstructure conf reqBody req =
             let q = B.Stmt
                     (
                       wrapQuery qs [
-                        (if hasPrefer "count=none" then countNoneF else countAllF),
+                        if hasPrefer "count=none" then countNoneF else countAllF,
                         countF,
                         case contentType of
                           "text/csv" -> asCsvF -- TODO check when in csv mode if the header is correct when requesting nested data
                           _     -> asJsonF
-                      ] range
+                      ] selectStarF range
                     )
                     V.empty True
             row <- H.maybeEx q
@@ -104,32 +105,32 @@ app dbstructure conf reqBody req =
 
         where
             frm = fromMaybe 0 $ rangeOffset <$> range
-            apiRequest = parseGetRequest table req
-                     >>= first formatRelationError . addRelations schema allRels Nothing
-                     >>= addJoinConditions schema allCols
+            -- apiRequest = parseGetRequest table req
+            --          >>= first formatRelationError . addRelations schema allRels Nothing
+            --          >>= addJoinConditions schema allCols
+            apiRequest = parseGetRequest table req >>= augumentRequestWithJoin schema allRels
             query = requestToQuery schema <$> apiRequest
 
     ([table], "POST") -> do
       let echoRequested = hasPrefer "return=representation"
-      case insertQuery of
+      case queries of
         Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
-        Right qs -> do
+        Right (qi, qs) -> do
           let isSingle = either (const False) id returnSingle
               pKeys = map pkName $ filter (filterPk schema table) allPrKeys
               q = B.Stmt
                     (
-                      wrapQuery qs [
+                      wrapQuery qi [
                         if isSingle then locationF pKeys else "null",
                         "null", -- countF,
-                        (
-                          if echoRequested
-                          then
-                            case contentType of
-                               "text/csv" -> asCsvF
-                               _     -> if isSingle then asJsonSingleF else asJsonF
-                          else "null"
-                        )
-                      ] Nothing
+                        if echoRequested
+                        then
+                          case contentType of
+                             "text/csv" -> asCsvF
+                             _     -> if isSingle then asJsonSingleF else asJsonF
+                        else "null"
+
+                      ] qs Nothing
                     )
                     V.empty True
 
@@ -145,9 +146,18 @@ app dbstructure conf reqBody req =
             $ if echoRequested then body else ""
       where
         res = parsePostRequest table req reqBody
-        apiRequest = snd <$> res
-        returnSingle = fst <$> res
-        insertQuery = requestToQuery schema <$> apiRequest
+        ins = fst <$> res
+        insertApiRequest = snd <$> ins
+        returnSingle = fst <$> ins
+        insertQuery = requestToQuery schema <$> insertApiRequest
+        selectApiRequest = (snd <$> res) >>= augumentRequestWithJoin schema (fakeSourceRelations ++ allRels)
+        selectQuery = requestToQuery schema <$> selectApiRequest
+        queries = (,) <$> insertQuery <*> selectQuery
+        fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
+        --changeRootNodeToSource :: Text -> ApiRequest -> ApiRequest
+        --changeRootNodeToSource rootTableName (q, (rootTableName, r)) =
+
+        --returnSelect = selectStarF
 
     ([table], "PUT") ->
       handleJsonObj reqBody $ \obj -> do
@@ -350,11 +360,12 @@ formatParserError e = cs $ encode $ object [
      details = strip $ replace "\n" " " $ cs
        $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
 
-parsePostRequest :: NodeName -> Request -> BL.ByteString -> Either Text (Bool, ApiRequest)
+-- quite ugly return type
+parsePostRequest :: NodeName -> Request -> BL.ByteString -> Either Text ((Bool, ApiRequest), ApiRequest)
 parsePostRequest rootTableName httpRequest reqBody =
-  (,) <$> returnSingle <*> node
+  (,) <$> ((,) <$> returnSingle <*> insertApiRequest) <*> returnApiRequest
   where
-    node = Node <$> apiNode <*> pure []
+    insertApiRequest = Node <$> apiNode <*> pure []
     apiNode = (,) <$> (Insert rootTableName <$> flds <*> vals) <*> pure (rootTableName, Nothing)
     flds =  join $ first formatParserError . mapM (parseField . cs) <$> (fst <$> parsed)
     vals = snd <$> parsed
@@ -366,6 +377,8 @@ parsePostRequest rootTableName httpRequest reqBody =
     lookupHeader  = flip lookup hdrs
     --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
     isCsv = lookupHeader "Content-Type" == Just csvMT
+    qParams = queryParams httpRequest
+    returnApiRequest = buildSelectApiRequest sourceSubqueryName (selectStr qParams) (whereFilters qParams) (orderStr qParams)
 
 
 parseRequestBody :: Bool -> BL.ByteString -> Either Text ([Text],[[Value]])
@@ -426,17 +439,36 @@ convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
 
 parseGetRequest :: NodeName -> Request -> Either Text ApiRequest
 parseGetRequest rootTableName httpRequest =
+  buildSelectApiRequest rootTableName (selectStr qParams) (whereFilters qParams) (orderStr qParams)
+  where
+    qParams = queryParams httpRequest
+
+augumentRequestWithJoin :: Text ->  [Relation] ->  ApiRequest -> Either Text ApiRequest
+augumentRequestWithJoin schema allRels request = return request
+         >>= first formatRelationError . addRelations schema allRels Nothing
+         >>= addJoinConditions schema
+
+-- we use strings here because most of this data will be sent to parsers (which need strings for now)
+queryParams :: Request -> [(String, Maybe String)]
+queryParams httpRequest = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
+
+selectStr :: [(String, Maybe String)] -> String
+selectStr qParams = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
+
+whereFilters :: [(String, Maybe String)] -> [(String, String)]
+whereFilters qParams = [ (k, fromJust v) | (k,v) <- qParams, k `notElem` ["select", "order"], isJust v ]
+
+orderStr :: [(String, Maybe String)] -> Maybe String
+orderStr qParams = join $ lookup "order" qParams
+
+buildSelectApiRequest :: Text -> String -> [(String, String)] -> Maybe String -> Either Text ApiRequest
+buildSelectApiRequest rootTableName sel wher orderS =
   first formatParserError $ foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
   where
-    apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++selectStr++">>") $ cs selectStr
+    apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++sel++">>") $ sel
     addOrder (Node (q,i) f) o = Node (q{order=o}, i) f
-    flts = mapM pRequestFilter whereFilters
-    --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
-    qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
-    orderStr = join $ lookup "order" qString
-    ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderStr++">>")) orderStr
-    selectStr = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qString --in case the parametre is missing or empty we default to *
-    whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ]
+    flts = mapM pRequestFilter wher
+    ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderS++">>")) orderS
 
 addFilter :: (Path, Filter) -> ApiRequest -> ApiRequest
 addFilter ([], flt) (Node (q@(Select {where_=flts}), i) forest) = Node (q {where_=flt:flts}, i) forest
@@ -453,6 +485,12 @@ addFilter (path, flt) (Node rn forest) =
         Just node -> (Just node, delete node forest)
       where maybeNode = find ((name==).fst.snd.rootLabel) forst
 
+toSourceRelation :: Text -> Relation -> Maybe Relation
+toSourceRelation mt r@(Relation _ t _ ft _ _ rt _ _)
+  | mt == t = Just $ r {relTable=sourceSubqueryName}
+  | mt == ft = Just $ r {relFTable=sourceSubqueryName}
+  | Just mt == rt = Just $ r {relLTable=Just sourceSubqueryName}
+  | otherwise = Nothing
 
 data TableOptions = TableOptions {
   tblOptcolumns :: [Column]
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index c83d304d6..af6f395fb 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -2,6 +2,7 @@ module Main where
 
 
 import           PostgREST.App
+-- import PostgREST.QueryBuilder
 import           PostgREST.Config                     (AppConfig (..),
                                                        minimumPgVersion,
                                                        prettyVersion,
@@ -26,7 +27,7 @@ import           Network.Wai.Middleware.RequestLogger (logStdout)
 import           System.IO                            (BufferMode (..),
                                                        hSetBuffering, stderr,
                                                        stdin, stdout)
-
+-- import Data.Maybe (mapMaybe)
 
 isServerVersionSupported :: H.Session P.Postgres IO Bool
 isServerVersionSupported = do
@@ -86,8 +87,10 @@ main = do
     keys <- allPrimaryKeys
     return (tabs, rels, cols, keys)
 
+
   dbstructure <- either hasqlError
     (\(tabs, rels, cols, keys) ->
+
       return DbStructure {
           tables=tabs
         , columns=cols
@@ -96,6 +99,11 @@ main = do
         }
     ) metadata
 
+  -- let allRels = relations dbstructure
+  --     fakeRels = mapMaybe (toSourceRelation "projects") allRels
+  --
+  -- print $ findRelation (fakeRels ++ allRels) "test" "pg_source" "clients"
+
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index 2b9cb71ca..3d25b2cd2 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -36,6 +36,7 @@ module PostgREST.PgQuery (
 , whereT
 
 -- query fragments
+, sourceSubqueryName
 , orderF
 , countNoneF
 , countAllF
@@ -44,6 +45,7 @@ module PostgREST.PgQuery (
 , asCsvF
 , asJsonSingleF
 , asJsonF
+, selectStarF
 
 , StatementT
 ) where
@@ -246,24 +248,27 @@ insertableValue :: JSON.Value -> T.Text
 insertableValue JSON.Null = "null"
 insertableValue v = insertableText $ unquoted v
 
-wrapQuery :: T.Text -> [T.Text] -> Maybe NonnegRange -> T.Text
-wrapQuery source selectColumns range =
+wrapQuery :: T.Text -> [T.Text] -> T.Text ->  Maybe NonnegRange -> T.Text
+wrapQuery source selectColumns returnSelect range =
   withSourceF source <>
   " SELECT " <>
   T.intercalate ", " selectColumns <>
   " " <>
-  fromF ( limitF range )
+  fromF returnSelect ( limitF range )
 
 
 -- query fragments
+sourceSubqueryName :: T.Text
+sourceSubqueryName = "pg_source"
+
 withSourceF :: T.Text -> T.Text
-withSourceF s = "WITH source AS (" <> s <>")"
+withSourceF s = "WITH " <> sourceSubqueryName <> " AS (" <> s <>")"
 
 countF :: T.Text
 countF = "pg_catalog.count(t)"
 
 countAllF :: T.Text
-countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM source) a )"
+countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )"
 
 countNoneF :: T.Text
 countNoneF = "null"
@@ -283,7 +288,7 @@ asCsvHeaderF =
   "  FROM (" <>
   "    SELECT json_object_keys(r)::TEXT as k" <>
   "    FROM ( " <>
-  "      SELECT row_to_json(source) as r from source limit 1" <>
+  "      SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <>
   "    ) s" <>
   "  ) a" <>
   ")"
@@ -291,8 +296,11 @@ asCsvHeaderF =
 asCsvBodyF :: T.Text
 asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')"
 
-fromF :: T.Text -> T.Text
-fromF limit = "FROM (SELECT * FROM source " <> limit <> ") t"
+selectStarF :: T.Text
+selectStarF = "SELECT * FROM " <> sourceSubqueryName
+
+fromF :: T.Text -> T.Text -> T.Text
+fromF sel limit = "FROM (" <> sel <> " " <> limit <> ") t"
 
 limitF :: Maybe NonnegRange -> T.Text
 limitF r  = "LIMIT " <> limit <> " OFFSET " <> offset
@@ -303,7 +311,7 @@ limitF r  = "LIMIT " <> limit <> " OFFSET " <> offset
 locationF :: [T.Text] -> T.Text
 locationF pKeys =
     "(" <>
-    " WITH s AS (SELECT row_to_json(source) as r from source limit 1)" <>
+    " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss  limit 1)" <>
     " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
     " FROM s, json_each_text(s.r) AS json_data" <>
     (
@@ -375,23 +383,24 @@ pgFmtLit x =
 
 pgFmtCondition :: QualifiedIdentifier -> Filter -> T.Text
 pgFmtCondition table (Filter (col,jp) ops val) =
- notOp <> " " <> sqlCol  <> " " <> pgFmtOperator opCode <> " " <>
-   if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
- where
-   headPredicate:rest = T.split (=='.') ops
-   hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
-   opCode      = hasNot (head rest) headPredicate
-   notOp       = hasNot headPredicate ""
-   sqlCol = case val of
-     VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
-     VForeignKey qi _ -> pgFmtColumn qi col
-   sqlValue = valToStr val
-   getInner v = case v of
-     VText s -> s
-     _      -> ""
-   valToStr v = case v of
-     VText s -> pgFmtValue opCode s
-     VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn (QualifiedIdentifier s ft) fc
+  notOp <> " " <> sqlCol  <> " " <> pgFmtOperator opCode <> " " <>
+    if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
+  where
+    headPredicate:rest = T.split (=='.') ops
+    hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
+    opCode      = hasNot (head rest) headPredicate
+    notOp       = hasNot headPredicate ""
+    sqlCol = case val of
+      VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
+      VForeignKey qi _ -> pgFmtColumn qi col
+    sqlValue = valToStr val
+    getInner v = case v of
+      VText s -> s
+      _      -> ""
+    valToStr v = case v of
+      VText s -> pgFmtValue opCode s
+      VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn qi fc
+        where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
 
 pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
 pgFmtColumn table "*" = fromQi table <> ".*"
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index 60521839b..ed8093769 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -12,7 +12,7 @@ import           Control.Applicative
 import           Data.Tree
 import           PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem,
                                     pgFmtIdent, pgFmtCondition,
-                                    insertableValue, orderF)
+                                    insertableValue, orderF, sourceSubqueryName)
 import           PostgREST.Types
 --import qualified Data.Vector       as V (empty)
 --import qualified Hasql.Backend     as B
@@ -47,8 +47,8 @@ getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) =
     toFilter :: Text -> Text -> FieldName -> FieldName -> Filter
     toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc))
 
-addJoinConditions :: Text -> [Column] -> ApiRequest -> Either Text ApiRequest
-addJoinConditions schema allColumns (Node (query, (t, r)) forest) =
+addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest
+addJoinConditions schema (Node (query, (t, r)) forest) =
   case r of
     Nothing -> Node (updatedQuery, (t, r))  <$> updatedForest -- this is the root node
     Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(t,r)) <$> updatedForest
@@ -68,7 +68,7 @@ addJoinConditions schema allColumns (Node (query, (t, r)) forest) =
         parents = mapMaybe (getParents.rootLabel) forest
         getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel)
         getParents _ = Nothing
-    updatedForest = mapM (addJoinConditions schema allColumns) forest
+    updatedForest = mapM (addJoinConditions schema) forest
     addCond q con = q{where_=con ++ where_ q}
 
 -- requestToCountQuery :: Text -> ApiRequest -> PStmt
@@ -94,11 +94,24 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
   where
     --query = B.Stmt qStr V.empty True
     --qStr = Data.Text.unwords [
+    -- query = Data.Text.unwords [
+    --   ("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
+    --   "SELECT ", intercalate ", " (map (pgFmtSelectItem (QualifiedIdentifier schema mainTbl)) colSelects ++ selects),
+    --   "FROM ", intercalate ", " (map (fromQi . QualifiedIdentifier schema) tbls),
+    --   ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl) ) conditions )) `emptyOnNull` conditions,
+    --   orderF (fromMaybe [] ord)
+    --   ]
+    -- TODO! the folloing helper functions are just to remove the "schema" part when the table is "source" which is the name
+    -- of our WITH query part
+    tblSchema tbl = if tbl == sourceSubqueryName then "" else schema
+    qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
+    toQi t = QualifiedIdentifier (tblSchema t) t
+
     query = Data.Text.unwords [
       ("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
-      "SELECT ", intercalate ", " (map (pgFmtSelectItem (QualifiedIdentifier schema mainTbl)) colSelects ++ selects),
-      "FROM ", intercalate ", " (map (fromQi . QualifiedIdentifier schema) tbls),
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl) ) conditions )) `emptyOnNull` conditions,
+      "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
+      "FROM ", intercalate ", " (map (fromQi . toQi) tbls),
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
       orderF (fromMaybe [] ord)
       ]
     emptyOnNull val x = if null x then "" else val
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index c0775150b..40a665651 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -19,16 +19,38 @@ import TestTypes(IncPK(..), CompoundPK(..))
 spec :: Spec
 spec = afterAll_ resetDb $ around withApp $ do
   describe "Posting new record" $ do
-    after_ (clearTable "menagerie") . it "accepts disparate json types" $ do
-      p <- post "/menagerie"
-        [json| {
-          "integer": 13, "double": 3.14159, "varchar": "testing!"
-        , "boolean": false, "date": "1900-01-01", "money": "$3.99"
-        , "enum": "foo"
-        } |]
-      liftIO $ do
-        simpleBody p `shouldBe` ""
-        simpleStatus p `shouldBe` created201
+    after_ (clearTable "menagerie") . context "disparate csv types" $ do
+      it "accepts disparate json types" $ do
+        p <- post "/menagerie"
+          [json| {
+            "integer": 13, "double": 3.14159, "varchar": "testing!"
+          , "boolean": false, "date": "1900-01-01", "money": "$3.99"
+          , "enum": "foo"
+          } |]
+        liftIO $ do
+          simpleBody p `shouldBe` ""
+          simpleStatus p `shouldBe` created201
+
+      it "filters columns in result using &select" $ do
+        request methodPost "/menagerie?select=integer,varchar" [("Prefer", "return=representation")]
+          [json| {
+            "integer": 14, "double": 3.14159, "varchar": "testing!"
+          , "boolean": false, "date": "1900-01-01", "money": "$3.99"
+          , "enum": "foo"
+          } |] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|{"integer":14,"varchar":"testing!"}|]
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "application/json"]
+          }
+
+      it "includes related data after insert" $ do
+        request methodPost "/projects?select=id,name,clients(id,name)" [("Prefer", "return=representation")]
+          [str|{"id":5,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [str|{"id":5,"name":"New Project","clients":{"id":2,"name":"Apple"}}|]
+          , matchStatus  = 201
+          , matchHeaders = ["Content-Type" <:> "application/json", "Location" <:> "/projects?id=eq.5"]
+          }
+
 
     context "with no pk supplied" $ do
       context "into a table with auto-incrementing pk" . after_ (clearTable "auto_incrementing_pk") $
diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs
index c094934cc..1ff4c899a 100644
--- a/test/Feature/QuerySpec.hs
+++ b/test/Feature/QuerySpec.hs
@@ -11,6 +11,7 @@ import SpecHelper
 spec :: Spec
 spec =
   beforeAll (clearTable "items" >> createItems 15)
+   . beforeAll (clearProjectsTable)
    . beforeAll (clearTable "complex_items" >> createComplexItems)
    . beforeAll (clearTable "nullable_integer" >> createNullInteger)
    . beforeAll (
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index bf7042c11..30af213d0 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -130,6 +130,13 @@ clearTable table = do
   void . liftIO $ H.session pool $ H.tx Nothing $
     H.unitEx $ B.Stmt ("delete from test."<>table) V.empty True
 
+clearProjectsTable :: IO ()
+clearProjectsTable = do
+  pool <- testPool
+  void . liftIO $ H.session pool $ H.tx Nothing $
+    H.unitEx $ B.Stmt ("delete from test.projects where id > 4") V.empty True
+
+
 createItems :: Int -> IO ()
 createItems n = do
   pool <- testPool

From f7e600508740652d09592962f7b7b1ce31e557b6 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Tue, 27 Oct 2015 14:14:04 +0200
Subject: [PATCH 48/81] cleanup

---
 src/PostgREST/App.hs       | 10 +++++-----
 test/Feature/InsertSpec.hs |  4 ++--
 test/Feature/QuerySpec.hs  |  2 +-
 3 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 7509cf790..89fb19ff9 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -61,7 +61,7 @@ import           PostgREST.Types
 import           PostgREST.Auth (tokenJWT)
 
 import           Prelude
-import           Debug.Trace
+--import           Debug.Trace
 
 app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
 app dbstructure conf reqBody req =
@@ -444,9 +444,9 @@ parseGetRequest rootTableName httpRequest =
     qParams = queryParams httpRequest
 
 augumentRequestWithJoin :: Text ->  [Relation] ->  ApiRequest -> Either Text ApiRequest
-augumentRequestWithJoin schema allRels request = return request
-         >>= first formatRelationError . addRelations schema allRels Nothing
-         >>= addJoinConditions schema
+augumentRequestWithJoin schema allRels request =
+  (first formatRelationError . addRelations schema allRels Nothing) request
+  >>= addJoinConditions schema
 
 -- we use strings here because most of this data will be sent to parsers (which need strings for now)
 queryParams :: Request -> [(String, Maybe String)]
@@ -465,7 +465,7 @@ buildSelectApiRequest :: Text -> String -> [(String, String)] -> Maybe String ->
 buildSelectApiRequest rootTableName sel wher orderS =
   first formatParserError $ foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
   where
-    apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++sel++">>") $ sel
+    apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++sel++">>") sel
     addOrder (Node (q,i) f) o = Node (q{order=o}, i) f
     flts = mapM pRequestFilter wher
     ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderS++">>")) orderS
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index 40a665651..ae4bcc095 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -31,7 +31,7 @@ spec = afterAll_ resetDb $ around withApp $ do
           simpleBody p `shouldBe` ""
           simpleStatus p `shouldBe` created201
 
-      it "filters columns in result using &select" $ do
+      it "filters columns in result using &select" $
         request methodPost "/menagerie?select=integer,varchar" [("Prefer", "return=representation")]
           [json| {
             "integer": 14, "double": 3.14159, "varchar": "testing!"
@@ -43,7 +43,7 @@ spec = afterAll_ resetDb $ around withApp $ do
           , matchHeaders = ["Content-Type" <:> "application/json"]
           }
 
-      it "includes related data after insert" $ do
+      it "includes related data after insert" $
         request methodPost "/projects?select=id,name,clients(id,name)" [("Prefer", "return=representation")]
           [str|{"id":5,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
             matchBody    = Just [str|{"id":5,"name":"New Project","clients":{"id":2,"name":"Apple"}}|]
diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs
index 1ff4c899a..b6a236813 100644
--- a/test/Feature/QuerySpec.hs
+++ b/test/Feature/QuerySpec.hs
@@ -11,7 +11,7 @@ import SpecHelper
 spec :: Spec
 spec =
   beforeAll (clearTable "items" >> createItems 15)
-   . beforeAll (clearProjectsTable)
+   . beforeAll clearProjectsTable
    . beforeAll (clearTable "complex_items" >> createComplexItems)
    . beforeAll (clearTable "nullable_integer" >> createNullInteger)
    . beforeAll (

From 482a43d722d3e4c83080014b27699cb6a9aa7ef6 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Tue, 27 Oct 2015 16:27:44 +0200
Subject: [PATCH 49/81] PATCH path rewriten in new style

---
 src/PostgREST/App.hs          | 104 +++++++++++++++++++++++++---------
 src/PostgREST/QueryBuilder.hs |  31 +++++-----
 src/PostgREST/Types.hs        |   6 +-
 3 files changed, 98 insertions(+), 43 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 89fb19ff9..7f7c83098 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -22,7 +22,7 @@ import qualified Data.ByteString.Char8     as BS
 import qualified Data.ByteString.Lazy      as BL
 import qualified Data.Csv                  as CSV
 import           Data.Functor.Identity
-import qualified Data.HashMap.Strict       as M
+import qualified Data.HashMap.Strict       as HM
 import           Data.List                 (find, sortBy, delete, transpose)
 import           Data.Maybe                (fromMaybe, fromJust, isJust, isNothing, mapMaybe)
 import           Data.Ord                  (comparing)
@@ -31,6 +31,7 @@ import qualified Data.Set                  as S
 import           Data.String.Conversions   (cs)
 import           Data.Text                 (Text, replace, strip)
 import           Data.Tree
+import qualified Data.Map as M
 --import           Data.Foldable             (forlrM)
 
 import           Text.Parsec.Error
@@ -169,10 +170,10 @@ app dbstructure conf reqBody req =
             "You must speficy all and only primary keys as params"
           else do
             let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols
-                cols = map cs $ M.keys obj
+                cols = map cs $ HM.keys obj
             if S.fromList tableCols == S.fromList cols
               then do
-                let vals = M.elems obj
+                let vals = HM.elems obj
                 H.unitEx $ iffNotT
                   (whereT qt qq $ update qt cols vals)
                   (insertSelect qt cols vals)
@@ -183,25 +184,49 @@ app dbstructure conf reqBody req =
                 else responseLBS status400 []
                   "You must specify all columns in PUT request"
 
-    ([table], "PATCH") ->
-      handleJsonObj reqBody $ \obj -> do
-        let qt = qualify table
-            up = returningStarT
-              . whereT qt qq
-              $ update qt (map cs $ M.keys obj) (M.elems obj)
-            patch = withT up "t" $ B.Stmt
-              "select count(t), array_to_json(array_agg(row_to_json(t)))::character varying"
-              V.empty True
+    ([table], "PATCH") -> do
+      let echoRequested = hasPrefer "return=representation"
+      case queries of
+        Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
+        Right (qu, qs) -> do
+          let q = B.Stmt
+                    (
+                      wrapQuery qu [
+                        countF,
+                        if echoRequested
+                        then
+                          case contentType of
+                             "text/csv" -> asCsvF
+                             _     -> asJsonF
+                        else "null"
 
-        row <- H.maybeEx patch
-        let (queryTotal, body) =
-              fromMaybe (0 :: Int, Just "" :: Maybe Text) row
-            r = contentRangeH 0 (queryTotal-1) (Just queryTotal)
-            echoRequested = hasPrefer "return=representation"
-            s = case () of _ | queryTotal == 0 -> status404
-                             | echoRequested -> status200
-                             | otherwise -> status204
-        return $ responseLBS s [ jsonH, r ] $ if echoRequested then cs $ fromMaybe "[]" body else ""
+                      ] qs Nothing
+                    )
+                    V.empty True
+
+          row <- H.maybeEx q
+          let (queryTotal, bodyRaw) = fromMaybe (0::Int, Just "" :: Maybe BL.ByteString) row
+              body = fromMaybe "[]" bodyRaw
+              r = contentRangeH 0 (queryTotal-1) (Just queryTotal)
+              s = case () of _ | queryTotal == 0 -> status404
+                               | echoRequested -> status200
+                               | otherwise -> status204
+          --return $ responseLBS s [ jsonH, r ] $ if echoRequested then cs $ fromMaybe "[]" body else ""
+          return $ responseLBS s
+            [
+              contentTypeH,
+              r
+            ]
+            $ if echoRequested then body else ""
+
+      where
+        res = parsePatchRequest table req reqBody
+        updateApiRequest = fst <$> res
+        updateQuery = requestToQuery schema <$> updateApiRequest
+        selectApiRequest = (snd <$> res) >>= augumentRequestWithJoin schema (fakeSourceRelations ++ allRels)
+        selectQuery = requestToQuery schema <$> selectApiRequest
+        queries = (,) <$> updateQuery <*> selectQuery
+        fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
 
     ([table], "DELETE") -> do
       let qt = qualify table
@@ -221,7 +246,7 @@ app dbstructure conf reqBody req =
       if exists
         then do
           let call = B.Stmt "select " V.empty True <>
-                asJson (callProc qi $ fromMaybe M.empty (decode reqBody))
+                asJson (callProc qi $ fromMaybe HM.empty (decode reqBody))
           bodyJson :: Maybe (Identity Value) <- H.maybeEx call
           returnJWT <- doesProcReturnJWT schema proc
           return $ responseLBS status200 [jsonH]
@@ -360,6 +385,32 @@ formatParserError e = cs $ encode $ object [
      details = strip $ replace "\n" " " $ cs
        $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
 
+parsePatchRequest :: NodeName -> Request -> BL.ByteString -> Either Text (ApiRequest, ApiRequest)
+parsePatchRequest rootTableName httpRequest reqBody =
+  (,) <$> updateApiRequest <*> returnApiRequest
+  where
+    updateApiRequest = Node <$> apiNode <*> pure []
+    apiNode = (,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)
+    flds =  join $ first formatParserError . mapM (parseField . cs) <$> (fst <$> parsed)
+    vals = head.snd <$> parsed -- TODO! cheack if head is safe here
+    parseField f = parse pField ("failed to parse field <<"++f++">>") f
+    parsed :: Either Text ([Text],[[Value]])
+    parsed = parseRequestBody isCsv reqBody
+    returnSingle = (==1) . length . snd <$> parsed
+    isSingle = either (const False) id returnSingle
+    setWith = if isSingle
+          then M.fromList <$> (zip <$> flds <*> vals)
+          else Left "Expecting a sigle CSV line with header or a JSON object"
+    hdrs          = requestHeaders httpRequest
+    lookupHeader  = flip lookup hdrs
+    --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
+    isCsv = lookupHeader "Content-Type" == Just csvMT
+    qParams = queryParams httpRequest
+    selectFilters = filter (( '.' `elem` ) . fst) $ whereFilters qParams -- there can be no filters on the root table whre we are doing insert
+    updateFilters = filter (not . ( '.' `elem` ) . fst) $ whereFilters qParams -- update filters can be only on the root table
+    returnApiRequest = buildSelectApiRequest sourceSubqueryName (selectStr qParams) selectFilters (orderStr qParams)
+    cond = first formatParserError $ map snd <$> mapM pRequestFilter updateFilters
+
 -- quite ugly return type
 parsePostRequest :: NodeName -> Request -> BL.ByteString -> Either Text ((Bool, ApiRequest), ApiRequest)
 parsePostRequest rootTableName httpRequest reqBody =
@@ -378,7 +429,8 @@ parsePostRequest rootTableName httpRequest reqBody =
     --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
     isCsv = lookupHeader "Content-Type" == Just csvMT
     qParams = queryParams httpRequest
-    returnApiRequest = buildSelectApiRequest sourceSubqueryName (selectStr qParams) (whereFilters qParams) (orderStr qParams)
+    filters = filter (( '.' `elem` ) . fst) $ whereFilters qParams -- there can be no filters on the root table whre we are doing insert
+    returnApiRequest = buildSelectApiRequest sourceSubqueryName (selectStr qParams) filters (orderStr qParams)
 
 
 parseRequestBody :: Bool -> BL.ByteString -> Either Text ([Text],[[Value]])
@@ -422,11 +474,11 @@ convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
     header = map fst
 
     groupByKey :: Value -> Either String [(Text,[Value])]
-    groupByKey (Array a) = M.toList . foldr (M.unionWith (++)) (M.fromList []) <$> maps
+    groupByKey (Array a) = HM.toList . foldr (HM.unionWith (++)) (HM.fromList []) <$> maps
       where
-        maps :: Either String [M.HashMap Text [Value]]
+        maps :: Either String [HM.HashMap Text [Value]]
         maps = mapM getElems $ V.toList a
-        getElems (Object o) = Right $ M.map (:[]) o
+        getElems (Object o) = Right $ HM.map (:[]) o
         getElems _ = Left invalidMsg
     groupByKey _ = Left invalidMsg
 
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index ed8093769..6c9817d36 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -12,8 +12,9 @@ import           Control.Applicative
 import           Data.Tree
 import           PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem,
                                     pgFmtIdent, pgFmtCondition,
-                                    insertableValue, orderF, sourceSubqueryName)
+                                    insertableValue, orderF, sourceSubqueryName, pgFmtJsonPath)
 import           PostgREST.Types
+import qualified Data.Map as M
 --import qualified Data.Vector       as V (empty)
 --import qualified Hasql.Backend     as B
 
@@ -87,6 +88,9 @@ addJoinConditions schema (Node (query, (t, r)) forest) =
 --         fn  (Filter{value=VForeignKey _ _}) = False
 
 --requestToQuery :: Text -> ApiRequest -> PStmt
+emptyOnNull :: Text -> [a] -> Text
+emptyOnNull val x = if null x then "" else val
+
 requestToQuery :: Text -> ApiRequest -> Text
 requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest) =
   --orderT (fromMaybe [] ord)  query
@@ -114,7 +118,7 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
       ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
       orderF (fromMaybe [] ord)
       ]
-    emptyOnNull val x = if null x then "" else val
+
     (withs, selects) = foldr getQueryParts ([],[]) forest
     getQueryParts :: Tree ApiNode -> ([Text], [Text]) -> ([Text], [Text])
     getQueryParts (Node n@(_, (table, Just (Relation {relType=Child}))) forst) (w,s) = (w,sel:s)
@@ -149,9 +153,7 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
 requestToQuery schema (Node (Insert _ flds vals, (mainTbl, _)) _) =
   query
   where
-    --query = B.Stmt qStr V.empty True
     qi = QualifiedIdentifier schema mainTbl
-    --qStr = Data.Text.unwords [
     query = Data.Text.unwords [
       "INSERT INTO ", fromQi qi,
       " (" <> intercalate ", " (map (pgFmtIdent . fst) flds) <> ") ",
@@ -164,13 +166,14 @@ requestToQuery schema (Node (Insert _ flds vals, (mainTbl, _)) _) =
         ),
       "RETURNING " <> fromQi qi <> ".*"
       ]
-    -- ("insert into " <> fromQi t <> " (" <>
-    --   T.intercalate ", " (V.toList $ V.map pgFmtIdent cols) <>
-    --   ") values "
-    --   <> T.intercalate ", "
-    --     (V.toList $ V.map (\v -> "("
-    --         <> T.intercalate ", " (V.toList $ V.map insertableValue v)
-    --         <> ")"
-    --       ) vals
-    --     )
-    --   <> " returning row_to_json(" <> fromQi t <> ".*)")
+requestToQuery schema (Node (Update _ setWith conditions, (mainTbl, _)) _) =
+  query
+  where
+    qi = QualifiedIdentifier schema mainTbl
+    query = Data.Text.unwords [
+      "UPDATE ", fromQi qi,
+      " SET " <> intercalate ", " (map formatSet (M.toList setWith)) <> " ",
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      "RETURNING " <> fromQi qi <> ".*"
+      ]
+    formatSet ((c, jp), v) = pgFmtIdent c <> pgFmtJsonPath jp <> " = " <> insertableValue v
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
index 4bd0a5df1..2dac663c1 100644
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -3,7 +3,7 @@ import Data.Text
 import Data.Tree
 import qualified Data.ByteString.Char8 as BS
 import Data.Aeson
---import Data.Map
+import Data.Map
 
 data DbStructure = DbStructure {
   tables :: [Table]
@@ -80,8 +80,8 @@ type NodeName = Text
 type SelectItem = (Field, Maybe Cast)
 type Path = [Text]
 data Query = Select { select::[SelectItem], from::[Text], where_::[Filter], order::Maybe [OrderTerm] }
-           | Insert { into::Text, fields::[Field], values::[[Value]] } deriving (Show, Eq)
---           | Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq)
+           | Insert { into::Text, fields::[Field], values::[[Value]] }
+           | Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq)
 data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
 type ApiNode = (Query, (NodeName, Maybe Relation))
 type ApiRequest = Tree ApiNode

From 915ce0fa9db0c3eba67bc927bc1ce5ac58fb7cbe Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Wed, 28 Oct 2015 10:41:16 +0200
Subject: [PATCH 50/81] Fix for detecting many2many relations when the link
 table for more then 2 tables

---
 src/PostgREST/PgStructure.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/src/PostgREST/PgStructure.hs b/src/PostgREST/PgStructure.hs
index 7a1cf6147..5b1aa6eb5 100644
--- a/src/PostgREST/PgStructure.hs
+++ b/src/PostgREST/PgStructure.hs
@@ -8,7 +8,7 @@ module PostgREST.PgStructure where
 import           Control.Applicative
 import           Control.Monad         (join)
 import           Data.Functor.Identity
-import           Data.List             (elemIndex, find)
+import           Data.List             (elemIndex, find, subsequences)
 import           Data.Maybe            (fromMaybe, isJust, mapMaybe)
 import           Data.Monoid
 import           Data.Text             (Text, split)
@@ -172,17 +172,21 @@ allRelations = do
     )
   |]
   let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
-  let links = filter ((==2).length) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
+      links = join $ map (combinations 2) $ filter ((>=1).length) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
   return $ simpleRelations ++ mapMaybe link2Relation links
   where
     groupFn :: Relation -> Text
     groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
+    combinations k ns = filter ((k==).length) (subsequences ns)
     link2Relation [
       Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c},
       Relation{                           relColumns=lc2, relFTable=ft, relFColumns=fc}
-      ] = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
+      ]
+      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
+      | otherwise = Nothing
     link2Relation _ = Nothing
 
+
 allColumns :: [Relation] -> H.Tx P.Postgres s [Column]
 allColumns rels = do
   cols <- H.listEx $ [H.stmt|

From 9458ee3292c69778c8a3489ebe1b2774630cb115 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Thu, 29 Oct 2015 16:04:16 +0200
Subject: [PATCH 51/81] Cleanup / Refactoring

---
 src/PostgREST/App.hs          | 266 ++++++++++++----------------------
 src/PostgREST/QueryBuilder.hs |  40 +----
 2 files changed, 91 insertions(+), 215 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 7f7c83098..83a1c9d2c 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -1,18 +1,11 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
-module PostgREST.App where
--- module PostgREST.App (
---   app
--- , sqlError
--- , isSqlError
--- , contentTypeForAccept
--- , jsonH
--- , TableOptions(..)
--- , parsePostRequest
--- , rr
--- , bb
--- ) where
+--module PostgREST.App where
+module PostgREST.App (
+  app
+, contentTypeForAccept
+) where
 
 import           Control.Applicative
 import           Control.Arrow             ((***))
@@ -72,26 +65,16 @@ app dbstructure conf reqBody req =
       if range == Just emptyRange
       then return $ responseLBS status416 [] "HTTP Range error"
       else
-        case query of
-          Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
-          Right qs -> do
-            let q = B.Stmt
-                    (
-                      wrapQuery qs [
-                        if hasPrefer "count=none" then countNoneF else countAllF,
-                        countF,
-                        case contentType of
-                          "text/csv" -> asCsvF -- TODO check when in csv mode if the header is correct when requesting nested data
-                          _     -> asJsonF
-                      ] selectStarF range
-                    )
-                    V.empty True
+        case request of
+          Left e -> return $ responseLBS status400 [jsonH] $ cs e
+          Right (selectQuery, _, _) -> do
+            let q = B.Stmt (createStatement selectQuery Nothing True range [] (not $ hasPrefer "count=none") isCsv) V.empty True
             row <- H.maybeEx q
-            let (tableTotal, queryTotal, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString) row
+            let (tableTotal, queryTotal, _ , body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString, Just "" :: Maybe BL.ByteString) row
                 to = frm+queryTotal-1
                 contentRange = contentRangeH frm to tableTotal
                 status = rangeStatus frm to tableTotal
-                canonical = urlEncodeVars
+                canonical = urlEncodeVars -- should this be moved to the db (location)?
                   . sortBy (comparing fst)
                   . map (join (***) cs)
                   . parseSimpleQuery
@@ -106,59 +89,26 @@ app dbstructure conf reqBody req =
 
         where
             frm = fromMaybe 0 $ rangeOffset <$> range
-            -- apiRequest = parseGetRequest table req
-            --          >>= first formatRelationError . addRelations schema allRels Nothing
-            --          >>= addJoinConditions schema allCols
-            apiRequest = parseGetRequest table req >>= augumentRequestWithJoin schema allRels
-            query = requestToQuery schema <$> apiRequest
+            request = parseRequest schema allRels table req reqBody
 
     ([table], "POST") -> do
       let echoRequested = hasPrefer "return=representation"
-      case queries of
-        Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
-        Right (qi, qs) -> do
-          let isSingle = either (const False) id returnSingle
-              pKeys = map pkName $ filter (filterPk schema table) allPrKeys
-              q = B.Stmt
-                    (
-                      wrapQuery qi [
-                        if isSingle then locationF pKeys else "null",
-                        "null", -- countF,
-                        if echoRequested
-                        then
-                          case contentType of
-                             "text/csv" -> asCsvF
-                             _     -> if isSingle then asJsonSingleF else asJsonF
-                        else "null"
-
-                      ] qs Nothing
-                    )
-                    V.empty True
-
+      case request of
+        Left e -> return $ responseLBS status400 [jsonH] $ cs e
+        Right (selectQuery, mutateQuery, isSingle) -> do
+          let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
+              q = B.Stmt (createStatement selectQuery (Just (mutateQuery, isSingle)) echoRequested Nothing pKeys False isCsv) V.empty True
           row <- H.maybeEx q
-          let (locationRaw, _ {-- queryTotal --}, bodyRaw) = fromMaybe (Just "" :: Maybe BL.ByteString, Just (0::Int), Just "" :: Maybe BL.ByteString) row
-              body = fromMaybe "[]" bodyRaw
-              locationH = fromMaybe "" locationRaw
+          let (_, _, location, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString, Just "" :: Maybe BL.ByteString) row
           return $ responseLBS status201
             [
               contentTypeH,
-              (hLocation, "/" <> cs table <> "?" <> cs locationH)
+              (hLocation, "/" <> cs table <> "?" <> cs (fromMaybe "" location))
             ]
-            $ if echoRequested then body else ""
+            $ if echoRequested then (fromMaybe "[]" body) else ""
       where
-        res = parsePostRequest table req reqBody
-        ins = fst <$> res
-        insertApiRequest = snd <$> ins
-        returnSingle = fst <$> ins
-        insertQuery = requestToQuery schema <$> insertApiRequest
-        selectApiRequest = (snd <$> res) >>= augumentRequestWithJoin schema (fakeSourceRelations ++ allRels)
-        selectQuery = requestToQuery schema <$> selectApiRequest
-        queries = (,) <$> insertQuery <*> selectQuery
+        request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
         fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
-        --changeRootNodeToSource :: Text -> ApiRequest -> ApiRequest
-        --changeRootNodeToSource rootTableName (q, (rootTableName, r)) =
-
-        --returnSelect = selectStarF
 
     ([table], "PUT") ->
       handleJsonObj reqBody $ \obj -> do
@@ -186,46 +136,21 @@ app dbstructure conf reqBody req =
 
     ([table], "PATCH") -> do
       let echoRequested = hasPrefer "return=representation"
-      case queries of
-        Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
-        Right (qu, qs) -> do
-          let q = B.Stmt
-                    (
-                      wrapQuery qu [
-                        countF,
-                        if echoRequested
-                        then
-                          case contentType of
-                             "text/csv" -> asCsvF
-                             _     -> asJsonF
-                        else "null"
-
-                      ] qs Nothing
-                    )
-                    V.empty True
-
+      case request of
+        Left e -> return $ responseLBS status400 [jsonH] $ cs e
+        Right (selectQuery, mutateQuery, _) -> do
+          let q = B.Stmt (createStatement selectQuery (Just (mutateQuery, False)) echoRequested Nothing [] False isCsv) V.empty True
           row <- H.maybeEx q
-          let (queryTotal, bodyRaw) = fromMaybe (0::Int, Just "" :: Maybe BL.ByteString) row
-              body = fromMaybe "[]" bodyRaw
+          let (_, queryTotal, _, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString, Just "" :: Maybe BL.ByteString) row
               r = contentRangeH 0 (queryTotal-1) (Just queryTotal)
               s = case () of _ | queryTotal == 0 -> status404
                                | echoRequested -> status200
                                | otherwise -> status204
-          --return $ responseLBS s [ jsonH, r ] $ if echoRequested then cs $ fromMaybe "[]" body else ""
-          return $ responseLBS s
-            [
-              contentTypeH,
-              r
-            ]
-            $ if echoRequested then body else ""
+          return $ responseLBS s [contentTypeH, r]
+            $ if echoRequested then (fromMaybe "[]" body) else ""
 
       where
-        res = parsePatchRequest table req reqBody
-        updateApiRequest = fst <$> res
-        updateQuery = requestToQuery schema <$> updateApiRequest
-        selectApiRequest = (snd <$> res) >>= augumentRequestWithJoin schema (fakeSourceRelations ++ allRels)
-        selectQuery = requestToQuery schema <$> selectApiRequest
-        queries = (,) <$> updateQuery <*> selectQuery
+        request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
         fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
 
     ([table], "DELETE") -> do
@@ -298,14 +223,9 @@ app dbstructure conf reqBody req =
     range         = rangeRequested hdrs
     allOrigins    = ("Access-Control-Allow-Origin", "*") :: Header
     contentType   = fromMaybe "application/json" $ contentTypeForAccept accept
+    isCsv         = contentType == csvMT
     contentTypeH  = (hContentType, contentType)
 
-sqlError :: t
-sqlError = undefined
-
-isSqlError :: t
-isSqlError = undefined
-
 rangeStatus :: Int -> Int -> Maybe Int -> Status
 rangeStatus _ _ Nothing = status200
 rangeStatus frm to (Just total)
@@ -347,11 +267,6 @@ contentTypeForAccept accept
     findInAccept = flip find $ parseHttpAccept acceptH
     has          = isJust . findInAccept . BS.isPrefixOf
 
-bodyForAccept :: BS.ByteString -> QualifiedIdentifier  -> StatementT
-bodyForAccept contentType table
-  | contentType == csvMT = asCsvWithCount table
-  | otherwise = asJsonWithCount -- defaults to JSON
-
 handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response)
               -> H.Tx P.Postgres s Response
 handleJsonObj reqBody handler = do
@@ -376,6 +291,7 @@ formatRelationError :: Text -> Text
 formatRelationError e = cs $ encode $ object [
   "mesage" .= ("could not find foreign keys between these entities"::String),
   "details" .= e]
+
 formatParserError :: ParseError -> Text
 formatParserError e = cs $ encode $ object [
   "message" .= message,
@@ -385,54 +301,6 @@ formatParserError e = cs $ encode $ object [
      details = strip $ replace "\n" " " $ cs
        $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
 
-parsePatchRequest :: NodeName -> Request -> BL.ByteString -> Either Text (ApiRequest, ApiRequest)
-parsePatchRequest rootTableName httpRequest reqBody =
-  (,) <$> updateApiRequest <*> returnApiRequest
-  where
-    updateApiRequest = Node <$> apiNode <*> pure []
-    apiNode = (,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)
-    flds =  join $ first formatParserError . mapM (parseField . cs) <$> (fst <$> parsed)
-    vals = head.snd <$> parsed -- TODO! cheack if head is safe here
-    parseField f = parse pField ("failed to parse field <<"++f++">>") f
-    parsed :: Either Text ([Text],[[Value]])
-    parsed = parseRequestBody isCsv reqBody
-    returnSingle = (==1) . length . snd <$> parsed
-    isSingle = either (const False) id returnSingle
-    setWith = if isSingle
-          then M.fromList <$> (zip <$> flds <*> vals)
-          else Left "Expecting a sigle CSV line with header or a JSON object"
-    hdrs          = requestHeaders httpRequest
-    lookupHeader  = flip lookup hdrs
-    --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
-    isCsv = lookupHeader "Content-Type" == Just csvMT
-    qParams = queryParams httpRequest
-    selectFilters = filter (( '.' `elem` ) . fst) $ whereFilters qParams -- there can be no filters on the root table whre we are doing insert
-    updateFilters = filter (not . ( '.' `elem` ) . fst) $ whereFilters qParams -- update filters can be only on the root table
-    returnApiRequest = buildSelectApiRequest sourceSubqueryName (selectStr qParams) selectFilters (orderStr qParams)
-    cond = first formatParserError $ map snd <$> mapM pRequestFilter updateFilters
-
--- quite ugly return type
-parsePostRequest :: NodeName -> Request -> BL.ByteString -> Either Text ((Bool, ApiRequest), ApiRequest)
-parsePostRequest rootTableName httpRequest reqBody =
-  (,) <$> ((,) <$> returnSingle <*> insertApiRequest) <*> returnApiRequest
-  where
-    insertApiRequest = Node <$> apiNode <*> pure []
-    apiNode = (,) <$> (Insert rootTableName <$> flds <*> vals) <*> pure (rootTableName, Nothing)
-    flds =  join $ first formatParserError . mapM (parseField . cs) <$> (fst <$> parsed)
-    vals = snd <$> parsed
-    parseField f = parse pField ("failed to parse field <<"++f++">>") f
-    parsed :: Either Text ([Text],[[Value]])
-    parsed = parseRequestBody isCsv reqBody
-    returnSingle = (==1) . length . snd <$> parsed -- not quite correct qhen the user send single row but in an array
-    hdrs          = requestHeaders httpRequest
-    lookupHeader  = flip lookup hdrs
-    --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
-    isCsv = lookupHeader "Content-Type" == Just csvMT
-    qParams = queryParams httpRequest
-    filters = filter (( '.' `elem` ) . fst) $ whereFilters qParams -- there can be no filters on the root table whre we are doing insert
-    returnApiRequest = buildSelectApiRequest sourceSubqueryName (selectStr qParams) filters (orderStr qParams)
-
-
 parseRequestBody :: Bool -> BL.ByteString -> Either Text ([Text],[[Value]])
 parseRequestBody isCsv reqBody = first cs $
   checkStructure =<<
@@ -448,13 +316,6 @@ parseRequestBody isCsv reqBody = first cs $
       | headerMatchesContent v = Right v
       | isCsv = Left "CSV header does not match rows length"
       | otherwise = Left "The number of keys in objects do not match"
-    -- checkStructure v =
-    --   if headerMatchesContent v
-    --   then Right v
-    --   else
-    --     if isCsv
-    --     then Left "CSV header does not match rows length"
-    --     else Left "The number of keys in objects do not match"
 
     headerMatchesContent :: ([Text], [[Value]]) -> Bool
     headerMatchesContent (header, vals) = all ( (headerLength ==) . length) vals
@@ -489,12 +350,6 @@ convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
         a@(Array _) -> Right a
         _ -> Left invalidMsg
 
-parseGetRequest :: NodeName -> Request -> Either Text ApiRequest
-parseGetRequest rootTableName httpRequest =
-  buildSelectApiRequest rootTableName (selectStr qParams) (whereFilters qParams) (orderStr qParams)
-  where
-    qParams = queryParams httpRequest
-
 augumentRequestWithJoin :: Text ->  [Relation] ->  ApiRequest -> Either Text ApiRequest
 augumentRequestWithJoin schema allRels request =
   (first formatRelationError . addRelations schema allRels Nothing) request
@@ -553,3 +408,62 @@ instance ToJSON TableOptions where
   toJSON t = object [
       "columns" .= tblOptcolumns t
     , "pkey"   .= tblOptpkey t ]
+
+parseRequest :: Text -> [Relation] -> NodeName -> Request -> BL.ByteString -> Either Text (Text, Text, Bool)
+parseRequest schema allRels rootTableName httpRequest reqBody =
+  (,,) <$> selectQuery
+       <*> (if method == "GET" then pure "" else mutateQuery)
+       <*> (if method == "GET" then pure False else pure isSingleRecord)
+  where
+    hdrs = requestHeaders httpRequest
+    lookupHeader = flip lookup hdrs
+    isCsv = lookupHeader "Content-Type" == Just csvMT
+    method = requestMethod httpRequest
+    qParams = queryParams httpRequest
+    parsedBody = parseRequestBody isCsv reqBody
+    isSingleRecord = either (const False) ((==1) . length . snd ) parsedBody
+    parseField f = parse pField ("failed to parse field <<"++f++">>") f
+    flds =  join $ first formatParserError . mapM (parseField . cs) <$> (fst <$> parsedBody)
+    vals = snd <$> parsedBody
+    setWith = if isSingleRecord
+          then M.fromList <$> (zip <$> flds <*> (head <$> vals))
+          else Left "Expecting a sigle CSV line with header or a JSON object"
+    allFilters = whereFilters qParams
+    updateFilters = filter (not . ( '.' `elem` ) . fst) $ allFilters -- update filters can be only on the root table
+    cond = first formatParserError $ map snd <$> mapM pRequestFilter updateFilters
+    selectApiRequest = augumentRequestWithJoin schema allRels
+      =<< buildSelectApiRequest rootName (selectStr qParams) filters (orderStr qParams)
+      where
+        rootName = if method == "GET"
+          then rootTableName
+          else sourceSubqueryName
+        filters = if method == "GET"
+          then allFilters
+          else filter (( '.' `elem` ) . fst) allFilters -- there can be no filters on the root table whre we are doing insert/update
+    selectQuery = requestToQuery schema <$> selectApiRequest
+    mutateQuery = requestToQuery schema <$> case method of
+      "POST"  -> (Node <$> ((,) <$> (Insert rootTableName <$> flds <*> vals)    <*> pure (rootTableName, Nothing)) <*> pure [])
+      "PATCH" -> (Node <$> ((,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)) <*> pure [])
+      _       -> undefined
+
+createStatement :: Text -> Maybe (Text, Bool) -> Bool -> Maybe NonnegRange -> [Text] -> Bool -> Bool -> Text
+createStatement selectQuery Nothing _ range _ countTable asCsv =
+  wrapQuery selectQuery [
+    if countTable then countAllF else countNoneF,
+    countF,
+    "null", -- location header can not be calucalted
+    if asCsv then asCsvF else asJsonF
+  ] selectStarF range
+createStatement selectQuery (Just (changeQuery, isSingle)) echoRequested _ pKeys _ asCsv =
+  wrapQuery changeQuery [
+    countNoneF, -- when updateing it does not make sense
+    countF,
+    if isSingle then locationF pKeys else "null",
+    if echoRequested
+    then
+      if asCsv
+      then asCsvF
+      else if isSingle then asJsonSingleF else asJsonF
+    else "null"
+
+  ] selectQuery Nothing
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index 6c9817d36..49019cb7d 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -15,15 +15,11 @@ import           PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem,
                                     insertableValue, orderF, sourceSubqueryName, pgFmtJsonPath)
 import           PostgREST.Types
 import qualified Data.Map as M
---import qualified Data.Vector       as V (empty)
---import qualified Hasql.Backend     as B
 
 findRelation :: [Relation] -> Text -> Text -> Text -> Maybe Relation
 findRelation allRelations s t1 t2 =
   find (\r -> s == relSchema r && t1 == relTable r && t2 == relFTable r) allRelations
 
-
-
 addRelations :: Text -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
 addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) =
   case parentNode of
@@ -72,45 +68,18 @@ addJoinConditions schema (Node (query, (t, r)) forest) =
     updatedForest = mapM (addJoinConditions schema) forest
     addCond q con = q{where_=con ++ where_ q}
 
--- requestToCountQuery :: Text -> ApiRequest -> PStmt
--- requestToCountQuery schema (Node (Select _ _ conditions _, (mainTbl, _)) _) =
---   B.Stmt query V.empty True
---   where
---     query = Data.Text.unwords [
---       "SELECT pg_catalog.count(1)",
---       "FROM ", fromQi $ QualifiedIdentifier schema mainTbl,
---       ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
---       ]
---     emptyOnNull val x = if null x then "" else val
---     localConditions = filter fn conditions
---       where
---         fn  (Filter{value=VText _}) = True
---         fn  (Filter{value=VForeignKey _ _}) = False
-
---requestToQuery :: Text -> ApiRequest -> PStmt
 emptyOnNull :: Text -> [a] -> Text
 emptyOnNull val x = if null x then "" else val
 
 requestToQuery :: Text -> ApiRequest -> Text
 requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest) =
-  --orderT (fromMaybe [] ord)  query
   query
   where
-    --query = B.Stmt qStr V.empty True
-    --qStr = Data.Text.unwords [
-    -- query = Data.Text.unwords [
-    --   ("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
-    --   "SELECT ", intercalate ", " (map (pgFmtSelectItem (QualifiedIdentifier schema mainTbl)) colSelects ++ selects),
-    --   "FROM ", intercalate ", " (map (fromQi . QualifiedIdentifier schema) tbls),
-    --   ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl) ) conditions )) `emptyOnNull` conditions,
-    --   orderF (fromMaybe [] ord)
-    --   ]
     -- TODO! the folloing helper functions are just to remove the "schema" part when the table is "source" which is the name
     -- of our WITH query part
     tblSchema tbl = if tbl == sourceSubqueryName then "" else schema
     qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
     toQi t = QualifiedIdentifier (tblSchema t) t
-
     query = Data.Text.unwords [
       ("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
       "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
@@ -118,7 +87,6 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
       ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
       orderF (fromMaybe [] ord)
       ]
-
     (withs, selects) = foldr getQueryParts ([],[]) forest
     getQueryParts :: Tree ApiNode -> ([Text], [Text]) -> ([Text], [Text])
     getQueryParts (Node n@(_, (table, Just (Relation {relType=Child}))) forst) (w,s) = (w,sel:s)
@@ -127,26 +95,20 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
            <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
            <> "FROM (" <> subquery <> ") " <> table
            <> ") AS " <> table
-           --where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
            where subquery = requestToQuery schema (Node n forst)
-
     getQueryParts (Node n@(_, (table, Just (Relation {relType=Parent}))) forst) (w,s) = (wit:w,sel:s)
       where
         sel = "row_to_json(" <> table <> ".*) AS "<>table --TODO must be singular
         wit = table <> " AS ( " <> subquery <> " )"
-          --where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
           where subquery = requestToQuery schema (Node n forst)
-
     getQueryParts (Node n@(_, (table, Just (Relation {relType=Many}))) forst) (w,s) = (w,sel:s)
       where
         sel = "("
            <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
            <> "FROM (" <> subquery <> ") " <> table
            <> ") AS " <> table
-           --where (B.Stmt subquery _ _) = requestToQuery schema (Node n forst)
            where subquery = requestToQuery schema (Node n forst)
-
-    -- the following is just to remove the warning
+    --the following is just to remove the warning
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
     --posible relations are Child Parent Many
     getQueryParts (Node (_,(_,Nothing)) _) _ = undefined

From 738989c375fdc2cc4a34b2264b8a10318bdd29b8 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Thu, 29 Oct 2015 16:22:31 +0200
Subject: [PATCH 52/81] Cleanup 2

---
 src/PostgREST/App.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 83a1c9d2c..b48b7db1b 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -55,7 +55,6 @@ import           PostgREST.Types
 import           PostgREST.Auth (tokenJWT)
 
 import           Prelude
---import           Debug.Trace
 
 app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
 app dbstructure conf reqBody req =
@@ -70,7 +69,7 @@ app dbstructure conf reqBody req =
           Right (selectQuery, _, _) -> do
             let q = B.Stmt (createStatement selectQuery Nothing True range [] (not $ hasPrefer "count=none") isCsv) V.empty True
             row <- H.maybeEx q
-            let (tableTotal, queryTotal, _ , body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString, Just "" :: Maybe BL.ByteString) row
+            let (tableTotal, queryTotal, _ , body) = extractQueryResult row
                 to = frm+queryTotal-1
                 contentRange = contentRangeH frm to tableTotal
                 status = rangeStatus frm to tableTotal
@@ -99,7 +98,7 @@ app dbstructure conf reqBody req =
           let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
               q = B.Stmt (createStatement selectQuery (Just (mutateQuery, isSingle)) echoRequested Nothing pKeys False isCsv) V.empty True
           row <- H.maybeEx q
-          let (_, _, location, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString, Just "" :: Maybe BL.ByteString) row
+          let (_, _, location, body) = extractQueryResult row
           return $ responseLBS status201
             [
               contentTypeH,
@@ -141,7 +140,7 @@ app dbstructure conf reqBody req =
         Right (selectQuery, mutateQuery, _) -> do
           let q = B.Stmt (createStatement selectQuery (Just (mutateQuery, False)) echoRequested Nothing [] False isCsv) V.empty True
           row <- H.maybeEx q
-          let (_, queryTotal, _, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe BL.ByteString, Just "" :: Maybe BL.ByteString) row
+          let (_, queryTotal, _, body) = extractQueryResult row
               r = contentRangeH 0 (queryTotal-1) (Just queryTotal)
               s = case () of _ | queryTotal == 0 -> status404
                                | echoRequested -> status200
@@ -467,3 +466,7 @@ createStatement selectQuery (Just (changeQuery, isSingle)) echoRequested _ pKeys
     else "null"
 
   ] selectQuery Nothing
+
+extractQueryResult :: Maybe (Maybe Int, Int, Maybe BL.ByteString, Maybe BL.ByteString)
+                         -> (Maybe Int, Int, Maybe BL.ByteString, Maybe BL.ByteString)
+extractQueryResult = fromMaybe (Just 0, 0, Just "", Just "")

From 6fd0d5648f090643e97f99c1e7024ba00b0481e6 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Fri, 30 Oct 2015 12:08:25 +0200
Subject: [PATCH 53/81] PUT path commented, DELETE rewritten, all statementT
 functions commented

---
 src/PostgREST/App.hs          | 123 +++++++++---------
 src/PostgREST/MainTest.hs     | 131 +++++++++++++++++++
 src/PostgREST/PgQuery.hs      | 236 +++++++++++++++++-----------------
 src/PostgREST/QueryBuilder.hs |   9 ++
 src/PostgREST/Types.hs        |   1 +
 test/Feature/InsertSpec.hs    |  11 +-
 6 files changed, 332 insertions(+), 179 deletions(-)
 create mode 100644 src/PostgREST/MainTest.hs

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index b48b7db1b..1dd24b96b 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -20,7 +20,7 @@ import           Data.List                 (find, sortBy, delete, transpose)
 import           Data.Maybe                (fromMaybe, fromJust, isJust, isNothing, mapMaybe)
 import           Data.Ord                  (comparing)
 import           Data.Ranged.Ranges        (emptyRange)
-import qualified Data.Set                  as S
+--import qualified Data.Set                  as S
 import           Data.String.Conversions   (cs)
 import           Data.Text                 (Text, replace, strip)
 import           Data.Tree
@@ -109,29 +109,29 @@ app dbstructure conf reqBody req =
         request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
         fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
 
-    ([table], "PUT") ->
-      handleJsonObj reqBody $ \obj -> do
-        let qt = qualify table
-            pKeys = map pkName $ filter (filterPk schema table) allPrKeys
-            specifiedKeys = map (cs . fst) qq
-        if S.fromList pKeys /= S.fromList specifiedKeys
-          then return $ responseLBS status405 []
-            "You must speficy all and only primary keys as params"
-          else do
-            let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols
-                cols = map cs $ HM.keys obj
-            if S.fromList tableCols == S.fromList cols
-              then do
-                let vals = HM.elems obj
-                H.unitEx $ iffNotT
-                  (whereT qt qq $ update qt cols vals)
-                  (insertSelect qt cols vals)
-                return $ responseLBS status204 [ jsonH ] ""
-
-              else return $ if Prelude.null tableCols
-                then responseLBS status404 [] ""
-                else responseLBS status400 []
-                  "You must specify all columns in PUT request"
+    -- ([table], "PUT") ->
+    --   handleJsonObj reqBody $ \obj -> do
+    --     let qt = qualify table
+    --         pKeys = map pkName $ filter (filterPk schema table) allPrKeys
+    --         specifiedKeys = map (cs . fst) qq
+    --     if S.fromList pKeys /= S.fromList specifiedKeys
+    --       then return $ responseLBS status405 []
+    --         "You must speficy all and only primary keys as params"
+    --       else do
+    --         let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols
+    --             cols = map cs $ HM.keys obj
+    --         if S.fromList tableCols == S.fromList cols
+    --           then do
+    --             let vals = HM.elems obj
+    --             H.unitEx $ iffNotT
+    --               (whereT qt qq $ update qt cols vals)
+    --               (insertSelect qt cols vals)
+    --             return $ responseLBS status204 [ jsonH ] ""
+    --
+    --           else return $ if Prelude.null tableCols
+    --             then responseLBS status404 [] ""
+    --             else responseLBS status400 []
+    --               "You must specify all columns in PUT request"
 
     ([table], "PATCH") -> do
       let echoRequested = hasPrefer "return=representation"
@@ -153,16 +153,19 @@ app dbstructure conf reqBody req =
         fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
 
     ([table], "DELETE") -> do
-      let qt = qualify table
-          del = countT
-            . returningStarT
-            . whereT qt qq
-            $ deleteFrom qt
-      row <- H.maybeEx 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))] ""
+      case request of
+        Left e -> return $ responseLBS status400 [jsonH] $ cs e
+        Right (selectQuery, mutateQuery, _) -> do
+          let q = B.Stmt (createStatement selectQuery (Just (mutateQuery, False)) False Nothing [] True isCsv) V.empty True
+          row <- H.maybeEx q
+          let (_, queryTotal, _, _) = extractQueryResult row
+          return $ if queryTotal == 0
+            then responseLBS status404 [] ""
+            else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] ""
+
+
+      where
+        request = parseRequest schema allRels table req reqBody
 
     (["rpc", proc], "POST") -> do
       let qi = QualifiedIdentifier schema (cs proc)
@@ -211,8 +214,8 @@ app dbstructure conf reqBody req =
     filterTableAcl r (Table{tableAcl=a}) = r `elem` a
     path          = pathInfo req
     verb          = requestMethod req
-    qq            = queryString req
-    qualify       = QualifiedIdentifier schema
+    --qq            = queryString req
+    --qualify       = QualifiedIdentifier schema
     hdrs          = requestHeaders req
     lookupHeader  = flip lookup hdrs
     hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
@@ -266,22 +269,22 @@ contentTypeForAccept accept
     findInAccept = flip find $ parseHttpAccept acceptH
     has          = isJust . findInAccept . BS.isPrefixOf
 
-handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response)
-              -> H.Tx P.Postgres s Response
-handleJsonObj reqBody handler = do
-  let p = eitherDecode reqBody
-  case p of
-    Left err ->
-      return $ responseLBS status400 [jsonH] jErr
-      where
-        jErr = encode . object $
-          [("message", String $ "Failed to parse JSON payload. " <> cs err)]
-    Right (Object o) -> handler o
-    Right _ ->
-      return $ responseLBS status400 [jsonH] jErr
-      where
-        jErr = encode . object $
-          [("message", String "Expecting a JSON object")]
+-- handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response)
+--               -> H.Tx P.Postgres s Response
+-- handleJsonObj reqBody handler = do
+--   let p = eitherDecode reqBody
+--   case p of
+--     Left err ->
+--       return $ responseLBS status400 [jsonH] jErr
+--       where
+--         jErr = encode . object $
+--           [("message", String $ "Failed to parse JSON payload. " <> cs err)]
+--     Right (Object o) -> handler o
+--     Right _ ->
+--       return $ responseLBS status400 [jsonH] jErr
+--       where
+--         jErr = encode . object $
+--           [("message", String "Expecting a JSON object")]
 
 parseCsvCell :: BL.ByteString -> Value
 parseCsvCell s = if s == "NULL" then Null else String $ cs s
@@ -428,11 +431,14 @@ parseRequest schema allRels rootTableName httpRequest reqBody =
           then M.fromList <$> (zip <$> flds <*> (head <$> vals))
           else Left "Expecting a sigle CSV line with header or a JSON object"
     allFilters = whereFilters qParams
-    updateFilters = filter (not . ( '.' `elem` ) . fst) $ allFilters -- update filters can be only on the root table
-    cond = first formatParserError $ map snd <$> mapM pRequestFilter updateFilters
+    mutateFilters = filter (not . ( '.' `elem` ) . fst) $ allFilters -- update/delete filters can be only on the root table
+    cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
     selectApiRequest = augumentRequestWithJoin schema allRels
-      =<< buildSelectApiRequest rootName (selectStr qParams) filters (orderStr qParams)
+      =<< buildSelectApiRequest rootName sel filters (orderStr qParams)
       where
+        sel = if method == "DELETE"
+          then "*" -- we are not returning the records so no need to consider nested items
+          else selectStr qParams
         rootName = if method == "GET"
           then rootTableName
           else sourceSubqueryName
@@ -441,9 +447,10 @@ parseRequest schema allRels rootTableName httpRequest reqBody =
           else filter (( '.' `elem` ) . fst) allFilters -- there can be no filters on the root table whre we are doing insert/update
     selectQuery = requestToQuery schema <$> selectApiRequest
     mutateQuery = requestToQuery schema <$> case method of
-      "POST"  -> (Node <$> ((,) <$> (Insert rootTableName <$> flds <*> vals)    <*> pure (rootTableName, Nothing)) <*> pure [])
-      "PATCH" -> (Node <$> ((,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)) <*> pure [])
-      _       -> undefined
+      "POST"   -> (Node <$> ((,) <$> (Insert rootTableName <$> flds <*> vals)    <*> pure (rootTableName, Nothing)) <*> pure [])
+      "PATCH"  -> (Node <$> ((,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)) <*> pure [])
+      "DELETE" -> (Node <$> ((,) <$> (Delete [rootTableName] <$> cond) <*> pure (rootTableName, Nothing)) <*> pure [])
+      _        -> undefined
 
 createStatement :: Text -> Maybe (Text, Bool) -> Bool -> Maybe NonnegRange -> [Text] -> Bool -> Bool -> Text
 createStatement selectQuery Nothing _ range _ countTable asCsv =
diff --git a/src/PostgREST/MainTest.hs b/src/PostgREST/MainTest.hs
new file mode 100644
index 000000000..89a2397c9
--- /dev/null
+++ b/src/PostgREST/MainTest.hs
@@ -0,0 +1,131 @@
+module Main where
+
+
+import           PostgREST.App
+import           PostgREST.Config                     (AppConfig (..),
+                                                       minimumPgVersion,
+                                                       prettyVersion,
+                                                       readOptions)
+import           PostgREST.Error                      (errResponse, PgError)
+import           PostgREST.Middleware
+import           PostgREST.PgStructure
+import           PostgREST.Types
+
+import           Control.Monad                        (unless)
+import           Control.Monad.IO.Class               (liftIO)
+import           Data.Aeson                           (encode)
+import           Data.Functor.Identity
+import           Data.Monoid                          ((<>))
+import           Data.String.Conversions              (cs)
+import           Data.Text                            (Text)
+import qualified Hasql                                as H
+import qualified Hasql.Postgres                       as P
+import           Network.Wai
+import           Network.Wai.Handler.Warp             hiding (Connection)
+import           Network.Wai.Middleware.RequestLogger (logStdout)
+import           System.IO                            (BufferMode (..),
+                                                       hSetBuffering, stderr,
+                                                       stdin, stdout)
+-- import Data.Maybe (mapMaybe)
+-- import Data.List (subsequences)
+-- import Control.Monad (join)
+-- import PostgREST.QueryBuilder
+-- import           GHC.Exts              (groupWith)
+
+
+isServerVersionSupported :: H.Session P.Postgres IO Bool
+isServerVersionSupported = do
+  Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|]
+  return $ read (cs row) >= minimumPgVersion
+
+hasqlError :: PgError -> IO a
+hasqlError = error . cs . encode
+
+
+main :: IO ()
+main = do
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stdin  LineBuffering
+  hSetBuffering stderr NoBuffering
+
+  -- let dbString = "postgres://postgrest_test@localhost:5432/postgrest_test" :: String
+  --     conf = AppConfig dbString 3000 "postgrest_anonymous" "test" False "safe" 10 :: AppConfig
+
+  conf <- readOptions
+  let port = configPort conf
+
+  unless (configSecure conf) $
+    putStrLn "WARNING, running in insecure mode, auth will be in plaintext"
+  unless ("secret" /= configJwtSecret conf) $
+    putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
+  Prelude.putStrLn $ "Listening on port " ++
+    (show $ configPort conf :: String)
+
+  let pgSettings = P.StringSettings $ cs (configDatabase conf)
+      appSettings = setPort port
+                  . setServerName (cs $ "postgrest/" <> prettyVersion)
+                  $ defaultSettings
+      middle = logStdout . defaultMiddle (configSecure conf)
+
+  poolSettings <- maybe (fail "Improper session settings") return $
+    H.poolSettings (fromIntegral $ configPool conf) 30
+  pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
+
+  supportedOrError <- H.session pool isServerVersionSupported
+  either hasqlError
+    (\supported ->
+      unless supported $
+        error (
+          "Cannot run in this PostgreSQL version, PostgREST needs at least "
+          <> show minimumPgVersion)
+    ) supportedOrError
+
+  -- what was this code for?
+  -- roleOrError <- H.session pool $ do
+  --   Identity (role :: Text) <- H.tx Nothing $ H.singleEx
+  --     [H.stmt|SELECT SESSION_USER|]
+  --   return role
+  -- authenticator <- either hasqlError return roleOrError
+
+  let txSettings = Just (H.ReadCommitted, Just True)
+  metadata <- H.session pool $ H.tx txSettings $ do
+    tabs <- allTables
+    rels <- allRelations
+    cols <- allColumns rels
+    keys <- allPrimaryKeys
+    return (tabs, rels, cols, keys)
+
+
+  dbstructure <- either hasqlError
+    (\(tabs, rels, cols, keys) ->
+
+      return DbStructure {
+          tables=tabs
+        , columns=cols
+        , relations=rels
+        , primaryKeys=keys
+        }
+    ) metadata
+  runSettings appSettings $ middle $ \ req respond -> do
+    body <- strictRequestBody req
+    resOrError <- liftIO $ H.session pool $ H.tx txSettings $
+      runWithClaims conf (app dbstructure conf body) req
+    either (respond . errResponse) respond resOrError
+
+  --let allRels = relations dbstructure
+      -- links = join $ map (combinations 2) $ filter ((>=1).length) $ groupWith groupFn $ filter ( (==Child). relType) allRels
+      -- combinations k ns = filter ((k==).length) (subsequences ns)
+
+  --print $ findRelation allRels "test" "projects" "users"
+  --mapM_ print $ mapMaybe link2Relation links
+
+  -- where
+  --   groupFn :: Relation -> Text
+  --   groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
+  --   link2Relation [
+  --     Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c},
+  --     Relation{                           relColumns=lc2, relFTable=ft, relFColumns=fc}
+  --     ]
+  --     | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
+  --     | otherwise = Nothing
+  --   link2Relation _ = Nothing
diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index 3d25b2cd2..70247c9ac 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -9,12 +9,12 @@ module PostgREST.PgQuery (
 , wrapQuery
 , asJson
 , callProc
-, iffNotT
-, update
-, insertSelect
-, deleteFrom
-, asCsvWithCount
-, asJsonWithCount
+-- , iffNotT
+-- , update
+-- , insertSelect
+-- , deleteFrom
+-- , asCsvWithCount
+-- , asJsonWithCount
 , unquoted
 
 -- format functions
@@ -30,10 +30,10 @@ module PostgREST.PgQuery (
 , pgFmtAsJsonPath
 
 -- query transformers (to be removed)
-, withT
-, countT
-, returningStarT
-, whereT
+-- , withT
+-- , countT
+-- , returningStarT
+-- , whereT
 
 -- query fragments
 , sourceSubqueryName
@@ -70,7 +70,7 @@ import           Data.Scientific         (FPFormat (..), formatScientific,
 import           Data.String.Conversions (cs)
 import qualified Data.Text               as T
 import           Data.Vector             (empty)
-import qualified Network.HTTP.Types.URI  as Net
+--import qualified Network.HTTP.Types.URI  as Net
 import           Text.Regex.TDFA         ((=~))
 
 import           Prelude
@@ -107,82 +107,82 @@ operators = M.fromList [
   ]
 
 
-whereT :: QualifiedIdentifier -> Net.Query -> StatementT
-whereT table params q =
-  if L.null cols
-    then q
-    else q <> B.Stmt " where " empty True <> conjunction
-  where
-    cols = [ col | col <- params, fst col `notElem` ["order","select"] ]
-    wherePredTable = wherePred table
-    conjunction = mconcat $ L.intersperse andq (map wherePredTable cols)
-
-withT :: PStmt -> T.Text -> StatementT
-withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
-  B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq <> " from " <> v)
-    (ep <> wp)
-    (epre && wpre)
-
-iffNotT :: PStmt -> StatementT
-iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) =
-  B.Stmt
-    ("WITH aaa AS (" <> aq <> " returning *) " <>
-      bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)")
-    (ap <> bp)
-    (apre && bpre)
-
-countT :: StatementT
-countT s =
-  s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" }
-
-asCsvWithCount :: QualifiedIdentifier -> StatementT
-asCsvWithCount table = withCount . asCsv table
-
-asCsv :: QualifiedIdentifier -> StatementT
-asCsv table s = s {
-  B.stmtTemplate =
-    "(select string_agg(quote_ident(column_name::text), ',') from "
-    <> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '"
-    <> fromQi table <> "' order by ordinal_position) h) || '\r' || "
-    <> "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '') from ("
-    <> B.stmtTemplate s <> ") t" }
-
-asJsonWithCount :: StatementT
-asJsonWithCount = withCount . asJson
-
+-- whereT :: QualifiedIdentifier -> Net.Query -> StatementT
+-- whereT table params q =
+--   if L.null cols
+--     then q
+--     else q <> B.Stmt " where " empty True <> conjunction
+--   where
+--     cols = [ col | col <- params, fst col `notElem` ["order","select"] ]
+--     wherePredTable = wherePred table
+--     conjunction = mconcat $ L.intersperse andq (map wherePredTable cols)
+--
+-- withT :: PStmt -> T.Text -> StatementT
+-- withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
+--   B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq <> " from " <> v)
+--     (ep <> wp)
+--     (epre && wpre)
+--
+-- iffNotT :: PStmt -> StatementT
+-- iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) =
+--   B.Stmt
+--     ("WITH aaa AS (" <> aq <> " returning *) " <>
+--       bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)")
+--     (ap <> bp)
+--     (apre && bpre)
+--
+-- countT :: StatementT
+-- countT s =
+--   s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" }
+--
+-- asCsvWithCount :: QualifiedIdentifier -> StatementT
+-- asCsvWithCount table = withCount . asCsv table
+--
+-- asCsv :: QualifiedIdentifier -> StatementT
+-- asCsv table s = s {
+--   B.stmtTemplate =
+--     "(select string_agg(quote_ident(column_name::text), ',') from "
+--     <> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '"
+--     <> fromQi table <> "' order by ordinal_position) h) || '\r' || "
+--     <> "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '') from ("
+--     <> B.stmtTemplate s <> ") t" }
+--
+-- asJsonWithCount :: StatementT
+-- asJsonWithCount = withCount . asJson
+--
 asJson :: StatementT
 asJson s = s {
   B.stmtTemplate =
     "array_to_json(array_agg(row_to_json(t)))::character varying from ("
     <> B.stmtTemplate s <> ") t" }
-
-withCount :: StatementT
-withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s }
-
-returningStarT :: StatementT
-returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
-
-deleteFrom :: QualifiedIdentifier -> PStmt
-deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True
-
-insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
-insertSelect t [] _ = B.Stmt
-  ("insert into " <> fromQi t <> " default values returning *") empty True
-insertSelect t cols vals = B.Stmt
-  ("insert into " <> fromQi t <> " ("
-    <> T.intercalate ", " (map pgFmtIdent cols)
-    <> ") select "
-    <> T.intercalate ", " (map insertableValue vals))
-  empty True
-
-update :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
-update t cols vals = B.Stmt
-  ("update " <> fromQi t <> " set ("
-    <> T.intercalate ", " (map pgFmtIdent cols)
-    <> ") = ("
-    <> T.intercalate ", " (map insertableValue vals)
-    <> ")")
-  empty True
+--
+-- withCount :: StatementT
+-- withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s }
+--
+-- returningStarT :: StatementT
+-- returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
+--
+-- deleteFrom :: QualifiedIdentifier -> PStmt
+-- deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True
+--
+-- insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
+-- insertSelect t [] _ = B.Stmt
+--   ("insert into " <> fromQi t <> " default values returning *") empty True
+-- insertSelect t cols vals = B.Stmt
+--   ("insert into " <> fromQi t <> " ("
+--     <> T.intercalate ", " (map pgFmtIdent cols)
+--     <> ") select "
+--     <> T.intercalate ", " (map insertableValue vals))
+--   empty True
+--
+-- update :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
+-- update t cols vals = B.Stmt
+--   ("update " <> fromQi t <> " set ("
+--     <> T.intercalate ", " (map pgFmtIdent cols)
+--     <> ") = ("
+--     <> T.intercalate ", " (map insertableValue vals)
+--     <> ")")
+--   empty True
 
 callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
 callProc qi params = do
@@ -191,39 +191,39 @@ callProc qi params = do
   where
     assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
 
-wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt
-wherePred table (col, predicate) =
-  B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <>
-      if opCode `elem` ["is","isnot"] then whiteList val
-                                 else cs sqlValue)
-      empty True
-
-  where
-    headPredicate:rest = T.split (=='.') $ cs $ fromMaybe "." predicate
-    hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
-    opCode        = hasNot (head rest) headPredicate
-    notOp         = hasNot headPredicate ""
-    val         = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest)
-    sqlValue = pgFmtValue opCode val
-    op = pgFmtOperator opCode
+-- wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt
+-- wherePred table (col, predicate) =
+--   B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <>
+--       if opCode `elem` ["is","isnot"] then whiteList val
+--                                  else cs sqlValue)
+--       empty True
+--
+--   where
+--     headPredicate:rest = T.split (=='.') $ cs $ fromMaybe "." predicate
+--     hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
+--     opCode        = hasNot (head rest) headPredicate
+--     notOp         = hasNot headPredicate ""
+--     val         = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest)
+--     sqlValue = pgFmtValue opCode val
+--     op = pgFmtOperator opCode
 
 whiteList :: T.Text -> T.Text
 whiteList val = fromMaybe
   (cs (pgFmtLit val) <> "::unknown ")
   (L.find ((==) . T.toLower $ val) ["null","true","false"])
 
-andq :: PStmt
-andq = B.Stmt " and " empty True
+-- andq :: PStmt
+-- andq = B.Stmt " and " empty True
 
-parseJsonbPath :: T.Text -> Maybe JsonbPath
-parseJsonbPath p =
-  case T.splitOn "->>" p of
-    [a,b] ->
-      let i:is = T.splitOn "->" a in
-      Just $ DoubleArrow
-        (foldl SingleArrow (ColIdentifier i) (map KeyIdentifier is))
-        (KeyIdentifier b)
-    _ -> Nothing
+-- parseJsonbPath :: T.Text -> Maybe JsonbPath
+-- parseJsonbPath p =
+--   case T.splitOn "->>" p of
+--     [a,b] ->
+--       let i:is = T.splitOn "->" a in
+--       Just $ DoubleArrow
+--         (foldl SingleArrow (ColIdentifier i) (map KeyIdentifier is))
+--         (KeyIdentifier b)
+--     _ -> Nothing
 
 trimNullChars :: T.Text -> T.Text
 trimNullChars = T.takeWhile (/= '\x0')
@@ -352,16 +352,16 @@ pgFmtValue opCode val =
 pgFmtOperator :: T.Text -> T.Text
 pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operators
 
-pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
-pgFmtJsonbPath table p =
- pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
- where
-   pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
-   pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
-   pgFmtJsonbPath' (SingleArrow a b) =
-     pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
-   pgFmtJsonbPath' (DoubleArrow a b) =
-     pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
+-- pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
+-- pgFmtJsonbPath table p =
+--  pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
+--  where
+--    pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
+--    pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
+--    pgFmtJsonbPath' (SingleArrow a b) =
+--      pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
+--    pgFmtJsonbPath' (DoubleArrow a b) =
+--      pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
 
 pgFmtIdent :: T.Text -> T.Text
 pgFmtIdent x =
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index 49019cb7d..cd04960fa 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -139,3 +139,12 @@ requestToQuery schema (Node (Update _ setWith conditions, (mainTbl, _)) _) =
       "RETURNING " <> fromQi qi <> ".*"
       ]
     formatSet ((c, jp), v) = pgFmtIdent c <> pgFmtJsonPath jp <> " = " <> insertableValue v
+requestToQuery schema (Node (Delete _ conditions, (mainTbl, _)) _) =
+  query
+  where
+    qi = QualifiedIdentifier schema mainTbl
+    query = Data.Text.unwords [
+      "DELETE FROM ", fromQi qi,
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      "RETURNING " <> fromQi qi <> ".*"
+      ]
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
index 2dac663c1..8eeac7604 100644
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -81,6 +81,7 @@ type SelectItem = (Field, Maybe Cast)
 type Path = [Text]
 data Query = Select { select::[SelectItem], from::[Text], where_::[Filter], order::Maybe [OrderTerm] }
            | Insert { into::Text, fields::[Field], values::[[Value]] }
+           | Delete { from::[Text], where_::[Filter] }
            | Update { into::Text, set::Map Field Value, where_::[Filter] } deriving (Show, Eq)
 data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
 type ApiNode = (Query, (NodeName, Maybe Relation))
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index ae4bcc095..a7d4987ec 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -224,7 +224,8 @@ spec = afterAll_ resetDb $ around withApp $ do
 
     context "to a known uri" $ do
       context "without a fully-specified primary key" $
-        it "is not an allowed operation" $
+        it "is not an allowed operation" $ do
+          pendingWith "Decide on PUT usefullness"
           request methodPut "/compound_pk?k1=eq.12" []
             [json| { "k1":12, "k2":42 } |]
               `shouldRespondWith` 405
@@ -232,13 +233,15 @@ spec = afterAll_ resetDb $ around withApp $ do
       context "with a fully-specified primary key" $ do
 
         context "not specifying every column in the table" $
-          it "is rejected for lack of idempotence" $
+          it "is rejected for lack of idempotence" $ do
+            pendingWith "Decide on PUT usefullness"
             request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
               [json| { "k1":12, "k2":42 } |]
                 `shouldRespondWith` 400
 
         context "specifying every column in the table" . after_ (clearTable "compound_pk") $ do
           it "can create a new record" $ do
+            pendingWith "Decide on PUT usefullness"
             p <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
                  [json| { "k1":12, "k2":42, "extra":3 } |]
             liftIO $ do
@@ -255,6 +258,7 @@ spec = afterAll_ resetDb $ around withApp $ do
               compoundExtra record `shouldBe` Just 3
 
           it "can update an existing record" $ do
+            pendingWith "Decide on PUT usefullness"
             _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
                  [json| { "k1":12, "k2":42, "extra":4 } |]
             _ <- request methodPut "/compound_pk?k1=eq.12&k2=eq.42" []
@@ -269,7 +273,8 @@ spec = afterAll_ resetDb $ around withApp $ do
 
       context "with an auto-incrementing primary key" . after_ (clearTable "auto_incrementing_pk") $
 
-        it "succeeds with 204" $
+        it "succeeds with 204" $ do
+          pendingWith "Decide on PUT usefullness"
           request methodPut "/auto_incrementing_pk?id=eq.1" []
                [json| {
                  "id":1,

From 246c47dba45629e5d1f059c7d5bf1d76bfcca34d Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Fri, 30 Oct 2015 12:19:35 +0200
Subject: [PATCH 54/81] cleanup

---
 src/PostgREST/App.hs       | 14 +++++++-------
 test/Feature/InsertSpec.hs |  1 +
 2 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 1dd24b96b..1248c4012 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -104,7 +104,7 @@ app dbstructure conf reqBody req =
               contentTypeH,
               (hLocation, "/" <> cs table <> "?" <> cs (fromMaybe "" location))
             ]
-            $ if echoRequested then (fromMaybe "[]" body) else ""
+            $ if echoRequested then fromMaybe "[]" body else ""
       where
         request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
         fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
@@ -146,13 +146,13 @@ app dbstructure conf reqBody req =
                                | echoRequested -> status200
                                | otherwise -> status204
           return $ responseLBS s [contentTypeH, r]
-            $ if echoRequested then (fromMaybe "[]" body) else ""
+            $ if echoRequested then fromMaybe "[]" body else ""
 
       where
         request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
         fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
 
-    ([table], "DELETE") -> do
+    ([table], "DELETE") ->
       case request of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (selectQuery, mutateQuery, _) -> do
@@ -431,7 +431,7 @@ parseRequest schema allRels rootTableName httpRequest reqBody =
           then M.fromList <$> (zip <$> flds <*> (head <$> vals))
           else Left "Expecting a sigle CSV line with header or a JSON object"
     allFilters = whereFilters qParams
-    mutateFilters = filter (not . ( '.' `elem` ) . fst) $ allFilters -- update/delete filters can be only on the root table
+    mutateFilters = filter (not . ( '.' `elem` ) . fst) allFilters -- update/delete filters can be only on the root table
     cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
     selectApiRequest = augumentRequestWithJoin schema allRels
       =<< buildSelectApiRequest rootName sel filters (orderStr qParams)
@@ -447,9 +447,9 @@ parseRequest schema allRels rootTableName httpRequest reqBody =
           else filter (( '.' `elem` ) . fst) allFilters -- there can be no filters on the root table whre we are doing insert/update
     selectQuery = requestToQuery schema <$> selectApiRequest
     mutateQuery = requestToQuery schema <$> case method of
-      "POST"   -> (Node <$> ((,) <$> (Insert rootTableName <$> flds <*> vals)    <*> pure (rootTableName, Nothing)) <*> pure [])
-      "PATCH"  -> (Node <$> ((,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)) <*> pure [])
-      "DELETE" -> (Node <$> ((,) <$> (Delete [rootTableName] <$> cond) <*> pure (rootTableName, Nothing)) <*> pure [])
+      "POST"   -> Node <$> ((,) <$> (Insert rootTableName <$> flds <*> vals)    <*> pure (rootTableName, Nothing)) <*> pure []
+      "PATCH"  -> Node <$> ((,) <$> (Update rootTableName <$> setWith <*> cond) <*> pure (rootTableName, Nothing)) <*> pure []
+      "DELETE" -> Node <$> ((,) <$> (Delete [rootTableName] <$> cond) <*> pure (rootTableName, Nothing)) <*> pure []
       _        -> undefined
 
 createStatement :: Text -> Maybe (Text, Bool) -> Bool -> Maybe NonnegRange -> [Text] -> Bool -> Bool -> Text
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index a7d4987ec..0b86ede16 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -151,6 +151,7 @@ spec = afterAll_ resetDb $ around withApp $ do
 
     after_ (clearTable "menagerie") . context "disparate csv types" $
       it "succeeds with multipart response" $ do
+        pendingWith "Decide on what to do with CSV insert"
         let inserted = [str|integer,double,varchar,boolean,date,money,enum
             |13,3.14159,testing!,false,1900-01-01,$3.99,foo
             |12,0.1,a string,true,1929-10-01,12,bar

From 066d120c0e348f08bea3d2238ff354e384fad058 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Sat, 31 Oct 2015 12:01:26 -0400
Subject: [PATCH 55/81] Changes stack resolver to nightly.

---
 stack.yaml | 8 ++------
 1 file changed, 2 insertions(+), 6 deletions(-)

diff --git a/stack.yaml b/stack.yaml
index 2dc4d15b6..fb06a970b 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,11 +1,7 @@
 flags: {}
 packages:
 - '.'
-extra-deps: 
+extra-deps:
   - Ranged-sets-0.3.0
   - packdeps-0.4.1
-  - hspec-2.2.0
-  - hspec-core-2.2.0
-  - hspec-discover-2.2.0
-  - hspec-expectations-0.7.2
-resolver: lts-3.10
+resolver: nightly-2015-10-27

From 2c1236652ebe5e34d6f2e3acc4f1d2d1cb6a7c82 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Sun, 1 Nov 2015 16:49:21 -0500
Subject: [PATCH 56/81] Fixes hlint suggestions

---
 src/PostgREST/Auth.hs        | 2 +-
 src/PostgREST/PgStructure.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index efc391664..80f13a3f3 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -50,7 +50,7 @@ claimsToSQL = map setVar . toList
   In case there is any problem decoding the JWT it returns Nothing.
 -}
 jwtClaims :: Text -> Text -> Maybe JWT.ClaimsMap
-jwtClaims secret input = JWT.unregisteredClaims <$> JWT.claims <$> decoded
+jwtClaims secret input = JWT.unregisteredClaims . JWT.claims <$> decoded
   where
     decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
diff --git a/src/PostgREST/PgStructure.hs b/src/PostgREST/PgStructure.hs
index 5b1aa6eb5..d7e1710db 100644
--- a/src/PostgREST/PgStructure.hs
+++ b/src/PostgREST/PgStructure.hs
@@ -172,7 +172,7 @@ allRelations = do
     )
   |]
   let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
-      links = join $ map (combinations 2) $ filter ((>=1).length) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
+      links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
   return $ simpleRelations ++ mapMaybe link2Relation links
   where
     groupFn :: Relation -> Text

From 2e4c862d25ee57711da7856c13da76a5792d3798 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Mon, 2 Nov 2015 10:49:22 +0200
Subject: [PATCH 57/81] Refactor to add operators in just one place, @> and <@
 operators for #338 and #181

---
 src/PostgREST/App.hs      |  43 ------------
 src/PostgREST/Parsers.hs  |  26 ++-----
 src/PostgREST/PgQuery.hs  | 144 ++++----------------------------------
 test/Feature/QuerySpec.hs |  13 +++-
 test/SpecHelper.hs        |   3 +-
 test/fixtures/schema.sql  |   3 +-
 6 files changed, 33 insertions(+), 199 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 1248c4012..2361a7355 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -20,12 +20,10 @@ import           Data.List                 (find, sortBy, delete, transpose)
 import           Data.Maybe                (fromMaybe, fromJust, isJust, isNothing, mapMaybe)
 import           Data.Ord                  (comparing)
 import           Data.Ranged.Ranges        (emptyRange)
---import qualified Data.Set                  as S
 import           Data.String.Conversions   (cs)
 import           Data.Text                 (Text, replace, strip)
 import           Data.Tree
 import qualified Data.Map as M
---import           Data.Foldable             (forlrM)
 
 import           Text.Parsec.Error
 import           Text.ParserCombinators.Parsec (parse)
@@ -109,30 +107,6 @@ app dbstructure conf reqBody req =
         request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
         fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
 
-    -- ([table], "PUT") ->
-    --   handleJsonObj reqBody $ \obj -> do
-    --     let qt = qualify table
-    --         pKeys = map pkName $ filter (filterPk schema table) allPrKeys
-    --         specifiedKeys = map (cs . fst) qq
-    --     if S.fromList pKeys /= S.fromList specifiedKeys
-    --       then return $ responseLBS status405 []
-    --         "You must speficy all and only primary keys as params"
-    --       else do
-    --         let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols
-    --             cols = map cs $ HM.keys obj
-    --         if S.fromList tableCols == S.fromList cols
-    --           then do
-    --             let vals = HM.elems obj
-    --             H.unitEx $ iffNotT
-    --               (whereT qt qq $ update qt cols vals)
-    --               (insertSelect qt cols vals)
-    --             return $ responseLBS status204 [ jsonH ] ""
-    --
-    --           else return $ if Prelude.null tableCols
-    --             then responseLBS status404 [] ""
-    --             else responseLBS status400 []
-    --               "You must specify all columns in PUT request"
-
     ([table], "PATCH") -> do
       let echoRequested = hasPrefer "return=representation"
       case request of
@@ -269,23 +243,6 @@ contentTypeForAccept accept
     findInAccept = flip find $ parseHttpAccept acceptH
     has          = isJust . findInAccept . BS.isPrefixOf
 
--- handleJsonObj :: BL.ByteString -> (Object -> H.Tx P.Postgres s Response)
---               -> H.Tx P.Postgres s Response
--- handleJsonObj reqBody handler = do
---   let p = eitherDecode reqBody
---   case p of
---     Left err ->
---       return $ responseLBS status400 [jsonH] jErr
---       where
---         jErr = encode . object $
---           [("message", String $ "Failed to parse JSON payload. " <> cs err)]
---     Right (Object o) -> handler o
---     Right _ ->
---       return $ responseLBS status400 [jsonH] jErr
---       where
---         jErr = encode . object $
---           [("message", String "Expecting a JSON object")]
-
 parseCsvCell :: BL.ByteString -> Value
 parseCsvCell s = if s == "NULL" then Null else String $ cs s
 
diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs
index 753067567..e4d56e1ba 100644
--- a/src/PostgREST/Parsers.hs
+++ b/src/PostgREST/Parsers.hs
@@ -4,16 +4,14 @@ module PostgREST.Parsers
 where
 
 import           Control.Applicative hiding ((<$>))
---import           Control.Monad                 (join)
---import           Data.List                     (delete, find)
---import           Data.Maybe
 import           Data.Monoid
 import           Data.String.Conversions       (cs)
 import           Data.Text                     (Text)
 import           Data.Tree
---import           Network.Wai                   (Request, pathInfo, queryString)
 import           PostgREST.Types
 import           Text.ParserCombinators.Parsec hiding (many, (<|>))
+import           PostgREST.PgQuery (operators)
+
 
 pRequestSelect :: Text -> Parser ApiRequest
 pRequestSelect rootNodeName = do
@@ -50,8 +48,6 @@ pTreePath = do
   let pp = map cs p
       jpp = map cs <$> jp
   return (init pp, (last pp, jpp))
-  where
-
 
 pFieldForest :: Parser [Tree SelectItem]
 pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
@@ -84,22 +80,8 @@ pSelect = lexeme $
     return ((s, Nothing), Nothing)
 
 pOperator :: Parser Operator
-pOperator = cs <$> ( try (string "lte") -- has to be before lt
-     <|> try (string "lt")
-     <|> try (string "eq")
-     <|> try (string "gte") -- has to be before gh
-     <|> try (string "gt")
-     <|> try (string "lt")
-     <|> try (string "neq")
-     <|> try (string "like")
-     <|> try (string "ilike")
-     <|> try (string "in")
-     <|> try (string "notin")
-     <|> try (string "is" )
-     <|> try (string "isnot")
-     <|> try (string "@@")
-     <?> "operator (eq, gt, ...)"
-     )
+pOperator = cs <$> (pOp <?> "operator (eq, gt, ...)")
+  where pOp = foldl (<|>) empty $ map (try . string . cs . fst) operators
 
 pValue :: Parser FValue
 pValue = VText <$> (cs <$> many anyChar)
diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index 70247c9ac..9d66f6ecb 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -9,13 +9,8 @@ module PostgREST.PgQuery (
 , wrapQuery
 , asJson
 , callProc
--- , iffNotT
--- , update
--- , insertSelect
--- , deleteFrom
--- , asCsvWithCount
--- , asJsonWithCount
 , unquoted
+, operators
 
 -- format functions
 , pgFmtLit
@@ -29,12 +24,6 @@ module PostgREST.PgQuery (
 , pgFmtSelectItem
 , pgFmtAsJsonPath
 
--- query transformers (to be removed)
--- , withT
--- , countT
--- , returningStarT
--- , whereT
-
 -- query fragments
 , sourceSubqueryName
 , orderF
@@ -70,7 +59,6 @@ import           Data.Scientific         (FPFormat (..), formatScientific,
 import           Data.String.Conversions (cs)
 import qualified Data.Text               as T
 import           Data.Vector             (empty)
---import qualified Network.HTTP.Types.URI  as Net
 import           Text.Regex.TDFA         ((=~))
 
 import           Prelude
@@ -89,100 +77,34 @@ data JsonbPath =
   | DoubleArrow JsonbPath JsonbPath
   deriving (Show)
 
-operators :: M.Map T.Text T.Text
-operators = M.fromList [
+
+operators :: [(T.Text, T.Text)]
+operators = [
   ("eq", "="),
+  ("gte", ">="), -- has to be before gt (parsers)
   ("gt", ">"),
+  ("lte", "<="), -- has to be before lt (parsers)
   ("lt", "<"),
-  ("gte", ">="),
-  ("lte", "<="),
   ("neq", "<>"),
   ("like", "like"),
   ("ilike", "ilike"),
   ("in", "in"),
   ("notin", "not in"),
+  ("isnot", "is not"), -- has to be before is (parsers)
   ("is", "is"),
-  ("isnot", "is not"),
-  ("@@", "@@")
+  ("@@", "@@"),
+  ("@>", "@>"),
+  ("<@", "<@")
   ]
 
+operatorsMap :: M.Map T.Text T.Text
+operatorsMap = M.fromList operators
 
--- whereT :: QualifiedIdentifier -> Net.Query -> StatementT
--- whereT table params q =
---   if L.null cols
---     then q
---     else q <> B.Stmt " where " empty True <> conjunction
---   where
---     cols = [ col | col <- params, fst col `notElem` ["order","select"] ]
---     wherePredTable = wherePred table
---     conjunction = mconcat $ L.intersperse andq (map wherePredTable cols)
---
--- withT :: PStmt -> T.Text -> StatementT
--- withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
---   B.Stmt ("WITH " <> v <> " AS (" <> eq <> ") " <> wq <> " from " <> v)
---     (ep <> wp)
---     (epre && wpre)
---
--- iffNotT :: PStmt -> StatementT
--- iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) =
---   B.Stmt
---     ("WITH aaa AS (" <> aq <> " returning *) " <>
---       bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)")
---     (ap <> bp)
---     (apre && bpre)
---
--- countT :: StatementT
--- countT s =
---   s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" }
---
--- asCsvWithCount :: QualifiedIdentifier -> StatementT
--- asCsvWithCount table = withCount . asCsv table
---
--- asCsv :: QualifiedIdentifier -> StatementT
--- asCsv table s = s {
---   B.stmtTemplate =
---     "(select string_agg(quote_ident(column_name::text), ',') from "
---     <> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '"
---     <> fromQi table <> "' order by ordinal_position) h) || '\r' || "
---     <> "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '') from ("
---     <> B.stmtTemplate s <> ") t" }
---
--- asJsonWithCount :: StatementT
--- asJsonWithCount = withCount . asJson
---
 asJson :: StatementT
 asJson s = s {
   B.stmtTemplate =
     "array_to_json(array_agg(row_to_json(t)))::character varying from ("
     <> B.stmtTemplate s <> ") t" }
---
--- withCount :: StatementT
--- withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s }
---
--- returningStarT :: StatementT
--- returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
---
--- deleteFrom :: QualifiedIdentifier -> PStmt
--- deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True
---
--- insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
--- insertSelect t [] _ = B.Stmt
---   ("insert into " <> fromQi t <> " default values returning *") empty True
--- insertSelect t cols vals = B.Stmt
---   ("insert into " <> fromQi t <> " ("
---     <> T.intercalate ", " (map pgFmtIdent cols)
---     <> ") select "
---     <> T.intercalate ", " (map insertableValue vals))
---   empty True
---
--- update :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
--- update t cols vals = B.Stmt
---   ("update " <> fromQi t <> " set ("
---     <> T.intercalate ", " (map pgFmtIdent cols)
---     <> ") = ("
---     <> T.intercalate ", " (map insertableValue vals)
---     <> ")")
---   empty True
 
 callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
 callProc qi params = do
@@ -191,40 +113,11 @@ callProc qi params = do
   where
     assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
 
--- wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt
--- wherePred table (col, predicate) =
---   B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <>
---       if opCode `elem` ["is","isnot"] then whiteList val
---                                  else cs sqlValue)
---       empty True
---
---   where
---     headPredicate:rest = T.split (=='.') $ cs $ fromMaybe "." predicate
---     hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
---     opCode        = hasNot (head rest) headPredicate
---     notOp         = hasNot headPredicate ""
---     val         = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest)
---     sqlValue = pgFmtValue opCode val
---     op = pgFmtOperator opCode
-
 whiteList :: T.Text -> T.Text
 whiteList val = fromMaybe
   (cs (pgFmtLit val) <> "::unknown ")
   (L.find ((==) . T.toLower $ val) ["null","true","false"])
 
--- andq :: PStmt
--- andq = B.Stmt " and " empty True
-
--- parseJsonbPath :: T.Text -> Maybe JsonbPath
--- parseJsonbPath p =
---   case T.splitOn "->>" p of
---     [a,b] ->
---       let i:is = T.splitOn "->" a in
---       Just $ DoubleArrow
---         (foldl SingleArrow (ColIdentifier i) (map KeyIdentifier is))
---         (KeyIdentifier b)
---     _ -> Nothing
-
 trimNullChars :: T.Text -> T.Text
 trimNullChars = T.takeWhile (/= '\x0')
 
@@ -350,18 +243,7 @@ pgFmtValue opCode val =
    unknownLiteral = (<> "::unknown ") . pgFmtLit
 
 pgFmtOperator :: T.Text -> T.Text
-pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operators
-
--- pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
--- pgFmtJsonbPath table p =
---  pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
---  where
---    pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
---    pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
---    pgFmtJsonbPath' (SingleArrow a b) =
---      pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
---    pgFmtJsonbPath' (DoubleArrow a b) =
---      pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
+pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
 
 pgFmtIdent :: T.Text -> T.Text
 pgFmtIdent x =
diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs
index b6a236813..7a96229e0 100644
--- a/test/Feature/QuerySpec.hs
+++ b/test/Feature/QuerySpec.hs
@@ -7,6 +7,8 @@ import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders))
 
 import SpecHelper
+import Text.Heredoc
+
 
 spec :: Spec
 spec =
@@ -135,11 +137,20 @@ spec =
       get "/clients?select=id,projects(id,tasks(id,name))&projects.tasks.name=like.Design*" `shouldRespondWith`
         "[{\"id\":1,\"projects\":[{\"id\":1,\"tasks\":[{\"id\":1,\"name\":\"Design w7\"}]},{\"id\":2,\"tasks\":[{\"id\":3,\"name\":\"Design w10\"}]}]},{\"id\":2,\"projects\":[{\"id\":3,\"tasks\":[{\"id\":5,\"name\":\"Design IOS\"}]},{\"id\":4,\"tasks\":[{\"id\":7,\"name\":\"Design OSX\"}]}]}]"
 
+    it "matches with @> operator" $
+      get "/complex_items?select=id&arr_data=@>.{2}" `shouldRespondWith`
+        [str|[{"id":2},{"id":3}]|]
+
+    it "matches with <@ operator" $
+      get "/complex_items?select=id&arr_data=<@.{1,2,4}" `shouldRespondWith`
+        [str|[{"id":1},{"id":2}]|]
+
+
   describe "Shaping response with select parameter" $ do
 
     it "selectStar works in absense of parameter" $
       get "/complex_items?id=eq.3" `shouldRespondWith`
-        "[{\"id\":3,\"name\":\"Three\",\"settings\":{\"foo\":{\"int\":1,\"bar\":\"baz\"}}}]"
+        [str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3]}]|]
 
     it "one simple column" $
       get "/complex_items?select=id" `shouldRespondWith`
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index 30af213d0..1a0dae557 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -151,10 +151,11 @@ createComplexItems = do
   void . liftIO $ H.session pool $ H.tx Nothing txn
   where
     txn = mapM_ H.unitEx stmts
-    stmts = getZipList $ [H.stmt|insert into test.complex_items (id, name, settings) values (?,?,?)|]
+    stmts = getZipList $ [H.stmt|insert into test.complex_items (id, name, settings, arr_data) values (?,?,?,?)|]
         <$> ZipList ([1..3]::[Int])
         <*> ZipList (["One", "Two", "Three"]::[Text])
         <*> ZipList [jobj,jobj,jobj]
+        <*> ZipList ([[1], [1,2], [1,2,3]]::[[Int]])
     jobj = J.object [("foo", J.object [("int", J.Number 1),("bar", J.String "baz")])]
 
 createNulls :: Int -> IO ()
diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql
index 61ab265c6..8c17f72ff 100755
--- a/test/fixtures/schema.sql
+++ b/test/fixtures/schema.sql
@@ -204,7 +204,8 @@ ALTER TABLE test.items OWNER TO postgrest_test;
 CREATE TABLE complex_items (
     id bigint NOT NULL,
     name text,
-    settings json
+    settings json,
+    arr_data INTEGER[]
 );
 
 

From b3e88a37d3430addc4e633dfe10280dbe0138aa0 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Mon, 2 Nov 2015 23:31:35 +0200
Subject: [PATCH 58/81] Refacttoring

---
 src/PostgREST/App.hs     | 36 ++++++++++++++++--------------------
 src/PostgREST/Parsers.hs | 11 ++++-------
 2 files changed, 20 insertions(+), 27 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 2361a7355..11767b2ab 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -57,7 +57,11 @@ import           Prelude
 app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
 app dbstructure conf reqBody req =
   case (path, verb) of
-
+    -- ([table], v) ->
+    --   case request of
+    --     Left e -> return $ responseLBS status400 [jsonH] $ cs e
+    --     Right (selectQuery, mutateQuery, isSingle) ->
+        
     ([table], "GET") ->
       if range == Just emptyRange
       then return $ responseLBS status416 [] "HTTP Range error"
@@ -83,13 +87,10 @@ app dbstructure conf reqBody req =
                     if Prelude.null canonical then "" else "?" <> cs canonical
                 )
               ] (fromMaybe "[]" body)
-
         where
             frm = fromMaybe 0 $ rangeOffset <$> range
-            request = parseRequest schema allRels table req reqBody
 
-    ([table], "POST") -> do
-      let echoRequested = hasPrefer "return=representation"
+    ([table], "POST") ->
       case request of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (selectQuery, mutateQuery, isSingle) -> do
@@ -103,12 +104,8 @@ app dbstructure conf reqBody req =
               (hLocation, "/" <> cs table <> "?" <> cs (fromMaybe "" location))
             ]
             $ if echoRequested then fromMaybe "[]" body else ""
-      where
-        request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
-        fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
 
-    ([table], "PATCH") -> do
-      let echoRequested = hasPrefer "return=representation"
+    ([_], "PATCH") ->
       case request of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (selectQuery, mutateQuery, _) -> do
@@ -122,11 +119,7 @@ app dbstructure conf reqBody req =
           return $ responseLBS s [contentTypeH, r]
             $ if echoRequested then fromMaybe "[]" body else ""
 
-      where
-        request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
-        fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
-
-    ([table], "DELETE") ->
+    ([_], "DELETE") ->
       case request of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (selectQuery, mutateQuery, _) -> do
@@ -137,10 +130,6 @@ app dbstructure conf reqBody req =
             then responseLBS status404 [] ""
             else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] ""
 
-
-      where
-        request = parseRequest schema allRels table req reqBody
-
     (["rpc", proc], "POST") -> do
       let qi = QualifiedIdentifier schema (cs proc)
       exists <- doesProcExist schema proc
@@ -201,6 +190,8 @@ app dbstructure conf reqBody req =
     contentType   = fromMaybe "application/json" $ contentTypeForAccept accept
     isCsv         = contentType == csvMT
     contentTypeH  = (hContentType, contentType)
+    echoRequested = hasPrefer "return=representation"
+    request = parseRequest schema allRels (head path) req reqBody --TODO! is head safe?
 
 rangeStatus :: Int -> Int -> Maybe Int -> Status
 rangeStatus _ _ Nothing = status200
@@ -390,7 +381,12 @@ parseRequest schema allRels rootTableName httpRequest reqBody =
     allFilters = whereFilters qParams
     mutateFilters = filter (not . ( '.' `elem` ) . fst) allFilters -- update/delete filters can be only on the root table
     cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
-    selectApiRequest = augumentRequestWithJoin schema allRels
+    fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels
+    rels = case method of
+      "POST"  -> fakeSourceRelations ++ allRels
+      "PATCH" -> fakeSourceRelations ++ allRels
+      _       -> allRels
+    selectApiRequest = augumentRequestWithJoin schema rels
       =<< buildSelectApiRequest rootName sel filters (orderStr qParams)
       where
         sel = if method == "DELETE"
diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs
index e4d56e1ba..7069a049c 100644
--- a/src/PostgREST/Parsers.hs
+++ b/src/PostgREST/Parsers.hs
@@ -34,7 +34,6 @@ pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
     op = fst <$> opVal
     val = snd <$> opVal
 
-
 ws :: Parser Text
 ws = cs <$> many (oneOf " \t")
 
@@ -45,23 +44,21 @@ pTreePath :: Parser (Path,Field)
 pTreePath = do
   p <- pFieldName `sepBy1` pDelimiter
   jp <- optionMaybe ( string "->" >>  pJsonPath)
-  let pp = map cs p
-      jpp = map cs <$> jp
-  return (init pp, (last pp, jpp))
+  return (init p, (last p, jp))
 
 pFieldForest :: Parser [Tree SelectItem]
 pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
 
 pFieldTree :: Parser (Tree SelectItem)
-pFieldTree = try (Node <$> pSelect <*> ( char '(' *> pFieldForest <* char ')'))
-      <|>    Node <$> pSelect <*> pure []
+pFieldTree = try (Node <$> pSelect <*> between (char '(') (char ')') pFieldForest)
+          <|>     Node <$> pSelect <*> pure []
 
 pStar :: Parser Text
 pStar = cs <$> (string "*" *> pure ("*"::String))
 
 pFieldName :: Parser Text
 pFieldName =  cs <$> (many1 (letter <|> digit <|> oneOf "_")
-      <?> "field name (* or [a..z0..9_])")
+          <?> "field name (* or [a..z0..9_])")
 
 pJsonPathDelimiter :: Parser Text
 pJsonPathDelimiter = cs <$> (try (string "->>") <|> string "->")

From 14e806759db28bd6e115dc5dace89966ae18fb04 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Tue, 3 Nov 2015 09:31:56 +0200
Subject: [PATCH 59/81] Revert to the old way of displaying the list of tables

---
 src/PostgREST/App.hs         | 15 +-----
 src/PostgREST/Main.hs        |  8 ++--
 src/PostgREST/PgStructure.hs | 89 +++++++++++++++++++++++-------------
 src/PostgREST/Types.hs       |  4 +-
 test/SpecHelper.hs           |  8 ++--
 5 files changed, 66 insertions(+), 58 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 11767b2ab..2f1bf4b67 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -57,11 +57,7 @@ import           Prelude
 app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
 app dbstructure conf reqBody req =
   case (path, verb) of
-    -- ([table], v) ->
-    --   case request of
-    --     Left e -> return $ responseLBS status400 [jsonH] $ cs e
-    --     Right (selectQuery, mutateQuery, isSingle) ->
-        
+
     ([table], "GET") ->
       if range == Just emptyRange
       then return $ responseLBS status416 [] "HTTP Range error"
@@ -151,8 +147,7 @@ app dbstructure conf reqBody req =
       -- select * from public.proc(a := "foo"::undefined) where whereT limit limitT
 
     ([], _) -> do
-      Identity (dbrole :: Text) <- H.singleEx $ [H.stmt|SELECT current_user|]
-      let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTabs
+      body <- encode <$> tables (cs schema)
       return $ responseLBS status200 [jsonH] $ cs body
 
     ([table], "OPTIONS") -> do
@@ -165,20 +160,14 @@ app dbstructure conf reqBody req =
       return $ responseLBS status404 [] ""
 
   where
-    allTabs = tables dbstructure
     allRels = relations dbstructure
     allCols = columns dbstructure
     allPrKeys = primaryKeys dbstructure
     filterCol sc table (Column{colSchema=s, colTable=t}) =  s==sc && table==t
     filterCol _ _ _ =  False
     filterPk sc table pk = sc == pkSchema pk && table == pkTable pk
-
-    filterTableAcl :: Text -> Table -> Bool
-    filterTableAcl r (Table{tableAcl=a}) = r `elem` a
     path          = pathInfo req
     verb          = requestMethod req
-    --qq            = queryString req
-    --qualify       = QualifiedIdentifier schema
     hdrs          = requestHeaders req
     lookupHeader  = flip lookup hdrs
     hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index af6f395fb..7dc0540e0 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -81,19 +81,17 @@ main = do
 
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
-    tabs <- allTables
     rels <- allRelations
     cols <- allColumns rels
     keys <- allPrimaryKeys
-    return (tabs, rels, cols, keys)
+    return (rels, cols, keys)
 
 
   dbstructure <- either hasqlError
-    (\(tabs, rels, cols, keys) ->
+    (\(rels, cols, keys) ->
 
       return DbStructure {
-          tables=tabs
-        , columns=cols
+          columns=cols
         , relations=rels
         , primaryKeys=keys
         }
diff --git a/src/PostgREST/PgStructure.hs b/src/PostgREST/PgStructure.hs
index d7e1710db..b9db312ae 100644
--- a/src/PostgREST/PgStructure.hs
+++ b/src/PostgREST/PgStructure.hs
@@ -48,11 +48,8 @@ doesProcReturnJWT = doesProc [H.stmt|
       AND    pg_catalog.pg_get_function_result(p.oid) = 'jwt_claims'
     |]
 
-tableFromRow :: (Text, Text, Bool, Maybe Text) -> Table
-tableFromRow (s, n, i, a) = Table s n i (parseAcl a)
-  where
-    parseAcl :: Maybe Text -> [Text]
-    parseAcl str = fromMaybe [] $ split (==',') <$> str
+tableFromRow :: (Text, Text, Bool) -> Table
+tableFromRow (s, n, i) = Table s n i
 
 columnFromRow :: (Text,       Text,      Text,
                   Int,        Bool,      Text,
@@ -77,34 +74,62 @@ pkFromRow (s, t, n) = PrimaryKey s t n
 addParentRelation :: Relation -> [Relation] -> [Relation]
 addParentRelation rel@(Relation s t c ft fc _ _ _ _) rels = Relation s ft fc t c Parent Nothing Nothing Nothing:rel:rels
 
-allTables :: H.Tx P.Postgres s [Table]
-allTables = do
-    rows <- H.listEx $ [H.stmt|
-      SELECT
-        n.nspname AS table_schema,
-        c.relname AS table_name,
-        c.relkind = 'r' OR (c.relkind IN ('v','f'))
-        AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
-        OR (EXISTS
-          ( SELECT 1
-            FROM pg_trigger
-            WHERE pg_trigger.tgrelid = c.oid
-            AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable,
-        array_to_string(array_agg(r.rolname), ',') AS acl
-      FROM pg_class c
-      CROSS JOIN pg_roles r
-      JOIN pg_namespace n ON n.oid = c.relnamespace
-      WHERE c.relkind IN ('v','r','m')
-        AND n.nspname NOT IN ('pg_catalog', 'information_schema')
-        AND (
-          pg_has_role(r.rolname, c.relowner, 'USAGE'::text) OR
-          has_table_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR
-          has_any_column_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text) )
+-- allTables :: H.Tx P.Postgres s [Table]
+-- allTables = do
+--     rows <- H.listEx $ [H.stmt|
+--       SELECT
+--         n.nspname AS table_schema,
+--         c.relname AS table_name,
+--         c.relkind = 'r' OR (c.relkind IN ('v','f'))
+--         AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
+--         OR (EXISTS
+--           ( SELECT 1
+--             FROM pg_trigger
+--             WHERE pg_trigger.tgrelid = c.oid
+--             AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable,
+--         array_to_string(array_agg(r.rolname), ',') AS acl
+--       FROM pg_class c
+--       CROSS JOIN pg_roles r
+--       JOIN pg_namespace n ON n.oid = c.relnamespace
+--       WHERE c.relkind IN ('v','r','m')
+--         AND n.nspname NOT IN ('pg_catalog', 'information_schema')
+--         AND (
+--           pg_has_role(r.rolname, c.relowner, 'USAGE'::text) OR
+--           has_table_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR
+--           has_any_column_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text) )
+--
+--       GROUP BY table_schema, table_name, insertable
+--       ORDER BY table_schema, table_name
+--     |]
+--     return $ map tableFromRow rows
 
-      GROUP BY table_schema, table_name, insertable
-      ORDER BY table_schema, table_name
-    |]
-    return $ map tableFromRow rows
+tables :: Text -> H.Tx P.Postgres s [Table]
+tables schema = do
+  rows <- H.listEx $
+    [H.stmt|
+      select
+        n.nspname as table_schema,
+        relname as table_name,
+        c.relkind = 'r' or (c.relkind IN ('v', 'f')) and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8
+        or (exists (
+           select 1
+           from pg_trigger
+           where pg_trigger.tgrelid = c.oid and (pg_trigger.tgtype::integer & 69) = 69)
+        ) as insertable
+      from
+        pg_class c
+        join pg_namespace n on n.oid = c.relnamespace
+      where
+        c.relkind in ('v', 'r', 'm')
+        and n.nspname = ?
+        and (
+          pg_has_role(c.relowner, 'USAGE'::text)
+          or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text)
+          or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
+        )
+      order by relname
+    |] schema
+  return $ map tableFromRow rows
 
 allRelations :: H.Tx P.Postgres s [Relation]
 allRelations = do
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
index 8eeac7604..691efad99 100644
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -6,8 +6,7 @@ import Data.Aeson
 import Data.Map
 
 data DbStructure = DbStructure {
-  tables :: [Table]
-, columns :: [Column]
+  columns :: [Column]
 , relations :: [Relation]
 , primaryKeys :: [PrimaryKey]
 }
@@ -17,7 +16,6 @@ data Table = Table {
   tableSchema :: Text
 , tableName :: Text
 , tableInsertable :: Bool
-, tableAcl :: [Text]
 } deriving (Show)
 
 data ForeignKey = ForeignKey {
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index 1a0dae557..6dd276057 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -56,18 +56,16 @@ withApp perform = do
 
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
-    tabs <- allTables
     rels <- allRelations
     cols <- allColumns rels
     keys <- allPrimaryKeys
-    return (tabs, rels, cols, keys)
+    return (rels, cols, keys)
 
   dbstructure <- case metadata of
     Left e -> fail $ show e
-    Right (tabs, rels, cols, keys) ->
+    Right (rels, cols, keys) ->
       return DbStructure {
-          tables=tabs
-        , columns=cols
+          columns=cols
         , relations=rels
         , primaryKeys=keys
         }

From 28b7b80bbb29f5fa4c7058f1f823a80fd806d47d Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Wed, 4 Nov 2015 16:22:13 +0200
Subject: [PATCH 60/81] remove PUT from cors

---
 src/PostgREST/Config.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs
index efb090fa5..54d9dcb0e 100644
--- a/src/PostgREST/Config.hs
+++ b/src/PostgREST/Config.hs
@@ -56,7 +56,7 @@ argParser = AppConfig
 
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing
-  ["GET", "POST", "PUT", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
+  ["GET", "POST", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
   (Just $ 60*60*24) False False True
 
 -- | CORS policy to be used in by Wai Cors middleware

From 37b1d7d69279dfcc293ad78bba563553f7f9f0f6 Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Wed, 4 Nov 2015 16:23:02 +0200
Subject: [PATCH 61/81] fix debian scripts to match current parameters

---
 debian/postgrest.default | 19 ++++++++++----
 debian/postgrest.init.d  | 55 +++++++++++++++++++++++++++-------------
 2 files changed, 52 insertions(+), 22 deletions(-)

diff --git a/debian/postgrest.default b/debian/postgrest.default
index 33dab96cc..fe0141969 100644
--- a/debian/postgrest.default
+++ b/debian/postgrest.default
@@ -7,17 +7,26 @@
 # database host
 #POSTGREST_DBHOST=localhost
 
+# database host
+#POSTGREST_DBPORT=5432
+
 # database to use
-#POSTGREST_DBNAME=
+#POSTGREST_DBNAME=app
 
 # database user
-#POSTGREST_DBUSER=postgres
+#POSTGREST_DBUSER=authenticator
 
 # database password
 #POSTGREST_DBPASS=
 
 # database pool
-#POSTGREST_DBPOOL=10
+#POSTGREST_POOL=10
 
-# additional options
-#POSTGREST_OPTS=
+# jwt secret
+#POSTGREST_JWT_SECRET=secret
+
+# default schema
+#POSTGREST_SCHEMA=public
+
+# secure (use 1 to enable, empty string to disable)
+#POSTGREST_SECURE=
diff --git a/debian/postgrest.init.d b/debian/postgrest.init.d
index 2227d8c07..a9091740e 100755
--- a/debian/postgrest.init.d
+++ b/debian/postgrest.init.d
@@ -13,31 +13,52 @@ if test -f /etc/default/postgrest; then
     . /etc/default/postgrest
 fi
 POSTGREST=/usr/local/bin/postgrest
+CONNECTION_STRING="postgres://"
+POSTGREST_OPTS=""
 POSTGREST_USER=${POSTGREST_USER:-postgrest}
-POSTGREST_DBNAME=${POSTGREST_DBNAME:-postgres}
-POSTGREST_DBUSER=${POSTGREST_DBUSER:-postgres}
-if [ -n "$POSTGREST_DBHOST" ]; then
-	POSTGREST_OPTS="$POSTGREST_OPTS --db-host $POSTGREST_DBHOST"
-fi
-if [ -n "$POSTGREST_DBNAME" ]; then
-	POSTGREST_OPTS="$POSTGREST_OPTS --db-name $POSTGREST_DBNAME"
-fi
-if [ -n "$POSTGREST_DBUSER" ]; then
-	POSTGREST_OPTS="$POSTGREST_OPTS --db-user $POSTGREST_DBUSER"
-	POSTGREST_OPTS="$POSTGREST_OPTS --anonymous $POSTGREST_DBUSER"
-fi
+POSTGREST_PORT=${POSTGREST_PORT:-3000}
+POSTGREST_DBUSER=${POSTGREST_DBUSER:-authenticator}
+#POSTGREST_DBPASS=${POSTGREST_DBPASS:-authenticator}
+POSTGREST_DBHOST=${POSTGREST_DBHOST:-localhost}
+POSTGREST_DBPORT=${POSTGREST_DBPORT:-5432}
+POSTGREST_DBNAME=${POSTGREST_DBNAME:-app}
+POSTGREST_DBPOOL=${POSTGREST_DBPOOL:-10}
+POSTGREST_ANON=${POSTGREST_ANON:-anonymous}
+POSTGREST_JWT_SECRET=${POSTGREST_JWT_SECRET:-secret}
+POSTGREST_SCHEMA=${POSTGREST_SCHEMA:-public}
+
+CONNECTION_STRING="$CONNECTION_STRING$POSTGREST_DBUSER"
 if [ -n "$POSTGREST_DBPASS" ]; then
-	POSTGREST_OPTS="$POSTGREST_OPTS --db-pass $POSTGREST_DBPASS"
+	CONNECTION_STRING="$CONNECTION_STRING:$POSTGREST_DBPASS"
 fi
-if [ -n "$POSTGREST_DBPOOL" ]; then
-	POSTGREST_OPTS="$POSTGREST_OPTS --db-pool $POSTGREST_DBPOOL"
+CONNECTION_STRING="$CONNECTION_STRING@$POSTGREST_DBHOST:$POSTGREST_DBPORT/$POSTGREST_DBNAME"
+
+if [ -n "$POSTGREST_PORT" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --port $POSTGREST_PORT"
 fi
-POSTGREST_OPTS="$POSTGREST_OPTS --schema public"
+
+if [ -n "$POSTGREST_POOL" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --pool $POSTGREST_POOL"
+fi
+if [ -n "$POSTGREST_JWT_SECRET" ]; then
+	#export POSTGREST_JWT_SECRET="$POSTGREST_JWT_SECRET"
+	POSTGREST_OPTS="$POSTGREST_OPTS --jwt-secret $POSTGREST_JWT_SECRET"
+fi
+if [ -n "$POSTGREST_SCHEMA" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --schema $POSTGREST_SCHEMA"
+fi
+if [ -n "$POSTGREST_ANON" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --anonymous $POSTGREST_ANON"
+fi
+
+#export CONNECTION_STRING="$CONNECTION_STRING"
+
+START_PARAMS="$CONNECTION_STRING $POSTGREST_OPTS"
 
 start()
 {
 	log_daemon_msg "Starting PostgreSQL REST API daemon" "postgrest" || true
-	if start-stop-daemon --start --quiet --oknodo --chuid ${POSTGREST_USER} --startas /usr/local/bin/postgrest-wrapper --exec $POSTGREST -- $POSTGREST_OPTS; then
+	if start-stop-daemon --start --quiet --oknodo --chuid ${POSTGREST_USER} --startas /usr/local/bin/postgrest-wrapper --exec $POSTGREST -- $START_PARAMS; then
 		log_end_msg 0 || true
 	else
 		log_end_msg 1 || true

From cfad68f5cb05f09708ae6a1cafcc906f609838ed Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Wed, 4 Nov 2015 16:28:22 +0200
Subject: [PATCH 62/81] Fix test

---
 test/Feature/CorsSpec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/Feature/CorsSpec.hs b/test/Feature/CorsSpec.hs
index fa005dc22..35ff69982 100644
--- a/test/Feature/CorsSpec.hs
+++ b/test/Feature/CorsSpec.hs
@@ -41,7 +41,7 @@ spec = around withApp $ describe "CORS" $ do
             "true"
           respHeaders `shouldSatisfy` matchHeader
             "Access-Control-Allow-Methods"
-            "GET, POST, PUT, PATCH, DELETE, OPTIONS, HEAD"
+            "GET, POST, PATCH, DELETE, OPTIONS, HEAD"
           respHeaders `shouldSatisfy` matchHeader
             "Access-Control-Allow-Headers"
             "Authentication, Foo, Bar, Accept, Accept-Language, Content-Language"

From aab2f0d1f146f3b65e2922416c68f7747d410b47 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Thu, 5 Nov 2015 16:59:58 -0500
Subject: [PATCH 63/81] Ensure JWT expires

---
 CHANGELOG.md                |  1 +
 src/PostgREST/Auth.hs       | 14 +++++++++++--
 src/PostgREST/Main.hs       | 11 +++-------
 src/PostgREST/Middleware.hs | 42 ++++++++++++++++++++-----------------
 test/Feature/AuthSpec.hs    | 27 +++++++++++++++++++++---
 test/SpecHelper.hs          |  6 ++++--
 test/fixtures/schema.sql    |  1 +
 7 files changed, 68 insertions(+), 34 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index b52223031..96d8b9fc4 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -10,6 +10,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - Filter columns, e.g. `?select=col1,col2` - @ruslantalpa
 - Does not execute the count total if header "Prefer: count=none" - @diogob
 - Postgres connection string argument - @calebmer
+- Ensure JWT expires - @calebmer
 
 ### Removed
 - API versioning feature - @calebmer
diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index 80f13a3f3..e8b1e2f47 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -25,6 +25,7 @@ import           Data.Map                as M (fromList, toList)
 import           Data.Monoid             ((<>))
 import           Data.String.Conversions (cs)
 import           Data.Text               (Text)
+import           Data.Time.Clock         (NominalDiffTime)
 import           PostgREST.PgQuery       (pgFmtLit, pgFmtIdent, unquoted)
 import qualified Web.JWT                 as JWT
 import qualified Data.HashMap.Lazy       as H
@@ -49,10 +50,19 @@ claimsToSQL = map setVar . toList
   returns a map of JWT claims
   In case there is any problem decoding the JWT it returns Nothing.
 -}
-jwtClaims :: Text -> Text -> Maybe JWT.ClaimsMap
-jwtClaims secret input = JWT.unregisteredClaims . JWT.claims <$> decoded
+jwtClaims :: Text -> Text -> NominalDiffTime -> Maybe JWT.ClaimsMap
+jwtClaims secret input time =
+  case claim JWT.exp of
+    Just (Just expires) ->
+      if JWT.secondsSinceEpoch expires > time
+        then customClaims
+        else Nothing
+    _ -> customClaims
   where
     decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
+    claim :: (JWT.JWTClaimsSet -> a) -> Maybe a
+    claim prop = prop . JWT.claims <$> decoded
+    customClaims = claim JWT.unregisteredClaims
 
 -- | Receives the name of a role and returns a SET ROLE statement
 setRole :: Text -> Text
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index af6f395fb..f51a936ae 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -24,6 +24,7 @@ import qualified Hasql.Postgres                       as P
 import           Network.Wai
 import           Network.Wai.Handler.Warp             hiding (Connection)
 import           Network.Wai.Middleware.RequestLogger (logStdout)
+import           Data.Time.Clock.POSIX                (getPOSIXTime)
 import           System.IO                            (BufferMode (..),
                                                        hSetBuffering, stderr,
                                                        stdin, stdout)
@@ -72,13 +73,6 @@ main = do
           <> show minimumPgVersion)
     ) supportedOrError
 
-  -- what was this code for?
-  -- roleOrError <- H.session pool $ do
-  --   Identity (role :: Text) <- H.tx Nothing $ H.singleEx
-  --     [H.stmt|SELECT SESSION_USER|]
-  --   return role
-  -- authenticator <- either hasqlError return roleOrError
-
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
     tabs <- allTables
@@ -105,7 +99,8 @@ main = do
   -- print $ findRelation (fakeRels ++ allRels) "test" "pg_source" "clients"
 
   runSettings appSettings $ middle $ \ req respond -> do
+    time <- getPOSIXTime
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf (app dbstructure conf body) req
+      runWithClaims conf time (app dbstructure conf body) req
     either (respond . errResponse) respond resOrError
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index 5787ca3a2..9d4ea5fc4 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -7,6 +7,7 @@ import           Data.Maybe                    (fromMaybe, isNothing)
 import           Data.Monoid
 import           Data.Text
 import           Data.String.Conversions       (cs)
+import           Data.Time.Clock               (NominalDiffTime)
 import qualified Hasql                         as H
 import qualified Hasql.Postgres                as P
 
@@ -32,27 +33,30 @@ import qualified Data.Vector             as V
 import qualified Hasql.Backend           as B
 import qualified Data.Map.Lazy           as M
 
-runWithClaims :: forall s. AppConfig ->
+runWithClaims :: forall s. AppConfig -> NominalDiffTime ->
                  (Request -> H.Tx P.Postgres s Response) ->
                  Request -> H.Tx P.Postgres s Response
-runWithClaims conf app req = do
-    mapM_ H.unitEx $ stmt <$> env
-    app req
- where
-   stmt = (flip $ flip B.Stmt V.empty) True
-   hdrs = requestHeaders req
-   jwtSecret = (cs $ configJwtSecret conf) :: Text
-   auth = fromMaybe "" $ lookup hAuthorization hdrs
-   anon = cs $ configAnonRole conf
-   claims =
-     fromMaybe (M.fromList []) $
-     case split (==' ') (cs auth) of
-       ("Bearer" : jwt : _) -> jwtClaims jwtSecret jwt
-       _ -> Nothing
-   env = if M.member "role" claims
-            then jwtEnv
-            else setRole anon : jwtEnv
-   jwtEnv = claimsToSQL claims
+runWithClaims conf time app req = do
+    _ <- H.unitEx $ stmt setAnon
+    case split (== ' ') (cs auth) of
+      ("Bearer" : tokenStr : _) ->
+        case jwtClaims jwtSecret tokenStr time of
+          Just claims ->
+            if M.member "role" claims
+            then do
+              mapM_ H.unitEx $ stmt <$> claimsToSQL claims
+              app req
+            else invalidJWT
+          _ -> invalidJWT
+      _ -> app req
+  where
+    stmt = (flip $ flip B.Stmt V.empty) True
+    hdrs = requestHeaders req
+    jwtSecret = (cs $ configJwtSecret conf) :: Text
+    auth = fromMaybe "" $ lookup hAuthorization hdrs
+    anon = cs $ configAnonRole conf
+    setAnon = setRole anon
+    invalidJWT = return $ responseLBS status400 [] "Invalid JWT"
 
 redirectInsecure :: Application -> Application
 redirectInsecure app req respond = do
diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs
index 992ca1d9e..136ae4549 100644
--- a/test/Feature/AuthSpec.hs
+++ b/test/Feature/AuthSpec.hs
@@ -31,15 +31,36 @@ spec = beforeAll
     request methodGet "/authors_only" [auth] ""
       `shouldRespondWith` 200
 
+  it "works with tokens which have extra fields" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIiwia2V5MSI6InZhbHVlMSIsImtleTIiOiJ2YWx1ZTIiLCJrZXkzIjoidmFsdWUzIiwiYSI6MSwiYiI6MiwiYyI6M30.GfydCh-F4wnM379xs0n1zUgalwJIsb6YoBapCo8HlFk"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "succeeds with an unexpired token" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.QaPPLWTuyydMu_q7H4noMT7Lk6P4muet1OpJXF6ofhc"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "fails with an expired token" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.enk_qZ_u6gZsXY4R8bREKB_HNExRpM0lIWSLktk9JJQ"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 400
+
   it "hides tables from users with invalid JWT" $ do
     let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 404
+      `shouldRespondWith` 400
 
-  it "hides tables from users with JWT that contain no claims about role" $ do
+  it "should fail when jwt contains no claims" $ do
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.MKYc_lOECtB0LJOiykilAdlHodB-I0_id2qHKq35dmc"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 404
+      `shouldRespondWith` 400
+
+  it "hides tables from users with JWT that contain no claims about role" $ do
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.zyohGMnrDy4_8eJTl6I2AUXO3MeCCiwR24aGWRkTE9o"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 400
 
   it "recovers after 400 error with logged in user" $ do
     _ <- post "/authors_only" [json| { "owner": "jdoe", "secret": "test content" } |]
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index 1a0dae557..a7e97f812 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -11,6 +11,7 @@ import Hasql.Postgres as P
 import Data.String.Conversions (cs)
 import Data.Monoid
 import Data.Text hiding (map)
+import Data.Time.Clock.POSIX (getPOSIXTime)
 import qualified Data.Vector as V
 import Control.Monad (void)
 import Control.Applicative
@@ -73,9 +74,10 @@ withApp perform = do
         }
 
   perform $ middle $ \req resp -> do
+    time <- getPOSIXTime
     body <- strictRequestBody req
     result <- liftIO $ H.session pool $ H.tx txSettings
-      $ runWithClaims cfg (app dbstructure cfg body) req
+      $ runWithClaims cfg time (app dbstructure cfg body) req
     either (resp . errResponse) resp result
 
   where middle = defaultMiddle False
@@ -134,7 +136,7 @@ clearProjectsTable :: IO ()
 clearProjectsTable = do
   pool <- testPool
   void . liftIO $ H.session pool $ H.tx Nothing $
-    H.unitEx $ B.Stmt ("delete from test.projects where id > 4") V.empty True
+    H.unitEx $ B.Stmt "delete from test.projects where id > 4" V.empty True
 
 
 createItems :: Int -> IO ()
diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql
index 8c17f72ff..0abf60888 100755
--- a/test/fixtures/schema.sql
+++ b/test/fixtures/schema.sql
@@ -291,6 +291,7 @@ $$ LANGUAGE SQL;
 
 
 CREATE TYPE public.jwt_claims AS (role text, id text);
+
 CREATE FUNCTION test.login(id text, pass text)
 RETURNS public.jwt_claims
 SECURITY DEFINER

From 34c153086ca24a8a77adf7216fd7526888febf39 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Thu, 5 Nov 2015 17:15:50 -0500
Subject: [PATCH 64/81] Do not redirect insecure requests

---
 CHANGELOG.md                |  1 +
 src/PostgREST/Middleware.hs | 36 ++++++++++--------------------------
 2 files changed, 11 insertions(+), 26 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index b52223031..80d6887a0 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -14,6 +14,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 ### Removed
 - API versioning feature - @calebmer
 - `--db-x` command line arguments - @calebmer
+- Secure flag responds with 403 instead of redirect - @calebmer
 
 ### Fixed
 - Tolerate a missing role in user creation - @calebmer
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index 5787ca3a2..03ba3dcb7 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -4,19 +4,15 @@
 module PostgREST.Middleware where
 
 import           Data.Maybe                    (fromMaybe, isNothing)
-import           Data.Monoid
 import           Data.Text
 import           Data.String.Conversions       (cs)
 import qualified Hasql                         as H
 import qualified Hasql.Postgres                as P
 
-import           Network.HTTP.Types.Header     (hAccept, hAuthorization,
-                                                hLocation)
-import           Network.HTTP.Types.Status     (status301, status400, status415)
-import           Network.URI                   (URI (..), parseURI)
+import           Network.HTTP.Types.Header     (hAccept, hAuthorization)
+import           Network.HTTP.Types.Status     (status403, status415)
 import           Network.Wai                   (Application, Request (..),
-                                                Response, isSecure, rawPathInfo,
-                                                rawQueryString, requestHeaders,
+                                                Response, isSecure, requestHeaders,
                                                 responseLBS)
 import           Network.Wai.Middleware.Cors   (cors)
 import           Network.Wai.Middleware.Gzip   (def, gzip)
@@ -54,26 +50,14 @@ runWithClaims conf app req = do
             else setRole anon : jwtEnv
    jwtEnv = claimsToSQL claims
 
-redirectInsecure :: Application -> Application
-redirectInsecure app req respond = do
-  let hdrs = requestHeaders req
-      host = lookup "host" hdrs
-      uriM = parseURI . cs =<< mconcat [
-        Just "https://",
-        host,
-        Just $ rawPathInfo req,
-        Just $ rawQueryString req]
-      isHerokuSecure = lookup "x-forwarded-proto" hdrs == Just "https"
-
+checkInsecure :: Application -> Application
+checkInsecure app req respond =
   if not (isSecure req || isHerokuSecure)
-    then case uriM of
-      Just uri ->
-        respond $ responseLBS status301 [
-            (hLocation, cs . show $ uri { uriScheme = "https:" })
-          ] ""
-      Nothing ->
-        respond $ responseLBS status400 [] "SSL is required"
+    then respond $ responseLBS status403 [] "SSL is required"
     else app req respond
+  where
+    hdrs = requestHeaders req
+    isHerokuSecure = lookup "x-forwarded-proto" hdrs == Just "https"
 
 unsupportedAccept :: Application -> Application
 unsupportedAccept app req respond = do
@@ -84,7 +68,7 @@ unsupportedAccept app req respond = do
   else app req respond
 
 defaultMiddle :: Bool -> Application -> Application
-defaultMiddle secure = (if secure then redirectInsecure else id)
+defaultMiddle secure = (if secure then checkInsecure else id)
   . gzip def . cors corsPolicy
   . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
   . unsupportedAccept

From 3d2a78e962e7fc77febf0ea6774b7b4e0fef0878 Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Thu, 5 Nov 2015 17:18:22 -0800
Subject: [PATCH 65/81] Encode JWT when proc return types end in jwt_claims

Fixes it when the jwt_claims type is defined in a non-default schema
---
 src/PostgREST/PgStructure.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/PostgREST/PgStructure.hs b/src/PostgREST/PgStructure.hs
index d7e1710db..70d804f7d 100644
--- a/src/PostgREST/PgStructure.hs
+++ b/src/PostgREST/PgStructure.hs
@@ -45,7 +45,7 @@ doesProcReturnJWT = doesProc [H.stmt|
       ON     pronamespace = n.oid
       WHERE  nspname = ?
       AND    proname = ?
-      AND    pg_catalog.pg_get_function_result(p.oid) = 'jwt_claims'
+      AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
     |]
 
 tableFromRow :: (Text, Text, Bool, Maybe Text) -> Table

From c02468762940cbf4dc83c4d553aeaf42047c5e51 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Sun, 8 Nov 2015 13:03:50 -0500
Subject: [PATCH 66/81] Remove secure flag entirely

---
 CHANGELOG.md                |  2 +-
 src/PostgREST/Config.hs     |  4 +---
 src/PostgREST/Main.hs       |  4 +---
 src/PostgREST/MainTest.hs   |  4 +---
 src/PostgREST/Middleware.hs | 23 +++++++----------------
 test/SpecHelper.hs          |  4 ++--
 6 files changed, 13 insertions(+), 28 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 80d6887a0..56fb3b9ce 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -14,7 +14,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 ### Removed
 - API versioning feature - @calebmer
 - `--db-x` command line arguments - @calebmer
-- Secure flag responds with 403 instead of redirect - @calebmer
+- Remove secure flag - @calebmer
 
 ### Fixed
 - Tolerate a missing role in user creation - @calebmer
diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs
index efb090fa5..5edf05718 100644
--- a/src/PostgREST/Config.hs
+++ b/src/PostgREST/Config.hs
@@ -38,7 +38,6 @@ data AppConfig = AppConfig {
   , configPort      :: Int
   , configAnonRole  :: String
   , configSchema    :: String
-  , configSecure    :: Bool
   , configJwtSecret :: String
   , configPool      :: Int
   }
@@ -49,8 +48,7 @@ argParser = AppConfig
 
   <*> option auto  (long "port"       <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault)
   <*> strOption    (long "anonymous"  <> short 'a' <> help "postgres role to use for non-authenticated requests" <> metavar "ROLE")
-  <*> strOption    (long "schema"     <> short 'S' <> help "schema to use for API routes" <> metavar "NAME" <> value "1" <> showDefault)
-  <*> switch       (long "secure"     <> short 's' <> help "redirect all requests to HTTPS")
+  <*> strOption    (long "schema"     <> short 's' <> help "schema to use for API routes" <> metavar "NAME" <> value "1" <> showDefault)
   <*> strOption    (long "jwt-secret" <> short 'j' <> help "secret used to encrypt and decrypt JWT tokens" <> metavar "SECRET" <> value "secret" <> showDefault)
   <*> option auto  (long "pool"       <> short 'o' <> help "max connections in database pool" <> metavar "COUNT" <> value 10 <> showDefault)
 
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index af6f395fb..44fbd841a 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -46,8 +46,6 @@ main = do
   conf <- readOptions
   let port = configPort conf
 
-  unless (configSecure conf) $
-    putStrLn "WARNING, running in insecure mode, auth will be in plaintext"
   unless ("secret" /= configJwtSecret conf) $
     putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
   Prelude.putStrLn $ "Listening on port " ++
@@ -57,7 +55,7 @@ main = do
       appSettings = setPort port
                   . setServerName (cs $ "postgrest/" <> prettyVersion)
                   $ defaultSettings
-      middle = logStdout . defaultMiddle (configSecure conf)
+      middle = logStdout . defaultMiddle
 
   poolSettings <- maybe (fail "Improper session settings") return $
     H.poolSettings (fromIntegral $ configPool conf) 30
diff --git a/src/PostgREST/MainTest.hs b/src/PostgREST/MainTest.hs
index 89a2397c9..55ebec5bc 100644
--- a/src/PostgREST/MainTest.hs
+++ b/src/PostgREST/MainTest.hs
@@ -54,8 +54,6 @@ main = do
   conf <- readOptions
   let port = configPort conf
 
-  unless (configSecure conf) $
-    putStrLn "WARNING, running in insecure mode, auth will be in plaintext"
   unless ("secret" /= configJwtSecret conf) $
     putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
   Prelude.putStrLn $ "Listening on port " ++
@@ -65,7 +63,7 @@ main = do
       appSettings = setPort port
                   . setServerName (cs $ "postgrest/" <> prettyVersion)
                   $ defaultSettings
-      middle = logStdout . defaultMiddle (configSecure conf)
+      middle = logStdout . defaultMiddle
 
   poolSettings <- maybe (fail "Improper session settings") return $
     H.poolSettings (fromIntegral $ configPool conf) 30
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index 03ba3dcb7..cc9fb3fa8 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -10,10 +10,9 @@ import qualified Hasql                         as H
 import qualified Hasql.Postgres                as P
 
 import           Network.HTTP.Types.Header     (hAccept, hAuthorization)
-import           Network.HTTP.Types.Status     (status403, status415)
-import           Network.Wai                   (Application, Request (..),
-                                                Response, isSecure, requestHeaders,
-                                                responseLBS)
+import           Network.HTTP.Types.Status     (status415)
+import           Network.Wai                   (Application, Request (..), Response,
+                                                requestHeaders, responseLBS)
 import           Network.Wai.Middleware.Cors   (cors)
 import           Network.Wai.Middleware.Gzip   (def, gzip)
 import           Network.Wai.Middleware.Static (only, staticPolicy)
@@ -50,15 +49,6 @@ runWithClaims conf app req = do
             else setRole anon : jwtEnv
    jwtEnv = claimsToSQL claims
 
-checkInsecure :: Application -> Application
-checkInsecure app req respond =
-  if not (isSecure req || isHerokuSecure)
-    then respond $ responseLBS status403 [] "SSL is required"
-    else app req respond
-  where
-    hdrs = requestHeaders req
-    isHerokuSecure = lookup "x-forwarded-proto" hdrs == Just "https"
-
 unsupportedAccept :: Application -> Application
 unsupportedAccept app req respond = do
   let
@@ -67,8 +57,9 @@ unsupportedAccept app req respond = do
   then respond $ responseLBS status415 [] "Unsupported Accept header, try: application/json"
   else app req respond
 
-defaultMiddle :: Bool -> Application -> Application
-defaultMiddle secure = (if secure then checkInsecure else id)
-  . gzip def . cors corsPolicy
+defaultMiddle :: Application -> Application
+defaultMiddle =
+    gzip def
+  . cors corsPolicy
   . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
   . unsupportedAccept
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index 1a0dae557..f99af00de 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -41,7 +41,7 @@ isLeft (Left _ ) = True
 isLeft _ = False
 
 cfg :: AppConfig
-cfg = AppConfig dbString 3000 "postgrest_anonymous" "test" False "safe" 10
+cfg = AppConfig dbString 3000 "postgrest_anonymous" "test" "safe" 10
 
 testPoolOpts :: PoolSettings
 testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30
@@ -78,7 +78,7 @@ withApp perform = do
       $ runWithClaims cfg (app dbstructure cfg body) req
     either (resp . errResponse) resp result
 
-  where middle = defaultMiddle False
+  where middle = defaultMiddle
 
 
 resetDb :: IO ()

From 62cb8e0453ae8964b6d78b20938db5fd31d00b9e Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Wed, 11 Nov 2015 08:34:50 -0500
Subject: [PATCH 67/81] Cleanup JWT expires

---
 src/PostgREST/Auth.hs       |  5 +++--
 src/PostgREST/Main.hs       |  5 +----
 src/PostgREST/Middleware.hs | 13 ++++++++-----
 test/SpecHelper.hs          |  4 +---
 4 files changed, 13 insertions(+), 14 deletions(-)

diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index e8b1e2f47..a608b684c 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -18,6 +18,7 @@ module PostgREST.Auth (
   , tokenJWT
   ) where
 
+import           Control.Monad           (join)
 import           Data.Aeson              (Value (..), Object)
 import           Data.Aeson.Types        (emptyObject, emptyArray)
 import           Data.Vector             as V (null, head)
@@ -52,8 +53,8 @@ claimsToSQL = map setVar . toList
 -}
 jwtClaims :: Text -> Text -> NominalDiffTime -> Maybe JWT.ClaimsMap
 jwtClaims secret input time =
-  case claim JWT.exp of
-    Just (Just expires) ->
+  case join $ claim JWT.exp of
+    Just expires ->
       if JWT.secondsSinceEpoch expires > time
         then customClaims
         else Nothing
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index f51a936ae..1a49e9862 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -2,7 +2,6 @@ module Main where
 
 
 import           PostgREST.App
--- import PostgREST.QueryBuilder
 import           PostgREST.Config                     (AppConfig (..),
                                                        minimumPgVersion,
                                                        prettyVersion,
@@ -24,7 +23,6 @@ import qualified Hasql.Postgres                       as P
 import           Network.Wai
 import           Network.Wai.Handler.Warp             hiding (Connection)
 import           Network.Wai.Middleware.RequestLogger (logStdout)
-import           Data.Time.Clock.POSIX                (getPOSIXTime)
 import           System.IO                            (BufferMode (..),
                                                        hSetBuffering, stderr,
                                                        stdin, stdout)
@@ -99,8 +97,7 @@ main = do
   -- print $ findRelation (fakeRels ++ allRels) "test" "pg_source" "clients"
 
   runSettings appSettings $ middle $ \ req respond -> do
-    time <- getPOSIXTime
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf time (app dbstructure conf body) req
+      runWithClaims conf (app dbstructure conf body) req
     either (respond . errResponse) respond resOrError
diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index 9d4ea5fc4..3444fe167 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -7,7 +7,7 @@ import           Data.Maybe                    (fromMaybe, isNothing)
 import           Data.Monoid
 import           Data.Text
 import           Data.String.Conversions       (cs)
-import           Data.Time.Clock               (NominalDiffTime)
+import           Data.Time.Clock.POSIX         (getPOSIXTime)
 import qualified Hasql                         as H
 import qualified Hasql.Postgres                as P
 
@@ -27,17 +27,20 @@ import           PostgREST.App                 (contentTypeForAccept)
 import           PostgREST.Auth                (setRole, jwtClaims, claimsToSQL)
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 
+import           System.IO.Unsafe              (unsafePerformIO)
+
 import           Prelude hiding(concat)
 
 import qualified Data.Vector             as V
 import qualified Hasql.Backend           as B
 import qualified Data.Map.Lazy           as M
 
-runWithClaims :: forall s. AppConfig -> NominalDiffTime ->
+runWithClaims :: forall s. AppConfig ->
                  (Request -> H.Tx P.Postgres s Response) ->
                  Request -> H.Tx P.Postgres s Response
-runWithClaims conf time app req = do
+runWithClaims conf app req = do
     _ <- H.unitEx $ stmt setAnon
+    let time = unsafePerformIO getPOSIXTime
     case split (== ' ') (cs auth) of
       ("Bearer" : tokenStr : _) ->
         case jwtClaims jwtSecret tokenStr time of
@@ -50,13 +53,13 @@ runWithClaims conf time app req = do
           _ -> invalidJWT
       _ -> app req
   where
-    stmt = (flip $ flip B.Stmt V.empty) True
+    stmt c = B.Stmt c V.empty True
     hdrs = requestHeaders req
     jwtSecret = (cs $ configJwtSecret conf) :: Text
     auth = fromMaybe "" $ lookup hAuthorization hdrs
     anon = cs $ configAnonRole conf
     setAnon = setRole anon
-    invalidJWT = return $ responseLBS status400 [] "Invalid JWT"
+    invalidJWT = return $ responseLBS status400 [("Content-Type","application/json")] "{\"message\":\"Invalid JWT\"}"
 
 redirectInsecure :: Application -> Application
 redirectInsecure app req respond = do
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index a7e97f812..62fb98694 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -11,7 +11,6 @@ import Hasql.Postgres as P
 import Data.String.Conversions (cs)
 import Data.Monoid
 import Data.Text hiding (map)
-import Data.Time.Clock.POSIX (getPOSIXTime)
 import qualified Data.Vector as V
 import Control.Monad (void)
 import Control.Applicative
@@ -74,10 +73,9 @@ withApp perform = do
         }
 
   perform $ middle $ \req resp -> do
-    time <- getPOSIXTime
     body <- strictRequestBody req
     result <- liftIO $ H.session pool $ H.tx txSettings
-      $ runWithClaims cfg time (app dbstructure cfg body) req
+      $ runWithClaims cfg (app dbstructure cfg body) req
     either (resp . errResponse) resp result
 
   where middle = defaultMiddle False

From 7560fafbab677638e4439ebca92d96ec65de0c7a Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Mon, 9 Nov 2015 17:42:53 -0500
Subject: [PATCH 68/81] Refactor DbStructure

- Rename `dbstructure` to `db` in App.hs
- Rename PgStructure* to DbStructure*
- Move `DbStructure` creation to DbStructure.hs
---
 postgrest.cabal                               |  6 +-
 src/PostgREST/App.hs                          | 12 ++--
 .../{PgStructure.hs => DbStructure.hs}        | 55 ++++++++++++-------
 src/PostgREST/Main.hs                         | 36 ++----------
 src/PostgREST/MainTest.hs                     |  8 +--
 src/PostgREST/PgQuery.hs                      |  2 +-
 src/PostgREST/QueryBuilder.hs                 | 14 ++---
 src/PostgREST/Types.hs                        | 20 ++++---
 test/Feature/StructureSpec.hs                 |  2 +
 test/SpecHelper.hs                            | 21 ++-----
 ...{PgStructureSpec.hx => DbStructureSpec.hx} |  4 +-
 11 files changed, 81 insertions(+), 99 deletions(-)
 rename src/PostgREST/{PgStructure.hs => DbStructure.hs} (85%)
 rename test/Unit/{PgStructureSpec.hx => DbStructureSpec.hx} (93%)

diff --git a/postgrest.cabal b/postgrest.cabal
index 83eff1d4e..9db15172a 100644
--- a/postgrest.cabal
+++ b/postgrest.cabal
@@ -70,7 +70,7 @@ executable postgrest
                      , PostgREST.Middleware
                      , PostgREST.Parsers
                      , PostgREST.PgQuery
-                     , PostgREST.PgStructure
+                     , PostgREST.DbStructure
                      , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
                      , PostgREST.Types
@@ -134,7 +134,7 @@ library
                      , PostgREST.Middleware
                      , PostgREST.Parsers
                      , PostgREST.PgQuery
-                     , PostgREST.PgStructure
+                     , PostgREST.DbStructure
                      , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
                      , PostgREST.Types
@@ -165,7 +165,7 @@ Test-Suite spec
                      , PostgREST.Middleware
                      , PostgREST.Parsers
                      , PostgREST.PgQuery
-                     , PostgREST.PgStructure
+                     , PostgREST.DbStructure
                      , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
                      , PostgREST.Types
diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 2f1bf4b67..2779c016d 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -46,7 +46,7 @@ import qualified Hasql.Postgres            as P
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.Parsers
 import           PostgREST.PgQuery
-import           PostgREST.PgStructure
+import           PostgREST.DbStructure
 import           PostgREST.QueryBuilder
 import           PostgREST.RangeQuery
 import           PostgREST.Types
@@ -55,7 +55,7 @@ import           PostgREST.Auth (tokenJWT)
 import           Prelude
 
 app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
-app dbstructure conf reqBody req =
+app db conf reqBody req =
   case (path, verb) of
 
     ([table], "GET") ->
@@ -160,9 +160,9 @@ app dbstructure conf reqBody req =
       return $ responseLBS status404 [] ""
 
   where
-    allRels = relations dbstructure
-    allCols = columns dbstructure
-    allPrKeys = primaryKeys dbstructure
+    allRels = relations db
+    allCols = columns db
+    allPrKeys = primaryKeys db
     filterCol sc table (Column{colSchema=s, colTable=t}) =  s==sc && table==t
     filterCol _ _ _ =  False
     filterPk sc table pk = sc == pkSchema pk && table == pkTable pk
@@ -332,7 +332,7 @@ addFilter (path, flt) (Node rn forest) =
       where maybeNode = find ((name==).fst.snd.rootLabel) forst
 
 toSourceRelation :: Text -> Relation -> Maybe Relation
-toSourceRelation mt r@(Relation _ t _ ft _ _ rt _ _)
+toSourceRelation mt r@(Relation _ t _ _ ft _ _ _ rt _ _)
   | mt == t = Just $ r {relTable=sourceSubqueryName}
   | mt == ft = Just $ r {relFTable=sourceSubqueryName}
   | Just mt == rt = Just $ r {relLTable=Just sourceSubqueryName}
diff --git a/src/PostgREST/PgStructure.hs b/src/PostgREST/DbStructure.hs
similarity index 85%
rename from src/PostgREST/PgStructure.hs
rename to src/PostgREST/DbStructure.hs
index 74d620078..911856202 100644
--- a/src/PostgREST/PgStructure.hs
+++ b/src/PostgREST/DbStructure.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
-module PostgREST.PgStructure where
+module PostgREST.DbStructure where
 
 import           Control.Applicative
 import           Control.Monad         (join)
@@ -21,6 +21,20 @@ import           PostgREST.Types
 import           GHC.Exts              (groupWith)
 import           Prelude
 
+createDbStructure :: H.Tx P.Postgres s DbStructure
+createDbStructure = do
+  tabs <- allTables
+  rels <- allRelations
+  cols <- allColumns rels
+  keys <- allPrimaryKeys
+
+  return DbStructure {
+      tables = tabs
+    , columns = cols
+    , relations = rels
+    , primaryKeys = keys
+    }
+
 doesProc :: forall c s. B.CxValue c Int =>
             (Text -> Text -> B.Stmt c) -> Text -> Text -> H.Tx c s Bool
 doesProc stmt schema proc = do
@@ -64,15 +78,15 @@ columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) =
     parseEnum str = fromMaybe [] $ split (==',') <$> str
 
 
-relationFromRow :: (Text, Text, [Text], Text, [Text]) -> Relation
-relationFromRow (s, t, cs, ft, fcs) = Relation s t cs ft fcs Child Nothing Nothing Nothing
+relationFromRow :: (Text, Text, [Text], Text, Text, [Text]) -> Relation
+relationFromRow (s, t, cs, fs, ft, fcs) = Relation s t cs fs ft fcs Child Nothing Nothing Nothing Nothing
 
 pkFromRow :: (Text, Text, Text) -> PrimaryKey
 pkFromRow (s, t, n) = PrimaryKey s t n
 
 
 addParentRelation :: Relation -> [Relation] -> [Relation]
-addParentRelation rel@(Relation s t c ft fc _ _ _ _) rels = Relation s ft fc t c Parent Nothing Nothing Nothing:rel:rels
+addParentRelation rel@(Relation s t c fs ft fc _ _ _ _ _) rels = Relation fs ft fc s t c Parent Nothing Nothing Nothing Nothing:rel:rels
 
 -- allTables :: H.Tx P.Postgres s [Table]
 -- allTables = do
@@ -135,9 +149,10 @@ allRelations :: H.Tx P.Postgres s [Relation]
 allRelations = do
   rels <- H.listEx $ [H.stmt|
     WITH table_fk AS (
-        SELECT ns.nspname AS table_schema,
+        SELECT ns1.nspname AS table_schema,
                tab.relname AS table_name,
                column_info.cols AS columns,
+               ns2.nspname AS foreign_table_schema,
                other.relname AS foreign_table_name,
                column_info.refs AS foreign_columns
         FROM pg_constraint,
@@ -152,10 +167,10 @@ allRelations = do
                                      WHERE attrelid = confrelid AND attnum = ref)
                                 AS refs)
                 AS column_info,
-           LATERAL (SELECT * FROM pg_namespace
-                            WHERE pg_namespace.oid = connamespace) AS ns,
+           LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
            LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
-           LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other
+           LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
+           LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
         WHERE confrelid != 0
         ORDER BY (conrelid, column_info.nums)
     )
@@ -167,33 +182,35 @@ allRelations = do
             vcu.table_schema,
             vcu.view_name AS table_name,
             array_agg(vcu.column_name::text) AS columns,
+            table_fk.foreign_table_schema,
             table_fk.foreign_table_name,
             table_fk.foreign_columns
-        FROM information_schema.view_column_usage as vcu
+        FROM information_schema.view_column_usage AS vcu
         JOIN table_fk ON
             table_fk.table_schema = vcu.view_schema AND
             table_fk.table_name = vcu.table_name AND
             vcu.column_name = ANY (table_fk.columns)
         WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
         AND columns = table_fk.columns
-        GROUP BY vcu.table_schema, vcu.view_name, table_fk.foreign_table_name, table_fk.foreign_columns
+        GROUP BY vcu.table_schema, vcu.view_name, table_fk.foreign_table_schema, table_fk.foreign_table_name, table_fk.foreign_columns
     )
     UNION
     (
         SELECT
-            vcu.view_schema as table_schema,
+            table_fk.table_schema,
             table_fk.table_name,
             table_fk.columns,
-            vcu.view_name as foreign_table_name,
-            array_agg(vcu.column_name::text) as foreign_columns
-        FROM information_schema.view_column_usage as vcu
+            vcu.view_schema AS foreign_table_schema,
+            vcu.view_name AS foreign_table_name,
+            array_agg(vcu.column_name::text) AS foreign_columns
+        FROM information_schema.view_column_usage AS vcu
         JOIN table_fk ON
             table_fk.table_schema = vcu.view_schema AND
             table_fk.foreign_table_name = vcu.table_name AND
             vcu.column_name = ANY (table_fk.foreign_columns)
         WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
             AND foreign_columns = table_fk.foreign_columns
-        GROUP BY vcu.view_schema, table_fk.table_name, vcu.view_name, table_fk.columns
+        GROUP BY table_fk.table_schema, table_fk.table_name, vcu.view_schema, vcu.view_name, table_fk.columns
     )
   |]
   let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
@@ -204,10 +221,10 @@ allRelations = do
     groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
     combinations k ns = filter ((k==).length) (subsequences ns)
     link2Relation [
-      Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c},
-      Relation{                           relColumns=lc2, relFTable=ft, relFColumns=fc}
+      Relation{relSchema=ls, relTable=lt, relColumns=lc1, relFSchema=s,  relFTable=t,  relFColumns=c},
+      Relation{                           relColumns=lc2, relFSchema=fs, relFTable=ft, relFColumns=fc}
       ]
-      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
+      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation s t c fs ft fc Many (Just ls) (Just lt) (Just lc1) (Just lc2)
       | otherwise = Nothing
     link2Relation _ = Nothing
 
@@ -264,7 +281,7 @@ allColumns rels = do
     lookupFn (Column{colSchema=cs, colTable=ct, colName=cn})  (Relation{relSchema=rs, relTable=rt, relColumns=rc, relType=rty}) =
       cs==rs && ct==rt && cn `elem` rc && rty==Child
     lookupFn _ _ = False
-    relToFk cName (Relation{relFTable=t, relColumns=cs, relFColumns=fcs}) = ForeignKey t <$> c
+    relToFk cName (Relation{relSchema=s, relFTable=t, relColumns=cs, relFColumns=fcs}) = ForeignKey s t <$> c
       where
         pos = elemIndex cName cs
         c = (fcs !!) <$> pos
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index 311e895cc..53cf2b917 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -2,14 +2,13 @@ module Main where
 
 
 import           PostgREST.App
--- import PostgREST.QueryBuilder
 import           PostgREST.Config                     (AppConfig (..),
                                                        minimumPgVersion,
                                                        prettyVersion,
                                                        readOptions)
 import           PostgREST.Error                      (errResponse, PgError)
 import           PostgREST.Middleware
-import           PostgREST.PgStructure
+import           PostgREST.DbStructure
 import           PostgREST.Types
 
 import           Control.Monad                        (unless)
@@ -27,7 +26,6 @@ import           Network.Wai.Middleware.RequestLogger (logStdout)
 import           System.IO                            (BufferMode (..),
                                                        hSetBuffering, stderr,
                                                        stdin, stdout)
--- import Data.Maybe (mapMaybe)
 
 isServerVersionSupported :: H.Session P.Postgres IO Bool
 isServerVersionSupported = do
@@ -70,38 +68,12 @@ main = do
           <> show minimumPgVersion)
     ) supportedOrError
 
-  -- what was this code for?
-  -- roleOrError <- H.session pool $ do
-  --   Identity (role :: Text) <- H.tx Nothing $ H.singleEx
-  --     [H.stmt|SELECT SESSION_USER|]
-  --   return role
-  -- authenticator <- either hasqlError return roleOrError
-
   let txSettings = Just (H.ReadCommitted, Just True)
-  metadata <- H.session pool $ H.tx txSettings $ do
-    rels <- allRelations
-    cols <- allColumns rels
-    keys <- allPrimaryKeys
-    return (rels, cols, keys)
-
-
-  dbstructure <- either hasqlError
-    (\(rels, cols, keys) ->
-
-      return DbStructure {
-          columns=cols
-        , relations=rels
-        , primaryKeys=keys
-        }
-    ) metadata
-
-  -- let allRels = relations dbstructure
-  --     fakeRels = mapMaybe (toSourceRelation "projects") allRels
-  --
-  -- print $ findRelation (fakeRels ++ allRels) "test" "pg_source" "clients"
+  dbOrError <- H.session pool $ H.tx txSettings createDbStructure
+  db <- either hasqlError return dbOrError
 
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf (app dbstructure conf body) req
+      runWithClaims conf (app db conf body) req
     either (respond . errResponse) respond resOrError
diff --git a/src/PostgREST/MainTest.hs b/src/PostgREST/MainTest.hs
index 55ebec5bc..45326d33d 100644
--- a/src/PostgREST/MainTest.hs
+++ b/src/PostgREST/MainTest.hs
@@ -8,7 +8,7 @@ import           PostgREST.Config                     (AppConfig (..),
                                                        readOptions)
 import           PostgREST.Error                      (errResponse, PgError)
 import           PostgREST.Middleware
-import           PostgREST.PgStructure
+import           PostgREST.DbStructure
 import           PostgREST.Types
 
 import           Control.Monad                        (unless)
@@ -94,7 +94,7 @@ main = do
     return (tabs, rels, cols, keys)
 
 
-  dbstructure <- either hasqlError
+  db <- either hasqlError
     (\(tabs, rels, cols, keys) ->
 
       return DbStructure {
@@ -107,10 +107,10 @@ main = do
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf (app dbstructure conf body) req
+      runWithClaims conf (app db conf body) req
     either (respond . errResponse) respond resOrError
 
-  --let allRels = relations dbstructure
+  --let allRels = relations db
       -- links = join $ map (combinations 2) $ filter ((>=1).length) $ groupWith groupFn $ filter ( (==Child). relType) allRels
       -- combinations k ns = filter ((k==).length) (subsequences ns)
 
diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index 9d66f6ecb..62cf96df7 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -281,7 +281,7 @@ pgFmtCondition table (Filter (col,jp) ops val) =
       _      -> ""
     valToStr v = case v of
       VText s -> pgFmtValue opCode s
-      VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn qi fc
+      VForeignKey (QualifiedIdentifier s _) (ForeignKey _ ft fc) -> pgFmtColumn qi fc
         where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
 
 pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index cd04960fa..27799ac99 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -35,14 +35,14 @@ addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) for
     updatedForest = mapM (addRelations schema allRelations (Just node)) forest
 
 getJoinConditions :: Relation -> [Filter]
-getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) =
+getJoinConditions (Relation s t cs fs ft fcs typ ls lt lc1 lc2) =
   case typ of
-    Child  -> zipWith (toFilter t ft) cs fcs
-    Parent -> zipWith (toFilter t ft) cs fcs
-    Many   -> zipWith (toFilter t (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" lt)) fcs (fromMaybe [] lc2)
+    Child  -> zipWith (toFilter t fs ft) cs fcs
+    Parent -> zipWith (toFilter t fs ft) cs fcs
+    Many   -> zipWith (toFilter t (fromMaybe "" ls) (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" ls) (fromMaybe "" lt)) fcs (fromMaybe [] lc2)
   where
-    toFilter :: Text -> Text -> FieldName -> FieldName -> Filter
-    toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc))
+    toFilter :: Text -> Text -> Text -> FieldName -> FieldName -> Filter
+    toFilter tb fsc ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fsc ftb fc))
 
 addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest
 addJoinConditions schema (Node (query, (t, r)) forest) =
@@ -55,7 +55,7 @@ addJoinConditions schema (Node (query, (t, r)) forest) =
       where
          q = addCond updatedQuery (getJoinConditions rel)
          qq = q{from=linkTable:from q}
-    _ -> Left "unknow relation"
+    _ -> Left "unknown relation"
   where
     -- add parentTable and parentJoinConditions to the query
     updatedQuery = foldr (flip addCond) (query{from = parentTables ++ from query}) parentJoinConditions
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
index 691efad99..a65835473 100644
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -19,7 +19,9 @@ data Table = Table {
 } deriving (Show)
 
 data ForeignKey = ForeignKey {
-  fkTable::Text, fkCol::Text
+  fkSchema :: Text,
+  fkTable :: Text,
+  fkCol :: Text
 } deriving (Show, Eq)
 
 
@@ -36,7 +38,7 @@ data Column = Column {
 , colDefault :: Maybe Text
 , colEnum :: [Text]
 , colFK :: Maybe ForeignKey
-} | Star {colSchema :: Text, colTable :: Text } deriving (Show)
+} | Star { colSchema :: Text, colTable :: Text } deriving (Show)
 
 data PrimaryKey = PrimaryKey {
   pkSchema::Text, pkTable::Text, pkName::Text
@@ -56,13 +58,15 @@ data QualifiedIdentifier = QualifiedIdentifier {
 
 data RelationType = Child | Parent | Many deriving (Show, Eq)
 data Relation = Relation {
-  relSchema  :: Text
-, relTable   :: Text
+  relSchema   :: Text
+, relTable    :: Text
 , relColumns  :: [Text]
-, relFTable  :: Text
+, relFSchema  :: Text
+, relFTable   :: Text
 , relFColumns :: [Text]
-, relType    :: RelationType
-, relLTable  :: Maybe Text
+, relType     :: RelationType
+, relLSchema  :: Maybe Text
+, relLTable   :: Maybe Text
 , relLCols1   :: Maybe [Text]
 , relLCols2   :: Maybe [Text]
 } deriving (Show, Eq)
@@ -101,7 +105,7 @@ instance ToJSON Column where
     , "enum"      .= colEnum c ]
 
 instance ToJSON ForeignKey where
-  toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
+  toJSON fk = object ["schema".=fkSchema fk, "table".=fkTable fk, "column".=fkCol fk]
 
 instance ToJSON Table where
   toJSON v = object [
diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs
index 2a28f43db..148a1ca1b 100644
--- a/test/Feature/StructureSpec.hs
+++ b/test/Feature/StructureSpec.hs
@@ -175,6 +175,7 @@ spec = around withApp $ do
             },
             {
                "references":{
+                  "schema":"test",
                   "column":"id",
                   "table":"auto_incrementing_pk"
                },
@@ -191,6 +192,7 @@ spec = around withApp $ do
             },
             {
                "references":{
+                  "schema":"test",
                   "column":"k",
                   "table":"simple_pk"
                },
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index 45cbcbe96..dcc765f0d 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -30,8 +30,7 @@ import PostgREST.App (app)
 import PostgREST.Config (AppConfig(..))
 import PostgREST.Middleware
 import PostgREST.Error(errResponse)
-import PostgREST.PgStructure
-import PostgREST.Types
+import PostgREST.DbStructure
 
 dbString :: String
 dbString = "postgres://postgrest_test@localhost:5432/postgrest_test"
@@ -55,25 +54,13 @@ withApp perform = do
     <- H.acquirePool pgSettings testPoolOpts
 
   let txSettings = Just (H.ReadCommitted, Just True)
-  metadata <- H.session pool $ H.tx txSettings $ do
-    rels <- allRelations
-    cols <- allColumns rels
-    keys <- allPrimaryKeys
-    return (rels, cols, keys)
-
-  dbstructure <- case metadata of
-    Left e -> fail $ show e
-    Right (rels, cols, keys) ->
-      return DbStructure {
-          columns=cols
-        , relations=rels
-        , primaryKeys=keys
-        }
+  dbOrError <- H.session pool $ H.tx txSettings createDbStructure
+  db <- either (fail . show) return dbOrError
 
   perform $ middle $ \req resp -> do
     body <- strictRequestBody req
     result <- liftIO $ H.session pool $ H.tx txSettings
-      $ runWithClaims cfg (app dbstructure cfg body) req
+      $ runWithClaims cfg (app db cfg body) req
     either (resp . errResponse) resp result
 
   where middle = defaultMiddle
diff --git a/test/Unit/PgStructureSpec.hx b/test/Unit/DbStructureSpec.hx
similarity index 93%
rename from test/Unit/PgStructureSpec.hx
rename to test/Unit/DbStructureSpec.hx
index b1c1570dd..6a8a9e4de 100644
--- a/test/Unit/PgStructureSpec.hx
+++ b/test/Unit/DbStructureSpec.hx
@@ -1,7 +1,7 @@
-module Unit.PgStructureSpec where
+module Unit.DbStructureSpec where
 
 import Test.Hspec
-import PgStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
+import DbStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
   foreignKeys)
 
 import Database.HDBC (quickQuery)

From 3a682360f33392665fb4093191727080103bb2e1 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Mon, 9 Nov 2015 17:50:56 -0500
Subject: [PATCH 69/81] Remove view relations from sql statement

---
 src/PostgREST/DbStructure.hs | 132 ++++++++++-------------------------
 1 file changed, 37 insertions(+), 95 deletions(-)

diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs
index 911856202..3a8a36e48 100644
--- a/src/PostgREST/DbStructure.hs
+++ b/src/PostgREST/DbStructure.hs
@@ -148,70 +148,30 @@ tables schema = do
 allRelations :: H.Tx P.Postgres s [Relation]
 allRelations = do
   rels <- H.listEx $ [H.stmt|
-    WITH table_fk AS (
-        SELECT ns1.nspname AS table_schema,
-               tab.relname AS table_name,
-               column_info.cols AS columns,
-               ns2.nspname AS foreign_table_schema,
-               other.relname AS foreign_table_name,
-               column_info.refs AS foreign_columns
-        FROM pg_constraint,
-           LATERAL (SELECT array_agg(cols.attname) AS cols,
-                           array_agg(cols.attnum)  AS nums,
-                           array_agg(refs.attname) AS refs
-                      FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
-                           LATERAL (SELECT * FROM pg_attribute
-                                     WHERE attrelid = conrelid AND attnum = col)
-                                AS cols,
-                           LATERAL (SELECT * FROM pg_attribute
-                                     WHERE attrelid = confrelid AND attnum = ref)
-                                AS refs)
-                AS column_info,
-           LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
-           LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
-           LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
-           LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
-        WHERE confrelid != 0
-        ORDER BY (conrelid, column_info.nums)
-    )
-
-    SELECT * FROM table_fk
-    UNION
-    (
-        SELECT
-            vcu.table_schema,
-            vcu.view_name AS table_name,
-            array_agg(vcu.column_name::text) AS columns,
-            table_fk.foreign_table_schema,
-            table_fk.foreign_table_name,
-            table_fk.foreign_columns
-        FROM information_schema.view_column_usage AS vcu
-        JOIN table_fk ON
-            table_fk.table_schema = vcu.view_schema AND
-            table_fk.table_name = vcu.table_name AND
-            vcu.column_name = ANY (table_fk.columns)
-        WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
-        AND columns = table_fk.columns
-        GROUP BY vcu.table_schema, vcu.view_name, table_fk.foreign_table_schema, table_fk.foreign_table_name, table_fk.foreign_columns
-    )
-    UNION
-    (
-        SELECT
-            table_fk.table_schema,
-            table_fk.table_name,
-            table_fk.columns,
-            vcu.view_schema AS foreign_table_schema,
-            vcu.view_name AS foreign_table_name,
-            array_agg(vcu.column_name::text) AS foreign_columns
-        FROM information_schema.view_column_usage AS vcu
-        JOIN table_fk ON
-            table_fk.table_schema = vcu.view_schema AND
-            table_fk.foreign_table_name = vcu.table_name AND
-            vcu.column_name = ANY (table_fk.foreign_columns)
-        WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
-            AND foreign_columns = table_fk.foreign_columns
-        GROUP BY table_fk.table_schema, table_fk.table_name, vcu.view_schema, vcu.view_name, table_fk.columns
-    )
+    SELECT ns1.nspname AS table_schema,
+           tab.relname AS table_name,
+           column_info.cols AS columns,
+           ns2.nspname AS foreign_table_schema,
+           other.relname AS foreign_table_name,
+           column_info.refs AS foreign_columns
+    FROM pg_constraint,
+       LATERAL (SELECT array_agg(cols.attname) AS cols,
+                       array_agg(cols.attnum)  AS nums,
+                       array_agg(refs.attname) AS refs
+                  FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
+                       LATERAL (SELECT * FROM pg_attribute
+                                 WHERE attrelid = conrelid AND attnum = col)
+                            AS cols,
+                       LATERAL (SELECT * FROM pg_attribute
+                                 WHERE attrelid = confrelid AND attnum = ref)
+                            AS refs)
+            AS column_info,
+       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
+       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
+       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
+       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
+    WHERE confrelid != 0
+    ORDER BY (conrelid, column_info.nums)
   |]
   let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
       links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
@@ -289,36 +249,18 @@ allColumns rels = do
 allPrimaryKeys :: H.Tx P.Postgres s [PrimaryKey]
 allPrimaryKeys = do
   pks <- H.listEx $ [H.stmt|
-    WITH table_pk AS (
-        SELECT
-            kc.table_schema,
-            kc.table_name,
-            kc.column_name
-        FROM
-            information_schema.table_constraints tc,
-            information_schema.key_column_usage kc
-        WHERE
-            tc.constraint_type = 'PRIMARY KEY' AND
-            kc.table_name = tc.table_name AND
-            kc.table_schema = tc.table_schema AND
-            kc.constraint_name = tc.constraint_name AND
-            kc.table_schema NOT IN ('pg_catalog', 'information_schema')
-    )
-    SELECT table_schema,
-           table_name,
-           column_name
-    FROM table_pk
-    UNION (
-        SELECT
-            vcu.view_schema,
-            vcu.view_name,
-            vcu.column_name
-         FROM information_schema.view_column_usage AS vcu
-         JOIN
-            table_pk ON table_pk.table_schema = vcu.view_schema AND
-            table_pk.table_name = vcu.table_name AND
-            table_pk.column_name = vcu.column_name
-         WHERE vcu.view_schema NOT IN ('pg_catalog','information_schema')
-    )
+    SELECT
+        kc.table_schema,
+        kc.table_name,
+        kc.column_name
+    FROM
+        information_schema.table_constraints tc,
+        information_schema.key_column_usage kc
+    WHERE
+        tc.constraint_type = 'PRIMARY KEY' AND
+        kc.table_name = tc.table_name AND
+        kc.table_schema = tc.table_schema AND
+        kc.constraint_name = tc.constraint_name AND
+        kc.table_schema NOT IN ('pg_catalog', 'information_schema')
     |]
   return $ map pkFromRow pks

From e1e4fe6d5c0f4a889678566574c5fecb990b0d5f Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Tue, 10 Nov 2015 18:49:30 -0500
Subject: [PATCH 70/81] Types reference each other

---
 src/PostgREST/App.hs          |  16 +--
 src/PostgREST/DbStructure.hs  | 245 ++++++++++++++++------------------
 src/PostgREST/PgQuery.hs      |   3 +-
 src/PostgREST/QueryBuilder.hs |  26 ++--
 src/PostgREST/Types.hs        |  82 ++++++------
 5 files changed, 178 insertions(+), 194 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 2779c016d..f3f914109 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -163,9 +163,9 @@ app db conf reqBody req =
     allRels = relations db
     allCols = columns db
     allPrKeys = primaryKeys db
-    filterCol sc table (Column{colSchema=s, colTable=t}) =  s==sc && table==t
+    filterCol sc table (Column{colTable=Table{tableSchema=s, tableName=t}}) = s==sc && table==t
     filterCol _ _ _ =  False
-    filterPk sc table pk = sc == pkSchema pk && table == pkTable pk
+    filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
     path          = pathInfo req
     verb          = requestMethod req
     hdrs          = requestHeaders req
@@ -289,7 +289,7 @@ convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized)
         a@(Array _) -> Right a
         _ -> Left invalidMsg
 
-augumentRequestWithJoin :: Text ->  [Relation] ->  ApiRequest -> Either Text ApiRequest
+augumentRequestWithJoin :: Schema ->  [Relation] ->  ApiRequest -> Either Text ApiRequest
 augumentRequestWithJoin schema allRels request =
   (first formatRelationError . addRelations schema allRels Nothing) request
   >>= addJoinConditions schema
@@ -332,10 +332,10 @@ addFilter (path, flt) (Node rn forest) =
       where maybeNode = find ((name==).fst.snd.rootLabel) forst
 
 toSourceRelation :: Text -> Relation -> Maybe Relation
-toSourceRelation mt r@(Relation _ t _ _ ft _ _ _ rt _ _)
-  | mt == t = Just $ r {relTable=sourceSubqueryName}
-  | mt == ft = Just $ r {relFTable=sourceSubqueryName}
-  | Just mt == rt = Just $ r {relLTable=Just sourceSubqueryName}
+toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
+  | mt == tableName t = Just $ r {relTable=t {tableName=sourceSubqueryName}}
+  | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceSubqueryName}}
+  | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceSubqueryName}) <$> rt}
   | otherwise = Nothing
 
 data TableOptions = TableOptions {
@@ -348,7 +348,7 @@ instance ToJSON TableOptions where
       "columns" .= tblOptcolumns t
     , "pkey"   .= tblOptpkey t ]
 
-parseRequest :: Text -> [Relation] -> NodeName -> Request -> BL.ByteString -> Either Text (Text, Text, Bool)
+parseRequest :: Schema -> [Relation] -> NodeName -> Request -> BL.ByteString -> Either Text (Text, Text, Bool)
 parseRequest schema allRels rootTableName httpRequest reqBody =
   (,,) <$> selectQuery
        <*> (if method == "GET" then pure "" else mutateQuery)
diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs
index 3a8a36e48..6949a9412 100644
--- a/src/PostgREST/DbStructure.hs
+++ b/src/PostgREST/DbStructure.hs
@@ -3,13 +3,17 @@
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
-module PostgREST.DbStructure where
+module PostgREST.DbStructure (
+  createDbStructure
+, doesProcExist
+, doesProcReturnJWT
+) where
 
 import           Control.Applicative
 import           Control.Monad         (join)
 import           Data.Functor.Identity
 import           Data.List             (elemIndex, find, subsequences)
-import           Data.Maybe            (fromMaybe, isJust, mapMaybe)
+import           Data.Maybe            (fromMaybe, fromJust, isJust, mapMaybe)
 import           Data.Monoid
 import           Data.Text             (Text, split)
 import qualified Hasql                 as H
@@ -24,13 +28,13 @@ import           Prelude
 createDbStructure :: H.Tx P.Postgres s DbStructure
 createDbStructure = do
   tabs <- allTables
-  rels <- allRelations
-  cols <- allColumns rels
-  keys <- allPrimaryKeys
+  cols <- allColumns tabs
+  rels <- allRelations tabs cols
+  keys <- allPrimaryKeys tabs
 
   return DbStructure {
       tables = tabs
-    , columns = cols
+    , columns = addForeignKeys rels cols
     , relations = rels
     , primaryKeys = keys
     }
@@ -62,135 +66,79 @@ doesProcReturnJWT = doesProc [H.stmt|
       AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
     |]
 
-tableFromRow :: (Text, Text, Bool) -> Table
-tableFromRow (s, n, i) = Table s n i
+addForeignKeys :: [Relation] -> [Column] -> [Column]
+addForeignKeys rels = map addFk
+  where
+    addFk col = col { colFK = fk col }
+    fk col = join $ relToFk col <$> find (lookupFn col) rels
+    lookupFn :: Column -> Relation -> Bool
+    lookupFn c (Relation{relColumns=cs, relType=rty}) = c `elem` cs && rty==Child
+    -- lookupFn _ _ = False
+    relToFk col (Relation{relColumns=cols, relFColumns=colsF}) = ForeignKey <$> colF
+      where
+        pos = elemIndex col cols
+        colF = (colsF !!) <$> pos
 
-columnFromRow :: (Text,       Text,      Text,
+columnFromRow :: [Table] ->
+                 (Text,       Text,      Text,
                   Int,        Bool,      Text,
                   Bool,       Maybe Int, Maybe Int,
                   Maybe Text, Maybe Text)
-              -> Column
-columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) =
-  Column s t n pos nul typ u l p d (parseEnum e) Nothing
-
+                 -> Column
+columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) =
+  Column table n pos nul typ u l p d (parseEnum e) Nothing
   where
+    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
     parseEnum :: Maybe Text -> [Text]
     parseEnum str = fromMaybe [] $ split (==',') <$> str
 
 
-relationFromRow :: (Text, Text, [Text], Text, Text, [Text]) -> Relation
-relationFromRow (s, t, cs, fs, ft, fcs) = Relation s t cs fs ft fcs Child Nothing Nothing Nothing Nothing
+relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Relation
+relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) = Relation table cols tableF colsF Child Nothing Nothing Nothing
+  where
+    findTable s t = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
+    findCols s t cs = filter (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col `elem` cs) allCols
+    table  = findTable rs rt
+    tableF = findTable frs frt
+    cols  = findCols rs rt rcs
+    colsF = findCols frs frt frcs
 
-pkFromRow :: (Text, Text, Text) -> PrimaryKey
-pkFromRow (s, t, n) = PrimaryKey s t n
+pkFromRow :: [Table] -> (Schema, Text, Text) -> PrimaryKey
+pkFromRow tabs (s, t, n) = PrimaryKey table n
+  where
+    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
 
 
 addParentRelation :: Relation -> [Relation] -> [Relation]
-addParentRelation rel@(Relation s t c fs ft fc _ _ _ _ _) rels = Relation fs ft fc s t c Parent Nothing Nothing Nothing Nothing:rel:rels
+addParentRelation rel@(Relation t c ft fc _ _ _ _) rels = Relation ft fc t c Parent Nothing Nothing Nothing : rel : rels
 
--- allTables :: H.Tx P.Postgres s [Table]
--- allTables = do
---     rows <- H.listEx $ [H.stmt|
---       SELECT
---         n.nspname AS table_schema,
---         c.relname AS table_name,
---         c.relkind = 'r' OR (c.relkind IN ('v','f'))
---         AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
---         OR (EXISTS
---           ( SELECT 1
---             FROM pg_trigger
---             WHERE pg_trigger.tgrelid = c.oid
---             AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable,
---         array_to_string(array_agg(r.rolname), ',') AS acl
---       FROM pg_class c
---       CROSS JOIN pg_roles r
---       JOIN pg_namespace n ON n.oid = c.relnamespace
---       WHERE c.relkind IN ('v','r','m')
---         AND n.nspname NOT IN ('pg_catalog', 'information_schema')
---         AND (
---           pg_has_role(r.rolname, c.relowner, 'USAGE'::text) OR
---           has_table_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR
---           has_any_column_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text) )
---
---       GROUP BY table_schema, table_name, insertable
---       ORDER BY table_schema, table_name
---     |]
---     return $ map tableFromRow rows
+allTables :: H.Tx P.Postgres s [Table]
+allTables = do
+    rows <- H.listEx $ [H.stmt|
+      SELECT
+        n.nspname AS table_schema,
+        c.relname AS table_name,
+        c.relkind = 'r' OR (c.relkind IN ('v','f'))
+        AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
+        OR (EXISTS
+          ( SELECT 1
+            FROM pg_trigger
+            WHERE pg_trigger.tgrelid = c.oid
+            AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable
+      FROM pg_class c
+      JOIN pg_namespace n ON n.oid = c.relnamespace
+      WHERE c.relkind IN ('v','r','m')
+        AND n.nspname NOT IN ('pg_catalog', 'information_schema')
+      GROUP BY table_schema, table_name, insertable
+      ORDER BY table_schema, table_name;
+    |]
+    return $ map tableFromRow rows
 
-tables :: Text -> H.Tx P.Postgres s [Table]
-tables schema = do
-  rows <- H.listEx $
-    [H.stmt|
-      select
-        n.nspname as table_schema,
-        relname as table_name,
-        c.relkind = 'r' or (c.relkind IN ('v', 'f')) and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8
-        or (exists (
-           select 1
-           from pg_trigger
-           where pg_trigger.tgrelid = c.oid and (pg_trigger.tgtype::integer & 69) = 69)
-        ) as insertable
-      from
-        pg_class c
-        join pg_namespace n on n.oid = c.relnamespace
-      where
-        c.relkind in ('v', 'r', 'm')
-        and n.nspname = ?
-        and (
-          pg_has_role(c.relowner, 'USAGE'::text)
-          or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text)
-          or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
-        )
-      order by relname
-    |] schema
-  return $ map tableFromRow rows
+tableFromRow :: (Text, Text, Bool) -> Table
+tableFromRow (s, n, i) = Table s n i
 
-allRelations :: H.Tx P.Postgres s [Relation]
-allRelations = do
-  rels <- H.listEx $ [H.stmt|
-    SELECT ns1.nspname AS table_schema,
-           tab.relname AS table_name,
-           column_info.cols AS columns,
-           ns2.nspname AS foreign_table_schema,
-           other.relname AS foreign_table_name,
-           column_info.refs AS foreign_columns
-    FROM pg_constraint,
-       LATERAL (SELECT array_agg(cols.attname) AS cols,
-                       array_agg(cols.attnum)  AS nums,
-                       array_agg(refs.attname) AS refs
-                  FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
-                       LATERAL (SELECT * FROM pg_attribute
-                                 WHERE attrelid = conrelid AND attnum = col)
-                            AS cols,
-                       LATERAL (SELECT * FROM pg_attribute
-                                 WHERE attrelid = confrelid AND attnum = ref)
-                            AS refs)
-            AS column_info,
-       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
-       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
-       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
-       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
-    WHERE confrelid != 0
-    ORDER BY (conrelid, column_info.nums)
-  |]
-  let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
-      links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
-  return $ simpleRelations ++ mapMaybe link2Relation links
-  where
-    groupFn :: Relation -> Text
-    groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
-    combinations k ns = filter ((k==).length) (subsequences ns)
-    link2Relation [
-      Relation{relSchema=ls, relTable=lt, relColumns=lc1, relFSchema=s,  relFTable=t,  relFColumns=c},
-      Relation{                           relColumns=lc2, relFSchema=fs, relFTable=ft, relFColumns=fc}
-      ]
-      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation s t c fs ft fc Many (Just ls) (Just lt) (Just lc1) (Just lc2)
-      | otherwise = Nothing
-    link2Relation _ = Nothing
-
-
-allColumns :: [Relation] -> H.Tx P.Postgres s [Column]
-allColumns rels = do
+allColumns :: [Table] -> H.Tx P.Postgres s [Column]
+allColumns tabs = do
   cols <- H.listEx $ [H.stmt|
       SELECT DISTINCT
           info.table_schema AS schema,
@@ -232,22 +180,53 @@ allColumns rels = do
       ) AS enum_info ON (info.udt_name = enum_info.n)
       ORDER BY schema, position
   |]
-  return $ map (addFK . columnFromRow) cols
+  return $ map (columnFromRow tabs) cols
 
+allRelations :: [Table] -> [Column] -> H.Tx P.Postgres s [Relation]
+allRelations tabs cols = do
+  rels <- H.listEx $ [H.stmt|
+    SELECT ns1.nspname AS table_schema,
+           tab.relname AS table_name,
+           column_info.cols AS columns,
+           ns2.nspname AS foreign_table_schema,
+           other.relname AS foreign_table_name,
+           column_info.refs AS foreign_columns
+    FROM pg_constraint,
+       LATERAL (SELECT array_agg(cols.attname) AS cols,
+                       array_agg(cols.attnum)  AS nums,
+                       array_agg(refs.attname) AS refs
+                  FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
+                       LATERAL (SELECT * FROM pg_attribute
+                                 WHERE attrelid = conrelid AND attnum = col)
+                            AS cols,
+                       LATERAL (SELECT * FROM pg_attribute
+                                 WHERE attrelid = confrelid AND attnum = ref)
+                            AS refs)
+            AS column_info,
+       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
+       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
+       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
+       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
+    WHERE confrelid != 0
+    ORDER BY (conrelid, column_info.nums)
+  |]
+  let simpleRelations = foldr (addParentRelation . relationFromRow tabs cols) [] rels
+      links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
+  return $ simpleRelations ++ mapMaybe link2Relation links
   where
-    addFK col = col { colFK = fk col }
-    fk col = join $ relToFk (colName col) <$> find (lookupFn col) rels
-    lookupFn :: Column -> Relation -> Bool
-    lookupFn (Column{colSchema=cs, colTable=ct, colName=cn})  (Relation{relSchema=rs, relTable=rt, relColumns=rc, relType=rty}) =
-      cs==rs && ct==rt && cn `elem` rc && rty==Child
-    lookupFn _ _ = False
-    relToFk cName (Relation{relSchema=s, relFTable=t, relColumns=cs, relFColumns=fcs}) = ForeignKey s t <$> c
-      where
-        pos = elemIndex cName cs
-        c = (fcs !!) <$> pos
+    groupFn :: Relation -> Text
+    groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t
+    combinations k ns = filter ((k==).length) (subsequences ns)
+    link2Relation [
+      Relation{relTable=lt, relColumns=lc1, relFTable=t,  relFColumns=c},
+      Relation{             relColumns=lc2, relFTable=ft, relFColumns=fc}
+      ]
+      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc Many (Just lt) (Just lc1) (Just lc2)
+      | otherwise = Nothing
+    link2Relation _ = Nothing
 
-allPrimaryKeys :: H.Tx P.Postgres s [PrimaryKey]
-allPrimaryKeys = do
+allPrimaryKeys :: [Table] -> H.Tx P.Postgres s [PrimaryKey]
+allPrimaryKeys tabs = do
   pks <- H.listEx $ [H.stmt|
     SELECT
         kc.table_schema,
@@ -263,4 +242,4 @@ allPrimaryKeys = do
         kc.constraint_name = tc.constraint_name AND
         kc.table_schema NOT IN ('pg_catalog', 'information_schema')
     |]
-  return $ map pkFromRow pks
+  return $ map (pkFromRow tabs) pks
diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs
index 62cf96df7..ebf68adea 100644
--- a/src/PostgREST/PgQuery.hs
+++ b/src/PostgREST/PgQuery.hs
@@ -281,8 +281,9 @@ pgFmtCondition table (Filter (col,jp) ops val) =
       _      -> ""
     valToStr v = case v of
       VText s -> pgFmtValue opCode s
-      VForeignKey (QualifiedIdentifier s _) (ForeignKey _ ft fc) -> pgFmtColumn qi fc
+      VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
         where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
+      _ -> ""
 
 pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
 pgFmtColumn table "*" = fromQi table <> ".*"
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index 27799ac99..679524e3e 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -7,7 +7,7 @@ import           Control.Error
 import           Data.List         (find)
 import           Data.Monoid
 import           Data.Text         hiding (filter, find, foldr, head, last, map,
-                                    null, zipWith)
+                                    null, zipWith, concatMap)
 import           Control.Applicative
 import           Data.Tree
 import           PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem,
@@ -16,11 +16,11 @@ import           PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem,
 import           PostgREST.Types
 import qualified Data.Map as M
 
-findRelation :: [Relation] -> Text -> Text -> Text -> Maybe Relation
+findRelation :: [Relation] -> Schema -> Text -> Text -> Maybe Relation
 findRelation allRelations s t1 t2 =
-  find (\r -> s == relSchema r && t1 == relTable r && t2 == relFTable r) allRelations
+  find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations
 
-addRelations :: Text -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
+addRelations :: Schema -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
 addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) =
   case parentNode of
     Nothing -> Node (query, (table, Nothing)) <$> updatedForest
@@ -35,14 +35,14 @@ addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) for
     updatedForest = mapM (addRelations schema allRelations (Just node)) forest
 
 getJoinConditions :: Relation -> [Filter]
-getJoinConditions (Relation s t cs fs ft fcs typ ls lt lc1 lc2) =
+getJoinConditions (Relation t cs ft fcs typ _ lc1 lc2) =
   case typ of
-    Child  -> zipWith (toFilter t fs ft) cs fcs
-    Parent -> zipWith (toFilter t fs ft) cs fcs
-    Many   -> zipWith (toFilter t (fromMaybe "" ls) (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" ls) (fromMaybe "" lt)) fcs (fromMaybe [] lc2)
+    Child  -> zipWith (toFilter t) cs fcs
+    Parent -> zipWith (toFilter t) cs fcs
+    Many   -> zipWith (toFilter t) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft) fcs (fromMaybe [] lc2)
   where
-    toFilter :: Text -> Text -> Text -> FieldName -> FieldName -> Filter
-    toFilter tb fsc ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fsc ftb fc))
+    toFilter :: Table -> Column -> Column -> Filter
+    toFilter tb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier (tableSchema tb) (tableName tb)) (ForeignKey fc))
 
 addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest
 addJoinConditions schema (Node (query, (t, r)) forest) =
@@ -54,15 +54,15 @@ addJoinConditions schema (Node (query, (t, r)) forest) =
       Node (qq, (t, r)) <$> updatedForest
       where
          q = addCond updatedQuery (getJoinConditions rel)
-         qq = q{from=linkTable:from q}
+         qq = q{from=tableName linkTable : from q}
     _ -> Left "unknown relation"
   where
     -- add parentTable and parentJoinConditions to the query
     updatedQuery = foldr (flip addCond) (query{from = parentTables ++ from query}) parentJoinConditions
       where
-        parentJoinConditions = map (getJoinConditions.snd) parents
+        parentJoinConditions = map (getJoinConditions . snd) parents
         parentTables = map fst parents
-        parents = mapMaybe (getParents.rootLabel) forest
+        parents = mapMaybe (getParents . rootLabel) forest
         getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel)
         getParents _ = Nothing
     updatedForest = mapM (addJoinConditions schema) forest
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
index a65835473..b7f60606f 100644
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -9,66 +9,62 @@ data DbStructure = DbStructure {
   columns :: [Column]
 , relations :: [Relation]
 , primaryKeys :: [PrimaryKey]
-}
+} deriving (Show, Eq)
 
+type Schema = Text
 
 data Table = Table {
-  tableSchema :: Text
-, tableName :: Text
+  tableSchema     :: Schema
+, tableName       :: Text
 , tableInsertable :: Bool
 } deriving (Show)
 
-data ForeignKey = ForeignKey {
-  fkSchema :: Text,
-  fkTable :: Text,
-  fkCol :: Text
-} deriving (Show, Eq)
+data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq)
 
-
-data Column = Column {
-  colSchema :: Text
-, colTable :: Text
-, colName :: Text
-, colPosition :: Int
-, colNullable :: Bool
-, colType :: Text
-, colUpdatable :: Bool
-, colMaxLen :: Maybe Int
-, colPrecision :: Maybe Int
-, colDefault :: Maybe Text
-, colEnum :: [Text]
-, colFK :: Maybe ForeignKey
-} | Star { colSchema :: Text, colTable :: Text } deriving (Show)
+data Column =
+    Column {
+      colTable     :: Table
+    , colName      :: Text
+    , colPosition  :: Int
+    , colNullable  :: Bool
+    , colType      :: Text
+    , colUpdatable :: Bool
+    , colMaxLen    :: Maybe Int
+    , colPrecision :: Maybe Int
+    , colDefault   :: Maybe Text
+    , colEnum      :: [Text]
+    , colFK        :: Maybe ForeignKey
+    }
+  | Star { colTable :: Table }
+  deriving (Show, Eq)
 
 data PrimaryKey = PrimaryKey {
-  pkSchema::Text, pkTable::Text, pkName::Text
-}
+    pkTable :: Table
+  , pkName  :: Text
+} deriving (Show, Eq)
 
 data OrderTerm = OrderTerm {
-  otTerm :: Text
+  otTerm      :: Text
 , otDirection :: BS.ByteString
 , otNullOrder :: Maybe BS.ByteString
 } deriving (Show, Eq)
 
 data QualifiedIdentifier = QualifiedIdentifier {
-  qiSchema :: Text
+  qiSchema :: Schema
 , qiName   :: Text
 } deriving (Show, Eq)
 
 
 data RelationType = Child | Parent | Many deriving (Show, Eq)
 data Relation = Relation {
-  relSchema   :: Text
-, relTable    :: Text
-, relColumns  :: [Text]
-, relFSchema  :: Text
-, relFTable   :: Text
-, relFColumns :: [Text]
+  relTable    :: Table
+, relColumns  :: [Column]
+, relFTable   :: Table
+, relFColumns :: [Column]
 , relType     :: RelationType
-, relLSchema  :: Maybe Text
-, relLTable   :: Maybe Text
-, relLCols1   :: Maybe [Text]
-, relLCols2   :: Maybe [Text]
+, relLTable   :: Maybe Table
+, relLCols1   :: Maybe [Column]
+, relLCols2   :: Maybe [Column]
 } deriving (Show, Eq)
 
 
@@ -92,7 +88,7 @@ type ApiRequest = Tree ApiNode
 
 instance ToJSON Column where
   toJSON c = object [
-      "schema"    .= colSchema c
+      "schema"    .= tableSchema t
     , "name"      .= colName c
     , "position"  .= colPosition c
     , "nullable"  .= colNullable c
@@ -103,9 +99,17 @@ instance ToJSON Column where
     , "references".= colFK c
     , "default"   .= colDefault c
     , "enum"      .= colEnum c ]
+    where
+      t = colTable c
 
 instance ToJSON ForeignKey where
-  toJSON fk = object ["schema".=fkSchema fk, "table".=fkTable fk, "column".=fkCol fk]
+  toJSON fk = object [
+      "schema" .= tableSchema t
+    , "table"  .= tableName t
+    , "column" .= colName c ]
+    where
+      c = fkCol fk
+      t = colTable c
 
 instance ToJSON Table where
   toJSON v = object [

From 16af8fc61edb9f27d92dc9cdfcfa4041d3078976 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Wed, 11 Nov 2015 07:51:35 -0500
Subject: [PATCH 71/81] Better relations for views

- Better column synonyms detection
- Raise relations to accessible schema when possible
---
 src/PostgREST/DbStructure.hs  | 185 +++++++++++++++++++++++---------
 src/PostgREST/Main.hs         |   3 +-
 src/PostgREST/Types.hs        |  15 ++-
 test/Feature/StructureSpec.hs | 196 +++++++++++++++++++---------------
 test/SpecHelper.hs            |   2 +-
 test/fixtures/schema.sql      |  68 ++++++------
 6 files changed, 285 insertions(+), 184 deletions(-)

diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs
index 6949a9412..91d728c64 100644
--- a/src/PostgREST/DbStructure.hs
+++ b/src/PostgREST/DbStructure.hs
@@ -10,33 +10,38 @@ module PostgREST.DbStructure (
 ) where
 
 import           Control.Applicative
-import           Control.Monad         (join)
+import           Control.Monad          (join)
 import           Data.Functor.Identity
-import           Data.List             (elemIndex, find, subsequences)
-import           Data.Maybe            (fromMaybe, fromJust, isJust, mapMaybe)
+import           Data.List              (elemIndex, find, subsequences, sort, transpose)
+import           Data.Maybe             (fromMaybe, fromJust, isJust, mapMaybe, listToMaybe)
 import           Data.Monoid
-import           Data.Text             (Text, split)
-import qualified Hasql                 as H
-import qualified Hasql.Postgres        as P
-import qualified Hasql.Backend         as B
-import           PostgREST.PgQuery     ()
+import           Data.Text              (Text, split)
+import qualified Hasql                  as H
+import qualified Hasql.Postgres         as P
+import qualified Hasql.Backend          as B
+import           PostgREST.PgQuery      ()
 import           PostgREST.Types
 
-import           GHC.Exts              (groupWith)
+import           GHC.Exts               (groupWith)
 import           Prelude
 
-createDbStructure :: H.Tx P.Postgres s DbStructure
-createDbStructure = do
+createDbStructure :: Schema -> H.Tx P.Postgres s DbStructure
+createDbStructure schema = do
   tabs <- allTables
   cols <- allColumns tabs
+  syns <- allSynonyms cols
   rels <- allRelations tabs cols
   keys <- allPrimaryKeys tabs
 
+  let rels' = (manyToManyRelations . raiseRelations schema syns . parentRelations . synonymousRelations syns) rels
+      cols' = addForeignKeys rels' cols
+      keys' = synonymousPrimaryKeys syns keys
+
   return DbStructure {
       tables = tabs
-    , columns = addForeignKeys rels cols
-    , relations = rels
-    , primaryKeys = keys
+    , columns = cols'
+    , relations = rels'
+    , primaryKeys = keys'
     }
 
 doesProc :: forall c s. B.CxValue c Int =>
@@ -66,6 +71,16 @@ doesProcReturnJWT = doesProc [H.stmt|
       AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
     |]
 
+synonymousColumns :: [(Column,Column)] -> [Column] -> [[Column]]
+synonymousColumns allSyns cols = synCols'
+  where
+    syns = sort $ filter ((== colTable (head cols)) . colTable . fst) allSyns
+    synCols  = transpose $ map (\c -> map snd $ filter ((== c) . fst) syns) cols
+    synCols' = (filter sameTable . filter matchLength) synCols
+    matchLength cs = length cols == length cs
+    sameTable (c:cs) = all (\cc -> colTable c == colTable cc) (c:cs)
+    sameTable [] = False
+
 addForeignKeys :: [Relation] -> [Column] -> [Column]
 addForeignKeys rels = map addFk
   where
@@ -79,38 +94,52 @@ addForeignKeys rels = map addFk
         pos = elemIndex col cols
         colF = (colsF !!) <$> pos
 
-columnFromRow :: [Table] ->
-                 (Text,       Text,      Text,
-                  Int,        Bool,      Text,
-                  Bool,       Maybe Int, Maybe Int,
-                  Maybe Text, Maybe Text)
-                 -> Column
-columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) =
-  Column table n pos nul typ u l p d (parseEnum e) Nothing
+synonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation]
+synonymousRelations _ [] = []
+synonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ synonymousRelations syns rels
   where
-    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
-    parseEnum :: Maybe Text -> [Text]
-    parseEnum str = fromMaybe [] $ split (==',') <$> str
+    synRelsP = synRels (relColumns rel) (\t cs -> rel{relTable=t,relColumns=cs})
+    synRelsF = synRels (relFColumns rel) (\t cs -> rel{relFTable=t,relFColumns=cs})
+    synRels cols mapFn = map (\cs -> mapFn (colTable $ head cs) cs) $ synonymousColumns syns cols
 
+parentRelations :: [Relation] -> [Relation]
+parentRelations [] = []
+parentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : parentRelations rels
 
-relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Relation
-relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) = Relation table cols tableF colsF Child Nothing Nothing Nothing
+manyToManyRelations :: [Relation] -> [Relation]
+manyToManyRelations rels = rels ++ mapMaybe link2Relation links
   where
-    findTable s t = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
-    findCols s t cs = filter (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col `elem` cs) allCols
-    table  = findTable rs rt
-    tableF = findTable frs frt
-    cols  = findCols rs rt rcs
-    colsF = findCols frs frt frcs
+    links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
+    groupFn :: Relation -> Text
+    groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t
+    combinations k ns = filter ((k==).length) (subsequences ns)
+    link2Relation [
+      Relation{relTable=lt, relColumns=lc1, relFTable=t,  relFColumns=c},
+      Relation{             relColumns=lc2, relFTable=ft, relFColumns=fc}
+      ]
+      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc Many (Just lt) (Just lc1) (Just lc2)
+      | otherwise = Nothing
+    link2Relation _ = Nothing
 
-pkFromRow :: [Table] -> (Schema, Text, Text) -> PrimaryKey
-pkFromRow tabs (s, t, n) = PrimaryKey table n
+raiseRelations :: Schema -> [(Column,Column)] -> [Relation] -> [Relation]
+raiseRelations schema syns = map raiseRel
   where
-    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+    raiseRel rel
+      | tableSchema table == schema = rel
+      | isJust newCols = rel{relFTable=fromJust newTable,relFColumns=fromJust newCols}
+      | otherwise = rel
+      where
+        cols = relFColumns rel
+        table = relFTable rel
+        newCols = listToMaybe $ filter ((== schema) . tableSchema . colTable . head) (synonymousColumns syns cols)
+        newTable = (colTable . head) <$> newCols
 
-
-addParentRelation :: Relation -> [Relation] -> [Relation]
-addParentRelation rel@(Relation t c ft fc _ _ _ _) rels = Relation ft fc t c Parent Nothing Nothing Nothing : rel : rels
+synonymousPrimaryKeys :: [(Column,Column)] -> [PrimaryKey] -> [PrimaryKey]
+synonymousPrimaryKeys _ [] = []
+synonymousPrimaryKeys syns (key:keys) = key : newKeys ++ synonymousPrimaryKeys syns keys
+  where
+    keySyns = filter ((\c -> colTable c == pkTable key && colName c == pkName key) . fst) syns
+    newKeys = map ((\c -> PrimaryKey{pkTable=colTable c,pkName=colName c}) . snd) keySyns
 
 allTables :: H.Tx P.Postgres s [Table]
 allTables = do
@@ -182,6 +211,19 @@ allColumns tabs = do
   |]
   return $ map (columnFromRow tabs) cols
 
+columnFromRow :: [Table] ->
+                 (Text,       Text,      Text,
+                  Int,        Bool,      Text,
+                  Bool,       Maybe Int, Maybe Int,
+                  Maybe Text, Maybe Text)
+                 -> Column
+columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) =
+  Column table n pos nul typ u l p d (parseEnum e) Nothing
+  where
+    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+    parseEnum :: Maybe Text -> [Text]
+    parseEnum str = fromMaybe [] $ split (==',') <$> str
+
 allRelations :: [Table] -> [Column] -> H.Tx P.Postgres s [Relation]
 allRelations tabs cols = do
   rels <- H.listEx $ [H.stmt|
@@ -210,20 +252,17 @@ allRelations tabs cols = do
     WHERE confrelid != 0
     ORDER BY (conrelid, column_info.nums)
   |]
-  let simpleRelations = foldr (addParentRelation . relationFromRow tabs cols) [] rels
-      links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
-  return $ simpleRelations ++ mapMaybe link2Relation links
+  return $ map (relationFromRow tabs cols) rels
+
+relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Relation
+relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) = Relation table cols tableF colsF Child Nothing Nothing Nothing
   where
-    groupFn :: Relation -> Text
-    groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t
-    combinations k ns = filter ((k==).length) (subsequences ns)
-    link2Relation [
-      Relation{relTable=lt, relColumns=lc1, relFTable=t,  relFColumns=c},
-      Relation{             relColumns=lc2, relFTable=ft, relFColumns=fc}
-      ]
-      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc Many (Just lt) (Just lc1) (Just lc2)
-      | otherwise = Nothing
-    link2Relation _ = Nothing
+    findTable s t = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
+    findCols s t cs = filter (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col `elem` cs) allCols
+    table  = findTable rs rt
+    tableF = findTable frs frt
+    cols  = findCols rs rt rcs
+    colsF = findCols frs frt frcs
 
 allPrimaryKeys :: [Table] -> H.Tx P.Postgres s [PrimaryKey]
 allPrimaryKeys tabs = do
@@ -243,3 +282,45 @@ allPrimaryKeys tabs = do
         kc.table_schema NOT IN ('pg_catalog', 'information_schema')
     |]
   return $ map (pkFromRow tabs) pks
+
+pkFromRow :: [Table] -> (Schema, Text, Text) -> PrimaryKey
+pkFromRow tabs (s, t, n) = PrimaryKey table n
+  where
+    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+
+allSynonyms :: [Column] -> H.Tx P.Postgres s [(Column,Column)]
+allSynonyms allCols = do
+  srcSyns <- H.listEx $ [H.stmt|
+    WITH synonyms AS (
+      SELECT
+        vcu.table_schema AS src_table_schema,
+        vcu.table_name AS src_table_name,
+        vcu.column_name AS src_column_name,
+        view.table_schema AS syn_table_schema,
+        view.table_name AS syn_table_name,
+        view.view_definition AS view_definition
+      FROM
+        information_schema.views AS view,
+        information_schema.view_column_usage AS vcu
+      WHERE
+        view.table_schema = vcu.view_schema AND
+        view.table_name = vcu.view_name AND
+        view.table_schema NOT IN ('pg_catalog', 'information_schema') AND
+        (SELECT COUNT(*) FROM information_schema.view_table_usage WHERE view_schema = view.table_schema AND view_name = view.table_name) = 1
+    )
+    SELECT
+      src_table_schema, src_table_name, src_column_name,
+      syn_table_schema, syn_table_name,
+      (regexp_matches(view_definition, CONCAT('\.(', src_column_name, ')(?=,|$)'), 'gn'))[1]
+    FROM synonyms
+    UNION (
+      SELECT
+        src_table_schema, src_table_name, src_column_name,
+        syn_table_schema, syn_table_name,
+        (regexp_matches(view_definition, CONCAT('\.', src_column_name, '\sAS\s("?)(.+?)\1(,|$)'), 'gn'))[2] /* " <- for syntax highlighting */
+      FROM synonyms
+    )
+    |]
+  return $ map (\(a,b,c,d,e,f) -> (findCol a b c,findCol d e f)) srcSyns
+  where
+    findCol s t c = fromJust $ find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index 53cf2b917..948cb875f 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -9,7 +9,6 @@ import           PostgREST.Config                     (AppConfig (..),
 import           PostgREST.Error                      (errResponse, PgError)
 import           PostgREST.Middleware
 import           PostgREST.DbStructure
-import           PostgREST.Types
 
 import           Control.Monad                        (unless)
 import           Control.Monad.IO.Class               (liftIO)
@@ -69,7 +68,7 @@ main = do
     ) supportedOrError
 
   let txSettings = Just (H.ReadCommitted, Just True)
-  dbOrError <- H.session pool $ H.tx txSettings createDbStructure
+  dbOrError <- H.session pool $ H.tx txSettings $ createDbStructure (cs $ configSchema conf)
   db <- either hasqlError return dbOrError
 
   runSettings appSettings $ middle $ \ req respond -> do
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
index b7f60606f..9bb4d4cab 100644
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -17,9 +17,9 @@ data Table = Table {
   tableSchema     :: Schema
 , tableName       :: Text
 , tableInsertable :: Bool
-} deriving (Show)
+} deriving (Show, Ord)
 
-data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq)
+data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
 
 data Column =
     Column {
@@ -36,7 +36,9 @@ data Column =
     , colFK        :: Maybe ForeignKey
     }
   | Star { colTable :: Table }
-  deriving (Show, Eq)
+  deriving (Show, Ord)
+
+type Synonym = (Column,Column)
 
 data PrimaryKey = PrimaryKey {
     pkTable :: Table
@@ -116,3 +118,10 @@ instance ToJSON Table where
       "schema"     .= tableSchema v
     , "name"       .= tableName v
     , "insertable" .= tableInsertable v ]
+
+instance Eq Table where
+  Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
+
+instance Eq Column where
+  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
+  _ == _ = False
diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs
index 148a1ca1b..339a36044 100644
--- a/test/Feature/StructureSpec.hs
+++ b/test/Feature/StructureSpec.hs
@@ -14,7 +14,9 @@ spec = around withApp $ do
     it "lists views in schema" $
       request methodGet "/" [] ""
         `shouldRespondWith` [json| [
-          {"schema":"test","name":"auto_incrementing_pk","insertable":true}
+          {"schema":"test","name":"articleStars","insertable":true}
+        , {"schema":"test","name":"articles","insertable":true}
+        , {"schema":"test","name":"auto_incrementing_pk","insertable":true}
         , {"schema":"test","name":"clients","insertable":true}
         , {"schema":"test","name":"comments","insertable":true}
         , {"schema":"test","name":"complex_items","insertable":true}
@@ -48,7 +50,6 @@ spec = around withApp $ do
         ] |]
         {matchStatus = 200}
 
-
   describe "Table info" $ do
     it "is available with OPTIONS verb" $
       request methodOptions "/menagerie" [] "" `shouldRespondWith`
@@ -153,100 +154,57 @@ spec = around withApp $ do
       |]
 
     it "it includes primary and foreign keys for views" $
-      request methodOptions "/insertable_view_with_join" [] "" `shouldRespondWith`
+      request methodOptions "/projects_view" [] "" `shouldRespondWith`
       [json|
       {
          "pkey":[
             "id"
          ],
          "columns":[
-            {
-               "references":null,
-               "default":null,
-               "precision":64,
-               "updatable":false,
-               "schema":"test",
-               "name":"id",
-               "type":"bigint",
-               "maxLen":null,
-               "enum":[],
-               "nullable":true,
-               "position":1
+          {
+            "references":null,
+            "default":null,
+            "precision":32,
+            "updatable":true,
+            "schema":"test",
+            "name":"id",
+            "type":"integer",
+            "maxLen":null,
+            "enum":[],
+            "nullable":true,
+            "position":1
+          },
+          {
+            "references":null,
+            "default":null,
+            "precision":null,
+            "updatable":true,
+            "schema":"test",
+            "name":"name",
+            "type":"text",
+            "maxLen":null,
+            "enum":[],
+            "nullable":true,
+            "position":2
+          },
+          {
+            "references": {
+              "schema":"test",
+              "column":"id",
+              "table":"clients"
             },
-            {
-               "references":{
-                  "schema":"test",
-                  "column":"id",
-                  "table":"auto_incrementing_pk"
-               },
-               "default":null,
-               "precision":32,
-               "updatable":false,
-               "schema":"test",
-               "name":"auto_inc_fk",
-               "type":"integer",
-               "maxLen":null,
-               "enum":[],
-               "nullable":true,
-               "position":2
-            },
-            {
-               "references":{
-                  "schema":"test",
-                  "column":"k",
-                  "table":"simple_pk"
-               },
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"test",
-               "name":"simple_fk",
-               "type":"character varying",
-               "maxLen":255,
-               "enum":[],
-               "nullable":true,
-               "position":3
-            },
-            {
-               "references":null,
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"test",
-               "name":"nullable_string",
-               "type":"character varying",
-               "maxLen":null,
-               "enum":[],
-               "nullable":true,
-               "position":4
-            },
-            {
-               "references":null,
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"test",
-               "name":"non_nullable_string",
-               "type":"character varying",
-               "maxLen":null,
-               "enum":[],
-               "nullable":true,
-               "position":5
-            },
-            {
-               "references":null,
-               "default":null,
-               "precision":null,
-               "updatable":false,
-               "schema":"test",
-               "name":"inserted_at",
-               "type":"timestamp with time zone",
-               "maxLen":null,
-               "enum":[],
-               "nullable":true,
-               "position":6
-            }
-         ]
+            "default":null,
+            "precision":32,
+            "updatable":true,
+            "schema":"test",
+            "name":"client_id",
+            "type":"integer",
+            "maxLen":null,
+            "enum":[],
+            "nullable":true,
+            "position":3
+          }
+        ]
       }
       |]
 
@@ -298,3 +256,63 @@ spec = around withApp $ do
         ]
       }
       |]
+
+    it "includes all information on views for renamed columns, and raises relations to correct schema" $
+      request methodOptions "/articleStars" [] ""
+        `shouldRespondWith` [json|
+          {
+            "pkey": [
+              "articleId",
+              "userId"
+            ],
+            "columns": [
+              {
+                "references": {
+                  "schema": "test",
+                  "column": "id",
+                  "table": "articles"
+                },
+                "default": null,
+                "precision": 32,
+                "updatable": true,
+                "schema": "test",
+                "name": "articleId",
+                "type": "integer",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 1
+              },
+              {
+                "references": {
+                  "schema": "test",
+                  "column": "id",
+                  "table": "users"
+                },
+                "default": null,
+                "precision": 32,
+                "updatable": true,
+                "schema": "test",
+                "name": "userId",
+                "type": "integer",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 2
+              },
+              {
+                "references": null,
+                "default": null,
+                "precision": null,
+                "updatable": true,
+                "schema": "test",
+                "name": "createdAt",
+                "type": "timestamp without time zone",
+                "maxLen": null,
+                "enum": [],
+                "nullable": true,
+                "position": 3
+              }
+            ]
+          }
+        |]
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index dcc765f0d..8a6f9dfe6 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -54,7 +54,7 @@ withApp perform = do
     <- H.acquirePool pgSettings testPoolOpts
 
   let txSettings = Just (H.ReadCommitted, Just True)
-  dbOrError <- H.session pool $ H.tx txSettings createDbStructure
+  dbOrError <- H.session pool $ H.tx txSettings $ createDbStructure (cs $ configSchema cfg)
   db <- either (fail . show) return dbOrError
 
   perform $ middle $ \req resp -> do
diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql
index 8c17f72ff..de2122959 100755
--- a/test/fixtures/schema.sql
+++ b/test/fixtures/schema.sql
@@ -382,8 +382,8 @@ SET search_path = private, pg_catalog;
 
 
 CREATE TABLE articles (
+    id integer PRIMARY KEY NOT NULL,
     body text,
-    id integer NOT NULL,
     owner name NOT NULL
 );
 
@@ -391,59 +391,43 @@ CREATE TABLE articles (
 ALTER TABLE private.articles OWNER TO postgrest_test;
 
 
-CREATE SEQUENCE articles_id_seq
-    START WITH 1
-    INCREMENT BY 1
-    NO MINVALUE
-    NO MAXVALUE
-    CACHE 1;
+CREATE TABLE article_stars (
+  article_id int REFERENCES articles(id),
+  user_id int REFERENCES test.users(id),
+  created_at timestamp NOT NULL DEFAULT now(),
+  CONSTRAINT user_article PRIMARY KEY (article_id, user_id)
+);
 
+ALTER TABLE private.article_stars OWNER TO postgrest_test;
 
-ALTER TABLE private.articles_id_seq OWNER TO postgrest_test;
-
-
-ALTER SEQUENCE articles_id_seq OWNED BY articles.id;
 
 
 SET search_path = test, pg_catalog;
 
 
+
+CREATE VIEW "articleStars" AS
+  SELECT article_id AS "articleId", user_id AS "userId", created_at AS "createdAt"
+  FROM private.article_stars;
+
+ALTER TABLE test."articleStars" OWNER TO postgrest_test;
+
+CREATE VIEW articles AS
+  SELECT *
+  FROM private.articles;
+
+ALTER TABLE test.articles OWNER TO postgrest_test;
+
 ALTER TABLE ONLY auto_incrementing_pk ALTER COLUMN id SET DEFAULT nextval('auto_incrementing_pk_id_seq'::regclass);
 
 
 
 ALTER TABLE ONLY has_fk ALTER COLUMN id SET DEFAULT nextval('has_fk_id_seq'::regclass);
 
-
-
 ALTER TABLE ONLY items ALTER COLUMN id SET DEFAULT nextval('items_id_seq'::regclass);
 
-
-SET search_path = private, pg_catalog;
-
-
-ALTER TABLE ONLY articles ALTER COLUMN id SET DEFAULT nextval('articles_id_seq'::regclass);
-
-
-SET search_path = test, pg_catalog;
-
-
-
-
-
-
-
-
 SELECT pg_catalog.setval('auto_incrementing_pk_id_seq', 1, true);
 
-
-
-
-
-
-
-
-
 SELECT pg_catalog.setval('has_fk_id_seq', 1, false);
 
 
@@ -654,6 +638,14 @@ REVOKE ALL ON TABLE projects_view FROM PUBLIC;
 REVOKE ALL ON TABLE projects_view FROM postgrest_test;
 GRANT ALL ON TABLE projects_view TO postgrest_test;
 GRANT ALL ON TABLE projects_view TO postgrest_anonymous;
+REVOKE ALL ON TABLE articles FROM PUBLIC;
+REVOKE ALL ON TABLE articles FROM postgrest_test;
+GRANT ALL ON TABLE  articles TO postgrest_test;
+GRANT ALL ON TABLE  articles TO postgrest_anonymous;
+REVOKE ALL ON TABLE "articleStars" FROM PUBLIC;
+REVOKE ALL ON TABLE "articleStars" FROM postgrest_test;
+GRANT ALL ON TABLE  "articleStars" TO postgrest_test;
+GRANT ALL ON TABLE  "articleStars" TO postgrest_anonymous;
 ---------
 
 
@@ -773,4 +765,6 @@ INSERT INTO users_projects VALUES(1,1),(1,2),(2,3),(2,4),(3,1),(3,3);
 INSERT INTO users_tasks VALUES(1,1),(1,2),(1,3),(1,4),(2,5),(2,6),(2,7),(3,1),(3,5);
 INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP');
 INSERT INTO postgrest.auth (id, pass, rolname) VALUES ('jdoe', '1234', 'postgrest_test_author');
+INSERT INTO private.articles (id, body, owner) VALUES (1, 'No… It''s a thing; it''s like a plan, but with more greatness.', 2), (2, 'Stop talking, brain thinking. Hush.', 3), (3, 'It''s a fez. I wear a fez now. Fezes are cool.', 1);
+INSERT INTO private.article_stars (article_id, user_id) VALUES (1,1), (1,2), (2,3), (3,2), (1,3);
 ----------------

From 0374d4e6513728ff7c2fa0847a977f2e13f11f31 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Wed, 11 Nov 2015 09:31:36 -0500
Subject: [PATCH 72/81] Add tables back to DbStructure

---
 src/PostgREST/App.hs         |  3 ++-
 src/PostgREST/DbStructure.hs | 23 ++++++++++++++++++++++-
 src/PostgREST/Types.hs       |  3 ++-
 3 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index f3f914109..a51004cf9 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -147,7 +147,7 @@ app db conf reqBody req =
       -- select * from public.proc(a := "foo"::undefined) where whereT limit limitT
 
     ([], _) -> do
-      body <- encode <$> tables (cs schema)
+      body <- encode <$> accessibleTables (filter ((== cs schema) . tableSchema) allTabs)
       return $ responseLBS status200 [jsonH] $ cs body
 
     ([table], "OPTIONS") -> do
@@ -160,6 +160,7 @@ app db conf reqBody req =
       return $ responseLBS status404 [] ""
 
   where
+    allTabs = tables db
     allRels = relations db
     allCols = columns db
     allPrKeys = primaryKeys db
diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs
index 91d728c64..0798b1120 100644
--- a/src/PostgREST/DbStructure.hs
+++ b/src/PostgREST/DbStructure.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE TypeSynonymInstances  #-}
 module PostgREST.DbStructure (
   createDbStructure
+, accessibleTables
 , doesProcExist
 , doesProcReturnJWT
 ) where
@@ -71,6 +72,26 @@ doesProcReturnJWT = doesProc [H.stmt|
       AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
     |]
 
+accessibleTables :: [Table] -> H.Tx P.Postgres s [Table]
+accessibleTables allTabs = do
+  accessible <- H.listEx $ [H.stmt|
+      SELECT
+        n.nspname AS table_schema,
+        c.relname AS table_name
+      FROM pg_class c
+      JOIN pg_namespace n ON n.oid = c.relnamespace
+      WHERE
+        c.relkind IN ('v','r','m') AND
+        n.nspname NOT IN ('pg_catalog', 'information_schema') AND (
+          pg_has_role(c.relowner, 'USAGE'::text) OR
+          has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR
+          has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
+        )
+      ORDER BY table_schema, table_name
+    |]
+  let isAccessible table = isJust $ find (\(s,n) -> tableSchema table == s && tableName table == n) accessible
+  return $ filter isAccessible allTabs
+
 synonymousColumns :: [(Column,Column)] -> [Column] -> [[Column]]
 synonymousColumns allSyns cols = synCols'
   where
@@ -159,7 +180,7 @@ allTables = do
       WHERE c.relkind IN ('v','r','m')
         AND n.nspname NOT IN ('pg_catalog', 'information_schema')
       GROUP BY table_schema, table_name, insertable
-      ORDER BY table_schema, table_name;
+      ORDER BY table_schema, table_name
     |]
     return $ map tableFromRow rows
 
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
index 9bb4d4cab..ae9e8e819 100644
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -6,7 +6,8 @@ import Data.Aeson
 import Data.Map
 
 data DbStructure = DbStructure {
-  columns :: [Column]
+  tables :: [Table]
+, columns :: [Column]
 , relations :: [Relation]
 , primaryKeys :: [PrimaryKey]
 } deriving (Show, Eq)

From b8b073810fdac7d3fd4e750fc592fc693eee999b Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Wed, 11 Nov 2015 15:53:52 -0500
Subject: [PATCH 73/81] Rename functions

---
 src/PostgREST/App.hs         | 12 ++++++------
 src/PostgREST/DbStructure.hs | 24 ++++++++++++------------
 src/PostgREST/Main.hs        |  6 +++---
 test/SpecHelper.hs           |  4 ++--
 4 files changed, 23 insertions(+), 23 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index a51004cf9..1741b2f6d 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -55,7 +55,7 @@ import           PostgREST.Auth (tokenJWT)
 import           Prelude
 
 app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
-app db conf reqBody req =
+app dbStructure conf reqBody req =
   case (path, verb) of
 
     ([table], "GET") ->
@@ -71,7 +71,7 @@ app db conf reqBody req =
                 to = frm+queryTotal-1
                 contentRange = contentRangeH frm to tableTotal
                 status = rangeStatus frm to tableTotal
-                canonical = urlEncodeVars -- should this be moved to the db (location)?
+                canonical = urlEncodeVars -- should this be moved to the dbStructure (location)?
                   . sortBy (comparing fst)
                   . map (join (***) cs)
                   . parseSimpleQuery
@@ -160,10 +160,10 @@ app db conf reqBody req =
       return $ responseLBS status404 [] ""
 
   where
-    allTabs = tables db
-    allRels = relations db
-    allCols = columns db
-    allPrKeys = primaryKeys db
+    allTabs = tables dbStructure
+    allRels = relations dbStructure
+    allCols = columns dbStructure
+    allPrKeys = primaryKeys dbStructure
     filterCol sc table (Column{colTable=Table{tableSchema=s, tableName=t}}) = s==sc && table==t
     filterCol _ _ _ =  False
     filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs
index 0798b1120..04aca3d97 100644
--- a/src/PostgREST/DbStructure.hs
+++ b/src/PostgREST/DbStructure.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
 module PostgREST.DbStructure (
-  createDbStructure
+  getDbStructure
 , accessibleTables
 , doesProcExist
 , doesProcReturnJWT
@@ -26,15 +26,15 @@ import           PostgREST.Types
 import           GHC.Exts               (groupWith)
 import           Prelude
 
-createDbStructure :: Schema -> H.Tx P.Postgres s DbStructure
-createDbStructure schema = do
+getDbStructure :: Schema -> H.Tx P.Postgres s DbStructure
+getDbStructure schema = do
   tabs <- allTables
   cols <- allColumns tabs
   syns <- allSynonyms cols
   rels <- allRelations tabs cols
   keys <- allPrimaryKeys tabs
 
-  let rels' = (manyToManyRelations . raiseRelations schema syns . parentRelations . synonymousRelations syns) rels
+  let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
       cols' = addForeignKeys rels' cols
       keys' = synonymousPrimaryKeys syns keys
 
@@ -115,20 +115,20 @@ addForeignKeys rels = map addFk
         pos = elemIndex col cols
         colF = (colsF !!) <$> pos
 
-synonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation]
-synonymousRelations _ [] = []
-synonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ synonymousRelations syns rels
+addSynonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation]
+addSynonymousRelations _ [] = []
+addSynonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ addSynonymousRelations syns rels
   where
     synRelsP = synRels (relColumns rel) (\t cs -> rel{relTable=t,relColumns=cs})
     synRelsF = synRels (relFColumns rel) (\t cs -> rel{relFTable=t,relFColumns=cs})
     synRels cols mapFn = map (\cs -> mapFn (colTable $ head cs) cs) $ synonymousColumns syns cols
 
-parentRelations :: [Relation] -> [Relation]
-parentRelations [] = []
-parentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : parentRelations rels
+addParentRelations :: [Relation] -> [Relation]
+addParentRelations [] = []
+addParentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : addParentRelations rels
 
-manyToManyRelations :: [Relation] -> [Relation]
-manyToManyRelations rels = rels ++ mapMaybe link2Relation links
+addManyToManyRelations :: [Relation] -> [Relation]
+addManyToManyRelations rels = rels ++ mapMaybe link2Relation links
   where
     links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
     groupFn :: Relation -> Text
diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs
index 948cb875f..4b12d07b8 100644
--- a/src/PostgREST/Main.hs
+++ b/src/PostgREST/Main.hs
@@ -68,11 +68,11 @@ main = do
     ) supportedOrError
 
   let txSettings = Just (H.ReadCommitted, Just True)
-  dbOrError <- H.session pool $ H.tx txSettings $ createDbStructure (cs $ configSchema conf)
-  db <- either hasqlError return dbOrError
+  dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema conf)
+  dbStructure <- either hasqlError return dbOrError
 
   runSettings appSettings $ middle $ \ req respond -> do
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf (app db conf body) req
+      runWithClaims conf (app dbStructure conf body) req
     either (respond . errResponse) respond resOrError
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index 8a6f9dfe6..8971b606f 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -54,7 +54,7 @@ withApp perform = do
     <- H.acquirePool pgSettings testPoolOpts
 
   let txSettings = Just (H.ReadCommitted, Just True)
-  dbOrError <- H.session pool $ H.tx txSettings $ createDbStructure (cs $ configSchema cfg)
+  dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema cfg)
   db <- either (fail . show) return dbOrError
 
   perform $ middle $ \req resp -> do
@@ -119,7 +119,7 @@ clearProjectsTable :: IO ()
 clearProjectsTable = do
   pool <- testPool
   void . liftIO $ H.session pool $ H.tx Nothing $
-    H.unitEx $ B.Stmt ("delete from test.projects where id > 4") V.empty True
+    H.unitEx $ B.Stmt "delete from test.projects where id > 4" V.empty True
 
 
 createItems :: Int -> IO ()

From 1061854f3575822980ad97206770109d130ec5d3 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Wed, 11 Nov 2015 15:55:08 -0500
Subject: [PATCH 74/81] Resolve SQL errors

---
 test/fixtures/schema.sql | 8 --------
 1 file changed, 8 deletions(-)

diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql
index de2122959..32129873f 100755
--- a/test/fixtures/schema.sql
+++ b/test/fixtures/schema.sql
@@ -450,10 +450,6 @@ SET search_path = private, pg_catalog;
 
 
 
-
-SELECT pg_catalog.setval('articles_id_seq', 1, false);
-
-
 SET search_path = test, pg_catalog;
 
 CREATE FUNCTION public.always_true(test.items) RETURNS boolean
@@ -514,10 +510,6 @@ ALTER TABLE ONLY auth
 SET search_path = private, pg_catalog;
 
 
-ALTER TABLE ONLY articles
-    ADD CONSTRAINT articles_pkey PRIMARY KEY (id);
-
-
 SET search_path = postgrest, pg_catalog;
 
 

From eb94c507f97b3ccfd20b2ae3fbb78d87e4d1df0d Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Thu, 12 Nov 2015 15:07:40 +0200
Subject: [PATCH 75/81] remove secure flag from debian config

---
 debian/postgrest.default | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/debian/postgrest.default b/debian/postgrest.default
index fe0141969..c2393494c 100644
--- a/debian/postgrest.default
+++ b/debian/postgrest.default
@@ -27,6 +27,3 @@
 
 # default schema
 #POSTGREST_SCHEMA=public
-
-# secure (use 1 to enable, empty string to disable)
-#POSTGREST_SECURE=

From acb8f8a15491352fcad6beda7b1df6f9515822fc Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Thu, 12 Nov 2015 08:14:14 -0500
Subject: [PATCH 76/81] Fix failing insert test

---
 src/PostgREST/QueryBuilder.hs | 26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
index 679524e3e..e80849091 100644
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -35,23 +35,27 @@ addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) for
     updatedForest = mapM (addRelations schema allRelations (Just node)) forest
 
 getJoinConditions :: Relation -> [Filter]
-getJoinConditions (Relation t cs ft fcs typ _ lc1 lc2) =
+getJoinConditions (Relation t cs ft fcs typ lt lc1 lc2) =
   case typ of
-    Child  -> zipWith (toFilter t) cs fcs
-    Parent -> zipWith (toFilter t) cs fcs
-    Many   -> zipWith (toFilter t) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft) fcs (fromMaybe [] lc2)
+    Child  -> zipWith (toFilter tN ftN) cs fcs
+    Parent -> zipWith (toFilter tN ftN) cs fcs
+    Many   -> zipWith (toFilter tN ltN) cs (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
   where
-    toFilter :: Table -> Column -> Column -> Filter
-    toFilter tb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier (tableSchema tb) (tableName tb)) (ForeignKey fc))
+    s = tableSchema t
+    tN = tableName t
+    ftN = tableName ft
+    ltN = fromMaybe "" (tableName <$> lt)
+    toFilter :: Text -> Text -> Column -> Column -> Filter
+    toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
 
 addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest
-addJoinConditions schema (Node (query, (t, r)) forest) =
+addJoinConditions schema (Node (query, (n, r)) forest) =
   case r of
-    Nothing -> Node (updatedQuery, (t, r))  <$> updatedForest -- this is the root node
-    Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(t,r)) <$> updatedForest
-    Just (Relation{relType=Parent}) -> Node (updatedQuery, (t,r)) <$> updatedForest
+    Nothing -> Node (updatedQuery, (n,r))  <$> updatedForest -- this is the root node
+    Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(n,r)) <$> updatedForest
+    Just (Relation{relType=Parent}) -> Node (updatedQuery, (n,r)) <$> updatedForest
     Just rel@(Relation{relType=Many, relLTable=(Just linkTable)}) ->
-      Node (qq, (t, r)) <$> updatedForest
+      Node (qq, (n, r)) <$> updatedForest
       where
          q = addCond updatedQuery (getJoinConditions rel)
          qq = q{from=tableName linkTable : from q}

From 6e9a28ba3ce7f9a5f13f14bb95b95e211b05dd7c Mon Sep 17 00:00:00 2001
From: Ruslan Talpa <ruslan.talpa@gmail.com>
Date: Thu, 12 Nov 2015 15:19:11 +0200
Subject: [PATCH 77/81] fix the missing status400 include

---
 src/PostgREST/Middleware.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs
index ff8a434b6..3144bc84f 100644
--- a/src/PostgREST/Middleware.hs
+++ b/src/PostgREST/Middleware.hs
@@ -11,7 +11,7 @@ import qualified Hasql                         as H
 import qualified Hasql.Postgres                as P
 
 import           Network.HTTP.Types.Header     (hAccept, hAuthorization)
-import           Network.HTTP.Types.Status     (status415)
+import           Network.HTTP.Types.Status     (status415, status400)
 import           Network.Wai                   (Application, Request (..), Response,
                                                 requestHeaders, responseLBS)
 import           Network.Wai.Middleware.Cors   (cors)

From 0f5bc34c041d72695a315d60e4296e49bb943d01 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Thu, 12 Nov 2015 08:22:27 -0500
Subject: [PATCH 78/81] Remove fromJust assumptions

---
 src/PostgREST/DbStructure.hs | 46 ++++++++++++++++++++++++------------
 1 file changed, 31 insertions(+), 15 deletions(-)

diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs
index 04aca3d97..67519a390 100644
--- a/src/PostgREST/DbStructure.hs
+++ b/src/PostgREST/DbStructure.hs
@@ -230,18 +230,20 @@ allColumns tabs = do
       ) AS enum_info ON (info.udt_name = enum_info.n)
       ORDER BY schema, position
   |]
-  return $ map (columnFromRow tabs) cols
+  return $ mapMaybe (columnFromRow tabs) cols
 
 columnFromRow :: [Table] ->
                  (Text,       Text,      Text,
                   Int,        Bool,      Text,
                   Bool,       Maybe Int, Maybe Int,
                   Maybe Text, Maybe Text)
-                 -> Column
+                 -> Maybe Column
 columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) =
-  Column table n pos nul typ u l p d (parseEnum e) Nothing
+  if isJust table
+    then Just $ Column (fromJust table) n pos nul typ u l p d (parseEnum e) Nothing
+    else Nothing
   where
-    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+    table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
     parseEnum :: Maybe Text -> [Text]
     parseEnum str = fromMaybe [] $ split (==',') <$> str
 
@@ -273,12 +275,15 @@ allRelations tabs cols = do
     WHERE confrelid != 0
     ORDER BY (conrelid, column_info.nums)
   |]
-  return $ map (relationFromRow tabs cols) rels
+  return $ mapMaybe (relationFromRow tabs cols) rels
 
-relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Relation
-relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) = Relation table cols tableF colsF Child Nothing Nothing Nothing
+relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
+relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
+  if isJust table && isJust tableF && length cols == length rcs && length colsF == length frcs
+    then Just $ Relation (fromJust table) cols (fromJust tableF) colsF Child Nothing Nothing Nothing
+    else Nothing
   where
-    findTable s t = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
+    findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
     findCols s t cs = filter (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col `elem` cs) allCols
     table  = findTable rs rt
     tableF = findTable frs frt
@@ -302,16 +307,19 @@ allPrimaryKeys tabs = do
         kc.constraint_name = tc.constraint_name AND
         kc.table_schema NOT IN ('pg_catalog', 'information_schema')
     |]
-  return $ map (pkFromRow tabs) pks
+  return $ mapMaybe (pkFromRow tabs) pks
 
-pkFromRow :: [Table] -> (Schema, Text, Text) -> PrimaryKey
-pkFromRow tabs (s, t, n) = PrimaryKey table n
+pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
+pkFromRow tabs (s, t, n) =
+  if isJust table
+    then Just $ PrimaryKey (fromJust table) n
+    else Nothing
   where
-    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+    table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
 
 allSynonyms :: [Column] -> H.Tx P.Postgres s [(Column,Column)]
 allSynonyms allCols = do
-  srcSyns <- H.listEx $ [H.stmt|
+  syns <- H.listEx $ [H.stmt|
     WITH synonyms AS (
       SELECT
         vcu.table_schema AS src_table_schema,
@@ -342,6 +350,14 @@ allSynonyms allCols = do
       FROM synonyms
     )
     |]
-  return $ map (\(a,b,c,d,e,f) -> (findCol a b c,findCol d e f)) srcSyns
+  return $ mapMaybe (synonymFromRow allCols) syns
+
+synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column)
+synonymFromRow allCols (s1,t1,c1,s2,t2,c2) =
+  if isJust col1 && isJust col2
+    then Just (fromJust col1,fromJust col2)
+    else Nothing
   where
-    findCol s t c = fromJust $ find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
+    col1 = findCol s1 t1 c1
+    col2 = findCol s2 t2 c2
+    findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols

From 2f6254f44c4845fb602dbd273f675ccd390b272f Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Thu, 12 Nov 2015 15:01:23 -0500
Subject: [PATCH 79/81] Rename DbStructure names

---
 src/PostgREST/App.hs         | 8 ++++----
 src/PostgREST/Config.hs      | 2 +-
 src/PostgREST/DbStructure.hs | 8 ++++----
 src/PostgREST/MainTest.hs    | 8 ++++----
 src/PostgREST/Types.hs       | 8 ++++----
 5 files changed, 17 insertions(+), 17 deletions(-)

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index 1741b2f6d..a395353a3 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -160,10 +160,10 @@ app dbStructure conf reqBody req =
       return $ responseLBS status404 [] ""
 
   where
-    allTabs = tables dbStructure
-    allRels = relations dbStructure
-    allCols = columns dbStructure
-    allPrKeys = primaryKeys dbStructure
+    allTabs = dbTables dbStructure
+    allRels = dbRelations dbStructure
+    allCols = dbColumns dbStructure
+    allPrKeys = dbPrimaryKeys dbStructure
     filterCol sc table (Column{colTable=Table{tableSchema=s, tableName=t}}) = s==sc && table==t
     filterCol _ _ _ =  False
     filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs
index a83ae50b9..17a94ff07 100644
--- a/src/PostgREST/Config.hs
+++ b/src/PostgREST/Config.hs
@@ -28,7 +28,7 @@ import           Data.Text                   (strip)
 import           Data.Version                (versionBranch)
 import           Network.Wai
 import           Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
-import           Options.Applicative         hiding (columns)
+import           Options.Applicative
 import           Paths_postgrest             (version)
 import           Prelude
 
diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs
index 67519a390..81dbb2deb 100644
--- a/src/PostgREST/DbStructure.hs
+++ b/src/PostgREST/DbStructure.hs
@@ -39,10 +39,10 @@ getDbStructure schema = do
       keys' = synonymousPrimaryKeys syns keys
 
   return DbStructure {
-      tables = tabs
-    , columns = cols'
-    , relations = rels'
-    , primaryKeys = keys'
+      dbTables = tabs
+    , dbColumns = cols'
+    , dbRelations = rels'
+    , dbPrimaryKeys = keys'
     }
 
 doesProc :: forall c s. B.CxValue c Int =>
diff --git a/src/PostgREST/MainTest.hs b/src/PostgREST/MainTest.hs
index 45326d33d..f9b90e9cc 100644
--- a/src/PostgREST/MainTest.hs
+++ b/src/PostgREST/MainTest.hs
@@ -98,10 +98,10 @@ main = do
     (\(tabs, rels, cols, keys) ->
 
       return DbStructure {
-          tables=tabs
-        , columns=cols
-        , relations=rels
-        , primaryKeys=keys
+          dbTables=tabs
+        , dbColumns=cols
+        , dbRelations=rels
+        , dbPrimaryKeys=keys
         }
     ) metadata
   runSettings appSettings $ middle $ \ req respond -> do
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
index ae9e8e819..19a8d05b0 100644
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -6,10 +6,10 @@ import Data.Aeson
 import Data.Map
 
 data DbStructure = DbStructure {
-  tables :: [Table]
-, columns :: [Column]
-, relations :: [Relation]
-, primaryKeys :: [PrimaryKey]
+  dbTables :: [Table]
+, dbColumns :: [Column]
+, dbRelations :: [Relation]
+, dbPrimaryKeys :: [PrimaryKey]
 } deriving (Show, Eq)
 
 type Schema = Text

From 3794d358b4e1dcb17c8162909fecdca462239a4f Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Thu, 12 Nov 2015 15:09:28 -0500
Subject: [PATCH 80/81] Prettify monads

---
 src/PostgREST/DbStructure.hs | 19 +++++--------------
 1 file changed, 5 insertions(+), 14 deletions(-)

diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs
index 81dbb2deb..7eda5dc8a 100644
--- a/src/PostgREST/DbStructure.hs
+++ b/src/PostgREST/DbStructure.hs
@@ -238,11 +238,9 @@ columnFromRow :: [Table] ->
                   Bool,       Maybe Int, Maybe Int,
                   Maybe Text, Maybe Text)
                  -> Maybe Column
-columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) =
-  if isJust table
-    then Just $ Column (fromJust table) n pos nul typ u l p d (parseEnum e) Nothing
-    else Nothing
+columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table
   where
+    buildColumn tbl = Column tbl n pos nul typ u l p d (parseEnum e) Nothing
     table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
     parseEnum :: Maybe Text -> [Text]
     parseEnum str = fromMaybe [] $ split (==',') <$> str
@@ -310,12 +308,8 @@ allPrimaryKeys tabs = do
   return $ mapMaybe (pkFromRow tabs) pks
 
 pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
-pkFromRow tabs (s, t, n) =
-  if isJust table
-    then Just $ PrimaryKey (fromJust table) n
-    else Nothing
-  where
-    table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
+pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
+  where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
 
 allSynonyms :: [Column] -> H.Tx P.Postgres s [(Column,Column)]
 allSynonyms allCols = do
@@ -353,10 +347,7 @@ allSynonyms allCols = do
   return $ mapMaybe (synonymFromRow allCols) syns
 
 synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column)
-synonymFromRow allCols (s1,t1,c1,s2,t2,c2) =
-  if isJust col1 && isJust col2
-    then Just (fromJust col1,fromJust col2)
-    else Nothing
+synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
   where
     col1 = findCol s1 t1 c1
     col2 = findCol s2 t2 c2

From 0bf3dd9b1c914068c4de6a71023d4cbbdeaddb14 Mon Sep 17 00:00:00 2001
From: calebmer <calebmeredith8@gmail.com>
Date: Sat, 14 Nov 2015 08:02:09 -0500
Subject: [PATCH 81/81] Remove extraneous files

---
 src/PostgREST/MainTest.hs | 129 --------------------------------------
 src/mock.hs               |  43 -------------
 2 files changed, 172 deletions(-)
 delete mode 100644 src/PostgREST/MainTest.hs
 delete mode 100644 src/mock.hs

diff --git a/src/PostgREST/MainTest.hs b/src/PostgREST/MainTest.hs
deleted file mode 100644
index f9b90e9cc..000000000
--- a/src/PostgREST/MainTest.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-module Main where
-
-
-import           PostgREST.App
-import           PostgREST.Config                     (AppConfig (..),
-                                                       minimumPgVersion,
-                                                       prettyVersion,
-                                                       readOptions)
-import           PostgREST.Error                      (errResponse, PgError)
-import           PostgREST.Middleware
-import           PostgREST.DbStructure
-import           PostgREST.Types
-
-import           Control.Monad                        (unless)
-import           Control.Monad.IO.Class               (liftIO)
-import           Data.Aeson                           (encode)
-import           Data.Functor.Identity
-import           Data.Monoid                          ((<>))
-import           Data.String.Conversions              (cs)
-import           Data.Text                            (Text)
-import qualified Hasql                                as H
-import qualified Hasql.Postgres                       as P
-import           Network.Wai
-import           Network.Wai.Handler.Warp             hiding (Connection)
-import           Network.Wai.Middleware.RequestLogger (logStdout)
-import           System.IO                            (BufferMode (..),
-                                                       hSetBuffering, stderr,
-                                                       stdin, stdout)
--- import Data.Maybe (mapMaybe)
--- import Data.List (subsequences)
--- import Control.Monad (join)
--- import PostgREST.QueryBuilder
--- import           GHC.Exts              (groupWith)
-
-
-isServerVersionSupported :: H.Session P.Postgres IO Bool
-isServerVersionSupported = do
-  Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|]
-  return $ read (cs row) >= minimumPgVersion
-
-hasqlError :: PgError -> IO a
-hasqlError = error . cs . encode
-
-
-main :: IO ()
-main = do
-  hSetBuffering stdout LineBuffering
-  hSetBuffering stdin  LineBuffering
-  hSetBuffering stderr NoBuffering
-
-  -- let dbString = "postgres://postgrest_test@localhost:5432/postgrest_test" :: String
-  --     conf = AppConfig dbString 3000 "postgrest_anonymous" "test" False "safe" 10 :: AppConfig
-
-  conf <- readOptions
-  let port = configPort conf
-
-  unless ("secret" /= configJwtSecret conf) $
-    putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
-  Prelude.putStrLn $ "Listening on port " ++
-    (show $ configPort conf :: String)
-
-  let pgSettings = P.StringSettings $ cs (configDatabase conf)
-      appSettings = setPort port
-                  . setServerName (cs $ "postgrest/" <> prettyVersion)
-                  $ defaultSettings
-      middle = logStdout . defaultMiddle
-
-  poolSettings <- maybe (fail "Improper session settings") return $
-    H.poolSettings (fromIntegral $ configPool conf) 30
-  pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
-
-  supportedOrError <- H.session pool isServerVersionSupported
-  either hasqlError
-    (\supported ->
-      unless supported $
-        error (
-          "Cannot run in this PostgreSQL version, PostgREST needs at least "
-          <> show minimumPgVersion)
-    ) supportedOrError
-
-  -- what was this code for?
-  -- roleOrError <- H.session pool $ do
-  --   Identity (role :: Text) <- H.tx Nothing $ H.singleEx
-  --     [H.stmt|SELECT SESSION_USER|]
-  --   return role
-  -- authenticator <- either hasqlError return roleOrError
-
-  let txSettings = Just (H.ReadCommitted, Just True)
-  metadata <- H.session pool $ H.tx txSettings $ do
-    tabs <- allTables
-    rels <- allRelations
-    cols <- allColumns rels
-    keys <- allPrimaryKeys
-    return (tabs, rels, cols, keys)
-
-
-  db <- either hasqlError
-    (\(tabs, rels, cols, keys) ->
-
-      return DbStructure {
-          dbTables=tabs
-        , dbColumns=cols
-        , dbRelations=rels
-        , dbPrimaryKeys=keys
-        }
-    ) metadata
-  runSettings appSettings $ middle $ \ req respond -> do
-    body <- strictRequestBody req
-    resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf (app db conf body) req
-    either (respond . errResponse) respond resOrError
-
-  --let allRels = relations db
-      -- links = join $ map (combinations 2) $ filter ((>=1).length) $ groupWith groupFn $ filter ( (==Child). relType) allRels
-      -- combinations k ns = filter ((k==).length) (subsequences ns)
-
-  --print $ findRelation allRels "test" "projects" "users"
-  --mapM_ print $ mapMaybe link2Relation links
-
-  -- where
-  --   groupFn :: Relation -> Text
-  --   groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
-  --   link2Relation [
-  --     Relation{relSchema=sc, relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c},
-  --     Relation{                           relColumns=lc2, relFTable=ft, relFColumns=fc}
-  --     ]
-  --     | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
-  --     | otherwise = Nothing
-  --   link2Relation _ = Nothing
diff --git a/src/mock.hs b/src/mock.hs
deleted file mode 100644
index 411b3c309..000000000
--- a/src/mock.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-arr = eitherDecode "[{\"a\":10},{\"a\":20}]" :: Either String Value
-ob = eitherDecode "{\"a\":10}"::Either String Value
-
-rc :: Request
-rc =  Request {
-  -- | Request method such as GET.
-     requestMethod = "POST"
-  ,  pathInfo = ["menagerie"]
-  ,  requestHeaders = [("Content-Type", "text/csv")] --      :: H.RequestHeaders
-  }
-bc :: BL.ByteString
-bc = [str|integer->sub->sub2,double,varchar,boolean,date,money,enum
-         |13,3.14159,testing!,false,1900-01-01,$3.99,foo
-         |12,0.1,NULL,true,1929-10-01,12,bar
-         |]
-
-rj :: Request
-rj =  Request {
- -- | Request method such as GET.
-     requestMethod = "POST"
-  ,  pathInfo = ["menagerie"]
-  ,  requestHeaders = [("Content-Type", "application/json")] --      :: H.RequestHeaders
-  }
-bj :: BL.ByteString
-bj = [str|{
-         |  "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
-         |  , "boolean": false, "date": "1900-01-01", "money": "$3.99"
-         |  , "enum": "foo"
-         |}
-         |]
-bj2 :: BL.ByteString
-bj2 = [str|[
-          |{
-          |  "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
-          |  , "boolean": false, "date": "1900-01-01", "money": "$3.99"
-          |  , "enum": "foo"
-          |},
-          |{
-          |  "integer->sub->>sub2": 13, "double": 3.14159, "varchar": "testing!"
-          |  , "boolean": false, "date": "1900-01-01", "money": "$3.99"
-          |  , "enum": "foo"
-          |}]
-          |]