From 4e34dd70674eaf98c82c0212c87ef321c6f16edf Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Thu, 18 Jan 2024 21:51:55 +0100 Subject: [PATCH] refactor: Replace interpolatedstring-perl6 with neat-interpolation The former depends on th-orphans which does not cross-compile well, because of template haskell usage. neat-interpolation is also much better maintained. This also potentially helps with packaging for Debian/Ubuntu in #2273. --- postgrest.cabal | 2 +- src/PostgREST/Config/Database.hs | 27 ++++++++++---------- src/PostgREST/Query/SqlFragment.hs | 10 ++++---- src/PostgREST/SchemaCache.hs | 40 +++++++++++++++--------------- 4 files changed, 40 insertions(+), 39 deletions(-) diff --git a/postgrest.cabal b/postgrest.cabal index 4657273ad0..b57a4bfda5 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -115,11 +115,11 @@ library , heredoc >= 0.2 && < 0.3 , http-types >= 0.12.2 && < 0.13 , insert-ordered-containers >= 0.2.2 && < 0.3 - , interpolatedstring-perl6 >= 1 && < 1.1 , jose >= 0.8.5.1 && < 0.12 , lens >= 4.14 && < 5.3 , lens-aeson >= 1.0.1 && < 1.3 , mtl >= 2.2.2 && < 2.4 + , neat-interpolation >= 0.5 && < 0.6 , network >= 2.6 && < 3.2 , network-uri >= 2.6.1 && < 2.8 , optparse-applicative >= 0.13 && < 0.19 diff --git a/src/PostgREST/Config/Database.hs b/src/PostgREST/Config/Database.hs index 4477608429..aff4b5b8a3 100644 --- a/src/PostgREST/Config/Database.hs +++ b/src/PostgREST/Config/Database.hs @@ -24,7 +24,7 @@ import qualified Hasql.Statement as SQL import qualified Hasql.Transaction as SQL import qualified Hasql.Transaction.Sessions as SQL -import Text.InterpolatedString.Perl6 (q, qc) +import NeatInterpolation (trimming) import Protolude @@ -95,7 +95,7 @@ queryDbSettings preConfFunc prepared = let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in transaction SQL.ReadCommitted SQL.Read $ SQL.statement dbSettingsNames $ SQL.Statement sql (arrayParam HE.text) decodeSettings prepared where - sql = [qc| + sql = encodeUtf8 [trimming| WITH role_setting AS ( SELECT setdatabase as database, @@ -109,25 +109,25 @@ queryDbSettings preConfFunc prepared = substr(setting, 1, strpos(setting, '=') - 1) as k, substr(setting, strpos(setting, '=') + 1) as v FROM role_setting - {preConfigF} + ${preConfigF} ) SELECT DISTINCT ON (key) - replace(k, '{prefix}', '') AS key, + replace(k, '${prefix}', '') AS key, v AS value FROM kv_settings - WHERE k = ANY($1) AND v IS NOT NULL + WHERE k = ANY($$1) AND v IS NOT NULL ORDER BY key, database DESC NULLS LAST; |] preConfigF = case preConfFunc of Nothing -> mempty - Just func -> [qc| + Just func -> [trimming| UNION SELECT null as database, x as k, current_setting(x, true) as v - FROM unnest($1) x - JOIN {func}() _ ON TRUE + FROM unnest($$1) x + JOIN ${func}() _ ON TRUE |]::Text decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text @@ -136,7 +136,7 @@ queryRoleSettings pgVer prepared = let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ SQL.Statement sql HE.noParams (processRows <$> rows) prepared where - sql = [q| + sql = encodeUtf8 [trimming| with role_setting as ( select r.rolname, unnest(r.rolconfig) as setting @@ -161,14 +161,15 @@ queryRoleSettings pgVer prepared = i.value as iso_lvl, coalesce(array_agg(row(kv.key, kv.value)) filter (where key <> 'default_transaction_isolation'), '{}') as role_settings from kv_settings kv - join pg_settings ps on ps.name = kv.key |] <> - (if pgVer >= pgVersion150 - then "and (ps.context = 'user' or has_parameter_privilege(current_user::regrole::oid, ps.name, 'set')) " - else "and ps.context = 'user' ") <> [q| + join pg_settings ps on ps.name = kv.key and (ps.context = 'user' ${hasParameterPrivilege}) left join iso_setting i on i.rolname = kv.rolname group by kv.rolname, i.value; |] + hasParameterPrivilege + | pgVer >= pgVersion150 = "or has_parameter_privilege(current_user::regrole::oid, ps.name, 'set')" + | otherwise = "" + processRows :: [(Text, Maybe Text, [(Text, Text)])] -> (RoleSettings, RoleIsolationLvl) processRows rs = let diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index bc6e483661..9329fb438d 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -53,8 +53,8 @@ import qualified Hasql.Encoders as HE import Control.Arrow ((***)) -import Data.Foldable (foldr1) -import Text.InterpolatedString.Perl6 (qc) +import Data.Foldable (foldr1) +import NeatInterpolation (trimming) import PostgREST.ApiRequest.Types (AggregateFunction (..), Alias, Cast, @@ -229,11 +229,11 @@ customFuncF _ funcQi RelAnyElement = fromQi funcQi <> "(_postgrest_t) customFuncF _ funcQi (RelId target) = fromQi funcQi <> "(_postgrest_t::" <> fromQi target <> ")" locationF :: [Text] -> SQL.Snippet -locationF pKeys = [qc|( - WITH data AS (SELECT row_to_json(_) AS row FROM {sourceCTEName} AS _ LIMIT 1) +locationF pKeys = SQL.sql $ encodeUtf8 [trimming|( + WITH data AS (SELECT row_to_json(_) AS row FROM ${sourceCTEName} AS _ LIMIT 1) SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null')) FROM data CROSS JOIN json_each_text(data.row) AS json_data - WHERE json_data.key IN ('{fmtPKeys}') + WHERE json_data.key IN ('${fmtPKeys}') )|] where fmtPKeys = T.intercalate "','" pKeys diff --git a/src/PostgREST/SchemaCache.hs b/src/PostgREST/SchemaCache.hs index e3944e4cbe..a343292371 100644 --- a/src/PostgREST/SchemaCache.hs +++ b/src/PostgREST/SchemaCache.hs @@ -40,8 +40,8 @@ import qualified Hasql.Encoders as HE import qualified Hasql.Statement as SQL import qualified Hasql.Transaction as SQL -import Data.Functor.Contravariant ((>$<)) -import Text.InterpolatedString.Perl6 (q) +import Data.Functor.Contravariant ((>$<)) +import NeatInterpolation (trimming) import PostgREST.Config (AppConfig (..)) import PostgREST.Config.Database (TimezoneNames, @@ -339,7 +339,7 @@ decodeRepresentations = dataRepresentations :: Bool -> SQL.Statement AppConfig RepresentationsMap dataRepresentations = SQL.Statement sql mempty decodeRepresentations where - sql = [q| + sql = encodeUtf8 [trimming| SELECT c.castsource::regtype::text, c.casttarget::regtype::text, @@ -376,7 +376,7 @@ accessibleFuncs = SQL.Statement sql params decodeFuncs sql = funcsSqlQuery <> " AND pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')" funcsSqlQuery :: SqlQuery -funcsSqlQuery = [q| +funcsSqlQuery = encodeUtf8 [trimming| -- Recursively get the base types of domains WITH base_types AS ( @@ -461,7 +461,7 @@ funcsSqlQuery = [q| substr(setting, strpos(setting, '=') + 1) )) as kvs FROM unnest(proconfig) setting - WHERE setting ~ ANY($2) + WHERE setting ~ ANY($$2) ) func_settings ON TRUE WHERE t.oid <> 'trigger'::regtype AND COALESCE(a.callable, true) AND prokind = 'f'|] @@ -470,20 +470,20 @@ schemaDescription :: Bool -> SQL.Statement Schema (Maybe Text) schemaDescription = SQL.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text)) where - sql = [q| + sql = encodeUtf8 [trimming| select description from pg_namespace n left join pg_description d on d.objoid = n.oid where - n.nspname = $1 |] + n.nspname = $$1 |] accessibleTables :: Bool -> SQL.Statement [Schema] AccessSet accessibleTables = SQL.Statement sql (arrayParam HE.text) decodeAccessibleIdentifiers where - sql = [q| + sql = encodeUtf8 [trimming| SELECT n.nspname AS table_schema, c.relname AS table_name @@ -491,7 +491,7 @@ accessibleTables = JOIN pg_namespace n ON n.oid = c.relnamespace WHERE c.relkind IN ('v','r','m','f','p') AND n.nspname NOT IN ('pg_catalog', 'information_schema') - AND n.nspname = ANY($1) + AND n.nspname = ANY($$1) AND ( pg_has_role(c.relowner, 'USAGE') or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER') @@ -619,7 +619,7 @@ tablesSqlQuery = -- (pg_has_role(ss.relowner, 'USAGE'::text) OR has_column_privilege(ss.roid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text)); -- on the "columns" CTE, left joining on pg_depend and pg_class is used to obtain the sequence name as a column default in case there are GENERATED .. AS IDENTITY, -- generated columns are only available from pg >= 10 but the query is agnostic to versions. dep.deptype = 'i' is done because there are other 'a' dependencies on PKs - [q| + encodeUtf8 [trimming| WITH columns AS ( SELECT @@ -678,7 +678,7 @@ tablesSqlQuery = AND a.attnum > 0 AND NOT a.attisdropped AND c.relkind in ('r', 'v', 'f', 'm', 'p') - AND nc.nspname = ANY($1) + AND nc.nspname = ANY($$1) ), columns_agg AS ( SELECT DISTINCT @@ -826,7 +826,7 @@ allM2OandO2ORels = SQL.Statement sql HE.noParams decodeRels where -- We use jsonb_agg for comparing the uniques/pks instead of array_agg to avoid the ERROR: cannot accumulate arrays of different dimensionality - sql = [q| + sql = encodeUtf8 [trimming| WITH pks_uniques_cols AS ( SELECT @@ -875,7 +875,7 @@ allComputedRels :: Bool -> SQL.Statement () [Relationship] allComputedRels = SQL.Statement sql HE.noParams (HD.rowList cRelRow) where - sql = [q| + sql = encodeUtf8 [trimming| with all_relations as ( select reltype @@ -927,7 +927,7 @@ allViewsKeyDependencies = params = (toList . configDbSchemas >$< arrayParam HE.text) <> (configDbExtraSearchPath >$< arrayParam HE.text) - sql = [q| + sql = encodeUtf8 [trimming| with recursive pks_fks as ( -- pk + fk referencing col @@ -963,7 +963,7 @@ allViewsKeyDependencies = from pg_class c join pg_namespace n on n.oid = c.relnamespace join pg_rewrite r on r.ev_class = c.oid - where c.relkind in ('v', 'm') and n.nspname = ANY($1 || $2) + where c.relkind in ('v', 'm') and n.nspname = ANY($$1 || $$2) ), transform_json as ( select @@ -1067,7 +1067,7 @@ allViewsKeyDependencies = false, ARRAY[resorigtbl] from results r - where view_schema = ANY ($1) + where view_schema = ANY ($$1) union all select view.view_id, @@ -1130,7 +1130,7 @@ mediaHandlers = SQL.Statement sql params decodeMediaHandlers where params = toList . configDbSchemas >$< arrayParam HE.text - sql = [q| + sql = encodeUtf8 [trimming| with all_relations as ( select reltype @@ -1156,7 +1156,7 @@ mediaHandlers = JOIN pg_type b ON t.typbasetype = b.oid WHERE t.typbasetype <> 0 and - (t.typname ~* '^[A-Za-z0-9.-]+/[A-Za-z0-9.\+-]+$' or t.typname = '*/*') + (t.typname ~* '^[A-Za-z0-9.-]+/[A-Za-z0-9.\+-]+$$' or t.typname = '*/*') ) select proc_schema.nspname as handler_schema, @@ -1172,7 +1172,7 @@ mediaHandlers = join pg_type arg_name on arg_name.oid = proc.proargtypes[0] join pg_namespace arg_schema on arg_schema.oid = arg_name.typnamespace where - proc_schema.nspname = ANY($1) and + proc_schema.nspname = ANY($$1) and proc.pronargs = 1 and arg_name.oid in (select reltype from all_relations) union @@ -1188,7 +1188,7 @@ mediaHandlers = join media_types mtype on proc.prorettype = mtype.oid join pg_namespace typ_sch on typ_sch.oid = mtype.typnamespace where - pro_sch.nspname = ANY($1) and NOT proretset + pro_sch.nspname = ANY($$1) and NOT proretset and prokind = 'f'|] decodeMediaHandlers :: HD.Result MediaHandlerMap