diff --git a/src/Dbapi.hs b/src/Dbapi.hs index 108dc3df1..e5c93df1e 100644 --- a/src/Dbapi.hs +++ b/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 diff --git a/src/PgQuery.hs b/src/PgQuery.hs index 0dff3a678..045dafbe1 100644 --- a/src/PgQuery.hs +++ b/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 diff --git a/src/PgStructure.hs b/src/PgStructure.hs index 02767aa76..5622ae76f 100644 --- a/src/PgStructure.hs +++ b/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 schema conn = JSON.encode <$> tables (show schema) conn +printTables :: String -> Connection -> IO BL.ByteString +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) diff --git a/test/Main.hs b/test/Main.hs index c0a6f9d7d..b6a225fea 100644 --- a/test/Main.hs +++ b/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 diff --git a/test/Unit/PgQuerySpec.hs b/test/Unit/PgQuerySpec.hs index e9625876f..df47c3366 100644 --- a/test/Unit/PgQuerySpec.hs +++ b/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 diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index 1353c8896..2786e92ce 100644 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -3,8 +3,8 @@ -- -- Dumped from database version 9.3.4 --- Dumped by pg_dump version 9.3.1 --- Started on 2014-08-31 10:00:41 PDT +-- Dumped by pg_dump version 9.3.4 +-- 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) --- Dependencies: 178 +-- TOC entry 2000 (class 0 OID 0) +-- 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) --- Dependencies: 171 +-- TOC entry 2001 (class 0 OID 0) +-- 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) --- Dependencies: 174 +-- TOC entry 2002 (class 0 OID 0) +-- 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) --- Dependencies: 170 +-- TOC entry 1984 (class 0 OID 46228) +-- Dependencies: 172 -- Data for Name: auto_incrementing_pk; Type: TABLE DATA; Schema: 1; Owner: - -- -- --- TOC entry 2251 (class 0 OID 0) --- Dependencies: 171 +-- TOC entry 2003 (class 0 OID 0) +-- 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) --- Dependencies: 172 +-- TOC entry 1986 (class 0 OID 46237) +-- Dependencies: 174 -- Data for Name: compound_pk; Type: TABLE DATA; Schema: 1; Owner: - -- -- --- TOC entry 2238 (class 0 OID 231267) --- Dependencies: 173 +-- TOC entry 1987 (class 0 OID 46240) +-- 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) --- Dependencies: 174 +-- TOC entry 2004 (class 0 OID 0) +-- 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) --- Dependencies: 175 +-- TOC entry 1989 (class 0 OID 46245) +-- Dependencies: 177 -- Data for Name: menagerie; Type: TABLE DATA; Schema: 1; Owner: - -- -- --- TOC entry 2241 (class 0 OID 231278) --- Dependencies: 176 +-- TOC entry 1990 (class 0 OID 46251) +-- Dependencies: 178 -- Data for Name: no_pk; Type: TABLE DATA; Schema: 1; Owner: - -- -- --- TOC entry 2242 (class 0 OID 231284) --- Dependencies: 177 +-- TOC entry 1991 (class 0 OID 46257) +-- 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