pgmq-core 0.6.1.1 → 0.7.0.0

raw patch · 34 files changed

+425/−5 lines, 34 filesdep +bytestringdep +tasty-goldendep ~pgmq-corePVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, tasty-golden

Dependency ranges changed: pgmq-core

API changes (from Hackage documentation)

+ Pgmq.Types: ArchivedMessage :: !Message -> !UTCTime -> ArchivedMessage

+ Pgmq.Types: [archivedAt] :: ArchivedMessage -> !UTCTime

+ Pgmq.Types: [archivedMessage] :: ArchivedMessage -> !Message

+ Pgmq.Types: data ArchivedMessage

+ Pgmq.Types: instance Data.Aeson.Types.FromJSON.FromJSON Pgmq.Types.ArchivedMessage

+ Pgmq.Types: instance Data.Aeson.Types.FromJSON.FromJSON Pgmq.Types.Message

+ Pgmq.Types: instance Data.Aeson.Types.FromJSON.FromJSON Pgmq.Types.Queue

+ Pgmq.Types: instance Data.Aeson.Types.FromJSON.FromJSON Pgmq.Types.UnvalidatedQueue

+ Pgmq.Types: instance Data.Aeson.Types.ToJSON.ToJSON Pgmq.Types.ArchivedMessage

+ Pgmq.Types: instance Data.Aeson.Types.ToJSON.ToJSON Pgmq.Types.Message

+ Pgmq.Types: instance Data.Aeson.Types.ToJSON.ToJSON Pgmq.Types.NotifyInsertThrottle

+ Pgmq.Types: instance Data.Aeson.Types.ToJSON.ToJSON Pgmq.Types.Queue

+ Pgmq.Types: instance Data.Aeson.Types.ToJSON.ToJSON Pgmq.Types.RoutingMatch

+ Pgmq.Types: instance Data.Aeson.Types.ToJSON.ToJSON Pgmq.Types.TopicBinding

+ Pgmq.Types: instance Data.Aeson.Types.ToJSON.ToJSON Pgmq.Types.TopicSendResult

+ Pgmq.Types: instance Data.Aeson.Types.ToJSON.ToJSON Pgmq.Types.UnvalidatedQueue

+ Pgmq.Types: instance GHC.Classes.Eq Pgmq.Types.ArchivedMessage

+ Pgmq.Types: instance GHC.Internal.Generics.Generic Pgmq.Types.ArchivedMessage

+ Pgmq.Types: instance GHC.Internal.Show.Show Pgmq.Types.ArchivedMessage

Files

CHANGELOG.md +22/−0
pgmq-core.cabal +10/−3
src/Pgmq/Types.hs +184/−1
test/JsonGoldenSpec.hs +177/−0
test/Main.hs +3/−1
test/golden/archived_headers_absent.json +1/−0
test/golden/archived_headers_array.json +1/−0
test/golden/archived_headers_boolean.json +1/−0
test/golden/archived_headers_null.json +1/−0
test/golden/archived_headers_number.json +1/−0
test/golden/archived_headers_object.json +1/−0
test/golden/archived_headers_string.json +1/−0
test/golden/archived_message.json +1/−0
test/golden/archived_message_above_safe_integer.json +1/−0
test/golden/archived_message_max_int64.json +1/−0
test/golden/archived_message_null_headers.json +1/−0
test/golden/headers_absent.json +1/−0
test/golden/headers_array.json +1/−0
test/golden/headers_boolean.json +1/−0
test/golden/headers_null.json +1/−0
test/golden/headers_number.json +1/−0
test/golden/headers_object.json +1/−0
test/golden/headers_string.json +1/−0
test/golden/message_above_safe_integer.json +1/−0
test/golden/message_max_int64.json +1/−0
test/golden/message_null_headers.json +1/−0
test/golden/message_read.json +1/−0
test/golden/message_unread.json +1/−0
test/golden/notify_insert_throttle.json +1/−0
test/golden/queue.json +1/−0
test/golden/routing_match.json +1/−0
test/golden/topic_binding.json +1/−0
test/golden/topic_send_result.json +1/−0
test/golden/unvalidated_queue.json +1/−0

CHANGELOG.md view

@@ -1,5 +1,27 @@ # Revision history for pgmq-core +## 0.7.0.0 -- 2026-10-26++### New Features++- Add `ArchivedMessage`, a `Message` plus its `archivedAt` timestamp, for archive+  inspection reads.+- Add hand-written `ToJSON` instances for `Queue`, `UnvalidatedQueue`, `Message`,+  `ArchivedMessage`, `TopicBinding`, `RoutingMatch`, `TopicSendResult` and+  `NotifyInsertThrottle`, and `FromJSON` instances for the first four. Encodings use+  pgmq's snake_case columns and explicit null optional fields; archived messages+  flatten the `Message` object. Queue decoding validates names while+  `UnvalidatedQueue` preserves text. Arbitrary JSON headers normalize explicit null+  to `Nothing`; newtype instances and exact numeric int64 message IDs are unchanged.+  Remove downstream orphan instances for these newly supported types.++### Other Changes++- Golden and exact int64 fixtures pin the published wire contract in design note 020.+  Tests require tasty-golden 2.3.6 to reject missing fixtures as well as changed bytes.+- Document that `notifyChannelName` names an unsupported parent channel for+  partitioned queues.+ ## 0.6.1.1 -- 2026-09-25  Coordinated family version bump; core types are unchanged from 0.6.1.0.

pgmq-core.cabal view

@@ -1,6 +1,6 @@ cabal-version: 3.4 name: pgmq-core-version: 0.6.1.1+version: 0.7.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@@ -15,6 +15,7 @@ category: Database build-type: Simple extra-doc-files: CHANGELOG.md+extra-source-files: test/golden/*.json  common warnings   ghc-options:@@ -54,7 +55,10 @@   type: exitcode-stdio-1.0   hs-source-dirs: test   main-is: Main.hs-  other-modules: QueueNameSpec+  other-modules:+    JsonGoldenSpec+    QueueNameSpec+   default-extensions:     ImportQualifiedPost     OverloadedStrings@@ -62,7 +66,10 @@   build-depends:     aeson ^>=2.2,     base >=4.18 && <5,-    pgmq-core >=0.6 && <0.7,+    bytestring >=0.11 && <0.13,+    pgmq-core >=0.7 && <0.8,     tasty ^>=1.5,+    tasty-golden ^>=2.3.6,     tasty-hunit ^>=0.10,     text ^>=2.1,+    time ^>=1.14,

src/Pgmq/Types.hs view

@@ -5,6 +5,7 @@     MessageHeaders (..),     MessageId (..),     Message (..),+    ArchivedMessage (..),     Queue (..),     UnvalidatedQueue (..),     QueueName,@@ -29,7 +30,7 @@   ) where -import Data.Aeson (FromJSON (..), ToJSON, Value)+import Data.Aeson (Encoding, FromJSON (..), KeyValue, Series, ToJSON (..), Value, object, pairs, withObject, (.:), (.:?), (.=)) import Data.Aeson qualified as Aeson import Data.Char (isAlphaNum, isAscii, isDigit, isLower) import Data.Int (Int32, Int64)@@ -92,6 +93,19 @@   }   deriving stock (Eq, Generic, Show) +-- | A row of an archive table @pgmq.a_\<queue\>@: the message exactly as it was+-- when @archiveMessage@ (or @pgmq.archive@ called by any client) moved it out of+-- the queue table, plus the archival timestamp the archive table stamped.+--+-- Archive tables are only ever read by the non-destructive inspection reads+-- (@peekArchivedMessages@, @lookupArchivedMessage@ in pgmq-hasql); pgmq itself+-- never reads them back. See @docs/design/019-non-destructive-inspection-reads.md@.+data ArchivedMessage = ArchivedMessage+  { archivedMessage :: !Message,+    archivedAt :: !UTCTime+  }+  deriving stock (Eq, Generic, Show)+ newtype QueueName = QueueName Text   deriving newtype (Eq, Ord, ToJSON)   deriving stock (Show, Generic)@@ -239,5 +253,174 @@ -- 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.+--+-- Normal partitioned queues receive no insert notifications on their documented+-- parent channel. See @docs/design/015-notification-delivery-contract.md@.+-- The reconciler reports partitioned notification declarations as unsupported. notifyChannelName :: QueueName -> Text notifyChannelName q = "pgmq.q_" <> T.toLower (queueNameToText q) <> ".INSERT"++-- JSON wire encodings ---------------------------------------------------------++-- | Encode fields directly as a 'Series', preserving nested record encoders+-- and written key order. The shared 'KeyValue' field lists also build 'Value'+-- objects for 'toJSON', without making 'toEncoding' pass through those objects.+encodeFields :: [Series] -> Encoding+encodeFields = pairs . mconcat++-- | Wire keys are the @pgmq.list_queues()@ column names. The encoding is a+-- published compatibility surface; see @docs/design/020-json-wire-encodings.md@.+-- 'Queue' and 'UnvalidatedQueue' encode identically; only decoding differs.+queueFields :: (KeyValue e kv) => Queue -> [kv]+queueFields q =+  [ "queue_name" .= name q,+    "is_partitioned" .= isPartitioned q,+    "is_unlogged" .= isUnlogged q,+    "created_at" .= createdAt q+  ]++-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance ToJSON Queue where+  toJSON = object . queueFields+  toEncoding = encodeFields . queueFields++-- | Decoding validates @queue_name@ through 'parseQueueName' (the 'FromJSON'+-- 'QueueName' instance), so a foreign or mixed-case name fails here and must+-- be decoded as 'UnvalidatedQueue' instead.+-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance FromJSON Queue where+  parseJSON = withObject "Queue" $ \o ->+    Queue+      <$> o .: "queue_name"+      <*> o .: "created_at"+      <*> o .: "is_partitioned"+      <*> o .: "is_unlogged"++-- | Same wire shape as 'Queue'; see @docs/design/020-json-wire-encodings.md@.+unvalidatedQueueFields :: (KeyValue e kv) => UnvalidatedQueue -> [kv]+unvalidatedQueueFields q =+  [ "queue_name" .= unvalidatedName q,+    "is_partitioned" .= unvalidatedIsPartitioned q,+    "is_unlogged" .= unvalidatedIsUnlogged q,+    "created_at" .= unvalidatedCreatedAt q+  ]++-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance ToJSON UnvalidatedQueue where+  toJSON = object . unvalidatedQueueFields+  toEncoding = encodeFields . unvalidatedQueueFields++-- | Decodes any server-accepted name; nothing is validated.+-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance FromJSON UnvalidatedQueue where+  parseJSON = withObject "UnvalidatedQueue" $ \o ->+    UnvalidatedQueue+      <$> o .: "queue_name"+      <*> o .: "created_at"+      <*> o .: "is_partitioned"+      <*> o .: "is_unlogged"++-- | Wire keys are the @pgmq.message_record@ column names: @msg_id@, @read_ct@,+-- @enqueued_at@, @last_read_at@, @vt@, @message@, @headers@. Optional columns+-- are always present and encode as @null@. The encoding is a published+-- compatibility surface; see @docs/design/020-json-wire-encodings.md@.+messageFields :: (KeyValue e kv) => Message -> [kv]+messageFields m =+  [ "msg_id" .= messageId m,+    "read_ct" .= readCount m,+    "enqueued_at" .= enqueuedAt m,+    "last_read_at" .= lastReadAt m,+    "vt" .= visibilityTime m,+    "message" .= body m,+    "headers" .= headers m+  ]++-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance ToJSON Message where+  toJSON = object . messageFields+  toEncoding = encodeFields . messageFields++-- | A missing @last_read_at@ or @headers@ key decodes as 'Nothing', as does+-- an explicit @null@.+-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance FromJSON Message where+  parseJSON = withObject "Message" $ \o ->+    Message+      <$> o .: "msg_id"+      <*> o .: "vt"+      <*> o .: "enqueued_at"+      <*> o .:? "last_read_at"+      <*> o .: "read_ct"+      <*> o .: "message"+      <*> o .:? "headers"++-- | The 'Message' encoding with one more key, @archived_at@, flattened into+-- the same object. See @docs/design/020-json-wire-encodings.md@.+archivedMessageFields :: (KeyValue e kv) => ArchivedMessage -> [kv]+archivedMessageFields a =+  messageFields (archivedMessage a) <> ["archived_at" .= archivedAt a]++-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance ToJSON ArchivedMessage where+  toJSON = object . archivedMessageFields+  toEncoding = encodeFields . archivedMessageFields++-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance FromJSON ArchivedMessage where+  parseJSON = withObject "ArchivedMessage" $ \o ->+    ArchivedMessage+      <$> parseJSON (Aeson.Object o)+      <*> o .: "archived_at"++-- | Wire keys are the @pgmq.list_topic_bindings()@ columns. Encode-only; see+-- @docs/design/020-json-wire-encodings.md@.+topicBindingFields :: (KeyValue e kv) => TopicBinding -> [kv]+topicBindingFields b =+  [ "pattern" .= bindingPattern b,+    "queue_name" .= bindingQueueName b,+    "bound_at" .= bindingBoundAt b,+    "compiled_regex" .= bindingCompiledRegex b+  ]++-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance ToJSON TopicBinding where+  toJSON = object . topicBindingFields+  toEncoding = encodeFields . topicBindingFields++-- | Wire keys are the @pgmq.test_routing()@ columns. Encode-only.+routingMatchFields :: (KeyValue e kv) => RoutingMatch -> [kv]+routingMatchFields m =+  [ "pattern" .= matchPattern m,+    "queue_name" .= matchQueueName m,+    "compiled_regex" .= matchCompiledRegex m+  ]++-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance ToJSON RoutingMatch where+  toJSON = object . routingMatchFields+  toEncoding = encodeFields . routingMatchFields++-- | Wire keys are the @pgmq.send_batch_topic()@ result columns. Encode-only.+topicSendResultFields :: (KeyValue e kv) => TopicSendResult -> [kv]+topicSendResultFields r =+  [ "queue_name" .= sentToQueue r,+    "msg_id" .= sentMessageId r+  ]++-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance ToJSON TopicSendResult where+  toJSON = object . topicSendResultFields+  toEncoding = encodeFields . topicSendResultFields++-- | Wire keys are the @pgmq.list_notify_insert_throttles()@ columns. Encode-only.+notifyInsertThrottleFields :: (KeyValue e kv) => NotifyInsertThrottle -> [kv]+notifyInsertThrottleFields t =+  [ "queue_name" .= throttleQueueName t,+    "throttle_interval_ms" .= throttleIntervalMs t,+    "last_notified_at" .= throttleLastNotifiedAt t+  ]++-- | JSON wire contract: @docs/design/020-json-wire-encodings.md@.+instance ToJSON NotifyInsertThrottle where+  toJSON = object . notifyInsertThrottleFields+  toEncoding = encodeFields . notifyInsertThrottleFields

+ test/JsonGoldenSpec.hs view

@@ -0,0 +1,177 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Pins the JSON wire shape of every pgmq-core record that carries an aeson+-- instance. The golden files under @test/golden/@ are the human-readable+-- statement of the contract in @docs/design/020-json-wire-encodings.md@: a+-- renamed or re-typed field changes the bytes and fails here. Regenerate+-- with @--accept@ only after deciding, in the changelog, that the change is+-- additive.+module JsonGoldenSpec (tests) where++import Data.Aeson (ToJSON (..), Value (..), decode, eitherDecode, encode, object, (.=))+import Data.Aeson.KeyMap qualified as KM+import Data.ByteString.Lazy qualified as LBS+import Data.ByteString.Lazy.Char8 qualified as LBS8+import Data.Either (isLeft)+import Data.Int (Int64)+import Data.Time (UTCTime (..), fromGregorian)+import Pgmq.Types+import Test.Tasty (TestTree, localOption, testGroup)+import Test.Tasty.Golden (NoCreateFile (..), goldenVsString)+import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)++tests :: TestTree+tests =+  localOption (NoCreateFile True) $+    testGroup+      "JSON wire encodings"+      [ goldens,+        decoding,+        testGroup "all header JSON forms" (map headerCase headerValues),+        testCase "Queue and UnvalidatedQueue share bytes" $+          assertEqual "same encoding" (encode sampleQueue) (encode (UnvalidatedQueue "orders" fractionalTime False False)),+        testGroup "exact int64 positions" (map integerCase [9007199254740993, maxBound])+      ]++-- | 2026-08-19T12:34:56.123Z: a fractional second, so the golden shows how+-- aeson renders one (trailing zeros trimmed).+fractionalTime :: UTCTime+fractionalTime = UTCTime (fromGregorian 2026 8 19) 45296.123++-- | 2026-08-19T12:35:00Z: no fraction, so the golden shows the plain form.+wholeTime :: UTCTime+wholeTime = UTCTime (fromGregorian 2026 8 19) 45300++sampleQueueName :: QueueName+sampleQueueName = either (error . show) id (parseQueueName "orders")++sampleQueue :: Queue+sampleQueue = Queue sampleQueueName fractionalTime False False++sampleUnvalidatedQueue :: UnvalidatedQueue+sampleUnvalidatedQueue = UnvalidatedQueue "MyQueue" wholeTime True False++sampleMessage :: Message+sampleMessage =+  Message+    { messageId = MessageId 42,+      visibilityTime = fractionalTime,+      enqueuedAt = wholeTime,+      lastReadAt = Nothing,+      readCount = 0,+      body = MessageBody (object ["order_id" .= (7 :: Int)]),+      headers = Nothing+    }++sampleReadMessage :: Message+sampleReadMessage =+  sampleMessage+    { lastReadAt = Just fractionalTime,+      readCount = 3,+      headers = Just (object ["x-pgmq-group" .= ("g1" :: String)])+    }++samplePattern :: TopicPattern+samplePattern = either (error . show) id (parseTopicPattern "orders.*")++goldens :: TestTree+goldens =+  testGroup+    "goldens"+    [ golden "queue" sampleQueue,+      golden "unvalidated_queue" sampleUnvalidatedQueue,+      golden "message_unread" sampleMessage,+      golden "message_read" sampleReadMessage,+      golden "archived_message" (ArchivedMessage sampleReadMessage wholeTime),+      golden "message_null_headers" (sampleMessage {headers = Just Null}),+      golden "archived_message_null_headers" (ArchivedMessage (sampleMessage {headers = Just Null}) wholeTime),+      golden "message_above_safe_integer" (sampleMessage {messageId = MessageId 9007199254740993}),+      golden "message_max_int64" (sampleMessage {messageId = MessageId maxBound}),+      golden "archived_message_above_safe_integer" (ArchivedMessage (sampleMessage {messageId = MessageId 9007199254740993}) wholeTime),+      golden "archived_message_max_int64" (ArchivedMessage (sampleMessage {messageId = MessageId maxBound}) wholeTime),+      golden "topic_binding" (TopicBinding samplePattern "orders" wholeTime "^orders\\.[^.]+$"),+      golden "routing_match" (RoutingMatch samplePattern "orders" "^orders\\.[^.]+$"),+      golden "topic_send_result" (TopicSendResult "orders" (MessageId 42)),+      golden "notify_insert_throttle" (NotifyInsertThrottle "orders" 250 wholeTime)+    ]+  where+    golden name value =+      testGroup+        name+        [ goldenVsString "bytes" ("test/golden/" <> name <> ".json") (pure (encode value <> "\n")),+          testCase "toJSON and toEncoding agree" $+            assertEqual "encoder parity" (Just (toJSON value)) (decode (encode value) :: Maybe Value)+        ]++decoding :: TestTree+decoding =+  testGroup+    "decoding"+    [ testCase "a mixed-case name fails as Queue and succeeds as UnvalidatedQueue" $ do+        let bytes = encode sampleUnvalidatedQueue+        assertBool "Queue must reject MyQueue" (isLeft (eitherDecode bytes :: Either String Queue))+        assertEqual "UnvalidatedQueue accepts it" (Just sampleUnvalidatedQueue) (decode bytes),+      testCase "ArchivedMessage round-trips" $+        assertEqual "archive round-trip" (Just (ArchivedMessage sampleReadMessage wholeTime)) (decode (encode (ArchivedMessage sampleReadMessage wholeTime))),+      testCase "absent optional fields decode in both records" $ do+        let withoutOptional = case toJSON sampleMessage of+              Object o -> Object (KM.delete "headers" (KM.delete "last_read_at" o))+              _ -> error "message encoding must be an object"+            archived = case withoutOptional of+              Object o -> Object (KM.insert "archived_at" (toJSON wholeTime) o)+              _ -> error "message encoding must be an object"+        assertEqual "missing fields normalize" (Just sampleMessage) (decode (encode withoutOptional))+        assertEqual "missing archive fields normalize" (Just (ArchivedMessage sampleMessage wholeTime)) (decode (encode archived)),+      testCase "Queue round-trips" $+        assertEqual "round-trip" (Just sampleQueue) (decode (encode sampleQueue)),+      testCase "Message round-trips with and without optional fields" $ do+        assertEqual "unread" (Just sampleMessage) (decode (encode sampleMessage))+        assertEqual "read" (Just sampleReadMessage) (decode (encode sampleReadMessage)),+      testCase "a missing last_read_at decodes as Nothing" $ do+        let bytes = encode (object ["msg_id" .= (1 :: Int), "read_ct" .= (0 :: Int), "enqueued_at" .= wholeTime, "vt" .= wholeTime, "message" .= Null])+        case decode bytes of+          Just m -> assertEqual "Nothing" Nothing (lastReadAt m)+          Nothing -> assertFailure ("Message did not decode: " <> show (LBS.unpack bytes))+    ]++-- No restriction to object headers: JSON null intentionally normalizes to Nothing.+headerValues :: [(String, Maybe Value)]+headerValues =+  [ ("absent", Nothing),+    ("null", Just Null),+    ("boolean", Just (Bool True)),+    ("number", Just (Number 7.25)),+    ("string", Just (String "trace")),+    ("array", Just (toJSON [Bool True, Null, Number 3])),+    ("object", Just (object ["trace" .= ("abc" :: String)]))+  ]++headerCase :: (String, Maybe Value) -> TestTree+headerCase (label, header) =+  testGroup+    label+    [ goldenVsString "message" ("test/golden/headers_" <> label <> ".json") (pure (encode msg <> "\n")),+      goldenVsString "archive" ("test/golden/archived_headers_" <> label <> ".json") (pure (encode archived <> "\n")),+      testCase "normalization and encoder parity" $ do+        assertEqual "Message normalized" (Just normalized) (decode (encode msg))+        assertEqual "Archive normalized" (Just (ArchivedMessage normalized wholeTime)) (decode (encode archived))+        assertEqual "normalization preserves Message bytes" (encode msg) (encode normalized)+        assertEqual "normalization preserves Archive bytes" (encode archived) (encode (ArchivedMessage normalized wholeTime))+        assertEqual "Message encoder parity" (Just (toJSON msg)) (decode (encode msg) :: Maybe Value)+        assertEqual "Archive encoder parity" (Just (toJSON archived)) (decode (encode archived) :: Maybe Value)+    ]+  where+    msg = sampleMessage {headers = header}+    archived = ArchivedMessage msg wholeTime+    normalized = msg {headers = case header of Just Null -> Nothing; other -> other}++integerCase :: Int64 -> TestTree+integerCase n = testCase (show n) $ do+  let mid = MessageId n+      msg = sampleMessage {messageId = mid}+      archived = ArchivedMessage msg wholeTime+      decimal = LBS8.pack (show n)+  assertEqual "numeric token remains exact" decimal (encode mid)+  assertEqual "MessageId decodes without rounding" (Just mid) (decode decimal)+  assertEqual "Message decodes exact id" (Just mid) (messageId <$> decode (encode msg))+  assertEqual "Archive decodes exact id" (Just mid) (messageId . archivedMessage <$> decode (encode archived))

test/Main.hs view

@@ -1,5 +1,6 @@ module Main (main) where +import JsonGoldenSpec qualified import QueueNameSpec qualified import Test.Tasty (defaultMain, testGroup) @@ -8,5 +9,6 @@   defaultMain $     testGroup       "pgmq-core"-      [ QueueNameSpec.tests+      [ JsonGoldenSpec.tests,+        QueueNameSpec.tests       ]

+ test/golden/archived_headers_absent.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":null,"archived_at":"2026-08-19T12:35:00Z"}

+ test/golden/archived_headers_array.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":[true,null,3],"archived_at":"2026-08-19T12:35:00Z"}

+ test/golden/archived_headers_boolean.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":true,"archived_at":"2026-08-19T12:35:00Z"}

+ test/golden/archived_headers_null.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":null,"archived_at":"2026-08-19T12:35:00Z"}

+ test/golden/archived_headers_number.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":7.25,"archived_at":"2026-08-19T12:35:00Z"}

+ test/golden/archived_headers_object.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":{"trace":"abc"},"archived_at":"2026-08-19T12:35:00Z"}

+ test/golden/archived_headers_string.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":"trace","archived_at":"2026-08-19T12:35:00Z"}

+ test/golden/archived_message.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":3,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":"2026-08-19T12:34:56.123Z","vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":{"x-pgmq-group":"g1"},"archived_at":"2026-08-19T12:35:00Z"}

+ test/golden/archived_message_above_safe_integer.json view

@@ -0,0 +1,1 @@+{"msg_id":9007199254740993,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":null,"archived_at":"2026-08-19T12:35:00Z"}

+ test/golden/archived_message_max_int64.json view

@@ -0,0 +1,1 @@+{"msg_id":9223372036854775807,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":null,"archived_at":"2026-08-19T12:35:00Z"}

+ test/golden/archived_message_null_headers.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":null,"archived_at":"2026-08-19T12:35:00Z"}

+ test/golden/headers_absent.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":null}

+ test/golden/headers_array.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":[true,null,3]}

+ test/golden/headers_boolean.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":true}

+ test/golden/headers_null.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":null}

+ test/golden/headers_number.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":7.25}

+ test/golden/headers_object.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":{"trace":"abc"}}

+ test/golden/headers_string.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":"trace"}

+ test/golden/message_above_safe_integer.json view

@@ -0,0 +1,1 @@+{"msg_id":9007199254740993,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":null}

+ test/golden/message_max_int64.json view

@@ -0,0 +1,1 @@+{"msg_id":9223372036854775807,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":null}

+ test/golden/message_null_headers.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":null}

+ test/golden/message_read.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":3,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":"2026-08-19T12:34:56.123Z","vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":{"x-pgmq-group":"g1"}}

+ test/golden/message_unread.json view

@@ -0,0 +1,1 @@+{"msg_id":42,"read_ct":0,"enqueued_at":"2026-08-19T12:35:00Z","last_read_at":null,"vt":"2026-08-19T12:34:56.123Z","message":{"order_id":7},"headers":null}

+ test/golden/notify_insert_throttle.json view

@@ -0,0 +1,1 @@+{"queue_name":"orders","throttle_interval_ms":250,"last_notified_at":"2026-08-19T12:35:00Z"}

+ test/golden/queue.json view

@@ -0,0 +1,1 @@+{"queue_name":"orders","is_partitioned":false,"is_unlogged":false,"created_at":"2026-08-19T12:34:56.123Z"}

+ test/golden/routing_match.json view

@@ -0,0 +1,1 @@+{"pattern":"orders.*","queue_name":"orders","compiled_regex":"^orders\\.[^.]+$"}

+ test/golden/topic_binding.json view

@@ -0,0 +1,1 @@+{"pattern":"orders.*","queue_name":"orders","bound_at":"2026-08-19T12:35:00Z","compiled_regex":"^orders\\.[^.]+$"}

+ test/golden/topic_send_result.json view

@@ -0,0 +1,1 @@+{"queue_name":"orders","msg_id":42}

+ test/golden/unvalidated_queue.json view

@@ -0,0 +1,1 @@+{"queue_name":"MyQueue","is_partitioned":true,"is_unlogged":false,"created_at":"2026-08-19T12:35:00Z"}