@@ -11,162 +11,225 @@
1111-- per-key/window rate limits, expiry/backoff/TTL durations, and protocol version.
1212-- All values are plain literals; nothing is read from disk or env at runtime.
1313
14+-- Hostname this server binds to. Use 0.0.0.0 to accept connections on every interface.
1415serverHost : Text
1516serverHost = "localhost"
17+-- TCP port for incoming HTTP connections.
1618listenPort : Int
1719listenPort = 8080
20+-- URL scheme used when contacting peer federation servers.
1821federationScheme : Text
1922federationScheme = "https://"
20−serverFederationPrivateKeyHex : Text
21−serverFederationPrivateKeyHex = ""
22−serverFederationPublicKeyHex : Text
23−serverFederationPublicKeyHex = ""
23+-- The Ed25519 federation keypair lives in `*federationPrivateKeyHex` /
24+-- `*federationPublicKeyHex` refs and is generated on first startup; see `main`.
2425
26+-- Drop stored messages older than this (30 days).
2527messageMaxAge : Int<Ms>
2628messageMaxAge = 2592000000
29+-- Upper bound on TTL a client may request for a presence entry (1 hour).
2730maxPresenceTtl : Int<Ms>
2831maxPresenceTtl = 3600000
32+-- Max length (chars) of a hex-encoded pubkey accepted on the wire.
2933maxPubkeyLen : Int
3034maxPubkeyLen = 256
35+-- Max length of a hex-encoded message body / opaque blob (64 KiB hex ≈ 32 KiB bytes).
3136maxBlobLen : Int
3237maxBlobLen = 65536
38+-- Max length of a hex-encoded signature.
3339maxSignatureLen : Int
3440maxSignatureLen = 256
41+-- Cap on the number of message IDs accepted in a single ack/lookup request.
3542maxMessageIds : Int
3643maxMessageIds = 100
44+-- Cap on items in a batched send or batched cancel request.
3745maxBatchSize : Int
3846maxBatchSize = 100
47+-- Highest priority value a message is allowed to declare.
3948maxMessagePriority : Int
4049maxMessagePriority = 10
50+-- Cap on gossip events accepted or emitted in a single federation exchange.
4151maxGossipEvents : Int
4252maxGossipEvents = 100
53+-- Cap on events returned by one long-poll response.
4354maxPollEvents : Int
4455maxPollEvents = 50
56+-- Hard ceiling on presence entries kept in memory.
4557maxPresenceEntries : Int
4658maxPresenceEntries = 10000
59+-- Per-recipient ceiling on stored undelivered messages before older ones are pruned.
4760maxMessagesPerRecipient : Int
4861maxMessagesPerRecipient = 500
62+-- Total ceiling on stored messages across all recipients.
4963maxMessages : Int
5064maxMessages = 100000
65+-- Allowance for clock drift when validating client timestamps (5 s).
5166clockSkewTolerance : Int<Ms>
5267clockSkewTolerance = 5000
68+-- Ceiling on outstanding federation forward attempts retained for retry.
5369maxForwardsEntries : Int
5470maxForwardsEntries = 10000
71+-- Per-peer ceiling on outstanding forward attempts.
5572maxForwardsPerServer : Int
5673maxForwardsPerServer = 2000
74+-- Max accepted length of a server hostname.
5775maxServerNameLen : Int
5876maxServerNameLen = 128
77+-- Max accepted length of a hex-encoded message ID.
5978maxMessageIdLen : Int
6079maxMessageIdLen = 128
80+-- Max accepted length of an auth/session token.
6181maxTokenLen : Int
6282maxTokenLen = 256
83+-- Ceiling on outstanding auth challenges held in memory.
6384maxChallenges : Int
6485maxChallenges = 10000
86+-- Ceiling on concurrent active sessions.
6587maxSessions : Int
6688maxSessions = 10000
89+-- Ceiling on remembered acked message IDs (used for replay protection).
6790maxAckedIds : Int
6891maxAckedIds = 10000
92+-- Ceiling on remembered delivered message IDs.
6993maxDeliveredIds : Int
7094maxDeliveredIds = 10000
95+-- Per-pubkey ceiling on outstanding challenges (prevents one key from exhausting the pool).
7196maxChallengesPerKey : Int
7297maxChallengesPerKey = 5
98+-- Per-pubkey ceiling on concurrent sessions.
7399maxSessionsPerKey : Int
74100maxSessionsPerKey = 10
101+-- Validity window for an auth challenge before it must be re-issued (1 min).
75102challengeExpiry : Int<Ms>
76103challengeExpiry = 60000
104+-- Challenge requests permitted per key inside its rate window.
77105maxChallengeRatePerKey : Int
78106maxChallengeRatePerKey = 5
107+-- Window over which the per-key challenge rate is measured (1 s).
79108challengeRateWindowMs : Int<Ms>
80109challengeRateWindowMs = 1000
110+-- Send-message requests permitted per key per window.
81111maxSendRatePerKey : Int
82112maxSendRatePerKey = 20
113+-- Window for the per-key send rate limit (1 s).
83114sendRateWindowMs : Int<Ms>
84115sendRateWindowMs = 1000
116+-- Receive/poll requests permitted per key per window.
85117maxRecvRatePerKey : Int
86118maxRecvRatePerKey = 10
119+-- Window for the per-key receive rate limit (1 s).
87120recvRateWindowMs : Int<Ms>
88121recvRateWindowMs = 1000
122+-- Messages permitted per (sender, recipient) pair within the pair window.
89123maxPairRatePerPair : Int
90124maxPairRatePerPair = 30
125+-- Window for the per-pair rate limit (1 min).
91126pairRateWindowMs : Int<Ms>
92127pairRateWindowMs = 60000
128+-- Federation requests permitted from a single peer server per window.
93129maxFederationRatePerServer : Int
94130maxFederationRatePerServer = 50
131+-- Window for the per-peer federation rate limit (1 s).
95132federationRateWindowMs : Int<Ms>
96133federationRateWindowMs = 1000
134+-- Presence/key lookups permitted per key per window.
97135maxLookupRatePerKey : Int
98136maxLookupRatePerKey = 5
137+-- Window for the per-key lookup rate limit (1 s).
99138lookupRateWindowMs : Int<Ms>
100139lookupRateWindowMs = 1000
140+-- Other client write requests permitted per key per window.
101141maxClientWriteRatePerKey : Int
102142maxClientWriteRatePerKey = 10
143+-- Window for the per-key client-write rate limit (1 s).
103144clientWriteRateWindowMs : Int<Ms>
104145clientWriteRateWindowMs = 1000
146+-- Requests permitted per source IP per window (covers unauthenticated traffic).
105147maxIpRatePerIp : Int
106148maxIpRatePerIp = 10
149+-- Window for the per-IP rate limit (1 s).
107150ipRateWindowMs : Int<Ms>
108151ipRateWindowMs = 1000
152+-- Global ceiling on total request rate across all clients.
109153maxGlobalRequestRate : Int
110154maxGlobalRequestRate = 1000
155+-- Window for the global request rate limit (1 s).
111156globalRateWindowMs : Int<Ms>
112157globalRateWindowMs = 1000
158+-- Global ceiling on auth-endpoint requests (challenge + verify combined).
113159maxAuthGlobalRate : Int
114160maxAuthGlobalRate = 200
161+-- Window for the global auth rate limit (1 s).
115162authGlobalRateWindowMs : Int<Ms>
116163authGlobalRateWindowMs = 1000
117164
165+-- How long a session token remains valid after issue (1 hour).
118166sessionExpiry : Int<Ms>
119167sessionExpiry = 3600000
168+-- How long an "online" presence gossip is considered fresh (90 min).
120169onlineGossipTtl : Int<Ms>
121170onlineGossipTtl = 5400000
171+-- Floor on TTL accepted for "offline" presence gossip (1 min).
122172offlineGossipMinTtl : Int<Ms>
123173offlineGossipMinTtl = 60000
174+-- Times to retry a federation forward before giving up.
124175maxForwardRetries : Int
125176maxForwardRetries = 10
177+-- Hop-count ceiling for gossip propagation between peers.
126178maxGossipHops : Int
127179maxGossipHops = 5
180+-- Initial hop budget assigned to gossip events that originate on this server.
128181gossipOriginHops : Int
129182gossipOriginHops = 2
130183
184+-- Base delay for federation retry backoff (linear, not exponential — 30 s).
131185retryBackoffBase : Int<Ms>
132186retryBackoffBase = 30000
187+-- Cap on federation retry backoff (8 min).
133188retryBackoffMax : Int<Ms>
134189retryBackoffMax = 480000
135190
136−verificationTokenExpiry : Int<Ms>
137−verificationTokenExpiry = 30000
138−maxPendingVerifications : Int
139−maxPendingVerifications = 10000
140−
191+-- Cadence of the background prune/cleanup task (30 s).
141192backgroundPruneInterval : Int<Ms>
142193backgroundPruneInterval = 30000
194+-- Long-poll hold timeout before returning empty to the client (25 s).
143195pollTimeoutMs : Int<Ms>
144196pollTimeoutMs = 25000
197+-- Concurrent active long-polls permitted per pubkey.
145198maxPollsPerKey : Int
146199maxPollsPerKey = 3
200+-- Global ceiling on active long-polls.
147201maxActivePolls : Int
148202maxActivePolls = 5000
203+-- Max number of pubkeys a single poll may subscribe to.
149204maxWatchKeys : Int
150205maxWatchKeys = 50
206+-- Cadence at which this server refreshes its own presence to peers (5 min).
151207presenceRefreshInterval : Int<Ms>
152208presenceRefreshInterval = 300000
153209
210+-- Drop unacked messages older than this (7 days).
154211unackedMessageMaxAge : Int<Ms>
155212unackedMessageMaxAge = 604800000
213+-- Floor on the TTL a client may request when sending a message (1 min).
156214minMessageTtl : Int<Ms>
157215minMessageTtl = 60000
216+-- Window during which a delivered-but-unacked message is retained for re-delivery (2 min).
158217ackGracePeriod : Int<Ms>
159218ackGracePeriod = 120000
160219
220+-- Wire protocol version used for federation calls; bumped on incompatible changes.
161221federationProtocolVersion : Int
162222federationProtocolVersion = 15
223+-- Human-readable build identifier returned by the /health endpoint.
163224serverBuildVersion : Text
164225serverBuildVersion = "2026-04-27-simple"
165226
227+-- Master switch for federation; when False the server runs in single-node mode.
166228federationEnabled : Bool
167229federationEnabled = True {}
168230federationUrl : Text -> Text
169231federationUrl = \server -> federationScheme ++ server
232+-- When True, reject requests that arrive without a client-IP header (for IP-based rate limits).
170233requireClientIp : Bool
171234requireClientIp = True {}
172235
@@ -376,8 +439,6 @@ type BatchCancelResult = {messageId: MessageIdHex, cancelled: Bool}
376439*drainPhase : Int
377440*drainCompletedAt : Timestamp
378441
379−*pendingVerifications : [{token: Text, createdAt: Timestamp, scope: Text}]
380−
381442*senderExpirations : [SenderExpiration]
382443*senderDeliveries : [SenderDelivery]
383444*cancelNotifications : [CancelNotification]
@@ -385,6 +446,9 @@ type BatchCancelResult = {messageId: MessageIdHex, cancelled: Bool}
385446
386447*runtimeMaintenanceSecret : Text
387448
449+*federationPrivateKeyHex : Text
450+*federationPublicKeyHex : Text
451+
388452*blockedPeers : [Text]
389453*allowedPeers : [Text]
390454
@@ -398,7 +462,6 @@ type BatchCancelResult = {messageId: MessageIdHex, cancelled: Bool}
398462-- AuthApi -- challenge/verify/revoke/logout (client identity)
399463-- ClientApi -- /poll, send/batch/list/ack/delete/cancel, presence lookup
400464-- FederationApi -- inter-server gossip, forward, ack, cancel, delivery receipts
401−-- FederationVerify -- callback used by peers to verify Bearer tokens this server issued
402465-- FederationPubkey -- exposes this server's federation Ed25519 public key
403466-- MaintenanceApi -- operator endpoints (drain, prune, peer allow/block, admin)
404467-- HealthApi/StatsApi/MetricsApi/ReadyApi -- observability
@@ -433,9 +496,6 @@ route FederationApi where
433496 POST {forwards: [{toKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, originServer: ServerName, messageId: MessageIdHex, expiresAt: Timestamp, priority: Int}], fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text, protocolVersion: Int} /federation/forward-batch headers {authorization: Text} -> {ok: Bool, error: Text, results: [{messageId: MessageIdHex, ok: Bool}], retryAfterMs: Int} = FederationBatchForward
434497 POST {messageIds: [MessageIdHex], toKeys: [PubkeyHex], fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text, protocolVersion: Int} /federation/delivery-receipt headers {authorization: Text} -> {ok: Bool, error: Text, receivedCount: Int, retryAfterMs: Int} = FederationDeliveryReceipt
435498
436−route FederationVerifyApi where
437− POST {token: Text, scope: Text} /federation/verify headers {clientIp: Text} -> {ok: Bool} = VerifyToken
438−
439499route FederationPubkeyApi where
440500 GET /federation/pubkey -> {pubkey: Text, ok: Bool} = FederationPubkey
441501
@@ -496,7 +556,7 @@ route MetricsApi where
496556route ReadyApi where
497557 GET /ready -> {ready: Bool} = Ready
498558
499−route Api = AuthApi | ClientApi | FederationApi | FederationVerifyApi | FederationPubkeyApi | MaintenanceApi | HealthApi | StatsApi | MetricsApi | ReadyApi
559+route Api = AuthApi | ClientApi | FederationApi | FederationPubkeyApi | MaintenanceApi | HealthApi | StatsApi | MetricsApi | ReadyApi
500560
501561-- ============================================
502562-- Generic helpers
@@ -691,8 +751,8 @@ isBadServerName = \sn -> sn == "" || sn == "localhost" || not all (chars sn) (\c
691751-- Bearer token extraction, session lookup, maintenance secret check, and the
692752-- `gateAuth`/`gateClientWrite`/`gateLookup` combinators that every client
693753-- handler funnels through (drain → global rate → per-key rate → session).
694−-- Federation requests use a separate path (`withFederationAuth`) supporting
695−-- both Ed25519-signed and callback-Bearer auth.
754+-- Federation requests use a separate path (`withFederationAuth`) using
755+-- Ed25519-signed auth verified via the peer's published public key.
696756
697757-- Plain ip match (sessions with empty ip skip the check).
698758matchIp : Text -> Text -> Bool
@@ -756,24 +816,17 @@ withSessionAuth = \authorization t clientIp onUnauth onAuth -> do
756816 Just {value: s} -> onAuth s.pubkey
757817 _ -> onUnauth
758818
759−generateFederationAuth : Text -> a -> IO {reads *pendingVerifications, writes *pendingVerifications, clock, random} Text
819+generateFederationAuth : Text -> a -> IO {reads *federationPrivateKeyHex, random} Text
760820generateFederationAuth = \scope requestTimestamp -> do
761− let privKey = if serverFederationPrivateKeyHex == ""
762− then Nothing {}
763− else bytesFromHex serverFederationPrivateKeyHex
821+ hex <- *federationPrivateKeyHex
822+ let privKey = if hex == "" then Nothing {} else bytesFromHex hex
764823 case privKey of
765824 Just {value: pk} -> do
766825 nonce <- genTokenN 48
767826 yield ("Signed " ++ bytesToHex (sign pk (textToBytes (scope ++ "|" ++ show requestTimestamp ++ "|" ++ serverHostN ++ "|" ++ nonce))) ++ ":" ++ nonce)
768− _ -> do
769− token <- genToken
770− t <- now
771− atomic (do
772− cur <- *pendingVerifications
773− *pendingVerifications = capList (union cur [{token, createdAt: t, scope}]) maxPendingVerifications (\p -> p.createdAt))
774− yield ("Bearer " ++ token)
827+ _ -> yield ""
775828
776−-- Verify a federation request: signed (Ed25519 over scope|ts|fromServer|nonce) or callback Bearer token.
829+-- Verify a federation request: Ed25519 signature over scope|ts|fromServer|nonce, key fetched from peer.
777830verifyFederationAuth : Text -> Text -> Text -> a -> IO {network} {} Bool
778831verifyFederationAuth = \authorization fromServer scope requestTimestamp -> do
779832 if hasPrefix "Signed " authorization then do
@@ -795,11 +848,7 @@ verifyFederationAuth = \authorization fromServer scope requestTimestamp -> do
795848 _ -> yield False {}
796849 _ -> yield False {}
797850 _ -> yield False {}
798− else case extractToken authorization of
799− Just {value: token} -> do
800− result <- fetch (federationUrl fromServer) (VerifyToken {token: token, scope: scope, clientIp: ""})
801− case result of Ok {value: r} -> yield r.ok; _ -> yield False {}
802− _ -> yield False {}
851+ else yield False {}
803852
804853withFederationAuth = \authorization t respond fromServer scope requestTimestamp precondition action -> do
805854 blocked <- *blockedPeers
@@ -985,7 +1034,7 @@ mergePresence = \existing incoming -> fold (\acc e -> (\same -> if any acc (\x -
9851034-- block. Returns the locally-expired presence rows whose pubkey has no other
9861035-- live local session, so the caller can broadcast offline gossip for them.
9871036
988−pruneExpired : Int<Ms> -> IO {reads *ackedIds, reads *activePolls, reads *cancelNotifications, reads *challenges, reads *deliveredIds, reads *forwardFailures, reads *forwards, reads *messages, reads *pendingFederationCancels, reads *pendingVerifications, reads *presence, reads *senderDeliveries, reads *senderExpirations, reads *sessions, writes *ackedIds, writes *activePolls, writes *cancelNotifications, writes *challenges, writes *deliveredIds, writes *forwardFailures, writes *forwards, writes *messages, writes *pendingFederationCancels, writes *pendingVerifications, writes *presence, writes *senderDeliveries, writes *senderExpirations, writes *sessions} [{expiresAt: Timestamp, pubkey: PubkeyHex, server: AnyServerName, timestamp: Timestamp}]
1037+pruneExpired : Int<Ms> -> IO {reads *ackedIds, reads *activePolls, reads *cancelNotifications, reads *challenges, reads *deliveredIds, reads *forwardFailures, reads *forwards, reads *messages, reads *pendingFederationCancels, reads *presence, reads *senderDeliveries, reads *senderExpirations, reads *sessions, writes *ackedIds, writes *activePolls, writes *cancelNotifications, writes *challenges, writes *deliveredIds, writes *forwardFailures, writes *forwards, writes *messages, writes *pendingFederationCancels, writes *presence, writes *senderDeliveries, writes *senderExpirations, writes *sessions} [{expiresAt: Timestamp, pubkey: PubkeyHex, server: AnyServerName, timestamp: Timestamp}]
9891038pruneExpired = \t -> atomic do
9901039 ch <- *challenges
9911040 *challenges = filter ch (\x -> x.expiresAt > t)
@@ -1003,8 +1052,6 @@ pruneExpired = \t -> atomic do
10031052 *forwardFailures = filter ff (\f -> t - f.failedAt < 86400000)
10041053 aps <- *activePolls
10051054 *activePolls = filter aps (\p -> t - p.startedAt < pollTimeoutMs * 3)
1006− pv <- *pendingVerifications
1007− *pendingVerifications = filter pv (\p -> t - p.createdAt < verificationTokenExpiry)
10081055 se <- *senderExpirations
10091056 *senderExpirations = filter se (\x -> t - x.expiredAt < unackedMessageMaxAge)
10101057 sd <- *senderDeliveries
@@ -1217,7 +1264,7 @@ forwardQueuedToServer = \pubkey server t -> atomic (do
12171264-- expire stale rows, then opportunistically retry pending forwards and refresh
12181265-- local presence so peers don't see us go offline mid-session.
12191266
1220−pruneAndRetry : Int<Ms> -> IO {reads *ackedIds, reads *activePolls, reads *cancelNotifications, reads *challenges, reads *deliveredIds, reads *forwardFailures, reads *forwards, reads *lastPrunedAt, reads *messages, reads *pendingFederationCancels, reads *pendingVerifications, reads *presence, reads *senderDeliveries, reads *senderExpirations, reads *sessions, writes *ackedIds, writes *activePolls, writes *cancelNotifications, writes *challenges, writes *deliveredIds, writes *forwardFailures, writes *forwards, writes *lastPrunedAt, writes *messages, writes *pendingFederationCancels, writes *pendingVerifications, writes *presence, writes *senderDeliveries, writes *senderExpirations, writes *sessions, reads *blockedPeers, reads *lastPresenceRefresh, writes *lastPresenceRefresh, clock} {}
1267+pruneAndRetry : Int<Ms> -> IO {reads *ackedIds, reads *activePolls, reads *cancelNotifications, reads *challenges, reads *deliveredIds, reads *federationPrivateKeyHex, reads *forwardFailures, reads *forwards, reads *lastPrunedAt, reads *messages, reads *pendingFederationCancels, reads *presence, reads *senderDeliveries, reads *senderExpirations, reads *sessions, writes *ackedIds, writes *activePolls, writes *cancelNotifications, writes *challenges, writes *deliveredIds, writes *forwardFailures, writes *forwards, writes *lastPrunedAt, writes *messages, writes *pendingFederationCancels, writes *presence, writes *senderDeliveries, writes *senderExpirations, writes *sessions, reads *blockedPeers, reads *lastPresenceRefresh, writes *lastPresenceRefresh, clock} {}
12211268pruneAndRetry = \t -> do
12221269 *lastPrunedAt = t
12231270 expiredLocal <- pruneExpired t
@@ -1920,35 +1967,17 @@ handleSendBatch = \messages authorization clientIp respond -> do
19201967-- Inbound endpoints called peer-to-peer. Every handler funnels through
19211968-- `withFederationAuth` which checks: peer block/allow lists, request
19221969-- precondition (e.g. expected origin/server constraints), clock skew vs the
1923−-- request timestamp, signature/Bearer auth, and per-peer rate limit.
1970+-- request timestamp, Ed25519 signature auth, and per-peer rate limit.
19241971-- Receive paths never trust `originServer` for routing; they only use it for
19251972-- ack bookkeeping and SSRF-style filtering.
19261973
1927−-- POST /federation/verify: callback endpoint a peer invokes to validate a
1928−-- Bearer token we issued in `generateFederationAuth`. Single-use: a
1929−-- successful match removes the token from `pendingVerifications`.
1930−handleVerifyToken : Text -> Text -> Text -> ({ok: Bool} -> a) -> IO {reads *globalRateCount, reads *globalRateWindowStart, reads *ipRates, reads *pendingVerifications, writes *globalRateCount, writes *globalRateWindowStart, writes *ipRates, clock, writes *pendingVerifications} a
1931−handleVerifyToken = \token scope clientIp respond -> do
1932− t <- now
1933− g <- checkGlobalRate t
1934− ipLim <- checkIpRateGate clientIp t
1935− if scope == "" || g || ipLim
1936− then yield (respond {ok: False {}})
1937− else do
1938− found <- atomic (do
1939− pending <- *pendingVerifications
1940− let same = \p -> p.scope == scope && p.token == token
1941− let match = any pending (\p -> same p && t - p.createdAt < verificationTokenExpiry)
1942− when match (*pendingVerifications = removeWhere pending same)
1943− yield match)
1944− yield (respond {ok: found})
1945−
19461974-- GET /federation/pubkey: publish the Ed25519 public key peers should use to
19471975-- verify our `Signed ...` federation auth headers. Returns ok=False when the
1948−-- server has no configured federation key (peers fall back to Bearer mode).
1949−handleFederationPubkey : ({pubkey: Text, ok: Bool} -> ret) -> IO {} ret
1976+-- keypair has not yet been generated (should not happen post-startup).
1977+handleFederationPubkey : ({pubkey: Text, ok: Bool} -> ret) -> IO {reads *federationPublicKeyHex} ret
19501978handleFederationPubkey = \respond -> do
1951− yield (respond {pubkey: serverFederationPublicKeyHex, ok: serverFederationPublicKeyHex != ""})
1979+ hex <- *federationPublicKeyHex
1980+ yield (respond {pubkey: hex, ok: hex != ""})
19521981
19531982-- POST /federation/gossip: ingest peer presence events. Filters out events
19541983-- whose origin is local (loops) or whose timestamp is in the future beyond
@@ -2205,7 +2234,7 @@ handleShutdown = \authorization respond -> handleDrain 2 authorization (\r -> re
22052234-- POST /maintenance/prune: trigger an out-of-band `pruneAndRetry` tick.
22062235-- Useful when the operator wants to force expiry/forward retries without
22072236-- waiting for the next `backgroundPrune` interval.
2208−handlePrune : Text -> ({ok: Bool} -> a) -> IO {reads *runtimeMaintenanceSecret, clock, reads *ackedIds, reads *activePolls, reads *blockedPeers, reads *cancelNotifications, reads *challenges, reads *deliveredIds, reads *forwardFailures, reads *forwards, reads *lastPresenceRefresh, reads *lastPrunedAt, reads *messages, reads *pendingFederationCancels, reads *pendingVerifications, reads *presence, reads *senderDeliveries, reads *senderExpirations, reads *sessions, writes *ackedIds, writes *activePolls, writes *cancelNotifications, writes *challenges, writes *deliveredIds, writes *forwardFailures, writes *forwards, writes *lastPresenceRefresh, writes *lastPrunedAt, writes *messages, writes *pendingFederationCancels, writes *pendingVerifications, writes *presence, writes *senderDeliveries, writes *senderExpirations, writes *sessions} a
2237+handlePrune : Text -> ({ok: Bool} -> a) -> IO {reads *runtimeMaintenanceSecret, clock, reads *ackedIds, reads *activePolls, reads *blockedPeers, reads *cancelNotifications, reads *challenges, reads *deliveredIds, reads *federationPrivateKeyHex, reads *forwardFailures, reads *forwards, reads *lastPresenceRefresh, reads *lastPrunedAt, reads *messages, reads *pendingFederationCancels, reads *presence, reads *senderDeliveries, reads *senderExpirations, reads *sessions, writes *ackedIds, writes *activePolls, writes *cancelNotifications, writes *challenges, writes *deliveredIds, writes *forwardFailures, writes *forwards, writes *lastPresenceRefresh, writes *lastPrunedAt, writes *messages, writes *pendingFederationCancels, writes *presence, writes *senderDeliveries, writes *senderExpirations, writes *sessions} a
22092238handlePrune = \authorization respond -> do
22102239 t <- now
22112240 authorized <- verifyMaintenanceAuth authorization
@@ -2325,7 +2354,7 @@ handleListAllowed = \authorization respond -> do
23252354-- POST /maintenance/ping: send a zero-event gossip to a peer and return the
23262355-- round-trip latency. Useful for diagnosing federation reachability without
23272356-- waiting for organic traffic.
2328−handlePingPeer : Text -> Text -> ({error: Text, latencyMs: Int, ok: Bool} -> a) -> IO {reads *pendingVerifications, reads *runtimeMaintenanceSecret, writes *pendingVerifications, network, clock, random} a
2357+handlePingPeer : Text -> Text -> ({error: Text, latencyMs: Int, ok: Bool} -> a) -> IO {reads *federationPrivateKeyHex, reads *runtimeMaintenanceSecret, network, clock, random} a
23292358handlePingPeer = \server authorization respond -> withMaintAuth authorization (yield (respond {
23302359 ok: False {},
23312360 latencyMs: 0,
@@ -2874,7 +2903,7 @@ handleMetrics = \authorization respond -> do
28742903-- to the corresponding `handleXxx` function. Adding a new route means adding
28752904-- a `route ... = NewReq` line, a `handleNewReq` definition, and a clause here.
28762905
2877−serve : <AckMessages {authorization: Text, clientIp: Text, messageIds: [MessageIdHex], respond: {ackedCount: Int, authorized: Bool, error: Text, ok: Bool} -> Response} | AdminListAllSessions {authorization: Text, limit: Int, respond: {ok: Bool, sessions: [{count: Int, ips: [Text], latestExpiry: Timestamp, pubkey: PubkeyHex}], total: Int} -> Response} | AdminListSessions {authorization: Text, pubkey: PubkeyHex, respond: {count: Int, ok: Bool, sessions: [{createdAt: Timestamp, expiresAt: Timestamp, ip: Text, token: Text}]} -> Response} | AdminPurgeMessages {authorization: Text, pubkey: PubkeyHex, respond: {ok: Bool, purgedCount: Int} -> Response} | AdminRevokeIp {authorization: Text, ip: Text, respond: {affectedKeys: Int, ok: Bool, revokedCount: Int} -> Response} | AdminRevokeSessions {authorization: Text, pubkey: PubkeyHex, respond: {ok: Bool, revokedCount: Int} -> Response} | AllowPeer {authorization: Text, respond: {allowed: Int, ok: Bool} -> Response, server: ServerName} | BatchLookupPresence {authorization: Text, clientIp: Text, pubkeys: [PubkeyHex], respond: {authorized: Bool, error: Text, results: [{pubkey: PubkeyHex, server: AnyServerName}]} -> Response} | BlockPeer {authorization: Text, respond: {blocked: Int, ok: Bool} -> Response, server: ServerName} | CancelBatch {authorization: Text, cancels: [BatchCancelEntry], clientIp: Text, respond: {authorized: Bool, error: Text, results: [BatchCancelResult]} -> Response} | CancelMessage {authorization: Text, clientIp: Text, messageId: MessageIdHex, respond: {authorized: Bool, cancelled: Bool, error: Text, ok: Bool} -> Response, to: PubkeyHex} | DeleteMessages {authorization: Text, clientIp: Text, messageIds: [MessageIdHex], respond: {authorized: Bool, deletedCount: Int, error: Text, ok: Bool} -> Response} | Drain {authorization: Text, phase: Int, respond: {drained: Int, ok: Bool, phase: Int} -> Response} | FederationAck {authorization: Text, correlationId: Text, fromServer: ServerName, messageIds: [MessageIdHex], originServer: ServerName, protocolVersion: Int, requestTimestamp: Timestamp, respond: {ackedCount: Int, error: Text, ok: Bool, results: [{found: Bool, messageId: MessageIdHex}], retryAfterMs: Int} -> Response} | FederationBatchCancel {authorization: Text, cancels: [{messageId: MessageIdHex, toKey: PubkeyHex}], correlationId: Text, fromServer: ServerName, protocolVersion: Int, requestTimestamp: Timestamp, respond: {error: Text, ok: Bool, results: [BatchCancelResult], retryAfterMs: Int} -> Response} | FederationBatchForward {authorization: Text, correlationId: Text, forwards: [{encryptedBlob: BlobHex, expiresAt: Timestamp, messageId: MessageIdHex, originServer: ServerName, priority: Int, timestamp: Timestamp, toKey: PubkeyHex}], fromServer: ServerName, protocolVersion: Int, requestTimestamp: Timestamp, respond: {error: Text, ok: Bool, results: [{messageId: MessageIdHex, ok: Bool}], retryAfterMs: Int} -> Response} | FederationCancel {authorization: Text, correlationId: Text, fromServer: ServerName, messageId: MessageIdHex, protocolVersion: Int, requestTimestamp: Timestamp, respond: {cancelled: Bool, error: Text, ok: Bool, retryAfterMs: Int} -> Response, toKey: PubkeyHex} | FederationDeliveryReceipt {authorization: Text, correlationId: Text, fromServer: ServerName, messageIds: [MessageIdHex], protocolVersion: Int, requestTimestamp: Timestamp, respond: {error: Text, ok: Bool, receivedCount: Int, retryAfterMs: Int} -> Response, toKeys: [PubkeyHex]} | FederationPubkey {respond: {ok: Bool, pubkey: Text} -> Response} | FlushNonces {authorization: Text, respond: {flushedCount: Int, ok: Bool} -> Response} | ForwardMessage {authorization: Text, correlationId: Text, encryptedBlob: BlobHex, expiresAt: Timestamp, fromServer: ServerName, messageId: MessageIdHex, originServer: ServerName, priority: Int, protocolVersion: Int, requestTimestamp: Timestamp, respond: {error: Text, ok: Bool, retryAfterMs: Int} -> Response, timestamp: Timestamp, toKey: PubkeyHex} | GetConfig {authorization: Text, respond: {ackGracePeriod: Int, maxGossipHops: Int, maxMessagesPerRecipient: Int, ok: Bool, pollTimeoutMs: Int} -> Response} | GetRateLimits {authorization: Text, respond: {authGlobal: Int, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, sendRate: Int} -> Response} | Health {authorization: Text, respond: {capacityHealthy: Bool, capacityWarning: Bool, degradedPeers: Int, draining: Bool, federationHealthy: Bool, forwardQueueHealthy: Bool, heartbeatHealthy: Bool, nonceHealthy: Bool, ok: Bool, pruneHealthy: Bool, requestPressureHealthy: Bool, version: Text, watchdogHealthy: Bool} -> Response} | ListAllowed {authorization: Text, respond: {ok: Bool, peers: [Text]} -> Response} | ListBlocked {authorization: Text, respond: {ok: Bool, peers: [Text]} -> Response} | ListMessages {authorization: Text, clientIp: Text, offset: Int, respond: {authorized: Bool, count: Int, error: Text, messages: [{messageId: MessageIdHex, receivedAt: Timestamp, timestamp: Timestamp}]} -> Response} | Logout {authorization: Text, clientIp: Text, respond: {authorized: Bool, ok: Bool} -> Response} | LookupPresence {authorization: Text, clientIp: Text, pubkey: PubkeyHex, respond: {authorized: Bool, error: Text, server: AnyServerName} -> Response} | MessageStatus {authorization: Text, clientIp: Text, messageId: MessageIdHex, respond: {authorized: Bool, status: Text} -> Response, to: PubkeyHex} | Metrics {authorization: Text, respond: {metrics: Text, ok: Bool} -> Response} | PingPeer {authorization: Text, respond: {error: Text, latencyMs: Int, ok: Bool} -> Response, server: ServerName} | Poll {authorization: Text, clientIp: Text, cursor: Timestamp, generation: Int, respond: {authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, draining: Bool, droppedDeliveryReceipts: Int, droppedExpirationNotifs: Int, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, messageCancellations: [{cancelledAt: Timestamp, messageId: MessageIdHex}], messageDeliveries: [{deliveredAt: Timestamp, messageId: MessageIdHex, toKey: PubkeyHex}], messageExpirations: [{expiredAt: Timestamp, messageId: MessageIdHex, toKey: PubkeyHex}], presenceUpdates: [{online: Bool, pubkey: PubkeyHex}], rateLimited: Bool, retryAfterMs: Int} -> Response, watchKeys: [PubkeyHex]} | Prune {authorization: Text, respond: {ok: Bool} -> Response} | Ready {respond: {ready: Bool} -> Response} | Reconcile {authorization: Text, respond: {messageDrift: Int, ok: Bool, presenceDrift: Int, sessionDrift: Int} -> Response} | RecvGossip {authorization: Text, correlationId: Text, events: [GossipEvent], fromServer: ServerName, hopsRemaining: Int, protocolVersion: Int, requestTimestamp: Timestamp, respond: {error: Text, ok: Bool, retryAfterMs: Int} -> Response} | ReqChallenge {clientIp: Text, pubkey: PubkeyHex, respond: {challenge: Text, error: Text, expiresAt: Timestamp, ok: Bool, retryAfterMs: Int} -> Response} | RevokeSession {authorization: Text, clientIp: Text, respond: {authorized: Bool, ok: Bool} -> Response, targetToken: Text} | RotateSecret {authorization: Text, newSecret: Text, respond: {error: Text, ok: Bool} -> Response} | SendBatch {authorization: Text, clientIp: Text, messages: [BatchMessage], respond: {authorized: Bool, results: [BatchResult], retryAfterMs: Int} -> Response} | SendMessage {authorization: Text, clientIp: Text, encryptedBlob: BlobHex, expiresInMs: Int, messageId: OptionalMessageId, priority: Int, respond: {error: Text, loadPct: Int, messageId: OptionalMessageId, retryAfterMs: Int, status: MessageStatus} -> Response, timestamp: Timestamp, to: PubkeyHex} | SetRateLimits {authGlobal: Int, authorization: Text, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, pairRate: Int, recvRate: Int, respond: {ok: Bool} -> Response, sendRate: Int} | Shutdown {authorization: Text, respond: {drained: Int, ok: Bool} -> Response} | Stats {authorization: Text, respond: {capacity: {ackOverflow: Int, ackOverflowMax: Int, ackedIds: Int, ackedIdsMax: Int, activePolls: Int, activePollsMax: Int, challenges: Int, challengesMax: Int, deliveredIds: Int, deliveredIdsMax: Int, forwardNonces: Int, forwardNoncesMax: Int, forwards: Int, forwardsMax: Int, forwardsPct: Int, messageBucketMax: Int, messageBucketMin: Int, messages: Int, messagesMax: Int, messagesPct: Int, nonceEvictions: Int, presence: Int, presenceMax: Int, presencePct: Int, recipientCounts: Int, sessions: Int, sessionsMax: Int, sessionsPct: Int, totalMessageCount: Int}, federation: {avgLatencyMs: Int, blockedPeers: Int, callCount: Int, drainCompletedAt: Timestamp, enabled: Bool, forwardFailures: Int, forwardServers: Int, gossipFail: Int, gossipSuccess: Int, hungSlots: Int, inFlight: Int, latencyBuckets: {gte2000: Int, lt100: Int, lt2000: Int, lt500: Int}, maxForwardQueueDepth: Int, maxLatencyMs: Int, oldestAckAge: Int, oldestForwardAge: Int, pendingCancels: Int, recentGossip: Int, slowVerifies: Int, topFailingPeers: [{failures: Int, server: Text}], verifyFailures: Int}, ok: Bool, rates: {challenge: Int, clientCancels: Int, federation: Int, federationCancels: Int, federationPair: Int, global: Int, gossipEvent: Int, ip: Int, lookup: Int, pair: Int, pendingAckCleanups: Int, recv: Int, rejectedAuth: Int, rejectedFederation: Int, rejectedGlobal: Int, rejectedIp: Int, rejectedPerKey: Int, send: Int, senderDeliveries: Int, senderExpirations: Int, uniqueKeyIp: Int, verifyIp: Int}, timing: {activeRequests: Int, authAvgMs: Int, authCount: Int, authMaxMs: Int, drainPhase: Int, draining: Bool, heartbeatCount: Int, lastHeartbeatAt: Timestamp, lastPruneAt: Timestamp, peakActiveRequests: Int, pollAvgMs: Int, pollCount: Int, pollLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, pollMaxMs: Int, pruneCount: Int, pruneRunning: Timestamp, sendAvgMs: Int, sendCount: Int, sendLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, sendMaxMs: Int, totalEntries: Int, uptime: Int}, version: Text} -> Response} | StatsForwards {authorization: Text, respond: {ok: Bool, servers: [{count: Int, oldestAge: Int, server: Text, totalRetries: Int}], total: Int} -> Response} | StatsKey {authorization: Text, pubkey: PubkeyHex, respond: {activePolls: Int, forwardDetails: [{createdAt: Timestamp, retries: Int, server: Text}], forwards: Int, messages: Int, ok: Bool, presence: [KeyPresenceEntry], sessions: Int} -> Response} | StatsPeers {authorization: Text, respond: {ok: Bool, peers: [PeerStatus]} -> Response} | StatsRates {authorization: Text, respond: {authGlobal: Int, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, scalePct: Int, sendRate: Int} -> Response} | TopRecipients {authorization: Text, limit: Int, respond: {ok: Bool, recipients: [RecipientCount], total: Int} -> Response} | UnallowPeer {authorization: Text, respond: {ok: Bool, removed: Bool} -> Response, server: ServerName} | UnblockPeer {authorization: Text, respond: {ok: Bool, unblocked: Bool} -> Response, server: ServerName} | Undrain {authorization: Text, respond: {ok: Bool} -> Response} | VerifyAuth {challenge: Text, clientIp: Text, pubkey: PubkeyHex, respond: {error: Text, expiresAt: Timestamp, token: Text} -> Response, revokeOthers: Bool, signature: SignatureHex} | VerifyToken {clientIp: Text, respond: {ok: Bool} -> Response, scope: Text, token: Text}> -> IO {reads *ackedIds, reads *activePolls, reads *allowedPeers, reads *authGlobalRateCount, reads *authGlobalRateWindowStart, reads *blockedPeers, reads *cancelNotifications, reads *challengeRates, reads *challenges, reads *deliveredIds, reads *drainCompletedAt, reads *drainPhase, reads *federationRates, reads *forwardFailures, reads *forwards, reads *globalRateCount, reads *globalRateWindowStart, reads *heartbeatCount, reads *ipRates, reads *lastHeartbeatAt, reads *lastPresenceRefresh, reads *lastPrunedAt, reads *messages, reads *pendingFederationCancels, reads *pendingVerifications, reads *pollWakeup, reads *presence, reads *pruneCount, reads *recvRates, reads *runtimeMaintenanceSecret, reads *senderDeliveries, reads *senderExpirations, reads *seqCounter, reads *serverGeneration, reads *sessions, reads *startedAt, writes *ackedIds, writes *activePolls, writes *allowedPeers, writes *authGlobalRateCount, writes *authGlobalRateWindowStart, writes *blockedPeers, writes *cancelNotifications, writes *challengeRates, writes *challenges, writes *deliveredIds, writes *drainCompletedAt, writes *drainPhase, writes *federationRates, writes *forwardFailures, writes *forwards, writes *globalRateCount, writes *globalRateWindowStart, writes *ipRates, writes *lastPresenceRefresh, writes *lastPrunedAt, writes *messages, writes *pendingFederationCancels, writes *pendingVerifications, writes *pollWakeup, writes *presence, writes *recvRates, writes *runtimeMaintenanceSecret, writes *senderDeliveries, writes *senderExpirations, writes *seqCounter, writes *sessions, network, clock, random} Response
2906+serve : <AckMessages {authorization: Text, clientIp: Text, messageIds: [MessageIdHex], respond: {ackedCount: Int, authorized: Bool, error: Text, ok: Bool} -> Response} | AdminListAllSessions {authorization: Text, limit: Int, respond: {ok: Bool, sessions: [{count: Int, ips: [Text], latestExpiry: Timestamp, pubkey: PubkeyHex}], total: Int} -> Response} | AdminListSessions {authorization: Text, pubkey: PubkeyHex, respond: {count: Int, ok: Bool, sessions: [{createdAt: Timestamp, expiresAt: Timestamp, ip: Text, token: Text}]} -> Response} | AdminPurgeMessages {authorization: Text, pubkey: PubkeyHex, respond: {ok: Bool, purgedCount: Int} -> Response} | AdminRevokeIp {authorization: Text, ip: Text, respond: {affectedKeys: Int, ok: Bool, revokedCount: Int} -> Response} | AdminRevokeSessions {authorization: Text, pubkey: PubkeyHex, respond: {ok: Bool, revokedCount: Int} -> Response} | AllowPeer {authorization: Text, respond: {allowed: Int, ok: Bool} -> Response, server: ServerName} | BatchLookupPresence {authorization: Text, clientIp: Text, pubkeys: [PubkeyHex], respond: {authorized: Bool, error: Text, results: [{pubkey: PubkeyHex, server: AnyServerName}]} -> Response} | BlockPeer {authorization: Text, respond: {blocked: Int, ok: Bool} -> Response, server: ServerName} | CancelBatch {authorization: Text, cancels: [BatchCancelEntry], clientIp: Text, respond: {authorized: Bool, error: Text, results: [BatchCancelResult]} -> Response} | CancelMessage {authorization: Text, clientIp: Text, messageId: MessageIdHex, respond: {authorized: Bool, cancelled: Bool, error: Text, ok: Bool} -> Response, to: PubkeyHex} | DeleteMessages {authorization: Text, clientIp: Text, messageIds: [MessageIdHex], respond: {authorized: Bool, deletedCount: Int, error: Text, ok: Bool} -> Response} | Drain {authorization: Text, phase: Int, respond: {drained: Int, ok: Bool, phase: Int} -> Response} | FederationAck {authorization: Text, correlationId: Text, fromServer: ServerName, messageIds: [MessageIdHex], originServer: ServerName, protocolVersion: Int, requestTimestamp: Timestamp, respond: {ackedCount: Int, error: Text, ok: Bool, results: [{found: Bool, messageId: MessageIdHex}], retryAfterMs: Int} -> Response} | FederationBatchCancel {authorization: Text, cancels: [{messageId: MessageIdHex, toKey: PubkeyHex}], correlationId: Text, fromServer: ServerName, protocolVersion: Int, requestTimestamp: Timestamp, respond: {error: Text, ok: Bool, results: [BatchCancelResult], retryAfterMs: Int} -> Response} | FederationBatchForward {authorization: Text, correlationId: Text, forwards: [{encryptedBlob: BlobHex, expiresAt: Timestamp, messageId: MessageIdHex, originServer: ServerName, priority: Int, timestamp: Timestamp, toKey: PubkeyHex}], fromServer: ServerName, protocolVersion: Int, requestTimestamp: Timestamp, respond: {error: Text, ok: Bool, results: [{messageId: MessageIdHex, ok: Bool}], retryAfterMs: Int} -> Response} | FederationCancel {authorization: Text, correlationId: Text, fromServer: ServerName, messageId: MessageIdHex, protocolVersion: Int, requestTimestamp: Timestamp, respond: {cancelled: Bool, error: Text, ok: Bool, retryAfterMs: Int} -> Response, toKey: PubkeyHex} | FederationDeliveryReceipt {authorization: Text, correlationId: Text, fromServer: ServerName, messageIds: [MessageIdHex], protocolVersion: Int, requestTimestamp: Timestamp, respond: {error: Text, ok: Bool, receivedCount: Int, retryAfterMs: Int} -> Response, toKeys: [PubkeyHex]} | FederationPubkey {respond: {ok: Bool, pubkey: Text} -> Response} | FlushNonces {authorization: Text, respond: {flushedCount: Int, ok: Bool} -> Response} | ForwardMessage {authorization: Text, correlationId: Text, encryptedBlob: BlobHex, expiresAt: Timestamp, fromServer: ServerName, messageId: MessageIdHex, originServer: ServerName, priority: Int, protocolVersion: Int, requestTimestamp: Timestamp, respond: {error: Text, ok: Bool, retryAfterMs: Int} -> Response, timestamp: Timestamp, toKey: PubkeyHex} | GetConfig {authorization: Text, respond: {ackGracePeriod: Int, maxGossipHops: Int, maxMessagesPerRecipient: Int, ok: Bool, pollTimeoutMs: Int} -> Response} | GetRateLimits {authorization: Text, respond: {authGlobal: Int, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, sendRate: Int} -> Response} | Health {authorization: Text, respond: {capacityHealthy: Bool, capacityWarning: Bool, degradedPeers: Int, draining: Bool, federationHealthy: Bool, forwardQueueHealthy: Bool, heartbeatHealthy: Bool, nonceHealthy: Bool, ok: Bool, pruneHealthy: Bool, requestPressureHealthy: Bool, version: Text, watchdogHealthy: Bool} -> Response} | ListAllowed {authorization: Text, respond: {ok: Bool, peers: [Text]} -> Response} | ListBlocked {authorization: Text, respond: {ok: Bool, peers: [Text]} -> Response} | ListMessages {authorization: Text, clientIp: Text, offset: Int, respond: {authorized: Bool, count: Int, error: Text, messages: [{messageId: MessageIdHex, receivedAt: Timestamp, timestamp: Timestamp}]} -> Response} | Logout {authorization: Text, clientIp: Text, respond: {authorized: Bool, ok: Bool} -> Response} | LookupPresence {authorization: Text, clientIp: Text, pubkey: PubkeyHex, respond: {authorized: Bool, error: Text, server: AnyServerName} -> Response} | MessageStatus {authorization: Text, clientIp: Text, messageId: MessageIdHex, respond: {authorized: Bool, status: Text} -> Response, to: PubkeyHex} | Metrics {authorization: Text, respond: {metrics: Text, ok: Bool} -> Response} | PingPeer {authorization: Text, respond: {error: Text, latencyMs: Int, ok: Bool} -> Response, server: ServerName} | Poll {authorization: Text, clientIp: Text, cursor: Timestamp, generation: Int, respond: {authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, draining: Bool, droppedDeliveryReceipts: Int, droppedExpirationNotifs: Int, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, messageCancellations: [{cancelledAt: Timestamp, messageId: MessageIdHex}], messageDeliveries: [{deliveredAt: Timestamp, messageId: MessageIdHex, toKey: PubkeyHex}], messageExpirations: [{expiredAt: Timestamp, messageId: MessageIdHex, toKey: PubkeyHex}], presenceUpdates: [{online: Bool, pubkey: PubkeyHex}], rateLimited: Bool, retryAfterMs: Int} -> Response, watchKeys: [PubkeyHex]} | Prune {authorization: Text, respond: {ok: Bool} -> Response} | Ready {respond: {ready: Bool} -> Response} | Reconcile {authorization: Text, respond: {messageDrift: Int, ok: Bool, presenceDrift: Int, sessionDrift: Int} -> Response} | RecvGossip {authorization: Text, correlationId: Text, events: [GossipEvent], fromServer: ServerName, hopsRemaining: Int, protocolVersion: Int, requestTimestamp: Timestamp, respond: {error: Text, ok: Bool, retryAfterMs: Int} -> Response} | ReqChallenge {clientIp: Text, pubkey: PubkeyHex, respond: {challenge: Text, error: Text, expiresAt: Timestamp, ok: Bool, retryAfterMs: Int} -> Response} | RevokeSession {authorization: Text, clientIp: Text, respond: {authorized: Bool, ok: Bool} -> Response, targetToken: Text} | RotateSecret {authorization: Text, newSecret: Text, respond: {error: Text, ok: Bool} -> Response} | SendBatch {authorization: Text, clientIp: Text, messages: [BatchMessage], respond: {authorized: Bool, results: [BatchResult], retryAfterMs: Int} -> Response} | SendMessage {authorization: Text, clientIp: Text, encryptedBlob: BlobHex, expiresInMs: Int, messageId: OptionalMessageId, priority: Int, respond: {error: Text, loadPct: Int, messageId: OptionalMessageId, retryAfterMs: Int, status: MessageStatus} -> Response, timestamp: Timestamp, to: PubkeyHex} | SetRateLimits {authGlobal: Int, authorization: Text, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, pairRate: Int, recvRate: Int, respond: {ok: Bool} -> Response, sendRate: Int} | Shutdown {authorization: Text, respond: {drained: Int, ok: Bool} -> Response} | Stats {authorization: Text, respond: {capacity: {ackOverflow: Int, ackOverflowMax: Int, ackedIds: Int, ackedIdsMax: Int, activePolls: Int, activePollsMax: Int, challenges: Int, challengesMax: Int, deliveredIds: Int, deliveredIdsMax: Int, forwardNonces: Int, forwardNoncesMax: Int, forwards: Int, forwardsMax: Int, forwardsPct: Int, messageBucketMax: Int, messageBucketMin: Int, messages: Int, messagesMax: Int, messagesPct: Int, nonceEvictions: Int, presence: Int, presenceMax: Int, presencePct: Int, recipientCounts: Int, sessions: Int, sessionsMax: Int, sessionsPct: Int, totalMessageCount: Int}, federation: {avgLatencyMs: Int, blockedPeers: Int, callCount: Int, drainCompletedAt: Timestamp, enabled: Bool, forwardFailures: Int, forwardServers: Int, gossipFail: Int, gossipSuccess: Int, hungSlots: Int, inFlight: Int, latencyBuckets: {gte2000: Int, lt100: Int, lt2000: Int, lt500: Int}, maxForwardQueueDepth: Int, maxLatencyMs: Int, oldestAckAge: Int, oldestForwardAge: Int, pendingCancels: Int, recentGossip: Int, slowVerifies: Int, topFailingPeers: [{failures: Int, server: Text}], verifyFailures: Int}, ok: Bool, rates: {challenge: Int, clientCancels: Int, federation: Int, federationCancels: Int, federationPair: Int, global: Int, gossipEvent: Int, ip: Int, lookup: Int, pair: Int, pendingAckCleanups: Int, recv: Int, rejectedAuth: Int, rejectedFederation: Int, rejectedGlobal: Int, rejectedIp: Int, rejectedPerKey: Int, send: Int, senderDeliveries: Int, senderExpirations: Int, uniqueKeyIp: Int, verifyIp: Int}, timing: {activeRequests: Int, authAvgMs: Int, authCount: Int, authMaxMs: Int, drainPhase: Int, draining: Bool, heartbeatCount: Int, lastHeartbeatAt: Timestamp, lastPruneAt: Timestamp, peakActiveRequests: Int, pollAvgMs: Int, pollCount: Int, pollLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, pollMaxMs: Int, pruneCount: Int, pruneRunning: Timestamp, sendAvgMs: Int, sendCount: Int, sendLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, sendMaxMs: Int, totalEntries: Int, uptime: Int}, version: Text} -> Response} | StatsForwards {authorization: Text, respond: {ok: Bool, servers: [{count: Int, oldestAge: Int, server: Text, totalRetries: Int}], total: Int} -> Response} | StatsKey {authorization: Text, pubkey: PubkeyHex, respond: {activePolls: Int, forwardDetails: [{createdAt: Timestamp, retries: Int, server: Text}], forwards: Int, messages: Int, ok: Bool, presence: [KeyPresenceEntry], sessions: Int} -> Response} | StatsPeers {authorization: Text, respond: {ok: Bool, peers: [PeerStatus]} -> Response} | StatsRates {authorization: Text, respond: {authGlobal: Int, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, scalePct: Int, sendRate: Int} -> Response} | TopRecipients {authorization: Text, limit: Int, respond: {ok: Bool, recipients: [RecipientCount], total: Int} -> Response} | UnallowPeer {authorization: Text, respond: {ok: Bool, removed: Bool} -> Response, server: ServerName} | UnblockPeer {authorization: Text, respond: {ok: Bool, unblocked: Bool} -> Response, server: ServerName} | Undrain {authorization: Text, respond: {ok: Bool} -> Response} | VerifyAuth {challenge: Text, clientIp: Text, pubkey: PubkeyHex, respond: {error: Text, expiresAt: Timestamp, token: Text} -> Response, revokeOthers: Bool, signature: SignatureHex}> -> IO {reads *ackedIds, reads *activePolls, reads *allowedPeers, reads *authGlobalRateCount, reads *authGlobalRateWindowStart, reads *blockedPeers, reads *cancelNotifications, reads *challengeRates, reads *challenges, reads *deliveredIds, reads *drainCompletedAt, reads *drainPhase, reads *federationPrivateKeyHex, reads *federationPublicKeyHex, reads *federationRates, reads *forwardFailures, reads *forwards, reads *globalRateCount, reads *globalRateWindowStart, reads *heartbeatCount, reads *ipRates, reads *lastHeartbeatAt, reads *lastPresenceRefresh, reads *lastPrunedAt, reads *messages, reads *pendingFederationCancels, reads *pollWakeup, reads *presence, reads *pruneCount, reads *recvRates, reads *runtimeMaintenanceSecret, reads *senderDeliveries, reads *senderExpirations, reads *seqCounter, reads *serverGeneration, reads *sessions, reads *startedAt, writes *ackedIds, writes *activePolls, writes *allowedPeers, writes *authGlobalRateCount, writes *authGlobalRateWindowStart, writes *blockedPeers, writes *cancelNotifications, writes *challengeRates, writes *challenges, writes *deliveredIds, writes *drainCompletedAt, writes *drainPhase, writes *federationRates, writes *forwardFailures, writes *forwards, writes *globalRateCount, writes *globalRateWindowStart, writes *ipRates, writes *lastPresenceRefresh, writes *lastPrunedAt, writes *messages, writes *pendingFederationCancels, writes *pollWakeup, writes *presence, writes *recvRates, writes *runtimeMaintenanceSecret, writes *senderDeliveries, writes *senderExpirations, writes *seqCounter, writes *sessions, network, clock, random} Response
28782907serve = \req -> case req of
28792908 ReqChallenge {pubkey, clientIp, respond} -> handleChallenge pubkey clientIp respond
28802909 VerifyAuth {pubkey, challenge, signature, revokeOthers, clientIp, respond} -> handleVerifyAuth pubkey challenge signature revokeOthers clientIp respond
@@ -2898,7 +2927,6 @@ serve = \req -> case req of
28982927 FederationBatchCancel {cancels, fromServer, requestTimestamp, authorization, respond} -> handleFederationBatchCancel cancels fromServer requestTimestamp authorization respond
28992928 FederationBatchForward {forwards, fromServer, requestTimestamp, authorization, respond} -> handleFederationBatchForward forwards fromServer requestTimestamp authorization respond
29002929 FederationDeliveryReceipt {messageIds, toKeys, fromServer, requestTimestamp, authorization, respond} -> handleFederationDeliveryReceipt messageIds toKeys fromServer requestTimestamp authorization respond
2901− VerifyToken {token, scope, clientIp, respond} -> handleVerifyToken token scope clientIp respond
29022930 FederationPubkey {respond} -> handleFederationPubkey respond
29032931 Prune {authorization, respond} -> handlePrune authorization respond
29042932 Drain {phase, authorization, respond} -> handleDrain phase authorization respond
@@ -2940,7 +2968,7 @@ serve = \req -> case req of
29402968-- `pollTimeoutMs` so long-poll holders unblock and return an empty heartbeat
29412969-- response, keeping connections fresh.
29422970
2943−backgroundPrune : IO {reads *drainPhase, clock, reads *ackedIds, reads *activePolls, reads *blockedPeers, reads *cancelNotifications, reads *challenges, reads *deliveredIds, reads *forwardFailures, reads *forwards, reads *lastPresenceRefresh, reads *lastPrunedAt, reads *messages, reads *pendingFederationCancels, reads *pendingVerifications, reads *presence, reads *pruneCount, reads *senderDeliveries, reads *senderExpirations, reads *sessions, writes *ackedIds, writes *activePolls, writes *cancelNotifications, writes *challenges, writes *deliveredIds, writes *forwardFailures, writes *forwards, writes *lastPresenceRefresh, writes *lastPrunedAt, writes *messages, writes *pendingFederationCancels, writes *pendingVerifications, writes *presence, writes *pruneCount, writes *senderDeliveries, writes *senderExpirations, writes *sessions} a
2971+backgroundPrune : IO {reads *drainPhase, clock, reads *ackedIds, reads *activePolls, reads *blockedPeers, reads *cancelNotifications, reads *challenges, reads *deliveredIds, reads *federationPrivateKeyHex, reads *forwardFailures, reads *forwards, reads *lastPresenceRefresh, reads *lastPrunedAt, reads *messages, reads *pendingFederationCancels, reads *presence, reads *pruneCount, reads *senderDeliveries, reads *senderExpirations, reads *sessions, writes *ackedIds, writes *activePolls, writes *cancelNotifications, writes *challenges, writes *deliveredIds, writes *forwardFailures, writes *forwards, writes *lastPresenceRefresh, writes *lastPrunedAt, writes *messages, writes *pendingFederationCancels, writes *presence, writes *pruneCount, writes *senderDeliveries, writes *senderExpirations, writes *sessions} a
29442972backgroundPrune = do
29452973 sleep backgroundPruneInterval
29462974 dp <- *drainPhase
@@ -2969,6 +2997,13 @@ main = do
29692997 t <- now
29702998 genJitter <- randomInt 1000000
29712999 atomic (do *startedAt = t; *serverGeneration = t * 1000 + genJitter)
3000+ priv <- *federationPrivateKeyHex
3001+ when (priv == "") (do
3002+ let kp = generateKeyPair
3003+ atomic (do
3004+ *federationPrivateKeyHex = bytesToHex kp.privateKey
3005+ *federationPublicKeyHex = bytesToHex kp.publicKey)
3006+ logInfo "Generated federation keypair on first startup")
29723007 logInfo ("Skrepka relay server starting on port " ++ show listenPort ++ "...")
29733008 logInfo (" federation: " ++ (if federationEnabled then "enabled" else "disabled"))
29743009 fork backgroundPrune