{-# LANGUAGE TypeFamilies #-}

-- | The postgresql-simple database monad with a built-in 'MonadArbiter' instance:
--
-- @
-- import Arbiter.Core qualified as Arb
-- import Arbiter.Simple qualified as ArbS
-- import Control.Monad (void)
--
-- myFunction :: ArbS.SimpleDb MyRegistry IO ()
-- myFunction = void $ Arb.insertJob (Arb.defaultJob myPayload)
-- @
module Arbiter.Simple.SimpleDb
  ( -- * Database monad
    SimpleDb (..)
  , SimpleEnv
  , Db
  , Env (..)
  , PoolState (..)
  , HasPoolState (..)
  , runSimpleDb
  , inTransaction

    -- * Environment creation
  , createSimpleEnv
  , createSimpleEnvWithConfig
  , createSimpleEnvWithPool
  , destroySimpleEnv
  , disableListener
  , useDedicatedListener
  ) where

import Arbiter.Core.Backend
  ( Db (..)
  , Driver (..)
  , Env (..)
  , HasPoolState (..)
  , PoolState (..)
  , createEnvWithConfig
  , createEnvWithPool
  , destroyEnv
  , disableListener
  , runDb
  )
import Arbiter.Core.Backend qualified as Backend
import Arbiter.Core.Job.Schema (SchemaName)
import Arbiter.Core.MonadArbiter (MonadArbiter (..))
import Arbiter.Core.PoolConfig (PoolConfig)
import Arbiter.Core.PoolConfig qualified as PC
import Arbiter.Core.QueueRegistry (JobPayloadRegistry)
import Arbiter.LibPQ (libPQListenConn, withLibPQListenConn)
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (MonadReader, asks)
import Control.Monad.Trans.Class (MonadTrans (..))
import Data.ByteString (ByteString)
import Data.Pool (Pool)
import Data.Proxy (Proxy (..))
import Database.PostgreSQL.Simple (Connection, close, connectPostgreSQL)
import Database.PostgreSQL.Simple.Internal (withConnection)
import UnliftIO (MonadUnliftIO)

import Arbiter.Simple.MonadArbiter
  ( simpleExecuteQuery
  , simpleExecuteStatement
  , simpleRunHandlerWithConnection
  , simpleWithDbTransaction
  )

-- | The 'Env' for 'SimpleDb'.
type SimpleEnv = Env Connection ()

simpleDriver :: Driver Connection ()
simpleDriver :: Driver Connection ()
simpleDriver = Driver {withListenConn :: Connection -> (ListenConn -> IO ()) -> IO ()
withListenConn = \Connection
conn ListenConn -> IO ()
action -> Connection -> (Connection -> IO ()) -> IO ()
forall a. Connection -> (Connection -> IO a) -> IO a
withConnection Connection
conn (ListenConn -> IO ()
action (ListenConn -> IO ())
-> (Connection -> ListenConn) -> Connection -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ListenConn
libPQListenConn), initialConfig :: ()
initialConfig = ()}

-- | The postgresql-simple database monad.
newtype SimpleDb (registry :: JobPayloadRegistry) m a = SimpleDb
  { forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
SimpleDb registry m a -> Db Connection () registry m a
unSimpleDb :: Db Connection () registry m a
  }
  deriving newtype
    ( Functor (SimpleDb registry m)
Functor (SimpleDb registry m) =>
(forall a. a -> SimpleDb registry m a)
-> (forall a b.
    SimpleDb registry m (a -> b)
    -> SimpleDb registry m a -> SimpleDb registry m b)
-> (forall a b c.
    (a -> b -> c)
    -> SimpleDb registry m a
    -> SimpleDb registry m b
    -> SimpleDb registry m c)
-> (forall a b.
    SimpleDb registry m a
    -> SimpleDb registry m b -> SimpleDb registry m b)
-> (forall a b.
    SimpleDb registry m a
    -> SimpleDb registry m b -> SimpleDb registry m a)
-> Applicative (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
Applicative m =>
Functor (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
Applicative m =>
a -> SimpleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m b
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
SimpleDb registry m (a -> b)
-> SimpleDb registry m a -> SimpleDb registry m b
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SimpleDb registry m a
-> SimpleDb registry m b
-> SimpleDb registry m c
forall a. a -> SimpleDb registry m a
forall a b.
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m a
forall a b.
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m b
forall a b.
SimpleDb registry m (a -> b)
-> SimpleDb registry m a -> SimpleDb registry m b
forall a b c.
(a -> b -> c)
-> SimpleDb registry m a
-> SimpleDb registry m b
-> SimpleDb registry m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
Applicative m =>
a -> SimpleDb registry m a
pure :: forall a. a -> SimpleDb registry m a
$c<*> :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
SimpleDb registry m (a -> b)
-> SimpleDb registry m a -> SimpleDb registry m b
<*> :: forall a b.
SimpleDb registry m (a -> b)
-> SimpleDb registry m a -> SimpleDb registry m b
$cliftA2 :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SimpleDb registry m a
-> SimpleDb registry m b
-> SimpleDb registry m c
liftA2 :: forall a b c.
(a -> b -> c)
-> SimpleDb registry m a
-> SimpleDb registry m b
-> SimpleDb registry m c
$c*> :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m b
*> :: forall a b.
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m b
$c<* :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m a
<* :: forall a b.
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m a
Applicative
    , (forall a b.
 (a -> b) -> SimpleDb registry m a -> SimpleDb registry m b)
-> (forall a b.
    a -> SimpleDb registry m b -> SimpleDb registry m a)
-> Functor (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Functor m =>
a -> SimpleDb registry m b -> SimpleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Functor m =>
(a -> b) -> SimpleDb registry m a -> SimpleDb registry m b
forall a b. a -> SimpleDb registry m b -> SimpleDb registry m a
forall a b.
(a -> b) -> SimpleDb registry m a -> SimpleDb registry m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Functor m =>
(a -> b) -> SimpleDb registry m a -> SimpleDb registry m b
fmap :: forall a b.
(a -> b) -> SimpleDb registry m a -> SimpleDb registry m b
$c<$ :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Functor m =>
a -> SimpleDb registry m b -> SimpleDb registry m a
<$ :: forall a b. a -> SimpleDb registry m b -> SimpleDb registry m a
Functor
    , HasPoolState Connection
    , Applicative (SimpleDb registry m)
Applicative (SimpleDb registry m) =>
(forall a b.
 SimpleDb registry m a
 -> (a -> SimpleDb registry m b) -> SimpleDb registry m b)
-> (forall a b.
    SimpleDb registry m a
    -> SimpleDb registry m b -> SimpleDb registry m b)
-> (forall a. a -> SimpleDb registry m a)
-> Monad (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
Monad m =>
Applicative (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
Monad m =>
a -> SimpleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Monad m =>
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m b
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Monad m =>
SimpleDb registry m a
-> (a -> SimpleDb registry m b) -> SimpleDb registry m b
forall a. a -> SimpleDb registry m a
forall a b.
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m b
forall a b.
SimpleDb registry m a
-> (a -> SimpleDb registry m b) -> SimpleDb registry m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Monad m =>
SimpleDb registry m a
-> (a -> SimpleDb registry m b) -> SimpleDb registry m b
>>= :: forall a b.
SimpleDb registry m a
-> (a -> SimpleDb registry m b) -> SimpleDb registry m b
$c>> :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Monad m =>
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m b
>> :: forall a b.
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m b
$creturn :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
Monad m =>
a -> SimpleDb registry m a
return :: forall a. a -> SimpleDb registry m a
Monad
    , MonadThrow (SimpleDb registry m)
MonadThrow (SimpleDb registry m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 SimpleDb registry m a
 -> (e -> SimpleDb registry m a) -> SimpleDb registry m a)
-> (forall e a.
    Exception e =>
    SimpleDb registry m a
    -> (ExceptionWithContext e -> SimpleDb registry m a)
    -> SimpleDb registry m a)
-> MonadCatch (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadCatch m =>
MonadThrow (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
SimpleDb registry m a
-> (e -> SimpleDb registry m a) -> SimpleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SimpleDb registry m a
-> (ExceptionWithContext e -> SimpleDb registry m a)
-> SimpleDb registry m a
forall e a.
(HasCallStack, Exception e) =>
SimpleDb registry m a
-> (e -> SimpleDb registry m a) -> SimpleDb registry m a
forall e a.
Exception e =>
SimpleDb registry m a
-> (ExceptionWithContext e -> SimpleDb registry m a)
-> SimpleDb registry m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> (forall e a.
    Exception e =>
    m a -> (ExceptionWithContext e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
SimpleDb registry m a
-> (e -> SimpleDb registry m a) -> SimpleDb registry m a
catch :: forall e a.
(HasCallStack, Exception e) =>
SimpleDb registry m a
-> (e -> SimpleDb registry m a) -> SimpleDb registry m a
$ccatchNoPropagate :: forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SimpleDb registry m a
-> (ExceptionWithContext e -> SimpleDb registry m a)
-> SimpleDb registry m a
catchNoPropagate :: forall e a.
Exception e =>
SimpleDb registry m a
-> (ExceptionWithContext e -> SimpleDb registry m a)
-> SimpleDb registry m a
MonadCatch
    , Monad (SimpleDb registry m)
Monad (SimpleDb registry m) =>
(forall a. HasCallStack => String -> SimpleDb registry m a)
-> MonadFail (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadFail m =>
Monad (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> SimpleDb registry m a
forall a. HasCallStack => String -> SimpleDb registry m a
forall (m :: * -> *).
Monad m =>
(forall a. HasCallStack => String -> m a) -> MonadFail m
$cfail :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> SimpleDb registry m a
fail :: forall a. HasCallStack => String -> SimpleDb registry m a
MonadFail
    , Monad (SimpleDb registry m)
Monad (SimpleDb registry m) =>
(forall a. IO a -> SimpleDb registry m a)
-> MonadIO (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadIO m =>
Monad (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
MonadIO m =>
IO a -> SimpleDb registry m a
forall a. IO a -> SimpleDb registry m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
MonadIO m =>
IO a -> SimpleDb registry m a
liftIO :: forall a. IO a -> SimpleDb registry m a
MonadIO
    , MonadCatch (SimpleDb registry m)
MonadCatch (SimpleDb registry m) =>
(forall b.
 HasCallStack =>
 ((forall a. SimpleDb registry m a -> SimpleDb registry m a)
  -> SimpleDb registry m b)
 -> SimpleDb registry m b)
-> (forall b.
    HasCallStack =>
    ((forall a. SimpleDb registry m a -> SimpleDb registry m a)
     -> SimpleDb registry m b)
    -> SimpleDb registry m b)
-> (forall a b c.
    HasCallStack =>
    SimpleDb registry m a
    -> (a -> ExitCase b -> SimpleDb registry m c)
    -> (a -> SimpleDb registry m b)
    -> SimpleDb registry m (b, c))
-> MonadMask (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadMask m =>
MonadCatch (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. SimpleDb registry m a -> SimpleDb registry m a)
 -> SimpleDb registry m b)
-> SimpleDb registry m b
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
SimpleDb registry m a
-> (a -> ExitCase b -> SimpleDb registry m c)
-> (a -> SimpleDb registry m b)
-> SimpleDb registry m (b, c)
forall b.
HasCallStack =>
((forall a. SimpleDb registry m a -> SimpleDb registry m a)
 -> SimpleDb registry m b)
-> SimpleDb registry m b
forall a b c.
HasCallStack =>
SimpleDb registry m a
-> (a -> ExitCase b -> SimpleDb registry m c)
-> (a -> SimpleDb registry m b)
-> SimpleDb registry m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall (registry :: JobPayloadRegistry) (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. SimpleDb registry m a -> SimpleDb registry m a)
 -> SimpleDb registry m b)
-> SimpleDb registry m b
mask :: forall b.
HasCallStack =>
((forall a. SimpleDb registry m a -> SimpleDb registry m a)
 -> SimpleDb registry m b)
-> SimpleDb registry m b
$cuninterruptibleMask :: forall (registry :: JobPayloadRegistry) (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. SimpleDb registry m a -> SimpleDb registry m a)
 -> SimpleDb registry m b)
-> SimpleDb registry m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. SimpleDb registry m a -> SimpleDb registry m a)
 -> SimpleDb registry m b)
-> SimpleDb registry m b
$cgeneralBracket :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
SimpleDb registry m a
-> (a -> ExitCase b -> SimpleDb registry m c)
-> (a -> SimpleDb registry m b)
-> SimpleDb registry m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
SimpleDb registry m a
-> (a -> ExitCase b -> SimpleDb registry m c)
-> (a -> SimpleDb registry m b)
-> SimpleDb registry m (b, c)
MonadMask
    , MonadReader (SimpleEnv registry)
    , Monad (SimpleDb registry m)
Monad (SimpleDb registry m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 e -> SimpleDb registry m a)
-> (forall e a.
    Exception e =>
    ExceptionWithContext e -> SimpleDb registry m a)
-> MonadThrow (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadThrow m =>
Monad (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> SimpleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
ExceptionWithContext e -> SimpleDb registry m a
forall e a.
(HasCallStack, Exception e) =>
e -> SimpleDb registry m a
forall e a.
Exception e =>
ExceptionWithContext e -> SimpleDb registry m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> (forall e a. Exception e => ExceptionWithContext e -> m a)
-> MonadThrow m
$cthrowM :: forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> SimpleDb registry m a
throwM :: forall e a.
(HasCallStack, Exception e) =>
e -> SimpleDb registry m a
$crethrowM :: forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
ExceptionWithContext e -> SimpleDb registry m a
rethrowM :: forall e a.
Exception e =>
ExceptionWithContext e -> SimpleDb registry m a
MonadThrow
    , MonadIO (SimpleDb registry m)
MonadIO (SimpleDb registry m) =>
(forall b.
 ((forall a. SimpleDb registry m a -> IO a) -> IO b)
 -> SimpleDb registry m b)
-> MonadUnliftIO (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadUnliftIO m =>
MonadIO (SimpleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. SimpleDb registry m a -> IO a) -> IO b)
-> SimpleDb registry m b
forall b.
((forall a. SimpleDb registry m a -> IO a) -> IO b)
-> SimpleDb registry m b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall (registry :: JobPayloadRegistry) (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. SimpleDb registry m a -> IO a) -> IO b)
-> SimpleDb registry m b
withRunInIO :: forall b.
((forall a. SimpleDb registry m a -> IO a) -> IO b)
-> SimpleDb registry m b
MonadUnliftIO
    )

instance MonadTrans (SimpleDb registry) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> SimpleDb registry m a
lift = Db Connection () registry m a -> SimpleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
Db Connection () registry m a -> SimpleDb registry m a
SimpleDb (Db Connection () registry m a -> SimpleDb registry m a)
-> (m a -> Db Connection () registry m a)
-> m a
-> SimpleDb registry m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (Env Connection () registry) m a
-> Db Connection () registry m a
forall conn cfg (registry :: JobPayloadRegistry) (m :: * -> *) a.
ReaderT (Env conn cfg registry) m a -> Db conn cfg registry m a
Db (ReaderT (Env Connection () registry) m a
 -> Db Connection () registry m a)
-> (m a -> ReaderT (Env Connection () registry) m a)
-> m a
-> Db Connection () registry m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (Env Connection () registry) m a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Env Connection () registry) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (MonadUnliftIO m) => MonadArbiter (SimpleDb registry m) where
  type RegistryOf (SimpleDb registry m) = registry
  type Handler (SimpleDb registry m) job result = Connection -> job -> SimpleDb registry m result
  getSchema :: SimpleDb registry m SchemaName
getSchema = (Env Connection () registry -> SchemaName)
-> SimpleDb registry m SchemaName
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env Connection () registry -> SchemaName
forall conn cfg (registry :: JobPayloadRegistry).
Env conn cfg registry -> SchemaName
schema
  executeQuery :: forall a. Query a -> SimpleDb registry m [a]
executeQuery = Query a -> SimpleDb registry m [a]
forall (m :: * -> *) a.
(HasPoolState Connection m, MonadUnliftIO m) =>
Query a -> m [a]
simpleExecuteQuery
  executeStatement :: forall a. Query a -> SimpleDb registry m Int64
executeStatement = Query a -> SimpleDb registry m Int64
forall (m :: * -> *) a.
(HasPoolState Connection m, MonadUnliftIO m) =>
Query a -> m Int64
simpleExecuteStatement
  withDbTransaction :: forall a. SimpleDb registry m a -> SimpleDb registry m a
withDbTransaction = SimpleDb registry m a -> SimpleDb registry m a
forall (m :: * -> *) a.
(HasPoolState Connection m, MonadUnliftIO m) =>
m a -> m a
simpleWithDbTransaction
  runHandlerWithConnection :: forall payload.
JobHandler
  (SimpleDb registry m)
  payload
  (ResultOf (SimpleDb registry m) payload)
-> JobRead payload
-> SimpleDb registry m (ResultOf (SimpleDb registry m) payload)
runHandlerWithConnection = Handler
  (SimpleDb registry m)
  (JobRecord payload Int64 SchemaName UTCTime PayloadKeys)
  (ResultFor payload (RegistryOf (SimpleDb registry m)))
-> JobRecord payload Int64 SchemaName UTCTime PayloadKeys
-> SimpleDb
     registry m (ResultFor payload (RegistryOf (SimpleDb registry m)))
(Connection
 -> JobRecord payload Int64 SchemaName UTCTime PayloadKeys
 -> SimpleDb registry m (SpecResult (MatchIn payload '[] registry)))
-> JobRecord payload Int64 SchemaName UTCTime PayloadKeys
-> SimpleDb registry m (SpecResult (MatchIn payload '[] registry))
forall (m :: * -> *) job result.
(HasPoolState Connection m, MonadUnliftIO m) =>
(Connection -> job -> m result) -> job -> m result
simpleRunHandlerWithConnection
  getListener :: SimpleDb registry m (Maybe Listener)
getListener = (Env Connection () registry -> Maybe Listener)
-> SimpleDb registry m (Maybe Listener)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env Connection () registry -> Maybe Listener
forall conn cfg (registry :: JobPayloadRegistry).
Env conn cfg registry -> Maybe Listener
listener

-- | Close the idle connections in the env's pool. Connections in use stay open and go
-- back to the pool. The pool stays usable.
destroySimpleEnv :: (MonadIO m) => SimpleEnv registry -> m ()
destroySimpleEnv :: forall (m :: * -> *) (registry :: JobPayloadRegistry).
MonadIO m =>
SimpleEnv registry -> m ()
destroySimpleEnv = Env Connection () registry -> m ()
forall (m :: * -> *) conn cfg (registry :: JobPayloadRegistry).
MonadIO m =>
Env conn cfg registry -> m ()
destroyEnv

-- | Run a 'SimpleDb' action in its env.
runSimpleDb :: SimpleEnv registry -> SimpleDb registry m a -> m a
runSimpleDb :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
SimpleEnv registry -> SimpleDb registry m a -> m a
runSimpleDb SimpleEnv registry
env = SimpleEnv registry -> Db Connection () registry m a -> m a
forall conn cfg (registry :: JobPayloadRegistry) (m :: * -> *) a.
Env conn cfg registry -> Db conn cfg registry m a -> m a
runDb SimpleEnv registry
env (Db Connection () registry m a -> m a)
-> (SimpleDb registry m a -> Db Connection () registry m a)
-> SimpleDb registry m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDb registry m a -> Db Connection () registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
SimpleDb registry m a -> Db Connection () registry m a
unSimpleDb

-- | Run a 'SimpleDb' action on one connection pinned as the caller's open transaction.
--
-- @
-- import Arbiter.Core qualified as Arb
-- import Arbiter.Simple qualified as ArbS
--
-- PG.withTransaction conn $ do
--   PG.execute conn \"INSERT INTO orders ...\" params
--   ArbS.inTransaction \@MyRegistry conn \"arbiter\" $
--     Arb.insertJob (Arb.defaultJob (ProcessOrder orderId))
-- @
inTransaction
  :: forall registry m a
   . Connection
  -- ^ Connection with an open transaction
  -> SchemaName
  -> SimpleDb registry m a
  -> m a
inTransaction :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
Connection -> SchemaName -> SimpleDb registry m a -> m a
inTransaction Connection
conn SchemaName
schemaName = Driver Connection ()
-> Connection -> SchemaName -> Db Connection () registry m a -> m a
forall conn cfg (registry :: JobPayloadRegistry) (m :: * -> *) a.
Driver conn cfg
-> conn -> SchemaName -> Db conn cfg registry m a -> m a
Backend.inTransaction Driver Connection ()
simpleDriver Connection
conn SchemaName
schemaName (Db Connection () registry m a -> m a)
-> (SimpleDb registry m a -> Db Connection () registry m a)
-> SimpleDb registry m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDb registry m a -> Db Connection () registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
SimpleDb registry m a -> Db Connection () registry m a
unSimpleDb

-- | Create a 'SimpleEnv' with 'Arbiter.Core.PoolConfig.defaultPoolConfig'. Size worker pools with
-- 'createSimpleEnvWithConfig' and @Arbiter.Worker.poolConfigForWorkers@.
-- While anything listens, the listener holds one pool slot.
createSimpleEnv
  :: forall registry m
   . (MonadIO m)
  => Proxy registry
  -- ^ Type-level job payload registry
  -> ByteString
  -- ^ PostgreSQL connection string
  -> SchemaName
  -> m (SimpleEnv registry)
createSimpleEnv :: forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadIO m =>
Proxy registry
-> ByteString -> SchemaName -> m (SimpleEnv registry)
createSimpleEnv Proxy registry
proxy ByteString
connStr SchemaName
schemaName =
  Proxy registry
-> ByteString -> SchemaName -> PoolConfig -> m (SimpleEnv registry)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadIO m =>
Proxy registry
-> ByteString -> SchemaName -> PoolConfig -> m (SimpleEnv registry)
createSimpleEnvWithConfig Proxy registry
proxy ByteString
connStr SchemaName
schemaName PoolConfig
PC.defaultPoolConfig

-- | Create a 'SimpleEnv' with custom pool settings. While anything listens, the listener holds
-- one pool slot.
--
-- @
-- let config = PoolConfig
--       { poolSize = 50
--       , poolIdleTimeout = 120
--       , poolStripes = Just 4
--       }
-- env <- createSimpleEnvWithConfig (Proxy \@MyRegistry) "host=localhost dbname=mydb" "arbiter" config
-- @
createSimpleEnvWithConfig
  :: forall registry m
   . (MonadIO m)
  => Proxy registry
  -- ^ Type-level job payload registry
  -> ByteString
  -- ^ PostgreSQL connection string
  -> SchemaName
  -> PoolConfig
  -- ^ Pool configuration
  -> m (SimpleEnv registry)
createSimpleEnvWithConfig :: forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadIO m =>
Proxy registry
-> ByteString -> SchemaName -> PoolConfig -> m (SimpleEnv registry)
createSimpleEnvWithConfig Proxy registry
_proxy ByteString
connStr = Driver Connection ()
-> IO Connection
-> (Connection -> IO ())
-> SchemaName
-> PoolConfig
-> m (Env Connection () registry)
forall (m :: * -> *) conn cfg (registry :: JobPayloadRegistry).
MonadIO m =>
Driver conn cfg
-> IO conn
-> (conn -> IO ())
-> SchemaName
-> PoolConfig
-> m (Env conn cfg registry)
createEnvWithConfig Driver Connection ()
simpleDriver (ByteString -> IO Connection
connectPostgreSQL ByteString
connStr) Connection -> IO ()
close

-- | Create a 'SimpleEnv' over a caller's own connection pool. While anything listens, the
-- listener holds one pool slot.
createSimpleEnvWithPool
  :: forall registry m
   . (MonadIO m)
  => Proxy registry
  -- ^ Type-level job payload registry
  -> Pool Connection
  -- ^ Caller's connection pool
  -> SchemaName
  -> m (SimpleEnv registry)
createSimpleEnvWithPool :: forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadIO m =>
Proxy registry
-> Pool Connection -> SchemaName -> m (SimpleEnv registry)
createSimpleEnvWithPool Proxy registry
_proxy = Driver Connection ()
-> Pool Connection -> SchemaName -> m (Env Connection () registry)
forall (m :: * -> *) conn cfg (registry :: JobPayloadRegistry).
MonadIO m =>
Driver conn cfg
-> Pool conn -> SchemaName -> m (Env conn cfg registry)
createEnvWithPool Driver Connection ()
simpleDriver

-- | Give the env a dedicated LISTEN connection that takes no pool slot.
useDedicatedListener :: (MonadIO m) => ByteString -> SimpleEnv registry -> m (SimpleEnv registry)
useDedicatedListener :: forall (m :: * -> *) (registry :: JobPayloadRegistry).
MonadIO m =>
ByteString -> SimpleEnv registry -> m (SimpleEnv registry)
useDedicatedListener ByteString
connStr = ((ListenConn -> IO ()) -> IO ())
-> Env Connection () registry -> m (Env Connection () registry)
forall (m :: * -> *) conn cfg (registry :: JobPayloadRegistry).
MonadIO m =>
((ListenConn -> IO ()) -> IO ())
-> Env conn cfg registry -> m (Env conn cfg registry)
Backend.useDedicatedListener (ByteString -> (ListenConn -> IO ()) -> IO ()
forall a. ByteString -> (ListenConn -> IO a) -> IO a
withLibPQListenConn ByteString
connStr)