From e302bb1d19f92e9e262d2b710a4d6e393e7040c2 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Tue, 7 Oct 2014 16:14:34 -0700 Subject: [PATCH 01/11] add table with fk for testing. --- test/fixtures/schema.sql | 206 ++++++++++++++++++++++----------------- 1 file changed, 119 insertions(+), 87 deletions(-) diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index 0c831cfe5..6ce0b9468 100644 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -5,6 +5,7 @@ -- Dumped from database version 9.3.4 -- Dumped by pg_dump version 9.3.4 -- Started on 2014-10-01 13:41:39 PDT +-- Started on 2014-10-07 16:46:34 PDT SET statement_timeout = 0; SET lock_timeout = 0; @@ -24,7 +25,7 @@ CREATE SCHEMA "1"; ALTER SCHEMA "1" OWNER TO dbapi_test; -- --- TOC entry 9 (class 2615 OID 280933) +-- TOC entry 8 (class 2615 OID 50928) -- Name: dbapi; Type: SCHEMA; Schema: -; Owner: dbapi_test -- @@ -34,7 +35,7 @@ CREATE SCHEMA dbapi; ALTER SCHEMA dbapi OWNER TO dbapi_test; -- --- TOC entry 10 (class 2615 OID 280934) +-- TOC entry 9 (class 2615 OID 50929) -- Name: private; Type: SCHEMA; Schema: -; Owner: dbapi_test -- @@ -133,7 +134,7 @@ CREATE TABLE auto_incrementing_pk ( ALTER TABLE "1".auto_incrementing_pk OWNER TO dbapi_test; -- --- TOC entry 176 (class 1259 OID 280944) +-- TOC entry 182 (class 1259 OID 50939) -- Name: auto_incrementing_pk_id_seq; Type: SEQUENCE; Schema: 1; Owner: dbapi_test -- @@ -171,7 +172,45 @@ CREATE TABLE compound_pk ( ALTER TABLE "1".compound_pk OWNER TO dbapi_test; -- --- TOC entry 178 (class 1259 OID 280949) +-- TOC entry 184 (class 1259 OID 50944) +-- Name: has_fk; Type: TABLE; Schema: 1; Owner: dbapi_test; Tablespace: +-- + +CREATE TABLE has_fk ( + id bigint NOT NULL, + auto_inc_fk integer, + simple_fk character varying(255) +); + + +ALTER TABLE "1".has_fk OWNER TO dbapi_test; + +-- +-- TOC entry 185 (class 1259 OID 50947) +-- Name: has_fk_id_seq; Type: SEQUENCE; Schema: 1; Owner: dbapi_test +-- + +CREATE SEQUENCE has_fk_id_seq + START WITH 1 + INCREMENT BY 1 + NO MINVALUE + NO MAXVALUE + CACHE 1; + + +ALTER TABLE "1".has_fk_id_seq OWNER TO dbapi_test; + +-- +-- TOC entry 2042 (class 0 OID 0) +-- Dependencies: 185 +-- Name: has_fk_id_seq; Type: SEQUENCE OWNED BY; Schema: 1; Owner: dbapi_test +-- + +ALTER SEQUENCE has_fk_id_seq OWNED BY has_fk.id; + + +-- +-- TOC entry 186 (class 1259 OID 50949) -- Name: items; Type: TABLE; Schema: 1; Owner: dbapi_test; Tablespace: -- @@ -183,7 +222,7 @@ CREATE TABLE items ( ALTER TABLE "1".items OWNER TO dbapi_test; -- --- TOC entry 179 (class 1259 OID 280952) +-- TOC entry 187 (class 1259 OID 50952) -- Name: items_id_seq; Type: SEQUENCE; Schema: 1; Owner: dbapi_test -- @@ -316,7 +355,15 @@ ALTER TABLE ONLY auto_incrementing_pk ALTER COLUMN id SET DEFAULT nextval('auto_ -- --- TOC entry 2141 (class 2604 OID 280987) +-- TOC entry 1886 (class 2604 OID 50987) +-- Name: id; Type: DEFAULT; Schema: 1; Owner: dbapi_test +-- + +ALTER TABLE ONLY has_fk ALTER COLUMN id SET DEFAULT nextval('has_fk_id_seq'::regclass); + + +-- +-- TOC entry 1887 (class 2604 OID 50988) -- Name: id; Type: DEFAULT; Schema: 1; Owner: dbapi_test -- @@ -351,26 +398,34 @@ SET search_path = "1", pg_catalog; --- --- TOC entry 2302 (class 0 OID 0) --- Dependencies: 176 +-- TOC entry 2051 (class 0 OID 0) +-- Dependencies: 182 -- Name: auto_incrementing_pk_id_seq; Type: SEQUENCE SET; Schema: 1; Owner: dbapi_test -- -SELECT pg_catalog.setval('auto_incrementing_pk_id_seq', 46, true); +SELECT pg_catalog.setval('auto_incrementing_pk_id_seq', 50, true); -- --- TOC entry 2270 (class 0 OID 280946) --- Dependencies: 177 +-- TOC entry 2018 (class 0 OID 50941) +-- Dependencies: 183 -- Data for Name: compound_pk; Type: TABLE DATA; Schema: 1; Owner: dbapi_test -- -- --- TOC entry 2271 (class 0 OID 280949) --- Dependencies: 178 +-- TOC entry 2052 (class 0 OID 0) +-- Dependencies: 185 +-- Name: has_fk_id_seq; Type: SEQUENCE SET; Schema: 1; Owner: dbapi_test +-- + +SELECT pg_catalog.setval('has_fk_id_seq', 1, false); + + +-- +-- TOC entry 2021 (class 0 OID 50949) +-- Dependencies: 186 -- Data for Name: items; Type: TABLE DATA; Schema: 1; Owner: dbapi_test -- @@ -401,52 +456,33 @@ SELECT pg_catalog.setval('items_id_seq', 15, true); -- --- TOC entry 2273 (class 0 OID 280954) --- Dependencies: 180 --- Data for Name: menagerie; Type: TABLE DATA; Schema: 1; Owner: dbapi_test --- - - - --- +-- TOC entry 2023 (class 0 OID 50954) +-- Dependencies: 188 -- TOC entry 2274 (class 0 OID 280960) -- Dependencies: 181 +-- TOC entry 2024 (class 0 OID 50960) +-- Dependencies: 189 -- Data for Name: no_pk; Type: TABLE DATA; Schema: 1; Owner: dbapi_test -- -- --- TOC entry 2275 (class 0 OID 280966) --- Dependencies: 182 --- Data for Name: simple_pk; Type: TABLE DATA; Schema: 1; Owner: dbapi_test --- - SET search_path = dbapi, pg_catalog; -- --- TOC entry 2276 (class 0 OID 280972) --- Dependencies: 183 --- Data for Name: auth; Type: TABLE DATA; Schema: dbapi; Owner: dbapi_test -- - SET search_path = private, pg_catalog; -- --- TOC entry 2277 (class 0 OID 280978) --- Dependencies: 184 --- Data for Name: articles; Type: TABLE DATA; Schema: private; Owner: dbapi_test --- -- --- TOC entry 2304 (class 0 OID 0) --- Dependencies: 185 -- Name: articles_id_seq; Type: SEQUENCE SET; Schema: private; Owner: dbapi_test -- @@ -455,9 +491,6 @@ SELECT pg_catalog.setval('articles_id_seq', 1, false); SET search_path = "1", pg_catalog; --- --- TOC entry 2158 (class 2606 OID 281013) --- Name: authors_only_pkey; Type: CONSTRAINT; Schema: 1; Owner: dbapi_test_author; Tablespace: -- ALTER TABLE ONLY authors_only @@ -466,7 +499,6 @@ ALTER TABLE ONLY authors_only -- -- TOC entry 2144 (class 2606 OID 280990) --- Name: auto_incrementing_pk_pkey; Type: CONSTRAINT; Schema: 1; Owner: dbapi_test; Tablespace: -- ALTER TABLE ONLY auto_incrementing_pk @@ -474,7 +506,7 @@ ALTER TABLE ONLY auto_incrementing_pk -- --- TOC entry 2146 (class 2606 OID 280992) +-- TOC entry 1892 (class 2606 OID 50993) -- Name: compound_pk_pkey; Type: CONSTRAINT; Schema: 1; Owner: dbapi_test; Tablespace: -- @@ -483,8 +515,6 @@ ALTER TABLE ONLY compound_pk -- --- TOC entry 2152 (class 2606 OID 280994) --- Name: contacts_pkey; Type: CONSTRAINT; Schema: 1; Owner: dbapi_test; Tablespace: -- ALTER TABLE ONLY simple_pk @@ -492,8 +522,16 @@ ALTER TABLE ONLY simple_pk -- --- TOC entry 2148 (class 2606 OID 280996) --- Name: items_pkey; Type: CONSTRAINT; Schema: 1; Owner: dbapi_test; Tablespace: +-- TOC entry 1894 (class 2606 OID 50997) +-- Name: has_fk_pkey; Type: CONSTRAINT; Schema: 1; Owner: dbapi_test; Tablespace: +-- + +ALTER TABLE ONLY has_fk + ADD CONSTRAINT has_fk_pkey PRIMARY KEY (id); + + +-- +-- TOC entry 1896 (class 2606 OID 50999) -- ALTER TABLE ONLY items @@ -501,7 +539,6 @@ ALTER TABLE ONLY items -- --- TOC entry 2150 (class 2606 OID 280998) -- Name: menagerie_pkey; Type: CONSTRAINT; Schema: 1; Owner: dbapi_test; Tablespace: -- @@ -512,7 +549,6 @@ ALTER TABLE ONLY menagerie SET search_path = dbapi, pg_catalog; -- --- TOC entry 2154 (class 2606 OID 281000) -- Name: auth_pkey; Type: CONSTRAINT; Schema: dbapi; Owner: dbapi_test; Tablespace: -- @@ -523,7 +559,6 @@ ALTER TABLE ONLY auth SET search_path = private, pg_catalog; -- --- TOC entry 2156 (class 2606 OID 281002) -- Name: articles_pkey; Type: CONSTRAINT; Schema: private; Owner: dbapi_test; Tablespace: -- @@ -534,7 +569,6 @@ ALTER TABLE ONLY articles SET search_path = dbapi, pg_catalog; -- --- TOC entry 2159 (class 2620 OID 281004) -- Name: ensure_auth_role_exists; Type: TRIGGER; Schema: dbapi; Owner: dbapi_test -- @@ -544,16 +578,33 @@ CREATE CONSTRAINT TRIGGER ensure_auth_role_exists AFTER INSERT OR UPDATE ON auth SET search_path = private, pg_catalog; -- --- TOC entry 2160 (class 2620 OID 281005) -- Name: articles_owner_track; Type: TRIGGER; Schema: private; Owner: dbapi_test -- CREATE TRIGGER articles_owner_track BEFORE INSERT OR UPDATE ON articles FOR EACH ROW EXECUTE PROCEDURE dbapi.update_owner(); +SET search_path = "1", pg_catalog; + +-- +-- TOC entry 1905 (class 2606 OID 51009) +-- Name: has_fk_fk_fkey; Type: FK CONSTRAINT; Schema: 1; Owner: dbapi_test +-- + +ALTER TABLE ONLY has_fk + ADD CONSTRAINT has_fk_fk_fkey FOREIGN KEY (auto_inc_fk) REFERENCES auto_incrementing_pk(id); + + +-- +-- TOC entry 1906 (class 2606 OID 51015) +-- Name: has_fk_simple_fk_fkey; Type: FK CONSTRAINT; Schema: 1; Owner: dbapi_test +-- + +ALTER TABLE ONLY has_fk + ADD CONSTRAINT has_fk_simple_fk_fkey FOREIGN KEY (simple_fk) REFERENCES simple_pk(k); + + -- --- TOC entry 2285 (class 0 OID 0) --- Dependencies: 11 -- Name: 1; Type: ACL; Schema: -; Owner: dbapi_test -- @@ -562,7 +613,17 @@ GRANT ALL ON SCHEMA "1" TO dbapi_test; GRANT USAGE ON SCHEMA "1" TO dbapi_anonymous; -SET search_path = "1", pg_catalog; +-- +-- TOC entry 2036 (class 0 OID 0) +-- Dependencies: 15 +-- Name: public; Type: ACL; Schema: -; Owner: postgres +-- + +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; + -- -- TOC entry 2289 (class 0 OID 0) @@ -586,31 +647,8 @@ GRANT ALL ON TABLE auto_incrementing_pk TO dbapi_anonymous; -- --- TOC entry 2292 (class 0 OID 0) --- Dependencies: 176 --- Name: auto_incrementing_pk_id_seq; Type: ACL; Schema: 1; Owner: dbapi_test --- - -REVOKE ALL ON SEQUENCE auto_incrementing_pk_id_seq FROM dbapi_test; -GRANT ALL ON SEQUENCE auto_incrementing_pk_id_seq TO dbapi_test; -GRANT USAGE ON SEQUENCE auto_incrementing_pk_id_seq TO dbapi_anonymous; - - --- --- TOC entry 2293 (class 0 OID 0) --- Dependencies: 177 --- Name: compound_pk; Type: ACL; Schema: 1; Owner: dbapi_test --- - -REVOKE ALL ON TABLE compound_pk FROM dbapi_test; -GRANT ALL ON TABLE compound_pk TO dbapi_test; -GRANT ALL ON TABLE compound_pk TO dbapi_anonymous; - - --- --- TOC entry 2294 (class 0 OID 0) --- Dependencies: 178 --- Name: items; Type: ACL; Schema: 1; Owner: dbapi_test +-- TOC entry 2043 (class 0 OID 0) +-- Dependencies: 186 -- REVOKE ALL ON TABLE items FROM dbapi_test; @@ -630,8 +668,8 @@ GRANT USAGE ON SEQUENCE items_id_seq TO dbapi_anonymous; -- --- TOC entry 2297 (class 0 OID 0) --- Dependencies: 180 +-- TOC entry 2046 (class 0 OID 0) +-- Dependencies: 188 -- Name: menagerie; Type: ACL; Schema: 1; Owner: dbapi_test -- @@ -674,9 +712,3 @@ REVOKE ALL ON TABLE articles FROM dbapi_test; GRANT ALL ON TABLE articles TO dbapi_test; --- Completed on 2014-10-01 13:41:40 PDT - --- --- PostgreSQL database dump complete --- - From 5063dfe894065d04211d3fd7cb209c241598cca9 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Tue, 7 Oct 2014 16:41:02 -0700 Subject: [PATCH 02/11] simple unit tests for existing functionality --- test/Unit/PgStructureSpec.hs | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) create mode 100644 test/Unit/PgStructureSpec.hs diff --git a/test/Unit/PgStructureSpec.hs b/test/Unit/PgStructureSpec.hs new file mode 100644 index 000000000..059283c69 --- /dev/null +++ b/test/Unit/PgStructureSpec.hs @@ -0,0 +1,23 @@ +module Unit.PgStructureSpec where + +import Test.Hspec +import PgStructure (Table(..), tables, Column(..), columns) + +import Database.HDBC (quickQuery) +import SpecHelper(dbWithSchema) + +spec :: Spec +spec = around dbWithSchema $ beforeWith setRole $ do + describe "tables" $ + it "shows all the tables" $ \conn -> do + ts <- tables "1" conn + map tableName ts `shouldBe` ["auto_incrementing_pk","compound_pk", + "has_fk","items","menagerie","no_pk", "simple_pk"] + + describe "columns" $ + it "responds with each column for the table" $ \conn -> do + cs <- columns "1" "auto_incrementing_pk" conn + map colName cs `shouldBe` ["id","nullable_string","non_nullable_string", + "inserted_at"] + + where setRole = \conn -> quickQuery conn "set role dbapi_test" [] >> return conn From d16ecdc28fd42b6800b5abef63d40c46767ed4f1 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Tue, 7 Oct 2014 17:48:03 -0700 Subject: [PATCH 03/11] data/procedure for foreign key --- src/PgStructure.hs | 20 ++++++++++++++++++++ test/Unit/PgStructureSpec.hs | 13 +++++++++++-- 2 files changed, 31 insertions(+), 2 deletions(-) diff --git a/src/PgStructure.hs b/src/PgStructure.hs index 8ffdbdcc7..a6c25f157 100644 --- a/src/PgStructure.hs +++ b/src/PgStructure.hs @@ -36,6 +36,26 @@ instance JSON.ToJSON Table where toBool :: String -> Bool toBool = (== "YES") +data ForeignKey = ForeignKey { + fkCol::String, fkTableReferred::String, fkColReferred::String +} deriving (Eq, Show) + +foreignKeys :: String -> String -> Connection -> IO [ForeignKey] +foreignKeys schema table conn = do + r <- quickQuery conn + "select kcu.column_name, ccu.table_name AS foreign_table_name,\ + \ ccu.column_name AS foreign_column_name \ + \from information_schema.table_constraints AS tc \ + \ join information_schema.key_column_usage AS kcu \ + \ on tc.constraint_name = kcu.constraint_name \ + \ join information_schema.constraint_column_usage AS ccu \ + \ on ccu.constraint_name = tc.constraint_name \ + \where constraint_type = 'FOREIGN KEY' \ + \ and tc.table_name=? and tc.table_schema = ? \ + \order by kcu.column_name" (map toSql [table, schema]) + return [ForeignKey col reftab refcol | [col, reftab, refcol] <- + map (map fromSql) r] + data Column = Column { colSchema :: String , colTable :: String diff --git a/test/Unit/PgStructureSpec.hs b/test/Unit/PgStructureSpec.hs index 059283c69..bf9480b4d 100644 --- a/test/Unit/PgStructureSpec.hs +++ b/test/Unit/PgStructureSpec.hs @@ -1,7 +1,8 @@ module Unit.PgStructureSpec where import Test.Hspec -import PgStructure (Table(..), tables, Column(..), columns) +import PgStructure (Table(..), tables, Column(..), columns, ForeignKey(..), + foreignKeys) import Database.HDBC (quickQuery) import SpecHelper(dbWithSchema) @@ -20,4 +21,12 @@ spec = around dbWithSchema $ beforeWith setRole $ do map colName cs `shouldBe` ["id","nullable_string","non_nullable_string", "inserted_at"] - where setRole = \conn -> quickQuery conn "set role dbapi_test" [] >> return conn + describe "foreignKeys" $ + it "has a description of the foreign key columns" $ \conn -> + foreignKeys "1" "has_fk" conn `shouldReturn` [ + ForeignKey { fkCol="auto_inc_fk", + fkTableReferred="auto_incrementing_pk", fkColReferred="id"}, + ForeignKey { fkCol="simple_fk", fkTableReferred="simple_pk", + fkColReferred="k"} + ] + where setRole conn = quickQuery conn "set role dbapi_test" [] >> return conn From 59f985536299be0388cbda10c6e8b9fbbd3ba743 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Tue, 7 Oct 2014 22:39:08 -0700 Subject: [PATCH 04/11] return a map of foreign keys --- src/PgStructure.hs | 12 +++++++----- test/Unit/PgStructureSpec.hs | 10 ++++------ 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/PgStructure.hs b/src/PgStructure.hs index a6c25f157..53bc70096 100644 --- a/src/PgStructure.hs +++ b/src/PgStructure.hs @@ -11,8 +11,8 @@ import Data.Maybe (mapMaybe) import Control.Applicative ( (<*>) ) import qualified Data.ByteString.Lazy as BL - import qualified Data.Aeson as JSON +import qualified Data.Map as Map import Database.HDBC hiding (colType, colNullable) import Database.HDBC.PostgreSQL @@ -37,10 +37,10 @@ toBool :: String -> Bool toBool = (== "YES") data ForeignKey = ForeignKey { - fkCol::String, fkTableReferred::String, fkColReferred::String + fkTable::String, fkCol::String } deriving (Eq, Show) -foreignKeys :: String -> String -> Connection -> IO [ForeignKey] +foreignKeys :: String -> String -> Connection -> IO (Map.Map String ForeignKey) foreignKeys schema table conn = do r <- quickQuery conn "select kcu.column_name, ccu.table_name AS foreign_table_name,\ @@ -53,8 +53,10 @@ foreignKeys schema table conn = do \where constraint_type = 'FOREIGN KEY' \ \ and tc.table_name=? and tc.table_schema = ? \ \order by kcu.column_name" (map toSql [table, schema]) - return [ForeignKey col reftab refcol | [col, reftab, refcol] <- - map (map fromSql) r] + return $ foldl addKey Map.empty $ map (map fromSql) r + where + addKey m [col, ftab, fcol] = Map.insert col (ForeignKey ftab fcol) m + addKey m _ = m --should never happen data Column = Column { colSchema :: String diff --git a/test/Unit/PgStructureSpec.hs b/test/Unit/PgStructureSpec.hs index bf9480b4d..9045dc044 100644 --- a/test/Unit/PgStructureSpec.hs +++ b/test/Unit/PgStructureSpec.hs @@ -6,6 +6,7 @@ import PgStructure (Table(..), tables, Column(..), columns, ForeignKey(..), import Database.HDBC (quickQuery) import SpecHelper(dbWithSchema) +import qualified Data.Map as M; spec :: Spec spec = around dbWithSchema $ beforeWith setRole $ do @@ -23,10 +24,7 @@ spec = around dbWithSchema $ beforeWith setRole $ do describe "foreignKeys" $ it "has a description of the foreign key columns" $ \conn -> - foreignKeys "1" "has_fk" conn `shouldReturn` [ - ForeignKey { fkCol="auto_inc_fk", - fkTableReferred="auto_incrementing_pk", fkColReferred="id"}, - ForeignKey { fkCol="simple_fk", fkTableReferred="simple_pk", - fkColReferred="k"} - ] + foreignKeys "1" "has_fk" conn `shouldReturn` M.fromList [ + ("auto_inc_fk", ForeignKey {fkTable="auto_incrementing_pk", fkCol="id"}), + ("simple_fk", ForeignKey { fkTable="simple_pk", fkCol="k"})] where setRole conn = quickQuery conn "set role dbapi_test" [] >> return conn From f0e8d23dd298e10da7659216782b6537b478fa80 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Tue, 7 Oct 2014 23:52:51 -0700 Subject: [PATCH 05/11] getting foreign key data with a column. --- src/PgStructure.hs | 18 +++++++++--------- test/Unit/PgStructureSpec.hs | 8 +++++++- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/src/PgStructure.hs b/src/PgStructure.hs index 53bc70096..42d5a6c45 100644 --- a/src/PgStructure.hs +++ b/src/PgStructure.hs @@ -1,8 +1,6 @@ --- {{{ Imports - +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# LANGUAGE OverloadedStrings #-} - module PgStructure where import Data.Functor ( (<$>) ) @@ -19,8 +17,6 @@ import Database.HDBC.PostgreSQL import Data.Aeson ((.=)) --- }}} - data Table = Table { tableSchema :: String , tableName :: String @@ -69,6 +65,7 @@ data Column = Column { , colMaxLen :: Maybe Int , colPrecision :: Maybe Int , colDefault :: Maybe String +, colFK :: Maybe ForeignKey } deriving (Show) instance JSON.ToJSON Column where @@ -120,11 +117,15 @@ columns s t conn = do \ from information_schema.columns\ \ where table_schema = ?\ \ and table_name = ?" [toSql s, toSql t] - return $ mapMaybe mkColumn r + fks <- foreignKeys s t conn + let lookupFK (_:_:name:_) = Map.lookup (fromSql name) fks + lookupFK _ = Nothing + let cols = zipWith ($) (map mkColumn r) (map lookupFK r) + return cols where - mkColumn [schema, table, name, pos, nullable, colT, updatable, maxlen, precision, defVal] = - Just $ Column (fromSql schema) + --TODO: handle failed pattern match with an appropriate exception + mkColumn [schema, table, name, pos, nullable, colT, updatable, maxlen, precision, defVal] = Column (fromSql schema) (fromSql table) (fromSql name) (fromSql pos) @@ -134,7 +135,6 @@ columns s t conn = do (fromSql maxlen) (fromSql precision) (fromSql defVal) - mkColumn _ = Nothing printTables :: String -> Connection -> IO BL.ByteString printTables schema conn = JSON.encode <$> tables schema conn diff --git a/test/Unit/PgStructureSpec.hs b/test/Unit/PgStructureSpec.hs index 9045dc044..e0a177b14 100644 --- a/test/Unit/PgStructureSpec.hs +++ b/test/Unit/PgStructureSpec.hs @@ -16,12 +16,18 @@ spec = around dbWithSchema $ beforeWith setRole $ do map tableName ts `shouldBe` ["auto_incrementing_pk","compound_pk", "has_fk","items","menagerie","no_pk", "simple_pk"] - describe "columns" $ + describe "columns" $ do it "responds with each column for the table" $ \conn -> do cs <- columns "1" "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 + 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 [ From 40f3056ef4219c808970c25cb618c4d3bf7d3a5d Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Wed, 8 Oct 2014 15:10:11 -0700 Subject: [PATCH 06/11] some more setup/teardown actions --- test/SpecHelper.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 94d1062f9..e3c2de74c 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -10,6 +10,7 @@ import Database.HDBC.PostgreSQL import Data.String.Conversions (cs) import Data.Either (isLeft) +import Control.Exception.Base (bracket, finally) import Control.Exception.Base (bracket, tryJust) import Control.Monad (when) @@ -24,6 +25,7 @@ import qualified Data.ByteString.Char8 as BS import Network.Wai.Middleware.Cors (cors) import Dbapi (app, corsPolicy, AppConfig(..)) +import PgQuery(addUser) cfg :: AppConfig cfg = AppConfig "postgres://dbapi_test:@localhost:5432/dbapi_test" 9000 "test/test.crt" "test/test.key" "dbapi_anonymous" @@ -45,6 +47,20 @@ dbWithSchema action = withDatabaseConnection $ \c -> do action c rollback c +withUser :: BS.ByteString -> BS.ByteString -> BS.ByteString -> + ActionWith Connection -> ActionWith Connection +withUser name pass role action conn = do + addUser name pass role conn + finally (action conn) $ do + _ <- run conn "delete from dbapi.auth where id=?" [toSql name] + runRaw conn "commit" + +withApp :: ActionWith Application -> ActionWith Connection +withApp action conn = do + runRaw conn "begin;" + action $ cors corsPolicy $ app conn "dbapi_anonymous" + rollback conn + appWithFixture :: ActionWith Application -> IO () appWithFixture action = withDatabaseConnection $ \c -> do result <- tryJust transactionAborted $ do From 5d642581404bfba89684e0b9896e363a8701ad65 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Wed, 8 Oct 2014 16:36:47 -0700 Subject: [PATCH 07/11] fix test to reflect more tables --- test/Unit/PgStructureSpec.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/test/Unit/PgStructureSpec.hs b/test/Unit/PgStructureSpec.hs index e0a177b14..3ba1954bf 100644 --- a/test/Unit/PgStructureSpec.hs +++ b/test/Unit/PgStructureSpec.hs @@ -13,8 +13,8 @@ spec = around dbWithSchema $ beforeWith setRole $ do describe "tables" $ it "shows all the tables" $ \conn -> do ts <- tables "1" conn - map tableName ts `shouldBe` ["auto_incrementing_pk","compound_pk", - "has_fk","items","menagerie","no_pk", "simple_pk"] + map tableName ts `shouldBe` ["authors_only","auto_incrementing_pk", + "compound_pk","has_fk","items","menagerie","no_pk", "simple_pk"] describe "columns" $ do it "responds with each column for the table" $ \conn -> do @@ -33,4 +33,5 @@ spec = around dbWithSchema $ beforeWith setRole $ do foreignKeys "1" "has_fk" conn `shouldReturn` M.fromList [ ("auto_inc_fk", ForeignKey {fkTable="auto_incrementing_pk", fkCol="id"}), ("simple_fk", ForeignKey { fkTable="simple_pk", fkCol="k"})] + where setRole conn = quickQuery conn "set role dbapi_test" [] >> return conn From c9fc2154abf094781c97b3b25c93ef90f1797e87 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Wed, 8 Oct 2014 16:37:30 -0700 Subject: [PATCH 08/11] fix basic auth parsing --- src/Dbapi.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Dbapi.hs b/src/Dbapi.hs index 7ce42bef5..d7b6d8922 100644 --- a/src/Dbapi.hs +++ b/src/Dbapi.hs @@ -77,7 +77,7 @@ httpRequesterRole :: RequestHeaders -> Connection -> IO LoginAttempt httpRequesterRole hdrs conn = do let auth = fromMaybe "" $ lookup hAuthorization hdrs case BS.split ' ' (cs auth) of - ("Basic " : b64 : _) -> + ("Basic" : b64 : _) -> case BS.split ':' $ cs (decode $ cs b64) of (u:p:_) -> signInRole u p conn _ -> return MalformedAuth From e17c51e2f1315391871e1f237faf945784a45be2 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Wed, 8 Oct 2014 16:37:53 -0700 Subject: [PATCH 09/11] clean up spec helper --- test/SpecHelper.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index e3c2de74c..2180a282f 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -9,10 +9,7 @@ import Database.HDBC import Database.HDBC.PostgreSQL import Data.String.Conversions (cs) -import Data.Either (isLeft) -import Control.Exception.Base (bracket, finally) - -import Control.Exception.Base (bracket, tryJust) +import Control.Exception.Base (bracket, finally, tryJust) import Control.Monad (when) import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange, @@ -27,6 +24,10 @@ import Network.Wai.Middleware.Cors (cors) import Dbapi (app, corsPolicy, AppConfig(..)) import PgQuery(addUser) +isLeft :: Either a b -> Bool +isLeft (Left _ ) = True +isLeft _ = False + cfg :: AppConfig cfg = AppConfig "postgres://dbapi_test:@localhost:5432/dbapi_test" 9000 "test/test.crt" "test/test.key" "dbapi_anonymous" From ee02a98cf2abe714dae600432d92b4d1c554cad6 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Wed, 8 Oct 2014 16:38:12 -0700 Subject: [PATCH 10/11] emit references for columns with foreign keys --- src/PgStructure.hs | 4 ++ test/Feature/StructureSpec.hs | 71 ++++++++++++++++++++++++++++++++--- 2 files changed, 70 insertions(+), 5 deletions(-) diff --git a/src/PgStructure.hs b/src/PgStructure.hs index 42d5a6c45..96e4c5e73 100644 --- a/src/PgStructure.hs +++ b/src/PgStructure.hs @@ -36,6 +36,9 @@ data ForeignKey = ForeignKey { fkTable::String, fkCol::String } deriving (Eq, Show) +instance JSON.ToJSON ForeignKey where + toJSON fk = JSON.object ["table".=fkTable fk, "column".=fkCol fk] + foreignKeys :: String -> String -> Connection -> IO (Map.Map String ForeignKey) foreignKeys schema table conn = do r <- quickQuery conn @@ -78,6 +81,7 @@ instance JSON.ToJSON Column where , "updatable" .= colUpdatable c , "maxLen" .= colMaxLen c , "precision" .= colPrecision c + , "references".= colFK c , "default" .= colDefault c ] data TableOptions = TableOptions { diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index 2d1ecf552..64171c5ae 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE OverloadedStrings, QuasiQuotes #-} module Feature.StructureSpec where @@ -8,15 +9,26 @@ import Test.Hspec.Wai.JSON import SpecHelper import Network.HTTP.Types +import Codec.Binary.Base64.String (encode) +import Data.Monoid ((<>)) +import Data.String.Conversions (cs) + +uName = "a user" +uPass = "nobody can ever know" +uRole = "dbapi_test" spec :: Spec -spec = around appWithFixture $ do +spec = around withDatabaseConnection $ + aroundWith (withUser uName uPass uRole) $ aroundWith withApp $ do describe "GET /" $ it "lists views in schema" $ - get "/" `shouldRespondWith` - [json| [ - {"schema":"1","name":"auto_incrementing_pk","insertable":true} + request methodGet "/" + [("Authorization", "Basic "<>(cs.encode $ cs uName<>":"<>cs uPass))] "" + `shouldRespondWith` [json| [ + {"schema":"1","name":"authors_only","insertable":true} + , {"schema":"1","name":"auto_incrementing_pk","insertable":true} , {"schema":"1","name":"compound_pk","insertable":true} + , {"schema":"1","name":"has_fk","insertable":true} , {"schema":"1","name":"items","insertable":true} , {"schema":"1","name":"menagerie","insertable":true} , {"schema":"1","name":"no_pk","insertable":true} @@ -24,7 +36,7 @@ spec = around appWithFixture $ do ] |] {matchStatus = 200} - describe "Table info" $ + describe "Table info" $ do it "is available with OPTIONS verb" $ request methodOptions "/auto_incrementing_pk" [] "" `shouldRespondWith` [json| { @@ -39,6 +51,7 @@ spec = around appWithFixture $ do "maxLen": null, "nullable": false, "position": 1, + "references": null, "default": "nextval('\"1\".auto_incrementing_pk_id_seq'::regclass)" }, { "precision": null, @@ -49,6 +62,7 @@ spec = around appWithFixture $ do "maxLen": null, "nullable": true, "position": 2, + "references": null, "default": null }, { "precision": null, @@ -59,6 +73,7 @@ spec = around appWithFixture $ do "maxLen": null, "nullable": false, "position": 3, + "references": null, "default": null }, { "precision": null, @@ -69,8 +84,54 @@ spec = around appWithFixture $ do "maxLen": null, "nullable": true, "position": 4, + "references": null, "default": "now()" } ] } |] + + it "includes foreign key data" $ + request methodOptions "/has_fk" + [("Authorization", "Basic "<>(cs.encode $ cs uName<>":"<>cs uPass))] "" + `shouldRespondWith` [json| + { + "pkey": ["id"], + "columns":[ + { + "default": "nextval('\"1\".has_fk_id_seq'::regclass)", + "precision": 64, + "updatable": true, + "schema": "1", + "name": "id", + "type": "bigint", + "maxLen": null, + "nullable": false, + "position": 1, + "references": null + }, { + "default": null, + "precision": 32, + "updatable": true, + "schema": "1", + "name": "auto_inc_fk", + "type": "integer", + "maxLen": null, + "nullable": true, + "position": 2, + "references": {"table": "auto_incrementing_pk", "column": "id"} + }, { + "default": null, + "precision": null, + "updatable": true, + "schema": "1", + "name": "simple_fk", + "type": "character varying", + "maxLen": 255, + "nullable": true, + "position": 3, + "references": {"table": "simple_pk", "column": "k"} + } + ] + } + |] From 195e9048170fcf3d88ce2ce98ee5f7fa28df8696 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Wed, 8 Oct 2014 17:04:44 -0700 Subject: [PATCH 11/11] make compound_pk owned by dbapi_anonymous --- test/fixtures/schema.sql | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index 6ce0b9468..8380f80d7 100644 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -169,7 +169,7 @@ CREATE TABLE compound_pk ( ); -ALTER TABLE "1".compound_pk OWNER TO dbapi_test; +ALTER TABLE "1".compound_pk OWNER TO dbapi_anonymous; -- -- TOC entry 184 (class 1259 OID 50944)