refactor: Pass params in SchemaCache without contrazip2

Contravariant.Extras uses Template Haskell, which is hard to
cross-compile. Reducing usage of Template Haskell with the ultimate goal
of solving all cross compilation challenges.
This commit is contained in:
Wolfgang Walther
2024-06-16 00:59:10 +02:00
committed by Wolfgang Walther
parent 08692f52d6
commit 0b25039f0f
2 changed files with 32 additions and 21 deletions
-1
View File
@@ -101,7 +101,6 @@ library
, clock >= 0.8.3 && < 0.9.0
, configurator-pg >= 0.2 && < 0.3
, containers >= 0.5.7 && < 0.7
, contravariant-extras >= 0.3.3 && < 0.4
, cookie >= 0.4.2 && < 0.5
, directory >= 1.2.6 && < 1.4
, either >= 4.4.1 && < 5.1
+32 -20
View File
@@ -40,7 +40,7 @@ import qualified Hasql.Encoders as HE
import qualified Hasql.Statement as SQL
import qualified Hasql.Transaction as SQL
import Contravariant.Extras (contrazip2)
import Data.Functor.Contravariant ((>$<))
import Text.InterpolatedString.Perl6 (q)
import PostgREST.Config (AppConfig (..))
@@ -140,15 +140,15 @@ type SqlQuery = ByteString
querySchemaCache :: AppConfig -> SQL.Transaction SchemaCache
querySchemaCache AppConfig{..} = do
querySchemaCache conf@AppConfig{..} = do
SQL.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object
tabs <- SQL.statement schemas $ allTables prepared
keyDeps <- SQL.statement (schemas, configDbExtraSearchPath) $ allViewsKeyDependencies prepared
tabs <- SQL.statement conf $ allTables prepared
keyDeps <- SQL.statement conf $ allViewsKeyDependencies prepared
m2oRels <- SQL.statement mempty $ allM2OandO2ORels prepared
funcs <- SQL.statement (schemas, configDbHoistedTxSettings) $ allFunctions prepared
funcs <- SQL.statement conf $ allFunctions prepared
cRels <- SQL.statement mempty $ allComputedRels prepared
reps <- SQL.statement schemas $ dataRepresentations prepared
mHdlers <- SQL.statement schemas $ mediaHandlers prepared
reps <- SQL.statement conf $ dataRepresentations prepared
mHdlers <- SQL.statement conf $ mediaHandlers prepared
tzones <- SQL.statement mempty $ timezones prepared
_ <-
let sleepCall = SQL.Statement "select pg_sleep($1 / 1000.0)" (param HE.int4) HD.noResult prepared in
@@ -336,8 +336,8 @@ decodeRepresentations =
-- 2. implicit
-- For the time being it must also be to/from JSON or text, although one can imagine a future where we support special
-- cases like CSV specific representations.
dataRepresentations :: Bool -> SQL.Statement [Schema] RepresentationsMap
dataRepresentations = SQL.Statement sql (arrayParam HE.text) decodeRepresentations
dataRepresentations :: Bool -> SQL.Statement AppConfig RepresentationsMap
dataRepresentations = SQL.Statement sql mempty decodeRepresentations
where
sql = [q|
SELECT
@@ -358,14 +358,21 @@ dataRepresentations = SQL.Statement sql (arrayParam HE.text) decodeRepresentatio
OR (dst_t.typtype = 'd' AND c.castsource IN ('json'::regtype::oid , 'text'::regtype::oid)))
|]
allFunctions :: Bool -> SQL.Statement ([Schema], [Text]) RoutineMap
allFunctions = SQL.Statement sql (contrazip2 (arrayParam HE.text) (arrayParam HE.text)) decodeFuncs
allFunctions :: Bool -> SQL.Statement AppConfig RoutineMap
allFunctions = SQL.Statement sql params decodeFuncs
where
sql = funcsSqlQuery <> " AND pn.nspname = ANY($1)"
params =
(toList . configDbSchemas >$< arrayParam HE.text) <>
(configDbHoistedTxSettings >$< arrayParam HE.text)
sql =
funcsSqlQuery <> " AND pn.nspname = ANY($1)"
accessibleFuncs :: Bool -> SQL.Statement (Schema, [Text]) RoutineMap
accessibleFuncs = SQL.Statement sql (contrazip2 (param HE.text) (arrayParam HE.text)) decodeFuncs
accessibleFuncs = SQL.Statement sql params decodeFuncs
where
params =
(fst >$< param HE.text) <>
(snd >$< arrayParam HE.text)
sql = funcsSqlQuery <> " AND pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
funcsSqlQuery :: SqlQuery
@@ -599,9 +606,10 @@ addViewPrimaryKeys tabs keyDeps =
-- * We need to choose a single reference for each column, otherwise we'd output too many columns in location headers etc.
takeFirstPK = mapMaybe (head . snd)
allTables :: Bool -> SQL.Statement [Schema] TablesMap
allTables =
SQL.Statement tablesSqlQuery (arrayParam HE.text) decodeTables
allTables :: Bool -> SQL.Statement AppConfig TablesMap
allTables = SQL.Statement tablesSqlQuery params decodeTables
where
params = toList . configDbSchemas >$< arrayParam HE.text
-- | Gets tables with their PK cols
tablesSqlQuery :: SqlQuery
@@ -909,13 +917,16 @@ allComputedRels =
column HD.bool
-- | Returns all the views' primary keys and foreign keys dependencies
allViewsKeyDependencies :: Bool -> SQL.Statement ([Schema], [Schema]) [ViewKeyDependency]
allViewsKeyDependencies :: Bool -> SQL.Statement AppConfig [ViewKeyDependency]
allViewsKeyDependencies =
SQL.Statement sql (contrazip2 (arrayParam HE.text) (arrayParam HE.text)) decodeViewKeyDeps
SQL.Statement sql params decodeViewKeyDeps
-- query explanation at:
-- * rationale: https://gist.github.com/wolfgangwalther/5425d64e7b0d20aad71f6f68474d9f19
-- * json transformation: https://gist.github.com/wolfgangwalther/3a8939da680c24ad767e93ad2c183089
where
params =
(toList . configDbSchemas >$< arrayParam HE.text) <>
(configDbExtraSearchPath >$< arrayParam HE.text)
sql = [q|
with recursive
pks_fks as (
@@ -1114,10 +1125,11 @@ initialMediaHandlers =
HM.insert (RelAnyElement, MediaType.MTGeoJSON ) (BuiltinOvAggGeoJson, MediaType.MTGeoJSON)
HM.empty
mediaHandlers :: Bool -> SQL.Statement [Schema] MediaHandlerMap
mediaHandlers :: Bool -> SQL.Statement AppConfig MediaHandlerMap
mediaHandlers =
SQL.Statement sql (arrayParam HE.text) decodeMediaHandlers
SQL.Statement sql params decodeMediaHandlers
where
params = toList . configDbSchemas >$< arrayParam HE.text
sql = [q|
with
all_relations as (