@@ -177,17 +177,17 @@ federationLatencyWindowMs : Int<Ms>
177177federationLatencyWindowMs = 300000 -- 5 minutes; reset latency metrics after this interval
178178
179179-- Snapshot format version (increment on schema changes to prevent corrupt restores)
180−snapshotVersion = 11 -- bumped for Message.priority and ForwardEntry.priority fields
180+snapshotVersion = 12 -- bumped for ForwardEntry.senderKey and federation forward priority
181181
182182-- Server build version: included in /health and /stats responses for deployment verification.
183183-- Update this string when deploying a new build so operators can confirm which version is running.
184−serverBuildVersion = "2026-04-26a"
184+serverBuildVersion = "2026-04-26b"
185185
186186-- Federation protocol version: included in gossip/forward/ack requests.
187187-- Peers log warnings when they receive requests from older versions.
188188-- Backward compatible: older peers ignore unknown fields (Knot's JSON parser
189189-- drops unknown keys). 0 = pre-versioning peer (field missing or unset).
190−federationProtocolVersion = 11
190+federationProtocolVersion = 12
191191
192192-- Snapshot checksum: deterministic hash of entry counts for integrity verification.
193193-- Uses multiplicative hash to distinguish permutations of the same counts
@@ -419,7 +419,10 @@ type Message = {messageId: MessageIdHex, toKey: PubkeyHex, encryptedBlob: BlobHe
419419-- Presence: tracks that a pubkey is online at a given server, with expiry
420420type PresenceEntry = {pubkey: PubkeyHex, server: AnyServerName, expiresAt: Timestamp, timestamp: Timestamp}
421421-- Queued federation forward: message waiting to be delivered to a remote server.
422−type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: Timestamp, toKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, originServer: Text, retries: Int, expiresAt: Timestamp, priority: Int}
422+-- senderKey: pubkey of the authenticated sender (locally-originated only; "" for federation relays).
423+-- Used by fedDeliveryReceipts to generate delivery receipts even if the original message was pruned.
424+-- Pre-v12 snapshots without senderKey default to "" (Knot ignores missing Text fields).
425+type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: Timestamp, toKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, originServer: Text, retries: Int, expiresAt: Timestamp, priority: Int, senderKey: Text}
423426-- Tracks message IDs that were acked by a polling client, pending federation ack back to origin
424427type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName, retries: Int}
425428-- Terminal state: message delivered and ack confirmed (used for dedup after ack overflow)
@@ -1003,7 +1006,7 @@ route FederationApi where
10031006 -- privacy model (the server never learns who sent a message). /messages/cancel for
10041007 -- federated messages requires the client to include sender identity in the encrypted
10051008 -- payload; the server cannot verify sender identity for federation-forwarded messages.
1006− POST {toKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, originServer: ServerName, messageId: MessageIdHex, fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text, expiresAt: Timestamp, protocolVersion: Int} /forward headers {authorization: Text}
1009+ POST {toKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, originServer: ServerName, messageId: MessageIdHex, fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text, expiresAt: Timestamp, priority: Int, protocolVersion: Int} /forward headers {authorization: Text}
10071010 -> {ok: Bool, error: Text}
10081011 = ForwardMessage
10091012 -- Acknowledge delivery of messages back to the origin server
@@ -1023,7 +1026,7 @@ route FederationApi where
10231026 -- Batch forward: forward multiple messages in one request (reduces HTTP round-trips).
10241027 -- Each message is processed independently; partial success is possible.
10251028 -- Results are returned per-message so the sender knows which forwards succeeded.
1026− POST {forwards: [{toKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, originServer: ServerName, messageId: MessageIdHex, expiresAt: Timestamp}], fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text, protocolVersion: Int} /forward-batch headers {authorization: Text}
1029+ POST {forwards: [{toKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, originServer: ServerName, messageId: MessageIdHex, expiresAt: Timestamp, priority: Int}], fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text, protocolVersion: Int} /forward-batch headers {authorization: Text}
10271030 -> {ok: Bool, error: Text, results: [{messageId: MessageIdHex, ok: Bool}]}
10281031 = FederationBatchForward
10291032
@@ -1531,6 +1534,8 @@ isBadServerName = \sn ->
15311534 || containsSuffix ".ec2.internal" sn -- AWS EC2 internal DNS
15321535 || containsSuffix ".amazonaws.com" sn -- AWS service endpoints (S3, SQS, etc.)
15331536 || matchesHostname sn "metadata.google.internal" -- GCP metadata server
1537+ || containsSuffix ".internal.cloudapp.net" sn -- Azure VM internal DNS
1538+ || matchesHostname sn "metadata.azure.com" -- Azure Instance Metadata Service (IMDS v2)
15341539 -- NOTE: Unicode/IDN defense is provided by containsBadUrlChar above, which rejects
15351540 -- any character not in [0-9a-z-.:] via isAllowedServerChar. This blocks homoglyph
15361541 -- attacks (e.g., Greek omicron in "lοcalhost") assuming Knot's Text type preserves
@@ -3880,7 +3885,7 @@ incrementForwardRetries = \messageId toServer toKey -> atomic do
38803885 tfc <- *totalForwardCount
38813886 set *totalForwardCount = max 0 (tfc - 1)
38823887 logWarn ("federation: dropping forward " ++ messageId ++ " to " ++ toServer ++ " after " ++ show maxForwardRetries ++ " retries")
3883− else writeFwdBucket b (do f <- fwdBkt; yield (if f.messageId == messageId && f.toServer == toServer then {messageId: f.messageId, toServer: f.toServer, createdAt: f.createdAt, toKey: f.toKey, encryptedBlob: f.encryptedBlob, timestamp: f.timestamp, originServer: f.originServer, retries: f.retries + 1, expiresAt: f.expiresAt} else f))
3888+ else writeFwdBucket b (do f <- fwdBkt; yield (if f.messageId == messageId && f.toServer == toServer then {messageId: f.messageId, toServer: f.toServer, createdAt: f.createdAt, toKey: f.toKey, encryptedBlob: f.encryptedBlob, timestamp: f.timestamp, originServer: f.originServer, retries: f.retries + 1, expiresAt: f.expiresAt, priority: f.priority, senderKey: f.senderKey} else f))
38843889
38853890-- Retry forwards for a server using batch forward (1 HTTP round-trip per batch of maxBatchSize).
38863891-- Falls back to single forward if the peer returns an HTTP-level error (old peer without batch support).
@@ -3893,7 +3898,7 @@ retryForwardsForServer = \entries remaining ->
38933898 t <- now
38943899 auth <- generateFederationAuth "forward" server
38953900 corrId <- genTokenN 1
3896− let batchPayload = do f <- batch; yield {toKey: f.toKey, encryptedBlob: f.encryptedBlob, timestamp: f.timestamp, originServer: f.originServer, messageId: f.messageId, expiresAt: f.expiresAt}
3901+ let batchPayload = do f <- batch; yield {toKey: f.toKey, encryptedBlob: f.encryptedBlob, timestamp: f.timestamp, originServer: f.originServer, messageId: f.messageId, expiresAt: f.expiresAt, priority: f.priority}
38973902 result <- fetchFederation server (FederationBatchForward {
38983903 forwards: batchPayload, fromServer: serverHostN,
38993904 requestTimestamp: t, authorization: auth, correlationId: corrId, protocolVersion: federationProtocolVersion})
@@ -4632,7 +4637,7 @@ forwardCandidates = \targets messages forwards t ->
46324637 let origin = if m.originServer == "" then serverHostN else m.originServer
46334638 yield {messageId: m.messageId, toServer: target.server, createdAt: t,
46344639 toKey: m.toKey, encryptedBlob: m.encryptedBlob, timestamp: m.timestamp,
4635− originServer: origin, retries: 0, expiresAt: m.expiresAt, priority: m.priority})) [] targets
4640+ originServer: origin, retries: 0, expiresAt: m.expiresAt, priority: m.priority, senderKey: m.senderKey})) [] targets
46364641
46374642
46384643-- Challenge-IP binding rules:
@@ -5041,7 +5046,7 @@ sendMessageCore = \senderKey to encryptedBlob clampedTs effectiveMsgId expiresIn
50415046 let forwardsEnqueued = if federationEnabled && count remoteServers > 0 then do
50425047 let fbi = pubkeyBucket to
50435048 fwdBkt <- readFwdBucket fbi
5044− let newFwds = do s <- remoteServers; where none fwdBkt (\f -> f.messageId == effectiveMsgId && f.toServer == s); yield {messageId: effectiveMsgId, toServer: s, createdAt: t, toKey: to, encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: serverHostN, retries: 0, expiresAt: msgExpiresAt, priority: msgPriority}
5049+ let newFwds = do s <- remoteServers; where none fwdBkt (\f -> f.messageId == effectiveMsgId && f.toServer == s); yield {messageId: effectiveMsgId, toServer: s, createdAt: t, toKey: to, encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: serverHostN, retries: 0, expiresAt: msgExpiresAt, priority: msgPriority, senderKey: senderKey}
50455050 totalFwdCount <- *totalForwardCount
50465051 let globalCap = maxForwardsEntries - totalFwdCount
50475052 -- Per-key cap: prevents one key from consuming disproportionate forward slots
@@ -5065,8 +5070,8 @@ forkSendForwards = \effectiveMsgId to encryptedBlob clampedTs remoteServers ->
50655070 fwdInfo <- atomic do
50665071 fwdBkt <- readFwdBucket (pubkeyBucket to)
50675072 case headOf (do f <- fwdBkt; where f.messageId == effectiveMsgId && f.toServer == server; yield f) of
5068− Nothing {} -> yield {pending: False {}, fwdExpiresAt: 0}
5069− Just {value: fe} -> yield {pending: True {}, fwdExpiresAt: fe.expiresAt}
5073+ Nothing {} -> yield {pending: False {}, fwdExpiresAt: 0, fwdPriority: 0}
5074+ Just {value: fe} -> yield {pending: True {}, fwdExpiresAt: fe.expiresAt, fwdPriority: fe.priority}
50705075 when fwdInfo.pending (do
50715076 fwdT <- now
50725077 fwdAuth <- generateFederationAuth "forward" server
@@ -5076,7 +5081,7 @@ forkSendForwards = \effectiveMsgId to encryptedBlob clampedTs remoteServers ->
50765081 timestamp: clampedTs, originServer: serverHostN, messageId: effectiveMsgId,
50775082 fromServer: serverHostN, requestTimestamp: fwdT,
50785083 authorization: fwdAuth, correlationId: fwdCorrId,
5079− expiresAt: fwdInfo.fwdExpiresAt, protocolVersion: federationProtocolVersion})
5084+ expiresAt: fwdInfo.fwdExpiresAt, priority: fwdInfo.fwdPriority, protocolVersion: federationProtocolVersion})
50805085 case fwdResult of
50815086 Err e -> do
50825087 logWarn ("federation: forward to " ++ server ++ " failed for " ++ effectiveMsgId ++ ": " ++ show e)
@@ -5098,8 +5103,8 @@ sendBatchForwardsSequential = \msgs server ->
50985103 batchFwdInfo <- atomic do
50995104 fwdBkt <- readFwdBucket (pubkeyBucket r.toKey)
51005105 case headOf (do f <- fwdBkt; where f.messageId == r.messageId && f.toServer == server; yield f) of
5101− Nothing {} -> yield {pending: False {}, fwdExpiresAt: 0}
5102− Just {value: fe} -> yield {pending: True {}, fwdExpiresAt: fe.expiresAt}
5106+ Nothing {} -> yield {pending: False {}, fwdExpiresAt: 0, fwdPriority: 0}
5107+ Just {value: fe} -> yield {pending: True {}, fwdExpiresAt: fe.expiresAt, fwdPriority: fe.priority}
51035108 when batchFwdInfo.pending (do
51045109 fwdT <- now
51055110 fwdAuth <- generateFederationAuth "forward" server
@@ -5109,7 +5114,7 @@ sendBatchForwardsSequential = \msgs server ->
51095114 timestamp: r.ts, originServer: serverHostN, messageId: r.messageId,
51105115 fromServer: serverHostN, requestTimestamp: fwdT,
51115116 authorization: fwdAuth, correlationId: fwdCorrId,
5112− expiresAt: batchFwdInfo.fwdExpiresAt, protocolVersion: federationProtocolVersion})
5117+ expiresAt: batchFwdInfo.fwdExpiresAt, priority: batchFwdInfo.fwdPriority, protocolVersion: federationProtocolVersion})
51135118 case fwdResult of
51145119 Err e -> do
51155120 logWarn ("federation: forward to " ++ server ++ " failed for " ++ r.messageId ++ ": " ++ show e)
@@ -5519,7 +5524,7 @@ handleRecvGossip = \events hopsRemaining fromServer requestTimestamp correlation
55195524-- (fromServer != originServer) where an intermediate server re-forwards because
55205525-- the recipient moved. Cascade is bounded by dedup (same messageId won't be stored
55215526-- twice) and forwardCandidates (won't re-forward to the same server).
5522−handleForwardMessage = \toKey encryptedBlob timestamp originServer messageId fromServer requestTimestamp correlationId expiresAt authorization respond -> do
5527+handleForwardMessage = \toKey encryptedBlob timestamp originServer messageId fromServer requestTimestamp correlationId expiresAt priority authorization respond -> do
55235528 t <- now
55245529 let corrId = sanitizeCorrelationId correlationId
55255530 when (corrId != "") (logInfo ("[CORR] " ++ corrId ++ " forward " ++ messageId ++ " from " ++ fromServer))
@@ -5606,9 +5611,10 @@ handleForwardMessage = \toKey encryptedBlob timestamp originServer messageId fro
56065611 -- Use sender-specified TTL if provided and still in the future; clamp to local max.
56075612 -- expiresAt == 0 means pre-v10 peer or unset; fall back to server default.
56085613 let fwdExpiresAt = if expiresAt > 0 && expiresAt > t then min expiresAt (seqTs + unackedMessageMaxAge) else seqTs + unackedMessageMaxAge
5614+ let clampedPriority = clamp 0 maxMessagePriority priority
56095615 writeMessageBucket bkt (union bucket
56105616 [{messageId: messageId, toKey: toKey,
5611− encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs, expiresAt: fwdExpiresAt, senderKey: "", priority: 0}])
5617+ encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs, expiresAt: fwdExpiresAt, senderKey: "", priority: clampedPriority}])
56125618 set *totalMessageCount = totalMsgCount + 1
56135619 writeRcBucket bkt (adjustRecipientCount recipientCounts toKey 1)
56145620 signalMessageForKey toKey seqTs
@@ -5637,7 +5643,9 @@ handleForwardMessage = \toKey encryptedBlob timestamp originServer messageId fro
56375643 _ -> respond {ok: True {}, error: ""}))
56385644
56395645-- Generate sender delivery receipts for messages confirmed delivered via federation ack.
5640−-- Reads the original message from the origin server's mailbox to extract senderKey.
5646+-- Uses senderKey from the ForwardEntry directly (stored since v12), so receipts are
5647+-- generated even if the original message was already pruned from the mailbox.
5648+-- Falls back to message lookup for pre-v12 forward entries where senderKey is "".
56415649-- Per-bucket: only reads message buckets containing the acked recipients.
56425650fedDeliveryReceipts : [Int] -> [ForwardEntry] -> Timestamp -> IO ()
56435651fedDeliveryReceipts = \bucketIds forwards t -> case headOf bucketIds of
@@ -5645,15 +5653,22 @@ fedDeliveryReceipts = \bucketIds forwards t -> case headOf bucketIds of
56455653 Just {value: b} -> do
56465654 let rest = do x <- bucketIds; where x != b; yield x
56475655 let bucketFwds = do f <- forwards; where pubkeyBucket f.toKey == b; yield f
5648− atomic do
5649− msgs <- readMessageBucket b
5650− let deliveries = do f <- bucketFwds; m <- msgs; where m.messageId == f.messageId && m.toKey == f.toKey && m.senderKey != "" && m.originServer == ""; yield {senderKey: m.senderKey, messageId: m.messageId, toKey: m.toKey, deliveredAt: t}
5651− when (count deliveries > 0) (do
5652− sd <- *senderDeliveries
5653− let combined = union sd deliveries
5654− set *senderDeliveries = if count combined > maxSenderDeliveries
5655− then evictOneOldest combined (\d -> d.deliveredAt)
5656− else combined)
5656+ -- Fast path: forward entries with senderKey (v12+) don't need message lookup
5657+ let fromForwards = do f <- bucketFwds; where f.senderKey != ""; yield {senderKey: f.senderKey, messageId: f.messageId, toKey: f.toKey, deliveredAt: t}
5658+ -- Fallback: pre-v12 entries without senderKey — look up the original message
5659+ let needLookup = do f <- bucketFwds; where f.senderKey == ""; yield f
5660+ msgDeliveries <- if count needLookup > 0
5661+ then atomic do
5662+ msgs <- readMessageBucket b
5663+ yield (do f <- needLookup; m <- msgs; where m.messageId == f.messageId && m.toKey == f.toKey && m.senderKey != "" && m.originServer == ""; yield {senderKey: m.senderKey, messageId: m.messageId, toKey: m.toKey, deliveredAt: t})
5664+ else yield []
5665+ let deliveries = union fromForwards msgDeliveries
5666+ when (count deliveries > 0) (atomic do
5667+ sd <- *senderDeliveries
5668+ let combined = union sd deliveries
5669+ set *senderDeliveries = if count combined > maxSenderDeliveries
5670+ then evictOneOldest combined (\d -> d.deliveredAt)
5671+ else combined)
56575672 fedDeliveryReceipts rest forwards t
56585673
56595674-- POST /federation/ack: Peer server confirms delivery of messages we originated.
@@ -5892,9 +5907,10 @@ forwardBatchInner = \entries fromServer t acc ->
58925907 let seqTs = nextSeqTs t seqCounter
58935908 set *seqCounter = seqTs
58945909 let fwdExpiresAt = if entry.expiresAt > 0 && entry.expiresAt > t then min entry.expiresAt (seqTs + unackedMessageMaxAge) else seqTs + unackedMessageMaxAge
5910+ let batchClampedPriority = clamp 0 maxMessagePriority entry.priority
58955911 writeMessageBucket bkt (union bucket
58965912 [{messageId: entry.messageId, toKey: entry.toKey,
5897− encryptedBlob: entry.encryptedBlob, timestamp: clampedTs, originServer: entry.originServer, receivedAt: seqTs, expiresAt: fwdExpiresAt, senderKey: "", priority: 0}])
5913+ encryptedBlob: entry.encryptedBlob, timestamp: clampedTs, originServer: entry.originServer, receivedAt: seqTs, expiresAt: fwdExpiresAt, senderKey: "", priority: batchClampedPriority}])
58985914 set *totalMessageCount = totalMsgCount + 1
58995915 writeRcBucket bkt (adjustRecipientCount recipientCounts entry.toKey 1)
59005916 signalMessageForKey entry.toKey seqTs
@@ -7462,8 +7478,8 @@ serveInner = \req -> case req of
74627478 BatchLookupPresence {pubkeys, authorization, clientIp, respond} -> handleBatchLookupPresence pubkeys authorization clientIp respond
74637479 RecvGossip {events, hopsRemaining, fromServer, requestTimestamp, correlationId, protocolVersion, authorization, respond} -> do
74647480 warnOldProtocol fromServer protocolVersion; handleRecvGossip events hopsRemaining fromServer requestTimestamp correlationId authorization respond
7465− ForwardMessage {toKey, encryptedBlob, timestamp, originServer, messageId, fromServer, requestTimestamp, correlationId, expiresAt, protocolVersion, authorization, respond} -> do
7466− warnOldProtocol fromServer protocolVersion; handleForwardMessage toKey encryptedBlob timestamp originServer messageId fromServer requestTimestamp correlationId expiresAt authorization respond
7481+ ForwardMessage {toKey, encryptedBlob, timestamp, originServer, messageId, fromServer, requestTimestamp, correlationId, expiresAt, priority, protocolVersion, authorization, respond} -> do
7482+ warnOldProtocol fromServer protocolVersion; handleForwardMessage toKey encryptedBlob timestamp originServer messageId fromServer requestTimestamp correlationId expiresAt priority authorization respond
74677483 FederationAck {messageIds, originServer, fromServer, requestTimestamp, correlationId, protocolVersion, authorization, respond} -> do
74687484 warnOldProtocol fromServer protocolVersion; handleFederationAck messageIds originServer fromServer requestTimestamp correlationId authorization respond
74697485 FederationCancel {messageId, toKey, fromServer, requestTimestamp, correlationId, protocolVersion, authorization, respond} -> do
@@ -7655,8 +7671,13 @@ backgroundPrune = do
76557671 -- to clients with pre-jump cursors. Without a generation bump, these messages are
76567672 -- silently skipped until real time catches up to the inflated timestamps.
76577673 when (lp > 0 && t - lp > backgroundPruneInterval * 10) (do
7658− logWarn ("clock forward jump detected — " ++ show (t - lp) ++ "ms since last prune (expected ~" ++ show backgroundPruneInterval ++ "ms), bumping server generation to reset client cursors")
7659− set *serverGeneration = t)
7674+ logWarn ("clock forward jump detected — " ++ show (t - lp) ++ "ms since last prune (expected ~" ++ show backgroundPruneInterval ++ "ms), bumping server generation and resetting seqCounter")
7675+ set *serverGeneration = t
7676+ -- Also reset seqCounter: messages stored during the forward jump window have
7677+ -- inflated receivedAt timestamps from nextSeqTs using the jumped seqCounter.
7678+ -- Without this reset, new messages would continue getting inflated timestamps
7679+ -- until seqCounter is organically surpassed by real time.
7680+ set *seqCounter = t)
76607681 -- Heartbeat watchdog: bump pollWakeup if heartbeat loop appears dead
76617682 sa <- *startedAt
76627683 lastHb <- *lastHeartbeatAt
@@ -7772,25 +7793,33 @@ backgroundSnapshot = do
77727793 lastFp <- *lastSnapshotFingerprint
77737794 let stateChanged = lastFp == 0 || fingerprint != lastFp
77747795 when (hasState && stateChanged && (lastAutoExport == 0 || t - lastAutoExport >= autoSnapshotExportInterval)) (do
7775− -- Split into per-collection reads to reduce contention (auto-export is best-effort;
7776− -- slight inconsistency between collections is acceptable vs. one large atomic block
7777− -- holding all 80+ bucket locks and competing with hot-path operations).
7778− p <- atomic do pp <- readAllPresence; yield pp
7779− a <- atomic do aa <- readAllAcked; yield aa
7780− ao <- atomic do aao <- *ackOverflow; yield aao
7781− d <- atomic do dd <- readAllDelivered; yield dd
7782− ff <- atomic do fff <- *forwardFailures; yield fff
7783− f <- atomic do ff2 <- readAllForwards; yield ff2
7784− fn <- atomic do fnn <- readAllNonces; yield fnn
7785− extraState <- atomic do
7796+ -- Single atomic read for consistent [SNAPSHOT_DATA] output (used for restore).
7797+ -- Previous per-collection reads caused inconsistencies (e.g., ackedIds referencing
7798+ -- messageIds from a different snapshot window). The contention cost is acceptable
7799+ -- since auto-export runs at most once per hour.
7800+ exportSnapshot <- atomic do
7801+ p <- readAllPresence
7802+ a <- readAllAcked
7803+ ao <- *ackOverflow
7804+ d <- readAllDelivered
7805+ ff <- *forwardFailures
7806+ f <- readAllForwards
7807+ fn <- readAllNonces
77867808 bp <- *blockedPeers
77877809 ap <- *allowedPeers
77887810 pac <- *pendingAckCleanups
77897811 se <- *senderExpirations
77907812 sdl <- *senderDeliveries
7791− yield {bp: bp, ap: ap, pac: pac, se: se, sdl: sdl}
7813+ yield {p: p, a: a, ao: ao, d: d, ff: ff, f: f, fn: fn, bp: bp, ap: ap, pac: pac, se: se, sdl: sdl}
7814+ let p = exportSnapshot.p
7815+ let a = exportSnapshot.a
7816+ let ao = exportSnapshot.ao
7817+ let d = exportSnapshot.d
7818+ let ff = exportSnapshot.ff
7819+ let f = exportSnapshot.f
7820+ let fn = exportSnapshot.fn
77927821 let exportCs = snapshotChecksum (count p) (count a) (count d) (count f) (count fn)
7793− let exportData = {version: snapshotVersion, checksum: exportCs, presence: p, ackedIds: a, ackOverflow: ao, deliveredIds: d, forwardFailures: ff, forwards: f, forwardNonces: fn, blockedPeers: extraState.bp, allowedPeers: extraState.ap, pendingAckCleanups: extraState.pac, senderExpirations: extraState.se, senderDeliveries: extraState.sdl}
7822+ let exportData = {version: snapshotVersion, checksum: exportCs, presence: p, ackedIds: a, ackOverflow: ao, deliveredIds: d, forwardFailures: ff, forwards: f, forwardNonces: fn, blockedPeers: exportSnapshot.bp, allowedPeers: exportSnapshot.ap, pendingAckCleanups: exportSnapshot.pac, senderExpirations: exportSnapshot.se, senderDeliveries: exportSnapshot.sdl}
77947823 autoRtSec <- *runtimeMaintenanceSecret
77957824 let autoEffSec = if autoRtSec != "" then autoRtSec else maintenanceSecret
77967825 let autoTag = snapshotIntegrityTag exportCs autoEffSec
@@ -7853,6 +7882,24 @@ backgroundWatchdog = do
78537882 logStaleInFlight hungSlots t)
78547883 backgroundWatchdog
78557884
7885+-- Meta-watchdog: monitors the watchdog itself. The backgroundWatchdog can restart prune
7886+-- and heartbeat loops, but if the watchdog itself panics (e.g., a bug in hung-slot detection),
7887+-- no loop monitors it. This ultra-simple loop just checks lastWatchdogAt freshness and
7888+-- restarts backgroundWatchdog if stale. Runs infrequently (10x watchdog interval) to minimize cost.
7889+-- Cannot restart itself — a panic here surfaces as healthWatchdogMaxAge failure in /health.
7890+backgroundMetaWatchdog = do
7891+ sleep (backgroundPruneInterval * 50)
7892+ t <- now
7893+ sa <- *startedAt
7894+ let warmup = t - sa < backgroundPruneInterval * 60
7895+ if warmup then backgroundMetaWatchdog
7896+ else do
7897+ lastWd <- *lastWatchdogAt
7898+ when (lastWd > 0 && t - lastWd > healthWatchdogMaxAge * 3) (do
7899+ logError "meta-watchdog: watchdog loop appears dead, restarting"
7900+ fork backgroundWatchdog)
7901+ backgroundMetaWatchdog
7902+
78567903-- Startup connectivity probe: send an empty gossip to each known peer and log results.
78577904-- Surfaces DNS, firewall, and TLS issues before the first real gossip cycle.
78587905-- Probes up to 10 peers sequentially (not forked) to avoid overwhelming the network.
@@ -7977,6 +8024,7 @@ main = do
79778024 fork backgroundPrune
79788025 fork pollHeartbeat
79798026 fork backgroundWatchdog
8027+ fork backgroundMetaWatchdog
79808028 when (autoSnapshotInterval > 0) (fork backgroundSnapshot)
79818029 -- Startup peer connectivity check: probe known peers after a short delay
79828030 -- to surface federation misconfigurations immediately (DNS, firewall, TLS).