@@ -131,12 +131,6 @@ maxLookupRatePerKey = 5
131-- Window for the per-key lookup rate limit (1 s).
131-- Window for the per-key lookup rate limit (1 s).
132lookupRateWindowMs : Int<Ms>
132lookupRateWindowMs : Int<Ms>
133lookupRateWindowMs = 1000
133lookupRateWindowMs = 1000
134−-- Other client write requests permitted per key per window.
135−maxClientWriteRatePerKey : Int
136−maxClientWriteRatePerKey = 10
137−-- Window for the per-key client-write rate limit (1 s).
138−clientWriteRateWindowMs : Int<Ms>
139−clientWriteRateWindowMs = 1000
140-- Requests permitted per source IP per window (covers unauthenticated traffic).
134-- Requests permitted per source IP per window (covers unauthenticated traffic).
141maxIpRatePerIp : Int
135maxIpRatePerIp : Int
142maxIpRatePerIp = 10
136maxIpRatePerIp = 10
@@ -336,8 +330,6 @@ type ActivePoll = {pubkey: PubkeyHex, startedAt: Timestamp}
336*challengeRates : [RateEntry]
330*challengeRates : [RateEntry]
337-- Per-key counters for read-only lookups (presence, /messages/list).
331-- Per-key counters for read-only lookups (presence, /messages/list).
338*lookupRates : [RateEntry]
332*lookupRates : [RateEntry]
339−-- Per-key counters for misc client writes (/messages/status).
340−*clientWriteRates : [RateEntry]
341-- Per-peer counters for inbound federation calls.
333-- Per-peer counters for inbound federation calls.
342*federationRates : [RateEntry]
334*federationRates : [RateEntry]
343-- Per-source-IP counters; gate for unauthenticated traffic.
335-- Per-source-IP counters; gate for unauthenticated traffic.
@@ -427,8 +419,8 @@ route MaintenanceApi where
427 POST {pubkey: PubkeyHex} /maintenance/messages/purge headers {authorization: Text} -> {ok: Bool, purgedCount: Int} = AdminPurgeMessages
419 POST {pubkey: PubkeyHex} /maintenance/messages/purge headers {authorization: Text} -> {ok: Bool, purgedCount: Int} = AdminPurgeMessages
428 POST {ip: Text} /maintenance/sessions/revoke-ip headers {authorization: Text} -> {ok: Bool, revokedCount: Int, affectedKeys: Int} = AdminRevokeIp
420 POST {ip: Text} /maintenance/sessions/revoke-ip headers {authorization: Text} -> {ok: Bool, revokedCount: Int, affectedKeys: Int} = AdminRevokeIp
429 POST {limit: Int} /maintenance/sessions/list headers {authorization: Text} -> {sessions: [{pubkey: PubkeyHex, count: Int, ips: [Text], latestExpiry: Timestamp}], ok: Bool, total: Int} = AdminListAllSessions
421 POST {limit: Int} /maintenance/sessions/list headers {authorization: Text} -> {sessions: [{pubkey: PubkeyHex, count: Int, ips: [Text], latestExpiry: Timestamp}], ok: Bool, total: Int} = AdminListAllSessions
430− GET /maintenance/rate-limits headers {authorization: Text} -> {ok: Bool, globalRequest: Int, ipRate: Int, sendRate: Int, federationRate: Int, authGlobal: Int, recvRate: Int, challengeRate: Int, pairRate: Int, lookupRate: Int, clientWriteRate: Int} = GetRateLimits
422+ 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
431− POST {globalRequest: Int, ipRate: Int, sendRate: Int, federationRate: Int, authGlobal: Int, recvRate: Int, challengeRate: Int, pairRate: Int, lookupRate: Int, clientWriteRate: Int} /maintenance/rate-limits headers {authorization: Text} -> {ok: Bool} = SetRateLimits
423+ POST {globalRequest: Int, ipRate: Int, sendRate: Int, federationRate: Int, authGlobal: Int, recvRate: Int, challengeRate: Int, pairRate: Int, lookupRate: Int} /maintenance/rate-limits headers {authorization: Text} -> {ok: Bool} = SetRateLimits
432 POST /maintenance/nonces/flush headers {authorization: Text} -> {ok: Bool, flushedCount: Int} = FlushNonces
424 POST /maintenance/nonces/flush headers {authorization: Text} -> {ok: Bool, flushedCount: Int} = FlushNonces
433 POST {server: ServerName} /maintenance/allow headers {authorization: Text} -> {ok: Bool, allowed: Int} = AllowPeer
425 POST {server: ServerName} /maintenance/allow headers {authorization: Text} -> {ok: Bool, allowed: Int} = AllowPeer
434 POST {server: ServerName} /maintenance/unallow headers {authorization: Text} -> {ok: Bool, removed: Bool} = UnallowPeer
426 POST {server: ServerName} /maintenance/unallow headers {authorization: Text} -> {ok: Bool, removed: Bool} = UnallowPeer
@@ -466,7 +458,7 @@ route StatsApi where
466 GET /stats/key/{pubkey: PubkeyHex} headers {authorization: Text} -> {messages: Int, presence: [KeyPresenceEntry], sessions: Int, forwards: Int, forwardDetails: [{server: Text, retries: Int}], activePolls: Int, ok: Bool} = StatsKey
458 GET /stats/key/{pubkey: PubkeyHex} headers {authorization: Text} -> {messages: Int, presence: [KeyPresenceEntry], sessions: Int, forwards: Int, forwardDetails: [{server: Text, retries: Int}], activePolls: Int, ok: Bool} = StatsKey
467 POST {limit: Int} /stats/top-recipients headers {authorization: Text} -> {recipients: [RecipientCount], ok: Bool, total: Int} = TopRecipients
459 POST {limit: Int} /stats/top-recipients headers {authorization: Text} -> {recipients: [RecipientCount], ok: Bool, total: Int} = TopRecipients
468 GET /stats/forwards headers {authorization: Text} -> {servers: [{server: Text, count: Int, totalRetries: Int}], ok: Bool, total: Int} = StatsForwards
460 GET /stats/forwards headers {authorization: Text} -> {servers: [{server: Text, count: Int, totalRetries: Int}], ok: Bool, total: Int} = StatsForwards
469− GET /stats/rates headers {authorization: Text} -> {ok: Bool, scalePct: Int, globalRequest: Int, ipRate: Int, sendRate: Int, federationRate: Int, authGlobal: Int, recvRate: Int, challengeRate: Int, pairRate: Int, lookupRate: Int, clientWriteRate: Int} = StatsRates
461+ GET /stats/rates headers {authorization: Text} -> {ok: Bool, scalePct: Int, globalRequest: Int, ipRate: Int, sendRate: Int, federationRate: Int, authGlobal: Int, recvRate: Int, challengeRate: Int, pairRate: Int, lookupRate: Int} = StatsRates
471route MetricsApi where
463route MetricsApi where
472 GET /metrics headers {authorization: Text} -> {metrics: Text, ok: Bool} = Metrics
464 GET /metrics headers {authorization: Text} -> {metrics: Text, ok: Bool} = Metrics
@@ -667,8 +659,8 @@ isBadServerName = \sn -> sn == "" || sn == "localhost" || not all (chars sn) (\c
667-- Auth helpers
659-- Auth helpers
668-- ============================================
660-- ============================================
669-- Bearer token extraction, session lookup, maintenance secret check, and the
661-- Bearer token extraction, session lookup, maintenance secret check, and the
670−-- `gateAuth`/`gateClientWrite`/`gateLookup` combinators that every client
662+-- `gateAuth`/`gateLookup` combinators that every client handler funnels
671−-- handler funnels through (global rate → per-key rate → session).
663+-- through (global rate → per-key rate → session).
672-- Federation requests use a separate path (`withFederationAuth`) using
664-- Federation requests use a separate path (`withFederationAuth`) using
673-- Ed25519-signed auth verified via the peer's published public key.
665-- Ed25519-signed auth verified via the peer's published public key.
@@ -705,19 +697,8 @@ gateAuth = \auth ip t mkErr onAuth -> do
705 let err = \e -> yield (mkErr e)
697 let err = \e -> yield (mkErr e)
706 if g then err "rate_limited" else withSessionAuth auth t ip (err "unauthorized") onAuth
698 if g then err "rate_limited" else withSessionAuth auth t ip (err "unauthorized") onAuth
708−-- gateAuth + per-key rate gate. `rateResp` is the response value when the per-key gate trips.
700+-- gateAuth + per-key lookup-rate gate. `rateResp` is the response value when
709−gateClientWrite : Text -> Text -> Int<Ms> -> (Text -> a) -> a -> (Text -> IO {} a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} a
701+-- the per-key gate trips.
710−gateClientWrite = \auth ip t mkErr rateResp onAuth ->
711− gateAuth auth ip t mkErr (\pk -> do
713− rates <- *clientWriteRates
714− let r = checkRate rates pk maxClientWriteRatePerKey clientWriteRateWindowMs t
715− -- TODO: make this no be a `replace`
716− *clientWriteRates = r.entries
718− if lim then yield rateResp else onAuth pk)
720−-- Variant of `gateClientWrite` that uses the per-key lookup-rate window instead.
721gateLookup : Text -> Text -> Int<Ms> -> (Text -> a) -> a -> (Text -> IO {} a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} a
702gateLookup : Text -> Text -> Int<Ms> -> (Text -> a) -> a -> (Text -> IO {} a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} a
722gateLookup = \auth ip t mkErr rateResp onAuth ->
703gateLookup = \auth ip t mkErr rateResp onAuth ->
723 gateAuth auth ip t mkErr (\pk -> do
704 gateAuth auth ip t mkErr (\pk -> do
@@ -1864,7 +1845,7 @@ handleAdminListAllSessions = \limit authorization -> withMaintAuth authorization
1865-- GET /maintenance/rate-limits: expose the configured rate ceilings. Returns
1846-- GET /maintenance/rate-limits: expose the configured rate ceilings. Returns
1866-- zeros for unauthenticated callers (response shape stays stable).
1847-- zeros for unauthenticated callers (response shape stays stable).
1867−handleGetRateLimits : Text -> IO {r *runtimeMaintenanceSecret} {authGlobal: Int, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, sendRate: Int}
1848+handleGetRateLimits : Text -> IO {r *runtimeMaintenanceSecret} {authGlobal: Int, challengeRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, sendRate: Int}
1868handleGetRateLimits = \authorization -> do
1849handleGetRateLimits = \authorization -> do
1869 ok <- verifyMaintenanceAuth authorization
1850 ok <- verifyMaintenanceAuth authorization
1870 let v = \x -> if ok then x else 0
1851 let v = \x -> if ok then x else 0
@@ -1878,14 +1859,13 @@ handleGetRateLimits = \authorization -> do
1878 recvRate: v maxRecvRatePerKey,
1859 recvRate: v maxRecvRatePerKey,
1879 challengeRate: v maxChallengeRatePerKey,
1860 challengeRate: v maxChallengeRatePerKey,
1880 pairRate: v maxPairRatePerPair,
1861 pairRate: v maxPairRatePerPair,
1881− lookupRate: v maxLookupRatePerKey,
1862+ lookupRate: v maxLookupRatePerKey
1882− clientWriteRate: v maxClientWriteRatePerKey
1885-- POST /maintenance/rate-limits: stub. Rate ceilings are compile-time constants
1865-- POST /maintenance/rate-limits: stub. Rate ceilings are compile-time constants
1886-- in this simplified server, so this just authorizes and returns ok=true.
1866-- in this simplified server, so this just authorizes and returns ok=true.
1887−handleSetRateLimits : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Text -> IO {r *runtimeMaintenanceSecret} {ok: Bool}
1867+handleSetRateLimits : a -> b -> c -> d -> e -> f -> g -> h -> i -> Text -> IO {r *runtimeMaintenanceSecret} {ok: Bool}
1888−handleSetRateLimits = \globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization -> do
1868+handleSetRateLimits = \globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate authorization -> do
1889 authorized <- verifyMaintenanceAuth authorization
1869 authorized <- verifyMaintenanceAuth authorization
1890 yield {ok: authorized}
1870 yield {ok: authorized}
@@ -2203,7 +2183,7 @@ handleStatsForwards = \authorization -> withMaintAuth authorization (yield {
2204-- GET /stats/rates: same shape as /maintenance/rate-limits with an extra
2184-- GET /stats/rates: same shape as /maintenance/rate-limits with an extra
2205-- scalePct field. Kept separate for backwards compatibility with older clients.
2185-- scalePct field. Kept separate for backwards compatibility with older clients.
2206−handleStatsRates : Text -> IO {r *runtimeMaintenanceSecret} {authGlobal: Int, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, scalePct: Int, sendRate: Int}
2186+handleStatsRates : Text -> IO {r *runtimeMaintenanceSecret} {authGlobal: Int, challengeRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, scalePct: Int, sendRate: Int}
2207handleStatsRates = \authorization -> do
2187handleStatsRates = \authorization -> do
2208 ok <- verifyMaintenanceAuth authorization
2188 ok <- verifyMaintenanceAuth authorization
2209 let v = \x -> if ok then x else 0
2189 let v = \x -> if ok then x else 0
@@ -2218,8 +2198,7 @@ handleStatsRates = \authorization -> do
2218 recvRate: v maxRecvRatePerKey,
2198 recvRate: v maxRecvRatePerKey,
2219 challengeRate: v maxChallengeRatePerKey,
2199 challengeRate: v maxChallengeRatePerKey,
2220 pairRate: v maxPairRatePerPair,
2200 pairRate: v maxPairRatePerPair,
2221− lookupRate: v maxLookupRatePerKey,
2201+ lookupRate: v maxLookupRatePerKey
2222− clientWriteRate: v maxClientWriteRatePerKey
2225-- GET /metrics: Prometheus-style text exposition of the most useful gauges.
2204-- GET /metrics: Prometheus-style text exposition of the most useful gauges.
@@ -2280,7 +2259,7 @@ api = serve Api where
2280 AdminPurgeMessages = \{pubkey, authorization} -> handleAdminPurgeMessages pubkey authorization
2259 AdminPurgeMessages = \{pubkey, authorization} -> handleAdminPurgeMessages pubkey authorization
2281 AdminRevokeIp = \{ip, authorization} -> handleAdminRevokeIp ip authorization
2260 AdminRevokeIp = \{ip, authorization} -> handleAdminRevokeIp ip authorization
2282 GetRateLimits = \{authorization} -> handleGetRateLimits authorization
2261 GetRateLimits = \{authorization} -> handleGetRateLimits authorization
2283− SetRateLimits = \{globalRequest, ipRate, sendRate, federationRate, authGlobal, recvRate, challengeRate, pairRate, lookupRate, clientWriteRate, authorization} -> handleSetRateLimits globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization
2262+ SetRateLimits = \{globalRequest, ipRate, sendRate, federationRate, authGlobal, recvRate, challengeRate, pairRate, lookupRate, authorization} -> handleSetRateLimits globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate authorization
2284 FlushNonces = \{authorization} -> handleFlushNonces authorization
2263 FlushNonces = \{authorization} -> handleFlushNonces authorization
2285 AllowPeer = \{server, authorization} -> handleAllowPeer server authorization
2264 AllowPeer = \{server, authorization} -> handleAllowPeer server authorization
2286 UnallowPeer = \{server, authorization} -> handleUnallowPeer server authorization
2265 UnallowPeer = \{server, authorization} -> handleUnallowPeer server authorization