-- | Connect to a postgres db and run queries.
--   This module is meant for simple one-off checks against
--   a postgres database, such as health checks or version checks,
--   and not for normal work.
module Hasura.Backends.Postgres.Connection.Connect
  ( withPostgresDB,
  )
where

import Data.Environment qualified as Env
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Connection qualified as PG
import Hasura.Base.Error (QErr)
import Hasura.Prelude
import Hasura.RQL.Types.Common (resolveUrlConf)

-- | Connect to a postgres database and run a transaction.
withPostgresDB :: Env.Environment -> PG.PostgresConnConfiguration -> PG.TxET QErr IO a -> IO (Either QErr a)
withPostgresDB :: forall a.
Environment
-> PostgresConnConfiguration
-> TxET QErr IO a
-> IO (Either QErr a)
withPostgresDB Environment
env PG.PostgresConnConfiguration {Maybe (NonEmpty PostgresSourceConnInfo)
Maybe PostgresConnectionSet
Maybe ConnectionTemplate
ExtensionsSchema
PostgresSourceConnInfo
_pccConnectionInfo :: PostgresSourceConnInfo
_pccReadReplicas :: Maybe (NonEmpty PostgresSourceConnInfo)
_pccExtensionsSchema :: ExtensionsSchema
_pccConnectionTemplate :: Maybe ConnectionTemplate
_pccConnectionSet :: Maybe PostgresConnectionSet
_pccConnectionInfo :: PostgresConnConfiguration -> PostgresSourceConnInfo
_pccReadReplicas :: PostgresConnConfiguration
-> Maybe (NonEmpty PostgresSourceConnInfo)
_pccExtensionsSchema :: PostgresConnConfiguration -> ExtensionsSchema
_pccConnectionTemplate :: PostgresConnConfiguration -> Maybe ConnectionTemplate
_pccConnectionSet :: PostgresConnConfiguration -> Maybe PostgresConnectionSet
..} TxET QErr IO a
tx = do
  PostgresSourceConnInfo -> IO (Either QErr PGPool)
generateMinimalPool PostgresSourceConnInfo
_pccConnectionInfo IO (Either QErr PGPool)
-> (Either QErr PGPool -> IO (Either QErr a)) -> IO (Either QErr a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left QErr
err ->
      -- Cannot able to intialise a pool due to a bad connection config.
      Either QErr a -> IO (Either QErr a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QErr a -> IO (Either QErr a))
-> Either QErr a -> IO (Either QErr a)
forall a b. (a -> b) -> a -> b
$ QErr -> Either QErr a
forall a b. a -> Either a b
Left QErr
err
    Right PGPool
pool -> ExceptT QErr IO a -> IO (Either QErr a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (PGPool -> TxET QErr IO a -> ExceptT QErr IO a
forall (m :: * -> *) e a.
(MonadIO m, MonadBaseControl IO m, FromPGConnErr e) =>
PGPool -> TxET e m a -> ExceptT e m a
PG.runTx' PGPool
pool TxET QErr IO a
tx)
  where
    generateMinimalPool :: PG.PostgresSourceConnInfo -> IO (Either QErr PG.PGPool)
    generateMinimalPool :: PostgresSourceConnInfo -> IO (Either QErr PGPool)
generateMinimalPool PG.PostgresSourceConnInfo {Bool
Maybe (PGClientCerts CertVar CertVar)
Maybe PostgresPoolSettings
TxIsolation
UrlConf
_psciDatabaseUrl :: UrlConf
_psciPoolSettings :: Maybe PostgresPoolSettings
_psciUsePreparedStatements :: Bool
_psciIsolationLevel :: TxIsolation
_psciSslConfiguration :: Maybe (PGClientCerts CertVar CertVar)
_psciDatabaseUrl :: PostgresSourceConnInfo -> UrlConf
_psciPoolSettings :: PostgresSourceConnInfo -> Maybe PostgresPoolSettings
_psciUsePreparedStatements :: PostgresSourceConnInfo -> Bool
_psciIsolationLevel :: PostgresSourceConnInfo -> TxIsolation
_psciSslConfiguration :: PostgresSourceConnInfo -> Maybe (PGClientCerts CertVar CertVar)
..} = ExceptT QErr IO PGPool -> IO (Either QErr PGPool)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
      Text
urlText <- Environment -> UrlConf -> ExceptT QErr IO Text
forall (m :: * -> *).
MonadError QErr m =>
Environment -> UrlConf -> m Text
resolveUrlConf Environment
env UrlConf
_psciDatabaseUrl
      let connInfo :: ConnInfo
connInfo = Int -> ConnDetails -> ConnInfo
PG.ConnInfo Int
0 (ConnDetails -> ConnInfo) -> ConnDetails -> ConnInfo
forall a b. (a -> b) -> a -> b
$ ByteString -> ConnDetails
PG.CDDatabaseURI (ByteString -> ConnDetails) -> ByteString -> ConnDetails
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
txtToBs Text
urlText
          -- Create pool with only one connection
          connParams :: ConnParams
connParams = ConnParams
PG.defaultConnParams {cpConns :: Int
PG.cpConns = Int
1}
      IO PGPool -> ExceptT QErr IO PGPool
forall a. IO a -> ExceptT QErr IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PGPool -> ExceptT QErr IO PGPool)
-> IO PGPool -> ExceptT QErr IO PGPool
forall a b. (a -> b) -> a -> b
$ ConnInfo -> ConnParams -> PGLogger -> IO PGPool
PG.initPGPool ConnInfo
connInfo ConnParams
connParams (\PGLogEvent
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())