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

import Hasql.IO qualified as IO
import Hasql.LibPq14 qualified as LibPQ
import Hasql.Prelude
import Hasql.PreparedStatementRegistry qualified as PreparedStatementRegistry
import Hasql.Settings qualified as Settings

-- |
-- A single connection to the database.
data Connection
  = Connection !(MVar LibPQ.Connection) !Bool !PreparedStatementRegistry.PreparedStatementRegistry

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

-- |
-- Acquire a connection using the provided settings encoded according to the PostgreSQL format.
acquire :: Settings.Settings -> IO (Either ConnectionError Connection)
acquire :: Settings -> IO (Either ConnectionError Connection)
acquire Settings
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 (Settings -> IO Connection
IO.acquireConnection Settings
settings)
    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 Any))
-> ExceptT ConnectionError IO (Maybe Any)
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 Any)
-> Maybe ConnectionError -> ExceptT ConnectionError IO (Maybe Any)
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 Any
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 (MVar Connection -> Bool -> PreparedStatementRegistry -> Connection
Connection MVar Connection
pqConnectionRef Bool
integerDatetimes PreparedStatementRegistry
registry)

-- |
-- Release the connection.
release :: Connection -> IO ()
release :: Connection -> IO ()
release (Connection 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 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