1-- Skrepka Relay Server (maximally simplified)
2-- Single-server implementation of the Skrepka protocol (v0.1).
3-- Every collection is a flat list; rate limiters are plain count-per-window.
4-- Token comparison is plain `==` (timing-attack vulnerable), retry backoff is linear,
5-- and many helpers are inlined. Performance suffers; clarity is the only goal.
7-- ============================================
9-- ============================================
10-- Top-level constants: bind address, federation identity, capacity ceilings,
11-- per-key/window rate limits, expiry/backoff/TTL durations, and protocol version.
12-- Values written here are defaults; every scalar (Int/Float/Text/Bool/Maybe ...)
13-- top-level constant can be overridden at startup via `--name=value` on the
14-- command line (see Knot's `knot_override_lookup`). Run with `--help` for the
17-- This server's canonical federation identity. Used as the `server` field in
18-- presence/gossip events, in signed federation challenges, and for self-checks
19-- (`isLocalServer`). Not a bind address — the listener accepts connections on
20-- every interface regardless of this value. May also differ from the URL
21-- clients use to reach the server (e.g. behind a reverse proxy or alternate
22-- DNS name); peers must resolve this name to reach us for federation.
24-- Must be unique per deployment. Every operator participating in federation
25-- has to recompile with their own public hostname here — peers reject events
26-- whose origin fails `isBadServerName` (which blocks the default "localhost"
27-- and other private/reserved names), so two default-built servers cannot
28-- federate with each other. The default is only suitable for a single-node,
29-- non-federated deployment.
31serverHost = "localhost"
32-- Network interface the HTTP listener binds to. "0.0.0.0" accepts connections
33-- on every IPv4 interface (the typical default behind a reverse proxy);
34-- "127.0.0.1" restricts the listener to localhost-only; "::" / "::1" do the
35-- IPv6 equivalents. Override with `--bindHost=...` at startup. Unrelated to
36-- `serverHost` above — this is the kernel-level bind address; that is the
37-- federation identity peers see.
40-- TCP port for incoming HTTP connections.
43-- URL scheme used when contacting peer federation servers.
44federationScheme : Text
45federationScheme = "https://"
46-- The Ed25519 federation keypair lives in `*federationPrivateKeyHex` /
47-- `*federationPublicKeyHex` refs and is generated on first startup; see `main`.
49-- Storage retention for messages and dedup-id records. Mailbox rows live this
50-- long after `receivedAt`; expired rows are pruned by `pruneExpired` (30 days).
51messageMaxAge : Int<Ms>
52messageMaxAge = 2592000000
53-- Length (chars) of a hex-encoded Ed25519 pubkey (32 bytes → 64 hex).
56-- Max length of a hex-encoded message body / opaque blob (40 MiB hex ≈ 20 MiB bytes).
59-- Length of a hex-encoded Ed25519 signature (64 bytes → 128 hex).
62-- Cap on the number of message IDs accepted in a single ack/lookup request.
65-- Cap on items in a batched send request.
68-- Cap on gossip events accepted or emitted in a single federation exchange.
71-- Cap on events returned by one long-poll response.
74-- Allowance for clock drift when validating client timestamps (5 s).
75clockSkewTolerance : Int<Ms>
76clockSkewTolerance = 5000
77-- Per-peer ceiling on outstanding forward attempts.
78maxForwardsPerServer : Int
79maxForwardsPerServer = 2000
80-- Max accepted length of a server hostname.
83-- Max accepted length of a hex-encoded message ID.
86-- Ceiling on outstanding auth challenges held in memory.
89-- Ceiling on concurrent active sessions.
92-- Ceiling on remembered delivered message IDs.
94maxDeliveredIds = 10000
95-- Per-pubkey ceiling on outstanding challenges (prevents one key from exhausting the pool).
96maxChallengesPerKey : Int
97maxChallengesPerKey = 5
98-- Per-pubkey ceiling on concurrent sessions.
99maxSessionsPerKey : Int
100maxSessionsPerKey = 10
101-- Validity window for an auth challenge before it must be re-issued (1 min).
102challengeExpiry : Int<Ms>
103challengeExpiry = 60000
104-- Challenge requests permitted per key inside its rate window.
105maxChallengeRatePerKey : Int
106maxChallengeRatePerKey = 5
107-- Window over which the per-key challenge rate is measured (1 s).
108challengeRateWindowMs : Int<Ms>
109challengeRateWindowMs = 1000
110-- Send-message requests permitted per key per window.
111maxSendRatePerKey : Int
112maxSendRatePerKey = 20
113-- Window for the per-key send rate limit (1 s).
114sendRateWindowMs : Int<Ms>
115sendRateWindowMs = 1000
116-- Receive/poll requests permitted per key per window.
117maxRecvRatePerKey : Int
118maxRecvRatePerKey = 10
119-- Window for the per-key receive rate limit (1 s).
120recvRateWindowMs : Int<Ms>
121recvRateWindowMs = 1000
122-- Messages permitted per (sender, recipient) pair within the pair window.
123maxPairRatePerPair : Int
124maxPairRatePerPair = 30
125-- Window for the per-pair rate limit (1 min).
126pairRateWindowMs : Int<Ms>
127pairRateWindowMs = 60000
128-- Federation requests permitted from a single peer server per window.
129maxFederationRatePerServer : Int
130maxFederationRatePerServer = 50
131-- Window for the per-peer federation rate limit (1 s).
132federationRateWindowMs : Int<Ms>
133federationRateWindowMs = 1000
134-- Presence/key lookups permitted per key per window.
135maxLookupRatePerKey : Int
136maxLookupRatePerKey = 5
137-- Window for the per-key lookup rate limit (1 s).
138lookupRateWindowMs : Int<Ms>
139lookupRateWindowMs = 1000
140-- Other client write requests permitted per key per window.
141maxClientWriteRatePerKey : Int
142maxClientWriteRatePerKey = 10
143-- Window for the per-key client-write rate limit (1 s).
144clientWriteRateWindowMs : Int<Ms>
145clientWriteRateWindowMs = 1000
146-- Requests permitted per source IP per window (covers unauthenticated traffic).
149-- Window for the per-IP rate limit (1 s).
150ipRateWindowMs : Int<Ms>
152-- Global ceiling on total request rate across all clients.
153maxGlobalRequestRate : Int
154maxGlobalRequestRate = 1000
155-- Window for the global request rate limit (1 s).
156globalRateWindowMs : Int<Ms>
157globalRateWindowMs = 1000
158-- Global ceiling on auth-endpoint requests (challenge + verify combined).
159maxAuthGlobalRate : Int
160maxAuthGlobalRate = 200
161-- Window for the global auth rate limit (1 s).
162authGlobalRateWindowMs : Int<Ms>
163authGlobalRateWindowMs = 1000
165-- How long a session token remains valid after issue (1 hour).
166sessionExpiry : Int<Ms>
167sessionExpiry = 3600000
168-- How long a received "online" presence gossip is considered fresh (90 min).
169-- Receivers anchor the TTL to their own wall clock at receive time, so this
170-- value isn't carried on the wire.
171onlineGossipTtl : Int<Ms>
172onlineGossipTtl = 5400000
173-- Times to retry a federation forward before giving up.
174maxForwardRetries : Int
175maxForwardRetries = 10
177-- Base delay for federation retry backoff (linear, not exponential — 30 s).
178retryBackoffBase : Int<Ms>
179retryBackoffBase = 30000
180-- Cap on federation retry backoff (8 min).
181retryBackoffMax : Int<Ms>
182retryBackoffMax = 480000
184-- Cadence of the background prune/cleanup task (30 s).
185backgroundPruneInterval : Int<Ms>
186backgroundPruneInterval = 30000
187-- Long-poll hold timeout before returning empty to the client (25 s).
188pollTimeoutMs : Int<Ms>
190-- Concurrent active long-polls permitted per pubkey.
193-- Cadence at which this server refreshes its own presence to peers (5 min).
194presenceRefreshInterval : Int<Ms>
195presenceRefreshInterval = 300000
197-- Window during which a delivered-but-unacked message is retained for re-delivery (2 min).
198ackGracePeriod : Int<Ms>
199ackGracePeriod = 120000
201-- Human-readable build identifier returned by the /health endpoint.
202serverBuildVersion : Text
203serverBuildVersion = "2026-04-27-simple"
205-- Master switch for federation; when False the server runs in single-node mode.
206federationEnabled : Bool
207federationEnabled = True {}
208federationUrl : Text -> Text
209federationUrl = \server -> federationScheme ++ server
210-- When True, reject requests that arrive without a client-IP header (for IP-based rate limits).
211requireClientIp : Bool
212requireClientIp = True {}
214-- Drop the Ms unit and convert milliseconds to seconds.
215msToS : Int<Ms> -> Int<S>
216msToS = \ms -> stripUnit ms / 1000
218-- Drop the S unit and convert seconds to milliseconds.
219sToMs : Int<S> -> Int<Ms>
220sToMs = \s -> stripUnit s * 1000
222-- ============================================
224-- ============================================
225-- Wire/state shapes plus refinement aliases for hex/server-name validation.
226-- Hex types are bounded length + lowercase-hex; server names are lowercased
227-- and stripped of trailing dots. The SSRF deny-list (`isBadServerName`) is
228-- applied at federation egress, not in the type predicate.
230-- One event in a /poll response: the opaque cipher blob addressed to the
231-- polling pubkey. The server cannot read the blob; clients derive any
232-- per-message id locally as `messageIdOf encryptedBlob`.
233type PollEvent = {encryptedBlob: BlobHex}
235-- Kind of presence event flowing through federation gossip. `GossipUnknown` is
236-- the parser's fallback for forward-compatibility with future event types.
237data GossipEventType = GossipOnline {} | GossipOffline {} | GossipUnknown {}
239impl ToJSON GossipEventType where
240 toJson et = toJson (case et of
241 GossipOnline {} -> "online"
242 GossipOffline {} -> "offline"
243 GossipUnknown {} -> "unknown")
245impl FromJSON GossipEventType where
246 parseJson t = (\s -> if s == "online" then GossipOnline {} else if s == "offline" then GossipOffline {} else GossipUnknown {}) (parseJson t : Text)
248-- One presence change exchanged between federated servers.
249type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex}
251-- /messages signals failure via the per-entry `error` field on each result:
252-- empty = success (delivered, federated, queued, or silent duplicate),
253-- non-empty = "rate_limited" | "self_send". A non-empty top-level `error`
254-- ("rate_limited" | "unauthorized") means the request was rejected before
255-- any entry was processed and `results` is empty.
256-- The sender's UI treats every success the same and learns "they got it"
257-- only via the recipient's E2E ack.
259-- True when `s` is non-empty lowercase hex of even length, with `maxLen` ceiling.
260isValidBoundedHex : Int -> Text -> Bool
261isValidBoundedHex = \maxLen s -> not tooLong s maxLen && isValidHex s
262-- True when `s` is lowercase hex of exactly `exactLen` characters (even by definition).
263isValidExactHex : Int -> Text -> Bool
264isValidExactHex = \exactLen s -> count (chars s) == exactLen && isValidHex s
265-- Hex-encoded Ed25519 public key (32 bytes → 64 chars exact).
266type PubkeyHex = Text where isValidExactHex pubkeyLen
267-- Hex-encoded ciphertext or opaque blob; capped at `maxBlobLen` (~20 MiB).
268type BlobHex = Text where isValidBoundedHex maxBlobLen
269-- Hex-encoded Ed25519 signature (64 bytes → 128 chars exact).
270type SignatureHex = Text where isValidExactHex signatureLen
271isValidMessageId : Text -> Bool
272isValidMessageId = isValidBoundedHex maxMessageIdLen
273-- Hex-encoded message id, length ≤ `maxMessageIdLen`.
274type MessageIdHex = Text where isValidMessageId
275-- Normalized hostname (lowercased, no trailing dot, length-bounded). The SSRF
276-- deny-list (`isBadServerName`) is enforced separately at federation egress
277-- (`withFederationAuth`, `handlePingPeer`); keeping it out of the type predicate
278-- lets the default `serverHost = "localhost"` flow through presence rows in a
279-- non-federated single-node deployment.
280isValidServerName : Text -> Bool
281isValidServerName = \s -> not tooLong s maxServerNameLen && s == normalizeServerName s
282type ServerName = Text where isValidServerName
284-- Wall-clock time in milliseconds since epoch.
285type Timestamp = Int<Ms>
287-- Outstanding nonce issued by /auth/challenge; consumed by /auth/verify.
288type Challenge = {pubkey: PubkeyHex, challenge: Text, expiresAt: Timestamp, ip: Text}
289-- An issued bearer token bound to (pubkey, ip, expiry).
290type Session = {token: Text, pubkey: PubkeyHex, expiresAt: Timestamp, ip: Text}
291-- Mailbox row: a stored message awaiting recipient pickup or federation forward.
292-- Identity is `messageIdOf encryptedBlob` (BLAKE3 of the ciphertext); we don't
293-- persist it because it's deterministically derivable. Storage TTL is fixed
294-- at `messageMaxAge`, so expiry is derived from `receivedAt`. Any send time
295-- the sender wants to convey lives inside `encryptedBlob` (the server cannot
297type Message = {toKey: PubkeyHex, encryptedBlob: BlobHex, receivedAt: Timestamp}
298-- Last-known location of a pubkey, either local (`server == serverHostN`) or
299-- learned from a peer via gossip. Multiple entries per pubkey are allowed.
300type PresenceEntry = {pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp}
301-- A message queued for cross-server delivery to `toServer`. `retries` is
302-- incremented by `retryPendingForwards` until `maxForwardRetries` is hit.
303-- Identity is derived from `encryptedBlob` (see `Message`).
304type ForwardEntry = {toServer: ServerName, toKey: PubkeyHex, encryptedBlob: BlobHex, retries: Int}
305-- Replay-protection record: a message id we already delivered locally.
306type DeliveredEntry = {messageId: MessageIdHex, toKey: PubkeyHex, deliveredAt: Timestamp}
307-- Running failure counter for a peer; keyed by `server`. Drives `retryBackoff`.
308type ForwardFailure = {server: Text, failedAt: Timestamp, failures: Int, firstFailedAt: Timestamp}
309-- One fixed-window rate counter. `key` identifies the subject (pubkey, ip,
310-- server, or composite "sender|recipient" string).
311type RateEntry = {key: Text, windowStart: Timestamp, count: Int}
312-- A live long-poll slot held by a pubkey; used to cap concurrency per key.
313type ActivePoll = {pubkey: PubkeyHex, startedAt: Timestamp}
315-- ============================================
316-- Persisted State (all flat lists, no sharding)
317-- ============================================
318-- Mutable refs (`*x`) holding the entire server state in memory. Every list
319-- scan is O(n); scaling is the first thing the production version replaces.
320-- Grouped here: auth (challenges/sessions), mailbox (messages/forwards/acks),
321-- presence, rate-limit windows, and bookkeeping counters.
323*challenges : [Challenge]
326*presence : [PresenceEntry]
327*forwards : [ForwardEntry]
328*deliveredIds : [DeliveredEntry]
329*forwardFailures : [ForwardFailure]
330*activePolls : [ActivePoll]
332*sendRates : [RateEntry]
333*recvRates : [RateEntry]
334*pairRates : [RateEntry]
335*challengeRates : [RateEntry]
336*lookupRates : [RateEntry]
337*clientWriteRates : [RateEntry]
338*federationRates : [RateEntry]
339*ipRates : [RateEntry]
341*globalRateCount : Int
342*globalRateWindowStart : Timestamp
343*authGlobalRateCount : Int
344*authGlobalRateWindowStart : Timestamp
346*seqCounter : Timestamp
347*pollWakeup : Timestamp
348*lastPrunedAt : Timestamp
349*lastHeartbeatAt : Timestamp
350*lastPresenceRefresh : Timestamp
351*startedAt : Timestamp
352*serverGeneration : Int
354*runtimeMaintenanceSecret : Text
356*federationPrivateKeyHex : Text
357*federationPublicKeyHex : Text
359*blockedPeers : [Text]
360*allowedPeers : [Text]
365-- ============================================
366-- Routes (response shapes preserved; removed metric fields are zero-filled)
367-- ============================================
368-- Public HTTP surface, grouped by audience:
369-- AuthApi -- challenge/verify/revoke/logout (client identity)
370-- ClientApi -- /poll, send/batch/list/ack/delete, presence lookup
371-- FederationApi -- inter-server gossip, forward, ack, delivery receipts
372-- FederationPubkey -- exposes this server's federation Ed25519 public key
373-- MaintenanceApi -- operator endpoints (prune, peer allow/block, admin)
374-- HealthApi/StatsApi/MetricsApi/ReadyApi -- observability
375-- Response field shapes are kept stable for backwards compatibility even when
376-- the underlying value is no longer computed (zero-filled).
379 POST {pubkey: PubkeyHex} /auth/challenge headers {clientIp: Text} -> {challenge: Text, ok: Bool, expiresAt: Timestamp, retryAfterMs: Int, error: Text} = ReqChallenge
380 POST {pubkey: PubkeyHex, challenge: Text, signature: SignatureHex, revokeOthers: Bool} /auth/verify headers {clientIp: Text} -> {token: Text, expiresAt: Timestamp, error: Text} = VerifyAuth
381 POST {targetToken: Text} /auth/revoke headers {authorization: Text, clientIp: Text} -> {ok: Bool, authorized: Bool} = RevokeSession
382 POST /auth/logout headers {authorization: Text, clientIp: Text} -> {ok: Bool, authorized: Bool} = Logout
385 POST {cursor: Timestamp, generation: Int} /poll headers {authorization: Text, clientIp: Text} -> {events: [PollEvent], cursor: Timestamp, authorized: Bool, rateLimited: Bool, generation: Int, heartbeat: Bool, retryAfterMs: Int, cursorReset: Bool, hasMore: Bool, cursorStale: Bool, loadPct: Int} = Poll
386 POST {messages: [{to: PubkeyHex, encryptedBlob: BlobHex}]} /messages headers {authorization: Text, clientIp: Text} -> {results: [{messageId: MessageIdHex, error: Text}], error: Text, retryAfterMs: Int} = SendMessages
387 POST {to: PubkeyHex, messageId: MessageIdHex} /messages/status headers {authorization: Text, clientIp: Text} -> {status: Text, authorized: Bool} = MessageStatus
388 POST {messageIds: [MessageIdHex]} /messages/ack headers {authorization: Text, clientIp: Text} -> {ok: Bool, authorized: Bool, ackedCount: Int, error: Text} = AckMessages
389 POST {offset: Int} /messages/list headers {authorization: Text, clientIp: Text} -> {messages: [{messageId: MessageIdHex, receivedAt: Timestamp}], authorized: Bool, count: Int, error: Text} = ListMessages
390 POST {messageIds: [MessageIdHex]} /messages/delete headers {authorization: Text, clientIp: Text} -> {ok: Bool, authorized: Bool, deletedCount: Int, error: Text} = DeleteMessages
391 GET /lookup/{pubkey: PubkeyHex} headers {authorization: Text, clientIp: Text} -> {server: ServerName, authorized: Bool, error: Text} = LookupPresence
392 POST {pubkeys: [PubkeyHex]} /lookup/batch headers {authorization: Text, clientIp: Text} -> {results: [{pubkey: PubkeyHex, server: ServerName}], authorized: Bool, error: Text} = BatchLookupPresence
394route FederationApi where
395 POST {events: [GossipEvent], fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text} /federation/gossip headers {authorization: Text} -> {ok: Bool, error: Text, retryAfterMs: Int} = RecvGossip
396 POST {toKey: PubkeyHex, encryptedBlob: BlobHex, messageId: MessageIdHex, fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text} /federation/forward headers {authorization: Text} -> {ok: Bool, error: Text, retryAfterMs: Int} = ForwardMessage
397 POST {forwards: [{toKey: PubkeyHex, encryptedBlob: BlobHex, messageId: MessageIdHex}], fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text} /federation/forward-batch headers {authorization: Text} -> {ok: Bool, error: Text, results: [{messageId: MessageIdHex, ok: Bool}], retryAfterMs: Int} = FederationBatchForward
399route FederationPubkeyApi where
400 GET /federation/pubkey -> {pubkey: Text, ok: Bool} = FederationPubkey
402route MaintenanceApi where
403 POST /maintenance/prune headers {authorization: Text} -> {ok: Bool} = Prune
404 POST {server: ServerName} /maintenance/block headers {authorization: Text} -> {ok: Bool, blocked: Int} = BlockPeer
405 POST {server: ServerName} /maintenance/unblock headers {authorization: Text} -> {ok: Bool, unblocked: Bool} = UnblockPeer
406 GET /maintenance/blocked headers {authorization: Text} -> {peers: [Text], ok: Bool} = ListBlocked
407 POST {server: ServerName} /maintenance/ping headers {authorization: Text} -> {ok: Bool, latencyMs: Int, error: Text} = PingPeer
408 GET /maintenance/sessions/{pubkey: PubkeyHex} headers {authorization: Text} -> {sessions: [{token: Text, expiresAt: Timestamp, ip: Text}], count: Int, ok: Bool} = AdminListSessions
409 POST {pubkey: PubkeyHex} /maintenance/sessions/revoke-all headers {authorization: Text} -> {ok: Bool, revokedCount: Int} = AdminRevokeSessions
410 POST {pubkey: PubkeyHex} /maintenance/messages/purge headers {authorization: Text} -> {ok: Bool, purgedCount: Int} = AdminPurgeMessages
411 POST {ip: Text} /maintenance/sessions/revoke-ip headers {authorization: Text} -> {ok: Bool, revokedCount: Int, affectedKeys: Int} = AdminRevokeIp
412 POST {limit: Int} /maintenance/sessions/list headers {authorization: Text} -> {sessions: [{pubkey: PubkeyHex, count: Int, ips: [Text], latestExpiry: Timestamp}], ok: Bool, total: Int} = AdminListAllSessions
413 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, clientWriteRate: Int} = GetRateLimits
414 POST {globalRequest: Int, ipRate: Int, sendRate: Int, federationRate: Int, authGlobal: Int, recvRate: Int, challengeRate: Int, pairRate: Int, lookupRate: Int, clientWriteRate: Int} /maintenance/rate-limits headers {authorization: Text} -> {ok: Bool} = SetRateLimits
415 POST /maintenance/nonces/flush headers {authorization: Text} -> {ok: Bool, flushedCount: Int} = FlushNonces
416 POST {server: ServerName} /maintenance/allow headers {authorization: Text} -> {ok: Bool, allowed: Int} = AllowPeer
417 POST {server: ServerName} /maintenance/unallow headers {authorization: Text} -> {ok: Bool, removed: Bool} = UnallowPeer
418 GET /maintenance/allowed headers {authorization: Text} -> {peers: [Text], ok: Bool} = ListAllowed
419 POST /maintenance/reconcile headers {authorization: Text} -> {ok: Bool, messageDrift: Int, presenceDrift: Int, sessionDrift: Int} = Reconcile
420 POST {newSecret: Text} /maintenance/rotate-secret headers {authorization: Text} -> {ok: Bool, error: Text} = RotateSecret
421 GET /maintenance/config headers {authorization: Text} -> {ok: Bool, pollTimeoutMs: Int, ackGracePeriod: Int} = GetConfig
424 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
426-- Per-peer health snapshot for /stats/peers. Latency/gossip-rate fields are
427-- zero-filled in this simplified server.
431 lastFailedAt: Timestamp,
432 firstFailedAt: Timestamp,
435 pendingForwards: Int,
439 gossipEventsPerMin: Int
441-- Single presence row exposed via /stats/key (server + expiry only).
442type KeyPresenceEntry = {server: Text, expiresAt: Timestamp}
443-- Mailbox depth ranking entry for /stats/top-recipients.
444type RecipientCount = {pubkey: PubkeyHex, count: Int}
447 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, deliveredIds: Int, deliveredIdsMax: Int, forwardNonces: Int, forwardNoncesMax: Int, nonceEvictions: Int, activePolls: 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, oldestAckAge: 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, pendingAckCleanups: 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
448 GET /stats/peers headers {authorization: Text} -> {peers: [PeerStatus], ok: Bool} = StatsPeers
449 GET /stats/key/{pubkey: PubkeyHex} headers {authorization: Text} -> {messages: Int, presence: [KeyPresenceEntry], sessions: Int, forwards: Int, forwardDetails: [{server: Text, retries: Int}], activePolls: Int, ok: Bool} = StatsKey
450 POST {limit: Int} /stats/top-recipients headers {authorization: Text} -> {recipients: [RecipientCount], ok: Bool, total: Int} = TopRecipients
451 GET /stats/forwards headers {authorization: Text} -> {servers: [{server: Text, count: Int, totalRetries: Int}], ok: Bool, total: Int} = StatsForwards
452 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, clientWriteRate: Int} = StatsRates
454route MetricsApi where
455 GET /metrics headers {authorization: Text} -> {metrics: Text, ok: Bool} = Metrics
458 GET /ready -> {ready: Bool} = Ready
460route Api = AuthApi | ClientApi | FederationApi | FederationPubkeyApi | MaintenanceApi | HealthApi | StatsApi | MetricsApi | ReadyApi
462-- ============================================
464-- ============================================
465-- List/predicate combinators (filter/any/none/findFirst/...), token generation,
466-- and small text/server-name utilities used throughout the rest of the file.
467-- Everything is intentionally O(n) over flat lists; performance is sacrificed
468-- for clarity per the file header.
470filter : a b -> (b -> Bool) -> a b
471filter = \xs pred -> do
475removeWhere : a b -> (b -> Bool) -> a b
476removeWhere = \xs pred -> filter xs (\x -> not pred x)
477pluck : a b -> (b -> c) -> a c
481mapWhere : a b -> (b -> Bool) -> (b -> c) -> a c
482mapWhere = \xs pred -> pluck (filter xs pred)
483countWhere : a b -> (b -> Bool) -> Int
484countWhere = \xs pred -> count (filter xs pred)
485any : [a] -> (a -> Bool) -> Bool
486any = \xs pred -> countWhere xs pred > 0
487none : [a] -> (a -> Bool) -> Bool
488none = \xs pred -> not any xs pred
489all : [a] -> (a -> Bool) -> Bool
490all = \xs pred -> none xs (\x -> not pred x)
491findFirst : [a] -> (a -> Bool) -> Maybe a
492findFirst = \xs pred -> headOf (filter xs pred)
493when : Bool -> IO {} {} -> IO {} {}
494when = \cond action -> if cond then action else yield {}
496min = \a b -> if a < b then a else b
498max = \a b -> if a > b then a else b
499clamp : a -> a -> a -> a
500clamp = \lo hi x -> max lo (min hi x)
502abs = \x -> if x < 0 then 0 - x else x
503-- Pair each element with its 0-based index.
504withIndex : [a] -> [{i: Int, v: a}]
505withIndex = fold (\acc x -> union acc [{i: count acc, v: x}]) []
507-- First element of a list, or Nothing for an empty list.
508headOf : [a] -> Maybe a
509headOf = \items -> fold (\_ x -> Just {value: x}) (Nothing {}) (takeRelation 1 items)
511-- Cap to maxN by dropping the smallest-key entries (LRU-style). Always sorts.
512capList : [a] -> Int -> (a -> b) -> [a]
513capList = \items maxN getKey -> dropRelation (max 0 (count items - maxN)) (sortBy getKey items)
515-- Integer percentage with zero-denominator guard.
516pct : Int -> Int -> Int
517pct = \cur maxN -> if maxN > 0 then cur * 100 / maxN else 0
519-- Common ack/delete tail: pull matching messages, drop them and their forwards.
520removeForKey : (forall r. {toKey: PubkeyHex, encryptedBlob: BlobHex | r} -> Bool) -> IO {rw *forwards, rw *messages} [Message]
521removeForKey = \pred -> do
524 *messages = removeWhere msgs pred
525 *forwards = removeWhere fwds pred
526 yield (filter msgs pred)
528-- Cap pred-matching entries to maxN-1 (caller adds one more).
529capPerKey : [a] -> (a -> Bool) -> Int -> (a -> b) -> [a]
530capPerKey = \items pred maxN getKey -> union (removeWhere items pred) (capList (filter items pred) (maxN - 1) getKey)
532-- Shared empty/error shape for /poll. Only a few fields ever vary.
533emptyPollResp : Timestamp -> Bool -> Bool -> Int -> Int -> Bool -> {events: [PollEvent], cursor: Timestamp, authorized: Bool, rateLimited: Bool, generation: Int, heartbeat: Bool, retryAfterMs: Int, cursorReset: Bool, hasMore: Bool, cursorStale: Bool, loadPct: Int}
534emptyPollResp = \cursor authorized rateLimited gen retryAfterMs cursorWasReset -> {
542 cursorReset: cursorWasReset,
544 cursorStale: False {},
548-- Sequence an IO action over each item, in order.
549forEach : [a] -> (a -> IO {} {}) -> IO {} {}
550forEach = \items action -> case single (takeRelation 1 items) of
551 Nothing {} -> yield {}
552 Just {value: x} -> do
554 forEach (dropRelation 1 items) action
556-- Like forEach, but collects each action's result into a list.
557mapEach : [a] -> (a -> IO {} b) -> IO {} [b]
558mapEach = \items action -> case headOf items of
559 Nothing {} -> yield []
560 Just {value: x} -> do
562 rest <- mapEach (dropRelation 1 items) action
563 yield (union [r] rest)
565-- Hex tokens: one random hex char per recursive call.
566genTokenN : Int -> IO {random} Text
567genTokenN = \n -> if n <= 0
571 rest <- genTokenN (n - 1)
572 yield (take 1 (drop d "0123456789abcdef") ++ rest)
574-- Standard 48-char hex token used for session bearers and federation nonces.
575genToken : IO {random} Text
576genToken = genTokenN 48
578-- Canonical message identity: BLAKE3 of the encrypted blob, hex-encoded.
579-- Binding the id to the payload means a hostile peer cannot multiply-store
580-- the same ciphertext under different ids on /federation/forward — same
581-- blob always collides with the existing dedup key.
582messageIdOf : BlobHex -> MessageIdHex
583messageIdOf = \blob -> bytesToHex (hash blob)
585-- True when `s` exceeds `maxLen` characters.
586tooLong : Text -> Int -> Bool
587tooLong = \s maxLen -> count (chars s) > maxLen
589-- True when `s` is non-empty, even-length, and only lowercase hex digits.
590isValidHex : Text -> Bool
591isValidHex = \s -> (\cs -> (\n -> n > 0 && n / 2 * 2 == n && all cs (\c -> contains c "0123456789abcdef")) (count cs)) (chars s)
593-- Recursively strip every trailing "." from `s` (DNS root form).
594stripTrailingDot : Text -> Text
595stripTrailingDot = \s -> if containsSuffix "." s
596then stripTrailingDot (take (count (chars s) - 1) s)
599-- Canonical form of a hostname: lowercase, no trailing dot.
600normalizeServerName : Text -> Text
601normalizeServerName = \s -> toLower (stripTrailingDot s)
603-- This server's own hostname in canonical form (used everywhere for self-checks).
605serverHostN = normalizeServerName serverHost
606-- True when `s` refers to this server.
607isLocalServer : Text -> Bool
608isLocalServer = \s -> s == serverHostN
609-- True when `s` refers to any server other than this one.
610isRemote : Text -> Bool
611isRemote = \s -> not isLocalServer s
613-- True when `s` starts with `pre`.
614hasPrefix : Text -> Text -> Bool
615hasPrefix = \pre s -> take (count (chars pre)) s == pre
617-- True when `s` ends with `suffix`.
618containsSuffix : Text -> Text -> Bool
619containsSuffix = \suffix s -> drop (max 0 (count (chars s) - count (chars suffix))) s == suffix
621-- Block private/reserved/internal hostnames (SSRF defense). Skips obscure encoding
622-- tricks (octal, hex, percent-encoding) but covers the high-value cases.
623isBadServerName : Text -> Bool
624isBadServerName = \sn -> sn == "" || sn == "localhost" || not all (chars sn) (\c -> contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:") || any [
634] (\p -> hasPrefix p sn) || any [".localhost", ".local", ".internal", ".arpa", ".onion"] (\s -> containsSuffix s sn)
636-- ============================================
638-- ============================================
639-- Bearer token extraction, session lookup, maintenance secret check, and the
640-- `gateAuth`/`gateClientWrite`/`gateLookup` combinators that every client
641-- handler funnels through (global rate → per-key rate → session).
642-- Federation requests use a separate path (`withFederationAuth`) using
643-- Ed25519-signed auth verified via the peer's published public key.
645-- Plain ip match (sessions with empty ip skip the check).
646matchIp : Text -> Text -> Bool
647matchIp = \clientIp sessionIp -> sessionIp == "" || clientIp == sessionIp
649-- Pull the token out of an `Authorization: Bearer <token>` header. Returns
650-- Nothing if the prefix is missing or the token is empty.
651extractToken : Text -> Maybe Text
652extractToken = \h -> if hasPrefix "Bearer " h && drop 7 h != ""
653then Just {value: drop 7 h}
656-- True when the header carries a Bearer token equal to the runtime maintenance
657-- secret. Plain `==` comparison; not constant-time (see file header).
658verifyMaintenanceAuth : Text -> IO {r *runtimeMaintenanceSecret} Bool
659verifyMaintenanceAuth = \authorization -> do
660 secret <- *runtimeMaintenanceSecret
661 yield (secret != "" && extractToken authorization == Just {value: secret})
663-- Branch on maintenance-secret auth: run `onAuth` when the bearer matches,
664-- `onUnauth` otherwise.
665withMaintAuth : Text -> IO {| effs} a -> IO {| effs} a -> IO {r *runtimeMaintenanceSecret | effs} a
666withMaintAuth = \authorization onUnauth onAuth -> do
667 authorized <- verifyMaintenanceAuth authorization
668 if authorized then onAuth else onUnauth
670-- Common gate for handlers: global rate, session auth.
671-- mkErr is called with one of: "rate_limited", "unauthorized".
672gateAuth : Text -> Text -> Timestamp -> (Text -> resp) -> (PubkeyHex -> IO {} resp) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} resp
673gateAuth = \auth ip t mkErr onAuth -> do
674 g <- checkGlobalRate t
675 let err = \e -> yield (mkErr e)
676 if g then err "rate_limited" else withSessionAuth auth t ip (err "unauthorized") onAuth
678-- gateAuth + per-key rate gate. `rateResp` is the response value when the per-key gate trips.
679gateClientWrite : Text -> Text -> Int<Ms> -> (Text -> a) -> a -> (Text -> IO {} a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} a
680gateClientWrite = \auth ip t mkErr rateResp onAuth ->
681 gateAuth auth ip t mkErr (\pk -> do
683 rates <- *clientWriteRates
684 let r = checkRate rates pk maxClientWriteRatePerKey clientWriteRateWindowMs t
685 -- TODO: make this no be a `replace`
686 *clientWriteRates = r.entries
688 if lim then yield rateResp else onAuth pk)
690-- Variant of `gateClientWrite` that uses the per-key lookup-rate window instead.
691gateLookup : Text -> Text -> Int<Ms> -> (Text -> a) -> a -> (Text -> IO {} a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} a
692gateLookup = \auth ip t mkErr rateResp onAuth ->
693 gateAuth auth ip t mkErr (\pk -> do
695 rates <- *lookupRates
696 let r = checkRate rates pk maxLookupRatePerKey lookupRateWindowMs t
697 -- TODO: make this no be a `replace`
698 *lookupRates = r.entries
700 if lim then yield rateResp else onAuth pk)
702-- Resolve a Bearer token to its session pubkey if the session is unexpired and
703-- the client IP matches. Runs `onAuth pubkey` on success, `onUnauth` otherwise.
704withSessionAuth : Text -> Int<Ms> -> Text -> IO {| e} a -> (PubkeyHex -> IO {| e} a) -> IO {r *sessions | e} a
705withSessionAuth = \authorization t clientIp onUnauth onAuth -> do
707 case extractToken authorization of
708 Nothing {} -> onUnauth
709 Just {value: token} -> case findFirst ses (\s -> s.expiresAt > t && s.token == token && matchIp clientIp s.ip) of
710 Just {value: s} -> onAuth s.pubkey
713-- Build the `Signed <hexsig>:<nonce>` header for an outbound federation call.
714-- Signs the canonical "scope|timestamp|fromServer|nonce" string with our
715-- federation private key (the peer fetches our public key via /federation/pubkey
716-- to verify). Returns "" if no keypair has been generated yet.
717generateFederationAuth : Text -> a -> IO {r *federationPrivateKeyHex, random} Text
718generateFederationAuth = \scope requestTimestamp -> do
719 hex <- *federationPrivateKeyHex
720 let privKey = if hex == "" then Nothing {} else bytesFromHex hex
722 Just {value: pk} -> do
723 nonce <- genTokenN 48
724 yield ("Signed " ++ bytesToHex (sign pk (textToBytes (scope ++ "|" ++ show requestTimestamp ++ "|" ++ serverHostN ++ "|" ++ nonce))) ++ ":" ++ nonce)
727-- Verify a federation request: Ed25519 signature over scope|ts|fromServer|nonce, key fetched from peer.
728verifyFederationAuth : Text -> Text -> Text -> a -> IO {network} {} Bool
729verifyFederationAuth = \authorization fromServer scope requestTimestamp -> do
730 if hasPrefix "Signed " authorization then do
731 let payload = drop 7 authorization
732 if payload == "" || tooLong payload (signatureLen + 25) then yield False {}
734 -- Split payload on first ':' into {sig, nonce}.
735 let cs = chars payload
736 let sepIdx = case findFirst (withIndex cs) (\p -> p.v == ":") of
737 Just {value: p} -> p.i
739 let sig = take sepIdx payload
740 let nonce = drop (sepIdx + 1) payload
741 result <- fetch (federationUrl fromServer) (FederationPubkey {})
743 Ok {value: r} -> case bytesFromHex r.pubkey of
744 Just {value: pk} -> case bytesFromHex sig of
745 Just {value: sigBytes} -> yield (r.ok && r.pubkey != "" && verify pk (textToBytes (scope ++ "|" ++ show requestTimestamp ++ "|" ++ fromServer ++ (if nonce == "" then "" else "|" ++ nonce))) sigBytes)
751-- Combined gate for inbound federation calls. Order of checks (each short-
752-- circuits with an error code in the response):
753-- 1. `fromServer` passes the SSRF deny-list (so `verifyFederationAuth`'s
754-- pubkey fetch can't be steered at loopback/private hosts);
755-- 2. peer not block-listed; 3. peer in allow-list (if any); 4. caller-supplied
756-- `precondition` holds; 5. clock skew within `clockSkewTolerance`;
757-- 6. Ed25519 signature verifies; 7. per-peer federation rate limit.
758withFederationAuth = \authorization t mkErr fromServer scope requestTimestamp precondition action -> do
759 blocked <- *blockedPeers
760 allowed <- *allowedPeers
761 let err = \e r -> yield (mkErr e r)
762 let preErr = if isBadServerName fromServer
763 then "invalid_request"
764 else if elem fromServer blocked
766 else if count allowed > 0 && not elem fromServer allowed
768 else if not precondition
769 then "invalid_request"
770 else if requestTimestamp > 0 && abs (requestTimestamp - t) > clockSkewTolerance
776 verified <- verifyFederationAuth authorization fromServer scope requestTimestamp
778 then err "unauthorized" 0
780 limited <- checkServerRateGate fromServer t
781 if limited then err "rate_limited" federationRateWindowMs else action
783-- ============================================
784-- Rate limiting (plain count-per-window, no sliding interpolation)
785-- ============================================
786-- Two flavors of fixed-window counters:
787-- * Per-key (`checkRate`) — keyed by pubkey, ip, server, or pair string;
788-- entries live in a `RateEntry` list ref capped at 5000 with LRU eviction.
789-- * Global (`checkGlobalRate`/`checkAuthGlobalRate`) — single counter+windowStart
790-- pair, used for the request-wide and auth-wide ceilings.
791-- `authPreCheck` composes global + ip + auth-global into a one-shot
792-- gate for unauthenticated handlers (challenge/verify).
794-- Returns {limited, entries}. Increments count when the key fits within the window.
795checkRate : [RateEntry] -> Text -> Int -> Int<Ms> -> Timestamp -> {limited: Bool, entries: [RateEntry]}
796checkRate = \entries key maxRate windowMs t -> (\cur -> if cur.count > maxRate then {limited: True {}, entries} else {limited: False {}, entries: capList (union (removeWhere entries (\x -> x.key == key)) [{key, cur.windowStart, cur.count}]) 5000 (\r -> r.windowStart)}) (case findFirst entries (\r -> r.key == key && t - r.windowStart < windowMs) of
797 Just {value: r} -> {r.windowStart, count: r.count + 1}
798 _ -> {windowStart: t, count: 1})
800-- Single-counter global rate gate. Resets the counter when the window expires;
801-- returns True when the limit has been hit (caller responds rate_limited).
802checkGlobalRate : Timestamp -> IO {rw *globalRateCount, rw *globalRateWindowStart} Bool
803checkGlobalRate = \t -> atomic (do
804 ws <- *globalRateWindowStart
805 c <- *globalRateCount
806 if t - ws >= globalRateWindowMs
808 *globalRateWindowStart = t
811 else if c >= maxGlobalRequestRate
814 *globalRateCount = c + 1
817-- Same shape as `checkGlobalRate` but charged only by the auth endpoints
818-- (challenge + verify). Stops a single attacker from exhausting the global
819-- counter via auth churn.
820checkAuthGlobalRate = \t -> atomic (do
821 ws <- *authGlobalRateWindowStart
822 c <- *authGlobalRateCount
823 if t - ws >= authGlobalRateWindowMs
825 *authGlobalRateWindowStart = t
826 *authGlobalRateCount = 1
828 else if c >= maxAuthGlobalRate
831 *authGlobalRateCount = c + 1
834-- Per-source-IP rate gate (skipped when the IP is unknown — see `requireClientIp`).
835checkIpRateGate : Text -> Int<Ms> -> IO {rw *ipRates} Bool
836checkIpRateGate = \ip t -> if ip == ""
840 let r = checkRate rates ip maxIpRatePerIp ipRateWindowMs t
844-- Per-peer federation rate gate; charged inside `withFederationAuth`.
845checkServerRateGate : Text -> Int -> IO {rw *federationRates} Bool
846checkServerRateGate = \server t -> atomic (do
847 rates <- *federationRates
848 let r = checkRate rates server maxFederationRatePerServer federationRateWindowMs t
849 *federationRates = r.entries
852-- Pre-auth gate: global + ip + auth-global. Returns "" when ok, else an error code.
853authPreCheck : Text -> Int<Ms> -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates} Text
854authPreCheck = \clientIp t -> do
855 g <- checkGlobalRate t
856 i <- checkIpRateGate clientIp t
857 a <- checkAuthGlobalRate t
859 then "global_rate_limited"
860 else if i then "ip_rate_limited" else if a then "auth_rate_limited" else "")
862-- ============================================
863-- Federation failure tracking (simple, no circuit breaker)
864-- ============================================
865-- Linear backoff per peer: each consecutive failure multiplies the delay by
866-- `retryBackoffBase` (capped at `retryBackoffMax`). `shouldRetryServer` is the
867-- single read-side gate; `recordFailure`/`clearFailure` are the write side.
868-- There is no half-open state — a single success clears all accumulated failures.
870-- Linear backoff: `retryBackoffBase * failures`, capped at `retryBackoffMax`.
871retryBackoff : Int -> Int<Ms>
872retryBackoff = \failures -> min retryBackoffMax (retryBackoffBase * max 1 failures)
874-- True when enough time has passed since the last failure for `server` to be
875-- worth retrying (or no failure recorded at all).
876shouldRetryServer : Text -> Timestamp -> [ForwardFailure] -> Bool
877shouldRetryServer = \server t failures -> none failures (\f -> f.server == server && t - f.failedAt < retryBackoff f.failures)
879-- Bump the failure counter for `server`. Preserves `firstFailedAt` across
880-- subsequent failures so health views can show the outage age.
881recordFailure : Text -> IO {rw *forwardFailures, clock} {}
882recordFailure = \server -> do
885 failures <- *forwardFailures
886 let same = \f -> f.server == server
887 let prev = case findFirst failures same of
888 Just {value: f} -> {failures: f.failures + 1, f.firstFailedAt}
889 _ -> {failures: 1, firstFailedAt: t}
890 *forwardFailures = union (removeWhere failures same) [
891 {server, failedAt: t, prev.failures, prev.firstFailedAt}
894-- Drop the failure record for `server` (called after any successful peer call).
895-- Single-success recovery — there is no half-open state.
896clearFailure : Text -> IO {rw *forwardFailures} {}
897clearFailure = \server -> atomic (do
898 forwardFailures <- *forwardFailures
899 *forwardFailures = filter forwardFailures (\f -> f.server != server))
901-- ============================================
902-- Common utility queries
903-- ============================================
904-- Pure helpers shared by send/poll/federation paths: monotonic sequence
905-- generation, presence lookup, and duplicate detection across
906-- (messages, deliveredIds).
908-- Strictly-monotonic next sequence timestamp: max of wall clock and prior+1.
909-- Guarantees /poll cursors order events even when many arrive in the same ms.
910nextSeqTs : Timestamp -> Timestamp -> Timestamp
911nextSeqTs = \t seqCounter -> max t (seqCounter + 1)
913-- Drop duplicates and cap to `maxMessageIds` (defense against bloated requests).
914dedupMessageIds : [MessageIdHex] -> [MessageIdHex]
915dedupMessageIds = \ids -> takeRelation maxMessageIds ids
917-- All unexpired presence rows for a given pubkey (may include both local and
918-- remote entries — the recipient may live on multiple servers simultaneously).
919presenceForKey : [PresenceEntry] -> PubkeyHex -> Timestamp -> [PresenceEntry]
920presenceForKey = \presence pubkey t -> filter presence (\p -> p.pubkey == pubkey && p.expiresAt > t)
922-- Resolve a key's server for client lookup, masking remote identities behind "remote".
923maskedServer : [PresenceEntry] -> PubkeyHex -> Timestamp -> Text
924maskedServer = \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)
926-- Replay-protection check. A message is a duplicate if either:
927-- * a live mailbox row exists with the same (encryptedBlob, toKey) -- since
928-- id := messageIdOf encryptedBlob, same blob ⇒ same id; or
929-- * a delivered-id tombstone matches (messageId, toKey).
930-- The blob comparison avoids hashing every live row on each check; the
931-- tombstone log only stores the id, so we compare it directly.
932isDuplicateMessage : BlobHex -> PubkeyHex -> [Message] -> [DeliveredEntry] -> Bool
933isDuplicateMessage = \blob toKey msgs dids -> any msgs (\m -> m.toKey == toKey && m.encryptedBlob == blob) || (\mid -> any dids (\d -> d.toKey == toKey && d.messageId == mid)) (messageIdOf blob)
935-- Project items through `getServer`, drop our own hostname, and dedupe.
936-- Used to derive peer recipient lists from forwards/presence/etc.
937collectPeers : [a] -> (a -> Text) -> [Text]
938collectPeers = \items getServer -> filter (pluck items getServer) isRemote
940-- All distinct remote hostnames currently appearing in `presence` (the gossip
941-- broadcast set we know about, less ourselves).
942knownPeerServersFromPresence : [PresenceEntry] -> [Text]
943knownPeerServersFromPresence = \presence -> collectPeers presence (\p -> p.server)
945-- ============================================
947-- ============================================
948-- Single sweep that drops expired entries from every state ref in one atomic
949-- block. Returns the locally-expired presence rows whose pubkey has no other
950-- live local session, so the caller can broadcast offline gossip for them.
952-- One sweep over every state ref: drops expired rows in a single atomic block.
953-- Returns the locally-expired presence rows whose pubkey has no other live
954-- local session, so the caller can broadcast offline gossip for them.
955pruneExpired : Int<Ms> -> IO {rw *activePolls, rw *challenges, rw *deliveredIds, rw *forwardFailures, rw *messages, rw *presence, rw *sessions} [{expiresAt: Timestamp, pubkey: PubkeyHex, server: ServerName}]
956pruneExpired = \t -> atomic do
958 *challenges = filter ch (\x -> x.expiresAt > t)
960 *sessions = filter ses (\x -> x.expiresAt > t)
962 *messages = filter msgs (\m -> t - m.receivedAt < messageMaxAge)
963 dids <- *deliveredIds
964 *deliveredIds = filter dids (\d -> t - d.deliveredAt < messageMaxAge)
965 ff <- *forwardFailures
966 *forwardFailures = filter ff (\f -> t - f.failedAt < 86400000)
968 *activePolls = filter aps (\p -> t - p.startedAt < pollTimeoutMs * 3)
969 -- presence: remember locally-expired keys for offline gossip
971 *presence = filter pres (\p -> p.expiresAt > t)
972 let stillLive = \pk -> any pres (\k -> isLocalServer k.server && k.pubkey == pk && k.expiresAt > t)
973 yield (filter pres (\p -> p.expiresAt <= t && isLocalServer p.server && not (stillLive p.pubkey)))
975-- ============================================
977-- ============================================
978-- Construction and outbound dispatch of presence gossip events. Failures from
979-- a peer record into `forwardFailures` (shared with forward retries) so both
980-- subsystems back off together.
982-- Build a gossip event with the originating pubkey's status.
983mkGossip : GossipEventType -> PubkeyHex -> GossipEvent
984mkGossip = \etype pk -> {eventType: etype, pubkey: pk}
986-- Fan out one bundle of gossip events to each peer, skipping peers in backoff.
987-- Records or clears federation-failure counters per call.
988sendBatchedGossip : [Text] -> [GossipEvent] -> IO {} {}
989sendBatchedGossip = \peers events -> forEach peers (\server -> do
991 failures <- *forwardFailures
992 when (shouldRetryServer server t failures) (do
993 auth <- generateFederationAuth "gossip" t
994 result <- fetch (federationUrl server) (RecvGossip {
997 fromServer: serverHostN,
1002 Err _ -> recordFailure server
1003 Ok _ -> clearFailure server))
1005-- Tell known peers that the listed local pubkeys just went offline. No-op when
1006-- federation is disabled or the list is empty.
1007broadcastOfflineGossip : [{pubkey: PubkeyHex | a}] -> IO {r *presence} {}
1008broadcastOfflineGossip = \expiredLocal -> do
1009 presence <- *presence
1010 when (federationEnabled && count expiredLocal > 0) (sendBatchedGossip (knownPeerServersFromPresence presence) (pluck expiredLocal (\p -> mkGossip (GossipOffline {}) p.pubkey)))
1012-- ============================================
1014-- ============================================
1015-- `retryPendingForwards` walks queued cross-server forwards in batches per
1016-- destination, increments retry counts, and gives up after `maxForwardRetries`.
1017-- `forwardQueuedToServer` is the catch-up path triggered when a remote key
1018-- comes online: any messages already buffered for that pubkey are enqueued
1019-- as forwards to the newly-known server.
1021-- Walk pending forwards grouped by destination, retry each (up to maxBatchSize
1022-- per peer) using `/federation/forward`. Drops successful entries; for failures
1023-- bumps the retry count and gives up after `maxForwardRetries`.
1024retryPendingForwards : IO {r *blockedPeers, r *forwardFailures, r *forwards, clock} {}
1025retryPendingForwards = do
1028 failures <- *forwardFailures
1029 blocked <- *blockedPeers
1030 forEach (filter (collectPeers fwds (\f -> f.toServer)) (\s -> shouldRetryServer s t failures && not elem s blocked)) (\server -> forEach (takeRelation maxBatchSize (filter fwds (\f -> f.toServer == server))) (\f -> do
1032 let messageId = messageIdOf f.encryptedBlob
1033 auth <- generateFederationAuth ("forward:" ++ messageId) t2
1034 result <- fetch (federationUrl server) (ForwardMessage {
1038 fromServer: serverHostN,
1039 requestTimestamp: t2,
1040 authorization: auth,
1043 success <- case result of
1045 recordFailure server
1048 when r.ok (clearFailure server)
1050 let isMatch = \x -> x.encryptedBlob == f.encryptedBlob && x.toServer == server
1051 let isDone = \x -> isMatch x && (success || x.retries + 1 >= maxForwardRetries)
1054 *forwards = pluck (removeWhere cur isDone) (\x -> if isMatch x
1055 then {x.toServer, x.toKey, x.encryptedBlob, retries: x.retries + 1}
1058-- Forward queued messages to a server when a remote key comes online.
1059forwardQueuedToServer : PubkeyHex -> ServerName -> IO {rw *forwards, r *messages} {}
1060forwardQueuedToServer = \pubkey server -> atomic (do
1063 let candidates = filter msgs (\m -> m.toKey == pubkey && none fwds (\f -> f.encryptedBlob == m.encryptedBlob && f.toServer == server))
1064 let newFwds = pluck (takeRelation maxForwardsPerServer candidates) (\m -> {
1070 *forwards = union fwds newFwds)
1072-- ============================================
1074-- ============================================
1075-- Composite tick run from `backgroundPrune` (and on demand via /maintenance/prune):
1076-- expire stale rows, then opportunistically retry pending forwards and refresh
1077-- local presence so peers don't see us go offline mid-session.
1079-- One composite background tick: prune expired state, gossip offline for
1080-- locally-expired keys, retry pending forwards, and (occasionally) refresh
1081-- local presence so peers don't see us drop off.
1082pruneAndRetry = \t -> do
1084 expiredLocal <- pruneExpired t
1085 fork (broadcastOfflineGossip expiredLocal)
1086 when federationEnabled (do
1087 fork retryPendingForwards
1088 lastRefresh <- *lastPresenceRefresh
1089 when (t - lastRefresh >= presenceRefreshInterval) (do
1090 *lastPresenceRefresh = t
1091 refreshLocalPresence t))
1093-- Extend the expiry of local presence rows whose backing session is still live
1094-- but the presence entry is past half its window. Re-broadcasts an `online`
1095-- event for the refreshed entries so peers don't time them out.
1096refreshLocalPresence : Int<Ms> -> IO {rw *presence, r *sessions} {}
1097refreshLocalPresence = \t -> do
1098 refreshState <- atomic (do
1099 sessions <- *sessions
1100 presence <- *presence
1101 let sessionKeys = map (\s -> s.pubkey) sessions
1102 let needsRefresh = \p -> isLocalServer p.server && elem p.pubkey sessionKeys && p.expiresAt - t < sessionExpiry / 2
1103 let kept = filter presence (\p -> not needsRefresh p)
1104 let refreshed = map (\p -> {p.pubkey, p.server, expiresAt: t + sessionExpiry}) (filter presence needsRefresh)
1105 let updated = union kept refreshed
1107 yield {refreshed, peers: knownPeerServersFromPresence updated})
1108 when (count refreshState.refreshed > 0) (fork (sendBatchedGossip refreshState.peers (pluck refreshState.refreshed (\p -> mkGossip (GossipOnline {}) p.pubkey))))
1110-- ============================================
1111-- Handler: challenge / verify / revoke / logout
1112-- ============================================
1113-- Identity is a public key; there are no accounts. The flow is:
1114-- 1. Client requests a fresh nonce (`handleChallenge`).
1115-- 2. Client signs the nonce with its private key and submits the signature
1116-- together with the original challenge (`handleVerifyAuth`).
1117-- 3. Server returns a Bearer token bound to (pubkey, ip, expiry); the new
1118-- session also installs a local presence row and gossips an `online`
1119-- event to known peers.
1120-- `handleRevoke` lets a session revoke its peers (same pubkey, different
1121-- token); `handleLogout` invalidates the caller's own token and, if no
1122-- sibling sessions remain, gossips an `offline` event.
1124-- POST /auth/challenge: issue a fresh signed-nonce challenge for `pubkey`.
1125-- Capped per-key (maxChallengesPerKey) and rate-limited; the IP is recorded
1126-- so /auth/verify can require the same client.
1127handleChallenge : PubkeyHex -> Text -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *challengeRates, rw *challenges, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates, clock, random} {challenge: Text, error: Text, expiresAt: Int, ok: Bool, retryAfterMs: Int}
1128handleChallenge = \pubkey clientIp -> do
1130 preErr <- if requireClientIp && clientIp == ""
1131 then yield "client_ip_required"
1132 else authPreCheck clientIp t
1134 then yield {challenge: "", ok: False {}, expiresAt: 0, retryAfterMs: 0, error: preErr}
1136 challenge <- genToken
1137 result <- atomic (do
1139 let cappedActive = capPerKey (filter ch (\c -> c.expiresAt > t)) (\c -> c.pubkey == pubkey) maxChallengesPerKey (\c -> c.expiresAt)
1140 if count cappedActive >= maxChallenges
1141 then yield {ok: False {}, error: "capacity"}
1143 chRates <- *challengeRates
1144 let chR = checkRate chRates pubkey maxChallengeRatePerKey challengeRateWindowMs t
1145 *challengeRates = chR.entries
1147 then yield {ok: False {}, error: "rate_limited"}
1149 *challenges = union cappedActive [
1150 {pubkey, challenge, expiresAt: t + challengeExpiry, ip: clientIp}
1152 yield {ok: True {}, error: ""})
1154 challenge: if result.ok then challenge else "",
1156 expiresAt: if result.ok then t + challengeExpiry else 0,
1161-- POST /auth/verify: validate `signature` over `challenge` for `pubkey`.
1162-- On success, mints a session token, records local presence (`pubkey` is now
1163-- live on this server), and gossips an `online` event to known peers. If
1164-- `revokeOthers` is set, all other sessions for the same pubkey are dropped.
1165handleVerifyAuth : PubkeyHex -> Text -> Text -> Bool -> Text -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *challenges, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates, rw *presence, rw *sessions, clock, random} {error: Text, expiresAt: Int, token: Text}
1166handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do
1168 preErr <- authPreCheck clientIp t
1170 then yield {token: "", expiresAt: 0, error: preErr}
1172 let expiry = t + sessionExpiry
1174 result <- atomic (do
1176 let same = \c -> c.pubkey == pubkey && c.challenge == challenge
1177 let sigValid = case bytesFromHex pubkey of
1178 Just {value: pk} -> case bytesFromHex signature of
1179 Just {value: sigBytes} -> verify pk (textToBytes challenge) sigBytes
1182 let valid = any ch (\c -> same c && c.expiresAt > t && matchIp clientIp c.ip) && sigValid
1184 then yield {valid: False {}, peers: []}
1186 *challenges = removeWhere ch same
1188 let mine = \s -> s.pubkey == pubkey
1189 let pruned = if revokeOthers
1190 then removeWhere ses mine
1191 else capPerKey ses mine maxSessionsPerKey (\s -> s.expiresAt)
1192 let newSession = {token, pubkey, expiresAt: expiry, ip: clientIp}
1193 *sessions = capList (union pruned [newSession]) maxSessions (\s -> s.expiresAt)
1195 let prunedPres = removeWhere pres (\p -> p.pubkey == pubkey && isLocalServer p.server)
1196 let newPres = union prunedPres [{pubkey, server: serverHostN, expiresAt: expiry}]
1198 yield {valid: True {}, peers: knownPeerServersFromPresence newPres})
1200 then yield {token: "", expiresAt: 0, error: "invalid"}
1202 when federationEnabled (fork (sendBatchedGossip result.peers [
1203 mkGossip (GossipOnline {}) pubkey
1205 yield {token, expiresAt: expiry, error: ""}
1207-- POST /auth/revoke: caller (any session for the pubkey) revokes a sibling
1208-- session by token. Returns ok=False if no such sibling existed.
1209handleRevoke : Text -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, ok: Bool}
1210handleRevoke = \targetToken authorization clientIp -> do
1212 gateAuth authorization clientIp t (\_ -> {ok: False {}, authorized: False {}}) (\caller -> do
1213 result <- atomic (do
1215 let pred = \s -> s.pubkey == caller && s.token == targetToken
1216 *sessions = removeWhere ses pred
1217 yield (any ses pred))
1218 yield {ok: result, authorized: True {}})
1220-- POST /auth/logout: drop the caller's own session. If this was the last
1221-- session for the pubkey, also clear local presence and gossip offline.
1222handleLogout : Text -> Text -> IO {rw *presence, rw *sessions, clock} {authorized: Bool, ok: Bool}
1223handleLogout = \authorization clientIp -> do
1225 let myToken = case extractToken authorization of
1226 Just {value: tk} -> tk
1228 removed <- atomic withSessionAuth authorization t clientIp (yield {
1234 *sessions = removeWhere ses (\s -> s.token == myToken)
1236 peers <- if any after (\s -> s.pubkey == pubkey)
1240 *presence = removeWhere pres (\p -> p.pubkey == pubkey && isLocalServer p.server)
1241 yield (knownPeerServersFromPresence pres)
1242 yield {ok: True {}, pubkey, peers})
1243 when (removed.ok && federationEnabled) (fork (sendBatchedGossip removed.peers [
1244 mkGossip (GossipOffline {}) removed.pubkey
1246 yield {removed.ok, authorized: removed.ok}
1248-- ============================================
1250-- ============================================
1251-- Long-poll. The client supplies a cursor (last-seen `receivedAt`) and the
1252-- server's last-known `generation` (server identity for cursor validity). We:
1253-- * If the generation mismatches, reset the cursor and signal `cursorReset`.
1254-- * Ack-and-drop everything <= the cursor (treating poll progress as ack).
1255-- * Wait on `pollWakeup` (bumped by send/heartbeat) and return new events
1256-- plus piggybacked sender-side expirations/deliveries.
1257-- Per-pubkey concurrency is capped via `activePolls` to bound long-poll holds.
1259-- POST /poll: top-level dispatch. Validates the global rate gate, detects a
1260-- generation mismatch (server restart) to force a cursor reset, then hands
1261-- off to `pollOnce` for the actual long-poll body.
1262handlePoll : Int -> Int -> Text -> Text -> IO {r *pollWakeup, r *serverGeneration, r *sessions, rw *activePolls, rw *forwards, rw *globalRateCount, rw *globalRateWindowStart, rw *messages, clock} {authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, rateLimited: Bool, retryAfterMs: Int}
1263handlePoll = \cursor generation authorization clientIp -> do
1265 serverGen <- *serverGeneration
1266 g <- checkGlobalRate t
1267 let cursorWasReset = generation != serverGen && cursor > 0
1268 let er = \auth rate retryRate -> yield (emptyPollResp 0 auth rate serverGen retryRate cursorWasReset)
1270 then er (False {}) (True {}) globalRateWindowMs
1271 else pollOnce authorization (if cursorWasReset then 0 else cursor) cursorWasReset clientIp serverGen t
1273-- Body of a single poll. Treats the cursor advance as an implicit ack
1274-- (`ackPolledMessages`), acquires a per-pubkey poll slot, runs `doPoll` to
1275-- collect events (or block until wakeup), then assembles the response.
1276pollOnce : Text -> Int -> Bool -> Text -> Int -> Int<Ms> -> IO {r *pollWakeup, r *sessions, rw *activePolls, rw *forwards, rw *messages, clock} {authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, rateLimited: Bool, retryAfterMs: Int}
1277pollOnce = \authorization cursor cursorWasReset clientIp serverGen t -> do
1278 setup <- atomic withSessionAuth authorization t clientIp (yield (Nothing {})) (\pubkey -> do
1279 let clampedCursor = clamp 0 t cursor
1280 when (clampedCursor > 0) (ackPolledMessages pubkey clampedCursor)
1281 startWakeup <- *pollWakeup
1282 yield (Just {value: {pubkey, clampedCursor, startWakeup}}))
1284 Nothing {} -> yield (emptyPollResp 0 (False {}) (False {}) serverGen 0 cursorWasReset)
1285 Just {value: s} -> do
1286 acquired <- atomic (do
1288 if countWhere aps (\p -> p.pubkey == s.pubkey) >= maxPollsPerKey
1289 then yield (False {})
1291 *activePolls = union aps [{s.pubkey, startedAt: t}]
1294 then yield (emptyPollResp cursor (True {}) (True {}) serverGen pollTimeoutMs cursorWasReset)
1296 pollResult <- doPoll s t
1297 atomic (do aps <- *activePolls; *activePolls = filter aps (\p -> p.pubkey != s.pubkey))
1301 authorized: True {},
1302 rateLimited: False {},
1303 generation: serverGen,
1304 heartbeat: count pollResult.events == 0,
1306 cursorReset: cursorWasReset,
1308 cursorStale: False {},
1312-- One pass: collect events at `t`. If empty, retry-wait on `pollWakeup`
1313-- (bumped by send/heartbeat) and re-collect once at the new wall time.
1314doPoll : {clampedCursor: Int, pubkey: PubkeyHex, startWakeup: Timestamp} -> Int<Ms> -> IO {r *pollWakeup, clock} {cursor: Int<Ms>, events: [{encryptedBlob: BlobHex}], hasMore: Bool}
1316 let collectAt = \tnow -> atomic (do
1318 yield (collectPollEvents msgs s.pubkey s.clampedCursor tnow))
1319 initial <- collectAt t
1320 if count initial.events > 0
1323 atomic (do wakeup <- *pollWakeup; if wakeup > s.startWakeup then yield {} else retry)
1327-- Pull this pubkey's unexpired messages newer than `cursor`, sort by
1328-- receivedAt, take up to `maxPollEvents`, and report `hasMore` if truncated.
1329collectPollEvents : [Message] -> PubkeyHex -> Timestamp -> Timestamp -> {events: [PollEvent], cursor: Timestamp, hasMore: Bool}
1330collectPollEvents = \messages pubkey cursor t -> (\myMsgs -> (\limited -> {events: pluck limited (\m -> {m.encryptedBlob}), cursor: fold (\acc m -> max acc m.receivedAt) cursor limited, hasMore: count myMsgs > count limited}) (takeRelation maxPollEvents (sortBy (\m -> m.receivedAt) myMsgs))) (filter messages (\m -> m.toKey == pubkey && t - m.receivedAt < messageMaxAge && m.receivedAt > cursor))
1332-- Treat the supplied cursor as an ack: drop all messages with
1333-- receivedAt <= cursor, plus their pending forwards.
1334ackPolledMessages : PubkeyHex -> Int -> IO {rw *forwards, rw *messages} {}
1335ackPolledMessages = \pubkey cursor -> do
1337 let matches = \m -> m.toKey == pubkey && m.receivedAt <= cursor
1338 let toAck = filter msgs matches
1339 let blobs = pluck toAck (\m -> m.encryptedBlob)
1340 *messages = removeWhere msgs matches
1342 *forwards = filter fwds (\f -> not (f.toKey == pubkey && elem f.encryptedBlob blobs))
1344-- ============================================
1346-- ============================================
1347-- Accept a message for a recipient pubkey. Placement (live local session,
1348-- federated forward, or held-for-presence) is internal; the response only
1349-- says whether the message was accepted (`error: ""`) or refused (`error:
1350-- "rate_limited" | "unauthorized" | "self_send"`). Duplicates are silently
1351-- treated as success so retries are idempotent.
1352-- Send is gated by global rate and the per-sender / per-pair / per-recipient
1353-- rate limits charged together inside `sendMessageCore`.
1354-- Federated forwards are kicked off in a background fork after the atomic.
1356-- POST /messages: send a list of ciphertexts. Each entry runs through
1357-- `sendMessageCore` separately so per-entry rate limits/errors don't abort
1358-- the rest; federated forwards are forked per entry. Top-level `error`
1359-- carries global gate failures ("rate_limited" | "unauthorized") and
1360-- short-circuits with empty `results`.
1361handleSendMessages : [{encryptedBlob: BlobHex, to: PubkeyHex | a}] -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {error: Text, results: [{error: Text, messageId: MessageIdHex}], retryAfterMs: Int}
1362handleSendMessages = \messages authorization clientIp -> do
1364 let mkErr = \e -> {results: [], error: e, retryAfterMs: 0}
1365 gateAuth authorization clientIp t mkErr (\senderKey -> do
1366 results <- mapEach (takeRelation maxBatchSize messages) (\m -> do
1367 let effMsgId = messageIdOf m.encryptedBlob
1368 r <- atomic (do sendMessageCore senderKey m.to m.encryptedBlob t)
1369 when federationEnabled (fork (forkForwardsTo m.to m.encryptedBlob r.remoteServers))
1370 yield {messageId: effMsgId, r.error})
1371 yield {results, error: "", retryAfterMs: 0})
1373-- Atomic core of /messages. Charges send/pair/recv rate
1374-- counters together (so any limit denies the message), enforces caps and
1375-- self-send/duplicate rejections, allocates a monotonic receivedAt via
1376-- `seqCounter`, appends the message, and pre-stages forwards for any remote
1377-- presence rows that already exist for `to`. Returns the error code (empty
1378-- on success or silent duplicate) and the list of remote servers the caller
1379-- should kick forwards to.
1380sendMessageCore : PubkeyHex -> PubkeyHex -> BlobHex -> Int<Ms> -> IO {r *deliveredIds, rw *forwards, rw *messages, rw *pairRates, rw *pollWakeup, r *presence, rw *recvRates, rw *sendRates, rw *seqCounter} {remoteServers: [Text], error: Text}
1381sendMessageCore = \senderKey to encryptedBlob t -> do
1383 dids <- *deliveredIds
1384 sRates <- *sendRates
1385 let sR = checkRate sRates senderKey maxSendRatePerKey sendRateWindowMs t
1386 *sendRates = sR.entries
1387 let srLim = sR.limited
1388 pRates <- *pairRates
1389 let pR = checkRate pRates (senderKey ++ "|" ++ to) maxPairRatePerPair pairRateWindowMs t
1390 *pairRates = pR.entries
1391 let prLim = pR.limited
1392 rRates <- *recvRates
1393 let rR = checkRate rRates to maxRecvRatePerKey recvRateWindowMs t
1394 *recvRates = rR.entries
1395 let rrLim = rR.limited
1396 let reject = \e -> yield {error: e, remoteServers: []}
1398 then reject "self_send"
1399 else if isDuplicateMessage encryptedBlob to msgs dids
1401 else if srLim || prLim || rrLim
1402 then reject "rate_limited"
1406 let seqTs = nextSeqTs t seq
1408 *messages = union msgs [{toKey: to, encryptedBlob, receivedAt: seqTs}]
1410 let toPresence = presenceForKey pres to t
1411 let remoteServers = collectPeers toPresence (\p -> p.server)
1412 when federationEnabled (do
1414 let newFwds = mapWhere remoteServers (\s -> none fwds (\f -> f.encryptedBlob == encryptedBlob && f.toServer == s)) (\s -> {
1420 *forwards = union fwds newFwds)
1421 yield {error: "", remoteServers}
1423-- Fire one /federation/forward call per pre-staged server. On success the
1424-- corresponding row in `forwards` is pruned, and if no other forwards remain
1425-- for this blob AND the recipient has no local presence, the backing
1426-- `*messages` row is dropped too: the origin's job is done and the message
1427-- now lives on the receiving peer's mailbox. On failure the forwards row
1428-- stays so `retryPendingForwards` can re-attempt with backoff.
1429forkForwardsTo : PubkeyHex -> BlobHex -> [Text] -> IO {} {}
1430forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
1431 let effMsgId = messageIdOf encryptedBlob
1433 let same = \x -> x.encryptedBlob == encryptedBlob && x.toServer == server
1434 case findFirst fwds same of
1435 Nothing {} -> yield {}
1436 Just {value: f} -> do
1438 auth <- generateFederationAuth ("forward:" ++ effMsgId) t
1439 result <- fetch (federationUrl server) (ForwardMessage {
1442 messageId: effMsgId,
1443 fromServer: serverHostN,
1444 requestTimestamp: t,
1445 authorization: auth,
1449 Err _ -> recordFailure server
1450 Ok {value: r} -> when r.ok (do
1454 let remaining = filter fwds2 (\x -> not same x)
1455 *forwards = remaining
1457 let stillLocal = any pres (\p -> p.pubkey == to && isLocalServer p.server && p.expiresAt > t)
1458 let othersPending = any remaining (\x -> x.encryptedBlob == encryptedBlob)
1459 when (not stillLocal && not othersPending) (do
1461 *messages = filter msgs (\m -> m.encryptedBlob != encryptedBlob)))))
1463-- ============================================
1465-- ============================================
1466-- Presence resolution for clients deciding where to send. Remote presence is
1467-- masked to the literal string "remote" rather than leaking the peer hostname
1468-- (the routing decision is the server's, not the sender's).
1470-- GET /lookup/{pubkey}: return our local server name if the key is here,
1471-- "remote" if known on a peer, "" otherwise. Peer hostnames are deliberately
1472-- masked (see section header).
1473handleLookupPresence : PubkeyHex -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, error: Text, server: Text}
1474handleLookupPresence = \pubkey authorization clientIp -> do
1476 let mkErr = \e -> {server: "", authorized: False {}, error: if e == "rate_limited" then e else ""}
1477 gateLookup authorization clientIp t mkErr {server: "", authorized: True {}, error: "rate_limited"} (\_ -> do
1479 yield {server: maskedServer pres pubkey t, authorized: True {}, error: ""})
1481-- POST /lookup/batch: same masking as `handleLookupPresence`, but for up to
1482-- 50 pubkeys in one round-trip.
1483handleBatchLookupPresence : [PubkeyHex] -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, error: Text, results: [{pubkey: PubkeyHex, server: Text}]}
1484handleBatchLookupPresence = \pubkeys authorization clientIp -> do
1488 authorized: False {},
1489 error: if e == "rate_limited" then e else ""
1491 gateLookup authorization clientIp t mkErr {
1493 authorized: True {},
1494 error: "rate_limited"
1497 let results = pluck (takeRelation 50 pubkeys) (\k -> {pubkey: k, server: maskedServer pres k t})
1498 yield {results, authorized: True {}, error: ""})
1500-- POST /messages/status: classify a message as
1501-- pending (in mailbox), forwarding (en-route to a peer),
1502-- delivered (acked or terminal), or unknown.
1503handleMessageStatus : PubkeyHex -> MessageIdHex -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, status: Text}
1504handleMessageStatus = \to messageId authorization clientIp -> do
1506 let mkErr = \_ -> {status: "", authorized: False {}}
1507 gateAuth authorization clientIp t mkErr (\_ -> do
1510 dids <- *deliveredIds
1511 let blobMatches = \x -> messageIdOf x.encryptedBlob == messageId && x.toKey == to
1512 let didMatches = \d -> d.messageId == messageId && d.toKey == to
1513 let s = if any msgs blobMatches
1515 else if any fwds blobMatches
1517 else if any dids didMatches then "delivered" else "unknown"
1518 yield {status: s, authorized: True {}})
1520-- ============================================
1521-- Handler: ack / list / delete
1522-- ============================================
1523-- Mailbox mutation by the recipient (ack, list, delete).
1525-- POST /messages/ack: explicit ack by message id (alternative to the implicit
1526-- cursor-based ack in /poll). Drops mailbox+forward rows.
1527handleAckMessages : [MessageIdHex] -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {ackedCount: Int, authorized: Bool, error: Text, ok: Bool}
1528handleAckMessages = \messageIds authorization clientIp -> do
1530 let mkErr = \e -> {ok: False {}, authorized: False {}, ackedCount: 0, error: e}
1531 gateClientWrite authorization clientIp t mkErr {
1533 authorized: True {},
1535 error: "rate_limited"
1537 ackedCount <- atomic (do
1538 toAck <- removeForKey (\x -> x.toKey == pubkey && elem (messageIdOf x.encryptedBlob) (dedupMessageIds messageIds))
1539 yield (count toAck))
1540 yield {ok: True {}, authorized: True {}, ackedCount, error: ""})
1542-- POST /messages/list: paginated peek at the caller's mailbox without acking.
1543-- Returns metadata only (no ciphertext) plus the total count.
1544handleListMessages : Int -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, count: Int, error: Text, messages: [{messageId: MessageIdHex, receivedAt: Int<Ms>}]}
1545handleListMessages = \offset authorization clientIp -> do
1549 authorized: False {},
1551 error: if e == "rate_limited" then e else ""
1553 gateAuth authorization clientIp t mkErr (\pubkey -> do
1555 rates <- *lookupRates
1556 let r = checkRate rates pubkey maxLookupRatePerKey lookupRateWindowMs t
1557 *lookupRates = r.entries
1560 then yield {messages: [], authorized: True {}, count: 0, error: "rate_limited"}
1563 let myMsgs = sortBy (\m -> m.receivedAt) (filter msgs (\m -> m.toKey == pubkey && t - m.receivedAt < messageMaxAge))
1564 let total = count myMsgs
1565 let page = pluck (takeRelation maxPollEvents (dropRelation (clamp 0 total offset) myMsgs)) (\m -> {
1566 messageId: messageIdOf m.encryptedBlob,
1569 yield {messages: page, authorized: True {}, count: total, error: ""})
1571-- POST /messages/delete: same effect as ack from the recipient's side, with
1572-- a "delete" semantic for the response.
1573handleDeleteMessages : [MessageIdHex] -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, deletedCount: Int, error: Text, ok: Bool}
1574handleDeleteMessages = \messageIds authorization clientIp -> do
1576 let mkErr = \e -> {ok: False {}, authorized: False {}, deletedCount: 0, error: e}
1577 gateClientWrite authorization clientIp t mkErr {
1579 authorized: True {},
1581 error: "rate_limited"
1583 deletedCount <- atomic (do
1584 toDel <- removeForKey (\x -> x.toKey == pubkey && elem (messageIdOf x.encryptedBlob) (dedupMessageIds messageIds))
1585 yield (count toDel))
1586 yield {ok: True {}, authorized: True {}, deletedCount, error: ""})
1588-- ============================================
1589-- Handler: federation receive
1590-- ============================================
1591-- Inbound endpoints called peer-to-peer. Every handler funnels through
1592-- `withFederationAuth` which checks: peer block/allow lists, request
1593-- precondition (e.g. expected origin/server constraints), clock skew vs the
1594-- request timestamp, Ed25519 signature auth, and per-peer rate limit.
1596-- GET /federation/pubkey: publish the Ed25519 public key peers should use to
1597-- verify our `Signed ...` federation auth headers. Returns ok=False when the
1598-- keypair has not yet been generated (should not happen post-startup).
1599handleFederationPubkey : IO {r *federationPublicKeyHex} {pubkey: Text, ok: Bool}
1600handleFederationPubkey = do
1601 hex <- *federationPublicKeyHex
1602 yield {pubkey: hex, ok: hex != ""}
1604-- POST /federation/gossip: ingest peer presence events. The transport-level
1605-- `fromServer` is the home server for every event. Drops every (pubkey,
1606-- fromServer) row touched by this batch, then re-adds fresh-TTL rows for
1607-- pubkeys with a `GossipOnline` event (so Online wins on collision). For keys
1608-- that transition offline → online, flushes any locally-buffered messages via
1609-- `forwardQueuedToServer`.
1610handleRecvGossip : [{eventType: <GossipOffline {} | GossipOnline {} | a>, pubkey: PubkeyHex | b}] -> Text -> Int -> Text -> IO {r *allowedPeers, r *blockedPeers, rw *federationRates, rw *presence, clock, network} {error: Text, ok: Bool, retryAfterMs: Int}
1611handleRecvGossip = \events fromServer requestTimestamp authorization -> do
1613 withFederationAuth authorization t (\e r -> {ok: False {}, error: e, retryAfterMs: r}) fromServer "gossip" requestTimestamp (isRemote fromServer && count events <= maxGossipEvents) (do
1614 newlyOnline <- atomic (do
1616 let touchedPubkeys = pluck events (\e -> e.pubkey)
1617 let onlinePubkeys = pluck (filter events (\e -> case e.eventType of
1618 GossipOnline {} -> True {}
1619 _ -> False {})) (\e -> e.pubkey)
1620 let kept = filter pres (\p -> p.server != fromServer || not elem p.pubkey touchedPubkeys)
1621 let added = map (\pk -> {pubkey: pk, server: fromServer, expiresAt: t + onlineGossipTtl}) onlinePubkeys
1622 *presence = union kept added
1623 yield (filter onlinePubkeys (\pk -> none pres (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t))))
1624 fork (forEach newlyOnline (\pk -> forwardQueuedToServer pk fromServer))
1625 yield {ok: True {}, error: "", retryAfterMs: 0})
1627-- Store a federated/forwarded message into the local mailbox. Caller wraps in `atomic`.
1628-- Returns "" on success (including duplicates), otherwise an error code:
1629-- "no_presence" | "rate_limited" (only when checkRecvRate).
1631-- The presence gate requires the recipient to be **currently locally online**
1632-- (not just visible to gossip somewhere). Without that, an A → B forward based
1633-- on stale gossip about R could land on B with no actively-polling client and
1634-- get stuck. If B refuses, A retries via `retryPendingForwards` against the
1635-- next presence target.
1636storeFederated : PubkeyHex -> BlobHex -> Bool -> Int<Ms> -> IO {r *deliveredIds, rw *messages, rw *pollWakeup, r *presence, rw *recvRates, rw *seqCounter} Text
1637storeFederated = \toKey encryptedBlob checkRecvRate t -> do
1640 dids <- *deliveredIds
1641 if not any pres (\p -> p.pubkey == toKey && isLocalServer p.server && p.expiresAt > t)
1642 then yield "no_presence"
1643 else if isDuplicateMessage encryptedBlob toKey msgs dids
1646 limited <- if checkRecvRate
1648 rRates <- *recvRates
1649 let r = checkRate rRates toKey maxRecvRatePerKey recvRateWindowMs t
1650 *recvRates = r.entries
1652 else yield (False {})
1654 then yield "rate_limited"
1657 let seqTs = nextSeqTs t seq
1659 *messages = union msgs [{toKey, encryptedBlob, receivedAt: seqTs}]
1663-- POST /federation/forward: receive a single federated message destined for
1664-- a local key. Delegates the actual store decision to `storeFederated`,
1665-- which returns "" on success (including the duplicate case). The peer-
1666-- supplied messageId in the request body is ignored: we derive the id from
1667-- the blob ourselves so a hostile peer cannot bypass dedup by varying the
1668-- id. Honest senders derive the same value, so the "forward:" ++ messageId
1669-- auth scope still verifies.
1670handleForwardMessage : PubkeyHex -> BlobHex -> Text -> Text -> Int -> Text -> IO {r *allowedPeers, r *blockedPeers, rw *federationRates, r *deliveredIds, rw *messages, rw *pollWakeup, r *presence, rw *recvRates, rw *seqCounter, clock, network} {error: Text, ok: Bool, retryAfterMs: Int}
1671handleForwardMessage = \toKey encryptedBlob _ fromServer requestTimestamp authorization -> do
1672 let messageId = messageIdOf encryptedBlob
1674 withFederationAuth authorization t (\e r -> {ok: False {}, error: e, retryAfterMs: r}) fromServer ("forward:" ++ messageId) requestTimestamp (isRemote fromServer) (do
1675 result <- atomic storeFederated toKey encryptedBlob (True {}) t
1676 yield {ok: result == "", error: result, retryAfterMs: 0})
1678-- POST /federation/forward-batch: bulk variant of `handleForwardMessage`.
1679-- Skips per-entry recv-rate charging (the per-server federation rate limit
1680-- already gates the call as a whole).
1681handleFederationBatchForward : [{encryptedBlob: BlobHex, messageId: MessageIdHex, toKey: PubkeyHex | a}] -> Text -> Int -> Text -> IO {r *allowedPeers, r *blockedPeers, rw *federationRates, clock, network} {error: Text, ok: Bool, results: [{messageId: MessageIdHex, ok: Bool}], retryAfterMs: Int}
1682handleFederationBatchForward = \forwards fromServer requestTimestamp authorization -> do
1684 withFederationAuth authorization t (\e r -> {ok: False {}, error: e, results: [], retryAfterMs: r}) fromServer "forward-batch" requestTimestamp (isRemote fromServer && count forwards <= maxBatchSize) (do
1685 results <- mapEach (takeRelation maxBatchSize forwards) (\e -> do
1686 -- Recompute id from blob; ignore e.messageId (untrusted, peer-chosen).
1687 let messageId = messageIdOf e.encryptedBlob
1688 result <- atomic storeFederated e.toKey e.encryptedBlob (False {}) t
1689 yield {messageId, ok: result == ""})
1690 yield {ok: True {}, error: "", results, retryAfterMs: 0})
1692-- ============================================
1693-- Maintenance handlers
1694-- ============================================
1695-- Operator endpoints, all gated by `runtimeMaintenanceSecret` (Bearer header).
1696-- Admin endpoints can revoke sessions by pubkey or IP, purge a recipient's
1697-- mailbox, list aggregated session activity, block/allow peers, rotate the
1698-- maintenance secret, and read live config.
1700-- POST /maintenance/prune: trigger an out-of-band `pruneAndRetry` tick.
1701-- Useful when the operator wants to force expiry/forward retries without
1702-- waiting for the next `backgroundPrune` interval.
1703handlePrune : Text -> IO {r *runtimeMaintenanceSecret, rw *activePolls, r *blockedPeers, rw *challenges, rw *deliveredIds, rw *forwardFailures, r *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *sessions, clock} {ok: Bool}
1704handlePrune = \authorization -> do
1706 authorized <- verifyMaintenanceAuth authorization
1707 when authorized (fork (pruneAndRetry t))
1708 yield {ok: authorized}
1710-- POST /maintenance/reconcile: stub. Production builds run a state
1711-- reconciliation pass here; this simplified server reports zero drift.
1712handleReconcile : Text -> IO {r *runtimeMaintenanceSecret} {messageDrift: Int, ok: Bool, presenceDrift: Int, sessionDrift: Int}
1713handleReconcile = \authorization -> do
1714 authorized <- verifyMaintenanceAuth authorization
1715 yield {ok: authorized, messageDrift: 0, presenceDrift: 0, sessionDrift: 0}
1717-- GET /health: aggregate readiness flags. During an initial warmup window
1718-- (3 prune intervals after startup) prune/heartbeat checks always pass to
1719-- avoid false negatives before the background loops have ticked.
1720handleHealth : a -> IO {r *lastHeartbeatAt, r *lastPrunedAt, r *startedAt, clock} {capacityHealthy: Bool, capacityWarning: Bool, degradedPeers: Int, federationHealthy: Bool, forwardQueueHealthy: Bool, heartbeatHealthy: Bool, nonceHealthy: Bool, ok: Bool, pruneHealthy: Bool, requestPressureHealthy: Bool, version: Text, watchdogHealthy: Bool}
1721handleHealth = \authorization -> do
1723 lastPrune <- *lastPrunedAt
1724 lastHb <- *lastHeartbeatAt
1726 let warmup = t - sa < backgroundPruneInterval * 3
1727 let pruneOk = warmup || t - lastPrune < backgroundPruneInterval * 3
1728 let heartbeatOk = warmup || t - lastHb < pollTimeoutMs * 3
1730 ok: pruneOk && heartbeatOk,
1731 version: serverBuildVersion,
1732 pruneHealthy: pruneOk,
1733 heartbeatHealthy: heartbeatOk,
1734 capacityHealthy: True {},
1735 capacityWarning: False {},
1736 federationHealthy: True {},
1737 watchdogHealthy: True {},
1738 nonceHealthy: True {},
1739 forwardQueueHealthy: True {},
1740 requestPressureHealthy: True {},
1744-- GET /ready: signals readiness once the first background prune has run
1745-- (load-balancer / orchestrator probe).
1746handleReady : IO {r *lastPrunedAt, r *startedAt} {ready: Bool}
1749 lastPrune <- *lastPrunedAt
1750 yield {ready: lastPrune > 0 && lastPrune >= sa}
1752-- POST /maintenance/block: deny-list a peer. Outbound retries skip blocked
1753-- peers; inbound federation calls from blocked peers fail in `withFederationAuth`.
1754handleBlockPeer : Text -> Text -> IO {rw *blockedPeers, r *runtimeMaintenanceSecret} {blocked: Int, ok: Bool}
1755handleBlockPeer = \server authorization -> withMaintAuth authorization (yield {
1760 current <- *blockedPeers
1761 let updated = union current [server]
1762 *blockedPeers = updated
1763 yield (count updated))
1764 yield {ok: True {}, blocked: n})
1766-- POST /maintenance/unblock: remove a peer from the deny-list.
1767handleUnblockPeer : Text -> Text -> IO {rw *blockedPeers, r *runtimeMaintenanceSecret} {ok: Bool, unblocked: Bool}
1768handleUnblockPeer = \server authorization -> withMaintAuth authorization (yield {
1772 removed <- atomic (do
1773 current <- *blockedPeers
1774 *blockedPeers = removeWhere current (\x -> x == server)
1775 yield (elem server current))
1776 yield {ok: True {}, unblocked: removed})
1778-- GET /maintenance/blocked: list the deny-listed peers (empty for unauthorized).
1779handleListBlocked : Text -> IO {r *blockedPeers, r *runtimeMaintenanceSecret} {ok: Bool, peers: [Text]}
1780handleListBlocked = \authorization -> do
1781 ok <- verifyMaintenanceAuth authorization
1782 list <- *blockedPeers
1783 yield {peers: if ok then list else [], ok}
1785-- POST /maintenance/allow: when the allowed-peers list is non-empty, only
1786-- federation calls from listed peers are accepted (whitelist mode). An empty
1787-- list disables the whitelist.
1788handleAllowPeer : Text -> Text -> IO {rw *allowedPeers, r *runtimeMaintenanceSecret} {allowed: Int, ok: Bool}
1789handleAllowPeer = \server authorization -> withMaintAuth authorization (yield {
1794 current <- *allowedPeers
1795 let updated = union current [server]
1796 *allowedPeers = updated
1797 yield (count updated))
1798 yield {ok: True {}, allowed: n})
1800-- POST /maintenance/unallow: remove an entry from the allow-list. If the
1801-- list becomes empty, the whitelist gate disengages.
1802handleUnallowPeer : Text -> Text -> IO {rw *allowedPeers, r *runtimeMaintenanceSecret} {ok: Bool, removed: Bool}
1803handleUnallowPeer = \server authorization -> withMaintAuth authorization (yield {
1807 removed <- atomic (do
1808 current <- *allowedPeers
1809 *allowedPeers = removeWhere current (\x -> x == server)
1810 yield (elem server current))
1811 yield {ok: True {}, removed})
1813-- GET /maintenance/allowed: list the allow-listed peers (empty for unauthorized).
1814handleListAllowed : Text -> IO {r *allowedPeers, r *runtimeMaintenanceSecret} {ok: Bool, peers: [Text]}
1815handleListAllowed = \authorization -> do
1816 ok <- verifyMaintenanceAuth authorization
1817 list <- *allowedPeers
1818 yield {peers: if ok then list else [], ok}
1820-- POST /maintenance/ping: send a zero-event gossip to a peer and return the
1821-- round-trip latency. Useful for diagnosing federation reachability without
1822-- waiting for organic traffic.
1823handlePingPeer : Text -> Text -> IO {r *federationPrivateKeyHex, r *runtimeMaintenanceSecret, network, clock, random} {error: Text, latencyMs: Int, ok: Bool}
1824handlePingPeer = \server authorization -> withMaintAuth authorization (yield {
1827 error: "unauthorized"
1828}) (if isBadServerName server
1829then yield {ok: False {}, latencyMs: 0, error: "invalid_server"}
1832 auth <- generateFederationAuth "gossip" startTime
1833 result <- fetch (federationUrl server) (RecvGossip {
1834 authorization: auth,
1836 fromServer: serverHostN,
1837 requestTimestamp: startTime,
1842 Err e -> yield {ok: False {}, latencyMs: endTime - startTime, error: show e}
1843 Ok {value: r} -> yield {r.ok, latencyMs: endTime - startTime, r.error})
1845-- GET /maintenance/sessions/{pubkey}: list a single user's active sessions.
1846-- Token values are masked ("***") — operators see expiry and ip only.
1847handleAdminListSessions : PubkeyHex -> Text -> IO {r *runtimeMaintenanceSecret, r *sessions} {count: Int, ok: Bool, sessions: [{expiresAt: Int<Ms>, ip: Text, token: Text}]}
1848handleAdminListSessions = \pubkey authorization -> do
1849 ok <- verifyMaintenanceAuth authorization
1852 then mapWhere ses (\s -> s.pubkey == pubkey) (\s -> {token: "***", s.expiresAt, s.ip})
1854 yield {sessions: mine, count: count mine, ok}
1856-- POST /maintenance/sessions/revoke-all: drop every session and local presence
1857-- row for `pubkey`. Operator-side kick for a compromised key.
1858handleAdminRevokeSessions : PubkeyHex -> Text -> IO {rw *presence, r *runtimeMaintenanceSecret, rw *sessions} {ok: Bool, revokedCount: Int}
1859handleAdminRevokeSessions = \pubkey authorization -> withMaintAuth authorization (yield {
1863 revoked <- atomic (do
1865 let same = \s -> s.pubkey == pubkey
1866 *sessions = removeWhere ses same
1868 *presence = filter pres (\p -> p.pubkey != pubkey || isRemote p.server)
1869 yield (countWhere ses same))
1870 yield {ok: True {}, revokedCount: revoked})
1872-- POST /maintenance/messages/purge: drop all queued/forwarding messages
1873-- destined for `pubkey`. With the federation ack flow gone, there's nothing
1874-- to ack back — peers will discover the absence on their next forward attempt.
1875handleAdminPurgeMessages : PubkeyHex -> Text -> IO {rw *forwards, rw *messages, r *runtimeMaintenanceSecret} {ok: Bool, purgedCount: Int}
1876handleAdminPurgeMessages = \pubkey authorization -> withMaintAuth authorization (yield {
1880 purged <- atomic (do
1882 let mine = \m -> m.toKey == pubkey
1883 let purgedMsgs = filter msgs mine
1884 *messages = removeWhere msgs mine
1886 *forwards = filter fwds (\f -> f.toKey != pubkey)
1887 yield (count purgedMsgs))
1888 yield {ok: True {}, purgedCount: purged})
1890-- POST /maintenance/sessions/revoke-ip: kill every session bound to a given
1891-- client IP, regardless of pubkey. Reports total revoked + distinct keys.
1892handleAdminRevokeIp : Text -> Text -> IO {r *runtimeMaintenanceSecret, rw *sessions} {affectedKeys: Int, ok: Bool, revokedCount: Int}
1893handleAdminRevokeIp = \ip authorization -> withMaintAuth authorization (yield {
1902 let same = \s -> s.ip == ip
1903 *sessions = removeWhere ses same
1904 yield (mapWhere ses same (\s -> s.pubkey)))
1905 yield {ok: ip != "", revokedCount: count keys, affectedKeys: count keys})
1907-- POST /maintenance/sessions/list: paged session inventory aggregated by
1908-- pubkey (count, distinct ips, latest expiry). Sorted by descending count.
1909handleAdminListAllSessions : Int -> Text -> IO {r *runtimeMaintenanceSecret, r *sessions, clock} {ok: Bool, sessions: [{count: Int, ips: [Text], latestExpiry: Int, pubkey: PubkeyHex}], total: Int}
1910handleAdminListAllSessions = \limit authorization -> withMaintAuth authorization (yield {
1917 let active = filter ses (\s -> s.expiresAt > t)
1918 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)))
1919 let cap = clamp 1 500 (if limit <= 0 then 100 else limit)
1920 let top = takeRelation cap (sortBy (\g -> 0 - g.count) grouped)
1921 yield {sessions: top, ok: True {}, total: count grouped})
1923-- GET /maintenance/rate-limits: expose the configured rate ceilings. Returns
1924-- zeros for unauthenticated callers (response shape stays stable).
1925handleGetRateLimits : Text -> IO {r *runtimeMaintenanceSecret} {authGlobal: Int, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, sendRate: Int}
1926handleGetRateLimits = \authorization -> do
1927 ok <- verifyMaintenanceAuth authorization
1928 let v = \x -> if ok then x else 0
1931 globalRequest: v maxGlobalRequestRate,
1932 ipRate: v maxIpRatePerIp,
1933 sendRate: v maxSendRatePerKey,
1934 federationRate: v maxFederationRatePerServer,
1935 authGlobal: v maxAuthGlobalRate,
1936 recvRate: v maxRecvRatePerKey,
1937 challengeRate: v maxChallengeRatePerKey,
1938 pairRate: v maxPairRatePerPair,
1939 lookupRate: v maxLookupRatePerKey,
1940 clientWriteRate: v maxClientWriteRatePerKey
1943-- POST /maintenance/rate-limits: stub. Rate ceilings are compile-time constants
1944-- in this simplified server, so this just authorizes and returns ok=true.
1945handleSetRateLimits : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Text -> IO {r *runtimeMaintenanceSecret} {ok: Bool}
1946handleSetRateLimits = \globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization -> do
1947 authorized <- verifyMaintenanceAuth authorization
1948 yield {ok: authorized}
1950-- POST /maintenance/nonces/flush: stub. Nonce caches were removed; the
1951-- endpoint is preserved so older operator tooling keeps working.
1952handleFlushNonces : Text -> IO {r *runtimeMaintenanceSecret} {flushedCount: Int, ok: Bool}
1953handleFlushNonces = \authorization -> do
1954 authorized <- verifyMaintenanceAuth authorization
1955 yield {ok: authorized, flushedCount: 0}
1957-- POST /maintenance/rotate-secret: replace the maintenance Bearer secret.
1958-- The old secret authenticates the rotation; subsequent calls must use the
1960handleRotateSecret : Text -> Text -> IO {rw *runtimeMaintenanceSecret} {error: Text, ok: Bool}
1961handleRotateSecret = \newSecret authorization -> withMaintAuth authorization (yield {
1963 error: "unauthorized"
1965 atomic *runtimeMaintenanceSecret = newSecret
1966 yield {ok: True {}, error: ""})
1968-- GET /maintenance/config: expose a small set of operationally-relevant
1969-- compile-time constants (poll timeout, ack grace).
1970handleGetConfig : Text -> IO {r *runtimeMaintenanceSecret} {ackGracePeriod: Int, ok: Bool, pollTimeoutMs: Int}
1971handleGetConfig = \authorization -> do
1972 ok <- verifyMaintenanceAuth authorization
1973 let v = \x -> if ok then x else 0
1974 yield {ok, pollTimeoutMs: v pollTimeoutMs, ackGracePeriod: v ackGracePeriod}
1976-- GET /stats: capacity gauges + minimal federation/timing snapshot. Most of
1977-- the historical metric fields are zero-filled (see `zeroStats`) — only the
1978-- counts that come straight from the state refs are populated.
1979handleStats : Text -> IO {r *activePolls, r *blockedPeers, r *challenges, r *deliveredIds, r *forwards, r *heartbeatCount, r *lastHeartbeatAt, r *lastPrunedAt, r *messages, r *presence, r *pruneCount, r *runtimeMaintenanceSecret, r *sessions, r *startedAt, clock} {capacity: {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, 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, 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}
1980handleStats = \authorization -> withMaintAuth authorization (yield zeroStats) (do
1983 sessions <- *sessions
1987 dids <- *deliveredIds
1992 hc <- *heartbeatCount
1994 lh <- *lastHeartbeatAt
1995 let sCount = count sessions
1996 let mCount = count msgs
1997 let pCount = count pres
1998 let fCount = count fwds
2001 version: serverBuildVersion,
2004 sessionsMax: maxSessions,
2005 sessionsPct: pct sCount maxSessions,
2007 totalMessageCount: mCount,
2010 challenges: count chs,
2011 challengesMax: maxChallenges,
2012 deliveredIds: count dids,
2013 deliveredIdsMax: maxDeliveredIds,
2015 forwardNoncesMax: 0,
2017 activePolls: count aps,
2019 messageBucketMax: 0,
2023 enabled: federationEnabled,
2032 oldestForwardAge: 0,
2035 blockedPeers: count bp,
2037 maxForwardQueueDepth: 0,
2038 topFailingPeers: [],
2041 latencyBuckets: {lt100: 0, lt500: 0, lt2000: 0, gte2000: 0}
2056 pendingAckCleanups: 0,
2061 rejectedFederation: 0
2069 lastHeartbeatAt: lh,
2070 totalEntries: sCount + mCount + pCount + fCount,
2072 peakActiveRequests: 0,
2076 pollLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0},
2080 sendLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0},
2087-- All-zero /stats payload returned to unauthorized callers. The shape is kept
2088-- in lockstep with the response in `handleStats` so older operator tooling
2089-- never sees a missing field.
2090zeroStats : {capacity: {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, 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, 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}
2093 version: serverBuildVersion,
2099 totalMessageCount: 0,
2107 forwardNoncesMax: 0,
2111 messageBucketMax: 0,
2124 oldestForwardAge: 0,
2129 maxForwardQueueDepth: 0,
2130 topFailingPeers: [],
2133 latencyBuckets: {lt100: 0, lt500: 0, lt2000: 0, gte2000: 0}
2148 pendingAckCleanups: 0,
2153 rejectedFederation: 0
2164 peakActiveRequests: 0,
2168 pollLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0},
2172 sendLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0},
2179-- GET /stats/peers: per-peer failure summary derived from `forwardFailures`,
2180-- including current backoff and pending forward queue depth.
2181handleStatsPeers : 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}]}
2182handleStatsPeers = \authorization -> withMaintAuth authorization (yield {peers: [], ok: False {}}) (do
2184 failures <- *forwardFailures
2187 peers: pluck failures (\f -> {
2190 lastFailedAt: f.failedAt,
2192 backoffMs: retryBackoff f.failures,
2193 retriable: shouldRetryServer f.server t failures,
2194 pendingForwards: countWhere fwds (\x -> x.toServer == f.server),
2198 gossipEventsPerMin: 0
2203-- GET /stats/key/{pubkey}: per-key footprint — message count, presence rows,
2204-- session count, queued forwards (with details), and active long-poll count.
2205handleStatsKey : PubkeyHex -> Text -> IO {r *activePolls, r *forwards, r *messages, r *presence, r *runtimeMaintenanceSecret, r *sessions, clock} {activePolls: Int, forwardDetails: [{retries: Int, server: ServerName}], forwards: Int, messages: Int, ok: Bool, presence: [{expiresAt: Int<Ms>, server: ServerName}], sessions: Int}
2206handleStatsKey = \pubkey authorization -> withMaintAuth authorization (yield {
2221 let myFwds = filter fwds (\x -> x.toKey == pubkey)
2223 messages: countWhere msgs (\x -> x.toKey == pubkey),
2224 presence: mapWhere pres (\x -> x.pubkey == pubkey && x.expiresAt > t) (\x -> {
2228 sessions: countWhere ses (\x -> x.pubkey == pubkey),
2229 forwards: count myFwds,
2230 forwardDetails: pluck myFwds (\x -> {server: x.toServer, x.retries}),
2231 activePolls: countWhere aps (\x -> x.pubkey == pubkey),
2235-- POST /stats/top-recipients: ranked list of pubkeys by mailbox depth.
2236-- `limit` defaults to 20, capped at 100, used to spot hot-spots / abuse.
2237handleTopRecipients : Int -> Text -> IO {r *messages, r *runtimeMaintenanceSecret} {ok: Bool, recipients: [RecipientCount], total: Int}
2238handleTopRecipients = \limit authorization -> withMaintAuth authorization (yield {
2244 let counts = pluck (pluck msgs (\m -> m.toKey)) (\pk -> {
2246 count: countWhere msgs (\m -> m.toKey == pk)
2248 let cap = clamp 1 100 (if limit <= 0 then 20 else limit)
2249 let top = takeRelation cap (sortBy (\c -> 0 - c.count) counts)
2250 yield {recipients: top, ok: True {}, total: count counts})
2252-- GET /stats/forwards: per-destination forward queue summary — count and
2253-- total accumulated retries.
2254handleStatsForwards : Text -> IO {r *forwards, r *runtimeMaintenanceSecret} {ok: Bool, servers: [{count: Int<u>, server: ServerName, totalRetries: Int}], total: Int}
2255handleStatsForwards = \authorization -> withMaintAuth authorization (yield {
2262 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))),
2267-- GET /stats/rates: same shape as /maintenance/rate-limits with an extra
2268-- scalePct field. Kept separate for backwards compatibility with older clients.
2269handleStatsRates : Text -> IO {r *runtimeMaintenanceSecret} {authGlobal: Int, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, scalePct: Int, sendRate: Int}
2270handleStatsRates = \authorization -> do
2271 ok <- verifyMaintenanceAuth authorization
2272 let v = \x -> if ok then x else 0
2276 globalRequest: v maxGlobalRequestRate,
2277 ipRate: v maxIpRatePerIp,
2278 sendRate: v maxSendRatePerKey,
2279 federationRate: v maxFederationRatePerServer,
2280 authGlobal: v maxAuthGlobalRate,
2281 recvRate: v maxRecvRatePerKey,
2282 challengeRate: v maxChallengeRatePerKey,
2283 pairRate: v maxPairRatePerPair,
2284 lookupRate: v maxLookupRatePerKey,
2285 clientWriteRate: v maxClientWriteRatePerKey
2288-- GET /metrics: Prometheus-style text exposition of the most useful gauges.
2289-- The `authorization` header is accepted but not validated here — operators
2290-- relying on auth must front this endpoint with a reverse proxy that enforces it.
2291handleMetrics : a -> IO {r *activePolls, r *forwards, r *messages, r *presence, r *sessions, r *startedAt, clock} {metrics: Text, ok: Bool}
2292handleMetrics = \authorization -> do
2301 metrics: fold (\acc r -> acc ++ r.k ++ " " ++ show r.v ++ "\n") "" [
2302 {k: "skrepka_messages_total", v: count msgs},
2303 {k: "skrepka_sessions_total", v: count ses},
2304 {k: "skrepka_presence_total", v: count pres},
2305 {k: "skrepka_forwards_total", v: count fwds},
2306 {k: "skrepka_active_polls", v: count aps},
2307 {k: "skrepka_uptime_seconds", v: (t - sa) / 1000}
2312-- ============================================
2314-- ============================================
2315-- Single match from generated request constructor (one per route entry above)
2316-- to the corresponding `handleXxx` function. Adding a new route means adding
2317-- a `route ... = NewReq` line, a `handleNewReq` definition, and a clause here.
2319-- Top-level request dispatcher: maps each generated request constructor to
2320-- its `handleXxx` function. Every route entry above must have a clause here.
2322api = serve Api where
2323 ReqChallenge = \{pubkey, clientIp} -> handleChallenge pubkey clientIp
2324 VerifyAuth = \{pubkey, challenge, signature, revokeOthers, clientIp} -> handleVerifyAuth pubkey challenge signature revokeOthers clientIp
2325 RevokeSession = \{targetToken, authorization, clientIp} -> handleRevoke targetToken authorization clientIp
2326 Logout = \{authorization, clientIp} -> handleLogout authorization clientIp
2327 Poll = \{cursor, generation, authorization, clientIp} -> handlePoll cursor generation authorization clientIp
2328 SendMessages = \{messages, authorization, clientIp} -> handleSendMessages messages authorization clientIp
2329 MessageStatus = \{to, messageId, authorization, clientIp} -> handleMessageStatus to messageId authorization clientIp
2330 AckMessages = \{messageIds, authorization, clientIp} -> handleAckMessages messageIds authorization clientIp
2331 ListMessages = \{offset, authorization, clientIp} -> handleListMessages offset authorization clientIp
2332 DeleteMessages = \{messageIds, authorization, clientIp} -> handleDeleteMessages messageIds authorization clientIp
2333 LookupPresence = \{pubkey, authorization, clientIp} -> handleLookupPresence pubkey authorization clientIp
2334 BatchLookupPresence = \{pubkeys, authorization, clientIp} -> handleBatchLookupPresence pubkeys authorization clientIp
2335 RecvGossip = \{events, fromServer, requestTimestamp, authorization} -> handleRecvGossip events fromServer requestTimestamp authorization
2336 ForwardMessage = \{toKey, encryptedBlob, messageId, fromServer, requestTimestamp, authorization} -> handleForwardMessage toKey encryptedBlob messageId fromServer requestTimestamp authorization
2337 FederationBatchForward = \{forwards, fromServer, requestTimestamp, authorization} -> handleFederationBatchForward forwards fromServer requestTimestamp authorization
2338 FederationPubkey = \{} -> handleFederationPubkey
2339 Prune = \{authorization} -> handlePrune authorization
2340 BlockPeer = \{server, authorization} -> handleBlockPeer server authorization
2341 UnblockPeer = \{server, authorization} -> handleUnblockPeer server authorization
2342 ListBlocked = \{authorization} -> handleListBlocked authorization
2343 PingPeer = \{server, authorization} -> handlePingPeer server authorization
2344 AdminListSessions = \{pubkey, authorization} -> handleAdminListSessions pubkey authorization
2345 AdminRevokeSessions = \{pubkey, authorization} -> handleAdminRevokeSessions pubkey authorization
2346 AdminListAllSessions = \{limit, authorization} -> handleAdminListAllSessions limit authorization
2347 AdminPurgeMessages = \{pubkey, authorization} -> handleAdminPurgeMessages pubkey authorization
2348 AdminRevokeIp = \{ip, authorization} -> handleAdminRevokeIp ip authorization
2349 GetRateLimits = \{authorization} -> handleGetRateLimits authorization
2350 SetRateLimits = \{globalRequest, ipRate, sendRate, federationRate, authGlobal, recvRate, challengeRate, pairRate, lookupRate, clientWriteRate, authorization} -> handleSetRateLimits globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization
2351 FlushNonces = \{authorization} -> handleFlushNonces authorization
2352 AllowPeer = \{server, authorization} -> handleAllowPeer server authorization
2353 UnallowPeer = \{server, authorization} -> handleUnallowPeer server authorization
2354 ListAllowed = \{authorization} -> handleListAllowed authorization
2355 Reconcile = \{authorization} -> handleReconcile authorization
2356 RotateSecret = \{newSecret, authorization} -> handleRotateSecret newSecret authorization
2357 GetConfig = \{authorization} -> handleGetConfig authorization
2358 Health = \{authorization} -> handleHealth authorization
2359 Stats = \{authorization} -> handleStats authorization
2360 StatsPeers = \{authorization} -> handleStatsPeers authorization
2361 StatsKey = \{pubkey, authorization} -> handleStatsKey pubkey authorization
2362 TopRecipients = \{limit, authorization} -> handleTopRecipients limit authorization
2363 StatsForwards = \{authorization} -> handleStatsForwards authorization
2364 StatsRates = \{authorization} -> handleStatsRates authorization
2365 Metrics = \{authorization} -> handleMetrics authorization
2366 Ready = \{} -> handleReady
2368-- ============================================
2370-- ============================================
2371-- `backgroundPrune` runs `pruneAndRetry` every `backgroundPruneInterval` ms.
2372-- `pollHeartbeat` bumps `pollWakeup` every `pollTimeoutMs` so long-poll
2373-- holders unblock and return an empty heartbeat response, keeping connections
2376-- Endless tick: every `backgroundPruneInterval` run `pruneAndRetry` and bump
2377-- `pruneCount` for /stats and /health.
2378backgroundPrune : IO {rw *activePolls, r *blockedPeers, rw *challenges, rw *deliveredIds, rw *forwardFailures, r *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *pruneCount, rw *sessions, clock} a
2380 sleep backgroundPruneInterval
2382 atomic (do pc <- *pruneCount; *pruneCount = pc + 1)
2386-- Endless tick that bumps `pollWakeup` every `pollTimeoutMs` so any blocked
2387-- /poll holders unblock and return an empty heartbeat response.
2388pollHeartbeat : IO {rw *heartbeatCount, rw *lastHeartbeatAt, rw *pollWakeup, clock} a
2392 atomic (do *pollWakeup = t; *lastHeartbeatAt = t; hc <- *heartbeatCount; *heartbeatCount = hc + 1)
2395-- ============================================
2397-- ============================================
2398-- Stamp `startedAt` and a fresh `serverGeneration` (used by clients to detect
2399-- server restarts and reset their poll cursor), spawn the two background
2400-- loops, and start the listener.
2402-- Entry point: stamp startup metadata, lazily generate the federation keypair
2403-- on first run, fork the background loops, and start the HTTP listener.
2407 genJitter <- randomInt 1000000
2408 atomic (do *startedAt = t; *serverGeneration = t * 1000 + genJitter)
2409 priv <- *federationPrivateKeyHex
2410 when (priv == "") (do
2411 kp <- generateKeyPair
2413 *federationPrivateKeyHex = bytesToHex kp.privateKey
2414 *federationPublicKeyHex = bytesToHex kp.publicKey)
2415 logInfo "Generated federation keypair on first startup")
2416 logInfo ("Skrepka relay server starting on " ++ bindHost ++ ":" ++ show listenPort ++ " ...")
2417 logInfo (" federation: " ++ (if federationEnabled then "enabled" else "disabled"))
2418 fork backgroundPrune
2420 listenOn bindHost listenPort api
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list