diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,21 @@ # Revision history for pgmq-effectful +## 0.6.1.0 -- 2026-09-16 + +Widen the `effectful-core` bound to `^>=2.6 || ^>=2.7`, adding support for 2.7 and dropping +the untested claim of support for 2.5. Nothing in the effect layer changed: the `Pgmq` effect, +both interpreters, and every exported name are identical, and both interpreters already +discarded the `LocalEnv` argument whose type lost a parameter in 2.7. + +Prefer `effectful-core` 2.7.1.1 or newer over 2.7.0.0 — the `Pgmq` effect is dynamically +dispatched, and 2.7.0.0 carries an upstream per-operation overhead regression for dynamic +dispatch that 2.7.1.1 fixed. + +The test suite now requires `ephemeral-pg >=0.3.1.0` and pins its temporary PostgreSQL +clusters to `/tmp/ephpg-pgmq-hs-`, so a run killed mid-test leaves a postmaster a later +run can reap. It therefore depends on `unix` to read the effective uid. No library +dependency changed. + ## 0.6.0.0 -- 2026-09-10 Add grouped-head reads and polling to plain/traced interpreters, with Consumer/receive spans. diff --git a/pgmq-effectful.cabal b/pgmq-effectful.cabal --- a/pgmq-effectful.cabal +++ b/pgmq-effectful.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: pgmq-effectful -version: 0.6.0.0 +version: 0.6.1.0 synopsis: Effectful effects for PGMQ (PostgreSQL Message Queue) description: Effectful effects and interpreters for pgmq-hs, a Haskell client @@ -58,7 +58,7 @@ base >=4.18 && <5, bytestring >=0.11 && <0.13, case-insensitive >=1.2 && <1.3, - effectful-core ^>=2.5 || ^>=2.6, + effectful-core ^>=2.6 || ^>=2.7, hasql ^>=1.10, hasql-pool ^>=1.4, hs-opentelemetry-api >=1.0 && <2, @@ -104,8 +104,8 @@ aeson >=2.0 && <2.3, base >=4.18 && <5, directory, - effectful-core ^>=2.5 || ^>=2.6, - ephemeral-pg >=0.2.1, + effectful-core ^>=2.6 || ^>=2.7, + ephemeral-pg >=0.3.1.0, hasql ^>=1.10, hasql-pool ^>=1.4, hs-opentelemetry-api >=1.0 && <2, @@ -122,5 +122,6 @@ tasty ^>=1.5, tasty-hunit ^>=0.10, text >=2.0 && <2.2, + unix, unordered-containers >=0.2 && <0.3, vector ^>=0.13, diff --git a/test/EphemeralDb.hs b/test/EphemeralDb.hs --- a/test/EphemeralDb.hs +++ b/test/EphemeralDb.hs @@ -15,6 +15,7 @@ import Control.Monad (filterM, when) import Data.List.NonEmpty (NonEmpty (..)) +import Data.Monoid (Last (..)) import Data.Text.IO qualified as TextIO import Database.PostgreSQL.Migrate ( defaultRunOptions, @@ -22,47 +23,75 @@ runMigrationPlan, ) import EphemeralPg - ( StartError, + ( Config (temporaryRoot), + StartError, connectionSettings, - withCached, + defaultCacheConfig, + defaultConfig, + withCachedConfig, ) import Hasql.Pool qualified as Pool import Hasql.Pool.Config qualified as PoolConfig import Hasql.Session qualified as Session import Pgmq.Migration qualified as Migration -import System.Directory (doesFileExist) +import System.Directory (createDirectoryIfMissing, doesFileExist) import System.Environment (lookupEnv) +import System.Posix.User (getEffectiveUserID) +-- | Root directory for ephemeral PostgreSQL clusters. +-- +-- ephemeral-pg reaps abandoned clusters at startup, but only within its own +-- temporary root. With 'temporaryRoot' unset that root is @$TMPDIR@, which +-- @nix develop@ makes unique per shell, so a run never reclaims what an earlier +-- session abandoned. Pinning one root across sessions keeps them reachable. +-- +-- The path is keyed by effective uid. It is a fixed location created @0700@, so +-- a run under a different user -- the Nix build sandbox -- must not collide with +-- a directory it cannot write to. +ephemeralRoot :: IO FilePath +ephemeralRoot = do + uid <- getEffectiveUserID + pure ("/tmp/ephpg-pgmq-hs-" <> show uid) + +-- | Cached-startup configuration pinned to 'ephemeralRoot'. +ephemeralConfig :: IO Config +ephemeralConfig = do + root <- ephemeralRoot + createDirectoryIfMissing True root + pure defaultConfig {temporaryRoot = Last (Just root)} + -- | Run an action with a temporary PostgreSQL database that has the -- pgmq schema installed. withPgmqDb :: (Pool.Pool -> IO a) -> IO (Either StartError a) -withPgmqDb action = withCached $ \db -> do - let connSettings = connectionSettings db - poolConfig = - PoolConfig.settings - [ PoolConfig.size 3, - PoolConfig.staticConnectionSettings connSettings - ] - pool <- Pool.acquire poolConfig - version <- lookupEnv "PGMQ_TEST_SCHEMA_VERSION" - case version of - Just "1.12.0" -> do - paths <- filterM doesFileExist ["test/fixtures/pgmq-1.12.0.sql", "pgmq-effectful/test/fixtures/pgmq-1.12.0.sql"] - path <- case paths of - candidate : _ -> pure candidate - [] -> error "Missing packaged PGMQ 1.12.0 test fixture" - sql <- TextIO.readFile path - Pool.use pool (Session.script sql) >>= either (error . show) pure - Nothing -> installNative connSettings - Just "1.13.0" -> installNative connSettings - Just invalid -> error ("Invalid PGMQ_TEST_SCHEMA_VERSION: " <> invalid) - required <- (== Just "1") <$> lookupEnv "PGMQ_REQUIRE_PARTMAN" - -- Required runs fail for absent or unusable pg_partman, not just missing metadata. - partman <- Pool.use pool (Session.script "CREATE SCHEMA IF NOT EXISTS partman; CREATE EXTENSION IF NOT EXISTS pg_partman SCHEMA partman") - case partman of - Left err -> when required (error ("PGMQ_REQUIRE_PARTMAN=1: " <> show err)) - Right () -> pure () - action pool +withPgmqDb action = + ephemeralConfig >>= \config -> + withCachedConfig config defaultCacheConfig $ \db -> do + let connSettings = connectionSettings db + poolConfig = + PoolConfig.settings + [ PoolConfig.size 3, + PoolConfig.staticConnectionSettings connSettings + ] + pool <- Pool.acquire poolConfig + version <- lookupEnv "PGMQ_TEST_SCHEMA_VERSION" + case version of + Just "1.12.0" -> do + paths <- filterM doesFileExist ["test/fixtures/pgmq-1.12.0.sql", "pgmq-effectful/test/fixtures/pgmq-1.12.0.sql"] + path <- case paths of + candidate : _ -> pure candidate + [] -> error "Missing packaged PGMQ 1.12.0 test fixture" + sql <- TextIO.readFile path + Pool.use pool (Session.script sql) >>= either (error . show) pure + Nothing -> installNative connSettings + Just "1.13.0" -> installNative connSettings + Just invalid -> error ("Invalid PGMQ_TEST_SCHEMA_VERSION: " <> invalid) + required <- (== Just "1") <$> lookupEnv "PGMQ_REQUIRE_PARTMAN" + -- Required runs fail for absent or unusable pg_partman, not just missing metadata. + partman <- Pool.use pool (Session.script "CREATE SCHEMA IF NOT EXISTS partman; CREATE EXTENSION IF NOT EXISTS pg_partman SCHEMA partman") + case partman of + Left err -> when required (error ("PGMQ_REQUIRE_PARTMAN=1: " <> show err)) + Right () -> pure () + action pool where installNative connSettings = do component <- either (error . ("Invalid PGMQ migration component: " <>) . show) pure Migration.pgmqMigrations