@@ -8,67 +8,74 @@ The schema cache is necessary for resource embedding, foreign keys are used for
88
99These queries are executed once at startup or when PostgREST is reloaded.
1010-}
11+ {-# LANGUAGE AllowAmbiguousTypes #-}
12+ {-# LANGUAGE DataKinds #-}
1113{-# LANGUAGE DeriveAnyClass #-}
1214{-# LANGUAGE DeriveGeneric #-}
1315{-# LANGUAGE FlexibleContexts #-}
16+ {-# LANGUAGE FlexibleInstances #-}
1417{-# LANGUAGE MultiParamTypeClasses #-}
1518{-# LANGUAGE NamedFieldPuns #-}
19+ {-# LANGUAGE PolyKinds #-}
1620{-# LANGUAGE QuasiQuotes #-}
1721{-# LANGUAGE RecordWildCards #-}
1822{-# LANGUAGE ScopedTypeVariables #-}
19- {-# LANGUAGE TypeSynonymInstances #-}
23+ {-# LANGUAGE TypeApplications #-}
24+ {-# LANGUAGE TypeFamilies #-}
2025
2126module PostgREST.SchemaCache
2227 ( SchemaCache (.. )
2328 , TablesFuzzyIndex
2429 , querySchemaCache
2530 , showSummary
2631 , decodeFuncs
27- , QueryTimings (.. )
28- , queryTimingsWLabels
2932 ) where
3033
3134import Data.Aeson ((.=) )
3235import qualified Data.Aeson as JSON
3336
34- import qualified Data.ByteString.Char8 as BS
3537import qualified Data.HashMap.Strict as HM
3638import qualified Data.HashMap.Strict.InsOrd as HMI
3739import qualified Data.Set as S
3840import qualified Data.Text as T
3941import qualified Hasql.Decoders as HD
4042import qualified Hasql.Encoders as HE
4143import qualified Hasql.Statement as SQL
42- import qualified Hasql.Transaction as SQL
44+ import qualified Hasql.Transaction as SQL hiding (sql ,
45+ statement )
4346
4447import Data.Functor.Contravariant ((>$<) )
4548import NeatInterpolation (trimming )
4649
47- import PostgREST.Config (AppConfig (.. ),
48- LogLevel (.. ))
49- import PostgREST.Config.Database (TimezoneNames ,
50- toIsolationLevel )
51- import PostgREST.SchemaCache.Identifiers (FieldName ,
52- QualifiedIdentifier (.. ),
53- RelIdentifier (.. ),
54- Schema , escapeIdent ,
55- isAnyElement )
56- import PostgREST.SchemaCache.Relationship (Cardinality (.. ),
57- Junction (.. ),
58- Relationship (.. ),
59- RelationshipsMap )
60- import PostgREST.SchemaCache.Representations (DataRepresentation (.. ),
61- RepresentationsMap )
62- import PostgREST.SchemaCache.Routine (FuncVolatility (.. ),
63- MediaHandler (.. ),
64- MediaHandlerMap ,
65- PgType (.. ),
66- RetType (.. ),
67- Routine (.. ),
68- RoutineMap ,
69- RoutineParam (.. ))
70- import PostgREST.SchemaCache.Table (Column (.. ), ColumnMap ,
71- Table (.. ), TablesMap )
50+ import PostgREST.Config (AppConfig (.. ),
51+ LogLevel (.. ))
52+ import PostgREST.Config.Database (TimezoneNames ,
53+ toIsolationLevel )
54+ import PostgREST.SchemaCache.Identifiers (FieldName ,
55+ QualifiedIdentifier (.. ),
56+ RelIdentifier (.. ),
57+ Schema ,
58+ escapeIdent ,
59+ isAnyElement )
60+ import PostgREST.SchemaCache.Relationship (Cardinality (.. ),
61+ Junction (.. ),
62+ Relationship (.. ),
63+ RelationshipsMap )
64+ import PostgREST.SchemaCache.Representations (DataRepresentation (.. ),
65+ RepresentationsMap )
66+ import PostgREST.SchemaCache.Routine (FuncVolatility (.. ),
67+ MediaHandler (.. ),
68+ MediaHandlerMap ,
69+ PgType (.. ),
70+ RetType (.. ),
71+ Routine (.. ),
72+ RoutineMap ,
73+ RoutineParam (.. ))
74+ import PostgREST.SchemaCache.Table (Column (.. ),
75+ ColumnMap ,
76+ Table (.. ),
77+ TablesMap )
78+ import qualified PostgREST.SqlTransaction as SQL
7279
7380import qualified PostgREST.MediaType as MediaType
7481
@@ -153,48 +160,47 @@ type SqlQuery = ByteString
153160maxDbTablesForFuzzySearch :: Int
154161maxDbTablesForFuzzySearch = 500
155162
156- querySchemaCache :: AppConfig -> SQL. Transaction (SchemaCache , Maybe QueryTimings )
157- querySchemaCache conf@ AppConfig {.. } = do
158- 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
159- tabs <- sqlTimedStmt gucTbls conf allTables
160- keyDeps <- sqlTimedStmt gucKDeps conf allViewsKeyDependencies
161- m2oRels <- sqlTimedStmt gucRels mempty allM2OandO2ORels
162- funcs <- sqlTimedStmt gucFuncs conf allFunctions
163- cRels <- sqlTimedStmt gucCRels mempty allComputedRels
164- reps <- sqlTimedStmt gucDReps conf dataRepresentations
165- mHdlers <- sqlTimedStmt gucMHdrs conf mediaHandlers
166- tzones <- if configDbTimezoneEnabled
167- then sqlTimedStmt gucTzones mempty timezones
168- else pure S. empty
169- _ <-
170- let sleepCall = SQL. Statement " select pg_sleep($1 / 1000.0)" (param HE. int4) HD. noResult True in
171- for_ configInternalSCQuerySleep (`SQL.statement` sleepCall) -- only used for testing
172-
173- qsTime <-
174- if isLogDebug
175- then Just <$> SQL. statement mempty (extractTimings configDbTimezoneEnabled)
176- else pure Nothing
177-
178- let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps
179- rels = addInverseRels $ addM2MRels tabsWViewsPks $ addViewM2OAndO2ORels keyDeps m2oRels
180-
181- return (removeInternal schemas $ SchemaCache {
182- dbTables = tabsWViewsPks
183- , dbRelationships = getOverrideRelationshipsMap rels cRels
184- , dbRoutines = funcs
185- , dbRepresentations = reps
186- , dbMediaHandlers = HM. union mHdlers initialMediaHandlers -- the custom handlers will override the initial ones
187- , dbTimezones = tzones
188-
189- , dbTablesFuzzyIndex =
190- -- Only build fuzzy index for schemas with a reasonable number of tables
191- -- Fuzzy.FuzzySet is memory heavy we just don't use it for large schemas
192- Fuzzy. fromList <$> HM. filter ((< maxDbTablesForFuzzySearch) . length ) (HM. fromListWith (<>) ((qiSchema &&& pure . qiName) <$> HM. keys tabsWViewsPks))
193- }, qsTime)
163+ querySchemaCache :: AppConfig -> SQL. Transaction (SchemaCache , Maybe SQL. QueryTimings )
164+ querySchemaCache conf@ AppConfig {.. } =
165+ -- if configInternalSCLockId is set run queries step-by-step waiting for lock release before each
166+ SQL. runSteppedTransaction @ (SQL. SqlTransaction SchemaCacheLabel ) configInternalSCLockId $
167+ -- if log level is debug then time queries
168+ SQL. runTimed @ (SQL. SqlTransaction SchemaCacheLabel ) isLogDebug $ do
169+ SQL. sql @ NoStep " 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
170+ tabs <- SQL. statement @ Tables conf allTables
171+ keyDeps <- SQL. statement @ KeyDependencies conf allViewsKeyDependencies
172+ m2oRels <- SQL. statement @ Relationships mempty allM2OandO2ORels
173+ funcs <- SQL. statement @ Functions conf allFunctions
174+ cRels <- SQL. statement @ ComputedRelationships mempty allComputedRels
175+ reps <- SQL. statement @ DataRepresentations conf dataRepresentations
176+ mHdlers <- SQL. statement @ MediaHandlers conf mediaHandlers
177+ tzones <- if configDbTimezoneEnabled
178+ then SQL. statement @ Timezones mempty timezones
179+ else pure S. empty
180+
181+ let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps
182+ rels = addInverseRels $ addM2MRels tabsWViewsPks $ addViewM2OAndO2ORels keyDeps m2oRels
183+
184+ return $ removeInternal schemas $ SchemaCache {
185+ dbTables = tabsWViewsPks
186+ , dbRelationships = getOverrideRelationshipsMap rels cRels
187+ , dbRoutines = funcs
188+ , dbRepresentations = reps
189+ , dbMediaHandlers = HM. union mHdlers initialMediaHandlers -- the custom handlers will override the initial ones
190+ , dbTimezones = tzones
191+
192+ , dbTablesFuzzyIndex =
193+ -- Only build fuzzy index for schemas with a reasonable number of tables
194+ -- Fuzzy.FuzzySet is memory heavy we just don't use it for large schemas
195+ Fuzzy. fromList <$> HM. filter ((< maxDbTablesForFuzzySearch) . length ) (HM. fromListWith (<>) ((qiSchema &&& pure . qiName) <$> HM. keys tabsWViewsPks))
196+ }
197+ -- only used for testing
198+ -- TODO remove configInternalSCQuerySleep once all tests are migrated to stepped execution
199+ <* for_ configInternalSCQuerySleep (\ sleep -> SQL. statement @ NoStep sleep sleepCall)
194200 where
195201 schemas = toList configDbSchemas
196202 isLogDebug = configLogLevel == LogDebug
197- sqlTimedStmt = sqlTimedStatement isLogDebug
203+ sleepCall = SQL. Statement " select pg_sleep($1 / 1000.0) " (param HE. int4) HD. noResult True
198204
199205-- | overrides detected relationships with the computed relationships and gets the RelationshipsMap
200206getOverrideRelationshipsMap :: [Relationship ] -> [Relationship ] -> RelationshipsMap
@@ -1155,71 +1161,19 @@ nullableColumn = HD.column . HD.nullable
11551161arrayColumn :: HD. Value a -> HD. Row [a ]
11561162arrayColumn = column . HD. listArray . HD. nonNullable
11571163
1158- {-
1159- - Times a sql statement inside a transaction, for this:
1160- -
1161- - 1. We start a timer: select set_config('pgrst.tmp_x', clock_timestamp()::text, false);
1162- - 2. Run the statement: select ....
1163- - 3. End the timer: select set_config('pgrst.tmp_x', (clock_timestamp() - current_setting('pgrst.tmp_x', false)::timestamptz)::text, false);
1164- -
1165- - We can do this for several statements inside the transaction. The timings are later captured at the end of the transaction with extractTimings.
1166- -}
1167- sqlTimedStatement :: Bool -> ByteString -> a -> SQL. Statement a b -> SQL. Transaction b
1168- sqlTimedStatement isLogDebug guc params stmt =
1169- if isLogDebug then
1170- SQL. sql sFrag >> SQL. statement params stmt <* SQL. sql eFrag
1171- else
1172- SQL. statement params stmt
1173- where
1174- sFrag = " select set_config('pgrst." <> guc <> " ', clock_timestamp()::text, true)"
1175- eFrag = " select set_config('pgrst." <> guc <> " ', (clock_timestamp() - current_setting('pgrst." <> guc <> " ', false)::timestamptz)::text, true)"
1176-
1177- -- Extract all the generated timings (see sqlTimedStatement) converting the value to milliseconds.
1178- extractTimings :: Bool -> SQL. Statement () QueryTimings
1179- extractTimings hasTimezones = SQL. Statement sql HE. noParams decodeThem True
1180- where
1181- qFrag setting = " extract('milliseconds' from current_setting('pgrst." <> setting <> " ', false)::interval)::text"
1182- sql = " SELECT " <> BS. intercalate " ,"
1183- [ qFrag gucTbls, qFrag gucKDeps, qFrag gucRels
1184- , qFrag gucFuncs, qFrag gucCRels, qFrag gucDReps
1185- , qFrag gucMHdrs, if hasTimezones then qFrag gucTzones else " '0.0'"
1186- ]
1187- decodeThem :: HD. Result QueryTimings
1188- decodeThem = HD. singleRow $
1189- QueryTimings
1190- <$> column HD. text <*> column HD. text <*> column HD. text
1191- <*> column HD. text <*> column HD. text <*> column HD. text
1192- <*> column HD. text <*> column HD. text
1193-
1194- data QueryTimings = QueryTimings
1195- { qtTables :: Text
1196- , qtKeyDeps :: Text
1197- , qtRels :: Text
1198- , qtFuncs :: Text
1199- , qtCRels :: Text
1200- , qtDReps :: Text
1201- , qtMHdrs :: Text
1202- , qtTzones :: Text
1203- } deriving (Show )
1204-
1205- queryTimingsWLabels :: QueryTimings -> [(ByteString , Text )]
1206- queryTimingsWLabels qt =
1207- [ (gucTbls, qtTables qt)
1208- , (gucKDeps, qtKeyDeps qt)
1209- , (gucRels, qtRels qt)
1210- , (gucFuncs, qtFuncs qt)
1211- , (gucCRels, qtCRels qt)
1212- , (gucDReps, qtDReps qt)
1213- , (gucMHdrs, qtMHdrs qt)
1214- , (gucTzones, qtTzones qt)
1215- ]
1216-
1217- gucTbls , gucKDeps , gucRels , gucFuncs , gucCRels , gucDReps , gucMHdrs , gucTzones :: ByteString
1218- gucTbls = " tables"
1219- gucKDeps = " keydeps"
1220- gucRels = " rels"
1221- gucFuncs = " funcs"
1222- gucCRels = " comprels"
1223- gucDReps = " dreps"
1224- gucMHdrs = " mhandlers"
1225- gucTzones = " tzones"
1164+ data SchemaCacheLabel = Step SQL. LockSpec SQL. TimingSpec
1165+
1166+ instance SQL. LabelKind SchemaCacheLabel where
1167+ type LabelConstraint SchemaCacheLabel label = (SQL. SqlBreakpoint label , SQL. SqlTiming label )
1168+ instance SQL. HasTimingsQueryLabel SchemaCacheLabel where
1169+ type TimingsQueryLabel SchemaCacheLabel = NoStep
1170+
1171+ type Tables = Step (SQL. Lock 0 ) (SQL. Timing " tables" )
1172+ type KeyDependencies = Step (SQL. Lock 1 ) (SQL. Timing " keydeps" )
1173+ type Relationships = Step (SQL. Lock 2 ) (SQL. Timing " rels" )
1174+ type Functions = Step (SQL. Lock 3 ) (SQL. Timing " funcs" )
1175+ type ComputedRelationships = Step (SQL. Lock 4 ) (SQL. Timing " comprels" )
1176+ type DataRepresentations = Step (SQL. Lock 5 ) (SQL. Timing " dreps" )
1177+ type MediaHandlers = Step (SQL. Lock 6 ) (SQL. Timing " mhandlers" )
1178+ type Timezones = Step (SQL. Lock 7 ) (SQL. Timing " tzones" )
1179+ type NoStep = Step SQL. NoLock SQL. NoTiming
0 commit comments