diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,14 @@ # Revision history for pgmq-hasql +## 0.6.1.0 -- 2026-09-16 + +Coordinated family version bump; the library is unchanged from 0.6.0.0. + +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 (PGMQ 1.12+), and expose all six grouped reads and their diff --git a/pgmq-hasql.cabal b/pgmq-hasql.cabal --- a/pgmq-hasql.cabal +++ b/pgmq-hasql.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: pgmq-hasql -version: 0.6.0.0 +version: 0.6.1.0 synopsis: Hasql-based client for PGMQ (PostgreSQL Message Queue) description: A Haskell client library for PGMQ (PostgreSQL Message Queue) built @@ -113,7 +113,7 @@ aeson, base >=4.18 && <5, directory, - ephemeral-pg >=0.2.1, + ephemeral-pg >=0.3.1.0, hasql, hasql-pool ^>=1.4, hedgehog ^>=1.5, @@ -129,4 +129,5 @@ tasty-hunit ^>=0.10, text, time, + unix, vector, diff --git a/test/EphemeralDb.hs b/test/EphemeralDb.hs --- a/test/EphemeralDb.hs +++ b/test/EphemeralDb.hs @@ -18,6 +18,7 @@ import Control.Monad (filterM, when) import Data.List.NonEmpty (NonEmpty (..)) +import Data.Monoid (Last (..)) import Data.Text qualified as T import Data.Text.IO qualified as TextIO import Data.Word (Word64) @@ -27,51 +28,79 @@ runMigrationPlan, ) import EphemeralPg - ( Database, + ( Config (temporaryRoot), + Database, 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 Pgmq.Types (QueueName, parseQueueName) -import System.Directory (doesFileExist) +import System.Directory (createDirectoryIfMissing, doesFileExist) import System.Environment (lookupEnv) +import System.Posix.User (getEffectiveUserID) import System.Random (randomRIO) +-- | 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 pgmq schema installed. -- The 'Database' handle is passed alongside the pool because tests that need a raw -- libpq connection (LISTEN\/NOTIFY has no hasql API) need its connection string. withPgmqDb :: (Pool.Pool -> Database -> 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-hasql/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 db +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-hasql/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 db where installNative connSettings = do component <- either (error . ("Invalid PGMQ migration component: " <>) . show) pure Migration.pgmqMigrations