@@ -206,9 +206,11 @@ federationUrl = \server -> federationScheme ++ server
206requireClientIp : Bool
206requireClientIp : Bool
207requireClientIp = True {}
207requireClientIp = True {}
209+-- Drop the Ms unit and convert milliseconds to seconds.
209msToS : Int<Ms> -> Int<S>
210msToS : Int<Ms> -> Int<S>
210msToS = \ms -> stripUnit ms / 1000
211msToS = \ms -> stripUnit ms / 1000
213+-- Drop the S unit and convert seconds to milliseconds.
212sToMs : Int<S> -> Int<Ms>
214sToMs : Int<S> -> Int<Ms>
213sToMs = \s -> stripUnit s * 1000
215sToMs = \s -> stripUnit s * 1000
@@ -220,12 +222,16 @@ sToMs = \s -> stripUnit s * 1000
220-- and stripped of trailing dots, with a deny-list filter (`isBadServerName`)
222-- and stripped of trailing dots, with a deny-list filter (`isBadServerName`)
221-- applied where SSRF is a concern.
223-- applied where SSRF is a concern.
225+-- One event in a /poll response. `eventType` is currently always "message"; the
226+-- payload is the cipher blob plus delivery metadata for the recipient.
223type PollEvent = {
227type PollEvent = {
224 id: MessageIdHex,
228 id: MessageIdHex,
225 eventType: Text,
229 eventType: Text,
226 payload: {encryptedBlob: BlobHex, timestamp: Timestamp, toKey: PubkeyHex, expiresAt: Timestamp}
230 payload: {encryptedBlob: BlobHex, timestamp: Timestamp, toKey: PubkeyHex, expiresAt: Timestamp}
233+-- Kind of presence event flowing through federation gossip. `GossipUnknown` is
234+-- the parser's fallback for forward-compatibility with future event types.
229data GossipEventType = GossipOnline {} | GossipOffline {} | GossipUnknown {}
235data GossipEventType = GossipOnline {} | GossipOffline {} | GossipUnknown {}
231impl ToJSON GossipEventType where
237impl ToJSON GossipEventType where
@@ -237,6 +243,8 @@ impl ToJSON GossipEventType where
237impl FromJSON GossipEventType where
243impl FromJSON GossipEventType where
238 parseJson t = (\s -> if s == "online" then GossipOnline {} else if s == "offline" then GossipOffline {} else GossipUnknown {}) (parseJson t : Text)
244 parseJson t = (\s -> if s == "online" then GossipOnline {} else if s == "offline" then GossipOffline {} else GossipUnknown {}) (parseJson t : Text)
246+-- One presence change exchanged between federated servers. `seenBy` lists the
247+-- hostnames already aware of the event, used by receivers to break gossip loops.
240type GossipEvent = {
248type GossipEvent = {
241 eventType: GossipEventType,
249 eventType: GossipEventType,
242 pubkey: PubkeyHex,
250 pubkey: PubkeyHex,
@@ -246,6 +254,9 @@ type GossipEvent = {
246 seenBy: [Text]
254 seenBy: [Text]
257+-- Outcome classification returned to the sender of /messages and per-entry in
258+-- /messages/batch. The first four are success-ish (see `isSendSuccess`); the
259+-- rest are refusals.
249data MessageStatus
260data MessageStatus
250 = MsDelivered {}
261 = MsDelivered {}
251 | MsFederated {}
262 | MsFederated {}
@@ -267,27 +278,42 @@ impl ToJSON MessageStatus where
267 MsDuplicate {} -> "duplicate"
278 MsDuplicate {} -> "duplicate"
268 MsDraining {} -> "draining")
279 MsDraining {} -> "draining")
281+-- True when `s` is non-empty lowercase hex of even length, with `maxLen` ceiling.
270isValidBoundedHex : Int -> Text -> Bool
282isValidBoundedHex : Int -> Text -> Bool
271isValidBoundedHex = \maxLen s -> not tooLong s maxLen && isValidHex s
283isValidBoundedHex = \maxLen s -> not tooLong s maxLen && isValidHex s
284+-- True when `s` is lowercase hex of exactly `exactLen` characters (even by definition).
272isValidExactHex : Int -> Text -> Bool
285isValidExactHex : Int -> Text -> Bool
273isValidExactHex = \exactLen s -> count (chars s) == exactLen && isValidHex s
286isValidExactHex = \exactLen s -> count (chars s) == exactLen && isValidHex s
287+-- Hex-encoded Ed25519 public key (32 bytes → 64 chars exact).
274type PubkeyHex = Text where isValidExactHex pubkeyLen
288type PubkeyHex = Text where isValidExactHex pubkeyLen
289+-- Hex-encoded ciphertext or opaque blob; capped at `maxBlobLen` (~20 MiB).
275type BlobHex = Text where isValidBoundedHex maxBlobLen
290type BlobHex = Text where isValidBoundedHex maxBlobLen
291+-- Hex-encoded Ed25519 signature (64 bytes → 128 chars exact).
276type SignatureHex = Text where isValidExactHex signatureLen
292type SignatureHex = Text where isValidExactHex signatureLen
277isValidMessageId : Text -> Bool
293isValidMessageId : Text -> Bool
278isValidMessageId = isValidBoundedHex maxMessageIdLen
294isValidMessageId = isValidBoundedHex maxMessageIdLen
295+-- Hex-encoded message id, length ≤ `maxMessageIdLen`.
279type MessageIdHex = Text where isValidMessageId
296type MessageIdHex = Text where isValidMessageId
297+-- A `MessageIdHex` or the empty string. Empty means "let the server generate one".
280type OptionalMessageId = Text where \s -> s == "" || isValidMessageId s
298type OptionalMessageId = Text where \s -> s == "" || isValidMessageId s
299+-- Normalized hostname (lowercased, no trailing dot, length-bounded).
281isAnyServerName : Text -> Bool
300isAnyServerName : Text -> Bool
282isAnyServerName = \s -> not tooLong s maxServerNameLen && s == normalizeServerName s
301isAnyServerName = \s -> not tooLong s maxServerNameLen && s == normalizeServerName s
302+-- A normalized hostname that also passes the SSRF deny-list (`isBadServerName`).
283isValidServerName : Text -> Bool
303isValidServerName : Text -> Bool
284isValidServerName = \s -> isAnyServerName s && not isBadServerName s
304isValidServerName = \s -> isAnyServerName s && not isBadServerName s
305+-- Peer hostname suitable for outbound federation calls.
285type ServerName = Text where isValidServerName
306type ServerName = Text where isValidServerName
307+-- Normalized hostname with no SSRF filter; used when the value comes from
308+-- presence rows that the client only ever sees masked to "remote".
286type AnyServerName = Text where isAnyServerName
309type AnyServerName = Text where isAnyServerName
311+-- Wall-clock time in milliseconds since epoch.
288type Timestamp = Int<Ms>
312type Timestamp = Int<Ms>
314+-- Outstanding nonce issued by /auth/challenge; consumed by /auth/verify.
290type Challenge = {pubkey: PubkeyHex, challenge: Text, expiresAt: Timestamp, ip: Text}
315type Challenge = {pubkey: PubkeyHex, challenge: Text, expiresAt: Timestamp, ip: Text}
316+-- An issued bearer token bound to (pubkey, ip, expiry).
291type Session = {
317type Session = {
292 token: Text,
318 token: Text,
293 pubkey: PubkeyHex,
319 pubkey: PubkeyHex,
@@ -295,6 +321,10 @@ type Session = {
295 ip: Text,
321 ip: Text,
296 createdAt: Timestamp
322 createdAt: Timestamp
324+-- Mailbox row: a stored message awaiting recipient pickup or federation forward.
325+-- `originServer` is "" for messages submitted directly by a local sender.
326+-- `senderKey` is "" for messages received via federation (we don't see the
327+-- remote sender's pubkey).
298type Message = {
328type Message = {
299 messageId: MessageIdHex,
329 messageId: MessageIdHex,
300 toKey: PubkeyHex,
330 toKey: PubkeyHex,
@@ -305,12 +335,16 @@ type Message = {
305 expiresAt: Timestamp,
335 expiresAt: Timestamp,
306 senderKey: Text
336 senderKey: Text
338+-- Last-known location of a pubkey, either local (`server == serverHostN`) or
339+-- learned from a peer via gossip. Multiple entries per pubkey are allowed.
308type PresenceEntry = {
340type PresenceEntry = {
309 pubkey: PubkeyHex,
341 pubkey: PubkeyHex,
310 server: AnyServerName,
342 server: AnyServerName,
311 expiresAt: Timestamp,
343 expiresAt: Timestamp,
312 timestamp: Timestamp
344 timestamp: Timestamp
346+-- A message queued for cross-server delivery to `toServer`. `retries` is
347+-- incremented by `retryPendingForwards` until `maxForwardRetries` is hit.
314type ForwardEntry = {
348type ForwardEntry = {
315 messageId: MessageIdHex,
349 messageId: MessageIdHex,
316 toServer: ServerName,
350 toServer: ServerName,
@@ -323,6 +357,8 @@ type ForwardEntry = {
323 expiresAt: Timestamp,
357 expiresAt: Timestamp,
324 senderKey: Text
358 senderKey: Text
360+-- Record that a federated message has been acked locally; flushed back to
361+-- `originServer` by `sendAcksAndClean`.
326type AckedEntry = {
362type AckedEntry = {
327 messageId: MessageIdHex,
363 messageId: MessageIdHex,
328 toKey: PubkeyHex,
364 toKey: PubkeyHex,
@@ -330,23 +366,33 @@ type AckedEntry = {
330 originServer: ServerName,
366 originServer: ServerName,
331 retries: Int
367 retries: Int
369+-- Replay-protection record: a message id we already delivered locally.
333type DeliveredEntry = {messageId: MessageIdHex, toKey: PubkeyHex, deliveredAt: Timestamp}
370type DeliveredEntry = {messageId: MessageIdHex, toKey: PubkeyHex, deliveredAt: Timestamp}
371+-- Running failure counter for a peer; keyed by `server`. Drives `retryBackoff`.
334type ForwardFailure = {server: Text, failedAt: Timestamp, failures: Int, firstFailedAt: Timestamp}
372type ForwardFailure = {server: Text, failedAt: Timestamp, failures: Int, firstFailedAt: Timestamp}
373+-- One fixed-window rate counter. `key` identifies the subject (pubkey, ip,
374+-- server, or composite "sender|recipient" string).
335type RateEntry = {key: Text, windowStart: Timestamp, count: Int}
375type RateEntry = {key: Text, windowStart: Timestamp, count: Int}
376+-- A live long-poll slot held by a pubkey; used to cap concurrency per key.
336type ActivePoll = {pubkey: PubkeyHex, startedAt: Timestamp}
377type ActivePoll = {pubkey: PubkeyHex, startedAt: Timestamp}
379+-- Pending notification to a sender that their queued message expired unacked.
380+-- Drained in the sender's next /poll response.
338type SenderExpiration = {
381type SenderExpiration = {
339 senderKey: Text,
382 senderKey: Text,
340 messageId: MessageIdHex,
383 messageId: MessageIdHex,
341 toKey: PubkeyHex,
384 toKey: PubkeyHex,
342 expiredAt: Timestamp
385 expiredAt: Timestamp
387+-- Pending notification to a sender that their message was delivered to the
388+-- recipient. Drained in the sender's next /poll response.
344type SenderDelivery = {
389type SenderDelivery = {
345 senderKey: Text,
390 senderKey: Text,
346 messageId: MessageIdHex,
391 messageId: MessageIdHex,
347 toKey: PubkeyHex,
392 toKey: PubkeyHex,
348 deliveredAt: Timestamp
393 deliveredAt: Timestamp
395+-- One entry of a /messages/batch request body.
350type BatchMessage = {
396type BatchMessage = {
351 to: PubkeyHex,
397 to: PubkeyHex,
352 encryptedBlob: BlobHex,
398 encryptedBlob: BlobHex,
@@ -354,6 +400,7 @@ type BatchMessage = {
354 messageId: OptionalMessageId,
400 messageId: OptionalMessageId,
355 expiresInMs: Int
401 expiresInMs: Int
403+-- Per-entry result returned by /messages/batch.
357type BatchResult = {messageId: OptionalMessageId, status: MessageStatus}
404type BatchResult = {messageId: OptionalMessageId, status: MessageStatus}
359-- ============================================
406-- ============================================
@@ -480,6 +527,8 @@ route MaintenanceApi where
480route HealthApi where
527route HealthApi where
481 GET /health headers {authorization: Text} -> {ok: Bool, version: Text, pruneHealthy: Bool, heartbeatHealthy: Bool, capacityHealthy: Bool, capacityWarning: Bool, federationHealthy: Bool, watchdogHealthy: Bool, nonceHealthy: Bool, forwardQueueHealthy: Bool, requestPressureHealthy: Bool, draining: Bool, degradedPeers: Int} = Health
528 GET /health headers {authorization: Text} -> {ok: Bool, version: Text, pruneHealthy: Bool, heartbeatHealthy: Bool, capacityHealthy: Bool, capacityWarning: Bool, federationHealthy: Bool, watchdogHealthy: Bool, nonceHealthy: Bool, forwardQueueHealthy: Bool, requestPressureHealthy: Bool, draining: Bool, degradedPeers: Int} = Health
530+-- Per-peer health snapshot for /stats/peers. Latency/gossip-rate fields are
531+-- zero-filled in this simplified server.
483type PeerStatus = {
532type PeerStatus = {
484 server: Text,
533 server: Text,
485 failures: Int,
534 failures: Int,
@@ -493,7 +542,9 @@ type PeerStatus = {
493 latencySamples: Int,
542 latencySamples: Int,
494 gossipEventsPerMin: Int
543 gossipEventsPerMin: Int
545+-- Single presence row exposed via /stats/key (server + expiry only).
496type KeyPresenceEntry = {server: Text, expiresAt: Timestamp}
546type KeyPresenceEntry = {server: Text, expiresAt: Timestamp}
547+-- Mailbox depth ranking entry for /stats/top-recipients.
497type RecipientCount = {pubkey: PubkeyHex, count: Int}
548type RecipientCount = {pubkey: PubkeyHex, count: Int}
499route StatsApi where
550route StatsApi where
@@ -564,6 +615,7 @@ unique = fold (\acc x -> if elem acc x then acc else union acc [x]) []
564withIndex : [a] -> [{i: Int, v: a}]
615withIndex : [a] -> [{i: Int, v: a}]
565withIndex = fold (\acc x -> union acc [{i: count acc, v: x}]) []
616withIndex = fold (\acc x -> union acc [{i: count acc, v: x}]) []
618+-- First element of a list, or Nothing for an empty list.
567headOf : [a] -> Maybe a
619headOf : [a] -> Maybe a
568headOf = \items -> fold (\_ x -> Just {value: x}) (Nothing {}) (takeRelation 1 items)
620headOf = \items -> fold (\_ x -> Just {value: x}) (Nothing {}) (takeRelation 1 items)
@@ -648,6 +700,7 @@ else do
648 rest <- genTokenN (n - 1)
700 rest <- genTokenN (n - 1)
649 yield (take 1 (drop d "0123456789abcdef") ++ rest)
701 yield (take 1 (drop d "0123456789abcdef") ++ rest)
703+-- Standard 48-char hex token used for session bearers and federation nonces.
651genToken : IO {random} Text
704genToken : IO {random} Text
652genToken = genTokenN 48
705genToken = genTokenN 48
@@ -655,30 +708,39 @@ genToken = genTokenN 48
655resolveMessageId : OptionalMessageId -> IO {random} OptionalMessageId
708resolveMessageId : OptionalMessageId -> IO {random} OptionalMessageId
656resolveMessageId = \mid -> if mid != "" then yield mid else genToken
709resolveMessageId = \mid -> if mid != "" then yield mid else genToken
711+-- True when `s` exceeds `maxLen` characters.
658tooLong : Text -> Int -> Bool
712tooLong : Text -> Int -> Bool
659tooLong = \s maxLen -> count (chars s) > maxLen
713tooLong = \s maxLen -> count (chars s) > maxLen
715+-- True when `s` is non-empty, even-length, and only lowercase hex digits.
661isValidHex : Text -> Bool
716isValidHex : Text -> Bool
662isValidHex = \s -> (\cs -> (\n -> n > 0 && n / 2 * 2 == n && all cs (\c -> contains c "0123456789abcdef")) (count cs)) (chars s)
717isValidHex = \s -> (\cs -> (\n -> n > 0 && n / 2 * 2 == n && all cs (\c -> contains c "0123456789abcdef")) (count cs)) (chars s)
719+-- Recursively strip every trailing "." from `s` (DNS root form).
664stripTrailingDot : Text -> Text
720stripTrailingDot : Text -> Text
665stripTrailingDot = \s -> if containsSuffix "." s
721stripTrailingDot = \s -> if containsSuffix "." s
666then stripTrailingDot (take (count (chars s) - 1) s)
722then stripTrailingDot (take (count (chars s) - 1) s)
725+-- Canonical form of a hostname: lowercase, no trailing dot.
669normalizeServerName : Text -> Text
726normalizeServerName : Text -> Text
670normalizeServerName = \s -> toLower (stripTrailingDot s)
727normalizeServerName = \s -> toLower (stripTrailingDot s)
729+-- This server's own hostname in canonical form (used everywhere for self-checks).
672serverHostN : Text
730serverHostN : Text
673serverHostN = normalizeServerName serverHost
731serverHostN = normalizeServerName serverHost
732+-- True when `s` refers to this server.
674isLocalServer : Text -> Bool
733isLocalServer : Text -> Bool
675isLocalServer = \s -> s == serverHostN
734isLocalServer = \s -> s == serverHostN
735+-- True when `s` refers to any server other than this one.
676isRemote : Text -> Bool
736isRemote : Text -> Bool
677isRemote = \s -> not isLocalServer s
737isRemote = \s -> not isLocalServer s
739+-- True when `s` starts with `pre`.
679hasPrefix : Text -> Text -> Bool
740hasPrefix : Text -> Text -> Bool
680hasPrefix = \pre s -> take (count (chars pre)) s == pre
741hasPrefix = \pre s -> take (count (chars pre)) s == pre
743+-- True when `s` ends with `suffix`.
682containsSuffix : Text -> Text -> Bool
744containsSuffix : Text -> Text -> Bool
683containsSuffix = \suffix s -> drop (max 0 (count (chars s) - count (chars suffix))) s == suffix
745containsSuffix = \suffix s -> drop (max 0 (count (chars s) - count (chars suffix))) s == suffix
@@ -710,16 +772,22 @@ isBadServerName = \sn -> sn == "" || sn == "localhost" || not all (chars sn) (\c
710matchIp : Text -> Text -> Bool
772matchIp : Text -> Text -> Bool
711matchIp = \clientIp sessionIp -> sessionIp == "" || clientIp == sessionIp
773matchIp = \clientIp sessionIp -> sessionIp == "" || clientIp == sessionIp
775+-- Pull the token out of an `Authorization: Bearer <token>` header. Returns
776+-- Nothing if the prefix is missing or the token is empty.
713extractToken : Text -> Maybe Text
777extractToken : Text -> Maybe Text
714extractToken = \h -> if hasPrefix "Bearer " h && drop 7 h != ""
778extractToken = \h -> if hasPrefix "Bearer " h && drop 7 h != ""
715then Just {value: drop 7 h}
779then Just {value: drop 7 h}
716else Nothing {}
780else Nothing {}
782+-- True when the header carries a Bearer token equal to the runtime maintenance
783+-- secret. Plain `==` comparison; not constant-time (see file header).
718verifyMaintenanceAuth : Text -> IO {r *runtimeMaintenanceSecret} Bool
784verifyMaintenanceAuth : Text -> IO {r *runtimeMaintenanceSecret} Bool
719verifyMaintenanceAuth = \authorization -> do
785verifyMaintenanceAuth = \authorization -> do
720 secret <- *runtimeMaintenanceSecret
786 secret <- *runtimeMaintenanceSecret
721 yield (secret != "" && extractToken authorization == Just {value: secret})
787 yield (secret != "" && extractToken authorization == Just {value: secret})
789+-- Branch on maintenance-secret auth: run `onAuth` when the bearer matches,
790+-- `onUnauth` otherwise.
723withMaintAuth : Text -> IO {| effs} a -> IO {| effs} a -> IO {r *runtimeMaintenanceSecret | effs} a
791withMaintAuth : Text -> IO {| effs} a -> IO {| effs} a -> IO {r *runtimeMaintenanceSecret | effs} a
724withMaintAuth = \authorization onUnauth onAuth -> do
792withMaintAuth = \authorization onUnauth onAuth -> do
725 authorized <- verifyMaintenanceAuth authorization
793 authorized <- verifyMaintenanceAuth authorization
@@ -748,6 +816,8 @@ gateClientWrite = \auth ip t respond mkErr rateResp onAuth ->
748 yield r.limited
816 yield r.limited
749 if lim then yield (respond rateResp) else onAuth pk)
817 if lim then yield (respond rateResp) else onAuth pk)
819+-- Variant of `gateClientWrite` that skips the drain check (lookups still work
820+-- while draining) and uses the per-key lookup-rate window instead.
751gateLookup : Text -> Text -> Int<Ms> -> (a -> b) -> (Text -> a) -> a -> (Text -> IO {} b) -> IO {r *drainPhase, rw *globalRateCount, rw *globalRateWindowStart, r *sessions} b
821gateLookup : Text -> Text -> Int<Ms> -> (a -> b) -> (Text -> a) -> a -> (Text -> IO {} b) -> IO {r *drainPhase, rw *globalRateCount, rw *globalRateWindowStart, r *sessions} b
752gateLookup = \auth ip t respond mkErr rateResp onAuth ->
822gateLookup = \auth ip t respond mkErr rateResp onAuth ->
753 gateAuth (False {}) auth ip t respond mkErr (\pk -> do
823 gateAuth (False {}) auth ip t respond mkErr (\pk -> do
@@ -759,6 +829,8 @@ gateLookup = \auth ip t respond mkErr rateResp onAuth ->
759 yield r.limited
829 yield r.limited
760 if lim then yield (respond rateResp) else onAuth pk)
830 if lim then yield (respond rateResp) else onAuth pk)
832+-- Resolve a Bearer token to its session pubkey if the session is unexpired and
833+-- the client IP matches. Runs `onAuth pubkey` on success, `onUnauth` otherwise.
762withSessionAuth : Text -> Int<Ms> -> Text -> IO {| e} a -> (PubkeyHex -> IO {| e} a) -> IO {r *sessions | e} a
834withSessionAuth : Text -> Int<Ms> -> Text -> IO {| e} a -> (PubkeyHex -> IO {| e} a) -> IO {r *sessions | e} a
763withSessionAuth = \authorization t clientIp onUnauth onAuth -> do
835withSessionAuth = \authorization t clientIp onUnauth onAuth -> do
764 ses <- *sessions
836 ses <- *sessions
@@ -768,6 +840,10 @@ withSessionAuth = \authorization t clientIp onUnauth onAuth -> do
768 Just {value: s} -> onAuth s.pubkey
840 Just {value: s} -> onAuth s.pubkey
769 _ -> onUnauth
841 _ -> onUnauth
843+-- Build the `Signed <hexsig>:<nonce>` header for an outbound federation call.
844+-- Signs the canonical "scope|timestamp|fromServer|nonce" string with our
845+-- federation private key (the peer fetches our public key via /federation/pubkey
846+-- to verify). Returns "" if no keypair has been generated yet.
771generateFederationAuth : Text -> a -> IO {r *federationPrivateKeyHex, random} Text
847generateFederationAuth : Text -> a -> IO {r *federationPrivateKeyHex, random} Text
772generateFederationAuth = \scope requestTimestamp -> do
848generateFederationAuth = \scope requestTimestamp -> do
773 hex <- *federationPrivateKeyHex
849 hex <- *federationPrivateKeyHex
@@ -802,6 +878,11 @@ verifyFederationAuth = \authorization fromServer scope requestTimestamp -> do
802 _ -> yield False {}
878 _ -> yield False {}
803 else yield False {}
879 else yield False {}
881+-- Combined gate for inbound federation calls. Order of checks (each short-
882+-- circuits with an error code in the response):
883+-- 1. peer not block-listed; 2. peer in allow-list (if any); 3. caller-supplied
884+-- `precondition` holds; 4. clock skew within `clockSkewTolerance`;
885+-- 5. Ed25519 signature verifies; 6. per-peer federation rate limit.
805withFederationAuth = \authorization t respond fromServer scope requestTimestamp precondition action -> do
886withFederationAuth = \authorization t respond fromServer scope requestTimestamp precondition action -> do
806 blocked <- *blockedPeers
887 blocked <- *blockedPeers
807 allowed <- *allowedPeers
888 allowed <- *allowedPeers
@@ -842,6 +923,8 @@ checkRate = \entries key maxRate windowMs t -> (\cur -> if cur.count > maxRate t
842 Just {value: r} -> {r.windowStart, count: r.count + 1}
923 Just {value: r} -> {r.windowStart, count: r.count + 1}
843 _ -> {windowStart: t, count: 1})
924 _ -> {windowStart: t, count: 1})
926+-- Single-counter global rate gate. Resets the counter when the window expires;
927+-- returns True when the limit has been hit (caller responds rate_limited).
845checkGlobalRate : Timestamp -> IO {rw *globalRateCount, rw *globalRateWindowStart} Bool
928checkGlobalRate : Timestamp -> IO {rw *globalRateCount, rw *globalRateWindowStart} Bool
846checkGlobalRate = \t -> atomic (do
929checkGlobalRate = \t -> atomic (do
847 ws <- *globalRateWindowStart
930 ws <- *globalRateWindowStart
@@ -857,6 +940,9 @@ checkGlobalRate = \t -> atomic (do
857 *globalRateCount = c + 1
940 *globalRateCount = c + 1
858 yield (False {}))
941 yield (False {}))
943+-- Same shape as `checkGlobalRate` but charged only by the auth endpoints
944+-- (challenge + verify). Stops a single attacker from exhausting the global
945+-- counter via auth churn.
860checkAuthGlobalRate = \t -> atomic (do
946checkAuthGlobalRate = \t -> atomic (do
861 ws <- *authGlobalRateWindowStart
947 ws <- *authGlobalRateWindowStart
862 c <- *authGlobalRateCount
948 c <- *authGlobalRateCount
@@ -871,6 +957,7 @@ checkAuthGlobalRate = \t -> atomic (do
871 *authGlobalRateCount = c + 1
957 *authGlobalRateCount = c + 1
872 yield (False {}))
958 yield (False {}))
960+-- Per-source-IP rate gate (skipped when the IP is unknown — see `requireClientIp`).
874checkIpRateGate : Text -> Int<Ms> -> IO {rw *ipRates} Bool
961checkIpRateGate : Text -> Int<Ms> -> IO {rw *ipRates} Bool
875checkIpRateGate = \ip t -> if ip == ""
962checkIpRateGate = \ip t -> if ip == ""
876then yield (False {})
963then yield (False {})
@@ -880,6 +967,7 @@ else atomic (do
880 replace *ipRates = r.entries
967 replace *ipRates = r.entries
881 yield r.limited)
968 yield r.limited)
970+-- Per-peer federation rate gate; charged inside `withFederationAuth`.
883checkServerRateGate : Text -> Int -> IO {rw *federationRates} Bool
971checkServerRateGate : Text -> Int -> IO {rw *federationRates} Bool
884checkServerRateGate = \server t -> atomic (do
972checkServerRateGate = \server t -> atomic (do
885 rates <- *federationRates
973 rates <- *federationRates
@@ -908,12 +996,17 @@ authPreCheck = \clientIp t -> do
908-- single read-side gate; `recordFailure`/`clearFailure` are the write side.
996-- single read-side gate; `recordFailure`/`clearFailure` are the write side.
909-- There is no half-open state — a single success clears all accumulated failures.
997-- There is no half-open state — a single success clears all accumulated failures.
999+-- Linear backoff: `retryBackoffBase * failures`, capped at `retryBackoffMax`.
911retryBackoff : Int -> Int<Ms>
1000retryBackoff : Int -> Int<Ms>
912retryBackoff = \failures -> min retryBackoffMax (retryBackoffBase * max 1 failures)
1001retryBackoff = \failures -> min retryBackoffMax (retryBackoffBase * max 1 failures)
1003+-- True when enough time has passed since the last failure for `server` to be
1004+-- worth retrying (or no failure recorded at all).
914shouldRetryServer : Text -> Timestamp -> [ForwardFailure] -> Bool
1005shouldRetryServer : Text -> Timestamp -> [ForwardFailure] -> Bool
915shouldRetryServer = \server t failures -> none failures (\f -> f.server == server && t - f.failedAt < retryBackoff f.failures)
1006shouldRetryServer = \server t failures -> none failures (\f -> f.server == server && t - f.failedAt < retryBackoff f.failures)
1008+-- Bump the failure counter for `server`. Preserves `firstFailedAt` across
1009+-- subsequent failures so health views can show the outage age.
917recordFailure : Text -> IO {rw *forwardFailures, clock} {}
1010recordFailure : Text -> IO {rw *forwardFailures, clock} {}
918recordFailure = \server -> do
1011recordFailure = \server -> do
919 t <- now
1012 t <- now
@@ -927,6 +1020,8 @@ recordFailure = \server -> do
927 {server, failedAt: t, prev.failures, prev.firstFailedAt}
1020 {server, failedAt: t, prev.failures, prev.firstFailedAt}
1023+-- Drop the failure record for `server` (called after any successful peer call).
1024+-- Single-success recovery — there is no half-open state.
930clearFailure : Text -> IO {rw *forwardFailures} {}
1025clearFailure : Text -> IO {rw *forwardFailures} {}
931clearFailure = \server -> atomic (do
1026clearFailure = \server -> atomic (do
932 forwardFailures <- *forwardFailures
1027 forwardFailures <- *forwardFailures
@@ -939,23 +1034,33 @@ clearFailure = \server -> atomic (do
939-- monotonic sequence generation, presence lookup, duplicate detection across
1034-- monotonic sequence generation, presence lookup, duplicate detection across
940-- (messages, ackedIds, deliveredIds), and last-write-wins presence merge.
1035-- (messages, ackedIds, deliveredIds), and last-write-wins presence merge.
1037+-- Clamp a client-supplied TTL to (0, maxPresenceTtl].
942clampTtl : Int<Ms> -> Int<Ms>
1038clampTtl : Int<Ms> -> Int<Ms>
943clampTtl = clamp 1 maxPresenceTtl
1039clampTtl = clamp 1 maxPresenceTtl
1041+-- Clamp a client-supplied message timestamp into [now - messageMaxAge, now].
1042+-- Stops senders from claiming arbitrary future or far-past timestamps.
945clampTimestamp : Timestamp -> Timestamp -> Timestamp
1043clampTimestamp : Timestamp -> Timestamp -> Timestamp
946clampTimestamp = \timestamp t -> clamp (t - messageMaxAge) t timestamp
1044clampTimestamp = \timestamp t -> clamp (t - messageMaxAge) t timestamp
1046+-- Resolve the effective TTL for a stored message: 0/negative means default,
1047+-- otherwise clamp the requested value into [minMessageTtl, unackedMessageMaxAge].
948effectiveMessageTtl : Int<Ms> -> Int<Ms>
1048effectiveMessageTtl : Int<Ms> -> Int<Ms>
949effectiveMessageTtl = \e -> if e <= 0
1049effectiveMessageTtl = \e -> if e <= 0
950then unackedMessageMaxAge
1050then unackedMessageMaxAge
951else clamp minMessageTtl unackedMessageMaxAge e
1051else clamp minMessageTtl unackedMessageMaxAge e
1053+-- Strictly-monotonic next sequence timestamp: max of wall clock and prior+1.
1054+-- Guarantees /poll cursors order events even when many arrive in the same ms.
953nextSeqTs : Timestamp -> Timestamp -> Timestamp
1055nextSeqTs : Timestamp -> Timestamp -> Timestamp
954nextSeqTs = \t seqCounter -> max t (seqCounter + 1)
1056nextSeqTs = \t seqCounter -> max t (seqCounter + 1)
1058+-- Drop duplicates and cap to `maxMessageIds` (defense against bloated requests).
956dedupMessageIds : [MessageIdHex] -> [MessageIdHex]
1059dedupMessageIds : [MessageIdHex] -> [MessageIdHex]
957dedupMessageIds = \ids -> takeRelation maxMessageIds (unique ids)
1060dedupMessageIds = \ids -> takeRelation maxMessageIds (unique ids)
1062+-- All unexpired presence rows for a given pubkey (may include both local and
1063+-- remote entries — the recipient may live on multiple servers simultaneously).
959presenceForKey : [PresenceEntry] -> PubkeyHex -> Timestamp -> [PresenceEntry]
1064presenceForKey : [PresenceEntry] -> PubkeyHex -> Timestamp -> [PresenceEntry]
960presenceForKey = \presence pubkey t -> filter presence (\p -> p.pubkey == pubkey && p.expiresAt > t)
1065presenceForKey = \presence pubkey t -> filter presence (\p -> p.pubkey == pubkey && p.expiresAt > t)
@@ -963,15 +1068,22 @@ presenceForKey = \presence pubkey t -> filter presence (\p -> p.pubkey == pubkey
963maskedServer : [PresenceEntry] -> PubkeyHex -> Timestamp -> Text
1068maskedServer : [PresenceEntry] -> PubkeyHex -> Timestamp -> Text
964maskedServer = \pres pubkey t -> (\here -> if any here (\p -> isLocalServer p.server) then serverHostN else if count here > 0 then "remote" else "") (presenceForKey pres pubkey t)
1069maskedServer = \pres pubkey t -> (\here -> if any here (\p -> isLocalServer p.server) then serverHostN else if count here > 0 then "remote" else "") (presenceForKey pres pubkey t)
1071+-- True when any row in `items` has a matching (messageId, toKey) pair.
966hasMessage : MessageIdHex -> PubkeyHex -> [{messageId: MessageIdHex, toKey: PubkeyHex | a}] -> Bool
1072hasMessage : MessageIdHex -> PubkeyHex -> [{messageId: MessageIdHex, toKey: PubkeyHex | a}] -> Bool
967hasMessage = \mid toKey items -> any items (\x -> x.messageId == mid && x.toKey == toKey)
1073hasMessage = \mid toKey items -> any items (\x -> x.messageId == mid && x.toKey == toKey)
1075+-- Replay-protection check: True if the (messageId, toKey) is already present in
1076+-- the live mailbox, the federated-acked log, or the delivered log.
969isDuplicateMessage : MessageIdHex -> PubkeyHex -> [{messageId: MessageIdHex, toKey: PubkeyHex | a}] -> [{messageId: MessageIdHex, toKey: PubkeyHex | b}] -> [{messageId: MessageIdHex, toKey: PubkeyHex | c}] -> Bool
1077isDuplicateMessage : MessageIdHex -> PubkeyHex -> [{messageId: MessageIdHex, toKey: PubkeyHex | a}] -> [{messageId: MessageIdHex, toKey: PubkeyHex | b}] -> [{messageId: MessageIdHex, toKey: PubkeyHex | c}] -> Bool
970isDuplicateMessage = \mid toKey msgs aids dids -> hasMessage mid toKey msgs || hasMessage mid toKey aids || hasMessage mid toKey dids
1078isDuplicateMessage = \mid toKey msgs aids dids -> hasMessage mid toKey msgs || hasMessage mid toKey aids || hasMessage mid toKey dids
1080+-- Project items through `getServer`, drop our own hostname, and dedupe.
1081+-- Used to derive peer recipient lists from forwards/presence/etc.
972collectPeers : [a] -> (a -> Text) -> [Text]
1082collectPeers : [a] -> (a -> Text) -> [Text]
973collectPeers = \items getServer -> unique (filter (pluck items getServer) isRemote)
1083collectPeers = \items getServer -> unique (filter (pluck items getServer) isRemote)
1085+-- All distinct remote hostnames currently appearing in `presence` (the gossip
1086+-- broadcast set we know about, less ourselves).
975knownPeerServersFromPresence : [PresenceEntry] -> [Text]
1087knownPeerServersFromPresence : [PresenceEntry] -> [Text]
976knownPeerServersFromPresence = \presence -> collectPeers presence (\p -> p.server)
1088knownPeerServersFromPresence = \presence -> collectPeers presence (\p -> p.server)
@@ -986,6 +1098,9 @@ mergePresence = \existing incoming -> fold (\acc e -> (\same -> if any acc (\x -
986-- block. Returns the locally-expired presence rows whose pubkey has no other
1098-- block. Returns the locally-expired presence rows whose pubkey has no other
987-- live local session, so the caller can broadcast offline gossip for them.
1099-- live local session, so the caller can broadcast offline gossip for them.
1101+-- One sweep over every state ref: drops expired rows in a single atomic block.
1102+-- Returns the locally-expired presence rows whose pubkey has no other live
1103+-- local session, so the caller can broadcast offline gossip for them.
989pruneExpired : Int<Ms> -> IO {rw *ackedIds, rw *activePolls, rw *challenges, rw *deliveredIds, rw *forwardFailures, rw *forwards, rw *messages, rw *presence, rw *senderDeliveries, rw *senderExpirations, rw *sessions} [{expiresAt: Timestamp, pubkey: PubkeyHex, server: AnyServerName, timestamp: Timestamp}]
1104pruneExpired : Int<Ms> -> IO {rw *ackedIds, rw *activePolls, rw *challenges, rw *deliveredIds, rw *forwardFailures, rw *forwards, rw *messages, rw *presence, rw *senderDeliveries, rw *senderExpirations, rw *sessions} [{expiresAt: Timestamp, pubkey: PubkeyHex, server: AnyServerName, timestamp: Timestamp}]
990pruneExpired = \t -> atomic do
1105pruneExpired = \t -> atomic do
991 ch <- *challenges
1106 ch <- *challenges
@@ -1054,6 +1169,8 @@ recordAcksAndDeliveries = \toAck t -> do
1054 *senderDeliveries = capList (union sds myDel) 10000 (\d -> d.deliveredAt)
1169 *senderDeliveries = capList (union sds myDel) 10000 (\d -> d.deliveredAt)
1055 yield ackedFed
1170 yield ackedFed
1172+-- Fan out one bundle of gossip events to each peer, skipping peers in backoff.
1173+-- Records or clears federation-failure counters per call.
1057sendBatchedGossip : [Text] -> [GossipEvent] -> IO {} {}
1174sendBatchedGossip : [Text] -> [GossipEvent] -> IO {} {}
1058sendBatchedGossip = \peers events -> forEach peers (\server -> do
1175sendBatchedGossip = \peers events -> forEach peers (\server -> do
1059 t <- now
1176 t <- now
@@ -1072,6 +1189,8 @@ sendBatchedGossip = \peers events -> forEach peers (\server -> do
1072 Err _ -> recordFailure server
1189 Err _ -> recordFailure server
1073 Ok _ -> clearFailure server))
1190 Ok _ -> clearFailure server))
1192+-- Tell known peers that the listed local pubkeys just went offline. No-op when
1193+-- federation is disabled or the list is empty.
1075broadcastOfflineGossip : Int<Ms> -> [{pubkey: PubkeyHex | a}] -> IO {r *presence} {}
1194broadcastOfflineGossip : Int<Ms> -> [{pubkey: PubkeyHex | a}] -> IO {r *presence} {}
1076broadcastOfflineGossip = \t expiredLocal -> do
1195broadcastOfflineGossip = \t expiredLocal -> do
1077 presence <- *presence
1196 presence <- *presence
@@ -1088,6 +1207,9 @@ broadcastOfflineGossip = \t expiredLocal -> do
1088-- comes online: any messages already buffered for that pubkey are enqueued
1207-- comes online: any messages already buffered for that pubkey are enqueued
1089-- as forwards to the newly-known server.
1208-- as forwards to the newly-known server.
1210+-- Walk pending forwards grouped by destination, retry each (up to maxBatchSize
1211+-- per peer) using `/federation/forward`. Drops successful entries; for failures
1212+-- bumps the retry count and gives up after `maxForwardRetries`.
1091retryPendingForwards : IO {r *blockedPeers, r *forwardFailures, r *forwards, clock} {}
1213retryPendingForwards : IO {r *blockedPeers, r *forwardFailures, r *forwards, clock} {}
1092retryPendingForwards = do
1214retryPendingForwards = do
1093 t <- now
1215 t <- now
@@ -1135,6 +1257,8 @@ retryPendingForwards = do
1136 else x))))
1258 else x))))
1260+-- Flush federated ack receipts back to each origin server in one call, then
1261+-- prune the locally-recorded acked entries the peer confirmed.
1138sendAcksAndClean : [{messageId: MessageIdHex, originServer: Text | a}] -> IO {} {}
1262sendAcksAndClean : [{messageId: MessageIdHex, originServer: Text | a}] -> IO {} {}
1139sendAcksAndClean = \pendingAcks -> forEach (collectPeers pendingAcks (\a -> a.originServer)) (\server -> do
1263sendAcksAndClean = \pendingAcks -> forEach (collectPeers pendingAcks (\a -> a.originServer)) (\server -> do
1140 let mids = mapWhere pendingAcks (\a -> a.originServer == server) (\a -> a.messageId)
1264 let mids = mapWhere pendingAcks (\a -> a.originServer == server) (\a -> a.messageId)
@@ -1183,6 +1307,9 @@ forwardQueuedToServer = \pubkey server t -> atomic (do
1183-- expire stale rows, then opportunistically retry pending forwards and refresh
1307-- expire stale rows, then opportunistically retry pending forwards and refresh
1184-- local presence so peers don't see us go offline mid-session.
1308-- local presence so peers don't see us go offline mid-session.
1310+-- One composite background tick: prune expired state, gossip offline for
1311+-- locally-expired keys, retry pending forwards, flush federation acks, and
1312+-- (occasionally) refresh local presence so peers don't see us drop off.
1186pruneAndRetry = \t -> do
1313pruneAndRetry = \t -> do
1187 *lastPrunedAt = t
1314 *lastPrunedAt = t
1188 expiredLocal <- pruneExpired t
1315 expiredLocal <- pruneExpired t
@@ -1196,6 +1323,9 @@ pruneAndRetry = \t -> do
1196 *lastPresenceRefresh = t
1323 *lastPresenceRefresh = t
1197 refreshLocalPresence t))
1324 refreshLocalPresence t))
1326+-- Extend the expiry of local presence rows whose backing session is still live
1327+-- but the presence entry is past half its window. Re-broadcasts an `online`
1328+-- event for the refreshed entries so peers don't time them out.
1199refreshLocalPresence : Int<Ms> -> IO {rw *presence, r *sessions} {}
1329refreshLocalPresence : Int<Ms> -> IO {rw *presence, r *sessions} {}
1200refreshLocalPresence = \t -> do
1330refreshLocalPresence = \t -> do
1201 refreshState <- atomic (do
1331 refreshState <- atomic (do
@@ -2103,6 +2233,7 @@ handleUnblockPeer = \server authorization respond -> withMaintAuth authorization
2103 yield (elem current server))
2233 yield (elem current server))
2104 yield (respond {ok: True {}, unblocked: removed}))
2234 yield (respond {ok: True {}, unblocked: removed}))
2236+-- GET /maintenance/blocked: list the deny-listed peers (empty for unauthorized).
2106handleListBlocked : Text -> ({ok: Bool, peers: [Text]} -> a) -> IO {r *blockedPeers, r *runtimeMaintenanceSecret} a
2237handleListBlocked : Text -> ({ok: Bool, peers: [Text]} -> a) -> IO {r *blockedPeers, r *runtimeMaintenanceSecret} a
2107handleListBlocked = \authorization respond -> do
2238handleListBlocked = \authorization respond -> do
2108 ok <- verifyMaintenanceAuth authorization
2239 ok <- verifyMaintenanceAuth authorization
@@ -2137,6 +2268,7 @@ handleUnallowPeer = \server authorization respond -> withMaintAuth authorization
2137 yield (elem current server))
2268 yield (elem current server))
2138 yield (respond {ok: True {}, removed}))
2269 yield (respond {ok: True {}, removed}))
2271+-- GET /maintenance/allowed: list the allow-listed peers (empty for unauthorized).
2140handleListAllowed : Text -> ({ok: Bool, peers: [Text]} -> a) -> IO {r *allowedPeers, r *runtimeMaintenanceSecret} a
2272handleListAllowed : Text -> ({ok: Bool, peers: [Text]} -> a) -> IO {r *allowedPeers, r *runtimeMaintenanceSecret} a
2141handleListAllowed = \authorization respond -> do
2273handleListAllowed = \authorization respond -> do
2142 ok <- verifyMaintenanceAuth authorization
2274 ok <- verifyMaintenanceAuth authorization
@@ -2428,6 +2560,9 @@ handleStats = \authorization respond -> withMaintAuth authorization (yield (resp
2563+-- All-zero /stats payload returned to unauthorized callers. The shape is kept
2564+-- in lockstep with the response in `handleStats` so older operator tooling
2565+-- never sees a missing field.
2431zeroStats : {capacity: {ackOverflow: Int, ackOverflowMax: Int, ackedIds: Int, ackedIdsMax: Int, activePolls: Int, challenges: Int, challengesMax: Int, deliveredIds: Int, deliveredIdsMax: Int, forwardNonces: Int, forwardNoncesMax: Int, forwards: Int, messageBucketMax: Int, messageBucketMin: Int, messages: Int, nonceEvictions: Int, presence: Int, recipientCounts: Int, sessions: Int, sessionsMax: Int, sessionsPct: Int, totalMessageCount: Int}, federation: {avgLatencyMs: Int, blockedPeers: Int, callCount: Int, drainCompletedAt: Timestamp, enabled: Bool, forwardFailures: Int, forwardServers: Int, gossipFail: Int, gossipSuccess: Int, hungSlots: Int, inFlight: Int, latencyBuckets: {gte2000: Int, lt100: Int, lt2000: Int, lt500: Int}, maxForwardQueueDepth: Int, maxLatencyMs: Int, oldestAckAge: Int, oldestForwardAge: Int, recentGossip: Int, slowVerifies: Int, topFailingPeers: [{failures: Int, server: Text}], verifyFailures: Int}, ok: Bool, rates: {challenge: Int, federation: Int, federationPair: Int, global: Int, gossipEvent: Int, ip: Int, lookup: Int, pair: Int, pendingAckCleanups: Int, recv: Int, rejectedAuth: Int, rejectedFederation: Int, rejectedGlobal: Int, rejectedIp: Int, rejectedPerKey: Int, send: Int, senderDeliveries: Int, senderExpirations: Int, uniqueKeyIp: Int, verifyIp: Int}, timing: {activeRequests: Int, authAvgMs: Int, authCount: Int, authMaxMs: Int, drainPhase: Int, draining: Bool, heartbeatCount: Int, lastHeartbeatAt: Timestamp, lastPruneAt: Timestamp, peakActiveRequests: Int, pollAvgMs: Int, pollCount: Int, pollLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, pollMaxMs: Int, pruneCount: Int, pruneRunning: Timestamp, sendAvgMs: Int, sendCount: Int, sendLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, sendMaxMs: Int, totalEntries: Int, uptime: Int}, version: Text}
2566zeroStats : {capacity: {ackOverflow: Int, ackOverflowMax: Int, ackedIds: Int, ackedIdsMax: Int, activePolls: Int, challenges: Int, challengesMax: Int, deliveredIds: Int, deliveredIdsMax: Int, forwardNonces: Int, forwardNoncesMax: Int, forwards: Int, messageBucketMax: Int, messageBucketMin: Int, messages: Int, nonceEvictions: Int, presence: Int, recipientCounts: Int, sessions: Int, sessionsMax: Int, sessionsPct: Int, totalMessageCount: Int}, federation: {avgLatencyMs: Int, blockedPeers: Int, callCount: Int, drainCompletedAt: Timestamp, enabled: Bool, forwardFailures: Int, forwardServers: Int, gossipFail: Int, gossipSuccess: Int, hungSlots: Int, inFlight: Int, latencyBuckets: {gte2000: Int, lt100: Int, lt2000: Int, lt500: Int}, maxForwardQueueDepth: Int, maxLatencyMs: Int, oldestAckAge: Int, oldestForwardAge: Int, recentGossip: Int, slowVerifies: Int, topFailingPeers: [{failures: Int, server: Text}], verifyFailures: Int}, ok: Bool, rates: {challenge: Int, federation: Int, federationPair: Int, global: Int, gossipEvent: Int, ip: Int, lookup: Int, pair: Int, pendingAckCleanups: Int, recv: Int, rejectedAuth: Int, rejectedFederation: Int, rejectedGlobal: Int, rejectedIp: Int, rejectedPerKey: Int, send: Int, senderDeliveries: Int, senderExpirations: Int, uniqueKeyIp: Int, verifyIp: Int}, timing: {activeRequests: Int, authAvgMs: Int, authCount: Int, authMaxMs: Int, drainPhase: Int, draining: Bool, heartbeatCount: Int, lastHeartbeatAt: Timestamp, lastPruneAt: Timestamp, peakActiveRequests: Int, pollAvgMs: Int, pollCount: Int, pollLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, pollMaxMs: Int, pruneCount: Int, pruneRunning: Timestamp, sendAvgMs: Int, sendCount: Int, sendLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, sendMaxMs: Int, totalEntries: Int, uptime: Int}, version: Text}
2432zeroStats = {
2567zeroStats = {
2433 ok: False {},
2568 ok: False {},
@@ -2672,6 +2807,8 @@ handleMetrics = \authorization respond -> do
2672-- to the corresponding `handleXxx` function. Adding a new route means adding
2807-- to the corresponding `handleXxx` function. Adding a new route means adding
2673-- a `route ... = NewReq` line, a `handleNewReq` definition, and a clause here.
2808-- a `route ... = NewReq` line, a `handleNewReq` definition, and a clause here.
2810+-- Top-level request dispatcher: maps each generated request constructor to
2811+-- its `handleXxx` function. Every route entry above must have a clause here.
2675serve = \req -> case req of
2812serve = \req -> case req of
2676 ReqChallenge {pubkey, clientIp, respond} -> handleChallenge pubkey clientIp respond
2813 ReqChallenge {pubkey, clientIp, respond} -> handleChallenge pubkey clientIp respond
2677 VerifyAuth {pubkey, challenge, signature, revokeOthers, clientIp, respond} -> handleVerifyAuth pubkey challenge signature revokeOthers clientIp respond
2814 VerifyAuth {pubkey, challenge, signature, revokeOthers, clientIp, respond} -> handleVerifyAuth pubkey challenge signature revokeOthers clientIp respond
@@ -2732,6 +2869,8 @@ serve = \req -> case req of
2732-- `pollTimeoutMs` so long-poll holders unblock and return an empty heartbeat
2869-- `pollTimeoutMs` so long-poll holders unblock and return an empty heartbeat
2733-- response, keeping connections fresh.
2870-- response, keeping connections fresh.
2872+-- Endless tick: every `backgroundPruneInterval` run `pruneAndRetry` (skipped
2873+-- when drain phase >= 2) and bump `pruneCount` for /stats and /health.
2735backgroundPrune : IO {r *drainPhase, rw *ackedIds, rw *activePolls, r *blockedPeers, rw *challenges, rw *deliveredIds, rw *forwardFailures, rw *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *pruneCount, rw *senderDeliveries, rw *senderExpirations, rw *sessions, clock} a
2874backgroundPrune : IO {r *drainPhase, rw *ackedIds, rw *activePolls, r *blockedPeers, rw *challenges, rw *deliveredIds, rw *forwardFailures, rw *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *pruneCount, rw *senderDeliveries, rw *senderExpirations, rw *sessions, clock} a
2736backgroundPrune = do
2875backgroundPrune = do
2737 sleep backgroundPruneInterval
2876 sleep backgroundPruneInterval
@@ -2742,6 +2881,8 @@ backgroundPrune = do
2742 pruneAndRetry t)
2881 pruneAndRetry t)
2743 backgroundPrune
2882 backgroundPrune
2884+-- Endless tick that bumps `pollWakeup` every `pollTimeoutMs` so any blocked
2885+-- /poll holders unblock and return an empty heartbeat response.
2745pollHeartbeat : IO {rw *heartbeatCount, rw *lastHeartbeatAt, rw *pollWakeup, clock} a
2886pollHeartbeat : IO {rw *heartbeatCount, rw *lastHeartbeatAt, rw *pollWakeup, clock} a
2746pollHeartbeat = do
2887pollHeartbeat = do
2747 sleep pollTimeoutMs
2888 sleep pollTimeoutMs
@@ -2756,6 +2897,8 @@ pollHeartbeat = do
2756-- server restarts and reset their poll cursor), spawn the two background
2897-- server restarts and reset their poll cursor), spawn the two background
2757-- loops, and start the listener.
2898-- loops, and start the listener.
2900+-- Entry point: stamp startup metadata, lazily generate the federation keypair
2901+-- on first run, fork the background loops, and start the HTTP listener.
2759main : IO {| _} {}
2902main : IO {| _} {}
2760main = do
2903main = do
2761 t <- now
2904 t <- now