packages feed

pgmq-core 0.4.0.1 → 0.5.0.0

raw patch · 5 files changed

+250/−7 lines, 5 filesdep +pgmq-coredep +tastydep +tasty-hunit

Dependencies added: pgmq-core, tasty, tasty-hunit

Files

CHANGELOG.md view
@@ -1,5 +1,48 @@ # Revision history for pgmq-core +## 0.5.0.0 -- 2026-08-06++### Breaking Changes++* Queue names are now validated consistently at every entry path. `parseQueueName` rejects+  the empty string and any character outside lowercase ASCII letters, digits, and+  underscore — previously uppercase was accepted and the empty string passed every check.+  `FromJSON QueueName` is now a hand-written instance that validates via `parseQueueName`;+  it was newtype-derived, accepting any string of any length, so configuration-loaded+  names bypassed validation entirely.++  Lowercase-only is a correctness requirement, not a style choice. pgmq's SQL lowercases+  physical table names while `pgmq.meta` stores the caller's original casing, and the+  notification trigger looks up the lowercased name. `MyQueue` and `myqueue` were+  therefore two logical queues silently interleaving in one physical table: dropping+  either destroyed the other's messages, and a mixed-case notification throttle was never+  matched by the trigger. Rejection was chosen over normalization because normalizing+  would silently join pre-existing mixed-case metadata and make the parsed name disagree+  with what the caller wrote.++  **Upgrade note**: `listQueues` re-validates names read back from the database, so a+  deployment whose `pgmq.meta` still contains mixed-case rows must run the transactional+  remediation in `docs/design/016-queue-name-validation.md` — which preserves topic+  bindings and notification configuration — before upgrading. Do not update or delete+  `pgmq.meta` rows by hand: both child foreign keys cascade on delete.++### New Features++* `notifyChannelName :: QueueName -> Text` returns the LISTEN/NOTIFY channel a queue's+  insert notifications arrive on (`pgmq.q_<lowercased name>.INSERT`). It is now the+  contract; do not assemble the name by hand. It lives here rather than in pgmq-hasql+  because a LISTEN consumer needs a raw connection anyway and may not depend on+  pgmq-hasql at all.+* `UnvalidatedQueue`, a queue listing row whose name is plain `Text`. pgmq's server-side+  validator checks only name length, so any client sharing the database can create a name+  `parseQueueName` rejects; this type is what the lenient pgmq-hasql and pgmq-effectful+  listings decode into.++### Other Changes++* New `pgmq-core-test` suite pinning both queue-name entry paths, `parseQueueName` and+  `FromJSON`.+ ## 0.4.0.1 -- 2026-07-14  * Version bump only — coordinated release with pgmq-migration 0.4.0.1.
pgmq-core.cabal view
@@ -1,6 +1,6 @@ cabal-version:   3.4 name:            pgmq-core-version:         0.4.0.1+version:         0.5.0.0 synopsis:        Core types for pgmq-hs, a Haskell client for PGMQ description:   Core types and type classes for pgmq-hs, a Haskell client library@@ -41,3 +41,22 @@    hs-source-dirs:     src   default-language:   GHC2024++test-suite pgmq-core-test+  import:             warnings+  default-language:   GHC2024+  type:               exitcode-stdio-1.0+  hs-source-dirs:     test+  main-is:            Main.hs+  other-modules:      QueueNameSpec+  default-extensions:+    ImportQualifiedPost+    OverloadedStrings++  build-depends:+    , aeson        ^>=2.2+    , base         >=4.18  && <5+    , pgmq-core+    , tasty        ^>=1.5+    , tasty-hunit  ^>=0.10+    , text         ^>=2.1
src/Pgmq/Types.hs view
@@ -6,6 +6,7 @@     MessageId (..),     Message (..),     Queue (..),+    UnvalidatedQueue (..),     QueueName,     parseQueueName,     queueNameToText,@@ -21,12 +22,16 @@     TopicBinding (..),     RoutingMatch (..),     TopicSendResult (..),++    -- * Notifications (pgmq 1.11.0+)     NotifyInsertThrottle (..),+    notifyChannelName,   ) where -import Data.Aeson (FromJSON, ToJSON, Value)-import Data.Char (isAlphaNum, isAscii)+import Data.Aeson (FromJSON (..), ToJSON, Value)+import Data.Aeson qualified as Aeson+import Data.Char (isAlphaNum, isAscii, isDigit, isLower) import Data.Int (Int32, Int64) import Data.Text (Text) import Data.Text qualified as T@@ -56,6 +61,23 @@   }   deriving stock (Eq, Generic, Show) +-- | A row of @pgmq.list_queues()@ with the queue name left unvalidated.+--+-- Queues are created by every client that shares the database, and the+-- server accepts names 'parseQueueName' rejects (its only check is length).+-- This shape exists so state inspection — notably pgmq-config's reconciler —+-- can observe such foreign queues without failing to decode them.+-- 'unvalidatedName' may therefore hold any server-accepted name; do not feed+-- it into APIs expecting a validated 'QueueName' without going through+-- 'parseQueueName'.+data UnvalidatedQueue = UnvalidatedQueue+  { unvalidatedName :: !Text,+    unvalidatedCreatedAt :: !UTCTime,+    unvalidatedIsPartitioned :: !Bool,+    unvalidatedIsUnlogged :: !Bool+  }+  deriving stock (Eq, Generic, Show)+ -- | https://pgmq.github.io/pgmq/api/sql/types/ -- Note: headers field added in pgmq 1.5.0 -- Note: lastReadAt field added in pgmq 1.10.0@@ -71,13 +93,20 @@   deriving stock (Eq, Generic, Show)  newtype QueueName = QueueName Text-  deriving newtype (Eq, Ord, FromJSON, ToJSON)+  deriving newtype (Eq, Ord, ToJSON)   deriving stock (Show, Generic)  instance Lift QueueName where   lift (QueueName t) = [|QueueName t|]   liftTyped (QueueName t) = [||QueueName t||] +-- | Validates via 'parseQueueName', so JSON- and config-loaded names get+-- exactly the same checks as programmatic construction. A derived instance+-- would bypass the smart constructor entirely.+instance FromJSON QueueName where+  parseJSON = Aeson.withText "QueueName" $ \t ->+    either (fail . show) pure (parseQueueName t)+ queueNameToText :: QueueName -> Text queueNameToText (QueueName t) = t @@ -87,16 +116,43 @@   | InvalidTopicPattern Text   deriving stock (Show, Generic) --- Adopted from https://github.com/tembo-io/pgmq/blob/e4d4b84bf302df77be2d1f877c5cf8ef8861bfc7/pgmq-rs/src/util.rs#L94+-- | Parse a queue name: non-empty, at most 47 characters, drawn from lowercase+-- ASCII letters, digits, and underscore only.+--+-- Lowercase-only is a correctness requirement, not a style choice. pgmq's SQL+-- lowercases /physical/ table names (@pgmq.format_table_name@) but stores the+-- caller's /original/ casing in @pgmq.meta@, and the notification trigger looks+-- up the /lowercased/ name extracted from the physical table. A mixed-case name+-- therefore aliases: @MyQueue@ and @myqueue@ are two metadata identities+-- sharing one physical table (interleaved messages; dropping either destroys+-- the other's data), and notification throttles configured under a mixed-case+-- name are never matched by the trigger. Rejecting anything but lowercase makes+-- all three representations agree. Names are deliberately not normalized:+-- silent lowercasing would re-introduce the aliasing against pre-existing+-- mixed-case metadata and make the parsed name disagree with what the caller+-- wrote.+--+-- Upgrade note: a database that already contains mixed-case rows in+-- @pgmq.meta@ will fail @listQueues@ decoding under this stricter parser (the+-- decoder re-validates names read back from the database). Run the mixed-case+-- remediation described in @docs/design/016-queue-name-validation.md@ before+-- upgrading such a deployment.+--+-- Length check adopted from+-- https://github.com/tembo-io/pgmq/blob/e4d4b84bf302df77be2d1f877c5cf8ef8861bfc7/pgmq-rs/src/util.rs#L94 parseQueueName :: Text -> Either PgmqError QueueName parseQueueName t+  | T.null t = Left $ InvalidQueueName "The queue name is empty."   | not isShortEnough = Left $ InvalidQueueName "The queue name is too long."-  | not hasValidCharacters = Left $ InvalidQueueName "The queue name contains invalid characters."+  | not hasValidCharacters =+      Left $+        InvalidQueueName+          "The queue name contains invalid characters (allowed: lowercase ASCII letters, digits, underscore)."   | otherwise = Right $ QueueName t   where     isShortEnough = T.length t <= maxQueueNameLength     hasValidCharacters = T.all isValidChar t-    isValidChar c = (isAscii c && isAlphaNum c) || c == '_'+    isValidChar c = (isAscii c && (isLower c || isDigit c)) || c == '_'      -- PostgreSQL identifier length information     -- https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-IDENTIFIERS@@ -169,3 +225,19 @@     throttleLastNotifiedAt :: !UTCTime   }   deriving stock (Eq, Generic, Show)++-- | The LISTEN\/NOTIFY channel on which pgmq raises insert notifications for a+-- queue, once @pgmq.enable_notify_insert@ has installed the trigger. The format+-- is @pgmq.q_\<lowercased queue name\>.INSERT@: the physical table name (the+-- @q_@ prefix, lowercased by pgmq's @format_table_name@) bracketed by the+-- @pgmq.@ schema tag and the trigger operation.+--+-- Because the name contains dots, LISTEN requires it double-quoted:+--+-- > LISTEN "pgmq.q_myqueue.INSERT"+--+-- NOTIFY is fire-and-forget. Notifications are not queued for disconnected+-- listeners, and a configured throttle interval suppresses them by design.+-- Consumers must keep a poll fallback regardless of LISTEN.+notifyChannelName :: QueueName -> Text+notifyChannelName q = "pgmq.q_" <> T.toLower (queueNameToText q) <> ".INSERT"
+ test/Main.hs view
@@ -0,0 +1,12 @@+module Main (main) where++import QueueNameSpec qualified+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main =+  defaultMain $+    testGroup+      "pgmq-core"+      [ QueueNameSpec.tests+      ]
+ test/QueueNameSpec.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE OverloadedStrings #-}++-- | PGH-7: queue names must be rejected consistently at every entry path.+--+-- The unexported @QueueName@ constructor leaves exactly two runtime ways to+-- build one: 'parseQueueName' and 'Data.Aeson.FromJSON'. Both must enforce the+-- same contract — non-empty, at most 47 characters, lowercase ASCII letters,+-- digits, and underscore only. Lowercase-only matters because pgmq's SQL+-- lowercases physical table names while @pgmq.meta@ stores the caller's+-- original casing: a mixed-case name aliases another queue's physical table+-- and configures notification throttles the trigger can never match. The+-- @FromJSON@ instance was previously newtype-derived and accepted anything,+-- which is the bypass these tests pin shut.+module QueueNameSpec (tests) where++import Data.Aeson qualified as Aeson+import Data.Text (Text)+import Data.Text qualified as T+import Pgmq.Types (PgmqError (..), QueueName, parseQueueName, queueNameToText)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)++tests :: TestTree+tests =+  testGroup+    "QueueName validation"+    [ parseAcceptance,+      parseRejection,+      jsonPath+    ]++parseAcceptance :: TestTree+parseAcceptance =+  testGroup+    "parseQueueName accepts"+    [ testCase "a typical lowercase name" $ do+        qn <- assertParses "my_queue_123"+        assertEqual "round-trips through queueNameToText" "my_queue_123" (queueNameToText qn),+      testCase "a 47-character lowercase name (the maximum)" $ do+        qn <- assertParses (T.replicate 47 "a")+        assertEqual "length preserved" 47 (T.length (queueNameToText qn))+    ]++parseRejection :: TestTree+parseRejection =+  testGroup+    "parseQueueName rejects"+    [ testCase "an uppercase name" $+        assertRejects "MyQueue" "invalid characters",+      testCase "the empty string" $+        assertRejects "" "empty",+      testCase "a 48-character name" $+        assertRejects (T.replicate 48 "a") "too long",+      testCase "a hyphenated name" $+        assertRejects "bad-name" "invalid characters",+      testCase "a name with punctuation" $+        assertRejects "queue!" "invalid characters"+    ]++jsonPath :: TestTree+jsonPath =+  testGroup+    "FromJSON validates via parseQueueName"+    [ testCase "a lowercase name decodes and round-trips through ToJSON" $+        case Aeson.fromJSON (Aeson.String "myqueue") :: Aeson.Result QueueName of+          Aeson.Error err -> assertFailure $ "Expected Success, got Error: " <> err+          Aeson.Success qn -> assertEqual "ToJSON round-trip" (Aeson.String "myqueue") (Aeson.toJSON qn),+      testCase "an uppercase name is rejected" $ assertJsonRejects "MyQueue",+      testCase "the empty string is rejected" $ assertJsonRejects "",+      testCase "an overlong name is rejected" $ assertJsonRejects (T.replicate 60 "x"),+      testCase "a hyphenated name is rejected" $ assertJsonRejects "bad-name"+    ]++assertParses :: Text -> IO QueueName+assertParses t =+  case parseQueueName t of+    Left err -> assertFailure $ "Expected Right, got: " <> show err+    Right qn -> pure qn++-- | The rejection must be an 'InvalidQueueName' whose message names the actual+-- problem, so callers surface something diagnosable.+assertRejects :: Text -> String -> IO ()+assertRejects t expectedFragment =+  case parseQueueName t of+    Right _ -> assertFailure $ "Expected rejection of " <> show t+    Left err@(InvalidQueueName msg) ->+      assertBool+        ("Expected message mentioning " <> show expectedFragment <> ", got: " <> show err)+        (T.pack expectedFragment `T.isInfixOf` msg)+    Left err -> assertFailure $ "Expected InvalidQueueName, got: " <> show err++assertJsonRejects :: Text -> IO ()+assertJsonRejects t =+  case Aeson.fromJSON (Aeson.String t) :: Aeson.Result QueueName of+    Aeson.Error _ -> pure ()+    Aeson.Success qn ->+      assertFailure $ "Expected FromJSON rejection of " <> show t <> ", got: " <> show (queueNameToText qn)