@@ -400,7 +400,7 @@ route HealthApi where
400400-- Returns counts of in-memory collections (requires federation or maintenance secret)
401401route StatsApi where
402402 GET /stats headers {authorization: Text}
403− -> {sessions: Int, sessionsMax: Int, messages: Int, messagesMax: Int, presence: Int, presenceMax: Int, forwards: Int, forwardsMax: Int, challenges: Int, challengesMax: Int, ackedIds: Int, ackedIdsMax: Int, ackOverflow: Int, ackOverflowMax: Int, deliveredIds: Int, deliveredIdsMax: Int, forwardFailures: Int, activePolls: Int, activePollsMax: Int, sendRates: Int, challengeRates: Int, federationRates: Int, globalRateCount: Int, ipRates: Int, lookupRates: Int, recvRates: Int, pruneCount: Int, heartbeatCount: Int, uptime: Int, lastPruneAt: Timestamp, lastHeartbeatAt: Timestamp, ok: Bool}
403+ -> {sessions: Int, sessionsMax: Int, messages: Int, messagesMax: Int, presence: Int, presenceMax: Int, forwards: Int, forwardsMax: Int, challenges: Int, challengesMax: Int, ackedIds: Int, ackedIdsMax: Int, ackOverflow: Int, ackOverflowMax: Int, deliveredIds: Int, deliveredIdsMax: Int, forwardFailures: Int, activePolls: Int, activePollsMax: Int, sendRates: Int, challengeRates: Int, federationRates: Int, globalRateCount: Int, ipRates: Int, lookupRates: Int, recvRates: Int, pruneCount: Int, heartbeatCount: Int, uptime: Int, lastPruneAt: Timestamp, lastHeartbeatAt: Timestamp, draining: Bool, federationEnabled: Bool, recentGossip: Int, totalMessageCount: Int, ok: Bool}
404404 = Stats
405405 GET /stats/peers headers {authorization: Text}
406406 -> {peers: [PeerStatus], ok: Bool}
@@ -635,9 +635,12 @@ isBadServerName = \sn ->
635635 || containsSuffix ".arpa" sn
636636
637637-- Look up a non-expired session matching the given token (constant-time comparison)
638+-- Pre-filter by token prefix to skip ~15/16 of sessions before expensive safeCompare.
639+-- Prefix match is not constant-time but only leaks approximate session count (already in /stats).
638640authenticateSession : [Session] -> Text -> Timestamp -> AuthResult
639641authenticateSession = \sessions token t ->
640− case headOf (do s <- sessions; where s.expiresAt > t && safeCompare s.token token; yield s) of
642+ let prefix = take 1 token in
643+ case headOf (do s <- sessions; where take 1 s.token == prefix && s.expiresAt > t && safeCompare s.token token; yield s) of
641644 Nothing {} -> Unauthorized {}
642645 Just {value: s} -> Authorized {pubkey: s.pubkey}
643646
@@ -674,6 +677,13 @@ verifyFederationAuthForServer = \fromServer authorization ->
674677verifyMaintenanceAuth : Text -> Bool
675678verifyMaintenanceAuth = verifyAuthWith (\token -> verifySecret token federationSecret || verifySecret token maintenanceSecret)
676679
680+-- Outbound federation auth: use per-peer secret if configured, otherwise global
681+federationAuthForServer : Text -> Text
682+federationAuthForServer = \server ->
683+ case headOf (do p <- federationPeerSecrets; where normalizeServerName p.server == server; yield p) of
684+ Just {value: p} -> "Bearer " ++ p.secret
685+ Nothing {} -> federationAuth
686+
677687clampTtl : Int<S> -> Int<S>
678688clampTtl = clamp 1 maxPresenceTtl
679689
@@ -697,10 +707,9 @@ nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
697707dedupMessageIds : [MessageIdHex] -> [MessageIdHex]
698708dedupMessageIds = \messageIds ->
699709 let capped = takeRelation maxMessageIds messageIds in
700− let result = fold (\acc mid ->
701− if any acc.items (\a -> a == mid) then acc
702− else {n: acc.n + 1, items: union acc.items [mid]}) {n: 0, items: []} capped
703− in result.items
710+ fold (\acc mid ->
711+ if any acc (\a -> a == mid) then acc
712+ else union acc [mid]) [] capped
704713
705714
706715-- Constant-time string comparison to prevent timing side-channels.
@@ -717,12 +726,10 @@ safeCompareLoop = \s1 s2 n result ->
717726
718727safeCompare : Text -> Text -> Bool
719728safeCompare = \a b ->
720− if a == "" || b == "" then False {}
721− else
722− let lenA = count (chars a) in
723− let lenB = count (chars b) in
724− let lenDiff = if lenA == lenB then 0 else 1 in
725− safeCompareLoop a b maxTokenLen 0 + lenDiff == 0
729+ let lenA = count (chars a) in
730+ let lenB = count (chars b) in
731+ let lenDiff = if lenA == lenB && lenA > 0 then 0 else 1 in
732+ safeCompareLoop a b maxTokenLen 0 + lenDiff == 0
726733
727734-- Generic sliding-window rate limiter. Returns whether the request is rate-limited
728735-- and the updated entries list. Callers provide match/create/update functions for their entry type.
@@ -845,17 +852,13 @@ capGossipPresence = \args ->
845852 (do e <- reclaimedEntries; yield (pubkeyServer e)),
846853 withinCapacity: False {}}
847854
848−countMessagesFor : [Message] -> PubkeyHex -> Timestamp -> Int
849−countMessagesFor = \messages toKey t ->
850− count (do m <- messages; where m.toKey == toKey && m.receivedAt >= t - messageMaxAge; yield m)
851−
852−-- Count total messages and messages for a specific key in a single pass (avoids two O(n) scans)
853−messageCounts : [Message] -> PubkeyHex -> Timestamp -> {total: Int, forKey: Int}
854−messageCounts = \messages toKey t ->
855+-- Single-pass dedup + per-recipient count over messages (avoids two O(n) scans in send/forward)
856+checkMessageStore : [Message] -> Text -> PubkeyHex -> Timestamp -> {isDup: Bool, recipientCount: Int}
857+checkMessageStore = \messages messageId toKey t ->
855858 fold (\acc m ->
856− {total: acc.total + 1,
857− forKey: if m.toKey == toKey && m.receivedAt >= t - messageMaxAge then acc.forKey + 1 else acc.forKey}
858− ) {total: 0, forKey: 0} messages
859+ {isDup: acc.isDup || (messageId != "" && m.messageId == messageId && m.toKey == toKey),
860+ recipientCount: if m.toKey == toKey && m.receivedAt >= t - messageMaxAge then acc.recipientCount + 1 else acc.recipientCount}
861+ ) {isDup: False {}, recipientCount: 0} messages
859862
860863hasMessage : MessageIdHex -> PubkeyHex -> [{messageId: MessageIdHex, toKey: PubkeyHex | a}] -> Bool
861864hasMessage = \mid toKey items -> any items (\x -> x.messageId == mid && x.toKey == toKey)
@@ -972,7 +975,7 @@ sendBatchedGossipToServer : ServerName -> [GossipEvent] -> Int -> IO {network} {
972975sendBatchedGossipToServer = \server allEvents hops ->
973976 forEachBatch allEvents maxGossipEvents (\batch -> do
974977 result <- fetch (federationUrl server) (RecvGossip {
975− authorization: federationAuth,
978+ authorization: federationAuthForServer server,
976979 events: batch, hopsRemaining: hops, fromServer: serverHostN})
977980 case result of
978981 Err e -> println ("federation: gossip to " ++ server ++ " failed: " ++ show e)
@@ -1132,7 +1135,7 @@ retryForwardsForServer = \entries remaining ->
11321135 result <- fetch (federationUrl f.toServer) (ForwardMessage {
11331136 toKey: f.toKey, encryptedBlob: f.encryptedBlob,
11341137 timestamp: f.timestamp, originServer: serverHostN, messageId: f.messageId,
1135− fromServer: serverHostN, authorization: federationAuth})
1138+ fromServer: serverHostN, authorization: federationAuthForServer f.toServer})
11361139 case result of
11371140 Err e -> do
11381141 println ("federation: forward to " ++ f.toServer ++ " failed for " ++ f.messageId ++ ": " ++ show e)
@@ -1175,7 +1178,7 @@ forwardQueuedMessages = \targets t -> do
11751178
11761179fetchFederationAck = \origin messageIds ->
11771180 fetch (federationUrl origin) (FederationAck {
1178− authorization: federationAuth,
1181+ authorization: federationAuthForServer origin,
11791182 messageIds: messageIds,
11801183 originServer: origin, fromServer: serverHostN})
11811184
@@ -1526,10 +1529,6 @@ forwardCandidates = \targets messages forwards t ->
15261529challengeMatch = \challenges pubkey challenge ip t ->
15271530 any challenges (\c -> c.pubkey == pubkey && safeCompare c.challenge challenge && c.expiresAt > t && (ip == "" || c.ip == "" || c.ip == ip))
15281531
1529−-- Check if a challenge exists for this key, ignoring IP (for unconditional consumption)
1530−challengeExistsForKey = \challenges pubkey challenge t ->
1531− any challenges (\c -> c.pubkey == pubkey && safeCompare c.challenge challenge && c.expiresAt > t)
1532−
15331532challengesExcluding = \challenges pubkey challenge ->
15341533 do c <- challenges; where c.pubkey != pubkey || c.challenge != challenge; yield c
15351534
@@ -1659,9 +1658,9 @@ verifyAuthInner = \pubkey challenge signature revokeOthers clientIp respond t ->
16591658 validation <- atomic do
16601659 challenges <- *challenges
16611660 let hasMatch = challengeMatch challenges pubkey challenge clientIp t
1662− -- Always consume challenge if it exists, even on IP mismatch (prevents brute-force from other IPs)
1663− let exists = challengeExistsForKey challenges pubkey challenge t
1664− when exists (set *challenges = challengesExcluding challenges pubkey challenge)
1661+ -- Only consume challenge on IP match (rate limiter handles brute-force from same IP;
1662+ -- not consuming on IP mismatch prevents remote attackers from burning challenges)
1663+ when hasMatch (set *challenges = challengesExcluding challenges pubkey challenge)
16651664 if not hasMatch || not sigValid
16661665 then yield {valid: False {}}
16671666 else yield {valid: True {}}
@@ -1733,7 +1732,8 @@ handleSendMessage = \to encryptedBlob timestamp messageId authorization respond
17331732 messages <- *messages
17341733 ackedIds <- *ackedIds
17351734 deliveredIds <- *deliveredIds
1736− if messageId != "" && (hasMessage messageId to messages || hasMessage messageId to ackedIds || hasMessage messageId to deliveredIds)
1735+ let msgCheck = checkMessageStore messages messageId to t
1736+ if messageId != "" && (msgCheck.isDup || hasMessage messageId to ackedIds || hasMessage messageId to deliveredIds)
17371737 then yield {send: SendDuplicate {}, senderRateLimited: False {}, globalCapReached: False {}}
17381738 else do
17391739 sendRates <- *sendRates
@@ -1757,7 +1757,7 @@ handleSendMessage = \to encryptedBlob timestamp messageId authorization respond
17571757 totalMsgCount <- *totalMessageCount
17581758 if totalMsgCount >= maxMessages
17591759 then yield {send: SendFailed {status: MsRejected {}}, senderRateLimited: False {}, globalCapReached: True {}}
1760− else if countMessagesFor messages to t >= maxMessagesPerRecipient
1760+ else if msgCheck.recipientCount >= maxMessagesPerRecipient
17611761 then yield {send: SendFailed {status: MsRejected {}}, senderRateLimited: False {}, globalCapReached: False {}}
17621762 else do
17631763 presence <- *presence
@@ -1798,7 +1798,7 @@ handleSendMessage = \to encryptedBlob timestamp messageId authorization respond
17981798 fwdResult <- fetch (federationUrl server) (ForwardMessage {
17991799 toKey: to, encryptedBlob: encryptedBlob,
18001800 timestamp: clampedTs, originServer: serverHostN, messageId: effectiveMsgId,
1801− fromServer: serverHostN, authorization: federationAuth})
1801+ fromServer: serverHostN, authorization: federationAuthForServer server})
18021802 case fwdResult of
18031803 Err e -> do
18041804 println ("federation: send forward to " ++ server ++ " failed for " ++ effectiveMsgId ++ ": " ++ show e)
@@ -1892,13 +1892,14 @@ handleForwardMessage = \toKey encryptedBlob timestamp originServer messageId fro
18921892 messages <- *messages
18931893 ackedIds <- *ackedIds
18941894 deliveredIds <- *deliveredIds
1895− if hasMessage messageId toKey messages || hasMessage messageId toKey ackedIds || hasMessage messageId toKey deliveredIds
1895+ let msgCheck = checkMessageStore messages messageId toKey t
1896+ if msgCheck.isDup || hasMessage messageId toKey ackedIds || hasMessage messageId toKey deliveredIds
18961897 then yield {forward: ForwardDuplicate {}, globalCapReached: False {}, recvRateLimited: False {}}
18971898 else do
18981899 totalMsgCount <- *totalMessageCount
18991900 if totalMsgCount >= maxMessages
19001901 then yield {forward: ForwardRejected {}, globalCapReached: True {}, recvRateLimited: False {}}
1901− else if countMessagesFor messages toKey t >= maxMessagesPerRecipient
1902+ else if msgCheck.recipientCount >= maxMessagesPerRecipient
19021903 then yield {forward: ForwardRejected {}, globalCapReached: False {}, recvRateLimited: False {}}
19031904 else do
19041905 recvRates <- *recvRates
@@ -1979,12 +1980,11 @@ handleDrain = \authorization respond -> do
19791980 ackedIds <- *ackedIds
19801981 let pendingForwardCount = count forwards
19811982 let pendingAckCount = count ackedIds
1982− -- Block on gossip (don't fork) so drain completes before process exit.
1983− -- NOTE: If peers are unreachable, this blocks until fetch returns (no timeout in runtime).
1984− -- Consider killing the process with a deadline after calling /drain.
1985− when (federationEnabled && drainedCount > 0 && count drainResult.peerServers > 0) (do
1983+ -- Fork gossip so drain responds immediately (hung peers can't block the response).
1984+ -- Operator should allow a few seconds after response before killing the process.
1985+ fork (when (federationEnabled && drainedCount > 0 && count drainResult.peerServers > 0) (do
19861986 let gossipEvents = do p <- drainResult.localEntries; yield {eventType: GossipOffline {}, pubkey: p.pubkey, server: serverHostN, timestamp: t, ttl: offlineGossipMinTtl}
1987− sendBatchedGossip drainResult.peerServers gossipEvents gossipOriginHops)
1987+ sendBatchedGossip drainResult.peerServers gossipEvents gossipOriginHops))
19881988 println ("drain: broadcast offline for " ++ show drainedCount ++ " local keys")
19891989 when (pendingForwardCount > 0)
19901990 (println ("drain: warning: " ++ show pendingForwardCount ++ " pending forwards will not be retried"))
@@ -2036,6 +2036,8 @@ handleHealth = \respond -> do
20362036 capacityHealthy: result.capacityOk,
20372037 federationHealthy: result.federationOk})
20382038
2039+zeroStats = {sessions: 0, sessionsMax: 0, messages: 0, messagesMax: 0, presence: 0, presenceMax: 0, forwards: 0, forwardsMax: 0, challenges: 0, challengesMax: 0, ackedIds: 0, ackedIdsMax: 0, ackOverflow: 0, ackOverflowMax: 0, deliveredIds: 0, deliveredIdsMax: 0, forwardFailures: 0, activePolls: 0, activePollsMax: 0, sendRates: 0, challengeRates: 0, federationRates: 0, globalRateCount: 0, ipRates: 0, lookupRates: 0, recvRates: 0, pruneCount: 0, heartbeatCount: 0, uptime: 0, lastPruneAt: 0, lastHeartbeatAt: 0, draining: False {}, federationEnabled: False {}, recentGossip: 0, totalMessageCount: 0, ok: False {}}
2040+
20392041handleStats = \authorization respond -> do
20402042 let authorized = verifyMaintenanceAuth authorization
20412043 if authorized
@@ -2065,10 +2067,13 @@ handleStats = \authorization respond -> do
20652067 sa <- *startedAt
20662068 lp <- *lastPrunedAt
20672069 lh <- *lastHeartbeatAt
2068− yield {s: s, m: m, p: p, f: f, c: c, a: a, ao: ao, d: d, ff: ff, ap: ap, sr: sr, cr: cr, fr: fr, grc: grc, ir: ir, lr: lr, rr: rr, pc: pc, hc: hc, sa: sa, lp: lp, lh: lh}
2069− let result = {sessions: count snapshot.s, messages: count snapshot.m, presence: count snapshot.p, forwards: count snapshot.f, challenges: count snapshot.c, ackedIds: count snapshot.a, ackOverflow: count snapshot.ao, deliveredIds: count snapshot.d, forwardFailures: count snapshot.ff, activePolls: count snapshot.ap, sendRates: count snapshot.sr, challengeRates: count snapshot.cr, federationRates: count snapshot.fr, globalRateCount: snapshot.grc, ipRates: count snapshot.ir, lookupRates: count snapshot.lr, recvRates: count snapshot.rr, pruneCount: snapshot.pc, heartbeatCount: snapshot.hc, uptime: t - snapshot.sa, lastPruneAt: snapshot.lp, lastHeartbeatAt: snapshot.lh}
2070− yield (respond {sessions: result.sessions, sessionsMax: maxSessions, messages: result.messages, messagesMax: maxMessages, presence: result.presence, presenceMax: maxPresenceEntries, forwards: result.forwards, forwardsMax: maxForwardsEntries, challenges: result.challenges, challengesMax: maxChallenges, ackedIds: result.ackedIds, ackedIdsMax: maxAckedIds, ackOverflow: result.ackOverflow, ackOverflowMax: maxAckOverflow, deliveredIds: result.deliveredIds, deliveredIdsMax: maxDeliveredIds, forwardFailures: result.forwardFailures, activePolls: result.activePolls, activePollsMax: maxActivePolls, sendRates: result.sendRates, challengeRates: result.challengeRates, federationRates: result.federationRates, globalRateCount: result.globalRateCount, ipRates: result.ipRates, lookupRates: result.lookupRates, recvRates: result.recvRates, pruneCount: result.pruneCount, heartbeatCount: result.heartbeatCount, uptime: result.uptime, lastPruneAt: result.lastPruneAt, lastHeartbeatAt: result.lastHeartbeatAt, ok: True {}})
2071− else yield (respond {sessions: 0, sessionsMax: 0, messages: 0, messagesMax: 0, presence: 0, presenceMax: 0, forwards: 0, forwardsMax: 0, challenges: 0, challengesMax: 0, ackedIds: 0, ackedIdsMax: 0, ackOverflow: 0, ackOverflowMax: 0, deliveredIds: 0, deliveredIdsMax: 0, forwardFailures: 0, activePolls: 0, activePollsMax: 0, sendRates: 0, challengeRates: 0, federationRates: 0, globalRateCount: 0, ipRates: 0, lookupRates: 0, recvRates: 0, pruneCount: 0, heartbeatCount: 0, uptime: 0, lastPruneAt: 0, lastHeartbeatAt: 0, ok: False {}})
2070+ dr <- *draining
2071+ rg <- *recentGossip
2072+ tmc <- *totalMessageCount
2073+ yield {s: s, m: m, p: p, f: f, c: c, a: a, ao: ao, d: d, ff: ff, ap: ap, sr: sr, cr: cr, fr: fr, grc: grc, ir: ir, lr: lr, rr: rr, pc: pc, hc: hc, sa: sa, lp: lp, lh: lh, dr: dr, rg: rg, tmc: tmc}
2074+ let result = {sessions: count snapshot.s, messages: count snapshot.m, presence: count snapshot.p, forwards: count snapshot.f, challenges: count snapshot.c, ackedIds: count snapshot.a, ackOverflow: count snapshot.ao, deliveredIds: count snapshot.d, forwardFailures: count snapshot.ff, activePolls: count snapshot.ap, sendRates: count snapshot.sr, challengeRates: count snapshot.cr, federationRates: count snapshot.fr, globalRateCount: snapshot.grc, ipRates: count snapshot.ir, lookupRates: count snapshot.lr, recvRates: count snapshot.rr, pruneCount: snapshot.pc, heartbeatCount: snapshot.hc, uptime: t - snapshot.sa, lastPruneAt: snapshot.lp, lastHeartbeatAt: snapshot.lh, draining: snapshot.dr, recentGossip: count snapshot.rg, totalMessageCount: snapshot.tmc}
2075+ yield (respond {sessions: result.sessions, sessionsMax: maxSessions, messages: result.messages, messagesMax: maxMessages, presence: result.presence, presenceMax: maxPresenceEntries, forwards: result.forwards, forwardsMax: maxForwardsEntries, challenges: result.challenges, challengesMax: maxChallenges, ackedIds: result.ackedIds, ackedIdsMax: maxAckedIds, ackOverflow: result.ackOverflow, ackOverflowMax: maxAckOverflow, deliveredIds: result.deliveredIds, deliveredIdsMax: maxDeliveredIds, forwardFailures: result.forwardFailures, activePolls: result.activePolls, activePollsMax: maxActivePolls, sendRates: result.sendRates, challengeRates: result.challengeRates, federationRates: result.federationRates, globalRateCount: result.globalRateCount, ipRates: result.ipRates, lookupRates: result.lookupRates, recvRates: result.recvRates, pruneCount: result.pruneCount, heartbeatCount: result.heartbeatCount, uptime: result.uptime, lastPruneAt: result.lastPruneAt, lastHeartbeatAt: result.lastHeartbeatAt, draining: result.draining, federationEnabled: federationEnabled, recentGossip: result.recentGossip, totalMessageCount: result.totalMessageCount, ok: True {}})
2076+ else yield (respond zeroStats)
20722077
20732078handleStatsPeers = \authorization respond -> do
20742079 let authorized = verifyMaintenanceAuth authorization
@@ -2139,7 +2144,7 @@ backgroundPrune = do
21392144 set *lastHeartbeatAt = t)
21402145 status <- atomic do
21412146 running <- *pruneRunning
2142− if running > 0 && t - running < backgroundPruneInterval * 3
2147+ if running > 0 && t - running < backgroundPruneInterval * 2
21432148 then yield {canRun: False {}, recovered: False {}, gen: 0}
21442149 else do
21452150 set *pruneRunning = t