@@ -228,9 +228,9 @@ type BlobHex = Text where isValidBoundedHex maxBlobLen
228228type SignatureHex = Text where isValidExactHex signatureLen
229229-- Normalized hostname (lowercased, no trailing dot, length-bounded). The SSRF
230230-- deny-list (`isBadServerName`) is enforced separately at federation egress
231−-- (`handlePingPeer`, `handleRecvGossip`); keeping it out of the type predicate
232−-- lets the default `serverHost = "localhost"` flow through presence rows in a
233−-- non-federated single-node deployment.
231+-- (`handleRecvGossip`); keeping it out of the type predicate lets the default
232+-- `serverHost = "localhost"` flow through presence rows in a non-federated
233+-- single-node deployment.
234234isValidServerName : Text -> Bool
235235isValidServerName = \s -> not tooLong s maxServerNameLen && s == normalizeServerName s
236236type ServerName = Text where isValidServerName
@@ -316,30 +316,21 @@ type RateEntry = {key: Text, windowStart: Timestamp, count: Int}
316316*lastHeartbeatAt : Timestamp
317317-- Wall time of the last self-presence refresh broadcast to peers.
318318*lastPresenceRefresh : Timestamp
319−-- Wall time of process start; underpins /stats uptime and /health warmup window.
319+-- Wall time of process start; underpins the /health warmup window and
320+-- /metrics uptime gauge.
320321*startedAt : Timestamp
321322-- Random 64-bit-ish identity stamped at startup. Clients echo it back on /poll;
322323-- any mismatch means the server restarted and the client must reset its cursor.
323324*serverGeneration : Int
324325
325−-- Bearer secret accepted on /maintenance/* endpoints. Set via the
326−-- `runtimeMaintenanceSecret` CLI flag at startup; empty value disables
327−-- maintenance entirely (every check returns false).
328−*runtimeMaintenanceSecret : Text
329−
330−-- Cumulative tick counters surfaced on /stats; bumped by the background loops.
331−*pruneCount : Int
332−*heartbeatCount : Int
333−
334326-- ============================================
335−-- Routes (response shapes preserved; removed metric fields are zero-filled)
327+-- Routes
336328-- ============================================
337329-- Public HTTP surface, grouped by audience:
338330-- AuthApi -- challenge/verify (client identity)
339331-- ClientApi -- /poll, /messages (send), presence lookup
340332-- FederationApi -- inter-server gossip, forward (single + batch)
341−-- MaintenanceApi -- operator endpoints (prune, admin)
342−-- HealthApi/StatsApi/MetricsApi/ReadyApi -- observability
333+-- HealthApi/MetricsApi/ReadyApi -- observability
343334-- Response field shapes are kept stable for backwards compatibility even when
344335-- the underlying value is no longer computed (zero-filled).
345336
@@ -358,57 +349,16 @@ route FederationApi where
358349 POST {toKey: PubkeyHex, encryptedBlob: BlobHex, fromServer: ServerName} /federation/forward -> {ok: Bool, error: Text, retryAfterMs: Int} = ForwardMessage
359350 POST {forwards: [{toKey: PubkeyHex, encryptedBlob: BlobHex}], fromServer: ServerName} /federation/forward-batch -> {ok: Bool, error: Text, results: [{ok: Bool}], retryAfterMs: Int} = FederationBatchForward
360351
361−route MaintenanceApi where
362− POST /maintenance/prune headers {authorization: Text} -> {ok: Bool} = Prune
363− POST {server: ServerName} /maintenance/ping headers {authorization: Text} -> {ok: Bool, latencyMs: Int, error: Text} = PingPeer
364− GET /maintenance/sessions/{pubkey: PubkeyHex} headers {authorization: Text} -> {sessions: [{token: Text, expiresAt: Timestamp, ip: Text}], count: Int, ok: Bool} = AdminListSessions
365− POST {pubkey: PubkeyHex} /maintenance/sessions/revoke-all headers {authorization: Text} -> {ok: Bool, revokedCount: Int} = AdminRevokeSessions
366− POST {pubkey: PubkeyHex} /maintenance/messages/purge headers {authorization: Text} -> {ok: Bool, purgedCount: Int} = AdminPurgeMessages
367− POST {ip: Text} /maintenance/sessions/revoke-ip headers {authorization: Text} -> {ok: Bool, revokedCount: Int, affectedKeys: Int} = AdminRevokeIp
368− POST {limit: Int} /maintenance/sessions/list headers {authorization: Text} -> {sessions: [{pubkey: PubkeyHex, count: Int, ips: [Text], latestExpiry: Timestamp}], ok: Bool, total: Int} = AdminListAllSessions
369− GET /maintenance/rate-limits headers {authorization: Text} -> {ok: Bool, globalRequest: Int, ipRate: Int, sendRate: Int, federationRate: Int, authGlobal: Int, recvRate: Int, challengeRate: Int, pairRate: Int, lookupRate: Int} = GetRateLimits
370− POST /maintenance/nonces/flush headers {authorization: Text} -> {ok: Bool, flushedCount: Int} = FlushNonces
371− POST /maintenance/reconcile headers {authorization: Text} -> {ok: Bool, messageDrift: Int, presenceDrift: Int, sessionDrift: Int} = Reconcile
372− GET /maintenance/config headers {authorization: Text} -> {ok: Bool, pollTimeoutMs: Int} = GetConfig
373−
374352route HealthApi where
375353 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, degradedPeers: Int} = Health
376354
377−-- Per-peer health snapshot for /stats/peers. Latency/gossip-rate fields are
378−-- zero-filled in this simplified server.
379−type PeerStatus = {
380− server: Text,
381− failures: Int,
382− lastFailedAt: Timestamp,
383− firstFailedAt: Timestamp,
384− backoffMs: Int,
385− retriable: Bool,
386− pendingForwards: Int,
387− avgLatencyMs: Int,
388− maxLatencyMs: Int,
389− latencySamples: Int,
390− gossipEventsPerMin: Int
391−}
392−-- Single presence row exposed via /stats/key (server + expiry only).
393−type KeyPresenceEntry = {server: Text, expiresAt: Timestamp}
394−-- Mailbox depth ranking entry for /stats/top-recipients.
395−type RecipientCount = {pubkey: PubkeyHex, count: Int}
396−
397−route StatsApi where
398− GET /stats headers {authorization: Text} -> {ok: Bool, version: Text, capacity: {sessions: Int, sessionsMax: Int, sessionsPct: Int, messages: Int, totalMessageCount: Int, presence: Int, forwards: Int, challenges: Int, challengesMax: Int, forwardNonces: Int, forwardNoncesMax: Int, nonceEvictions: Int, recipientCounts: Int, messageBucketMax: Int, messageBucketMin: Int}, federation: {enabled: Bool, inFlight: Int, hungSlots: Int, avgLatencyMs: Int, maxLatencyMs: Int, callCount: Int, slowVerifies: Int, verifyFailures: Int, forwardFailures: Int, oldestForwardAge: Int, recentGossip: Int, blockedPeers: Int, forwardServers: Int, maxForwardQueueDepth: Int, topFailingPeers: [{server: Text, failures: Int}], gossipSuccess: Int, gossipFail: Int, latencyBuckets: {lt100: Int, lt500: Int, lt2000: Int, gte2000: Int}}, rates: {send: Int, challenge: Int, federation: Int, federationPair: Int, global: Int, ip: Int, lookup: Int, recv: Int, pair: Int, gossipEvent: Int, verifyIp: Int, uniqueKeyIp: Int, rejectedGlobal: Int, rejectedIp: Int, rejectedAuth: Int, rejectedPerKey: Int, rejectedFederation: Int}, timing: {pruneCount: Int, pruneRunning: Timestamp, heartbeatCount: Int, uptime: Int, lastPruneAt: Timestamp, lastHeartbeatAt: Timestamp, totalEntries: Int, activeRequests: Int, peakActiveRequests: Int, pollAvgMs: Int, pollMaxMs: Int, pollCount: Int, pollLatencyBuckets: {lt50: Int, lt200: Int, lt1000: Int, gte1000: Int}, sendAvgMs: Int, sendMaxMs: Int, sendCount: Int, sendLatencyBuckets: {lt50: Int, lt200: Int, lt1000: Int, gte1000: Int}, authAvgMs: Int, authMaxMs: Int, authCount: Int}} = Stats
399− GET /stats/peers headers {authorization: Text} -> {peers: [PeerStatus], ok: Bool} = StatsPeers
400− GET /stats/key/{pubkey: PubkeyHex} headers {authorization: Text} -> {messages: Int, presence: [KeyPresenceEntry], sessions: Int, forwards: Int, forwardDetails: [{server: Text, retries: Int}], ok: Bool} = StatsKey
401− POST {limit: Int} /stats/top-recipients headers {authorization: Text} -> {recipients: [RecipientCount], ok: Bool, total: Int} = TopRecipients
402− GET /stats/forwards headers {authorization: Text} -> {servers: [{server: Text, count: Int, totalRetries: Int}], ok: Bool, total: Int} = StatsForwards
403− GET /stats/rates headers {authorization: Text} -> {ok: Bool, scalePct: Int, globalRequest: Int, ipRate: Int, sendRate: Int, federationRate: Int, authGlobal: Int, recvRate: Int, challengeRate: Int, pairRate: Int, lookupRate: Int} = StatsRates
404−
405355route MetricsApi where
406356 GET /metrics headers {authorization: Text} -> {metrics: Text, ok: Bool} = Metrics
407357
408358route ReadyApi where
409359 GET /ready -> {ready: Bool} = Ready
410360
411−route Api = AuthApi | ClientApi | FederationApi | MaintenanceApi | HealthApi | StatsApi | MetricsApi | ReadyApi
361+route Api = AuthApi | ClientApi | FederationApi | HealthApi | MetricsApi | ReadyApi
412362
413363-- ============================================
414364-- Generic helpers
@@ -469,10 +419,6 @@ headOf = \items -> fold (\_ x -> Just {value: x}) (Nothing {}) (takeRelation 1 i
469419capList : [a] -> Int -> (a -> b) -> [a]
470420capList = \items maxN getKey -> dropRelation (max 0 (count items - maxN)) (sortBy getKey items)
471421
472−-- Integer percentage with zero-denominator guard.
473−pct : Int -> Int -> Int
474−pct = \cur maxN -> if maxN > 0 then cur * 100 / maxN else 0
475−
476422-- Cap pred-matching entries to maxN-1 (caller adds one more). Splits the list
477423-- into "doesn't match" (untouched) and "matches" (capped + LRU-evicted) so a
478424-- single key can't exhaust a global pool — see `maxChallengesPerKey` and
@@ -585,7 +531,7 @@ isBadServerName = \sn -> sn == "" || sn == "localhost" || not all (chars sn) (\c
585531-- ============================================
586532-- Auth helpers
587533-- ============================================
588−-- Bearer token extraction, session lookup, maintenance secret check, and the
534+-- Bearer token extraction, session lookup, stats secret check, and the
589535-- `gateAuth`/`gateLookup` combinators that every client handler funnels
590536-- through (global rate → per-key rate → session).
591537-- Federation requests are unauthenticated: anyone can hit /federation/*.
@@ -602,20 +548,6 @@ extractToken = \h -> if hasPrefix "Bearer " h && drop 7 h != ""
602548then Just {value: drop 7 h}
603549else Nothing {}
604550
605−-- True when the header carries a Bearer token equal to the runtime maintenance
606−-- secret. Plain `==` comparison; not constant-time (see file header).
607−verifyMaintenanceAuth : Text -> IO {r *runtimeMaintenanceSecret} Bool
608−verifyMaintenanceAuth = \authorization -> do
609− secret <- *runtimeMaintenanceSecret
610− yield (secret != "" && extractToken authorization == Just {value: secret})
611−
612−-- Branch on maintenance-secret auth: run `onAuth` when the bearer matches,
613−-- `onUnauth` otherwise.
614−withMaintAuth : Text -> IO effs a -> IO effs a -> IO {r *runtimeMaintenanceSecret | effs} a
615−withMaintAuth = \authorization onUnauth onAuth -> do
616− authorized <- verifyMaintenanceAuth authorization
617− if authorized then onAuth else onUnauth
618−
619551-- Common gate for handlers: global rate, session auth.
620552-- mkErr is called with one of: "rate_limited", "unauthorized".
621553gateAuth : Text -> Text -> Timestamp -> (Text -> resp) -> (PubkeyHex -> IO {} resp) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} resp
@@ -902,9 +834,9 @@ forwardQueuedToServer = \pubkey server -> atomic (do
902834-- ============================================
903835-- Background loops
904836-- ============================================
905−-- Composite tick run from `backgroundPrune` (and on demand via /maintenance/prune):
906−-- expire stale rows, then opportunistically retry pending forwards and refresh
907−-- local presence so peers don't see us go offline mid-session.
837+-- Composite tick run from `backgroundPrune`: expire stale rows, then
838+-- opportunistically retry pending forwards and refresh local presence so peers
839+-- don't see us go offline mid-session.
908840
909841-- One composite background tick: prune expired state, gossip offline for
910842-- locally-expired keys, retry pending forwards, and (occasionally) refresh
@@ -948,7 +880,7 @@ refreshLocalPresence = \t -> do
948880-- session also installs a local presence row and gossips an `online`
949881-- event to known peers.
950882-- Sessions expire on their own (`sessionExpiry`); there is no client-driven
951−-- revoke/logout. Operators can force-revoke via `/maintenance/sessions/*`.
883+-- revoke/logout.
952884
953885-- POST /auth/challenge: issue a fresh signed-nonce challenge for `pubkey`.
954886-- Capped per-key (maxChallengesPerKey) and rate-limited; the IP is recorded
@@ -1361,29 +1293,8 @@ handleFederationBatchForward = \forwards _ -> do
13611293 yield {ok: True {}, error: "", results, retryAfterMs: 0}
13621294
13631295-- ============================================
1364−-- Maintenance handlers
1296+-- Health / readiness handlers
13651297-- ============================================
1366−-- Operator endpoints, all gated by `runtimeMaintenanceSecret` (Bearer header).
1367−-- Admin endpoints can revoke sessions by pubkey or IP, purge a recipient's
1368−-- mailbox, list aggregated session activity, rotate the maintenance secret,
1369−-- and read live config.
1370−
1371−-- POST /maintenance/prune: trigger an out-of-band `pruneAndRetry` tick.
1372−-- Useful when the operator wants to force expiry/forward retries without
1373−-- waiting for the next `backgroundPrune` interval.
1374−handlePrune : Text -> IO {r *runtimeMaintenanceSecret, rw *challenges, rw *forwardFailures, r *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *sessions, clock} {ok: Bool}
1375−handlePrune = \authorization -> do
1376− t <- now
1377− authorized <- verifyMaintenanceAuth authorization
1378− when authorized (fork (pruneAndRetry t))
1379− yield {ok: authorized}
1380−
1381−-- POST /maintenance/reconcile: stub. Production builds run a state
1382−-- reconciliation pass here; this simplified server reports zero drift.
1383−handleReconcile : Text -> IO {r *runtimeMaintenanceSecret} {messageDrift: Int, ok: Bool, presenceDrift: Int, sessionDrift: Int}
1384−handleReconcile = \authorization -> do
1385− authorized <- verifyMaintenanceAuth authorization
1386− yield {ok: authorized, messageDrift: 0, presenceDrift: 0, sessionDrift: 0}
13871298
13881299-- GET /health: aggregate readiness flags. During an initial warmup window
13891300-- (3 prune intervals after startup) prune/heartbeat checks always pass to
@@ -1420,431 +1331,6 @@ handleReady = do
14201331 lastPrune <- *lastPrunedAt
14211332 yield {ready: lastPrune > 0 && lastPrune >= sa}
14221333
1423−-- POST /maintenance/ping: send a zero-event gossip to a peer and return the
1424−-- round-trip latency. Useful for diagnosing federation reachability without
1425−-- waiting for organic traffic.
1426−handlePingPeer : Text -> Text -> IO {r *runtimeMaintenanceSecret, network, clock} {error: Text, latencyMs: Int, ok: Bool}
1427−handlePingPeer = \server authorization -> withMaintAuth authorization (yield {
1428− ok: False {},
1429− latencyMs: 0,
1430− error: "unauthorized"
1431−}) (if isBadServerName server
1432−then yield {ok: False {}, latencyMs: 0, error: "invalid_server"}
1433−else do
1434− startTime <- now
1435− result <- fetch (federationUrl server) (RecvGossip {events: [], fromServer: serverHost})
1436− endTime <- now
1437− case result of
1438− Err e -> yield {ok: False {}, latencyMs: endTime - startTime, error: show e}
1439− Ok {value: r} -> yield {r.ok, latencyMs: endTime - startTime, r.error})
1440−
1441−-- GET /maintenance/sessions/{pubkey}: list a single user's active sessions.
1442−-- Token values are masked ("***") — operators see expiry and ip only.
1443−handleAdminListSessions : PubkeyHex -> Text -> IO {r *runtimeMaintenanceSecret, r *sessions} {count: Int, ok: Bool, sessions: [{expiresAt: Int<Ms>, ip: Text, token: Text}]}
1444−handleAdminListSessions = \pubkey authorization -> do
1445− ok <- verifyMaintenanceAuth authorization
1446− ses <- *sessions
1447− let mine = if ok
1448− then mapWhere ses (\s -> s.pubkey == pubkey) (\s -> {token: "***", s.expiresAt, s.ip})
1449− else []
1450− yield {sessions: mine, count: count mine, ok}
1451−
1452−-- POST /maintenance/sessions/revoke-all: drop every session and local presence
1453−-- row for `pubkey`. Operator-side kick for a compromised key.
1454−handleAdminRevokeSessions : PubkeyHex -> Text -> IO {rw *presence, r *runtimeMaintenanceSecret, rw *sessions} {ok: Bool, revokedCount: Int}
1455−handleAdminRevokeSessions = \pubkey authorization -> withMaintAuth authorization (yield {
1456− ok: False {},
1457− revokedCount: 0
1458−}) (do
1459− revoked <- atomic (do
1460− ses <- *sessions
1461− let same = \s -> s.pubkey == pubkey
1462− *sessions = removeWhere ses same
1463− pres <- *presence
1464− *presence = filter pres (\p -> p.pubkey != pubkey || isRemote p.server)
1465− yield (countWhere ses same))
1466− yield {ok: True {}, revokedCount: revoked})
1467−
1468−-- POST /maintenance/messages/purge: drop all queued/forwarding messages
1469−-- destined for `pubkey`. With the federation ack flow gone, there's nothing
1470−-- to ack back — peers will discover the absence on their next forward attempt.
1471−handleAdminPurgeMessages : PubkeyHex -> Text -> IO {rw *forwards, rw *messages, r *runtimeMaintenanceSecret} {ok: Bool, purgedCount: Int}
1472−handleAdminPurgeMessages = \pubkey authorization -> withMaintAuth authorization (yield {
1473− ok: False {},
1474− purgedCount: 0
1475−}) (do
1476− purged <- atomic (do
1477− msgs <- *messages
1478− let mine = \m -> m.toKey == pubkey
1479− let purgedMsgs = filter msgs mine
1480− *messages = removeWhere msgs mine
1481− fwds <- *forwards
1482− *forwards = filter fwds (\f -> f.toKey != pubkey)
1483− yield (count purgedMsgs))
1484− yield {ok: True {}, purgedCount: purged})
1485−
1486−-- POST /maintenance/sessions/revoke-ip: kill every session bound to a given
1487−-- client IP, regardless of pubkey. Reports total revoked + distinct keys.
1488−handleAdminRevokeIp : Text -> Text -> IO {r *runtimeMaintenanceSecret, rw *sessions} {affectedKeys: Int, ok: Bool, revokedCount: Int}
1489−handleAdminRevokeIp = \ip authorization -> withMaintAuth authorization (yield {
1490− ok: False {},
1491− revokedCount: 0,
1492− affectedKeys: 0
1493−}) (do
1494− keys <- if ip == ""
1495− then yield []
1496− else atomic (do
1497− ses <- *sessions
1498− let same = \s -> s.ip == ip
1499− *sessions = removeWhere ses same
1500− yield (mapWhere ses same (\s -> s.pubkey)))
1501− yield {ok: ip != "", revokedCount: count keys, affectedKeys: count keys})
1502−
1503−-- POST /maintenance/sessions/list: paged session inventory aggregated by
1504−-- pubkey (count, distinct ips, latest expiry). Sorted by descending count.
1505−handleAdminListAllSessions : Int -> Text -> IO {r *runtimeMaintenanceSecret, r *sessions, clock} {ok: Bool, sessions: [{count: Int, ips: [Text], latestExpiry: Int, pubkey: PubkeyHex}], total: Int}
1506−handleAdminListAllSessions = \limit authorization -> withMaintAuth authorization (yield {
1507− sessions: [],
1508− ok: False {},
1509− total: 0
1510−}) (do
1511− t <- now
1512− ses <- *sessions
1513− let active = filter ses (\s -> s.expiresAt > t)
1514− let grouped = pluck (pluck active (\s -> s.pubkey)) (\pk -> (\mine -> {pubkey: pk, count: count mine, ips: mapWhere mine (\s -> s.ip != "") (\s -> s.ip), latestExpiry: fold (\acc s -> max acc s.expiresAt) 0 mine}) (filter active (\s -> s.pubkey == pk)))
1515− let cap = clamp 1 500 (if limit <= 0 then 100 else limit)
1516− let top = takeRelation cap (sortBy (\g -> 0 - g.count) grouped)
1517− yield {sessions: top, ok: True {}, total: count grouped})
1518−
1519−-- GET /maintenance/rate-limits: expose the configured rate ceilings. Returns
1520−-- zeros for unauthenticated callers (response shape stays stable).
1521−handleGetRateLimits : Text -> IO {r *runtimeMaintenanceSecret} {authGlobal: Int, challengeRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, sendRate: Int}
1522−handleGetRateLimits = \authorization -> do
1523− ok <- verifyMaintenanceAuth authorization
1524− let v = \x -> if ok then x else 0
1525− yield {
1526− ok,
1527− globalRequest: v maxGlobalRequestRate,
1528− ipRate: v maxIpRatePerIp,
1529− sendRate: v maxSendRatePerKey,
1530− federationRate: 0,
1531− authGlobal: v maxAuthGlobalRate,
1532− recvRate: v maxRecvRatePerKey,
1533− challengeRate: v maxChallengeRatePerKey,
1534− pairRate: v maxPairRatePerPair,
1535− lookupRate: v maxLookupRatePerKey
1536− }
1537−
1538−-- POST /maintenance/nonces/flush: stub. Nonce caches were removed; the
1539−-- endpoint is preserved so older operator tooling keeps working.
1540−handleFlushNonces : Text -> IO {r *runtimeMaintenanceSecret} {flushedCount: Int, ok: Bool}
1541−handleFlushNonces = \authorization -> do
1542− authorized <- verifyMaintenanceAuth authorization
1543− yield {ok: authorized, flushedCount: 0}
1544−
1545−-- GET /maintenance/config: expose a small set of operationally-relevant
1546−-- compile-time constants (poll timeout).
1547−handleGetConfig : Text -> IO {r *runtimeMaintenanceSecret} {ok: Bool, pollTimeoutMs: Int}
1548−handleGetConfig = \authorization -> do
1549− ok <- verifyMaintenanceAuth authorization
1550− let v = \x -> if ok then x else 0
1551− yield {ok, pollTimeoutMs: v pollTimeoutMs}
1552−
1553−-- GET /stats: capacity gauges + minimal federation/timing snapshot. Most of
1554−-- the historical metric fields are zero-filled (see `zeroStats`) — only the
1555−-- counts that come straight from the state refs are populated.
1556−handleStats : Text -> IO {r *challenges, r *forwards, r *heartbeatCount, r *lastHeartbeatAt, r *lastPrunedAt, r *messages, r *presence, r *pruneCount, r *runtimeMaintenanceSecret, r *sessions, r *startedAt, clock} {capacity: {challenges: Int, challengesMax: 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, 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, 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, recv: Int, rejectedAuth: Int, rejectedFederation: Int, rejectedGlobal: Int, rejectedIp: Int, rejectedPerKey: Int, send: Int, uniqueKeyIp: Int, verifyIp: Int}, timing: {activeRequests: Int, authAvgMs: Int, authCount: Int, authMaxMs: Int, 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}
1557−handleStats = \authorization -> withMaintAuth authorization (yield zeroStats) (do
1558− t <- now
1559− sa <- *startedAt
1560− sessions <- *sessions
1561− msgs <- *messages
1562− pres <- *presence
1563− fwds <- *forwards
1564− chs <- *challenges
1565− pc <- *pruneCount
1566− hc <- *heartbeatCount
1567− lp <- *lastPrunedAt
1568− lh <- *lastHeartbeatAt
1569− let sCount = count sessions
1570− let mCount = count msgs
1571− let pCount = count pres
1572− let fCount = count fwds
1573− yield {
1574− ok: True {},
1575− version: serverBuildVersion,
1576− capacity: {
1577− sessions: sCount,
1578− sessionsMax: maxSessions,
1579− sessionsPct: pct sCount maxSessions,
1580− messages: mCount,
1581− totalMessageCount: mCount,
1582− presence: pCount,
1583− forwards: fCount,
1584− challenges: count chs,
1585− challengesMax: maxChallenges,
1586− forwardNonces: 0,
1587− forwardNoncesMax: 0,
1588− nonceEvictions: 0,
1589− recipientCounts: 0,
1590− messageBucketMax: 0,
1591− messageBucketMin: 0
1592− },
1593− federation: {
1594− enabled: federationEnabled,
1595− inFlight: 0,
1596− hungSlots: 0,
1597− avgLatencyMs: 0,
1598− maxLatencyMs: 0,
1599− callCount: 0,
1600− slowVerifies: 0,
1601− verifyFailures: 0,
1602− forwardFailures: 0,
1603− oldestForwardAge: 0,
1604− recentGossip: 0,
1605− blockedPeers: 0,
1606− forwardServers: 0,
1607− maxForwardQueueDepth: 0,
1608− topFailingPeers: [],
1609− gossipSuccess: 0,
1610− gossipFail: 0,
1611− latencyBuckets: {lt100: 0, lt500: 0, lt2000: 0, gte2000: 0}
1612− },
1613− rates: {
1614− send: 0,
1615− challenge: 0,
1616− federation: 0,
1617− federationPair: 0,
1618− global: 0,
1619− ip: 0,
1620− lookup: 0,
1621− recv: 0,
1622− pair: 0,
1623− gossipEvent: 0,
1624− verifyIp: 0,
1625− uniqueKeyIp: 0,
1626− rejectedGlobal: 0,
1627− rejectedIp: 0,
1628− rejectedAuth: 0,
1629− rejectedPerKey: 0,
1630− rejectedFederation: 0
1631− },
1632− timing: {
1633− pruneCount: pc,
1634− pruneRunning: 0,
1635− heartbeatCount: hc,
1636− uptime: t - sa,
1637− lastPruneAt: lp,
1638− lastHeartbeatAt: lh,
1639− totalEntries: sCount + mCount + pCount + fCount,
1640− activeRequests: 0,
1641− peakActiveRequests: 0,
1642− pollAvgMs: 0,
1643− pollMaxMs: 0,
1644− pollCount: 0,
1645− pollLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0},
1646− sendAvgMs: 0,
1647− sendMaxMs: 0,
1648− sendCount: 0,
1649− sendLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0},
1650− authAvgMs: 0,
1651− authMaxMs: 0,
1652− authCount: 0
1653− }
1654− })
1655−
1656−-- All-zero /stats payload returned to unauthorized callers. The shape is kept
1657−-- in lockstep with the response in `handleStats` so older operator tooling
1658−-- never sees a missing field.
1659−zeroStats : {capacity: {challenges: Int, challengesMax: 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, 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, 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, recv: Int, rejectedAuth: Int, rejectedFederation: Int, rejectedGlobal: Int, rejectedIp: Int, rejectedPerKey: Int, send: Int, uniqueKeyIp: Int, verifyIp: Int}, timing: {activeRequests: Int, authAvgMs: Int, authCount: Int, authMaxMs: Int, 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}
1660−zeroStats = {
1661− ok: False {},
1662− version: serverBuildVersion,
1663− capacity: {
1664− sessions: 0,
1665− sessionsMax: 0,
1666− sessionsPct: 0,
1667− messages: 0,
1668− totalMessageCount: 0,
1669− presence: 0,
1670− forwards: 0,
1671− challenges: 0,
1672− challengesMax: 0,
1673− forwardNonces: 0,
1674− forwardNoncesMax: 0,
1675− nonceEvictions: 0,
1676− recipientCounts: 0,
1677− messageBucketMax: 0,
1678− messageBucketMin: 0
1679− },
1680− federation: {
1681− enabled: False {},
1682− inFlight: 0,
1683− hungSlots: 0,
1684− avgLatencyMs: 0,
1685− maxLatencyMs: 0,
1686− callCount: 0,
1687− slowVerifies: 0,
1688− verifyFailures: 0,
1689− forwardFailures: 0,
1690− oldestForwardAge: 0,
1691− recentGossip: 0,
1692− blockedPeers: 0,
1693− forwardServers: 0,
1694− maxForwardQueueDepth: 0,
1695− topFailingPeers: [],
1696− gossipSuccess: 0,
1697− gossipFail: 0,
1698− latencyBuckets: {lt100: 0, lt500: 0, lt2000: 0, gte2000: 0}
1699− },
1700− rates: {
1701− send: 0,
1702− challenge: 0,
1703− federation: 0,
1704− federationPair: 0,
1705− global: 0,
1706− ip: 0,
1707− lookup: 0,
1708− recv: 0,
1709− pair: 0,
1710− gossipEvent: 0,
1711− verifyIp: 0,
1712− uniqueKeyIp: 0,
1713− rejectedGlobal: 0,
1714− rejectedIp: 0,
1715− rejectedAuth: 0,
1716− rejectedPerKey: 0,
1717− rejectedFederation: 0
1718− },
1719− timing: {
1720− pruneCount: 0,
1721− pruneRunning: 0,
1722− heartbeatCount: 0,
1723− uptime: 0,
1724− lastPruneAt: 0,
1725− lastHeartbeatAt: 0,
1726− totalEntries: 0,
1727− activeRequests: 0,
1728− peakActiveRequests: 0,
1729− pollAvgMs: 0,
1730− pollMaxMs: 0,
1731− pollCount: 0,
1732− pollLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0},
1733− sendAvgMs: 0,
1734− sendMaxMs: 0,
1735− sendCount: 0,
1736− sendLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0},
1737− authAvgMs: 0,
1738− authMaxMs: 0,
1739− authCount: 0
1740− }
1741−}
1742−
1743−-- GET /stats/peers: per-peer failure summary derived from `forwardFailures`,
1744−-- including current backoff and pending forward queue depth.
1745−handleStatsPeers : Text -> IO {r *forwardFailures, r *forwards, r *runtimeMaintenanceSecret, clock} {ok: Bool, peers: [{avgLatencyMs: Int, backoffMs: Int<Ms>, failures: Int, firstFailedAt: Int<Ms>, gossipEventsPerMin: Int, lastFailedAt: Int<Ms>, latencySamples: Int, maxLatencyMs: Int, pendingForwards: Int, retriable: Bool, server: Text}]}
1746−handleStatsPeers = \authorization -> withMaintAuth authorization (yield {peers: [], ok: False {}}) (do
1747− t <- now
1748− failures <- *forwardFailures
1749− fwds <- *forwards
1750− yield {
1751− peers: pluck failures (\f -> {
1752− f.server,
1753− f.failures,
1754− lastFailedAt: f.failedAt,
1755− f.firstFailedAt,
1756− backoffMs: retryBackoff f.failures,
1757− retriable: shouldRetryServer f.server t failures,
1758− pendingForwards: countWhere fwds (\x -> x.toServer == f.server),
1759− avgLatencyMs: 0,
1760− maxLatencyMs: 0,
1761− latencySamples: 0,
1762− gossipEventsPerMin: 0
1763− }),
1764− ok: True {}
1765− })
1766−
1767−-- GET /stats/key/{pubkey}: per-key footprint — message count, presence rows,
1768−-- session count, and queued forwards (with details).
1769−handleStatsKey : PubkeyHex -> Text -> IO {r *forwards, r *messages, r *presence, r *runtimeMaintenanceSecret, r *sessions, clock} {forwardDetails: [{retries: Int, server: ServerName}], forwards: Int, messages: Int, ok: Bool, presence: [{expiresAt: Int<Ms>, server: ServerName}], sessions: Int}
1770−handleStatsKey = \pubkey authorization -> withMaintAuth authorization (yield {
1771− messages: 0,
1772− presence: [],
1773− sessions: 0,
1774− forwards: 0,
1775− forwardDetails: [],
1776− ok: False {}
1777−}) (do
1778− t <- now
1779− msgs <- *messages
1780− pres <- *presence
1781− ses <- *sessions
1782− fwds <- *forwards
1783− let myFwds = filter fwds (\x -> x.toKey == pubkey)
1784− yield {
1785− messages: countWhere msgs (\x -> x.toKey == pubkey),
1786− presence: mapWhere pres (\x -> x.pubkey == pubkey && x.expiresAt > t) (\x -> {
1787− x.server,
1788− x.expiresAt
1789− }),
1790− sessions: countWhere ses (\x -> x.pubkey == pubkey),
1791− forwards: count myFwds,
1792− forwardDetails: pluck myFwds (\x -> {server: x.toServer, x.retries}),
1793− ok: True {}
1794− })
1795−
1796−-- POST /stats/top-recipients: ranked list of pubkeys by mailbox depth.
1797−-- `limit` defaults to 20, capped at 100, used to spot hot-spots / abuse.
1798−handleTopRecipients : Int -> Text -> IO {r *messages, r *runtimeMaintenanceSecret} {ok: Bool, recipients: [RecipientCount], total: Int}
1799−handleTopRecipients = \limit authorization -> withMaintAuth authorization (yield {
1800− recipients: [],
1801− ok: False {},
1802− total: 0
1803−}) (do
1804− msgs <- *messages
1805− let counts = pluck (pluck msgs (\m -> m.toKey)) (\pk -> {
1806− pubkey: pk,
1807− count: countWhere msgs (\m -> m.toKey == pk)
1808− })
1809− let cap = clamp 1 100 (if limit <= 0 then 20 else limit)
1810− let top = takeRelation cap (sortBy (\c -> 0 - c.count) counts)
1811− yield {recipients: top, ok: True {}, total: count counts})
1812−
1813−-- GET /stats/forwards: per-destination forward queue summary — count and
1814−-- total accumulated retries.
1815−handleStatsForwards : Text -> IO {r *forwards, r *runtimeMaintenanceSecret} {ok: Bool, servers: [{count: Int<u>, server: ServerName, totalRetries: Int}], total: Int}
1816−handleStatsForwards = \authorization -> withMaintAuth authorization (yield {
1817− servers: [],
1818− ok: False {},
1819− total: 0
1820−}) (do
1821− fwds <- *forwards
1822− yield {
1823− servers: pluck (collectPeers fwds (\f -> f.toServer)) (\s -> (\svFwds -> {server: s, count: count svFwds, totalRetries: fold (\acc f -> acc + f.retries) 0 svFwds}) (filter fwds (\f -> f.toServer == s))),
1824− ok: True {},
1825− total: count fwds
1826− })
1827−
1828−-- GET /stats/rates: same shape as /maintenance/rate-limits with an extra
1829−-- scalePct field. Kept separate for backwards compatibility with older clients.
1830−handleStatsRates : Text -> IO {r *runtimeMaintenanceSecret} {authGlobal: Int, challengeRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, scalePct: Int, sendRate: Int}
1831−handleStatsRates = \authorization -> do
1832− ok <- verifyMaintenanceAuth authorization
1833− let v = \x -> if ok then x else 0
1834− yield {
1835− ok,
1836− scalePct: v 100,
1837− globalRequest: v maxGlobalRequestRate,
1838− ipRate: v maxIpRatePerIp,
1839− sendRate: v maxSendRatePerKey,
1840− federationRate: 0,
1841− authGlobal: v maxAuthGlobalRate,
1842− recvRate: v maxRecvRatePerKey,
1843− challengeRate: v maxChallengeRatePerKey,
1844− pairRate: v maxPairRatePerPair,
1845− lookupRate: v maxLookupRatePerKey
1846− }
1847−
18481334-- GET /metrics: Prometheus-style text exposition of the most useful gauges.
18491335-- The `authorization` header is accepted but not validated here — operators
18501336-- relying on auth must front this endpoint with a reverse proxy that enforces it.
@@ -1887,24 +1373,7 @@ api = serve Api where
18871373 RecvGossip = \{events, fromServer} -> handleRecvGossip events fromServer
18881374 ForwardMessage = \{toKey, encryptedBlob, fromServer} -> handleForwardMessage toKey encryptedBlob fromServer
18891375 FederationBatchForward = \{forwards, fromServer} -> handleFederationBatchForward forwards fromServer
1890− Prune = \{authorization} -> handlePrune authorization
1891− PingPeer = \{server, authorization} -> handlePingPeer server authorization
1892− AdminListSessions = \{pubkey, authorization} -> handleAdminListSessions pubkey authorization
1893− AdminRevokeSessions = \{pubkey, authorization} -> handleAdminRevokeSessions pubkey authorization
1894− AdminListAllSessions = \{limit, authorization} -> handleAdminListAllSessions limit authorization
1895− AdminPurgeMessages = \{pubkey, authorization} -> handleAdminPurgeMessages pubkey authorization
1896− AdminRevokeIp = \{ip, authorization} -> handleAdminRevokeIp ip authorization
1897− GetRateLimits = \{authorization} -> handleGetRateLimits authorization
1898− FlushNonces = \{authorization} -> handleFlushNonces authorization
1899− Reconcile = \{authorization} -> handleReconcile authorization
1900− GetConfig = \{authorization} -> handleGetConfig authorization
19011376 Health = \{authorization} -> handleHealth authorization
1902− Stats = \{authorization} -> handleStats authorization
1903− StatsPeers = \{authorization} -> handleStatsPeers authorization
1904− StatsKey = \{pubkey, authorization} -> handleStatsKey pubkey authorization
1905− TopRecipients = \{limit, authorization} -> handleTopRecipients limit authorization
1906− StatsForwards = \{authorization} -> handleStatsForwards authorization
1907− StatsRates = \{authorization} -> handleStatsRates authorization
19081377 Metrics = \{authorization} -> handleMetrics authorization
19091378 Ready = \{} -> handleReady
19101379
@@ -1916,23 +1385,21 @@ api = serve Api where
19161385-- holders unblock and return an empty heartbeat response, keeping connections
19171386-- fresh.
19181387
1919−-- Endless tick: every `backgroundPruneInterval` run `pruneAndRetry` and bump
1920−-- `pruneCount` for /stats and /health.
1921−backgroundPrune : IO {rw *challenges, rw *forwardFailures, r *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *pruneCount, rw *sessions, clock} a
1388+-- Endless tick: every `backgroundPruneInterval` run `pruneAndRetry`.
1389+backgroundPrune : IO {rw *challenges, rw *forwardFailures, r *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *sessions, clock} a
19221390backgroundPrune = do
19231391 sleep backgroundPruneInterval
19241392 t <- now
1925− atomic (do pc <- *pruneCount; *pruneCount = pc + 1)
19261393 pruneAndRetry t
19271394 backgroundPrune
19281395
19291396-- Endless tick that bumps `pollWakeup` every `pollTimeoutMs` so any blocked
19301397-- /poll holders unblock and return an empty heartbeat response.
1931−pollHeartbeat : IO {rw *heartbeatCount, rw *lastHeartbeatAt, rw *pollWakeup, clock} a
1398+pollHeartbeat : IO {rw *lastHeartbeatAt, rw *pollWakeup, clock} a
19321399pollHeartbeat = do
19331400 sleep pollTimeoutMs
19341401 t <- now
1935− atomic (do *pollWakeup = t; *lastHeartbeatAt = t; hc <- *heartbeatCount; *heartbeatCount = hc + 1)
1402+ atomic (do *pollWakeup = t; *lastHeartbeatAt = t)
19361403 pollHeartbeat
19371404
19381405-- ============================================