0902341 · skrepka · git.iko.soy

git.iko.soy/skrepka

Harden server.knot: session lifetime caps, pair rate limiting, deferred ack cleanup, per-bucket reconciliation, and extended monitoring

Security: - Add absolute session lifetime (24h max) to prevent indefinite auth via sliding window - Enforce maximum lifetime alongside expiry in authenticateSession - Add pair rate limiting (sender→recipient) to prevent mailbox flooding - Extend delivery evidence via forward nonces (60-day retention, 100k capacity) - Add auth-tier rate limiting to /auth/revoke endpoint Reliability: - Replace fork+sleep pattern in ack handlers with deferred cleanup queue - Reduce lock contention: per-bucket message reconciliation instead of all-16 - Add background watchdog monitoring prune/heartbeat loop liveness - Prune stale deferred ack cleanups during background cycle Performance: - Optimize forwardQueuedMessages: read only needed presence buckets, not all 16 - Batch nonce eviction (10% when at capacity) to prevent targeted cache-fill attacks - Remove challenge string leak (server identity no longer embedded in challenge) Operations: - Add timestamp anomaly warnings for future/stale messages in sendBatch - Add startup validation: maxSessionLifetime > 0, sessionExpiry ≤ maxSessionLifetime - Include pendingAckCleanups count in background snapshot logs

commit09023415f48fd83fde95a68ec0377ba8b70a6884 authoriko <mail@iko.soy> dateSat 25 Apr 2026, 10:55 (6 months ago) parent53a4c04

1 file changed+149−60

compare with master

unifiedsplit

server.knot+149−60

server.knot+149−60

@@ -92,6 +92,8 @@ authGlobalRateWindowMs = 1000

9292-- Session and gossip timing

9393sessionExpiry : Int<Ms>

9494sessionExpiry = 3600000 -- 1 hour

95+maxSessionLifetime : Int<Ms>

96+maxSessionLifetime = 86400000 -- 24 hours; absolute session lifetime (forces re-auth even if sliding window keeps refreshing)

9597onlineGossipTtl : Int<S>

9698onlineGossipTtl = 3600 -- 1 hour; TTL announced when a key authenticates

9799offlineGossipMinTtl : Int<S>

@@ -195,6 +197,9 @@ unackedMessageMaxAge = 604800000 -- 7 days

195197-- Grace period before federation ack can delete the original message (allows local client to poll)

196198ackGracePeriod : Int<Ms>

197199ackGracePeriod = 30000 -- 30 seconds

200+-- Deferred ack cleanup capacity

201+maxPendingAckCleanups = 10000

202+

198203-- Health check thresholds (background task freshness)

199204healthPruneMaxAge : Int<Ms>

200205healthPruneMaxAge = backgroundPruneInterval * 3

@@ -271,7 +276,7 @@ type Timestamp = Int<Ms>

271276-- Pending challenge for Ed25519 challenge-response auth

272277type Challenge = {pubkey: PubkeyHex, challenge: Text, expiresAt: Timestamp, ip: Text}

273278-- Authenticated session; token is a random hex string

274−type Session = {token: Text, pubkey: PubkeyHex, expiresAt: Timestamp, ip: Text}

279+type Session = {token: Text, pubkey: PubkeyHex, expiresAt: Timestamp, ip: Text, createdAt: Timestamp}

275280-- Stored message; originServer is "" for locally-originated messages, set to sender server for federated forwards

276281type Message = {messageId: MessageIdHex, toKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, originServer: Text, receivedAt: Timestamp}

277282-- Presence: tracks that a pubkey is online at a given server, with expiry

@@ -525,6 +530,10 @@ type BatchResult = {messageId: OptionalMessageId, status: MessageStatus}

525530-- Global federation connection counter (tracks total concurrent outbound connections)

526531*federationActiveConnections : Int

527532

533+-- Deferred ack cleanups: origin message reclamation queued by federation ack handlers,

534+-- processed by the prune cycle after ackGracePeriod elapses (replaces fork+sleep pattern).

535+*pendingAckCleanups : [{messageId: MessageIdHex, toKey: PubkeyHex, cleanupAfter: Timestamp}]

536+

528537-- Monotonic counter bumped on any presence change (gossip, auth, logout, prune, restore, drain)

529538-- Polls compare against this to skip expensive presence lookups when nothing changed.

530539*presenceVersion : Timestamp

@@ -884,7 +893,7 @@ isBadServerName = \sn ->

884893-- Caller passes the appropriate session bucket (sharded by token prefix).

885894authenticateSession : [Session] -> Text -> Timestamp -> AuthResult

886895authenticateSession = \sessions token t ->

887− case headOf (do s <- sessions; where s.expiresAt > t && safeCompare s.token token; yield s) of

896+ case headOf (do s <- sessions; where s.expiresAt > t && t - s.createdAt < maxSessionLifetime && safeCompare s.token token; yield s) of

888897 Nothing {} -> Unauthorized {}

889898 Just {value: s} -> Authorized {pubkey: s.pubkey, ip: s.ip}

890899

@@ -1360,6 +1369,23 @@ pruneMessageBucket = \b messageCutoff -> atomic do

13601369 set *recipientMsgCounts = batchDecrementRecipientCounts rc (countByRecipient removed)

13611370 else yield {}

13621371

1372+-- Per-bucket message reconciliation: reads one bucket per atomic block instead of all 16

1373+-- at once, reducing lock contention during reconciliation. Each pubkey maps to exactly one

1374+-- bucket, so per-bucket recipient counts are disjoint and can be merged without overlap.

1375+reconcileMessageCounts = \b acc ->

1376+ if b > 15 then do

1377+ atomic do

1378+ let total = fold (\a c -> a + c.count) 0 acc

1379+ stored <- *totalMessageCount

1380+ set *totalMessageCount = total

1381+ set *recipientMsgCounts = acc

1382+ yield (total - stored)

1383+ else do

1384+ bucketCounts <- atomic do

1385+ bucket <- readMessageBucket b

1386+ yield (countByRecipient bucket)

1387+ reconcileMessageCounts (b + 1) (union acc bucketCounts)

1388+

13631389-- ============================================

13641390-- Recipient Count Helpers

13651391-- ============================================

@@ -1717,7 +1743,7 @@ pruneExpired = \t -> do

17171743 atomic do

17181744 challenges <- *challenges

17191745 set *challenges = do x <- challenges; where x.expiresAt > t; yield x

1720− transformAllSessionBuckets (\bucket -> do x <- bucket; where x.expiresAt > t; yield x)

1746+ transformAllSessionBuckets (\bucket -> do x <- bucket; where x.expiresAt > t && t - x.createdAt < maxSessionLifetime; yield x)

17211747 sessionCount <- countAllSessions

17221748 set *totalSessionCount = sessionCount

17231749 -- Prune messages across all 16 buckets. Each bucket prune is atomic and adjusts

@@ -1808,6 +1834,9 @@ pruneExpired = \t -> do

18081834 -- Prune gossip event rate entries

18091835 gossipEventRates <- *gossipEventRates

18101836 set *gossipEventRates = do r <- gossipEventRates; where t - r.windowStart < gossipEventRateWindowMs; yield r

1837+ -- Prune stale deferred ack cleanups (older than messageMaxAge are never useful)

1838+ pendingCleanups <- *pendingAckCleanups

1839+ set *pendingAckCleanups = do c <- pendingCleanups; where t - c.cleanupAfter < messageMaxAge; yield c

18111840 -- Reconcile global federation connection counter with actual in-flight state

18121841 -- (self-heals drift from leaked slots where a forked task died without decrementing)

18131842 inFlightRec <- *federationInFlight

@@ -2136,8 +2165,10 @@ retryPendingForwards = \pending -> do

21362165forwardQueuedMessages = \targets t -> do

21372166 newForwards <- atomic do

21382167 forwards <- *forwards

2139− allPresence <- readAllPresence

2140− let localOnline = localOnlineKeys allPresence t

2168+ -- Read only the presence buckets needed for target pubkeys (not all 16)

2169+ let targetPresenceBuckets = uniqueBucketsFor targets (\target -> target.pubkey)

2170+ relevantPresence <- readSelectedPresenceBuckets targetPresenceBuckets

2171+ let localOnline = localOnlineKeys relevantPresence t

21412172 let remoteTargets = remoteOnlyTargets targets localOnline

21422173 -- Read only the message buckets containing target pubkeys (not all 16)

21432174 let neededBuckets = uniqueBucketsFor remoteTargets (\target -> target.pubkey)

@@ -2343,16 +2374,10 @@ pruneAndRetry = \t -> do

23432374 yield (actual - stored)

23442375 when (presDrift != 0 || sessDrift != 0)

23452376 (logInfo ("reconciliation: corrected drift — presence: " ++ show presDrift ++ ", sessions: " ++ show sessDrift))

2346− -- Message reconciliation is expensive (reads all 16 buckets + rebuilds recipient counts), keep periodic

2377+ -- Message reconciliation: per-bucket reads reduce lock contention vs reading all 16 at once

23472378 pc <- *pruneCount

23482379 when (pc > 0 && pc - (pc / reconciliationFrequency) * reconciliationFrequency == 0) (do

2349− msgDrift <- atomic do

2350− allMsgs <- readAllMessages

2351− let actual = count allMsgs

2352− stored <- *totalMessageCount

2353− set *totalMessageCount = actual

2354− set *recipientMsgCounts = countByRecipient allMsgs

2355− yield (actual - stored)

2380+ msgDrift <- reconcileMessageCounts 0 []

23562381 when (msgDrift != 0)

23572382 (logInfo ("reconciliation: corrected message drift: " ++ show msgDrift)))

23582383 pendingForwards <- atomic do f <- *forwards; yield f

@@ -2390,6 +2415,15 @@ pruneAndRetry = \t -> do

23902415 set *federationLatencyCount = 0

23912416 set *federationLatencyMax = 0

23922417 set *federationLatencyResetAt = t)

2418+ -- Process deferred ack cleanups: reclaim origin messages whose grace period has elapsed.

2419+ -- These were queued by handleFederationAck instead of fork+sleep.

2420+ readyCleanups <- atomic do

2421+ cleanups <- *pendingAckCleanups

2422+ let ready = do c <- cleanups; where t >= c.cleanupAfter; yield c

2423+ let remaining = do c <- cleanups; where t < c.cleanupAfter; yield c

2424+ set *pendingAckCleanups = remaining

2425+ yield ready

2426+ when (count readyCleanups > 0) (ackCleanupForwards readyCleanups t)

23932427 let result = {pendingForwards: pendingForwards, pendingAcks: ackState.pendingAcks, pendingOverflow: ackState.pendingOverflow, extendedActive: refreshResult.extendedActive, nearExpiryActive: refreshResult.nearExpiryActive, refreshPeers: refreshResult.refreshPeers, shouldRefresh: refreshResult.shouldRefresh}

23942428 -- Fork federation I/O so hung peers don't block next prune cycle

23952429 fork (do

@@ -2515,7 +2549,7 @@ pollOnce = \token cursor clientIp -> do

25152549 then yield (Nothing {})

25162550 else do

25172551 -- Refresh session expiry (sliding window keeps active sessions alive)

2518− writeSessionBucket bucket (do s <- sessions; yield (if safeCompare s.token token then {token: s.token, pubkey: s.pubkey, expiresAt: t + sessionExpiry, ip: s.ip} else s))

2552+ writeSessionBucket bucket (do s <- sessions; yield (if safeCompare s.token token then {token: s.token, pubkey: s.pubkey, expiresAt: t + sessionExpiry, ip: s.ip, createdAt: s.createdAt} else s))

25192553 seqCounter <- *seqCounter

25202554 let clampedCursor = clamp 0 (max seqCounter t) cursor

25212555 ackResult <- if clampedCursor > 0

@@ -2712,8 +2746,7 @@ handleChallenge = \pubkey clientIp respond -> do

27122746 authLimited <- checkAuthGlobalRate t

27132747 if authLimited then yield (respond {challenge: "", ok: False {}, expiresAt: 0})

27142748 else do

2715− rawChallenge <- genToken

2716− let challenge = serverHostN ++ ":" ++ rawChallenge

2749+ challenge <- genToken

27172750 result <- atomic do

27182751 challenges <- *challenges

27192752 let active = do c <- challenges; where c.expiresAt > t; yield c

@@ -2804,7 +2837,7 @@ verifyAuthInner = \pubkey challenge signature revokeOthers clientIp respond t ->

28042837 -- Count per-key sessions without materializing all sessions (O(sessions) but no union)

28052838 sessionsForKey <- countSessionsForKey pubkey

28062839 tsc <- *totalSessionCount

2807− let newSession = {token: token, pubkey: pubkey, expiresAt: expiry, ip: clientIp}

2840+ let newSession = {token: token, pubkey: pubkey, expiresAt: expiry, ip: clientIp, createdAt: t}

28082841 -- Update presence: replace local entry for this pubkey, evict oldest if over capacity

28092842 let pb = pubkeyBucket pubkey

28102843 presenceBkt <- readPresenceBucket pb

@@ -3101,7 +3134,13 @@ handleMessageStatus = \to messageId authorization clientIp respond -> do

31013134 let inAcked = hasMessage messageId to ackedIds

31023135 let inDelivered = hasMessage messageId to deliveredIds

31033136 if inAcked || inDelivered then yield "delivered"

3104− else yield "unknown"

3137+ else do

3138+ -- Extended check: forward nonces have 60-day retention (2x message lifetime)

3139+ -- and 100k capacity, providing delivery evidence after ackedIds/deliveredIds are pruned

3140+ forwardNonces <- *forwardNonces

3141+ let inNonces = any forwardNonces (\n -> n.messageId == messageId && n.toKey == to)

3142+ if inNonces then yield "delivered"

3143+ else yield "unknown"

31053144 yield (respond {status: result, authorized: True {}}))

31063145

31073146-- POST /auth/revoke: Revoke a specific session token.

@@ -3115,6 +3154,9 @@ handleRevoke = \targetToken authorization clientIp respond -> do

31153154 withSessionAuth authorization t clientIp

31163155 (yield (respond {ok: False {}, authorized: False {}}))

31173156 (\callerPubkey -> do

3157+ authLimited <- checkAuthGlobalRate t

3158+ if authLimited then yield (respond {ok: False {}, authorized: True {}})

3159+ else do

31183160 revokeLimited <- atomic do

31193161 challengeRates <- *challengeRates

31203162 let rateResult = checkRateWindow challengeRates (\r -> r.pubkey == callerPubkey)

@@ -3397,7 +3439,9 @@ handleForwardMessage = \toKey encryptedBlob timestamp originServer messageId fro

33973439 -- Record forward nonce for replay protection beyond message/ack dedup lifetime

33983440 fwdNonces <- *forwardNonces

33993441 let updatedNonces = union fwdNonces [{messageId: messageId, toKey: toKey, originServer: originServer, seenAt: t}]

3400− set *forwardNonces = if count updatedNonces > maxForwardNonces then evictOneOldest updatedNonces (\n -> n.seenAt) else updatedNonces

3442+ -- Batch-evict 10% when at capacity to create a buffer; makes it harder

3443+ -- for an attacker to force-evict specific nonces via targeted flooding.

3444+ set *forwardNonces = if count updatedNonces > maxForwardNonces then (evictSmallest updatedNonces (maxForwardNonces / 10) (\n -> n.seenAt)).kept else updatedNonces

34013445 yield {forward: ForwardStored {}, globalCapReached: False {}, recvRateLimited: False {}}

34023446 case result.forward of

34033447 ForwardRejected {} ->

@@ -3425,15 +3469,14 @@ handleFederationAck = \messageIds originServer fromServer requestTimestamp autho

34253469 let removed = do f <- forwards; where f.toServer == fromServer && any dedupedIds (\mid -> f.messageId == mid); yield f

34263470 set *forwards = forwardsExcluding forwards fromServer dedupedIds

34273471 yield removed

3428− -- Best-effort origin message cleanup (forked to avoid slowing the ack response).

3429− -- Reclaims messages past the ack grace period when the recipient has no local

3430− -- presence and no other pending forwards remain. Without this, confirmed-delivered

3431− -- messages sit for up to unackedMessageMaxAge (7 days).

3432− when (count removedForwards > 0) (fork (do

3433− sleep ackGracePeriod

3434− t2 <- now

3435− -- Batched by message bucket: entries for the same bucket share one atomic block.

3436− ackCleanupForwards removedForwards t2))

3472+ -- Deferred origin message cleanup: queue for processing in the next prune cycle

3473+ -- after ackGracePeriod elapses. Replaces fork+sleep which accumulated sleeping

3474+ -- goroutines under high federation ack volume.

3475+ when (count removedForwards > 0) (atomic do

3476+ cleanups <- *pendingAckCleanups

3477+ let newCleanups = do f <- removedForwards; yield {messageId: f.messageId, toKey: f.toKey, cleanupAfter: t + ackGracePeriod}

3478+ let combined = union cleanups newCleanups

3479+ set *pendingAckCleanups = if count combined > maxPendingAckCleanups then takeRelation maxPendingAckCleanups combined else combined)

34373480 yield (respond {ok: True {}, error: ""}))

34383481

34393482-- POST /maintenance/drain: Broadcast offline gossip for all local keys (graceful shutdown).

@@ -3833,6 +3876,11 @@ sendBatchInner = \senderKey messages t acc ->

38333876 Nothing {} -> yield acc

38343877 Just {value: msg} -> do

38353878 effectiveMsgId <- if msg.messageId != "" then yield msg.messageId else genToken

3879+ -- Log timestamp anomalies (matching handleSendMessage warnings)

3880+ when (msg.timestamp > t + clockSkewTolerance)

3881+ (logWarn ("sendBatch: future timestamp detected (+" ++ show (msg.timestamp - t) ++ "ms ahead) for " ++ effectiveMsgId))

3882+ when (msg.timestamp < t - messageMaxAge / 2 && t - msg.timestamp <= messageMaxAge)

3883+ (logWarn ("sendBatch: stale timestamp (" ++ show ((t - msg.timestamp) / 86400000) ++ " days old) for " ++ effectiveMsgId))

38363884 result <- if t - msg.timestamp > messageMaxAge

38373885 then yield {messageId: "", status: MsRejected {}, needsForward: False {}, forwardServer: "", toKey: "", blob: "", ts: 0}

38383886 else if senderKey == msg.to

@@ -3866,36 +3914,50 @@ sendBatchInner = \senderKey messages t acc ->

38663914 if recvResult.limited then yield {status: MsRateLimited {}, fwdServer: "", needsFwd: False {}}

38673915 else do

38683916 set *recvRates = recvResult.entries

3869− totalMsgCount <- *totalMessageCount

3870− if totalMsgCount >= maxMessages then yield {status: MsRejected {}, fwdServer: "", needsFwd: False {}}

3917+ -- Per-sender-per-recipient pair rate limiting (prevents one sender filling a recipient's mailbox)

3918+ pairRates <- *pairRates

3919+ let pairResult = checkRateWindow pairRates (\r -> r.sender == senderKey && r.recipient == msg.to)

3920+ (\ts -> {sender: senderKey, recipient: msg.to, windowStart: ts, count: 1})

3921+ (\r -> {sender: r.sender, recipient: r.recipient, windowStart: r.windowStart, count: r.count + 1})

3922+ maxPairRatePerPair pairRateWindowMs maxPairRateEntries t

3923+ if pairResult.limited then yield {status: MsRateLimited {}, fwdServer: "", needsFwd: False {}}

38713924 else do

3872− recipientCounts <- *recipientMsgCounts

3873− let recipientCount = getRecipientCount msg.to recipientCounts

3874− if recipientCount >= maxMessagesPerRecipient then yield {status: MsRejected {}, fwdServer: "", needsFwd: False {}}

3925+ set *pairRates = pairResult.entries

3926+ totalMsgCount <- *totalMessageCount

3927+ if totalMsgCount >= maxMessages then yield {status: MsRejected {}, fwdServer: "", needsFwd: False {}}

38753928 else do

3876− recipientPresence <- readPresenceBucket (pubkeyBucket msg.to)

3877− seqCounter <- *seqCounter

3878− let seqTs = nextSeqTs t seqCounter

3879− set *seqCounter = seqTs

3880− writeMessageBucket msgBucket (union bucket

3881− [{messageId: effectiveMsgId, toKey: msg.to,

3882− encryptedBlob: msg.encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: seqTs}])

3883− set *totalMessageCount = totalMsgCount + 1

3884− set *recipientMsgCounts = adjustRecipientCount recipientCounts msg.to 1

3885− signalMessageForKey msg.to seqTs

3886− let toPresence = presenceForKey recipientPresence msg.to t

3887− let localOnline = hasLocalPresence toPresence

3888− let remoteServers = collectPeerServers toPresence (\p -> p.server)

3889− let fwdServer = case headOf remoteServers of Nothing {} -> ""; Just {value: s} -> s

3890− when (federationEnabled && count remoteServers > 0) (do

3891− forwards <- *forwards

3892− let newFwds = do s <- remoteServers; where none forwards (\f -> f.messageId == effectiveMsgId && f.toServer == s); yield {messageId: effectiveMsgId, toServer: s, createdAt: t, toKey: msg.to, encryptedBlob: msg.encryptedBlob, timestamp: clampedTs, originServer: serverHostN, retries: 0}

3893− let cappedFwds = takeRelation (maxForwardsEntries - count forwards) newFwds

3894− set *forwards = union forwards cappedFwds)

3895− let delivery = if localOnline then MsDelivered {}

3896− else if federationEnabled && count remoteServers > 0 then MsFederated {}

3897− else MsQueued {}

3898− yield {status: delivery, fwdServer: fwdServer, needsFwd: federationEnabled && count remoteServers > 0}

3929+ recipientCounts <- *recipientMsgCounts

3930+ let recipientCount = getRecipientCount msg.to recipientCounts

3931+ if recipientCount >= maxMessagesPerRecipient then yield {status: MsRejected {}, fwdServer: "", needsFwd: False {}}

3932+ else do

3933+ recipientPresence <- readPresenceBucket (pubkeyBucket msg.to)

3934+ seqCounter <- *seqCounter

3935+ let seqTs = nextSeqTs t seqCounter

3936+ set *seqCounter = seqTs

3937+ writeMessageBucket msgBucket (union bucket

3938+ [{messageId: effectiveMsgId, toKey: msg.to,

3939+ encryptedBlob: msg.encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: seqTs}])

3940+ set *totalMessageCount = totalMsgCount + 1

3941+ set *recipientMsgCounts = adjustRecipientCount recipientCounts msg.to 1

3942+ signalMessageForKey msg.to seqTs

3943+ let toPresence = presenceForKey recipientPresence msg.to t

3944+ let localOnline = hasLocalPresence toPresence

3945+ let remoteServers = collectPeerServers toPresence (\p -> p.server)

3946+ let fwdServer = case headOf remoteServers of Nothing {} -> ""; Just {value: s} -> s

3947+ when (federationEnabled && count remoteServers > 0) (do

3948+ forwards <- *forwards

3949+ let newFwds = do s <- remoteServers; where none forwards (\f -> f.messageId == effectiveMsgId && f.toServer == s); yield {messageId: effectiveMsgId, toServer: s, createdAt: t, toKey: msg.to, encryptedBlob: msg.encryptedBlob, timestamp: clampedTs, originServer: serverHostN, retries: 0}

3950+ let cappedFwds = takeRelation (maxForwardsEntries - count forwards) newFwds

3951+ set *forwards = union forwards cappedFwds)

3952+ let delivery = if localOnline then MsDelivered {}

3953+ else if federationEnabled && count remoteServers > 0 then MsFederated {}

3954+ else MsQueued {}

3955+ yield {status: delivery, fwdServer: fwdServer, needsFwd: federationEnabled && count remoteServers > 0}

3956+ -- Log rate limiting and capacity warnings (matching handleSendMessage)

3957+ case sendResult.status of

3958+ MsRateLimited {} -> logWarn ("sendBatch: rate limited for " ++ effectiveMsgId)

3959+ MsRejected {} -> logWarn ("sendBatch: rejected for " ++ effectiveMsgId ++ " (capacity or mailbox full)")

3960+ _ -> yield {}

38993961 yield {messageId: effectiveMsgId, status: sendResult.status, needsForward: sendResult.needsFwd, forwardServer: sendResult.fwdServer, toKey: msg.to, blob: msg.encryptedBlob, ts: clampedTs}

39003962 sendBatchInner senderKey split.rest t (union acc [result])

39013963

@@ -4028,8 +4090,9 @@ backgroundSnapshot = do

40284090 ao <- *ackOverflow

40294091 d <- *deliveredIds

40304092 ff <- *forwardFailures

4031− yield {messages: tmc, sessions: sc, presence: pc, forwards: count f, ackedIds: count a, ackOverflow: count ao, deliveredIds: count d, forwardFailures: count ff}

4032− logInfo ("snapshot: messages=" ++ show result.messages ++ " sessions=" ++ show result.sessions ++ " presence=" ++ show result.presence ++ " forwards=" ++ show result.forwards ++ " ackedIds=" ++ show result.ackedIds ++ " ackOverflow=" ++ show result.ackOverflow ++ " deliveredIds=" ++ show result.deliveredIds ++ " forwardFailures=" ++ show result.forwardFailures)

4093+ pac <- *pendingAckCleanups

4094+ yield {messages: tmc, sessions: sc, presence: pc, forwards: count f, ackedIds: count a, ackOverflow: count ao, deliveredIds: count d, forwardFailures: count ff, pendingAckCleanups: count pac}

4095+ logInfo ("snapshot: messages=" ++ show result.messages ++ " sessions=" ++ show result.sessions ++ " presence=" ++ show result.presence ++ " forwards=" ++ show result.forwards ++ " ackedIds=" ++ show result.ackedIds ++ " ackOverflow=" ++ show result.ackOverflow ++ " deliveredIds=" ++ show result.deliveredIds ++ " forwardFailures=" ++ show result.forwardFailures ++ " pendingAckCleanups=" ++ show result.pendingAckCleanups)

40334096 -- Warn if federation state hasn't been exported recently (will be lost on restart)

40344097 t <- now

40354098 lastExport <- *lastSnapshotExportAt

@@ -4042,10 +4105,34 @@ backgroundSnapshot = do

40424105 else yield {}

40434106 backgroundSnapshot

40444107

4108+-- Background watchdog: monitors prune and heartbeat loops, restarts if they appear dead.

4109+-- Knot lacks try/catch, so panicked loops can't self-recover. This watchdog detects

4110+-- liveness by checking counter freshness and forks a new loop instance as needed.

4111+backgroundWatchdog = do

4112+ sleep (backgroundPruneInterval * 5)

4113+ t <- now

4114+ sa <- *startedAt

4115+ let warmup = t - sa < backgroundPruneInterval * 10

4116+ if warmup then backgroundWatchdog

4117+ else do

4118+ -- Check prune loop health

4119+ lastPrune <- *lastPrunedAt

4120+ when (t - lastPrune > healthPruneMaxAge * 3) (do

4121+ logError "watchdog: prune loop appears dead, restarting"

4122+ atomic do set *pruneRunning = 0

4123+ fork backgroundPrune)

4124+ -- Check heartbeat loop health

4125+ lastHb <- *lastHeartbeatAt

4126+ when (t - lastHb > healthHeartbeatMaxAge * 3) (do

4127+ logError "watchdog: heartbeat loop appears dead, restarting"

4128+ fork pollHeartbeat)

4129+ backgroundWatchdog

4130+

40454131main = do

40464132 let configOk = maxMessages > 0 && maxMessagesPerRecipient > 0 && maxPresenceEntries > 0

40474133 && maxSessions > 0 && maxChallenges > 0 && backgroundPruneInterval > 0

40484134 && pollTimeoutMs > 0 && challengeExpiry > 0 && sessionExpiry > 0

4135+ && maxSessionLifetime > 0

40494136 && maxPresenceTtl > 0 && maxForwardsEntries > 0 && maxAckedIds > 0

40504137 && maxForwardRetries > 0 && maxGossipHops > 0 && maxPollsPerKey > 0

40514138 && gossipOriginHops > 0 && maxThirdPartyGossipHops > 0

@@ -4059,6 +4146,7 @@ main = do

40594146 -- (e.g., messages pruned before their stated max age, backoff that never increases)

40604147 let configRelationsOk = unackedMessageMaxAge <= messageMaxAge

40614148 && challengeExpiry < sessionExpiry

4149+ && sessionExpiry <= maxSessionLifetime

40624150 && retryBackoffBase <= retryBackoffMax

40634151 && backgroundPruneInterval < healthPruneMaxAge

40644152 && ackGracePeriod < unackedMessageMaxAge

@@ -4080,7 +4168,7 @@ main = do

40804168 if not configOk

40814169 then logError "FATAL: invalid configuration — capacity limits and intervals must be > 0, server not started"

40824170 else if not configRelationsOk

4083− then logError "FATAL: invalid configuration — relationship invariants violated (check: unackedMessageMaxAge <= messageMaxAge, challengeExpiry < sessionExpiry, retryBackoffBase <= retryBackoffMax, backgroundPruneInterval < healthPruneMaxAge, pollTimeoutMs < sessionExpiry, gossipDedupWindow < presenceRefreshInterval, federationFetchTimeoutMs <= backgroundPruneInterval, maxAckOverflow <= maxAckedIds, gossipOriginHops <= maxGossipHops, maxThirdPartyGossipHops <= maxGossipHops, verificationTokenExpiry <= federationFetchTimeoutMs, forwardNonceRetention >= messageMaxAge, maxGlobalFederationConcurrency >= maxFederationConcurrency, maxGossipEventsPerServer > maxGossipEvents, per-key limits <= global limits), server not started"

4171+ then logError "FATAL: invalid configuration — relationship invariants violated (check: unackedMessageMaxAge <= messageMaxAge, challengeExpiry < sessionExpiry, sessionExpiry <= maxSessionLifetime, retryBackoffBase <= retryBackoffMax, backgroundPruneInterval < healthPruneMaxAge, pollTimeoutMs < sessionExpiry, gossipDedupWindow < presenceRefreshInterval, federationFetchTimeoutMs <= backgroundPruneInterval, maxAckOverflow <= maxAckedIds, gossipOriginHops <= maxGossipHops, maxThirdPartyGossipHops <= maxGossipHops, verificationTokenExpiry <= federationFetchTimeoutMs, forwardNonceRetention >= messageMaxAge, maxGlobalFederationConcurrency >= maxFederationConcurrency, maxGossipEventsPerServer > maxGossipEvents, per-key limits <= global limits), server not started"

40844172 else do

40854173 t <- now

40864174 atomic do

@@ -4099,7 +4187,7 @@ main = do

40994187 logInfo (" max sessions: " ++ show maxSessions ++ " (per key: " ++ show maxSessionsPerKey ++ ")")

41004188 logInfo (" max presence: " ++ show maxPresenceEntries)

41014189 logInfo (" max forwards: " ++ show maxForwardsEntries)

4102− logInfo (" session expiry: " ++ show sessionExpiry ++ "ms")

4190+ logInfo (" session expiry: " ++ show sessionExpiry ++ "ms (max lifetime: " ++ show maxSessionLifetime ++ "ms)")

41034191 logInfo (" message max age: " ++ show messageMaxAge ++ "ms")

41044192 logInfo (" global rate limit: " ++ show maxGlobalRequestRate ++ "/" ++ show globalRateWindowMs ++ "ms")

41054193 logInfo (" auth rate limit: " ++ show maxAuthGlobalRate ++ "/" ++ show authGlobalRateWindowMs ++ "ms")

@@ -4114,5 +4202,6 @@ main = do

41144202 (logInfo (" auto-snapshot: " ++ show autoSnapshotInterval ++ "ms"))

41154203 fork backgroundPrune

41164204 fork pollHeartbeat

4205+ fork backgroundWatchdog

41174206 when (autoSnapshotInterval > 0) (fork backgroundSnapshot)

41184207 listen 8080 serve