refactor: introduce AppState.usePool

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"] ->

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
 

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)

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