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

import Hasql.Private.Prelude
import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Hasql.Private.PreparedStatementRegistry as PreparedStatementRegistry
import qualified Hasql.Private.IO as IO
import qualified Hasql.Private.Settings 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 (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 (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 (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)
traverse ConnectionError -> ExceptT ConnectionError IO Any
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    IO () -> ExceptT ConnectionError IO ()
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 (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 (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 (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)
    Connection -> ExceptT ConnectionError IO Connection
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: 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