diff --git a/src/PostgREST/Admin.hs b/src/PostgREST/Admin.hs index f991e16fb..3183c28c3 100644 --- a/src/PostgREST/Admin.hs +++ b/src/PostgREST/Admin.hs @@ -11,7 +11,6 @@ import Network.Socket.ByteString import qualified Network.HTTP.Types.Status as HTTP import qualified Network.Wai as Wai -import qualified Hasql.Pool as SQL import qualified Hasql.Session as SQL import qualified PostgREST.AppState as AppState @@ -27,7 +26,7 @@ postgrestAdmin appState appConfig req respond = do isConnectionUp <- if configDbChannelEnabled appConfig then AppState.getIsListenerOn appState - else isRight <$> SQL.use (AppState.getPool appState) (SQL.sql "SELECT 1") + else isRight <$> AppState.usePool appState (SQL.sql "SELECT 1") case Wai.pathInfo req of ["ready"] -> diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index b451312ac..cca6f526f 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -24,10 +24,12 @@ module PostgREST.AppState , putRetryNextIn , releasePool , signalListener + , usePool , waitListener ) where -import qualified Hasql.Pool as SQL +import qualified Hasql.Pool as SQL +import qualified Hasql.Session as SQL import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction) @@ -96,6 +98,9 @@ initPool AppConfig{..} = getPool :: AppState -> SQL.Pool getPool = statePool +usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a) +usePool AppState{..} = SQL.use statePool + releasePool :: AppState -> IO () releasePool AppState{..} = SQL.release statePool diff --git a/src/PostgREST/CLI.hs b/src/PostgREST/CLI.hs index 95ae52231..cd21c349e 100644 --- a/src/PostgREST/CLI.hs +++ b/src/PostgREST/CLI.hs @@ -11,7 +11,6 @@ module PostgREST.CLI import qualified Data.Aeson as JSON import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as LBS -import qualified Hasql.Pool as SQL import qualified Hasql.Transaction.Sessions as SQL import qualified Options.Applicative as O @@ -49,7 +48,7 @@ dumpSchema appState = do AppConfig{..} <- AppState.getConfig appState result <- let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in - SQL.use (AppState.getPool appState) $ + AppState.usePool appState $ transaction SQL.ReadCommitted SQL.Read $ queryDbStructure (toList configDbSchemas) diff --git a/src/PostgREST/Workers.hs b/src/PostgREST/Workers.hs index 2de3591dd..3097b2a25 100644 --- a/src/PostgREST/Workers.hs +++ b/src/PostgREST/Workers.hs @@ -12,7 +12,6 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text.Encoding as T import qualified Hasql.Notifications as SQL -import qualified Hasql.Pool as SQL import qualified Hasql.Transaction.Sessions as SQL import Control.Retry (RetryStatus, capDelay, exponentialBackoff, @@ -112,14 +111,13 @@ connectionStatus appState = retrying retrySettings shouldRetry $ const $ AppState.releasePool appState >> getConnectionStatus where - pool = AppState.getPool appState retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds delayMicroseconds = 32000000 -- 32 seconds backoffMicroseconds = 1000000 -- 1 second getConnectionStatus :: IO ConnectionStatus getConnectionStatus = do - pgVersion <- SQL.use pool queryPgVersion + pgVersion <- AppState.usePool appState queryPgVersion case pgVersion of Left e -> do let err = PgError False e @@ -155,7 +153,7 @@ loadSchemaCache appState = do AppConfig{..} <- AppState.getConfig appState result <- let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in - SQL.use (AppState.getPool appState) . transaction SQL.ReadCommitted SQL.Read $ + AppState.usePool appState . transaction SQL.ReadCommitted SQL.Read $ queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements case result of Left e -> do @@ -234,7 +232,7 @@ reReadConfig startingUp appState = do AppConfig{..} <- AppState.getConfig appState dbSettings <- if configDbConfig then do - qDbSettings <- SQL.use (AppState.getPool appState) $ queryDbSettings configDbPreparedStatements + qDbSettings <- AppState.usePool appState $ queryDbSettings configDbPreparedStatements case qDbSettings of Left e -> do let