From 6d9a309650cff35104219b2011240819972bf0a8 Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Thu, 31 Dec 2020 14:05:42 +0100 Subject: [PATCH 1/7] refactor: Move addHasVariadic to SQL --- src/PostgREST/DbStructure.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index 6682a0c259..4cf98b77f8 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -129,7 +129,7 @@ sourceColumnFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2 decodeProcs :: HD.Result ProcsMap decodeProcs = -- Duplicate rows for a function means they're overloaded, order these by least args according to ProcDescription Ord instance - map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey . addHasVariadic) <$> HD.rowList procRow + map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey) <$> HD.rowList procRow where procRow = ProcDescription <$> column HD.text @@ -142,10 +142,7 @@ decodeProcs = <*> column HD.bool <*> column HD.bool) <*> (parseVolatility <$> column HD.char) - <*> pure False - - addHasVariadic :: ProcDescription -> ProcDescription - addHasVariadic pd@ProcDescription{pdArgs} = pd{pdHasVariadic=isJust $ find pgaVar pdArgs} + <*> column HD.bool addKey :: ProcDescription -> (QualifiedIdentifier, ProcDescription) addKey pd = (QualifiedIdentifier (pdSchema pd) (pdName pd), pd) @@ -232,7 +229,8 @@ procsSqlQuery = [q| -- if any INOUT or OUT arguments present, treat as composite or COALESCE(proargmodes::text[] && '{b,o}', false) ) AS rettype_is_composite, - p.provolatile + p.provolatile, + p.provariadic > 0 AS hasvariadic FROM pg_proc p JOIN pg_namespace pn ON pn.oid = p.pronamespace JOIN base_types bt ON bt.oid = p.prorettype From 07ab59a84665109d792a9ba7ea1ee795943334d8 Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Fri, 1 Jan 2021 12:49:44 +0100 Subject: [PATCH 2/7] refactor: Move parseArg to SQL --- src/PostgREST/DbStructure.hs | 82 +++++++++++++++++---------------- src/PostgREST/Private/Common.hs | 10 +++- 2 files changed, 50 insertions(+), 42 deletions(-) diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index 4cf98b77f8..856ec97e48 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -24,7 +24,6 @@ module PostgREST.DbStructure ( import qualified Data.HashMap.Strict as M import qualified Data.List as L -import qualified Data.Text as T import qualified Hasql.Decoders as HD import qualified Hasql.Encoders as HE import qualified Hasql.Session as H @@ -33,8 +32,7 @@ import qualified Hasql.Transaction as HT import Contravariant.Extras (contrazip2) import Data.Set as S (fromList) -import Data.Text (breakOn, dropAround, split, - splitOn, strip) +import Data.Text (split) import GHC.Exts (groupWith) import Protolude hiding (toS) import Protolude.Conv (toS) @@ -135,7 +133,12 @@ decodeProcs = <$> column HD.text <*> column HD.text <*> nullableColumn HD.text - <*> (parseArgs <$> column HD.text) + <*> compositeArrayColumn + (PgArg + <$> compositeField HD.text + <*> compositeField HD.text + <*> compositeField HD.bool + <*> compositeField HD.bool) <*> (parseRetType <$> column HD.text <*> column HD.text @@ -147,24 +150,6 @@ decodeProcs = addKey :: ProcDescription -> (QualifiedIdentifier, ProcDescription) addKey pd = (QualifiedIdentifier (pdSchema pd) (pdName pd), pd) - parseArgs :: Text -> [PgArg] - parseArgs = mapMaybe parseArg . filter (not . isPrefixOf "OUT" . toS) . map strip . split (==',') - - -- TODO: does parseArg properly handle unnamed "character varying" arguments or arguments with spaces in their names? - parseArg :: Text -> Maybe PgArg - parseArg arg = - let isVariadic = isPrefixOf "VARIADIC " $ toS arg - -- argmode can be IN, OUT, INOUT, or VARIADIC - argNoMode = lastDef "" $ splitOn (if isVariadic then "VARIADIC " else "INOUT ") arg - (body, def) = breakOn " DEFAULT " argNoMode - (name, typ) = breakOn " " body in - if T.null typ - -- Handle unnamed args. TODO: refactor to types - then Just $ - PgArg mempty (strip name) (T.null def) isVariadic - else Just $ - PgArg (dropAround (== '"') name) (strip typ) (T.null def) isVariadic - parseRetType :: Text -> Text -> Bool -> Bool -> RetType parseRetType schema name isSetOf isComposite | isSetOf = SetOf pgType @@ -193,33 +178,49 @@ accessibleProcs = H.Statement (toS sql) (param HE.text) decodeProcs True procsSqlQuery :: SqlQuery procsSqlQuery = [q| -- Recursively get the base types of domains - WITH RECURSIVE - rec_types AS ( - SELECT - oid, - typbasetype, - COALESCE(NULLIF(typbasetype, 0), oid) AS base - FROM pg_type - UNION - SELECT - t.oid, - b.typbasetype, - COALESCE(NULLIF(b.typbasetype, 0), b.oid) AS base - FROM rec_types t - JOIN pg_type b ON t.typbasetype = b.oid - ), + WITH base_types AS ( + WITH RECURSIVE + recurse AS ( + SELECT + oid, + typbasetype, + COALESCE(NULLIF(typbasetype, 0), oid) AS base + FROM pg_type + UNION + SELECT + t.oid, + b.typbasetype, + COALESCE(NULLIF(b.typbasetype, 0), b.oid) AS base + FROM recurse t + JOIN pg_type b ON t.typbasetype = b.oid + ) SELECT oid, base - FROM rec_types + FROM recurse WHERE typbasetype = 0 + ), + arguments AS ( + SELECT + oid, + array_agg(( + COALESCE(name, ''), -- name + type::regtype::text, -- type + idx <= (pronargs - pronargdefaults), -- is_required + COALESCE(mode = 'v', FALSE) -- is_variadic + ) ORDER BY idx) AS args + FROM pg_proc, + unnest(proargnames, proargtypes, proargmodes) + WITH ORDINALITY AS _ (name, type, mode, idx) + WHERE type IS NOT NULL -- only input arguments + GROUP BY oid ) SELECT pn.nspname AS proc_schema, p.proname AS proc_name, d.description AS proc_description, - pg_get_function_arguments(p.oid) AS args, + COALESCE(a.args, '{}') AS args, tn.nspname AS schema, COALESCE(comp.relname, t.typname) AS name, p.proretset AS rettype_is_setof, @@ -230,8 +231,9 @@ procsSqlQuery = [q| or COALESCE(proargmodes::text[] && '{b,o}', false) ) AS rettype_is_composite, p.provolatile, - p.provariadic > 0 AS hasvariadic + p.provariadic > 0 as hasvariadic FROM pg_proc p + LEFT JOIN arguments a ON a.oid = p.oid JOIN pg_namespace pn ON pn.oid = p.pronamespace JOIN base_types bt ON bt.oid = p.prorettype JOIN pg_type t ON t.oid = bt.base diff --git a/src/PostgREST/Private/Common.hs b/src/PostgREST/Private/Common.hs index c068fb6184..d40f3c0540 100644 --- a/src/PostgREST/Private/Common.hs +++ b/src/PostgREST/Private/Common.hs @@ -15,17 +15,23 @@ import Data.Foldable (foldr1) column :: HD.Value a -> HD.Row a column = HD.column . HD.nonNullable +compositeField :: HD.Value a -> HD.Composite a +compositeField = HD.field . HD.nonNullable + nullableColumn :: HD.Value a -> HD.Row (Maybe a) nullableColumn = HD.column . HD.nullable arrayColumn :: HD.Value a -> HD.Row [a] -arrayColumn = column . HD.array . HD.dimension replicateM . HD.element . HD.nonNullable +arrayColumn = column . HD.listArray . HD.nonNullable + +compositeArrayColumn :: HD.Composite a -> HD.Row [a] +compositeArrayColumn = arrayColumn . HD.composite param :: HE.Value a -> HE.Params a param = HE.param . HE.nonNullable arrayParam :: HE.Value a -> HE.Params [a] -arrayParam = param . HE.array . HE.dimension foldl' . HE.element . HE.nonNullable +arrayParam = param . HE.foldableArray . HE.nonNullable emptySnippetOnFalse :: H.Snippet -> Bool -> H.Snippet emptySnippetOnFalse val cond = if cond then mempty else val From 2d4414d598319dcbe00e7e5cf98cdfbf0c8c8782 Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Fri, 1 Jan 2021 21:19:50 +0100 Subject: [PATCH 3/7] Add STABLE RPCs in test fixtures to increase coverage --- test/fixtures/schema.sql | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index bf9d15323c..301cb4dc0d 100644 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -119,35 +119,36 @@ CREATE TABLE items3 ( CREATE FUNCTION search(id BIGINT) RETURNS SETOF items LANGUAGE plpgsql + STABLE AS $$BEGIN RETURN QUERY SELECT items.id FROM items WHERE items.id=search.id; END$$; CREATE FUNCTION always_true(test.items) RETURNS boolean - LANGUAGE sql STABLE + LANGUAGE sql IMMUTABLE AS $$ SELECT true $$; CREATE FUNCTION computed_overload(test.items) RETURNS boolean - LANGUAGE sql STABLE + LANGUAGE sql IMMUTABLE AS $$ SELECT true $$; CREATE FUNCTION computed_overload(test.items2) RETURNS boolean - LANGUAGE sql STABLE + LANGUAGE sql IMMUTABLE AS $$ SELECT true $$; CREATE FUNCTION is_first(test.items) RETURNS boolean - LANGUAGE sql STABLE + LANGUAGE sql IMMUTABLE AS $$ SELECT $1.id = 1 $$; CREATE FUNCTION anti_id(test.items) RETURNS bigint - LANGUAGE sql STABLE + LANGUAGE sql IMMUTABLE AS $_$ SELECT $1.id * -1 $_$; SET search_path = public, pg_catalog; CREATE FUNCTION always_false(test.items) RETURNS boolean - LANGUAGE sql STABLE + LANGUAGE sql IMMUTABLE AS $$ SELECT false $$; create table public_consumers ( @@ -194,6 +195,7 @@ create view consumers_extra_view as CREATE FUNCTION getitemrange(min bigint, max bigint) RETURNS SETOF items LANGUAGE sql + STABLE AS $_$ SELECT * FROM test.items WHERE id > $1 AND id <= $2; $_$; @@ -204,6 +206,7 @@ $_$; CREATE FUNCTION noparamsproc() RETURNS text LANGUAGE sql + IMMUTABLE AS $$ SELECT a FROM (VALUES ('Return value of no parameters procedure.')) s(a); $$; @@ -214,6 +217,7 @@ CREATE FUNCTION noparamsproc() RETURNS text CREATE FUNCTION login(id text, pass text) RETURNS public.jwt_token LANGUAGE sql SECURITY DEFINER + STABLE AS $$ SELECT jwt.sign( row_to_json(r), 'reallyreallyreallyreallyverysafe' @@ -239,6 +243,7 @@ CREATE FUNCTION varied_arguments( jsonb jsonb default '{}' ) RETURNS json LANGUAGE sql +IMMUTABLE AS $_$ SELECT json_build_object( 'double', double, @@ -262,6 +267,7 @@ Just a test for RPC function arguments$_$; CREATE FUNCTION json_argument(arg json) RETURNS text LANGUAGE sql +IMMUTABLE AS $_$ SELECT json_typeof(arg); $_$; @@ -272,6 +278,7 @@ $_$; CREATE FUNCTION jwt_test() RETURNS public.jwt_token LANGUAGE sql SECURITY DEFINER + IMMUTABLE AS $$ SELECT jwt.sign( row_to_json(r), 'reallyreallyreallyreallyverysafe' @@ -306,6 +313,7 @@ $$; CREATE FUNCTION get_current_user() RETURNS text LANGUAGE sql + STABLE AS $$ SELECT current_user::text; $$; @@ -319,6 +327,7 @@ CREATE FUNCTION reveal_big_jwt() RETURNS TABLE ( nbf bigint, iat bigint, jti text, "http://postgrest.com/foo" boolean ) LANGUAGE sql SECURITY DEFINER + STABLE AS $$ SELECT current_setting('request.jwt.claim.iss') as iss, current_setting('request.jwt.claim.sub') as sub, @@ -385,6 +394,7 @@ $_$; CREATE FUNCTION singlejsonparam(single_param json) RETURNS json LANGUAGE sql + IMMUTABLE AS $_$ SELECT single_param; $_$; @@ -395,6 +405,7 @@ $_$; CREATE FUNCTION test_empty_rowset() RETURNS SETOF integer LANGUAGE sql + IMMUTABLE AS $$ SELECT null::int FROM (SELECT 1) a WHERE false; $$; @@ -952,6 +963,7 @@ DO $do$BEGIN CREATE FUNCTION getproject_domain(id int) RETURNS SETOF projects_domain LANGUAGE sql + STABLE AS $_$ SELECT projects::projects_domain FROM test.projects WHERE id = $1; $_$; @@ -1163,11 +1175,13 @@ create function test.many_inout_params(INOUT num int, INOUT str text, INOUT b bo $$ language sql; CREATE FUNCTION test.variadic_param(VARIADIC v TEXT[] DEFAULT '{}') RETURNS text[] +IMMUTABLE LANGUAGE SQL AS $$ SELECT v $$; CREATE FUNCTION test.sayhello_variadic(name TEXT, VARIADIC v TEXT[]) RETURNS text +IMMUTABLE LANGUAGE SQL AS $$ SELECT 'Hello, ' || name $$; @@ -1680,7 +1694,7 @@ CREATE TABLE web_content ( CREATE FUNCTION getallusers() RETURNS SETOF users AS $$ SELECT * FROM test.users; -$$ LANGUAGE sql; +$$ LANGUAGE sql STABLE; create table app_users ( id integer primary key, From 562abc78a8095176919a21a13d98fbf1ce181427 Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Sat, 2 Jan 2021 11:22:56 +0100 Subject: [PATCH 4/7] cov: Add comment on SCHEMA in test fixtures --- test/fixtures/schema.sql | 3 +++ 1 file changed, 3 insertions(+) diff --git a/test/fixtures/schema.sql b/test/fixtures/schema.sql index 301cb4dc0d..32f79d51e3 100644 --- a/test/fixtures/schema.sql +++ b/test/fixtures/schema.sql @@ -21,6 +21,9 @@ CREATE SCHEMA extensions; CREATE SCHEMA v1; CREATE SCHEMA v2; +COMMENT ON SCHEMA v1 IS 'v1 schema'; +COMMENT ON SCHEMA v2 IS 'v2 schema'; + -- -- Name: plpgsql; Type: EXTENSION; Schema: -; Owner: - -- From c76c51ad1c6c909e996edc2323c0d0fa155eb70f Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Sat, 2 Jan 2021 11:26:18 +0100 Subject: [PATCH 5/7] refactor: simplify addXRels --- src/PostgREST/DbStructure.hs | 111 +++++++++++++++-------------------- 1 file changed, 48 insertions(+), 63 deletions(-) diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index 856ec97e48..407759c9d8 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -12,8 +12,10 @@ These queries are executed once at startup or when PostgREST is reloaded. {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} + module PostgREST.DbStructure ( getDbStructure , accessibleTables @@ -33,7 +35,6 @@ import qualified Hasql.Transaction as HT import Contravariant.Extras (contrazip2) import Data.Set as S (fromList) import Data.Text (split) -import GHC.Exts (groupWith) import Protolude hiding (toS) import Protolude.Conv (toS) import Protolude.Unsafe (unsafeHead) @@ -52,7 +53,7 @@ getDbStructure schemas extraSearchPath pgVer prepared = do keys <- HT.statement () $ allPrimaryKeys tabs prepared procs <- HT.statement schemas $ allProcs prepared - let rels = addM2MRels . addO2MRels $ addViewM2ORels srcCols m2oRels + let rels = addO2MRels . addM2MRels $ addViewM2ORels srcCols m2oRels cols' = addForeignKeys rels cols keys' = addViewPrimaryKeys srcCols keys @@ -339,71 +340,55 @@ When having t1_view.c1 and a t2_view.c2 source columns, we need to add a View-Vi The logic for composite pks is similar just need to make sure all the Relation columns have source columns. -} addViewM2ORels :: [SourceColumn] -> [Relation] -> [Relation] -addViewM2ORels allSrcCols = concatMap (\rel -> - rel : case rel of - Relation{relType=M2O, relTable, relColumns, relConstraint, relFTable, relFColumns} -> - - let srcColsGroupedByView :: [Column] -> [[SourceColumn]] - srcColsGroupedByView relCols = L.groupBy (\(_, viewCol1) (_, viewCol2) -> colTable viewCol1 == colTable viewCol2) $ - filter (\(c, _) -> c `elem` relCols) allSrcCols - relSrcCols = srcColsGroupedByView relColumns - relFSrcCols = srcColsGroupedByView relFColumns - getView :: [SourceColumn] -> Table - getView = colTable . snd . unsafeHead - srcCols `allSrcColsOf` cols = S.fromList (fst <$> srcCols) == S.fromList cols - -- Relation is dependent on the order of relColumns and relFColumns to get the join conditions right in the generated query. - -- So we need to change the order of the SourceColumns to match the relColumns - -- TODO: This could be avoided if the Relation type is improved with a structure that maintains the association of relColumns and relFColumns - srcCols `sortAccordingTo` cols = sortOn (\(k, _) -> L.lookup k $ zip cols [0::Int ..]) srcCols - - viewTableM2O = - [ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns) - relConstraint relFTable relFColumns - M2O Nothing - | srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ] - - tableViewM2O = - [ Relation relTable relColumns - relConstraint - (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns) - M2O Nothing - | fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ] - - viewViewM2O = - [ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns) - relConstraint - (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns) - M2O Nothing - | srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns - , fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ] - - in viewTableM2O ++ tableViewM2O ++ viewViewM2O - - _ -> []) +addViewM2ORels allSrcCols = concatMap (\rel@Relation{..} -> rel : + let + srcColsGroupedByView :: [Column] -> [[SourceColumn]] + srcColsGroupedByView relCols = L.groupBy (\(_, viewCol1) (_, viewCol2) -> colTable viewCol1 == colTable viewCol2) $ + filter (\(c, _) -> c `elem` relCols) allSrcCols + relSrcCols = srcColsGroupedByView relColumns + relFSrcCols = srcColsGroupedByView relFColumns + getView :: [SourceColumn] -> Table + getView = colTable . snd . unsafeHead + srcCols `allSrcColsOf` cols = S.fromList (fst <$> srcCols) == S.fromList cols + -- Relation is dependent on the order of relColumns and relFColumns to get the join conditions right in the generated query. + -- So we need to change the order of the SourceColumns to match the relColumns + -- TODO: This could be avoided if the Relation type is improved with a structure that maintains the association of relColumns and relFColumns + srcCols `sortAccordingTo` cols = sortOn (\(k, _) -> L.lookup k $ zip cols [0::Int ..]) srcCols + + viewTableM2O = + [ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns) + relConstraint relFTable relFColumns + M2O Nothing + | srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ] + + tableViewM2O = + [ Relation relTable relColumns + relConstraint + (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns) + M2O Nothing + | fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ] + + viewViewM2O = + [ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns) + relConstraint + (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns) + M2O Nothing + | srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns + , fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ] + + in viewTableM2O ++ tableViewM2O ++ viewViewM2O) addO2MRels :: [Relation] -> [Relation] -addO2MRels = concatMap (\rel@(Relation t c cn ft fc _ _) -> [rel, Relation ft fc cn t c O2M Nothing]) +addO2MRels rels = rels ++ [ Relation ft fc con t c O2M Nothing + | Relation t c con ft fc typ _ <- rels + , typ == M2O] addM2MRels :: [Relation] -> [Relation] -addM2MRels rels = rels ++ addMirrorRel (mapMaybe junction2Rel junctions) - where - junctions = join $ map (combinations 2) $ groupWith groupFn $ filter ( (==M2O). relType) rels - groupFn :: Relation -> (Text,Text) - groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = (s,t) - -- Reference : https://wiki.haskell.org/99_questions/Solutions/26 - combinations :: Int -> [a] -> [[a]] - combinations 0 _ = [ [] ] - combinations n xs = [ y:ys | y:xs' <- tails xs - , ys <- combinations (n-1) xs'] - junction2Rel [ - Relation{relTable=jt, relColumns=jc1, relConstraint=const1, relFTable=t, relFColumns=c}, - Relation{ relColumns=jc2, relConstraint=const2, relFTable=ft, relFColumns=fc} - ] - | jc1 /= jc2 = Just $ Relation t c Nothing ft fc M2M (Just $ Junction jt const1 jc1 const2 jc2) - | otherwise = Nothing - junction2Rel _ = Nothing - addMirrorRel = concatMap (\rel@(Relation t c _ ft fc _ (Just (Junction jt const1 jc1 const2 jc2))) -> - [rel, Relation ft fc Nothing t c M2M (Just (Junction jt const2 jc2 const1 jc1))]) +addM2MRels rels = rels ++ [ Relation t c Nothing ft fc M2M (Just $ Junction jt1 con1 jc1 con2 jc2) + | Relation jt1 jc1 con1 t c _ _ <- rels + , Relation jt2 jc2 con2 ft fc _ _ <- rels + , jt1 == jt2 + , con1 /= con2] addViewPrimaryKeys :: [SourceColumn] -> [PrimaryKey] -> [PrimaryKey] addViewPrimaryKeys srcCols = concatMap (\pk -> From 3a70e702af14ad6fe94cbeca3d2117d403b7c689 Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Sat, 2 Jan 2021 14:31:44 +0100 Subject: [PATCH 6/7] cov: remove unused fields from type Column --- src/PostgREST/DbStructure.hs | 42 +++++++++++++----------------------- src/PostgREST/Types.hs | 3 --- 2 files changed, 15 insertions(+), 30 deletions(-) diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index 407759c9d8..7a7b1b1af2 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -80,12 +80,13 @@ decodeColumns tables = mapMaybe (columnFromRow tables) <$> HD.rowList colRow where colRow = - (,,,,,,,,,,,) - <$> column HD.text <*> column HD.text - <*> column HD.text <*> nullableColumn HD.text - <*> column HD.int4 <*> column HD.bool - <*> column HD.text <*> column HD.bool - <*> nullableColumn HD.int4 + (,,,,,,,,) + <$> column HD.text + <*> column HD.text + <*> column HD.text + <*> nullableColumn HD.text + <*> column HD.bool + <*> column HD.text <*> nullableColumn HD.int4 <*> nullableColumn HD.text <*> nullableColumn HD.text @@ -433,14 +434,12 @@ allColumns tabs = info.table_name AS table_name, info.column_name AS name, info.description AS description, - info.ordinal_position AS position, info.is_nullable::boolean AS nullable, info.data_type AS col_type, - info.is_updatable::boolean AS updatable, info.character_maximum_length AS max_len, - info.numeric_precision AS precision, info.column_default AS default_value, - array_to_string(enum_info.vals, ',') AS enum + array_to_string(enum_info.vals, ',') AS enum, + info.position FROM ( -- CTE based on pg_catalog to get PRIMARY/FOREIGN key and UNIQUE columns outside api schema WITH key_columns AS ( @@ -475,7 +474,6 @@ allColumns tabs = c.relname::name AS table_name, a.attname::name AS column_name, d.description AS description, - a.attnum::integer AS ordinal_position, pg_get_expr(ad.adbin, ad.adrelid)::text AS column_default, not (a.attnotnull OR t.typtype = 'd' AND t.typnotnull) AS is_nullable, CASE @@ -496,15 +494,8 @@ allColumns tabs = information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*) )::integer AS character_maximum_length, - information_schema._pg_numeric_precision( - information_schema._pg_truetypid(a.*, t.*), - information_schema._pg_truetypmod(a.*, t.*) - )::integer AS numeric_precision, COALESCE(bt.typname, t.typname)::name AS udt_name, - ( - c.relkind in ('r', 'v', 'f') - AND pg_column_is_updatable(c.oid::regclass, a.attnum, false) - )::bool is_updatable + a.attnum::integer AS position FROM pg_attribute a LEFT JOIN key_columns kc ON kc.conkey = a.attnum AND kc.c_oid = a.attrelid @@ -533,14 +524,12 @@ allColumns tabs = table_name, column_name, description, - ordinal_position, is_nullable, data_type, - is_updatable, character_maximum_length, - numeric_precision, column_default, - udt_name + udt_name, + position FROM columns WHERE table_schema NOT IN ('pg_catalog', 'information_schema') ) AS info @@ -558,13 +547,12 @@ allColumns tabs = columnFromRow :: [Table] -> (Text, Text, Text, - Maybe Text, Int32, Bool, - Text, Bool, Maybe Int32, + Maybe Text, Bool, Text, Maybe Int32, Maybe Text, Maybe Text) -> Maybe Column -columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table +columnFromRow tabs (s, t, n, desc, nul, typ, l, d, e) = buildColumn <$> table where - buildColumn tbl = Column tbl n desc pos nul typ u l p d (parseEnum e) Nothing + buildColumn tbl = Column tbl n desc nul typ l d (parseEnum e) Nothing table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs parseEnum :: Maybe Text -> [Text] parseEnum = maybe [] (split (==',')) diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index a09720e8be..1b2bafd71a 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -241,12 +241,9 @@ data Column = colTable :: Table , colName :: FieldName , colDescription :: Maybe Text - , colPosition :: Int32 , colNullable :: Bool , colType :: Text - , colUpdatable :: Bool , colMaxLen :: Maybe Int32 - , colPrecision :: Maybe Int32 , colDefault :: Maybe Text , colEnum :: [Text] , colFK :: Maybe ForeignKey From ea6297991095ed66d60aae43dc430a5eed6a1a8e Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Sun, 3 Jan 2021 11:56:06 +0100 Subject: [PATCH 7/7] refactor: Combine relConstraint and relJunction in relLink --- src/PostgREST/DbRequestBuilder.hs | 46 ++++++++++++++----------------- src/PostgREST/DbStructure.hs | 37 +++++++++++++------------ src/PostgREST/Error.hs | 23 ++++++++-------- src/PostgREST/Types.hs | 34 ++++++++++++----------- 4 files changed, 68 insertions(+), 72 deletions(-) diff --git a/src/PostgREST/DbRequestBuilder.hs b/src/PostgREST/DbRequestBuilder.hs index 28eb2a6350..020d06c460 100644 --- a/src/PostgREST/DbRequestBuilder.hs +++ b/src/PostgREST/DbRequestBuilder.hs @@ -10,6 +10,7 @@ A query tree is built in case of resource embedding. By inferring the relationsh {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} module PostgREST.DbRequestBuilder ( readRequest @@ -135,13 +136,13 @@ findRel schema allRels origin target hint = -- In a self reference we get two relationships with the same foreign key and relTable/relFtable but with different cardinalities(m2o/o2m) -- We output the O2M rel, the M2O rel can be obtained by using the origin column as an embed hint. let [rel0, rel1] = take 2 rs in - if length rs == 2 && relConstraint rel0 == relConstraint rel1 && relTable rel0 == relTable rel1 && relFTable rel0 == relFTable rel1 + if length rs == 2 && relLink rel0 == relLink rel1 && relTable rel0 == relTable rel1 && relFTable rel0 == relFTable rel1 then note (NoRelBetween origin target) (find (\r -> relType r == O2M) rs) else Left $ AmbiguousRelBetween origin target rs where matchFKSingleCol hint_ cols = length cols == 1 && hint_ == (colName <$> head cols) rel = filter ( - \Relation{relTable, relColumns, relConstraint, relFTable, relFColumns, relType, relJunction} -> + \Relation{..} -> -- Both relationship ends need to be on the exposed schema schema == tableSchema relTable && schema == tableSchema relFTable && ( @@ -152,7 +153,7 @@ findRel schema allRels origin target hint = -- /projects?select=projects_client_id_fkey(*) ( origin == tableName relTable && -- projects - Just target == relConstraint -- projects_client_id_fkey + Constraint target == relLink -- projects_client_id_fkey ) || -- /projects?select=client_id(*) ( @@ -163,7 +164,10 @@ findRel schema allRels origin target hint = isNothing hint || -- hint is optional -- /projects?select=clients!projects_client_id_fkey(*) - hint == relConstraint || -- projects_client_id_fkey + ( + relType /= M2M && + hint == Just (constName relLink) -- projects_client_id_fkey + ) || -- /projects?select=clients!client_id(*) or /projects?select=clients!id(*) matchFKSingleCol hint relColumns || -- client_id @@ -171,8 +175,8 @@ findRel schema allRels origin target hint = -- /users?select=tasks!users_tasks(*) ( - relType == M2M && -- many-to-many between users and tasks - hint == (tableName . junTable <$> relJunction) -- users_tasks + relType == M2M && -- many-to-many between users and tasks + hint == Just (tableName $ junTable relLink) -- users_tasks ) ) ) allRels @@ -181,15 +185,10 @@ findRel schema allRels origin target hint = addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, rel, _, _, depth)) forest) = case rel of - Just r@Relation{relType=O2M} -> Node (augmentQuery r, nodeProps) <$> updatedForest - Just r@Relation{relType=M2O} -> Node (augmentQuery r, nodeProps) <$> updatedForest - Just r@Relation{relType=M2M, relJunction=junction} -> - case junction of - Just Junction{junTable} -> - let rq = augmentQuery r in - Node (rq{implicitJoins=tableQi junTable:implicitJoins rq}, nodeProps) <$> updatedForest - Nothing -> - Left UnknownRelation + Just r@Relation{relType=M2M, relLink=Junction{junTable}} -> + let rq = augmentQuery r in + Node (rq{implicitJoins=tableQi junTable:implicitJoins rq}, nodeProps) <$> updatedForest + Just r -> Node (augmentQuery r, nodeProps) <$> updatedForest Nothing -> Node node <$> updatedForest where newAlias = case isSelfReference <$> rel of @@ -206,17 +205,12 @@ addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_ -- previousAlias and newAlias are used in the case of self joins getJoinConditions :: Maybe Alias -> Maybe Alias -> Relation -> [JoinCondition] -getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, tableName=tN} cols _ Table{tableName=ftN} fCols typ jun) = - case typ of - O2M -> - zipWith (toJoinCondition tN ftN) cols fCols - M2O -> - zipWith (toJoinCondition tN ftN) cols fCols - M2M -> case jun of - Just (Junction jt _ jc1 _ jc2) -> - let jtn = tableName jt in - zipWith (toJoinCondition tN jtn) cols jc1 ++ zipWith (toJoinCondition ftN jtn) fCols jc2 - Nothing -> [] +getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fCols _ lnk) = + case lnk of + Junction Table{tableName=jtn} _ jc1 _ jc2 -> + zipWith (toJoinCondition tN jtn) cols jc1 ++ zipWith (toJoinCondition ftN jtn) fCols jc2 + Constraint _ -> + zipWith (toJoinCondition tN ftN) cols fCols where toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition toJoinCondition tb ftb c fc = diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index 7a7b1b1af2..8e02d030f3 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -357,39 +357,40 @@ addViewM2ORels allSrcCols = concatMap (\rel@Relation{..} -> rel : srcCols `sortAccordingTo` cols = sortOn (\(k, _) -> L.lookup k $ zip cols [0::Int ..]) srcCols viewTableM2O = - [ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns) - relConstraint relFTable relFColumns - M2O Nothing + [ Relation + (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns) + relFTable relFColumns + relType relLink | srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns ] tableViewM2O = - [ Relation relTable relColumns - relConstraint - (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns) - M2O Nothing + [ Relation + relTable relColumns + (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns) + relType relLink | fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ] viewViewM2O = - [ Relation (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns) - relConstraint - (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns) - M2O Nothing + [ Relation + (getView srcCols) (snd <$> srcCols `sortAccordingTo` relColumns) + (getView fSrcCols) (snd <$> fSrcCols `sortAccordingTo` relFColumns) + relType relLink | srcCols <- relSrcCols, srcCols `allSrcColsOf` relColumns , fSrcCols <- relFSrcCols, fSrcCols `allSrcColsOf` relFColumns ] in viewTableM2O ++ tableViewM2O ++ viewViewM2O) addO2MRels :: [Relation] -> [Relation] -addO2MRels rels = rels ++ [ Relation ft fc con t c O2M Nothing - | Relation t c con ft fc typ _ <- rels +addO2MRels rels = rels ++ [ Relation ft fc t c O2M lnk + | Relation t c ft fc typ lnk <- rels , typ == M2O] addM2MRels :: [Relation] -> [Relation] -addM2MRels rels = rels ++ [ Relation t c Nothing ft fc M2M (Just $ Junction jt1 con1 jc1 con2 jc2) - | Relation jt1 jc1 con1 t c _ _ <- rels - , Relation jt2 jc2 con2 ft fc _ _ <- rels +addM2MRels rels = rels ++ [ Relation t c ft fc M2M (Junction jt1 lnk1 jc1 lnk2 jc2) + | Relation jt1 jc1 t c _ lnk1 <- rels + , Relation jt2 jc2 ft fc _ lnk2 <- rels , jt1 == jt2 - , con1 /= con2] + , lnk1 /= lnk2] addViewPrimaryKeys :: [SourceColumn] -> [PrimaryKey] -> [PrimaryKey] addViewPrimaryKeys srcCols = concatMap (\pk -> @@ -586,7 +587,7 @@ allM2ORels tabs cols = relFromRow :: [Table] -> [Column] -> (Text, Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation relFromRow allTabs allCols (rs, rt, cn, rcs, frs, frt, frcs) = - Relation <$> table <*> cols <*> pure (Just cn) <*> tableF <*> colsF <*> pure M2O <*> pure Nothing + Relation <$> table <*> cols <*> tableF <*> colsF <*> pure M2O <*> pure (Constraint cn) where findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs findCol s t c = find (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col == c) allCols diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index c016c01129..608d19ebee 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -4,6 +4,7 @@ Description : PostgREST error HTTP responses -} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RecordWildCards #-} module PostgREST.Error ( errorResponseFor @@ -95,25 +96,23 @@ instance JSON.ToJSON ApiRequestError where "message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas)] compressedRel :: Relation -> JSON.Value -compressedRel rel = +compressedRel Relation{..} = let - fmtTbl tbl = tableSchema tbl <> "." <> tableName tbl + fmtTbl Table{..} = tableSchema <> "." <> tableName fmtEls els = "[" <> T.intercalate ", " els <> "]" in JSON.object $ [ - "origin" .= fmtTbl (relTable rel) - , "target" .= fmtTbl (relFTable rel) - , "cardinality" .= (show $ relType rel :: Text) + "origin" .= fmtTbl relTable + , "target" .= fmtTbl relFTable + , "cardinality" .= (show relType :: Text) ] ++ - case (relType rel, relJunction rel, relConstraint rel) of - (M2M, Just (Junction jt (Just const1) _ (Just const2) _), _) -> [ - "relationship" .= (fmtTbl jt <> fmtEls [const1] <> fmtEls [const2]) + case relLink of + Junction{..} -> [ + "relationship" .= (fmtTbl junTable <> fmtEls [constName junLink1] <> fmtEls [constName junLink2]) ] - (_, _, Just relCon) -> [ - "relationship" .= (relCon <> fmtEls (colName <$> relColumns rel) <> fmtEls (colName <$> relFColumns rel)) + Constraint{..} -> [ + "relationship" .= (constName <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relFColumns)) ] - (_, _, _) -> - mempty data PgError = PgError Authenticated P.UsageError deriving Show type Authenticated = Bool diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index 1b2bafd71a..37ddd9cfb6 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -298,31 +298,33 @@ instance Show Cardinality where show M2O = "m2o" show M2M = "m2m" -type ConstraintName = Text - {-| "Relation"ship between two tables. The order of the relColumns and relFColumns should be maintained to get the join conditions right. TODO merge relColumns and relFColumns to a tuple or Data.Bimap -} data Relation = Relation { - relTable :: Table -, relColumns :: [Column] -, relConstraint :: Maybe ConstraintName -- ^ Just on O2M/M2O, Nothing on M2M -, relFTable :: Table -, relFColumns :: [Column] -, relType :: Cardinality -, relJunction :: Maybe Junction -- ^ Junction for M2M Cardinality + relTable :: Table +, relColumns :: [Column] +, relFTable :: Table +, relFColumns :: [Column] +, relType :: Cardinality +, relLink :: Link -- ^ Constraint on O2M/M2O, Junction for M2M Cardinality } deriving (Show, Eq, Generic, JSON.ToJSON) +type ConstraintName = Text + -- | Junction table on an M2M relationship -data Junction = Junction { - junTable :: Table -, junConstraint1 :: Maybe ConstraintName -, junCols1 :: [Column] -, junConstraint2 :: Maybe ConstraintName -, junCols2 :: [Column] -} deriving (Show, Eq, Generic, JSON.ToJSON) +data Link + = Constraint { constName :: ConstraintName } + | Junction { + junTable :: Table + , junLink1 :: Link + , junCols1 :: [Column] + , junLink2 :: Link + , junCols2 :: [Column] + } + deriving (Show, Eq, Generic, JSON.ToJSON) isSelfReference :: Relation -> Bool isSelfReference r = relTable r == relFTable r