mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-04-01 00:56:11 +00:00
fe64d42db1
* smp server: split postgres support to a separate executable, to not require postgres library in the main binary * comments * enable server_postgres flag by default, add CPP option to test * refactor * change default for server_postgres to False * diff
65 lines
2.1 KiB
Haskell
65 lines
2.1 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Simplex.Messaging.Agent.Store.Postgres.Common
|
|
( DBStore (..),
|
|
DBOpts (..),
|
|
withConnection,
|
|
withConnection',
|
|
withTransaction,
|
|
withTransaction',
|
|
withTransactionPriority,
|
|
)
|
|
where
|
|
|
|
import Control.Concurrent.MVar
|
|
import Control.Concurrent.STM
|
|
import Control.Exception (bracket)
|
|
import Data.ByteString (ByteString)
|
|
import qualified Database.PostgreSQL.Simple as PSQL
|
|
import Simplex.Messaging.Agent.Store.Postgres.Options
|
|
|
|
-- TODO [postgres] use log_min_duration_statement instead of custom slow queries (SQLite's Connection type)
|
|
data DBStore = DBStore
|
|
{ dbConnstr :: ByteString,
|
|
dbSchema :: ByteString,
|
|
dbPoolSize :: Int,
|
|
dbPool :: TBQueue PSQL.Connection,
|
|
-- MVar is needed for fair pool distribution, without STM retry contention.
|
|
-- Only one thread can be blocked on STM read.
|
|
dbSem :: MVar (),
|
|
dbClosed :: TVar Bool,
|
|
dbNew :: Bool
|
|
}
|
|
|
|
withConnectionPriority :: DBStore -> Bool -> (PSQL.Connection -> IO a) -> IO a
|
|
withConnectionPriority DBStore {dbPool, dbSem} _priority =
|
|
bracket
|
|
(withMVar dbSem $ \_ -> atomically $ readTBQueue dbPool)
|
|
(atomically . writeTBQueue dbPool)
|
|
|
|
withConnection :: DBStore -> (PSQL.Connection -> IO a) -> IO a
|
|
withConnection st = withConnectionPriority st False
|
|
{-# INLINE withConnection #-}
|
|
|
|
withConnection' :: DBStore -> (PSQL.Connection -> IO a) -> IO a
|
|
withConnection' = withConnection
|
|
{-# INLINE withConnection' #-}
|
|
|
|
withTransaction' :: DBStore -> (PSQL.Connection -> IO a) -> IO a
|
|
withTransaction' = withTransaction
|
|
{-# INLINE withTransaction' #-}
|
|
|
|
withTransaction :: DBStore -> (PSQL.Connection -> IO a) -> IO a
|
|
withTransaction st = withTransactionPriority st False
|
|
{-# INLINE withTransaction #-}
|
|
|
|
-- TODO [postgres] analogue for dbBusyLoop?
|
|
withTransactionPriority :: DBStore -> Bool -> (PSQL.Connection -> IO a) -> IO a
|
|
withTransactionPriority st priority action = withConnectionPriority st priority transaction
|
|
where
|
|
transaction conn = PSQL.withTransaction conn $ action conn
|