jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(deps): update hasql to 1.9.3.1

Browse Source 
Michael and I arrived at mostly the same things independently. Took some
of his, some of mine.

Co-authored-by: Michal Kleczek <michal@kleczek.org>
This commit is contained in:
Wolfgang Walther
2026-04-27 09:12:31 +00:00
co-authored by Michal Kleczek
parent f80122e12b
commit a5cc457875
17 changed files with 146 additions and 184 deletions
Download Patch File Download Diff File Expand all files Collapse all files
nix/overlays/haskell-packages.nix
-12
View File
@@ -49,17 +49,6 @@ let
# Before upgrading fuzzyset to 0.3, check: https://github.com/PostgREST/postgrest/issues/3329 # Before upgrading fuzzyset to 0.3, check: https://github.com/PostgREST/postgrest/issues/3329
fuzzyset = prev.fuzzyset_0_2_4; fuzzyset = prev.fuzzyset_0_2_4;
# Downgrade hasql and related packages while we are still on GHC 9.4 for the static build.
hasql = lib.dontCheck (lib.doJailbreak prev.hasql_1_6_4_4);
hasql-dynamic-statements = lib.dontCheck prev.hasql-dynamic-statements_0_3_1_5;
hasql-implicits = lib.dontCheck prev.hasql-implicits_0_1_1_3;
hasql-notifications = lib.dontCheck prev.hasql-notifications_0_2_2_2;
hasql-pool = lib.dontCheck prev.hasql-pool_1_0_1;
hasql-transaction = lib.dontCheck prev.hasql-transaction_1_1_0_1;
postgresql-binary = lib.dontCheck (lib.doJailbreak prev.postgresql-binary_0_13_1_3);
text-builder = prev.text-builder_0_6_10;
text-builder-dev = prev.text-builder-dev_0_3_10;
http2 = http2 =
prev.callHackageDirect prev.callHackageDirect
{ {
@@ -95,7 +84,6 @@ let
sha256 = "sha256-jmr8kpeSPDkOhT0i9PhozZapX4nUs92cOX7POAGb7/M="; sha256 = "sha256-jmr8kpeSPDkOhT0i9PhozZapX4nUs92cOX7POAGb7/M=";
} }
{ }); { });
}; };
in in
{ {
postgrest.cabal
+9 -9
View File
@@ -117,11 +117,11 @@ library
, either >= 4.4.1 && < 5.1 , either >= 4.4.1 && < 5.1
, extra >= 1.7.0 && < 2.0 , extra >= 1.7.0 && < 2.0
, fuzzyset >= 0.2.4 && < 0.3 , fuzzyset >= 0.2.4 && < 0.3
, hasql >= 1.6.1.1 && < 1.7 , hasql >= 1.9 && <= 1.9.3.1
, hasql-dynamic-statements >= 0.3.1 && < 0.4 , hasql-dynamic-statements >= 0.3.1 && <= 0.3.1.8
, hasql-notifications >= 0.2.2.2 && < 0.2.3 , hasql-notifications >= 0.2.4.0 && < 0.3
, hasql-pool >= 1.0.1 && < 1.1 , hasql-pool >= 1.1 && <= 1.3.0.4
, hasql-transaction >= 1.0.1 && < 1.2 , hasql-transaction >= 1.0.1 && <= 1.2.1
, http-client >= 0.7.19 && < 0.8 , http-client >= 0.7.19 && < 0.8
, http-types >= 0.12.2 && < 0.13 , http-types >= 0.12.2 && < 0.13
, insert-ordered-containers >= 0.2.2 && < 0.3 , insert-ordered-containers >= 0.2.2 && < 0.3
@@ -270,8 +270,8 @@ test-suite spec
, bytestring >= 0.10.8 && < 0.13 , bytestring >= 0.10.8 && < 0.13
, case-insensitive >= 1.2 && < 1.3 , case-insensitive >= 1.2 && < 1.3
, containers >= 0.5.7 && < 0.8 , containers >= 0.5.7 && < 0.8
, hasql-pool >= 1.0.1 && < 1.1 , hasql-pool >= 1.0.1 && <= 1.3.0.4
, hasql-transaction >= 1.0.1 && < 1.2 , hasql-transaction >= 1.0.1 && <= 1.2.1
, heredoc >= 0.2 && < 0.3 , heredoc >= 0.2 && < 0.3
, hspec >= 2.3 && < 2.12 , hspec >= 2.3 && < 2.12
, hspec-expectations >= 0.8.4 && < 0.9 , hspec-expectations >= 0.8.4 && < 0.9
@@ -314,8 +314,8 @@ test-suite observability
build-depends: base >= 4.9 && < 4.22 build-depends: base >= 4.9 && < 4.22
, base64-bytestring >= 1 && < 1.3 , base64-bytestring >= 1 && < 1.3
, bytestring >= 0.10.8 && < 0.13 , bytestring >= 0.10.8 && < 0.13
, hasql-pool >= 1.0.1 && < 1.1 , hasql-pool >= 1.0.1 && <= 1.3.0.4
, hasql-transaction >= 1.0.1 && < 1.2 , hasql-transaction >= 1.0.1 && <= 1.2.1
, hspec >= 2.3 && < 2.12 , hspec >= 2.3 && < 2.12
, hspec-expectations >= 0.8.4 && < 0.9 , hspec-expectations >= 0.8.4 && < 0.9
, hspec-wai >= 0.10 && < 0.12 , hspec-wai >= 0.10 && < 0.12
src/PostgREST/AppState.hs
+33 -27
View File
@@ -55,8 +55,8 @@ import Data.Time.Clock (UTCTime, getCurrentTime)
import PostgREST.Auth.JwtCache (JwtCacheState, update) import PostgREST.Auth.JwtCache (JwtCacheState, update)
import PostgREST.Config (AppConfig (..), import PostgREST.Config (AppConfig (..),
addFallbackAppName, readAppConfig,
readAppConfig) toConnectionSettings)
import PostgREST.Config.Database (queryDbSettings, import PostgREST.Config.Database (queryDbSettings,
queryPgVersion, queryPgVersion,
queryRoleSettings) queryRoleSettings)
@@ -143,34 +143,47 @@ destroy :: AppState -> IO ()
destroy = destroyPool destroy = destroyPool
initPool :: AppConfig -> ObservationHandler -> IO SQL.Pool initPool :: AppConfig -> ObservationHandler -> IO SQL.Pool
initPool AppConfig{..} observer = do initPool cfg@AppConfig{..} observer = do
SQL.acquire $ SQL.settings SQL.acquire $ SQL.settings
[ SQL.size configDbPoolSize [ SQL.size configDbPoolSize
, SQL.acquisitionTimeout $ fromIntegral configDbPoolAcquisitionTimeout , SQL.acquisitionTimeout $ fromIntegral configDbPoolAcquisitionTimeout
, SQL.agingTimeout $ fromIntegral configDbPoolMaxLifetime , SQL.agingTimeout $ fromIntegral configDbPoolMaxLifetime
, SQL.idlenessTimeout $ fromIntegral configDbPoolMaxIdletime , SQL.idlenessTimeout $ fromIntegral configDbPoolMaxIdletime
, SQL.staticConnectionSettings (toUtf8 $ addFallbackAppName prettyVersion configDbUri) , SQL.staticConnectionSettings $ toConnectionSettings identity cfg
, SQL.observationHandler $ observer . HasqlPoolObs , SQL.observationHandler $ observer . HasqlPoolObs
] ]
-- | Run an action with a database connection. -- | Run an action with a database connection.
usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a) usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a)
usePool AppState{stateObserver=observer, stateMainThreadId=mainThreadId, ..} sess = do usePool AppState{stateObserver=observer, stateMainThreadId=mainThreadId, ..} sess = do
observer PoolRequest observer PoolRequest
res <- SQL.use statePool sess res <- SQL.use statePool sess
observer PoolRequestFullfilled observer PoolRequestFullfilled
whenLeft res (\case whenLeft res (\case
SQL.AcquisitionTimeoutUsageError -> SQL.AcquisitionTimeoutUsageError ->
observer PoolAcqTimeoutObs observer PoolAcqTimeoutObs
err@(SQL.ConnectionUsageError e) -> err@(SQL.ConnectionUsageError e) ->
let failureMessage = BS.unpack $ fromMaybe mempty e in let failureMessage = BS.unpack $ fromMaybe mempty e in
when (("FATAL: password authentication failed" `isInfixOf` failureMessage) || ("no password supplied" `isInfixOf` failureMessage)) $ do when (("FATAL: password authentication failed" `isInfixOf` failureMessage) || ("no password supplied" `isInfixOf` failureMessage)) $ do
observer $ ExitDBFatalError ServerAuthError err observer $ ExitDBFatalError ServerAuthError err
killThread mainThreadId killThread mainThreadId
err@(SQL.SessionUsageError (SQL.QueryError tpl _ (SQL.ResultError resultErr))) -> do err@(SQL.SessionUsageError (SQL.QueryError tpl _ (SQL.ResultError resultErr))) ->
handleResultError err tpl resultErr
err@(SQL.SessionUsageError (SQL.PipelineError (SQL.ResultError resultErr))) ->
-- Passing the empty template will not work for schema cache queries, see TODO further below.
handleResultError err mempty resultErr
err@(SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) ->
-- An error on the client-side, usually indicates problems with connection
observer $ QueryErrorCodeHighObs err
SQL.SessionUsageError (SQL.PipelineError (SQL.ClientError _)) -> pure ()
)
return res
where
handleResultError err tpl resultErr = do
case resultErr of case resultErr of
SQL.UnexpectedResult{} -> do SQL.UnexpectedResult{} -> do
observer $ ExitDBFatalError ServerPgrstBug err observer $ ExitDBFatalError ServerPgrstBug err
@@ -203,12 +216,6 @@ usePool AppState{stateObserver=observer, stateMainThreadId=mainThreadId, ..} ses
SQL.ServerError{} -> SQL.ServerError{} ->
when (Error.status (Error.PgError False err) >= HTTP.status500) $ when (Error.status (Error.PgError False err) >= HTTP.status500) $
observer $ QueryErrorCodeHighObs err observer $ QueryErrorCodeHighObs err
err@(SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) ->
-- An error on the client-side, usually indicates problems with connection
observer $ QueryErrorCodeHighObs err
)
return res
-- | Flush the connection pool so that any future use of the pool will -- | Flush the connection pool so that any future use of the pool will
-- use connections freshly established after this call. -- use connections freshly established after this call.
@@ -308,7 +315,7 @@ retryingSchemaCacheLoad appState@AppState{stateObserver=observer, stateMainThrea
qPgVersion :: IO (Maybe PgVersion) qPgVersion :: IO (Maybe PgVersion)
qPgVersion = do qPgVersion = do
AppConfig{..} <- getConfig appState AppConfig{..} <- getConfig appState
pgVersion <- usePool appState (queryPgVersion False) -- No need to prepare the query here, as the connection might not be established pgVersion <- usePool appState queryPgVersion
case pgVersion of case pgVersion of
Left e -> do Left e -> do
observer $ QueryPgVersionError e observer $ QueryPgVersionError e
@@ -336,8 +343,7 @@ retryingSchemaCacheLoad appState@AppState{stateObserver=observer, stateMainThrea
qSchemaCache = do qSchemaCache = do
conf@AppConfig{..} <- getConfig appState conf@AppConfig{..} <- getConfig appState
(resultTime, result) <- (resultTime, result) <-
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in timeItT $ usePool appState (SQL.transaction SQL.ReadCommitted SQL.Read $ querySchemaCache conf)
timeItT $ usePool appState (transaction SQL.ReadCommitted SQL.Read $ querySchemaCache conf)
case result of case result of
Left e -> do Left e -> do
markSchemaCachePending appState markSchemaCachePending appState
@@ -393,7 +399,7 @@ readInDbConfig startingUp appState@AppState{stateObserver=observer} = do
pgVer <- getPgVersion appState pgVer <- getPgVersion appState
dbSettings <- dbSettings <-
if configDbConfig conf then do if configDbConfig conf then do
qDbSettings <- usePool appState (queryDbSettings (quoteQi <$> configDbPreConfig conf) (configDbPreparedStatements conf)) qDbSettings <- usePool appState (queryDbSettings (quoteQi <$> configDbPreConfig conf))
case qDbSettings of case qDbSettings of
Left e -> do Left e -> do
observer $ ConfigReadErrorObs e observer $ ConfigReadErrorObs e
@@ -403,7 +409,7 @@ readInDbConfig startingUp appState@AppState{stateObserver=observer} = do
pure mempty pure mempty
(roleSettings, roleIsolationLvl) <- (roleSettings, roleIsolationLvl) <-
if configDbConfig conf then do if configDbConfig conf then do
rSettings <- usePool appState (queryRoleSettings pgVer (configDbPreparedStatements conf)) rSettings <- usePool appState (queryRoleSettings pgVer)
case rSettings of case rSettings of
Left e -> do Left e -> do
observer $ QueryRoleSettingsErrorObs e observer $ QueryRoleSettingsErrorObs e
src/PostgREST/CLI.hs
+1 -3
View File
@@ -62,9 +62,7 @@ dumpSchema :: AppState -> IO LBS.ByteString
dumpSchema appState = do dumpSchema appState = do
conf@AppConfig{..} <- AppState.getConfig appState conf@AppConfig{..} <- AppState.getConfig appState
result <- result <-
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in AppState.usePool appState (SQL.transaction SQL.ReadCommitted SQL.Read $ querySchemaCache conf)
AppState.usePool appState
(transaction SQL.ReadCommitted SQL.Read $ querySchemaCache conf)
case result of case result of
Left e -> do Left e -> do
let observer = AppState.getObserver appState let observer = AppState.getObserver appState
src/PostgREST/Config.hs
+23 -12
View File
@@ -9,6 +9,7 @@ Description : Manages PostgREST configuration type and parser.
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}
{-# LANGUAGE NamedFieldPuns #-}
module PostgREST.Config module PostgREST.Config
( AppConfig (..) ( AppConfig (..)
@@ -27,22 +28,25 @@ module PostgREST.Config
, parseSecret , parseSecret
, addFallbackAppName , addFallbackAppName
, addTargetSessionAttrs , addTargetSessionAttrs
, toConnectionSettings
, exampleConfigFile , exampleConfigFile
, audMatchesCfg , audMatchesCfg
, Verbosity (..) , Verbosity (..)
) where ) where
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Base64 as B64
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import qualified Data.Configurator as C import qualified Data.Configurator as C
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.String as S import qualified Data.String as S
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding as T
import qualified Jose.Jwa as JWT import qualified Hasql.Connection.Setting as SQL
import qualified Jose.Jwk as JWT import qualified Hasql.Connection.Setting.Connection as SQL
import qualified Jose.Jwa as JWT
import qualified Jose.Jwk as JWT
import Control.Monad (fail) import Control.Monad (fail)
import Data.Either.Combinators (mapLeft) import Data.Either.Combinators (mapLeft)
@@ -67,7 +71,8 @@ import PostgREST.Config.Proxy (Proxy (..),
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
toQi) toQi)
import Protolude hiding (Proxy, toList) import PostgREST.Version (prettyVersion)
import Protolude hiding (Proxy, toList)
audMatchesCfg :: AppConfig -> Text -> Bool audMatchesCfg :: AppConfig -> Text -> Bool
audMatchesCfg = maybe (const True) (==) . configJwtAudience audMatchesCfg = maybe (const True) (==) . configJwtAudience
@@ -646,6 +651,12 @@ addFallbackAppName version dbUri = addConnStringOption dbUri "fallback_applicati
addTargetSessionAttrs :: Text -> Text addTargetSessionAttrs :: Text -> Text
addTargetSessionAttrs dbUri = addConnStringOption dbUri "target_session_attrs" "read-write" addTargetSessionAttrs dbUri = addConnStringOption dbUri "target_session_attrs" "read-write"
toConnectionSettings :: (Text -> Text) -> AppConfig -> [SQL.Setting]
toConnectionSettings transformUri AppConfig{configDbUri, configDbPreparedStatements} =
[ SQL.connection $ SQL.string $ transformUri . addFallbackAppName prettyVersion $ configDbUri
, SQL.usePreparedStatements configDbPreparedStatements
]
addConnStringOption :: Text -> Text -> Text -> Text addConnStringOption :: Text -> Text -> Text -> Text
addConnStringOption dbUri key val = dbUri <> addConnStringOption dbUri key val = dbUri <>
case pgConnString dbUri of case pgConnString dbUri of
src/PostgREST/Config/Database.hs
+8 -10
View File
@@ -72,8 +72,8 @@ dbSettingsNames =
,"server_timing_enabled" ,"server_timing_enabled"
] ]
queryPgVersion :: Bool -> Session PgVersion queryPgVersion :: Session PgVersion
queryPgVersion prepared = statement mempty $ pgVersionStatement prepared queryPgVersion = statement mempty $ pgVersionStatement False
pgVersionStatement :: Bool -> SQL.Statement () PgVersion pgVersionStatement :: Bool -> SQL.Statement () PgVersion
pgVersionStatement = SQL.Statement sql HE.noParams versionRow pgVersionStatement = SQL.Statement sql HE.noParams versionRow
@@ -92,10 +92,9 @@ pgVersionStatement = SQL.Statement sql HE.noParams versionRow
-- --
-- The example above will result in <prefix>jwt_aud = 'val' -- The example above will result in <prefix>jwt_aud = 'val'
-- A setting on the database only will have no effect: ALTER DATABASE postgres SET <prefix>jwt_aud = 'xx' -- A setting on the database only will have no effect: ALTER DATABASE postgres SET <prefix>jwt_aud = 'xx'
queryDbSettings :: Maybe Text -> Bool -> Session [(Text, Text)] queryDbSettings :: Maybe Text -> Session [(Text, Text)]
queryDbSettings preConfFunc prepared = queryDbSettings preConfFunc =
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in SQL.transaction SQL.ReadCommitted SQL.Read $ SQL.statement dbSettingsNames $ SQL.Statement sql (arrayParam HE.text) decodeSettings True
transaction SQL.ReadCommitted SQL.Read $ SQL.statement dbSettingsNames $ SQL.Statement sql (arrayParam HE.text) decodeSettings prepared
where where
sql = encodeUtf8 [trimming| sql = encodeUtf8 [trimming|
WITH WITH
@@ -133,10 +132,9 @@ queryDbSettings preConfFunc prepared =
|]::Text |]::Text
decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text
queryRoleSettings :: PgVersion -> Bool -> Session (RoleSettings, RoleIsolationLvl) queryRoleSettings :: PgVersion -> Session (RoleSettings, RoleIsolationLvl)
queryRoleSettings pgVer prepared = queryRoleSettings pgVer =
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in SQL.transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ SQL.Statement sql HE.noParams (processRows <$> rows) True
transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ SQL.Statement sql HE.noParams (processRows <$> rows) prepared
where where
sql = encodeUtf8 [trimming| sql = encodeUtf8 [trimming|
with with
src/PostgREST/Error.hs
+10 -1
View File
@@ -471,18 +471,22 @@ instance ErrorBody PgError where
instance ErrorBody SQL.UsageError where instance ErrorBody SQL.UsageError where
code (SQL.ConnectionUsageError _) = "PGRST000" code (SQL.ConnectionUsageError _) = "PGRST000"
code (SQL.SessionUsageError (SQL.PipelineError e)) = code e
code (SQL.SessionUsageError (SQL.QueryError _ _ e)) = code e code (SQL.SessionUsageError (SQL.QueryError _ _ e)) = code e
code SQL.AcquisitionTimeoutUsageError = "PGRST003" code SQL.AcquisitionTimeoutUsageError = "PGRST003"
message (SQL.ConnectionUsageError _) = "Database connection error. Retrying the connection." message (SQL.ConnectionUsageError _) = "Database connection error. Retrying the connection."
message (SQL.SessionUsageError (SQL.PipelineError e)) = message e
message (SQL.SessionUsageError (SQL.QueryError _ _ e)) = message e message (SQL.SessionUsageError (SQL.QueryError _ _ e)) = message e
message SQL.AcquisitionTimeoutUsageError = "Timed out acquiring connection from connection pool." message SQL.AcquisitionTimeoutUsageError = "Timed out acquiring connection from connection pool."
details (SQL.ConnectionUsageError e) = JSON.String . T.decodeUtf8 <$> e details (SQL.ConnectionUsageError e) = JSON.String . T.decodeUtf8 <$> e
details (SQL.SessionUsageError (SQL.PipelineError e)) = details e
details (SQL.SessionUsageError (SQL.QueryError _ _ e)) = details e details (SQL.SessionUsageError (SQL.QueryError _ _ e)) = details e
details SQL.AcquisitionTimeoutUsageError = Nothing details SQL.AcquisitionTimeoutUsageError = Nothing
hint (SQL.ConnectionUsageError _) = Nothing hint (SQL.ConnectionUsageError _) = Nothing
hint (SQL.SessionUsageError (SQL.PipelineError e)) = hint e
hint (SQL.SessionUsageError (SQL.QueryError _ _ e)) = hint e hint (SQL.SessionUsageError (SQL.QueryError _ _ e)) = hint e
hint SQL.AcquisitionTimeoutUsageError = Nothing hint SQL.AcquisitionTimeoutUsageError = Nothing
@@ -527,8 +531,13 @@ instance ErrorBody SQL.CommandError where
pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status
pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503 pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503
pgErrorStatus _ SQL.AcquisitionTimeoutUsageError = HTTP.status504 pgErrorStatus _ SQL.AcquisitionTimeoutUsageError = HTTP.status504
pgErrorStatus _ (SQL.SessionUsageError (SQL.PipelineError (SQL.ClientError _))) = HTTP.status503
pgErrorStatus _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503 pgErrorStatus _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503
pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) = pgErrorStatus authed (SQL.SessionUsageError (SQL.PipelineError (SQL.ResultError rError))) = mapSQLtoHTTP authed rError
pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) = mapSQLtoHTTP authed rError
mapSQLtoHTTP :: Bool -> SQL.ResultError -> HTTP.Status
mapSQLtoHTTP authed rError =
case rError of case rError of
(SQL.ServerError c m d _ _) -> (SQL.ServerError c m d _ _) ->
case BS.unpack c of case BS.unpack c of
src/PostgREST/Listener.hs
+4 -4
View File
@@ -11,7 +11,6 @@ import qualified Hasql.Notifications as SQL
import PostgREST.AppState (AppState, getConfig) import PostgREST.AppState (AppState, getConfig)
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.Observation (Observation (..)) import PostgREST.Observation (Observation (..))
import PostgREST.Version (prettyVersion)
import qualified PostgREST.AppState as AppState import qualified PostgREST.AppState as AppState
import qualified PostgREST.Config as Config import qualified PostgREST.Config as Config
@@ -37,7 +36,7 @@ runListener appState = do
-- | This function never returns (but can throw) and return type enforces that. -- | This function never returns (but can throw) and return type enforces that.
retryingListen :: AppState -> IO Void retryingListen :: AppState -> IO Void
retryingListen appState = do retryingListen appState = do
AppConfig{..} <- AppState.getConfig appState cfg@AppConfig{..} <- AppState.getConfig appState
let let
dbChannel = toS configDbChannel dbChannel = toS configDbChannel
onError err = do onError err = do
@@ -62,7 +61,8 @@ retryingListen appState = do
-- Make sure we don't leak connections on errors -- Make sure we don't leak connections on errors
bracket bracket
-- acquire connection -- acquire connection
(SQL.acquire $ toUtf8 (Config.addTargetSessionAttrs $ Config.addFallbackAppName prettyVersion configDbUri)) (SQL.acquire $
Config.toConnectionSettings Config.addTargetSessionAttrs cfg)
-- release connection -- release connection
(`whenRight` releaseConnection) $ (`whenRight` releaseConnection) $
-- use connection -- use connection
@@ -70,7 +70,7 @@ retryingListen appState = do
Right db -> do Right db -> do
SQL.listen db $ SQL.toPgIdentifier dbChannel SQL.listen db $ SQL.toPgIdentifier dbChannel
(pqHost, pqPort) <- SQL.withLibPQConnection db $ bisequence . (LibPQ.host &&& LibPQ.port) (pqHost, pqPort) <- SQL.withLibPQConnection db $ bisequence . (LibPQ.host &&& LibPQ.port)
pgFullName <- SQL.run (queryPgVersion False) db >>= either throwIO (pure . pgvFullName) pgFullName <- SQL.run queryPgVersion db >>= either throwIO (pure . pgvFullName)
AppState.putIsListenerOn appState True AppState.putIsListenerOn appState True
src/PostgREST/Logger.hs
+6 -3
View File
@@ -133,9 +133,8 @@ logWithZTime loggerState txts = do
-- the SQL.Snippet or maybe don't use hasql-dynamic-statements and resort to plain strings for the queries and use regular hasql -- the SQL.Snippet or maybe don't use hasql-dynamic-statements and resort to plain strings for the queries and use regular hasql
renderSnippet :: SQL.Snippet -> ByteString renderSnippet :: SQL.Snippet -> ByteString
renderSnippet snippet = renderSnippet snippet =
let SQL.Statement sql _ _ _ = SQL.dynamicallyParameterized snippet decoder prepared let SQL.Statement sql _ _ _ = SQL.dynamicallyParameterized snippet decoder False
decoder = HD.noResult -- unused decoder = HD.noResult -- unused
prepared = False -- unused
in in
sql sql
@@ -218,13 +217,17 @@ observationMessages = \case
pure $ "Connection " <> show uuid <> ( pure $ "Connection " <> show uuid <> (
case status of case status of
SQL.ConnectingConnectionStatus -> " is being established" SQL.ConnectingConnectionStatus -> " is being established"
SQL.ReadyForUseConnectionStatus -> " is available" SQL.ReadyForUseConnectionStatus reason -> " is available due to " <> case reason of
SQL.EstablishedConnectionReadyForUseReason -> "connection establishment"
SQL.SessionFailedConnectionReadyForUseReason _ -> "session failure"
SQL.SessionSucceededConnectionReadyForUseReason -> "session success"
SQL.InUseConnectionStatus -> " is used" SQL.InUseConnectionStatus -> " is used"
SQL.TerminatedConnectionStatus reason -> " is terminated due to " <> case reason of SQL.TerminatedConnectionStatus reason -> " is terminated due to " <> case reason of
SQL.AgingConnectionTerminationReason -> "max lifetime" SQL.AgingConnectionTerminationReason -> "max lifetime"
SQL.IdlenessConnectionTerminationReason -> "max idletime" SQL.IdlenessConnectionTerminationReason -> "max idletime"
SQL.ReleaseConnectionTerminationReason -> "release" SQL.ReleaseConnectionTerminationReason -> "release"
SQL.NetworkErrorConnectionTerminationReason _ -> "network error" -- usage error is already logged, no need to repeat the same message. SQL.NetworkErrorConnectionTerminationReason _ -> "network error" -- usage error is already logged, no need to repeat the same message.
SQL.InitializationErrorTerminationReason _ -> "init failure"
) )
PoolRequest -> PoolRequest ->
pure "Trying to borrow a connection from pool" pure "Trying to borrow a connection from pool"
src/PostgREST/MainTx.hs
+1 -2
View File
@@ -96,9 +96,8 @@ data ResultSet
mainTx :: MainQuery -> AppConfig -> AuthResult -> ApiRequest -> ActionPlan -> SchemaCache -> MainTx mainTx :: MainQuery -> AppConfig -> AuthResult -> ApiRequest -> ActionPlan -> SchemaCache -> MainTx
mainTx _ _ _ _ (NoDb x) _ = NoDbTx $ NoDbResult x mainTx _ _ _ _ (NoDb x) _ = NoDbTx $ NoDbResult x
mainTx genQ@MainQuery{..} conf@AppConfig{..} AuthResult{..} apiReq (Db plan) sCache = mainTx genQ@MainQuery{..} conf@AppConfig{..} AuthResult{..} apiReq (Db plan) sCache =
DbTx isoLvl txMode dbHandler transaction DbTx isoLvl txMode dbHandler SQL.transaction
where where
transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction
isoLvl = planIsoLvl conf authRole plan isoLvl = planIsoLvl conf authRole plan
txMode = planTxMode plan txMode = planTxMode plan
dbHandler = do dbHandler = do
src/PostgREST/Metrics.hs
+1 -1
View File
@@ -53,7 +53,7 @@ observationMetrics MetricsState{..} obs = case obs of
PoolAcqTimeoutObs -> do PoolAcqTimeoutObs -> do
incCounter poolTimeouts incCounter poolTimeouts
(HasqlPoolObs (SQL.ConnectionObservation _ status)) -> case status of (HasqlPoolObs (SQL.ConnectionObservation _ status)) -> case status of
SQL.ReadyForUseConnectionStatus -> do SQL.ReadyForUseConnectionStatus _ -> do
incGauge poolAvailable incGauge poolAvailable
SQL.InUseConnectionStatus -> do SQL.InUseConnectionStatus -> do
decGauge poolAvailable decGauge poolAvailable
src/PostgREST/SchemaCache.hs
+28 -29
View File
@@ -158,23 +158,23 @@ maxDbTablesForFuzzySearch = 500
querySchemaCache :: AppConfig -> SQL.Transaction SchemaCache querySchemaCache :: AppConfig -> SQL.Transaction SchemaCache
querySchemaCache conf@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 <- sqlTimedStmt gucTbls conf $ allTables prepared tabs <- sqlTimedStmt gucTbls conf allTables
keyDeps <- sqlTimedStmt gucKDeps conf $ allViewsKeyDependencies prepared keyDeps <- sqlTimedStmt gucKDeps conf allViewsKeyDependencies
m2oRels <- sqlTimedStmt gucRels mempty $ allM2OandO2ORels prepared m2oRels <- sqlTimedStmt gucRels mempty allM2OandO2ORels
funcs <- sqlTimedStmt gucFuncs conf $ allFunctions prepared funcs <- sqlTimedStmt gucFuncs conf allFunctions
cRels <- sqlTimedStmt gucCRels mempty $ allComputedRels prepared cRels <- sqlTimedStmt gucCRels mempty allComputedRels
reps <- sqlTimedStmt gucDReps conf $ dataRepresentations prepared reps <- sqlTimedStmt gucDReps conf dataRepresentations
mHdlers <- sqlTimedStmt gucMHdrs conf $ mediaHandlers prepared mHdlers <- sqlTimedStmt gucMHdrs conf mediaHandlers
tzones <- if configDbTimezoneEnabled tzones <- if configDbTimezoneEnabled
then sqlTimedStmt gucTzones mempty $ timezones prepared then sqlTimedStmt gucTzones mempty timezones
else pure S.empty else pure S.empty
_ <- _ <-
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 True in
for_ configInternalSCQuerySleep (`SQL.statement` sleepCall) -- only used for testing for_ configInternalSCQuerySleep (`SQL.statement` sleepCall) -- only used for testing
qsTime <- qsTime <-
if isLogDebug if isLogDebug
then Just <$> SQL.statement mempty (extractTimings configDbTimezoneEnabled prepared) then Just <$> SQL.statement mempty (extractTimings configDbTimezoneEnabled)
else pure Nothing else pure Nothing
let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps
@@ -198,7 +198,6 @@ querySchemaCache conf@AppConfig{..} = do
} }
where where
schemas = toList configDbSchemas schemas = toList configDbSchemas
prepared = configDbPreparedStatements
delayEval confDelay result = maybe result (unsafePerformIO . (($> result) . (threadDelay . (1000 *) . fromIntegral))) confDelay delayEval confDelay result = maybe result (unsafePerformIO . (($> result) . (threadDelay . (1000 *) . fromIntegral))) confDelay
isLogDebug = configLogLevel == LogDebug isLogDebug = configLogLevel == LogDebug
sqlTimedStmt = sqlTimedStatement isLogDebug sqlTimedStmt = sqlTimedStatement isLogDebug
@@ -364,8 +363,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 AppConfig RepresentationsMap dataRepresentations :: SQL.Statement AppConfig RepresentationsMap
dataRepresentations = SQL.Statement sql mempty decodeRepresentations dataRepresentations = SQL.Statement sql mempty decodeRepresentations True
where where
sql = encodeUtf8 [trimming| sql = encodeUtf8 [trimming|
SELECT SELECT
@@ -386,8 +385,8 @@ dataRepresentations = SQL.Statement sql mempty decodeRepresentations
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 AppConfig RoutineMap allFunctions :: SQL.Statement AppConfig RoutineMap
allFunctions = SQL.Statement funcsSqlQuery params decodeFuncs allFunctions = SQL.Statement funcsSqlQuery params decodeFuncs True
where where
params = params =
(map escapeIdent . toList . configDbSchemas >$< arrayParam HE.text) <> (map escapeIdent . toList . configDbSchemas >$< arrayParam HE.text) <>
@@ -599,8 +598,8 @@ addViewPrimaryKeys tabs keyDeps =
takeFirstPK = mapMaybe (head . snd) takeFirstPK = mapMaybe (head . snd)
indexedDeps = HM.fromListWith (++) $ fmap ((keyDepType &&& keyDepView) &&& pure) keyDeps indexedDeps = HM.fromListWith (++) $ fmap ((keyDepType &&& keyDepView) &&& pure) keyDeps
allTables :: Bool -> SQL.Statement AppConfig TablesMap allTables :: SQL.Statement AppConfig TablesMap
allTables = SQL.Statement tablesSqlQuery params decodeTables allTables = SQL.Statement tablesSqlQuery params decodeTables True
where where
params = map escapeIdent . toList . configDbSchemas >$< arrayParam HE.text params = map escapeIdent . toList . configDbSchemas >$< arrayParam HE.text
@@ -747,9 +746,9 @@ tablesSqlQuery =
ORDER BY table_schema, table_name|] ORDER BY table_schema, table_name|]
-- | Gets many-to-one relationships and one-to-one(O2O) relationships, which are a refinement of the many-to-one's -- | Gets many-to-one relationships and one-to-one(O2O) relationships, which are a refinement of the many-to-one's
allM2OandO2ORels :: Bool -> SQL.Statement () [Relationship] allM2OandO2ORels :: SQL.Statement () [Relationship]
allM2OandO2ORels = allM2OandO2ORels =
SQL.Statement sql HE.noParams decodeRels SQL.Statement sql HE.noParams decodeRels True
where where
-- We use jsonb_agg for comparing the uniques/pks instead of array_agg to avoid the ERROR: cannot accumulate arrays of different dimensionality -- We use jsonb_agg for comparing the uniques/pks instead of array_agg to avoid the ERROR: cannot accumulate arrays of different dimensionality
sql = encodeUtf8 [trimming| sql = encodeUtf8 [trimming|
@@ -791,9 +790,9 @@ allM2OandO2ORels =
AND traint.conparentid = 0 AND traint.conparentid = 0
ORDER BY traint.conrelid, traint.conname|] ORDER BY traint.conrelid, traint.conname|]
allComputedRels :: Bool -> SQL.Statement () [Relationship] allComputedRels :: SQL.Statement () [Relationship]
allComputedRels = allComputedRels =
SQL.Statement sql HE.noParams (HD.rowList cRelRow) SQL.Statement sql HE.noParams (HD.rowList cRelRow) True
where where
sql = encodeUtf8 [trimming| sql = encodeUtf8 [trimming|
with with
@@ -837,9 +836,9 @@ 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 AppConfig [ViewKeyDependency] allViewsKeyDependencies :: SQL.Statement AppConfig [ViewKeyDependency]
allViewsKeyDependencies = allViewsKeyDependencies =
SQL.Statement sql params decodeViewKeyDeps SQL.Statement sql params decodeViewKeyDeps True
-- 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
@@ -1047,9 +1046,9 @@ 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 AppConfig MediaHandlerMap mediaHandlers :: SQL.Statement AppConfig MediaHandlerMap
mediaHandlers = mediaHandlers =
SQL.Statement sql params decodeMediaHandlers SQL.Statement sql params decodeMediaHandlers True
where where
params = map escapeIdent . toList . configDbSchemas >$< arrayParam HE.text params = map escapeIdent . toList . configDbSchemas >$< arrayParam HE.text
sql = encodeUtf8 [trimming| sql = encodeUtf8 [trimming|
@@ -1123,8 +1122,8 @@ decodeMediaHandlers =
<*> (MediaType.decodeMediaType . encodeUtf8 <$> column HD.text) <*> (MediaType.decodeMediaType . encodeUtf8 <$> column HD.text)
<*> (MediaType.decodeMediaType . encodeUtf8 <$> column HD.text) <*> (MediaType.decodeMediaType . encodeUtf8 <$> column HD.text)
timezones :: Bool -> SQL.Statement () TimezoneNames timezones :: SQL.Statement () TimezoneNames
timezones = SQL.Statement sql HE.noParams decodeTimezones timezones = SQL.Statement sql HE.noParams decodeTimezones True
where where
sql = encodeUtf8 $ unlines sql = encodeUtf8 $ unlines
-- This CTE wrapper is only added for clarifying the query under pg_stat_statements -- This CTE wrapper is only added for clarifying the query under pg_stat_statements
@@ -1183,8 +1182,8 @@ sqlTimedStatement isLogDebug guc params stmt =
eFrag = "select set_config('pgrst." <> guc <> "', (clock_timestamp() - current_setting('pgrst." <> guc <> "', false)::timestamptz)::text, true)" eFrag = "select set_config('pgrst." <> guc <> "', (clock_timestamp() - current_setting('pgrst." <> guc <> "', false)::timestamptz)::text, true)"
-- Extract all the generated timings (see sqlTimedStatement) converting the value to milliseconds. -- Extract all the generated timings (see sqlTimedStatement) converting the value to milliseconds.
extractTimings :: Bool -> Bool -> SQL.Statement () QueryTimings extractTimings :: Bool -> SQL.Statement () QueryTimings
extractTimings hasTimezones = SQL.Statement sql HE.noParams decodeThem extractTimings hasTimezones = SQL.Statement sql HE.noParams decodeThem True
where where
qFrag setting = "extract('milliseconds' from current_setting('pgrst." <> setting <> "', false)::interval)::text" qFrag setting = "extract('milliseconds' from current_setting('pgrst." <> setting <> "', false)::interval)::text"
sql = "SELECT " <> BS.intercalate "," sql = "SELECT " <> BS.intercalate ","
src/PostgREST/Version.hs
+6
View File
@@ -8,6 +8,12 @@ import qualified Data.Text as T
import Protolude import Protolude
-- Somehow this is not defined in doctests, so when running them
-- on a file that includes Version.hs, compilation fails.
#ifndef VERSION_postgrest
#define VERSION_postgrest "0"
#endif
version :: [Text] version :: [Text]
version = T.splitOn "." VERSION_postgrest version = T.splitOn "." VERSION_postgrest
stack.yaml
+1 -9
View File
@@ -10,17 +10,9 @@ nix:
extra-deps: extra-deps:
- configurator-pg-0.2.11 - configurator-pg-0.2.11
- fuzzyset-0.2.4 - fuzzyset-0.2.4
- hasql-1.6.4.4 - hasql-notifications-0.2.4.0
- hasql-dynamic-statements-0.3.1.5
- hasql-implicits-0.1.1.3
- hasql-notifications-0.2.2.2
- hasql-pool-1.0.1
- hasql-transaction-1.1.0.1
- http-semantics-0.4.0 - http-semantics-0.4.0
- http2-5.4.0 - http2-5.4.0
- postgresql-binary-0.13.1.3
- text-builder-0.6.10
- text-builder-dev-0.3.10
- warp-3.4.13 - warp-3.4.13
allow-newer: true allow-newer: true
stack.yaml.lock
+7 -56
View File
@@ -19,47 +19,12 @@ packages:
original: original:
hackage: fuzzyset-0.2.4 hackage: fuzzyset-0.2.4
- completed: - completed:
hackage: hasql-1.6.4.4@sha256:a26b346aaf33b903f011f8c47a1a1230ea2b0aa1d8325aaf779da425d6c076c5,4391 hackage: hasql-notifications-0.2.4.0@sha256:8e7a0076519a02dbcaa2b914fab37d3c0d6a44b9620fc0e16bc49f6e6eef2810,1998
pantry-tree: pantry-tree:
sha256: 120edb520584aa107998b49a7809fa70a1ad4648a9cae26d3b031cfe15bce18e sha256: 65a1d22d3fcf908824f312e98549b6f3cae91e1aaea67db16f5c51a9b5e7ec31
size: 2607
original:
hackage: hasql-1.6.4.4
- completed:
hackage: hasql-dynamic-statements-0.3.1.5@sha256:2455a5fdd8cc6458a6fa66cbca8a01d25011e16c405e36b0c6d75fc39b15477f,2961
pantry-tree:
sha256: f4fe881d367499a03290028180fdcb76be050807d1e13effeec6c78ab23b481a
size: 595
original:
hackage: hasql-dynamic-statements-0.3.1.5
- completed:
hackage: hasql-implicits-0.1.1.3@sha256:7a46264113765b0080de33560b22e13d4dfe811ce20e9e805fe600f30a0d418a,1334
pantry-tree:
sha256: 51278386de1d497546c1b1baabefaf16a63c30cb00dd8f1e8a9dc74291db9aac
size: 264
original:
hackage: hasql-implicits-0.1.1.3
- completed:
hackage: hasql-notifications-0.2.2.2@sha256:d1d6bc0d3ee5e418fc12ea023b78739e0decba6c34e2b43bec55b89e18bd4412,2025
pantry-tree:
sha256: 83a9cbb179b1efd0b2acd6509583c7afcdbe63469ab033d8581d48d675a80b44
size: 452 size: 452
original: original:
hackage: hasql-notifications-0.2.2.2 hackage: hasql-notifications-0.2.4.0
- completed:
hackage: hasql-pool-1.0.1@sha256:3cfb4c7153a6c536ac7e126c17723e6d26ee03794954deed2d72bcc826d05a40,2302
pantry-tree:
sha256: d98e1269bdd60989b0eb0b84e1d5357eaa9f92821439d9f206663b7251ee95b2
size: 799
original:
hackage: hasql-pool-1.0.1
- completed:
hackage: hasql-transaction-1.1.0.1@sha256:ca451ad29d2195d9e59e9118ab1b210887fea15383fa175895bba711e92b1d00,3302
pantry-tree:
sha256: b0435127264b8f40c11e0474d7c208f40278acd470fa2368ba2c6cda3a4f7ced
size: 1027
original:
hackage: hasql-transaction-1.1.0.1
- completed: - completed:
hackage: http-semantics-0.4.0@sha256:da8a98d542b2032cc12590847179577b0208a52bb3b9aa9a07c08d27d2a1714c,1513 hackage: http-semantics-0.4.0@sha256:da8a98d542b2032cc12590847179577b0208a52bb3b9aa9a07c08d27d2a1714c,1513
pantry-tree: pantry-tree:
@@ -75,26 +40,12 @@ packages:
original: original:
hackage: http2-5.4.0 hackage: http2-5.4.0
- completed: - completed:
hackage: postgresql-binary-0.13.1.3@sha256:4de5ddc90d9d3e586c3edf2860280a0915a484e9b8de3f36316a4cab2b330852,4037 hackage: warp-3.4.13@sha256:ccd1fb8765166ca31928635fffdab85569b7a0f2a81cc11c9a5b91eab663eda6,10066
pantry-tree: pantry-tree:
sha256: a5e9a06511b2a6a5be2388a4874d3c62babcfe1165b876e425bcc819b0474cde sha256: dfe50280b7d9549f7eebedc35f62d633ecb185ba0d9686146bb39074c3055df5
size: 1661 size: 4175
original: original:
hackage: postgresql-binary-0.13.1.3 hackage: warp-3.4.13
- completed:
hackage: text-builder-0.6.10@sha256:24e403038fb6b885c8a0f310e782d40ca80eb1b5359b90fbe74db98b84e1094b,2348
pantry-tree:
sha256: 18cea18e1e6bfba7fe6ff36926bafa6963ef2ba3f20dcfe3f25e9afef5ca8bf8
size: 515
original:
hackage: text-builder-0.6.10
- completed:
hackage: text-builder-dev-0.3.10@sha256:eb86d38ad19eb27ea5db1a9652330d6b0511bccc10a9fac43fedf8e65ba8b7f5,2973
pantry-tree:
sha256: 136ef4106267630f4b43d6b35076e15a16c6c8d1790fa45cca20a2def4d6b404
size: 736
original:
hackage: text-builder-dev-0.3.10
snapshots: snapshots:
- completed: - completed:
sha256: 655e468f774beee1badf07dc4c45fb50288d5c66ce7bef6f487b7f92891a90b0 sha256: 655e468f774beee1badf07dc4c45fb50288d5c66ce7bef6f487b7f92891a90b0
test/observability/Main.hs
+4 -3
View File
@@ -8,7 +8,8 @@ import Data.Function (id)
import PostgREST.App (postgrest) import PostgREST.App (postgrest)
import qualified PostgREST.AppState as AppState import qualified PostgREST.AppState as AppState
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..),
toConnectionSettings)
import PostgREST.Config.Database (queryPgVersion) import PostgREST.Config.Database (queryPgVersion)
import qualified PostgREST.Logger as Logger import qualified PostgREST.Logger as Logger
import qualified PostgREST.Metrics as Metrics import qualified PostgREST.Metrics as Metrics
@@ -38,12 +39,12 @@ main = do
, P.acquisitionTimeout 10 , P.acquisitionTimeout 10
, P.agingTimeout 60 , P.agingTimeout 60
, P.idlenessTimeout 60 , P.idlenessTimeout 60
, P.staticConnectionSettings (toUtf8 $ configDbUri testCfg) , P.staticConnectionSettings $ toConnectionSettings identity testCfg
-- make sure metrics are updated and pool observations published to poolChan -- make sure metrics are updated and pool observations published to poolChan
, P.observationHandler $ (writeChan poolChan <> Metrics.observationMetrics metricsState) . HasqlPoolObs , P.observationHandler $ (writeChan poolChan <> Metrics.observationMetrics metricsState) . HasqlPoolObs
] ]
actualPgVersion <- either (panic . show) id <$> P.use pool (queryPgVersion False) actualPgVersion <- either (panic . show) id <$> P.use pool queryPgVersion
-- cached schema cache so most tests run fast -- cached schema cache so most tests run fast
baseSchemaCache <- loadSCache pool testCfg baseSchemaCache <- loadSCache pool testCfg
test/spec/Main.hs
+4 -3
View File
@@ -9,7 +9,8 @@ import Data.Function (id)
import Test.Hspec import Test.Hspec
import PostgREST.App (postgrest) import PostgREST.App (postgrest)
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..),
toConnectionSettings)
import PostgREST.Config.Database (queryPgVersion) import PostgREST.Config.Database (queryPgVersion)
import PostgREST.SchemaCache (querySchemaCache) import PostgREST.SchemaCache (querySchemaCache)
import Protolude hiding (toList, toS) import Protolude hiding (toList, toS)
@@ -78,10 +79,10 @@ main = do
, P.acquisitionTimeout 10 , P.acquisitionTimeout 10
, P.agingTimeout 60 , P.agingTimeout 60
, P.idlenessTimeout 60 , P.idlenessTimeout 60
, P.staticConnectionSettings (toUtf8 $ configDbUri testCfg) , P.staticConnectionSettings $ toConnectionSettings identity testCfg
] ]
actualPgVersion <- either (panic . show) id <$> P.use pool (queryPgVersion False) actualPgVersion <- either (panic . show) id <$> P.use pool queryPgVersion
-- cached schema cache so most tests run fast -- cached schema cache so most tests run fast
baseSchemaCache <- loadSCache pool testCfg baseSchemaCache <- loadSCache pool testCfg