@@ -8,15 +8,15 @@
88-- Configuration
99-- ============================================
1010-- Top-level constants: bind address, federation identity, capacity ceilings,
11−-- per-key/window rate limits, expiry/backoff/TTL durations, and protocol version.
11+-- per-key/window rate limits, and expiry/backoff/TTL durations.
1212-- Values written here are defaults; every scalar (Int/Float/Text/Bool/Maybe ...)
1313-- top-level constant can be overridden at startup via `--name=value` on the
1414-- command line (see Knot's `knot_override_lookup`). Run with `--help` for the
1515-- full list.
1616
1717-- 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
18+-- presence/gossip events and for self-checks (`isLocalServer`). Not a bind
19+-- address — the listener accepts connections on
2020-- every interface regardless of this value. May also differ from the URL
2121-- clients use to reach the server (e.g. behind a reverse proxy or alternate
2222-- DNS name); peers must resolve this name to reach us for federation.
@@ -43,8 +43,6 @@ listenPort = 8080
4343-- URL scheme used when contacting peer federation servers.
4444federationScheme : Text
4545federationScheme = "https://"
46−-- The Ed25519 federation keypair lives in `*federationPrivateKeyHex` /
47−-- `*federationPublicKeyHex` refs and is generated on first startup; see `main`.
4846
4947-- Storage retention for messages and dedup-id records. Mailbox rows live this
5048-- long after `receivedAt`; expired rows are pruned by `pruneExpired` (30 days).
@@ -68,9 +66,6 @@ maxGossipEvents = 100
6866-- Cap on events returned by one long-poll response.
6967maxPollEvents : Int
7068maxPollEvents = 50
71−-- Allowance for clock drift when validating client timestamps (5 s).
72−clockSkewTolerance : Int<Ms>
73−clockSkewTolerance = 5000
7469-- Per-peer ceiling on outstanding forward attempts.
7570maxForwardsPerServer : Int
7671maxForwardsPerServer = 2000
@@ -116,12 +111,6 @@ maxPairRatePerPair = 30
116111-- Window for the per-pair rate limit (1 min).
117112pairRateWindowMs : Int<Ms>
118113pairRateWindowMs = 60000
119−-- Federation requests permitted from a single peer server per window.
120−maxFederationRatePerServer : Int
121−maxFederationRatePerServer = 50
122−-- Window for the per-peer federation rate limit (1 s).
123−federationRateWindowMs : Int<Ms>
124−federationRateWindowMs = 1000
125114-- Presence/key lookups permitted per key per window.
126115maxLookupRatePerKey : Int
127116maxLookupRatePerKey = 5
@@ -242,7 +231,7 @@ type BlobHex = Text where isValidBoundedHex maxBlobLen
242231type SignatureHex = Text where isValidExactHex signatureLen
243232-- Normalized hostname (lowercased, no trailing dot, length-bounded). The SSRF
244233-- deny-list (`isBadServerName`) is enforced separately at federation egress
245−-- (`withFederationAuth`, `handlePingPeer`); keeping it out of the type predicate
234+-- (`handlePingPeer`, `handleRecvGossip`); keeping it out of the type predicate
246235-- lets the default `serverHost = "localhost"` flow through presence rows in a
247236-- non-federated single-node deployment.
248237isValidServerName : Text -> Bool
@@ -316,8 +305,6 @@ type ActivePoll = {pubkey: PubkeyHex, startedAt: Timestamp}
316305*challengeRates : [RateEntry]
317306-- Per-key counters for read-only lookups (presence).
318307*lookupRates : [RateEntry]
319−-- Per-peer counters for inbound federation calls.
320−*federationRates : [RateEntry]
321308-- Per-source-IP counters; gate for unauthenticated traffic.
322309*ipRates : [RateEntry]
323310
@@ -349,15 +336,6 @@ type ActivePoll = {pubkey: PubkeyHex, startedAt: Timestamp}
349336-- maintenance entirely (every check returns false).
350337*runtimeMaintenanceSecret : Text
351338
352−-- Ed25519 federation keypair (hex). Generated on first startup if blank, then persisted.
353−*federationPrivateKeyHex : Text
354−*federationPublicKeyHex : Text
355−
356−-- Operator-managed peer deny-list; checked on every inbound and outbound federation call.
357−*blockedPeers : [Text]
358−-- Operator-managed allow-list. When non-empty, only listed peers may federate (whitelist mode).
359−*allowedPeers : [Text]
360−
361339-- Cumulative tick counters surfaced on /stats; bumped by the background loops.
362340*pruneCount : Int
363341*heartbeatCount : Int
@@ -369,8 +347,7 @@ type ActivePoll = {pubkey: PubkeyHex, startedAt: Timestamp}
369347-- AuthApi -- challenge/verify (client identity)
370348-- ClientApi -- /poll, /messages (send), presence lookup
371349-- FederationApi -- inter-server gossip, forward (single + batch)
372−-- FederationPubkey -- exposes this server's federation Ed25519 public key
373−-- MaintenanceApi -- operator endpoints (prune, peer allow/block, admin)
350+-- MaintenanceApi -- operator endpoints (prune, admin)
374351-- HealthApi/StatsApi/MetricsApi/ReadyApi -- observability
375352-- Response field shapes are kept stable for backwards compatibility even when
376353-- the underlying value is no longer computed (zero-filled).
@@ -386,18 +363,12 @@ route ClientApi where
386363 POST {pubkeys: [PubkeyHex]} /lookup/batch headers {authorization: Text, clientIp: Text} -> {results: [{pubkey: PubkeyHex, server: ServerName}], authorized: Bool, error: Text} = BatchLookupPresence
387364
388365route FederationApi where
389− POST {events: [GossipEvent], fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text} /federation/gossip headers {authorization: Text} -> {ok: Bool, error: Text, retryAfterMs: Int} = RecvGossip
390− POST {toKey: PubkeyHex, encryptedBlob: BlobHex, fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text} /federation/forward headers {authorization: Text} -> {ok: Bool, error: Text, retryAfterMs: Int} = ForwardMessage
391− POST {forwards: [{toKey: PubkeyHex, encryptedBlob: BlobHex}], fromServer: ServerName, requestTimestamp: Timestamp, correlationId: Text} /federation/forward-batch headers {authorization: Text} -> {ok: Bool, error: Text, results: [{ok: Bool}], retryAfterMs: Int} = FederationBatchForward
392−
393−route FederationPubkeyApi where
394− GET /federation/pubkey -> {pubkey: Text, ok: Bool} = FederationPubkey
366+ POST {events: [GossipEvent], fromServer: ServerName} /federation/gossip -> {ok: Bool, error: Text, retryAfterMs: Int} = RecvGossip
367+ POST {toKey: PubkeyHex, encryptedBlob: BlobHex, fromServer: ServerName} /federation/forward -> {ok: Bool, error: Text, retryAfterMs: Int} = ForwardMessage
368+ POST {forwards: [{toKey: PubkeyHex, encryptedBlob: BlobHex}], fromServer: ServerName} /federation/forward-batch -> {ok: Bool, error: Text, results: [{ok: Bool}], retryAfterMs: Int} = FederationBatchForward
395369
396370route MaintenanceApi where
397371 POST /maintenance/prune headers {authorization: Text} -> {ok: Bool} = Prune
398− POST {server: ServerName} /maintenance/block headers {authorization: Text} -> {ok: Bool, blocked: Int} = BlockPeer
399− POST {server: ServerName} /maintenance/unblock headers {authorization: Text} -> {ok: Bool, unblocked: Bool} = UnblockPeer
400− GET /maintenance/blocked headers {authorization: Text} -> {peers: [Text], ok: Bool} = ListBlocked
401372 POST {server: ServerName} /maintenance/ping headers {authorization: Text} -> {ok: Bool, latencyMs: Int, error: Text} = PingPeer
402373 GET /maintenance/sessions/{pubkey: PubkeyHex} headers {authorization: Text} -> {sessions: [{token: Text, expiresAt: Timestamp, ip: Text}], count: Int, ok: Bool} = AdminListSessions
403374 POST {pubkey: PubkeyHex} /maintenance/sessions/revoke-all headers {authorization: Text} -> {ok: Bool, revokedCount: Int} = AdminRevokeSessions
@@ -406,9 +377,6 @@ route MaintenanceApi where
406377 POST {limit: Int} /maintenance/sessions/list headers {authorization: Text} -> {sessions: [{pubkey: PubkeyHex, count: Int, ips: [Text], latestExpiry: Timestamp}], ok: Bool, total: Int} = AdminListAllSessions
407378 GET /maintenance/rate-limits headers {authorization: Text} -> {ok: Bool, globalRequest: Int, ipRate: Int, sendRate: Int, federationRate: Int, authGlobal: Int, recvRate: Int, challengeRate: Int, pairRate: Int, lookupRate: Int} = GetRateLimits
408379 POST /maintenance/nonces/flush headers {authorization: Text} -> {ok: Bool, flushedCount: Int} = FlushNonces
409− POST {server: ServerName} /maintenance/allow headers {authorization: Text} -> {ok: Bool, allowed: Int} = AllowPeer
410− POST {server: ServerName} /maintenance/unallow headers {authorization: Text} -> {ok: Bool, removed: Bool} = UnallowPeer
411− GET /maintenance/allowed headers {authorization: Text} -> {peers: [Text], ok: Bool} = ListAllowed
412380 POST /maintenance/reconcile headers {authorization: Text} -> {ok: Bool, messageDrift: Int, presenceDrift: Int, sessionDrift: Int} = Reconcile
413381 GET /maintenance/config headers {authorization: Text} -> {ok: Bool, pollTimeoutMs: Int} = GetConfig
414382
@@ -449,7 +417,7 @@ route MetricsApi where
449417route ReadyApi where
450418 GET /ready -> {ready: Bool} = Ready
451419
452−route Api = AuthApi | ClientApi | FederationApi | FederationPubkeyApi | MaintenanceApi | HealthApi | StatsApi | MetricsApi | ReadyApi
420+route Api = AuthApi | ClientApi | FederationApi | MaintenanceApi | HealthApi | StatsApi | MetricsApi | ReadyApi
453421
454422-- ============================================
455423-- Generic helpers
@@ -499,11 +467,6 @@ max = \a b -> if a > b then a else b
499467-- Confine `x` to the closed interval [lo, hi].
500468clamp : a -> a -> a -> a
501469clamp = \lo hi x -> max lo (min hi x)
502−abs : Int -> Int
503−abs = \x -> if x < 0 then 0 - x else x
504−-- Pair each element with its 0-based index.
505−withIndex : [a] -> [{i: Int, v: a}]
506−withIndex = fold (\acc x -> union acc [{i: count acc, v: x}]) []
507470
508471-- First element of a list, or Nothing for an empty list.
509472headOf : [a] -> Maybe a
@@ -637,8 +600,8 @@ isBadServerName = \sn -> sn == "" || sn == "localhost" || not all (chars sn) (\c
637600-- Bearer token extraction, session lookup, maintenance secret check, and the
638601-- `gateAuth`/`gateLookup` combinators that every client handler funnels
639602-- through (global rate → per-key rate → session).
640−-- Federation requests use a separate path (`withFederationAuth`) using
641−-- Ed25519-signed auth verified via the peer's published public key.
603+-- Federation requests are unauthenticated: anyone can hit /federation/*.
604+-- Per-recipient `recvRate` and `no_presence` checks bound the spam ceiling.
642605
643606-- Plain ip match (sessions with empty ip skip the check).
644607matchIp : Text -> Text -> Bool
@@ -697,76 +660,6 @@ withSessionAuth = \authorization t clientIp onUnauth onAuth -> do
697660 Just {value: s} -> onAuth s.pubkey
698661 _ -> onUnauth
699662
700−-- Build the `Signed <hexsig>:<nonce>` header for an outbound federation call.
701−-- Signs the canonical "scope|timestamp|fromServer|nonce" string with our
702−-- federation private key (the peer fetches our public key via /federation/pubkey
703−-- to verify). Returns "" if no keypair has been generated yet.
704−generateFederationAuth : Text -> a -> IO {r *federationPrivateKeyHex, random} Text
705−generateFederationAuth = \scope requestTimestamp -> do
706− hex <- *federationPrivateKeyHex
707− let privKey = if hex == "" then Nothing {} else bytesFromHex hex
708− case privKey of
709− Just {value: pk} -> do
710− nonce <- genTokenN 48
711− yield ("Signed " ++ bytesToHex (sign pk (textToBytes (scope ++ "|" ++ show requestTimestamp ++ "|" ++ serverHostN ++ "|" ++ nonce))) ++ ":" ++ nonce)
712− _ -> yield ""
713−
714−-- Verify a federation request: Ed25519 signature over scope|ts|fromServer|nonce, key fetched from peer.
715−verifyFederationAuth : Text -> Text -> Text -> a -> IO {network} {} Bool
716−verifyFederationAuth = \authorization fromServer scope requestTimestamp -> do
717− if hasPrefix "Signed " authorization then do
718− let payload = drop 7 authorization
719− if payload == "" || tooLong payload (signatureLen + 25) then yield False {}
720− else do
721− -- Split payload on first ':' into {sig, nonce}.
722− let cs = chars payload
723− let sepIdx = case findFirst (withIndex cs) (\p -> p.v == ":") of
724− Just {value: p} -> p.i
725− _ -> count cs
726− let sig = take sepIdx payload
727− let nonce = drop (sepIdx + 1) payload
728− result <- fetch (federationUrl fromServer) (FederationPubkey {})
729− case result of
730− Ok {value: r} -> case bytesFromHex r.pubkey of
731− Just {value: pk} -> case bytesFromHex sig of
732− Just {value: sigBytes} -> yield (r.ok && r.pubkey != "" && verify pk (textToBytes (scope ++ "|" ++ show requestTimestamp ++ "|" ++ fromServer ++ (if nonce == "" then "" else "|" ++ nonce))) sigBytes)
733− _ -> yield False {}
734− _ -> yield False {}
735− _ -> yield False {}
736− else yield False {}
737−
738−-- Combined gate for inbound federation calls. Order of checks (each short-
739−-- circuits with an error code in the response):
740−-- 1. `fromServer` passes the SSRF deny-list (so `verifyFederationAuth`'s
741−-- pubkey fetch can't be steered at loopback/private hosts);
742−-- 2. peer not block-listed; 3. peer in allow-list (if any); 4. caller-supplied
743−-- `precondition` holds; 5. clock skew within `clockSkewTolerance`;
744−-- 6. Ed25519 signature verifies; 7. per-peer federation rate limit.
745−withFederationAuth = \authorization t mkErr fromServer scope requestTimestamp precondition action -> do
746− blocked <- *blockedPeers
747− allowed <- *allowedPeers
748− let err = \e r -> yield (mkErr e r)
749− let preErr = if isBadServerName fromServer
750− then "invalid_request"
751− else if elem fromServer blocked
752− then "blocked"
753− else if count allowed > 0 && not elem fromServer allowed
754− then "not_allowed"
755− else if not precondition
756− then "invalid_request"
757− else if requestTimestamp > 0 && abs (requestTimestamp - t) > clockSkewTolerance
758− then "clock_skew"
759− else ""
760− if preErr != ""
761− then err preErr 0
762− else do
763− verified <- verifyFederationAuth authorization fromServer scope requestTimestamp
764− if not verified
765− then err "unauthorized" 0
766− else do
767− limited <- checkServerRateGate fromServer t
768− if limited then err "rate_limited" federationRateWindowMs else action
769−
770663-- ============================================
771664-- Rate limiting (plain count-per-window, no sliding interpolation)
772665-- ============================================
@@ -831,14 +724,6 @@ else atomic (do
831724 *ipRates = r.entries
832725 yield r.limited)
833726
834−-- Per-peer federation rate gate; charged inside `withFederationAuth`.
835−checkServerRateGate : Text -> Int -> IO {rw *federationRates} Bool
836−checkServerRateGate = \server t -> atomic (do
837− rates <- *federationRates
838− let r = checkRate rates server maxFederationRatePerServer federationRateWindowMs t
839− *federationRates = r.entries
840− yield r.limited)
841−
842727-- Pre-auth gate: global + ip + auth-global. Returns "" when ok, else an error code.
843728authPreCheck : Text -> Int<Ms> -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates} Text
844729authPreCheck = \clientIp t -> do
@@ -964,13 +849,9 @@ sendBatchedGossip = \peers events -> forEach peers (\server -> do
964849 t <- now
965850 failures <- *forwardFailures
966851 when (shouldRetryServer server t failures) (do
967− auth <- generateFederationAuth "gossip" t
968852 result <- fetch (federationUrl server) (RecvGossip {
969− authorization: auth,
970853 events,
971− fromServer: serverHostN,
972− requestTimestamp: t,
973− correlationId: ""
854+ fromServer: serverHostN
974855 })
975856 case result of
976857 Err _ -> recordFailure server
@@ -995,22 +876,16 @@ broadcastOfflineGossip = \expiredLocal -> do
995876-- Walk pending forwards grouped by destination, retry each (up to maxBatchSize
996877-- per peer) using `/federation/forward`. Drops successful entries; for failures
997878-- bumps the retry count and gives up after `maxForwardRetries`.
998−retryPendingForwards : IO {r *blockedPeers, r *forwardFailures, r *forwards, clock} {}
879+retryPendingForwards : IO {r *forwardFailures, r *forwards, clock} {}
999880retryPendingForwards = do
1000881 t <- now
1001882 fwds <- *forwards
1002883 failures <- *forwardFailures
1003− blocked <- *blockedPeers
1004− 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
1005− t2 <- now
1006− auth <- generateFederationAuth "forward" t2
884+ forEach (filter (collectPeers fwds (\f -> f.toServer)) (\s -> shouldRetryServer s t failures)) (\server -> forEach (takeRelation maxBatchSize (filter fwds (\f -> f.toServer == server))) (\f -> do
1007885 result <- fetch (federationUrl server) (ForwardMessage {
1008886 f.toKey,
1009887 f.encryptedBlob,
1010− fromServer: serverHostN,
1011− requestTimestamp: t2,
1012− authorization: auth,
1013− correlationId: ""
888+ fromServer: serverHostN
1014889 })
1015890 success <- case result of
1016891 Err _ -> do
@@ -1370,14 +1245,10 @@ forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
13701245 Nothing {} -> yield {}
13711246 Just {value: f} -> do
13721247 t <- now
1373− auth <- generateFederationAuth "forward" t
13741248 result <- fetch (federationUrl server) (ForwardMessage {
13751249 toKey: to,
13761250 encryptedBlob,
1377− fromServer: serverHostN,
1378− requestTimestamp: t,
1379− authorization: auth,
1380− correlationId: ""
1251+ fromServer: serverHostN
13811252 })
13821253 case result of
13831254 Err _ -> recordFailure server
@@ -1434,18 +1305,9 @@ handleBatchLookupPresence = \pubkeys authorization clientIp -> do
14341305-- ============================================
14351306-- Handler: federation receive
14361307-- ============================================
1437−-- Inbound endpoints called peer-to-peer. Every handler funnels through
1438−-- `withFederationAuth` which checks: peer block/allow lists, request
1439−-- precondition (e.g. expected origin/server constraints), clock skew vs the
1440−-- request timestamp, Ed25519 signature auth, and per-peer rate limit.
1441−
1442−-- GET /federation/pubkey: publish the Ed25519 public key peers should use to
1443−-- verify our `Signed ...` federation auth headers. Returns ok=False when the
1444−-- keypair has not yet been generated (should not happen post-startup).
1445−handleFederationPubkey : IO {r *federationPublicKeyHex} {pubkey: Text, ok: Bool}
1446−handleFederationPubkey = do
1447− hex <- *federationPublicKeyHex
1448− yield {pubkey: hex, ok: hex != ""}
1308+-- Inbound peer-to-peer endpoints. Federation is open and unauthenticated:
1309+-- the per-recipient `recvRate` and `no_presence` checks in `storeFederated`
1310+-- do the actual spam-bounding.
14491311
14501312-- POST /federation/gossip: ingest peer presence events. The transport-level
14511313-- `fromServer` is the home server for every event. Drops every (pubkey,
@@ -1453,10 +1315,12 @@ handleFederationPubkey = do
14531315-- pubkeys with a `GossipOnline` event (so Online wins on collision). For keys
14541316-- that transition offline → online, flushes any locally-buffered messages via
14551317-- `forwardQueuedToServer`.
1456−handleRecvGossip : [{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}
1457−handleRecvGossip = \events fromServer requestTimestamp authorization -> do
1318+handleRecvGossip : [{eventType: <GossipOffline {} | GossipOnline {} | a>, pubkey: PubkeyHex | b}] -> Text -> IO {rw *presence, clock} {error: Text, ok: Bool, retryAfterMs: Int}
1319+handleRecvGossip = \events fromServer -> do
14581320 t <- now
1459− withFederationAuth authorization t (\e r -> {ok: False {}, error: e, retryAfterMs: r}) fromServer "gossip" requestTimestamp (isRemote fromServer && count events <= maxGossipEvents) (do
1321+ if not isRemote fromServer || isBadServerName fromServer || count events > maxGossipEvents
1322+ then yield {ok: False {}, error: "invalid_request", retryAfterMs: 0}
1323+ else do
14601324 newlyOnline <- atomic (do
14611325 pres <- *presence
14621326 let touchedPubkeys = pluck events (\e -> e.pubkey)
@@ -1468,7 +1332,7 @@ handleRecvGossip = \events fromServer requestTimestamp authorization -> do
14681332 *presence = union kept added
14691333 yield (filter onlinePubkeys (\pk -> none pres (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t))))
14701334 fork (forEach newlyOnline (\pk -> forwardQueuedToServer pk fromServer))
1471− yield {ok: True {}, error: "", retryAfterMs: 0})
1335+ yield {ok: True {}, error: "", retryAfterMs: 0}
14721336
14731337-- Store a federated/forwarded message into the local mailbox. Caller wraps in `atomic`.
14741338-- Returns "" on success, otherwise an error code:
@@ -1506,37 +1370,37 @@ storeFederated = \toKey encryptedBlob checkRecvRate t -> do
15061370-- POST /federation/forward: receive a single federated message destined for
15071371-- a local key. Delegates the actual store decision to `storeFederated`,
15081372-- which returns "" on success.
1509−handleForwardMessage : PubkeyHex -> BlobHex -> Text -> Int -> Text -> IO {r *allowedPeers, r *blockedPeers, rw *federationRates, rw *messages, rw *pollWakeup, r *presence, rw *recvRates, rw *seqCounter, clock, network} {error: Text, ok: Bool, retryAfterMs: Int}
1510−handleForwardMessage = \toKey encryptedBlob fromServer requestTimestamp authorization -> do
1373+handleForwardMessage : PubkeyHex -> BlobHex -> Text -> IO {rw *messages, rw *pollWakeup, r *presence, rw *recvRates, rw *seqCounter, clock} {error: Text, ok: Bool, retryAfterMs: Int}
1374+handleForwardMessage = \toKey encryptedBlob _ -> do
15111375 t <- now
1512− withFederationAuth authorization t (\e r -> {ok: False {}, error: e, retryAfterMs: r}) fromServer "forward" requestTimestamp (isRemote fromServer) (do
1513− result <- atomic storeFederated toKey encryptedBlob (True {}) t
1514− yield {ok: result == "", error: result, retryAfterMs: 0})
1376+ result <- atomic storeFederated toKey encryptedBlob (True {}) t
1377+ yield {ok: result == "", error: result, retryAfterMs: 0}
15151378
15161379-- POST /federation/forward-batch: bulk variant of `handleForwardMessage`.
1517−-- Skips per-entry recv-rate charging (the per-server federation rate limit
1518−-- already gates the call as a whole).
1519−handleFederationBatchForward : [{encryptedBlob: BlobHex, toKey: PubkeyHex | a}] -> Text -> Int -> Text -> IO {r *allowedPeers, r *blockedPeers, rw *federationRates, clock, network} {error: Text, ok: Bool, results: [{ok: Bool}], retryAfterMs: Int}
1520−handleFederationBatchForward = \forwards fromServer requestTimestamp authorization -> do
1380+-- Skips per-entry recv-rate charging.
1381+handleFederationBatchForward : [{encryptedBlob: BlobHex, toKey: PubkeyHex | a}] -> Text -> IO {clock} {error: Text, ok: Bool, results: [{ok: Bool}], retryAfterMs: Int}
1382+handleFederationBatchForward = \forwards _ -> do
15211383 t <- now
1522− withFederationAuth authorization t (\e r -> {ok: False {}, error: e, results: [], retryAfterMs: r}) fromServer "forward-batch" requestTimestamp (isRemote fromServer && count forwards <= maxBatchSize) (do
1384+ if count forwards > maxBatchSize
1385+ then yield {ok: False {}, error: "invalid_request", results: [], retryAfterMs: 0}
1386+ else do
15231387 results <- mapEach (takeRelation maxBatchSize forwards) (\e -> do
15241388 result <- atomic storeFederated e.toKey e.encryptedBlob (False {}) t
15251389 yield {ok: result == ""})
1526− yield {ok: True {}, error: "", results, retryAfterMs: 0})
1390+ yield {ok: True {}, error: "", results, retryAfterMs: 0}
15271391
15281392-- ============================================
15291393-- Maintenance handlers
15301394-- ============================================
15311395-- Operator endpoints, all gated by `runtimeMaintenanceSecret` (Bearer header).
15321396-- Admin endpoints can revoke sessions by pubkey or IP, purge a recipient's
1533−-- mailbox, list aggregated session activity, block/allow peers, rotate the
1534−-- maintenance secret, and read live config.
1397+-- mailbox, list aggregated session activity, rotate the maintenance secret,
1398+-- and read live config.
15351399
15361400-- POST /maintenance/prune: trigger an out-of-band `pruneAndRetry` tick.
15371401-- Useful when the operator wants to force expiry/forward retries without
15381402-- waiting for the next `backgroundPrune` interval.
1539−handlePrune : Text -> IO {r *runtimeMaintenanceSecret, rw *activePolls, r *blockedPeers, rw *challenges, rw *forwardFailures, r *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *sessions, clock} {ok: Bool}
1403+handlePrune : Text -> IO {r *runtimeMaintenanceSecret, rw *activePolls, rw *challenges, rw *forwardFailures, r *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *sessions, clock} {ok: Bool}
15401404handlePrune = \authorization -> do
15411405 t <- now
15421406 authorized <- verifyMaintenanceAuth authorization
@@ -1585,78 +1449,10 @@ handleReady = do
15851449 lastPrune <- *lastPrunedAt
15861450 yield {ready: lastPrune > 0 && lastPrune >= sa}
15871451
1588−-- POST /maintenance/block: deny-list a peer. Outbound retries skip blocked
1589−-- peers; inbound federation calls from blocked peers fail in `withFederationAuth`.
1590−handleBlockPeer : Text -> Text -> IO {rw *blockedPeers, r *runtimeMaintenanceSecret} {blocked: Int, ok: Bool}
1591−handleBlockPeer = \server authorization -> withMaintAuth authorization (yield {
1592− ok: False {},
1593− blocked: 0
1594−}) (do
1595− n <- atomic (do
1596− current <- *blockedPeers
1597− let updated = union current [server]
1598− *blockedPeers = updated
1599− yield (count updated))
1600− yield {ok: True {}, blocked: n})
1601−
1602−-- POST /maintenance/unblock: remove a peer from the deny-list.
1603−handleUnblockPeer : Text -> Text -> IO {rw *blockedPeers, r *runtimeMaintenanceSecret} {ok: Bool, unblocked: Bool}
1604−handleUnblockPeer = \server authorization -> withMaintAuth authorization (yield {
1605− ok: False {},
1606− unblocked: False {}
1607−}) (do
1608− removed <- atomic (do
1609− current <- *blockedPeers
1610− *blockedPeers = removeWhere current (\x -> x == server)
1611− yield (elem server current))
1612− yield {ok: True {}, unblocked: removed})
1613−
1614−-- GET /maintenance/blocked: list the deny-listed peers (empty for unauthorized).
1615−handleListBlocked : Text -> IO {r *blockedPeers, r *runtimeMaintenanceSecret} {ok: Bool, peers: [Text]}
1616−handleListBlocked = \authorization -> do
1617− ok <- verifyMaintenanceAuth authorization
1618− list <- *blockedPeers
1619− yield {peers: if ok then list else [], ok}
1620−
1621−-- POST /maintenance/allow: when the allowed-peers list is non-empty, only
1622−-- federation calls from listed peers are accepted (whitelist mode). An empty
1623−-- list disables the whitelist.
1624−handleAllowPeer : Text -> Text -> IO {rw *allowedPeers, r *runtimeMaintenanceSecret} {allowed: Int, ok: Bool}
1625−handleAllowPeer = \server authorization -> withMaintAuth authorization (yield {
1626− ok: False {},
1627− allowed: 0
1628−}) (do
1629− n <- atomic (do
1630− current <- *allowedPeers
1631− let updated = union current [server]
1632− *allowedPeers = updated
1633− yield (count updated))
1634− yield {ok: True {}, allowed: n})
1635−
1636−-- POST /maintenance/unallow: remove an entry from the allow-list. If the
1637−-- list becomes empty, the whitelist gate disengages.
1638−handleUnallowPeer : Text -> Text -> IO {rw *allowedPeers, r *runtimeMaintenanceSecret} {ok: Bool, removed: Bool}
1639−handleUnallowPeer = \server authorization -> withMaintAuth authorization (yield {
1640− ok: False {},
1641− removed: False {}
1642−}) (do
1643− removed <- atomic (do
1644− current <- *allowedPeers
1645− *allowedPeers = removeWhere current (\x -> x == server)
1646− yield (elem server current))
1647− yield {ok: True {}, removed})
1648−
1649−-- GET /maintenance/allowed: list the allow-listed peers (empty for unauthorized).
1650−handleListAllowed : Text -> IO {r *allowedPeers, r *runtimeMaintenanceSecret} {ok: Bool, peers: [Text]}
1651−handleListAllowed = \authorization -> do
1652− ok <- verifyMaintenanceAuth authorization
1653− list <- *allowedPeers
1654− yield {peers: if ok then list else [], ok}
1655−
16561452-- POST /maintenance/ping: send a zero-event gossip to a peer and return the
16571453-- round-trip latency. Useful for diagnosing federation reachability without
16581454-- waiting for organic traffic.
1659−handlePingPeer : Text -> Text -> IO {r *federationPrivateKeyHex, r *runtimeMaintenanceSecret, network, clock, random} {error: Text, latencyMs: Int, ok: Bool}
1455+handlePingPeer : Text -> Text -> IO {r *runtimeMaintenanceSecret, network, clock} {error: Text, latencyMs: Int, ok: Bool}
16601456handlePingPeer = \server authorization -> withMaintAuth authorization (yield {
16611457 ok: False {},
16621458 latencyMs: 0,
@@ -1665,13 +1461,9 @@ handlePingPeer = \server authorization -> withMaintAuth authorization (yield {
16651461then yield {ok: False {}, latencyMs: 0, error: "invalid_server"}
16661462else do
16671463 startTime <- now
1668− auth <- generateFederationAuth "gossip" startTime
16691464 result <- fetch (federationUrl server) (RecvGossip {
1670− authorization: auth,
16711465 events: [],
1672− fromServer: serverHostN,
1673− requestTimestamp: startTime,
1674− correlationId: ""
1466+ fromServer: serverHostN
16751467 })
16761468 endTime <- now
16771469 case result of
@@ -1767,7 +1559,7 @@ handleGetRateLimits = \authorization -> do
17671559 globalRequest: v maxGlobalRequestRate,
17681560 ipRate: v maxIpRatePerIp,
17691561 sendRate: v maxSendRatePerKey,
1770− federationRate: v maxFederationRatePerServer,
1562+ federationRate: 0,
17711563 authGlobal: v maxAuthGlobalRate,
17721564 recvRate: v maxRecvRatePerKey,
17731565 challengeRate: v maxChallengeRatePerKey,
@@ -1793,7 +1585,7 @@ handleGetConfig = \authorization -> do
17931585-- GET /stats: capacity gauges + minimal federation/timing snapshot. Most of
17941586-- the historical metric fields are zero-filled (see `zeroStats`) — only the
17951587-- counts that come straight from the state refs are populated.
1796−handleStats : Text -> IO {r *activePolls, r *blockedPeers, r *challenges, 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, forwardNonces: Int, forwardNoncesMax: Int, forwards: Int, messageBucketMax: Int, messageBucketMin: Int, messages: Int, nonceEvictions: Int, presence: Int, recipientCounts: Int, sessions: Int, sessionsMax: Int, sessionsPct: Int, totalMessageCount: Int}, federation: {avgLatencyMs: Int, blockedPeers: Int, callCount: Int, enabled: Bool, forwardFailures: Int, forwardServers: Int, gossipFail: Int, gossipSuccess: Int, hungSlots: Int, inFlight: Int, latencyBuckets: {gte2000: Int, lt100: Int, lt2000: Int, lt500: Int}, maxForwardQueueDepth: Int, maxLatencyMs: Int, oldestForwardAge: Int, recentGossip: Int, slowVerifies: Int, topFailingPeers: [{failures: Int, server: Text}], verifyFailures: Int}, ok: Bool, rates: {challenge: Int, federation: Int, federationPair: Int, global: Int, gossipEvent: Int, ip: Int, lookup: Int, pair: Int, recv: Int, rejectedAuth: Int, rejectedFederation: Int, rejectedGlobal: Int, rejectedIp: Int, rejectedPerKey: Int, send: Int, uniqueKeyIp: Int, verifyIp: Int}, timing: {activeRequests: Int, authAvgMs: Int, authCount: Int, authMaxMs: Int, heartbeatCount: Int, lastHeartbeatAt: Timestamp, lastPruneAt: Timestamp, peakActiveRequests: Int, pollAvgMs: Int, pollCount: Int, pollLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, pollMaxMs: Int, pruneCount: Int, pruneRunning: Timestamp, sendAvgMs: Int, sendCount: Int, sendLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, sendMaxMs: Int, totalEntries: Int, uptime: Int}, version: Text}
1588+handleStats : Text -> IO {r *activePolls, r *challenges, 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, forwardNonces: Int, forwardNoncesMax: Int, forwards: Int, messageBucketMax: Int, messageBucketMin: Int, messages: Int, nonceEvictions: Int, presence: Int, recipientCounts: Int, sessions: Int, sessionsMax: Int, sessionsPct: Int, totalMessageCount: Int}, federation: {avgLatencyMs: Int, blockedPeers: Int, callCount: Int, enabled: Bool, forwardFailures: Int, forwardServers: Int, gossipFail: Int, gossipSuccess: Int, hungSlots: Int, inFlight: Int, latencyBuckets: {gte2000: Int, lt100: Int, lt2000: Int, lt500: Int}, maxForwardQueueDepth: Int, maxLatencyMs: Int, oldestForwardAge: Int, recentGossip: Int, slowVerifies: Int, topFailingPeers: [{failures: Int, server: Text}], verifyFailures: Int}, ok: Bool, rates: {challenge: Int, federation: Int, federationPair: Int, global: Int, gossipEvent: Int, ip: Int, lookup: Int, pair: Int, recv: Int, rejectedAuth: Int, rejectedFederation: Int, rejectedGlobal: Int, rejectedIp: Int, rejectedPerKey: Int, send: Int, uniqueKeyIp: Int, verifyIp: Int}, timing: {activeRequests: Int, authAvgMs: Int, authCount: Int, authMaxMs: Int, heartbeatCount: Int, lastHeartbeatAt: Timestamp, lastPruneAt: Timestamp, peakActiveRequests: Int, pollAvgMs: Int, pollCount: Int, pollLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, pollMaxMs: Int, pruneCount: Int, pruneRunning: Timestamp, sendAvgMs: Int, sendCount: Int, sendLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, sendMaxMs: Int, totalEntries: Int, uptime: Int}, version: Text}
17971589handleStats = \authorization -> withMaintAuth authorization (yield zeroStats) (do
17981590 t <- now
17991591 sa <- *startedAt
@@ -1803,7 +1595,6 @@ handleStats = \authorization -> withMaintAuth authorization (yield zeroStats) (d
18031595 fwds <- *forwards
18041596 aps <- *activePolls
18051597 chs <- *challenges
1806− bp <- *blockedPeers
18071598 pc <- *pruneCount
18081599 hc <- *heartbeatCount
18091600 lp <- *lastPrunedAt
@@ -1845,7 +1636,7 @@ handleStats = \authorization -> withMaintAuth authorization (yield zeroStats) (d
18451636 forwardFailures: 0,
18461637 oldestForwardAge: 0,
18471638 recentGossip: 0,
1848− blockedPeers: count bp,
1639+ blockedPeers: 0,
18491640 forwardServers: 0,
18501641 maxForwardQueueDepth: 0,
18511642 topFailingPeers: [],
@@ -2084,7 +1875,7 @@ handleStatsRates = \authorization -> do
20841875 globalRequest: v maxGlobalRequestRate,
20851876 ipRate: v maxIpRatePerIp,
20861877 sendRate: v maxSendRatePerKey,
2087− federationRate: v maxFederationRatePerServer,
1878+ federationRate: 0,
20881879 authGlobal: v maxAuthGlobalRate,
20891880 recvRate: v maxRecvRatePerKey,
20901881 challengeRate: v maxChallengeRatePerKey,
@@ -2133,14 +1924,10 @@ api = serve Api where
21331924 SendMessages = \{messages, authorization, clientIp} -> handleSendMessages messages authorization clientIp
21341925 LookupPresence = \{pubkey, authorization, clientIp} -> handleLookupPresence pubkey authorization clientIp
21351926 BatchLookupPresence = \{pubkeys, authorization, clientIp} -> handleBatchLookupPresence pubkeys authorization clientIp
2136− RecvGossip = \{events, fromServer, requestTimestamp, authorization} -> handleRecvGossip events fromServer requestTimestamp authorization
2137− ForwardMessage = \{toKey, encryptedBlob, fromServer, requestTimestamp, authorization} -> handleForwardMessage toKey encryptedBlob fromServer requestTimestamp authorization
2138− FederationBatchForward = \{forwards, fromServer, requestTimestamp, authorization} -> handleFederationBatchForward forwards fromServer requestTimestamp authorization
2139− FederationPubkey = \{} -> handleFederationPubkey
1927+ RecvGossip = \{events, fromServer} -> handleRecvGossip events fromServer
1928+ ForwardMessage = \{toKey, encryptedBlob, fromServer} -> handleForwardMessage toKey encryptedBlob fromServer
1929+ FederationBatchForward = \{forwards, fromServer} -> handleFederationBatchForward forwards fromServer
21401930 Prune = \{authorization} -> handlePrune authorization
2141− BlockPeer = \{server, authorization} -> handleBlockPeer server authorization
2142− UnblockPeer = \{server, authorization} -> handleUnblockPeer server authorization
2143− ListBlocked = \{authorization} -> handleListBlocked authorization
21441931 PingPeer = \{server, authorization} -> handlePingPeer server authorization
21451932 AdminListSessions = \{pubkey, authorization} -> handleAdminListSessions pubkey authorization
21461933 AdminRevokeSessions = \{pubkey, authorization} -> handleAdminRevokeSessions pubkey authorization
@@ -2149,9 +1936,6 @@ api = serve Api where
21491936 AdminRevokeIp = \{ip, authorization} -> handleAdminRevokeIp ip authorization
21501937 GetRateLimits = \{authorization} -> handleGetRateLimits authorization
21511938 FlushNonces = \{authorization} -> handleFlushNonces authorization
2152− AllowPeer = \{server, authorization} -> handleAllowPeer server authorization
2153− UnallowPeer = \{server, authorization} -> handleUnallowPeer server authorization
2154− ListAllowed = \{authorization} -> handleListAllowed authorization
21551939 Reconcile = \{authorization} -> handleReconcile authorization
21561940 GetConfig = \{authorization} -> handleGetConfig authorization
21571941 Health = \{authorization} -> handleHealth authorization
@@ -2174,7 +1958,7 @@ api = serve Api where
21741958
21751959-- Endless tick: every `backgroundPruneInterval` run `pruneAndRetry` and bump
21761960-- `pruneCount` for /stats and /health.
2177−backgroundPrune : IO {rw *activePolls, r *blockedPeers, rw *challenges, rw *forwardFailures, r *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *pruneCount, rw *sessions, clock} a
1961+backgroundPrune : IO {rw *activePolls, rw *challenges, rw *forwardFailures, r *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *pruneCount, rw *sessions, clock} a
21781962backgroundPrune = do
21791963 sleep backgroundPruneInterval
21801964 t <- now
@@ -2198,20 +1982,13 @@ pollHeartbeat = do
21981982-- server restarts and reset their poll cursor), spawn the two background
21991983-- loops, and start the listener.
22001984
2201−-- Entry point: stamp startup metadata, lazily generate the federation keypair
2202−-- on first run, fork the background loops, and start the HTTP listener.
1985+-- Entry point: stamp startup metadata, fork the background loops, and start
1986+-- the HTTP listener.
22031987main : IO _ {}
22041988main = do
22051989 t <- now
22061990 genJitter <- randomInt 1000000
22071991 atomic (do *startedAt = t; *serverGeneration = t * 1000 + genJitter)
2208− priv <- *federationPrivateKeyHex
2209− when (priv == "") (do
2210− kp <- generateKeyPair
2211− atomic (do
2212− *federationPrivateKeyHex = bytesToHex kp.privateKey
2213− *federationPublicKeyHex = bytesToHex kp.publicKey)
2214− logInfo "Generated federation keypair on first startup")
22151992 logInfo ("Skrepka relay server starting on " ++ bindHost ++ ":" ++ show listenPort ++ " ...")
22161993 logInfo (" federation: " ++ (if federationEnabled then "enabled" else "disabled"))
22171994 fork backgroundPrune