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 , clock >= 0.8.3 && < 0.9.0
, configurator-pg >= 0.2 && < 0.3 , configurator-pg >= 0.2 && < 0.3
, containers >= 0.5.7 && < 0.7 , containers >= 0.5.7 && < 0.7
, contravariant-extras >= 0.3.3 && < 0.4
, cookie >= 0.4.2 && < 0.5 , cookie >= 0.4.2 && < 0.5
, directory >= 1.2.6 && < 1.4 , directory >= 1.2.6 && < 1.4
, either >= 4.4.1 && < 5.1 , 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.Statement as SQL
import qualified Hasql.Transaction as SQL import qualified Hasql.Transaction as SQL
import Contravariant.Extras (contrazip2) import Data.Functor.Contravariant ((>$<))
import Text.InterpolatedString.Perl6 (q) import Text.InterpolatedString.Perl6 (q)
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
@@ -140,15 +140,15 @@ type SqlQuery = ByteString
querySchemaCache :: AppConfig -> SQL.Transaction SchemaCache 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 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 tabs <- SQL.statement conf $ allTables prepared
keyDeps <- SQL.statement (schemas, configDbExtraSearchPath) $ allViewsKeyDependencies prepared keyDeps <- SQL.statement conf $ allViewsKeyDependencies prepared
m2oRels <- SQL.statement mempty $ allM2OandO2ORels 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 cRels <- SQL.statement mempty $ allComputedRels prepared
reps <- SQL.statement schemas $ dataRepresentations prepared reps <- SQL.statement conf $ dataRepresentations prepared
mHdlers <- SQL.statement schemas $ mediaHandlers prepared mHdlers <- SQL.statement conf $ mediaHandlers prepared
tzones <- SQL.statement mempty $ timezones prepared tzones <- SQL.statement mempty $ timezones prepared
_ <- _ <-
let sleepCall = SQL.Statement "select pg_sleep($1 / 1000.0)" (param HE.int4) HD.noResult prepared in let sleepCall = SQL.Statement "select pg_sleep($1 / 1000.0)" (param HE.int4) HD.noResult prepared in
@@ -336,8 +336,8 @@ decodeRepresentations =
-- 2. implicit -- 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 -- 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. -- cases like CSV specific representations.
dataRepresentations :: Bool -> SQL.Statement [Schema] RepresentationsMap dataRepresentations :: Bool -> SQL.Statement AppConfig RepresentationsMap
dataRepresentations = SQL.Statement sql (arrayParam HE.text) decodeRepresentations dataRepresentations = SQL.Statement sql mempty decodeRepresentations
where where
sql = [q| sql = [q|
SELECT 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))) OR (dst_t.typtype = 'd' AND c.castsource IN ('json'::regtype::oid , 'text'::regtype::oid)))
|] |]
allFunctions :: Bool -> SQL.Statement ([Schema], [Text]) RoutineMap allFunctions :: Bool -> SQL.Statement AppConfig RoutineMap
allFunctions = SQL.Statement sql (contrazip2 (arrayParam HE.text) (arrayParam HE.text)) decodeFuncs allFunctions = SQL.Statement sql params decodeFuncs
where 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 :: 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 where
params =
(fst >$< param HE.text) <>
(snd >$< arrayParam HE.text)
sql = funcsSqlQuery <> " AND pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')" sql = funcsSqlQuery <> " AND pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
funcsSqlQuery :: SqlQuery 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. -- * 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) takeFirstPK = mapMaybe (head . snd)
allTables :: Bool -> SQL.Statement [Schema] TablesMap allTables :: Bool -> SQL.Statement AppConfig TablesMap
allTables = allTables = SQL.Statement tablesSqlQuery params decodeTables
SQL.Statement tablesSqlQuery (arrayParam HE.text) decodeTables where
params = toList . configDbSchemas >$< arrayParam HE.text
-- | Gets tables with their PK cols -- | Gets tables with their PK cols
tablesSqlQuery :: SqlQuery tablesSqlQuery :: SqlQuery
@@ -909,13 +917,16 @@ allComputedRels =
column HD.bool column HD.bool
-- | Returns all the views' primary keys and foreign keys dependencies -- | Returns all the views' primary keys and foreign keys dependencies
allViewsKeyDependencies :: Bool -> SQL.Statement ([Schema], [Schema]) [ViewKeyDependency] allViewsKeyDependencies :: Bool -> SQL.Statement AppConfig [ViewKeyDependency]
allViewsKeyDependencies = allViewsKeyDependencies =
SQL.Statement sql (contrazip2 (arrayParam HE.text) (arrayParam HE.text)) decodeViewKeyDeps SQL.Statement sql params decodeViewKeyDeps
-- query explanation at: -- query explanation at:
-- * rationale: https://gist.github.com/wolfgangwalther/5425d64e7b0d20aad71f6f68474d9f19 -- * rationale: https://gist.github.com/wolfgangwalther/5425d64e7b0d20aad71f6f68474d9f19
-- * json transformation: https://gist.github.com/wolfgangwalther/3a8939da680c24ad767e93ad2c183089 -- * json transformation: https://gist.github.com/wolfgangwalther/3a8939da680c24ad767e93ad2c183089
where where
params =
(toList . configDbSchemas >$< arrayParam HE.text) <>
(configDbExtraSearchPath >$< arrayParam HE.text)
sql = [q| sql = [q|
with recursive with recursive
pks_fks as ( pks_fks as (
@@ -1114,10 +1125,11 @@ initialMediaHandlers =
HM.insert (RelAnyElement, MediaType.MTGeoJSON ) (BuiltinOvAggGeoJson, MediaType.MTGeoJSON) HM.insert (RelAnyElement, MediaType.MTGeoJSON ) (BuiltinOvAggGeoJson, MediaType.MTGeoJSON)
HM.empty HM.empty
mediaHandlers :: Bool -> SQL.Statement [Schema] MediaHandlerMap mediaHandlers :: Bool -> SQL.Statement AppConfig MediaHandlerMap
mediaHandlers = mediaHandlers =
SQL.Statement sql (arrayParam HE.text) decodeMediaHandlers SQL.Statement sql params decodeMediaHandlers
where where
params = toList . configDbSchemas >$< arrayParam HE.text
sql = [q| sql = [q|
with with
all_relations as ( all_relations as (