Skip to content

Commit

Permalink
refactor: Replace interpolatedstring-perl6 with neat-interpolation
Browse files Browse the repository at this point in the history
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 PostgREST#2273.
  • Loading branch information
wolfgangwalther committed Jun 16, 2024
1 parent 0b25039 commit 4e34dd7
Show file tree
Hide file tree
Showing 4 changed files with 40 additions and 39 deletions.
2 changes: 1 addition & 1 deletion postgrest.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
27 changes: 14 additions & 13 deletions src/PostgREST/Config/Database.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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,
Expand All @@ -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

Expand All @@ -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
Expand All @@ -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
Expand Down
10 changes: 5 additions & 5 deletions src/PostgREST/Query/SqlFragment.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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
Expand Down
40 changes: 20 additions & 20 deletions src/PostgREST/SchemaCache.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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 (
Expand Down Expand Up @@ -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'|]
Expand All @@ -470,28 +470,28 @@ 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
FROM pg_class c
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')
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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
Expand All @@ -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,
Expand All @@ -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
Expand All @@ -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
Expand Down

0 comments on commit 4e34dd7

Please sign in to comment.