specify schema as a string everywhere in the app.

This will make it easier to support semantic API versioning,
and makes code reuse easier right now.

src/Dbapi.hs

@@ -12,7 +12,6 @@ import Control.Applicative
 import Options.Applicative hiding (columns)
 
 import Data.Maybe (fromMaybe, isJust)
-import Text.Read (readMaybe)
 import Text.Regex.TDFA ((=~))
 import Data.Map (intersection, fromList, toList, Map)
 import Data.List (sort)
@@ -84,7 +83,7 @@ app conn req respond = do
         if range == Just emptyRange
         then return $ responseLBS status416 [] "HTTP Range error"
         else do
-          r <- respondWithRangedResult <$> getRows (show ver) (unpack table) qq range conn
+          r <- respondWithRangedResult <$> getRows ver (unpack table) qq range conn
           let canonical = urlEncodeVars $ sort $
                           map (join (***) BS.unpack) $
                           parseSimpleQuery $
@@ -142,7 +141,7 @@ app conn req respond = do
     path   = pathInfo req
     verb   = requestMethod req
     qq     = queryString req
-    ver    = fromMaybe 1 $ requestedVersion (requestHeaders req)
+    ver    = fromMaybe "1" $ requestedVersion (requestHeaders req)
     range  = requestedRange (requestHeaders req)
     cRange = requestedContentRange (requestHeaders req)
 
@@ -169,10 +168,10 @@ respondWithRangedResult rr =
       | (1 + to - from) < total = status206
       | otherwise               = status200
 
-requestedVersion :: RequestHeaders -> Maybe Int
+requestedVersion :: RequestHeaders -> Maybe String
 requestedVersion hdrs =
   case verStr of
-       Just [[_, ver]] -> readMaybe ver
+       Just [[_, ver]] -> Just ver
        _ -> Nothing
 
   where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String

src/PgQuery.hs

@@ -36,8 +36,9 @@ data RangedResult = RangedResult {
 } deriving (Show)
 
 type QuotedSql = (String, [SqlValue])
+type Schema = String
 
-getRows :: String -> String -> Net.Query -> Maybe R.NonnegRange -> Connection -> IO RangedResult
+getRows :: Schema -> String -> Net.Query -> Maybe R.NonnegRange -> Connection -> IO RangedResult
 getRows schema table qq range conn = do
   query <- populateSql conn
     $ globalAndLimitedCounts schema table qq <>
@@ -88,18 +89,18 @@ limitClause range =
     limit  = fromMaybe "ALL" $ show <$> (R.limit =<< range)
     offset = fromMaybe 0     $ R.offset <$> range
 
-globalAndLimitedCounts :: String -> String -> Net.Query -> QuotedSql
+globalAndLimitedCounts :: Schema -> String -> Net.Query -> QuotedSql
 globalAndLimitedCounts schema table qq =
   (" select ", [])
   <> ("(select count(1) from %I.%I ", map toSql [schema, table])
   <> whereClause qq
   <> ("), count(t), ", [])
 
-selectStarClause :: String -> String -> QuotedSql
+selectStarClause :: Schema -> String -> QuotedSql
 selectStarClause schema table =
   (" select * from %I.%I ", map toSql [schema, table])
 
-selectCountClause :: String -> String -> QuotedSql
+selectCountClause :: Schema -> String -> QuotedSql
 selectCountClause schema table =
   (" select count(1) from %I.%I ", map toSql [schema, table])
 
@@ -107,7 +108,7 @@ jsonArrayRows :: QuotedSql -> QuotedSql
 jsonArrayRows q =
   ("array_to_json(array_agg(row_to_json(t))) from (", []) <> q <> (") t", [])
 
-insert :: Int -> Text -> SqlRow -> Connection -> IO (M.Map String SqlValue)
+insert :: Schema -> Text -> SqlRow -> Connection -> IO (M.Map String SqlValue)
 insert schema table row conn = do
   sql    <- populateSql conn $ insertClause schema table row
   stmt   <- prepare conn sql
@@ -115,7 +116,7 @@ insert schema table row conn = do
   Just m <- fetchRowMap stmt
   return m
 
-upsert :: Int -> Text -> SqlRow -> Net.Query -> Connection -> IO (M.Map String SqlValue)
+upsert :: Schema -> Text -> SqlRow -> Net.Query -> Connection -> IO (M.Map String SqlValue)
 upsert schema table row qq conn = do
   sql    <- populateSql conn $ upsertClause schema table row qq
   stmt   <- prepare conn (traceShow sql sql)
@@ -126,26 +127,26 @@ upsert schema table row qq conn = do
 placeholders :: String -> SqlRow -> String
 placeholders symbol = intercalate ", " . map (const symbol) . getRow
 
-insertClause :: Int -> Text -> SqlRow -> QuotedSql
+insertClause :: Schema -> Text -> SqlRow -> QuotedSql
 insertClause schema table row =
     ("insert into %I.%I (" ++ placeholders "%I" row ++ ")",
-     map toSql $ (pack . show $ schema) : table : sqlRowColumns row)
+     map toSql $ (pack schema) : table : sqlRowColumns row)
   <> (" values (" ++ placeholders "?" row ++ ") returning *", sqlRowValues row)
 
 
-insertClauseViaSelect :: Int -> Text -> SqlRow -> QuotedSql
+insertClauseViaSelect :: Schema -> Text -> SqlRow -> QuotedSql
 insertClauseViaSelect schema table row =
     ("insert into %I.%I (" ++ placeholders "%I" row ++ ")",
-     map toSql $ (pack . show $ schema) : table : sqlRowColumns row)
+     map toSql $ (pack schema) : table : sqlRowColumns row)
   <> (" select " ++ placeholders "?" row, sqlRowValues row)
 
-updateClause :: Int -> Text -> SqlRow -> QuotedSql
+updateClause :: Schema -> Text -> SqlRow -> QuotedSql
 updateClause schema table row =
     ("update %I.%I set (" ++ placeholders "%I" row ++ ")",
-     map toSql $ (pack . show $ schema) : table : sqlRowColumns row)
+     map toSql $ (pack schema) : table : sqlRowColumns row)
   <> (" = (" ++ placeholders "?" row ++ ")", [])
 
-upsertClause :: Int -> Text -> SqlRow -> Net.Query -> QuotedSql
+upsertClause :: Schema -> Text -> SqlRow -> Net.Query -> QuotedSql
 upsertClause schema table row qq =
   ("with upsert as (", []) <> updateClause schema table row
   <> whereClause qq

src/PgStructure.hs

@@ -88,7 +88,7 @@ tables s conn = do
         (toBool (fromSql insertable))
     mkTable _ = Nothing
 
-columns :: Int -> String -> Connection -> IO [Column]
+columns :: String -> String -> Connection -> IO [Column]
 columns s t conn = do
   r <- quickQuery conn
         "select table_schema, table_name, column_name, ordinal_position,\
@@ -96,7 +96,7 @@ columns s t conn = do
         \       character_maximum_length, numeric_precision\
         \  from information_schema.columns\
         \ where table_schema = ?\
-        \   and table_name = ?" [toSql (show s), toSql t]
+        \   and table_name = ?" [toSql s, toSql t]
   return $ mapMaybe mkColumn r
 
   where
@@ -115,10 +115,10 @@ columns s t conn = do
 namedColumnHash :: [Column] -> HashMap String Column
 namedColumnHash = fromList . (Prelude.zip =<< Prelude.map colName)
 
-printTables :: Int -> Connection -> IO BL.ByteString
+printTables :: String -> Connection -> IO BL.ByteString
-printTables schema conn = JSON.encode <$> tables (show schema) conn
+printTables schema conn = JSON.encode <$> tables schema conn
 
-printColumns :: Int -> String -> Connection -> IO BL.ByteString
+printColumns :: String -> String -> Connection -> IO BL.ByteString
 printColumns schema table conn =
   JSON.encode <$> (TableOptions <$> cols <*> pkey)
   where
@@ -127,7 +127,7 @@ printColumns schema table conn =
     pkey :: IO [String]
     pkey = primaryKeyColumns schema table conn
 
-primaryKeyColumns :: Int -> String -> Connection -> IO [String]
+primaryKeyColumns :: String -> String -> Connection -> IO [String]
 primaryKeyColumns s t conn = do
   r <- quickQuery conn
         "select kc.column_name \
@@ -139,5 +139,5 @@ primaryKeyColumns s t conn = do
         \  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 = ? \
-        \  and kc.table_name  = ?" [toSql (show s), toSql t]
+        \  and kc.table_name  = ?" [toSql s, toSql t]
   return $ map fromSql (concat r)

test/Main.hs

@@ -9,6 +9,7 @@ main :: IO ()
 main = do
   c <-openConnection
   runRaw c "drop schema if exists \"1\" cascade"
+  runRaw c "drop schema if exists dbapi cascade"
   loadFixture "schema" c
   disconnect c
   hspec spec

test/Unit/PgQuerySpec.hs

@@ -26,7 +26,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 "1" "auto_incrementing_pk" (SqlRow [
             ("non_nullable_string", toSql ("a string"::String))]) conn
         let returnRow = fromList . toList $ r
         incStr returnRow `shouldBe` "a string"
@@ -37,13 +37,17 @@ spec = around dbWithSchema $ do
         [returnRow] `shouldBe` map fromList tRows
 
       it "throws an exception if the PK is not unique" $ \conn -> do
-        r <- insert 1 "auto_incrementing_pk" (SqlRow [
+        r <- insert "1" "auto_incrementing_pk" (SqlRow [
             ("non_nullable_string", toSql ("a string"::String))]) conn
         let row = SqlRow .  map (\(k, v) -> (pack k, v)) . toList $ r
-        insert 1 "auto_incrementing_pk" row conn `shouldThrow` \e ->
+        insert "1" "auto_incrementing_pk" row conn `shouldThrow` \e ->
           seState e == "23505" -- uniqueness violation code
 
       it "throws an exception if a required value is missing" $ \conn -> do
-        insert 1 "auto_incrementing_pk" (SqlRow [
+        insert "1" "auto_incrementing_pk" (SqlRow [
           ("nullable_string", toSql ("a string"::String))]) conn
           `shouldThrow` \e -> seState e == "23502"
+
+  describe "addUser" $ do
+    it "adds a correct user to the right table" $ \_ -> do
+      pending

test/fixtures/schema.sql

@@ -3,8 +3,8 @@
 --
 
 -- Dumped from database version 9.3.4
--- Dumped by pg_dump version 9.3.1
+-- Dumped by pg_dump version 9.3.4
--- Started on 2014-08-31 10:00:41 PDT
+-- Started on 2014-09-25 16:21:25 PDT
 
 SET statement_timeout = 0;
 SET lock_timeout = 0;
@@ -14,7 +14,7 @@ SET check_function_bodies = false;
 SET client_min_messages = warning;
 
 --
--- TOC entry 6 (class 2615 OID 231254)
+-- TOC entry 6 (class 2615 OID 46226)
 -- Name: 1; Type: SCHEMA; Schema: -; Owner: -
 --
 
@@ -22,7 +22,15 @@ CREATE SCHEMA "1";
 
 
 --
--- TOC entry 178 (class 3079 OID 12018)
+-- TOC entry 7 (class 2615 OID 46227)
+-- Name: dbapi; Type: SCHEMA; Schema: -; Owner: -
+--
+
+CREATE SCHEMA dbapi;
+
+
+--
+-- TOC entry 181 (class 3079 OID 11756)
 -- Name: plpgsql; Type: EXTENSION; Schema: -; Owner: -
 --
 
@@ -30,14 +38,34 @@ CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;
 
 
 --
--- TOC entry 2248 (class 0 OID 0)
+-- TOC entry 2000 (class 0 OID 0)
--- Dependencies: 178
+-- Dependencies: 181
 -- Name: EXTENSION plpgsql; Type: COMMENT; Schema: -; Owner: -
 --
 
 COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language';
 
 
+SET search_path = dbapi, pg_catalog;
+
+--
+-- TOC entry 194 (class 1255 OID 46295)
+-- Name: check_role_exists(); Type: FUNCTION; Schema: dbapi; Owner: -
+--
+
+CREATE FUNCTION check_role_exists() RETURNS trigger
+    LANGUAGE plpgsql
+    AS $$
+begin 
+if not exists (select 1 from pg_roles as r where r.rolname = new.rolname) then
+   raise foreign_key_violation using message = 'Cannot create user with unknown role: ' || new.rolname;
+   return null;
+ end if;
+ return new;
+end
+$$;
+
+
 SET search_path = "1", pg_catalog;
 
 SET default_tablespace = '';
@@ -45,7 +73,7 @@ SET default_tablespace = '';
 SET default_with_oids = false;
 
 --
--- TOC entry 170 (class 1259 OID 231255)
+-- TOC entry 172 (class 1259 OID 46228)
 -- Name: auto_incrementing_pk; Type: TABLE; Schema: 1; Owner: -; Tablespace: 
 --
 
@@ -58,7 +86,7 @@ CREATE TABLE auto_incrementing_pk (
 
 
 --
--- TOC entry 171 (class 1259 OID 231262)
+-- TOC entry 173 (class 1259 OID 46235)
 -- Name: auto_incrementing_pk_id_seq; Type: SEQUENCE; Schema: 1; Owner: -
 --
 
@@ -71,8 +99,8 @@ CREATE SEQUENCE auto_incrementing_pk_id_seq
 
 
 --
--- TOC entry 2249 (class 0 OID 0)
+-- TOC entry 2001 (class 0 OID 0)
--- Dependencies: 171
+-- Dependencies: 173
 -- Name: auto_incrementing_pk_id_seq; Type: SEQUENCE OWNED BY; Schema: 1; Owner: -
 --
 
@@ -80,7 +108,7 @@ ALTER SEQUENCE auto_incrementing_pk_id_seq OWNED BY auto_incrementing_pk.id;
 
 
 --
--- TOC entry 172 (class 1259 OID 231264)
+-- TOC entry 174 (class 1259 OID 46237)
 -- Name: compound_pk; Type: TABLE; Schema: 1; Owner: -; Tablespace: 
 --
 
@@ -92,7 +120,7 @@ CREATE TABLE compound_pk (
 
 
 --
--- TOC entry 173 (class 1259 OID 231267)
+-- TOC entry 175 (class 1259 OID 46240)
 -- Name: items; Type: TABLE; Schema: 1; Owner: -; Tablespace: 
 --
 
@@ -102,7 +130,7 @@ CREATE TABLE items (
 
 
 --
--- TOC entry 174 (class 1259 OID 231270)
+-- TOC entry 176 (class 1259 OID 46243)
 -- Name: items_id_seq; Type: SEQUENCE; Schema: 1; Owner: -
 --
 
@@ -115,8 +143,8 @@ CREATE SEQUENCE items_id_seq
 
 
 --
--- TOC entry 2250 (class 0 OID 0)
+-- TOC entry 2002 (class 0 OID 0)
--- Dependencies: 174
+-- Dependencies: 176
 -- Name: items_id_seq; Type: SEQUENCE OWNED BY; Schema: 1; Owner: -
 --
 
@@ -124,7 +152,7 @@ ALTER SEQUENCE items_id_seq OWNED BY items.id;
 
 
 --
--- TOC entry 175 (class 1259 OID 231272)
+-- TOC entry 177 (class 1259 OID 46245)
 -- Name: menagerie; Type: TABLE; Schema: 1; Owner: -; Tablespace: 
 --
 
@@ -139,7 +167,7 @@ CREATE TABLE menagerie (
 
 
 --
--- TOC entry 176 (class 1259 OID 231278)
+-- TOC entry 178 (class 1259 OID 46251)
 -- Name: no_pk; Type: TABLE; Schema: 1; Owner: -; Tablespace: 
 --
 
@@ -150,7 +178,7 @@ CREATE TABLE no_pk (
 
 
 --
--- TOC entry 177 (class 1259 OID 231284)
+-- TOC entry 179 (class 1259 OID 46257)
 -- Name: simple_pk; Type: TABLE; Schema: 1; Owner: -; Tablespace: 
 --
 
@@ -160,8 +188,23 @@ CREATE TABLE simple_pk (
 );
 
 
+SET search_path = dbapi, pg_catalog;
+
 --
--- TOC entry 2116 (class 2604 OID 231290)
+-- TOC entry 180 (class 1259 OID 46284)
+-- Name: auth; Type: TABLE; Schema: dbapi; Owner: -; Tablespace: 
+--
+
+CREATE TABLE auth (
+    id character varying NOT NULL,
+    rolname name NOT NULL
+);
+
+
+SET search_path = "1", pg_catalog;
+
+--
+-- TOC entry 1862 (class 2604 OID 46269)
 -- Name: id; Type: DEFAULT; Schema: 1; Owner: -
 --
 
@@ -169,7 +212,7 @@ ALTER TABLE ONLY auto_incrementing_pk ALTER COLUMN id SET DEFAULT nextval('auto_
 
 
 --
--- TOC entry 2117 (class 2604 OID 231291)
+-- TOC entry 1863 (class 2604 OID 46270)
 -- Name: id; Type: DEFAULT; Schema: 1; Owner: -
 --
 
@@ -177,33 +220,33 @@ ALTER TABLE ONLY items ALTER COLUMN id SET DEFAULT nextval('items_id_seq'::regcl
 
 
 --
--- TOC entry 2235 (class 0 OID 231255)
+-- TOC entry 1984 (class 0 OID 46228)
--- Dependencies: 170
+-- Dependencies: 172
 -- Data for Name: auto_incrementing_pk; Type: TABLE DATA; Schema: 1; Owner: -
 --
 
 
 
 --
--- TOC entry 2251 (class 0 OID 0)
+-- TOC entry 2003 (class 0 OID 0)
--- Dependencies: 171
+-- Dependencies: 173
 -- Name: auto_incrementing_pk_id_seq; Type: SEQUENCE SET; Schema: 1; Owner: -
 --
 
-SELECT pg_catalog.setval('auto_incrementing_pk_id_seq', 1, true);
+SELECT pg_catalog.setval('auto_incrementing_pk_id_seq', 9, true);
 
 
 --
--- TOC entry 2237 (class 0 OID 231264)
+-- TOC entry 1986 (class 0 OID 46237)
--- Dependencies: 172
+-- Dependencies: 174
 -- Data for Name: compound_pk; Type: TABLE DATA; Schema: 1; Owner: -
 --
 
 
 
 --
--- TOC entry 2238 (class 0 OID 231267)
+-- TOC entry 1987 (class 0 OID 46240)
--- Dependencies: 173
+-- Dependencies: 175
 -- Data for Name: items; Type: TABLE DATA; Schema: 1; Owner: -
 --
 
@@ -225,8 +268,8 @@ INSERT INTO items (id) VALUES (15);
 
 
 --
--- TOC entry 2252 (class 0 OID 0)
+-- TOC entry 2004 (class 0 OID 0)
--- Dependencies: 174
+-- Dependencies: 176
 -- Name: items_id_seq; Type: SEQUENCE SET; Schema: 1; Owner: -
 --
 
@@ -234,31 +277,44 @@ SELECT pg_catalog.setval('items_id_seq', 15, true);
 
 
 --
--- TOC entry 2240 (class 0 OID 231272)
+-- TOC entry 1989 (class 0 OID 46245)
--- Dependencies: 175
+-- Dependencies: 177
 -- Data for Name: menagerie; Type: TABLE DATA; Schema: 1; Owner: -
 --
 
 
 
 --
--- TOC entry 2241 (class 0 OID 231278)
+-- TOC entry 1990 (class 0 OID 46251)
--- Dependencies: 176
+-- Dependencies: 178
 -- Data for Name: no_pk; Type: TABLE DATA; Schema: 1; Owner: -
 --
 
 
 
 --
--- TOC entry 2242 (class 0 OID 231284)
+-- TOC entry 1991 (class 0 OID 46257)
--- Dependencies: 177
+-- Dependencies: 179
 -- Data for Name: simple_pk; Type: TABLE DATA; Schema: 1; Owner: -
 --
 
 
 
+SET search_path = dbapi, pg_catalog;
+
 --
--- TOC entry 2119 (class 2606 OID 231293)
+-- TOC entry 1992 (class 0 OID 46284)
+-- Dependencies: 180
+-- Data for Name: auth; Type: TABLE DATA; Schema: dbapi; Owner: -
+--
+
+INSERT INTO auth (id, rolname) VALUES ('me@me.com', 'adam');
+
+
+SET search_path = "1", pg_catalog;
+
+--
+-- TOC entry 1865 (class 2606 OID 46272)
 -- Name: auto_incrementing_pk_pkey; Type: CONSTRAINT; Schema: 1; Owner: -; Tablespace: 
 --
 
@@ -267,7 +323,7 @@ ALTER TABLE ONLY auto_incrementing_pk
 
 
 --
--- TOC entry 2121 (class 2606 OID 231295)
+-- TOC entry 1867 (class 2606 OID 46274)
 -- Name: compound_pk_pkey; Type: CONSTRAINT; Schema: 1; Owner: -; Tablespace: 
 --
 
@@ -276,7 +332,7 @@ ALTER TABLE ONLY compound_pk
 
 
 --
--- TOC entry 2127 (class 2606 OID 231297)
+-- TOC entry 1873 (class 2606 OID 46276)
 -- Name: contacts_pkey; Type: CONSTRAINT; Schema: 1; Owner: -; Tablespace: 
 --
 
@@ -285,7 +341,7 @@ ALTER TABLE ONLY simple_pk
 
 
 --
--- TOC entry 2123 (class 2606 OID 231299)
+-- TOC entry 1869 (class 2606 OID 46278)
 -- Name: items_pkey; Type: CONSTRAINT; Schema: 1; Owner: -; Tablespace: 
 --
 
@@ -294,7 +350,7 @@ ALTER TABLE ONLY items
 
 
 --
--- TOC entry 2125 (class 2606 OID 231301)
+-- TOC entry 1871 (class 2606 OID 46280)
 -- Name: menagerie_pkey; Type: CONSTRAINT; Schema: 1; Owner: -; Tablespace: 
 --
 
@@ -302,7 +358,38 @@ ALTER TABLE ONLY menagerie
     ADD CONSTRAINT menagerie_pkey PRIMARY KEY ("integer");
 
 
--- Completed on 2014-08-31 10:00:41 PDT
+SET search_path = dbapi, pg_catalog;
+
+--
+-- TOC entry 1875 (class 2606 OID 46291)
+-- Name: auth_pkey; Type: CONSTRAINT; Schema: dbapi; Owner: -; Tablespace: 
+--
+
+ALTER TABLE ONLY auth
+    ADD CONSTRAINT auth_pkey PRIMARY KEY (id);
+
+
+--
+-- TOC entry 1876 (class 2620 OID 46297)
+-- Name: ensure_auth_role_exists; Type: TRIGGER; Schema: dbapi; Owner: -
+--
+
+CREATE CONSTRAINT TRIGGER ensure_auth_role_exists AFTER INSERT OR UPDATE ON auth NOT DEFERRABLE INITIALLY IMMEDIATE FOR EACH ROW EXECUTE PROCEDURE check_role_exists();
+
+
+--
+-- TOC entry 1999 (class 0 OID 0)
+-- Dependencies: 8
+-- Name: public; Type: ACL; Schema: -; Owner: -
+--
+
+REVOKE ALL ON SCHEMA public FROM PUBLIC;
+REVOKE ALL ON SCHEMA public FROM postgres;
+GRANT ALL ON SCHEMA public TO postgres;
+GRANT ALL ON SCHEMA public TO PUBLIC;
+
+
+-- Completed on 2014-09-25 16:21:25 PDT
 
 --
 -- PostgreSQL database dump complete