{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Simple database monad for Arbiter with postgresql-simple backend.
--
-- 'SimpleDb' has a built-in 'MonadArbiter' instance, so you can use it directly:
--
-- @
-- import Arbiter.Core
-- import Arbiter.Simple
--
-- myFunction :: SimpleDb MyRegistry IO ()
-- myFunction = insertJob (defaultJob myPayload)
-- @
module Arbiter.Simple.SimpleDb
  ( -- * Database Monad
    SimpleDb (..)
  , SimpleEnv (..)
  , runSimpleDb
  , inTransaction

    -- * Environment Creation
  , createSimpleEnv
  , createSimpleEnvWithConfig
  , createSimpleEnvWithPool
  ) where

import Arbiter.Core.HasArbiterSchema (HasArbiterSchema (..))
import Arbiter.Core.MonadArbiter (MonadArbiter (..))
import Arbiter.Core.PoolConfig (PoolConfig (..))
import Arbiter.Core.PoolConfig qualified as PC
import Arbiter.Core.QueueRegistry (AllQueuesUnique)
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader, asks, local)
import Control.Monad.Trans.Reader (ReaderT (..), runReaderT)
import Data.ByteString (ByteString)
import Data.Pool (Pool, defaultPoolConfig, newPool, setNumStripes)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Database.PostgreSQL.Simple (Connection, close, connectPostgreSQL)
import UnliftIO (MonadUnliftIO)

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

-- | Environment for SimpleDb operations
--
-- Contains both the schema name and the connection pool.
data SimpleEnv registry = SimpleEnv
  { forall {k} (registry :: k). SimpleEnv registry -> Text
schema :: Text
  -- ^ PostgreSQL schema name where job tables are located
  , forall {k} (registry :: k).
SimpleEnv registry -> SimpleConnectionPool
simplePool :: SimpleConnectionPool
  -- ^ The connection pool state
  }

-- | Simple database monad using postgresql-simple.
newtype SimpleDb registry m a = SimpleDb {forall {k} (registry :: k) (m :: * -> *) a.
SimpleDb registry m a -> ReaderT (SimpleEnv registry) m a
unSimpleDb :: ReaderT (SimpleEnv 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 a. a -> SimpleDb registry m a
forall k (registry :: k) (m :: * -> *).
Applicative m =>
Functor (SimpleDb registry m)
forall k (registry :: k) (m :: * -> *) a.
Applicative m =>
a -> SimpleDb registry m a
forall k (registry :: k) (m :: * -> *) a b.
Applicative m =>
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m a
forall k (registry :: k) (m :: * -> *) a b.
Applicative m =>
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m b
forall k (registry :: k) (m :: * -> *) a b.
Applicative m =>
SimpleDb registry m (a -> b)
-> SimpleDb registry m a -> SimpleDb registry m b
forall k (registry :: k) (m :: * -> *) a b c.
Applicative m =>
(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 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 k (registry :: k) (m :: * -> *) a.
Applicative m =>
a -> SimpleDb registry m a
pure :: forall a. a -> SimpleDb registry m a
$c<*> :: forall k (registry :: k) (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 k (registry :: k) (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 k (registry :: k) (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 k (registry :: k) (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 k (registry :: k) (m :: * -> *) a b.
Functor m =>
a -> SimpleDb registry m b -> SimpleDb registry m a
forall k (registry :: k) (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 k (registry :: k) (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 k (registry :: k) (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
    , 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 a. a -> SimpleDb registry m a
forall k (registry :: k) (m :: * -> *).
Monad m =>
Applicative (SimpleDb registry m)
forall k (registry :: k) (m :: * -> *) a.
Monad m =>
a -> SimpleDb registry m a
forall k (registry :: k) (m :: * -> *) a b.
Monad m =>
SimpleDb registry m a
-> SimpleDb registry m b -> SimpleDb registry m b
forall k (registry :: k) (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
-> 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 k (registry :: k) (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 k (registry :: k) (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 k (registry :: k) (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)
-> MonadCatch (SimpleDb registry m)
forall k (registry :: k) (m :: * -> *).
MonadCatch m =>
MonadThrow (SimpleDb registry m)
forall k (registry :: k) (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
SimpleDb registry m a
-> (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 (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall k (registry :: k) (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
MonadCatch
    , Monad (SimpleDb registry m)
Monad (SimpleDb registry m) =>
(forall a. String -> SimpleDb registry m a)
-> MonadFail (SimpleDb registry m)
forall a. String -> SimpleDb registry m a
forall k (registry :: k) (m :: * -> *).
MonadFail m =>
Monad (SimpleDb registry m)
forall k (registry :: k) (m :: * -> *) a.
MonadFail m =>
String -> SimpleDb registry m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall k (registry :: k) (m :: * -> *) a.
MonadFail m =>
String -> SimpleDb registry m a
fail :: forall a. 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 a. IO a -> SimpleDb registry m a
forall k (registry :: k) (m :: * -> *).
MonadIO m =>
Monad (SimpleDb registry m)
forall k (registry :: k) (m :: * -> *) a.
MonadIO m =>
IO a -> SimpleDb registry m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall k (registry :: k) (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 b.
HasCallStack =>
((forall a. SimpleDb registry m a -> SimpleDb registry m a)
 -> SimpleDb registry m b)
-> SimpleDb registry m b
forall k (registry :: k) (m :: * -> *).
MonadMask m =>
MonadCatch (SimpleDb registry m)
forall k (registry :: k) (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. SimpleDb registry m a -> SimpleDb registry m a)
 -> SimpleDb registry m b)
-> SimpleDb registry m b
forall k (registry :: k) (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 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 k (registry :: k) (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 k (registry :: k) (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 k (registry :: k) (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)
-> MonadThrow (SimpleDb registry m)
forall k (registry :: k) (m :: * -> *).
MonadThrow m =>
Monad (SimpleDb registry m)
forall k (registry :: k) (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> SimpleDb registry m a
forall e a.
(HasCallStack, Exception e) =>
e -> SimpleDb registry m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall k (registry :: k) (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
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 b.
((forall a. SimpleDb registry m a -> IO a) -> IO b)
-> SimpleDb registry m b
forall k (registry :: k) (m :: * -> *).
MonadUnliftIO m =>
MonadIO (SimpleDb registry m)
forall k (registry :: k) (m :: * -> *) b.
MonadUnliftIO m =>
((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 k (registry :: k) (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 (Monad m) => HasArbiterSchema (SimpleDb registry m) registry where
  getSchema :: SimpleDb registry m Text
getSchema = (SimpleEnv registry -> Text) -> SimpleDb registry m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SimpleEnv registry -> Text
forall {k} (registry :: k). SimpleEnv registry -> Text
schema

instance (Monad m) => HasSimplePool (SimpleDb registry m) where
  getSimplePool :: SimpleDb registry m SimpleConnectionPool
getSimplePool = (SimpleEnv registry -> SimpleConnectionPool)
-> SimpleDb registry m SimpleConnectionPool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SimpleEnv registry -> SimpleConnectionPool
forall {k} (registry :: k).
SimpleEnv registry -> SimpleConnectionPool
simplePool
  localSimplePool :: forall a.
(SimpleConnectionPool -> SimpleConnectionPool)
-> SimpleDb registry m a -> SimpleDb registry m a
localSimplePool SimpleConnectionPool -> SimpleConnectionPool
f = (SimpleEnv registry -> SimpleEnv registry)
-> SimpleDb registry m a -> SimpleDb registry m a
forall a.
(SimpleEnv registry -> SimpleEnv registry)
-> SimpleDb registry m a -> SimpleDb registry m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\SimpleEnv registry
env -> SimpleEnv registry
env {simplePool = f (simplePool env)})

instance (Monad m, MonadIO m, MonadUnliftIO m) => MonadArbiter (SimpleDb registry m) where
  type Handler (SimpleDb registry m) jobs result = Connection -> jobs -> SimpleDb registry m result
  executeQuery :: forall a. Text -> Params -> RowCodec a -> SimpleDb registry m [a]
executeQuery = Text -> Params -> RowCodec a -> SimpleDb registry m [a]
forall (m :: * -> *) a.
(HasSimplePool m, MonadUnliftIO m) =>
Text -> Params -> RowCodec a -> m [a]
simpleExecuteQuery
  executeStatement :: Text -> Params -> SimpleDb registry m Int64
executeStatement = Text -> Params -> SimpleDb registry m Int64
forall (m :: * -> *).
(HasSimplePool m, MonadUnliftIO m) =>
Text -> Params -> 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.
(HasSimplePool m, MonadUnliftIO m) =>
m a -> m a
simpleWithDbTransaction
  runHandlerWithConnection :: forall jobs result.
Handler (SimpleDb registry m) jobs result
-> jobs -> SimpleDb registry m result
runHandlerWithConnection = Handler (SimpleDb registry m) jobs result
-> jobs -> SimpleDb registry m result
(Connection -> jobs -> SimpleDb registry m result)
-> jobs -> SimpleDb registry m result
forall (m :: * -> *) jobs result.
(HasSimplePool m, MonadUnliftIO m) =>
(Connection -> jobs -> m result) -> jobs -> m result
simpleRunHandlerWithConnection

-- | Run a SimpleDb action with a SimpleEnv.
runSimpleDb :: SimpleEnv registry -> SimpleDb registry m a -> m a
runSimpleDb :: forall {k} (registry :: k) (m :: * -> *) a.
SimpleEnv registry -> SimpleDb registry m a -> m a
runSimpleDb SimpleEnv registry
env SimpleDb registry m a
action = ReaderT (SimpleEnv registry) m a -> SimpleEnv registry -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SimpleDb registry m a -> ReaderT (SimpleEnv registry) m a
forall {k} (registry :: k) (m :: * -> *) a.
SimpleDb registry m a -> ReaderT (SimpleEnv registry) m a
unSimpleDb SimpleDb registry m a
action) SimpleEnv registry
env

-- | Run a SimpleDb action using a single postgresql-simple connection.
--
-- No pool or env is needed. The connection is pinned with @transactionDepth = 1@,
-- so arbiter's 'withDbTransaction' uses savepoints instead of issuing @BEGIN@.
-- The caller is responsible for transaction lifecycle on the connection.
--
-- @
-- PG.withTransaction conn $ do
--   PG.execute conn "INSERT INTO orders ..." params
--   inTransaction conn "arbiter" $
--     Arb.insertJob (Arb.defaultJob (ProcessOrder orderId))
-- @
inTransaction
  :: forall registry m a
   . Connection
  -> Text
  -- ^ PostgreSQL schema name
  -> SimpleDb registry m a
  -> m a
inTransaction :: forall {k} (registry :: k) (m :: * -> *) a.
Connection -> Text -> SimpleDb registry m a -> m a
inTransaction Connection
conn Text
schemaName SimpleDb registry m a
action =
  let env :: SimpleEnv registry
env =
        SimpleEnv
          { schema :: Text
schema = Text
schemaName
          , simplePool :: SimpleConnectionPool
simplePool =
              SimpleConnectionPool
                { connectionPool :: Maybe (Pool Connection)
connectionPool = Maybe (Pool Connection)
forall a. Maybe a
Nothing
                , activeConn :: Maybe Connection
activeConn = Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
conn
                , transactionDepth :: Int
transactionDepth = Int
1
                }
          }
   in SimpleEnv registry -> SimpleDb registry m a -> m a
forall {k} (registry :: k) (m :: * -> *) a.
SimpleEnv registry -> SimpleDb registry m a -> m a
runSimpleDb SimpleEnv registry
env SimpleDb registry m a
action

-- | Create a JobQueue environment with resource-pool connection pooling
--
-- Uses conservative defaults (10 connections, 300s idle timeout, 1 stripe).
--
-- For worker pools, consider using 'createSimpleEnvWithConfig' with @poolConfigForWorkers@
-- to size the pool based on worker count:
--
-- @
-- poolCfg <- poolConfigForWorkers 10
-- env <- createSimpleEnvWithConfig (Proxy @MyRegistry) connStr "arbiter" poolCfg
-- @
--
-- All job tables are created within the specified schema.
createSimpleEnv
  :: forall registry m
   . (AllQueuesUnique registry, MonadIO m)
  => Proxy registry
  -- ^ Type-level job payload registry
  -> ByteString
  -- ^ PostgreSQL connection string
  -> Text
  -- ^ PostgreSQL schema name (e.g., "arbiter", "public")
  -> m (SimpleEnv registry)
createSimpleEnv :: forall (registry :: JobPayloadRegistry) (m :: * -> *).
(AllQueuesUnique registry, MonadIO m) =>
Proxy registry -> ByteString -> Text -> m (SimpleEnv registry)
createSimpleEnv Proxy registry
proxy ByteString
connStr Text
schemaName =
  Proxy registry
-> ByteString -> Text -> PoolConfig -> m (SimpleEnv registry)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
(AllQueuesUnique registry, MonadIO m) =>
Proxy registry
-> ByteString -> Text -> PoolConfig -> m (SimpleEnv registry)
createSimpleEnvWithConfig Proxy registry
proxy ByteString
connStr Text
schemaName PoolConfig
PC.defaultPoolConfig

-- | Control pool sizing, idle timeout, and striping.
--
-- Example:
--
-- @
-- let config = PoolConfig
--       { poolSize = 50
--       , poolIdleTimeout = 120
--       , poolStripes = Just 4
--       }
-- env <- createSimpleEnvWithConfig (Proxy @MyRegistry) "host=localhost dbname=mydb" "arbiter" config
-- @
createSimpleEnvWithConfig
  :: forall registry m
   . (AllQueuesUnique registry, MonadIO m)
  => Proxy registry
  -- ^ Type-level job payload registry
  -> ByteString
  -- ^ PostgreSQL connection string
  -> Text
  -- ^ PostgreSQL schema name
  -> PoolConfig
  -- ^ Pool configuration
  -> m (SimpleEnv registry)
createSimpleEnvWithConfig :: forall (registry :: JobPayloadRegistry) (m :: * -> *).
(AllQueuesUnique registry, MonadIO m) =>
Proxy registry
-> ByteString -> Text -> PoolConfig -> m (SimpleEnv registry)
createSimpleEnvWithConfig Proxy registry
_proxy ByteString
connStr Text
schemaName PoolConfig
config = IO (SimpleEnv registry) -> m (SimpleEnv registry)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SimpleEnv registry) -> m (SimpleEnv registry))
-> IO (SimpleEnv registry) -> m (SimpleEnv registry)
forall a b. (a -> b) -> a -> b
$ do
  let stripes :: Maybe Int
stripes = PoolConfig -> Maybe Int
poolStripes PoolConfig
config
  connPool <-
    PoolConfig Connection -> IO (Pool Connection)
forall a. PoolConfig a -> IO (Pool a)
newPool (PoolConfig Connection -> IO (Pool Connection))
-> PoolConfig Connection -> IO (Pool Connection)
forall a b. (a -> b) -> a -> b
$
      Maybe Int -> PoolConfig Connection -> PoolConfig Connection
forall a. Maybe Int -> PoolConfig a -> PoolConfig a
setNumStripes Maybe Int
stripes (PoolConfig Connection -> PoolConfig Connection)
-> PoolConfig Connection -> PoolConfig Connection
forall a b. (a -> b) -> a -> b
$
        IO Connection
-> (Connection -> IO ()) -> Double -> Int -> PoolConfig Connection
forall a. IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
defaultPoolConfig
          (ByteString -> IO Connection
connectPostgreSQL ByteString
connStr)
          Connection -> IO ()
close
          (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ PoolConfig -> Int
poolIdleTimeout PoolConfig
config) -- idle time (seconds)
          (PoolConfig -> Int
poolSize PoolConfig
config)
  pure
    SimpleEnv
      { schema = schemaName
      , simplePool = SimpleConnectionPool {connectionPool = Just connPool, activeConn = Nothing, transactionDepth = 0}
      }

-- | Create a SimpleEnv with a user-provided connection pool
createSimpleEnvWithPool
  :: forall registry
   . (AllQueuesUnique registry)
  => Proxy registry
  -- ^ Type-level job payload registry
  -> Pool Connection
  -- ^ User-provided connection pool
  -> Text
  -- ^ PostgreSQL schema name
  -> SimpleEnv registry
createSimpleEnvWithPool :: forall (registry :: JobPayloadRegistry).
AllQueuesUnique registry =>
Proxy registry -> Pool Connection -> Text -> SimpleEnv registry
createSimpleEnvWithPool Proxy registry
_proxy Pool Connection
connPool Text
schemaName =
  SimpleEnv
    { schema :: Text
schema = Text
schemaName
    , simplePool :: SimpleConnectionPool
simplePool = SimpleConnectionPool {connectionPool :: Maybe (Pool Connection)
connectionPool = Pool Connection -> Maybe (Pool Connection)
forall a. a -> Maybe a
Just Pool Connection
connPool, activeConn :: Maybe Connection
activeConn = Maybe Connection
forall a. Maybe a
Nothing, transactionDepth :: Int
transactionDepth = Int
0}
    }