2015-12-21 16:45:10 +03:00
|
|
|
-- |
|
|
|
|
-- This module provides a low-level effectful API dealing with the connections to the database.
|
2024-01-27 00:23:09 +03:00
|
|
|
module Hasql.Connection.Core where
|
2015-12-21 16:45:10 +03:00
|
|
|
|
2024-04-19 07:38:30 +03:00
|
|
|
import Hasql.IO qualified as IO
|
2024-04-27 18:43:39 +03:00
|
|
|
import Hasql.LibPq14 qualified as LibPQ
|
2024-01-27 00:23:09 +03:00
|
|
|
import Hasql.Prelude
|
2024-04-19 07:38:30 +03:00
|
|
|
import Hasql.PreparedStatementRegistry qualified as PreparedStatementRegistry
|
|
|
|
import Hasql.Settings qualified as Settings
|
2015-12-21 16:45:10 +03:00
|
|
|
|
|
|
|
-- |
|
|
|
|
-- A single connection to the database.
|
2022-06-20 13:54:54 +03:00
|
|
|
data Connection
|
|
|
|
= Connection !(MVar LibPQ.Connection) !Bool !PreparedStatementRegistry.PreparedStatementRegistry
|
2015-12-21 16:45:10 +03:00
|
|
|
|
|
|
|
-- |
|
|
|
|
-- Possible details of the connection acquistion error.
|
2015-12-23 14:23:39 +03:00
|
|
|
type ConnectionError =
|
2015-12-21 16:45:10 +03:00
|
|
|
Maybe ByteString
|
|
|
|
|
|
|
|
-- |
|
|
|
|
-- Acquire a connection using the provided settings encoded according to the PostgreSQL format.
|
2015-12-23 14:23:39 +03:00
|
|
|
acquire :: Settings.Settings -> IO (Either ConnectionError Connection)
|
2015-12-21 16:45:10 +03:00
|
|
|
acquire settings =
|
2015-12-26 09:32:03 +03:00
|
|
|
{-# SCC "acquire" #-}
|
2017-11-26 11:24:40 +03:00
|
|
|
runExceptT $ do
|
2015-12-21 16:45:10 +03:00
|
|
|
pqConnection <- lift (IO.acquireConnection settings)
|
2017-11-26 11:24:40 +03:00
|
|
|
lift (IO.checkConnectionStatus pqConnection) >>= traverse throwError
|
2015-12-21 16:45:10 +03:00
|
|
|
lift (IO.initConnection pqConnection)
|
|
|
|
integerDatetimes <- lift (IO.getIntegerDatetimes pqConnection)
|
|
|
|
registry <- lift (IO.acquirePreparedStatementRegistry)
|
2015-12-26 09:32:03 +03:00
|
|
|
pqConnectionRef <- lift (newMVar pqConnection)
|
|
|
|
pure (Connection pqConnectionRef integerDatetimes registry)
|
2015-12-21 16:45:10 +03:00
|
|
|
|
|
|
|
-- |
|
|
|
|
-- Release the connection.
|
|
|
|
release :: Connection -> IO ()
|
2015-12-26 09:32:03 +03:00
|
|
|
release (Connection pqConnectionRef _ _) =
|
|
|
|
mask_ $ do
|
|
|
|
nullConnection <- LibPQ.newNullConnection
|
|
|
|
pqConnection <- swapMVar pqConnectionRef nullConnection
|
|
|
|
IO.releaseConnection pqConnection
|
2016-07-23 13:20:50 +03:00
|
|
|
|
2016-07-23 15:44:55 +03:00
|
|
|
-- |
|
|
|
|
-- Execute an operation on the raw @libpq@ 'LibPQ.Connection'.
|
2016-07-23 13:20:50 +03:00
|
|
|
--
|
|
|
|
-- The access to the connection is exclusive.
|
|
|
|
withLibPQConnection :: Connection -> (LibPQ.Connection -> IO a) -> IO a
|
2016-07-23 15:44:55 +03:00
|
|
|
withLibPQConnection (Connection pqConnectionRef _ _) =
|
|
|
|
withMVar pqConnectionRef
|