@@ -366,6 +366,14 @@ type FederationInFlightEntry = {server: Text, count: Int, firstStartedAt: Timest
366366-- Tracks outstanding federation fetches per server (detects hung connections)
367367*federationInFlight : [FederationInFlightEntry]
368368
369+-- Federation latency tracking (for /stats)
370+*federationLatencyTotal : Int<Ms>
371+*federationLatencyCount : Int
372+*federationLatencyMax : Int<Ms>
373+
374+-- Server instance generation (epoch timestamp, for cursor staleness detection)
375+*serverGeneration : Int
376+
369377-- ============================================
370378-- Routes
371379-- ============================================
@@ -382,12 +390,15 @@ route AuthApi where
382390 POST {pubkey: PubkeyHex, challenge: Text, signature: SignatureHex, revokeOthers: Bool} /verify headers {clientIp: Text}
383391 -> {token: Text, expiresAt: Timestamp}
384392 = VerifyAuth
393+ POST {targetToken: Text} /revoke headers {authorization: Text, clientIp: Text}
394+ -> {ok: Bool, authorized: Bool}
395+ = RevokeSession
385396
386397-- Client-facing API (requires session token in Authorization header)
387398route ClientApi where
388399 -- Long-poll for new messages; cursor tracks last-seen receivedAt timestamp
389− POST {cursor: Timestamp} /poll headers {authorization: Text, clientIp: Text}
390− -> {events: [PollEvent], cursor: Timestamp, authorized: Bool, rateLimited: Bool, draining: Bool}
400+ POST {cursor: Timestamp, generation: Int} /poll headers {authorization: Text, clientIp: Text}
401+ -> {events: [PollEvent], cursor: Timestamp, authorized: Bool, rateLimited: Bool, draining: Bool, generation: Int}
391402 = Poll
392403 /messages
393404 -- Send an E2E encrypted message to a recipient pubkey
@@ -423,6 +434,9 @@ route MaintenanceApi where
423434 POST {} /maintenance/drain headers {authorization: Text}
424435 -> {ok: Bool, drained: Int}
425436 = Drain
437+ POST {} /maintenance/undrain headers {authorization: Text}
438+ -> {ok: Bool}
439+ = Undrain
426440
427441route HealthApi where
428442 GET /health -> {ok: Bool, pruneHealthy: Bool, heartbeatHealthy: Bool, capacityHealthy: Bool, federationHealthy: Bool} = Health
@@ -430,7 +444,7 @@ route HealthApi where
430444-- Returns counts of in-memory collections (requires federation or maintenance secret)
431445route StatsApi where
432446 GET /stats headers {authorization: Text}
433− -> {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, recipientCounts: Int, federationInFlight: Int, ok: Bool}
447+ -> {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, recipientCounts: Int, federationInFlight: Int, messagesPct: Int, presencePct: Int, forwardsPct: Int, sessionsPct: Int, federationAvgLatencyMs: Int, federationMaxLatencyMs: Int, federationCallCount: Int, ok: Bool}
434448 = Stats
435449 GET /stats/peers headers {authorization: Text}
436450 -> {peers: [PeerStatus], ok: Bool}
@@ -665,6 +679,10 @@ isBadServerName = \sn ->
665679 || containsSuffix ".arpa" sn
666680 || containsSuffix ".onion" sn
667681 || containsSuffix ".i2p" sn
682+ || containsSuffix ".corp" sn
683+ || containsSuffix ".home" sn
684+ || containsSuffix ".lan" sn
685+ || containsSuffix ".intranet" sn
668686
669687-- Look up a non-expired session matching the given token (constant-time comparison).
670688-- Caller passes the appropriate session bucket (sharded by token prefix).
@@ -885,8 +903,16 @@ fetchFederation = \server request -> do
885903 result <- fetch (federationUrl server) request
886904 clearFederationInFlight server
887905 endTime <- now
888− when (endTime - startTime > federationFetchTimeoutMs)
889− (println ("federation: slow response from " ++ server ++ " (" ++ show (endTime - startTime) ++ "ms)"))
906+ let latency = endTime - startTime
907+ when (latency > federationFetchTimeoutMs)
908+ (println ("federation: slow response from " ++ server ++ " (" ++ show latency ++ "ms)"))
909+ atomic do
910+ total <- *federationLatencyTotal
911+ cnt <- *federationLatencyCount
912+ mx <- *federationLatencyMax
913+ set *federationLatencyTotal = total + latency
914+ set *federationLatencyCount = cnt + 1
915+ set *federationLatencyMax = if latency > mx then latency else mx
890916 yield result
891917
892918clampTtl : Int<S> -> Int<S>
@@ -1282,6 +1308,10 @@ withFederationAuth = \authorization t respond fromServer precondition action ->
12821308 println ("federation: rate limited (" ++ show maxFederationRatePerServer ++ "/s per server), rejecting for " ++ fromServer)
12831309 yield (respond {ok: False {}, error: "rate_limited"})
12841310 else do
1311+ let hasPeerSecrets = count federationPeerSecrets > 0
1312+ let hasSpecificSecret = any federationPeerSecrets (\p -> normalizeServerName p.server == fromServer)
1313+ when (hasPeerSecrets && not hasSpecificSecret)
1314+ (println ("federation: warning: " ++ fromServer ++ " using global secret (no per-peer secret configured)"))
12851315 clearFailure fromServer
12861316 action
12871317
@@ -1294,9 +1324,11 @@ withSessionAuth = \authorization t clientIp onUnauth onAuth -> do
12941324 case authenticateSession sessions token t of
12951325 Unauthorized {} -> onUnauth
12961326 Authorized {pubkey, ip} -> do
1297− when (clientIp != "" && ip != "" && clientIp != ip)
1298− (println ("session: IP mismatch for " ++ pubkey ++ " (session: " ++ ip ++ ", request: " ++ clientIp ++ ")"))
1299− onAuth pubkey
1327+ if clientIp != "" && ip != "" && clientIp != ip
1328+ then do
1329+ println ("session: IP mismatch for " ++ pubkey ++ " (session: " ++ ip ++ ", request: " ++ clientIp ++ "), rejecting")
1330+ onUnauth
1331+ else onAuth pubkey
13001332
13011333removeForward = \mid srv -> atomic do
13021334 forwards <- *forwards
@@ -1463,6 +1495,8 @@ retryEvictedAcks = \evictedEntries pendingAcks ->
14631495 let deliveredExcess = count combinedDelivered - maxDeliveredIds
14641496 set *deliveredIds = if deliveredExcess <= 0 then combinedDelivered
14651497 else (evictSmallest combinedDelivered (max 0 deliveredExcess) (\d -> d.deliveredAt)).kept
1498+ when (deliveredExcess > 0)
1499+ (println ("ackMessages: deliveredIds at capacity (" ++ show maxDeliveredIds ++ "), " ++ show deliveredExcess ++ " oldest dedup entries permanently removed for " ++ server))
14661500 yield overflowExcess
14671501 when (dropped > 0)
14681502 (println ("ackMessages: overflow at capacity (" ++ show maxAckOverflow ++ "), " ++ show dropped ++ " ack entries moved to delivered set for " ++ server)))
@@ -1494,12 +1528,14 @@ retryOverflowAcks = \overflow -> do
14941528pruneAndRetry = \t -> do
14951529 atomic do set *lastPrunedAt = t
14961530 pr <- pruneExpired t
1497− result <- atomic do
1498− forwards <- *forwards
1531+ pendingForwards <- atomic do f <- *forwards; yield f
1532+ ackState <- atomic do
14991533 ackedIds2 <- *ackedIds
15001534 let pendingAcks = do a <- ackedIds2; where not (isLocalServer a.originServer); yield a
15011535 ackOverflow <- *ackOverflow
15021536 let pendingOverflow = do a <- ackOverflow; where not (isLocalServer a.originServer); yield a
1537+ yield {pendingAcks: pendingAcks, pendingOverflow: pendingOverflow}
1538+ refreshResult <- atomic do
15031539 lastRefresh <- *lastPresenceRefresh
15041540 let shouldRefresh = federationEnabled && t - lastRefresh >= presenceRefreshInterval
15051541 presence <- *presence
@@ -1512,7 +1548,8 @@ pruneAndRetry = \t -> do
15121548 set *presence = do pp <- presence; yield (if any toExtend (\e -> e.pubkey == pp.pubkey && isLocalServer pp.server) then {pubkey: pp.pubkey, server: pp.server, expiresAt: t + sessionExpiry, timestamp: t} else pp))
15131549 let refreshPeers = if shouldRefresh then collectPeerServers presence (\p -> p.server) else []
15141550 when shouldRefresh (set *lastPresenceRefresh = t)
1515− yield {pendingForwards: forwards, pendingAcks: pendingAcks, pendingOverflow: pendingOverflow, extendedActive: toExtend, nearExpiryActive: notExtended, refreshPeers: refreshPeers, shouldRefresh: shouldRefresh}
1551+ yield {extendedActive: toExtend, nearExpiryActive: notExtended, refreshPeers: refreshPeers, shouldRefresh: shouldRefresh}
1552+ let result = {pendingForwards: pendingForwards, pendingAcks: ackState.pendingAcks, pendingOverflow: ackState.pendingOverflow, extendedActive: refreshResult.extendedActive, nearExpiryActive: refreshResult.nearExpiryActive, refreshPeers: refreshResult.refreshPeers, shouldRefresh: refreshResult.shouldRefresh}
15161553 -- Fork federation I/O so hung peers don't block next prune cycle
15171554 fork (do
15181555 broadcastOfflineGossip t pr.peerServers pr.expiredLocal
@@ -1632,8 +1669,11 @@ pollOnce = \token cursor clientIp -> do
16321669 case authenticateSession sessions token t of
16331670 Unauthorized {} -> yield (Nothing {})
16341671 Authorized {pubkey, ip} -> do
1635− when (clientIp != "" && ip != "" && clientIp != ip)
1636− (println ("poll: session IP mismatch for " ++ pubkey ++ " (session: " ++ ip ++ ", request: " ++ clientIp ++ ")"))
1672+ if clientIp != "" && ip != "" && clientIp != ip
1673+ then do
1674+ println ("poll: session IP mismatch for " ++ pubkey ++ " (session: " ++ ip ++ ", request: " ++ clientIp ++ "), rejecting")
1675+ yield (Nothing {})
1676+ else do
16371677 -- Refresh session expiry (sliding window keeps active sessions alive)
16381678 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))
16391679 seqCounter <- *seqCounter
@@ -1885,7 +1925,7 @@ verifyAuthInner = \pubkey challenge signature revokeOthers clientIp respond t ->
18851925 let hasMatch = challengeMatch challenges pubkey challenge clientIp t
18861926 -- Only consume challenge on IP match (rate limiter handles brute-force from same IP;
18871927 -- not consuming on IP mismatch prevents remote attackers from burning challenges)
1888− when hasMatch (set *challenges = challengesExcluding challenges pubkey challenge)
1928+ when hasMatch (set *challenges = do c <- challenges; where c.pubkey != pubkey; yield c)
18891929 if not hasMatch || not sigValid
18901930 then yield {valid: False {}}
18911931 else yield {valid: True {}}
@@ -1943,21 +1983,23 @@ verifyAuthInner = \pubkey challenge signature revokeOthers clientIp respond t ->
19431983-- POST /poll: Long-poll for new messages. Cursor-based: messages at or before cursor
19441984-- are acked (removed from mailbox). Blocks until new messages arrive or heartbeat fires.
19451985-- Acks for federated messages are sent to origin servers in the background.
1946−handlePoll = \cursor authorization clientIp respond -> do
1986+handlePoll = \cursor generation authorization clientIp respond -> do
19471987 t <- now
1988+ serverGen <- *serverGeneration
1989+ let effectiveCursor = if generation == serverGen then cursor else 0
19481990 draining <- *draining
1949− if draining then yield (respond {events: [], cursor: 0, authorized: True {}, rateLimited: False {}, draining: True {}})
1991+ if draining then yield (respond {events: [], cursor: 0, authorized: True {}, rateLimited: False {}, draining: True {}, generation: serverGen})
19501992 else do
19511993 globalRateLimited <- checkGlobalRate t
1952− if globalRateLimited then yield (respond {events: [], cursor: 0, authorized: False {}, rateLimited: True {}, draining: False {}})
1994+ if globalRateLimited then yield (respond {events: [], cursor: 0, authorized: False {}, rateLimited: True {}, draining: False {}, generation: serverGen})
19531995 else do
19541996 result <- case extractToken authorization of
19551997 Nothing {} -> yield {authorized: False {}, events: [], cursor: 0, pendingAcks: [], evictedEntries: []}
1956− Just {value: token} -> pollOnce token cursor clientIp
1998+ Just {value: token} -> pollOnce token effectiveCursor clientIp
19571999 fork (when federationEnabled (do
19582000 sendAcksAndClean result.pendingAcks
19592001 retryEvictedAcks result.evictedEntries result.pendingAcks))
1960− yield (respond {events: result.events, cursor: result.cursor, authorized: result.authorized, rateLimited: False {}, draining: False {}})
2002+ yield (respond {events: result.events, cursor: result.cursor, authorized: result.authorized, rateLimited: False {}, draining: False {}, generation: serverGen})
19612003
19622004-- POST /messages: Send an encrypted message to a recipient.
19632005-- Deduplicates by messageId across messages, ackedIds, and deliveredIds.
@@ -2097,6 +2139,29 @@ handleLookupPresence = \pubkey authorization clientIp respond -> do
20972139 yield {server: maskedServer, authorized: True {}})
20982140 yield (respond {server: result.server, authorized: result.authorized})
20992141
2142+-- POST /auth/revoke: Revoke a specific session token.
2143+-- Caller authenticates via Authorization header, then specifies the target token to remove.
2144+-- Only removes the target if it belongs to the same pubkey as the caller (prevents cross-user revocation).
2145+handleRevoke = \targetToken authorization clientIp respond -> do
2146+ t <- now
2147+ globalRateLimited <- checkGlobalRate t
2148+ if globalRateLimited then yield (respond {ok: False {}, authorized: False {}})
2149+ else
2150+ withSessionAuth authorization t clientIp
2151+ (yield (respond {ok: False {}, authorized: False {}}))
2152+ (\callerPubkey -> do
2153+ let targetBucket = tokenBucket targetToken
2154+ removed <- atomic do
2155+ sessions <- readSessionBucket targetBucket
2156+ let hasTarget = any sessions (\s -> safeCompare s.token targetToken && s.pubkey == callerPubkey)
2157+ if hasTarget
2158+ then do
2159+ writeSessionBucket targetBucket (do s <- sessions; where not (safeCompare s.token targetToken && s.pubkey == callerPubkey); yield s)
2160+ yield (True {})
2161+ else yield (False {})
2162+ when removed (println ("revoke: session revoked for " ++ callerPubkey))
2163+ yield (respond {ok: removed, authorized: True {}}))
2164+
21002165-- POST /federation/gossip: Receive presence gossip from a peer server.
21012166-- Validates events, merges into presence table (last-write-wins), and re-gossips
21022167-- to other known peers with decremented hop count. Triggers message forwarding
@@ -2263,6 +2328,20 @@ handleDrain = \authorization respond -> do
22632328 (println ("drain: warning: " ++ show pendingAckCount ++ " pending acks will not be sent"))
22642329 yield (respond {ok: True {}, drained: drainedCount})
22652330
2331+-- POST /maintenance/undrain: Resume accepting requests after a drain.
2332+-- Background loops (prune, heartbeat) automatically resume on next iteration.
2333+handleUndrain = \authorization respond -> do
2334+ let authorized = verifyMaintenanceAuth authorization
2335+ if not authorized then yield (respond {ok: False {}})
2336+ else do
2337+ wasDraining <- atomic do
2338+ d <- *draining
2339+ set *draining = False {}
2340+ yield d
2341+ when wasDraining (println "undrain: server resumed, accepting new requests")
2342+ when (not wasDraining) (println "undrain: server was not draining")
2343+ yield (respond {ok: True {}})
2344+
22662345-- POST /maintenance/prune: Trigger a full maintenance cycle (prune + retry all pending ops).
22672346-- Accepts either federation or maintenance secret.
22682347handlePrune = \authorization respond -> do
@@ -2307,7 +2386,7 @@ handleHealth = \respond -> do
23072386 capacityHealthy: result.capacityOk,
23082387 federationHealthy: result.federationOk})
23092388
2310−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, recipientCounts: 0, federationInFlight: 0, ok: False {}}
2389+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, recipientCounts: 0, federationInFlight: 0, messagesPct: 0, presencePct: 0, forwardsPct: 0, sessionsPct: 0, federationAvgLatencyMs: 0, federationMaxLatencyMs: 0, federationCallCount: 0, ok: False {}}
23112390
23122391handleStats = \authorization respond -> do
23132392 let authorized = verifyMaintenanceAuth authorization
@@ -2343,9 +2422,17 @@ handleStats = \authorization respond -> do
23432422 tmc <- *totalMessageCount
23442423 rc <- *recipientMsgCounts
23452424 fi <- *federationInFlight
2346− yield {sc: sc, 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, rc: rc, fi: fi}
2347− let result = {sessions: snapshot.sc, 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, recipientCounts: count snapshot.rc, federationInFlight: count snapshot.fi}
2348− 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, recipientCounts: result.recipientCounts, federationInFlight: result.federationInFlight, ok: True {}})
2425+ flt <- *federationLatencyTotal
2426+ flc <- *federationLatencyCount
2427+ flm <- *federationLatencyMax
2428+ yield {sc: sc, 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, rc: rc, fi: fi, flt: flt, flc: flc, flm: flm}
2429+ let result = {sessions: snapshot.sc, 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, recipientCounts: count snapshot.rc, federationInFlight: count snapshot.fi, federationLatencyTotal: snapshot.flt, federationLatencyCount: snapshot.flc, federationLatencyMax: snapshot.flm}
2430+ let msgPct = if maxMessages > 0 then result.messages * 100 / maxMessages else 0
2431+ let presPct = if maxPresenceEntries > 0 then result.presence * 100 / maxPresenceEntries else 0
2432+ let fwdPct = if maxForwardsEntries > 0 then result.forwards * 100 / maxForwardsEntries else 0
2433+ let sessPct = if maxSessions > 0 then result.sessions * 100 / maxSessions else 0
2434+ let fedAvg = if result.federationLatencyCount > 0 then result.federationLatencyTotal / result.federationLatencyCount else 0
2435+ 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, recipientCounts: result.recipientCounts, federationInFlight: result.federationInFlight, messagesPct: msgPct, presencePct: presPct, forwardsPct: fwdPct, sessionsPct: sessPct, federationAvgLatencyMs: fedAvg, federationMaxLatencyMs: result.federationLatencyMax, federationCallCount: result.federationLatencyCount, ok: True {}})
23492436 else yield (respond zeroStats)
23502437
23512438handleStatsPeers = \authorization respond -> do
@@ -2381,7 +2468,8 @@ handleStatsKey = \pubkey authorization respond -> do
23812468serve = \req -> case req of
23822469 ReqChallenge {pubkey, clientIp, respond} -> handleChallenge pubkey clientIp respond
23832470 VerifyAuth {pubkey, challenge, signature, revokeOthers, clientIp, respond} -> handleVerifyAuth pubkey challenge signature revokeOthers clientIp respond
2384− Poll {cursor, authorization, clientIp, respond} -> handlePoll cursor authorization clientIp respond
2471+ RevokeSession {targetToken, authorization, clientIp, respond} -> handleRevoke targetToken authorization clientIp respond
2472+ Poll {cursor, generation, authorization, clientIp, respond} -> handlePoll cursor generation authorization clientIp respond
23852473 SendMessage {to, encryptedBlob, timestamp, messageId, authorization, clientIp, respond} -> handleSendMessage to encryptedBlob timestamp messageId authorization clientIp respond
23862474 LookupPresence {pubkey, authorization, clientIp, respond} -> handleLookupPresence pubkey authorization clientIp respond
23872475 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> handleRecvGossip events hopsRemaining fromServer authorization respond
@@ -2389,6 +2477,7 @@ serve = \req -> case req of
23892477 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> handleFederationAck messageIds originServer fromServer authorization respond
23902478 Prune {authorization, respond} -> handlePrune authorization respond
23912479 Drain {authorization, respond} -> handleDrain authorization respond
2480+ Undrain {authorization, respond} -> handleUndrain authorization respond
23922481 Health {respond} -> handleHealth respond
23932482 Stats {authorization, respond} -> handleStats authorization respond
23942483 StatsPeers {authorization, respond} -> handleStatsPeers authorization respond
@@ -2404,7 +2493,9 @@ backgroundPrune = do
24042493 jitter <- randomInt 5000
24052494 sleep (backgroundPruneInterval + jitter)
24062495 draining <- *draining
2407− if draining then println "backgroundPrune: stopping (server draining)"
2496+ if draining then do
2497+ sleep backgroundPruneInterval
2498+ backgroundPrune
24082499 else do
24092500 t <- now
24102501 -- Heartbeat watchdog: bump pollWakeup if heartbeat loop appears dead
@@ -2417,7 +2508,7 @@ backgroundPrune = do
24172508 set *lastHeartbeatAt = t)
24182509 status <- atomic do
24192510 running <- *pruneRunning
2420− if running > 0 && t - running < backgroundPruneInterval * 2
2511+ if running > 0 && t - running < backgroundPruneInterval * 3
24212512 then yield {canRun: False {}, recovered: False {}, gen: 0}
24222513 else do
24232514 set *pruneRunning = t
@@ -2449,7 +2540,9 @@ pollHeartbeat = do
24492540 if draining then do
24502541 t <- now
24512542 atomic do set *pollWakeup = t
2452− println "pollHeartbeat: stopping (server draining)"
2543+ -- Don't exit; sleep and retry so undrain can resume the loop
2544+ sleep pollTimeoutMs
2545+ pollHeartbeat
24532546 else do
24542547 t <- now
24552548 atomic do
@@ -2471,7 +2564,9 @@ main = do
24712564 then println "FATAL: invalid federationPeerSecrets — server names must pass validation and secrets must be non-empty"
24722565 else do
24732566 t <- now
2474− atomic do set *startedAt = t
2567+ atomic do
2568+ set *startedAt = t
2569+ set *serverGeneration = t
24752570 println "Skrepka relay server starting on port 8080..."
24762571 println (" federation: " ++ if federationEnabled then "enabled" else "disabled")
24772572 println (" prune interval: " ++ show backgroundPruneInterval ++ "ms")