-- |
-- This module provides a low-level effectful API dealing with the connections to the database.
module Hasql.Connection.Core where

import Hasql.Connection.Config qualified as Config
import Hasql.Connection.Setting qualified as Setting
import Hasql.IO qualified as IO
import Hasql.LibPq14 qualified as LibPQ
import Hasql.Prelude
import Hasql.PreparedStatementRegistry qualified as PreparedStatementRegistry

-- |
-- A single connection to the database.
data Connection
  = Connection
      -- | Whether prepared statements are allowed.
      !Bool
      -- | Lower level libpq connection.
      !(MVar LibPQ.Connection)
      -- | Integer datetimes.
      !Bool
      -- | Prepared statement registry.
      !PreparedStatementRegistry.PreparedStatementRegistry

-- |
-- Possible details of the connection acquistion error.
type ConnectionError =
  Maybe ByteString

-- |
-- Establish a connection according to the provided settings.
acquire ::
  [Setting.Setting] ->
  IO (Either ConnectionError Connection)
acquire :: [Setting] -> IO (Either ConnectionError Connection)
acquire [Setting]
settings =
  {-# SCC "acquire" #-}
  ExceptT ConnectionError IO Connection
-> IO (Either ConnectionError Connection)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ConnectionError IO Connection
 -> IO (Either ConnectionError Connection))
-> ExceptT ConnectionError IO Connection
-> IO (Either ConnectionError Connection)
forall a b. (a -> b) -> a -> b
$ do
    Connection
pqConnection <- IO Connection -> ExceptT ConnectionError IO Connection
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT ConnectionError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ByteString -> IO Connection
IO.acquireConnection (Config -> ByteString
Config.connectionString Config
config))
    IO (Maybe ConnectionError)
-> ExceptT ConnectionError IO (Maybe ConnectionError)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT ConnectionError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Connection -> IO (Maybe ConnectionError)
IO.checkConnectionStatus Connection
pqConnection) ExceptT ConnectionError IO (Maybe ConnectionError)
-> (Maybe ConnectionError
    -> ExceptT ConnectionError IO (Maybe (ZonkAny 0)))
-> ExceptT ConnectionError IO (Maybe (ZonkAny 0))
forall a b.
ExceptT ConnectionError IO a
-> (a -> ExceptT ConnectionError IO b)
-> ExceptT ConnectionError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ConnectionError -> ExceptT ConnectionError IO (ZonkAny 0))
-> Maybe ConnectionError
-> ExceptT ConnectionError IO (Maybe (ZonkAny 0))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ConnectionError -> ExceptT ConnectionError IO (ZonkAny 0)
forall a. ConnectionError -> ExceptT ConnectionError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    IO () -> ExceptT ConnectionError IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT ConnectionError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Connection -> IO ()
IO.initConnection Connection
pqConnection)
    Bool
integerDatetimes <- IO Bool -> ExceptT ConnectionError IO Bool
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT ConnectionError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Connection -> IO Bool
IO.getIntegerDatetimes Connection
pqConnection)
    PreparedStatementRegistry
registry <- IO PreparedStatementRegistry
-> ExceptT ConnectionError IO PreparedStatementRegistry
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT ConnectionError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO PreparedStatementRegistry
IO.acquirePreparedStatementRegistry)
    MVar Connection
pqConnectionRef <- IO (MVar Connection)
-> ExceptT ConnectionError IO (MVar Connection)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT ConnectionError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Connection -> IO (MVar Connection)
forall a. a -> IO (MVar a)
newMVar Connection
pqConnection)
    pure (Bool
-> MVar Connection
-> Bool
-> PreparedStatementRegistry
-> Connection
Connection (Config -> Bool
Config.usePreparedStatements Config
config) MVar Connection
pqConnectionRef Bool
integerDatetimes PreparedStatementRegistry
registry)
  where
    config :: Config
config = [Setting] -> Config
forall a. Updates a => [a] -> Config
Config.fromUpdates [Setting]
settings

-- |
-- Release the connection.
release :: Connection -> IO ()
release :: Connection -> IO ()
release (Connection Bool
_ MVar Connection
pqConnectionRef Bool
_ PreparedStatementRegistry
_) =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Connection
nullConnection <- IO Connection
LibPQ.newNullConnection
    Connection
pqConnection <- MVar Connection -> Connection -> IO Connection
forall a. MVar a -> a -> IO a
swapMVar MVar Connection
pqConnectionRef Connection
nullConnection
    Connection -> IO ()
IO.releaseConnection Connection
pqConnection

-- |
-- Execute an operation on the raw @libpq@ 'LibPQ.Connection'.
--
-- The access to the connection is exclusive.
withLibPQConnection :: Connection -> (LibPQ.Connection -> IO a) -> IO a
withLibPQConnection :: forall a. Connection -> (Connection -> IO a) -> IO a
withLibPQConnection (Connection Bool
_ MVar Connection
pqConnectionRef Bool
_ PreparedStatementRegistry
_) =
  MVar Connection -> (Connection -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Connection
pqConnectionRef