@@ -669,35 +669,35 @@ withMaintAuth = \authorization onUnauth onAuth -> do
669669
670670-- Common gate for handlers: global rate, session auth.
671671-- mkErr is called with one of: "rate_limited", "unauthorized".
672−gateAuth : Text -> Text -> Timestamp -> (resp -> ret) -> (Text -> resp) -> (PubkeyHex -> IO {} ret) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} ret
673−gateAuth = \auth ip t respond mkErr onAuth -> do
672+gateAuth : Text -> Text -> Timestamp -> (Text -> resp) -> (PubkeyHex -> IO {} resp) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} resp
673+gateAuth = \auth ip t mkErr onAuth -> do
674674 g <- checkGlobalRate t
675− let err = \e -> yield (respond (mkErr e))
675+ let err = \e -> yield (mkErr e)
676676 if g then err "rate_limited" else withSessionAuth auth t ip (err "unauthorized") onAuth
677677
678678-- gateAuth + per-key rate gate. `rateResp` is the response value when the per-key gate trips.
679−gateClientWrite : Text -> Text -> Int<Ms> -> (a -> b) -> (Text -> a) -> a -> (Text -> IO {} b) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} b
680−gateClientWrite = \auth ip t respond mkErr rateResp onAuth ->
681− gateAuth auth ip t respond mkErr (\pk -> do
679+gateClientWrite : Text -> Text -> Int<Ms> -> (Text -> a) -> a -> (Text -> IO {} a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} a
680+gateClientWrite = \auth ip t mkErr rateResp onAuth ->
681+ gateAuth auth ip t mkErr (\pk -> do
682682 lim <- atomic do
683683 rates <- *clientWriteRates
684684 let r = checkRate rates pk maxClientWriteRatePerKey clientWriteRateWindowMs t
685685 -- TODO: make this no be a `replace`
686686 *clientWriteRates = r.entries
687687 yield r.limited
688− if lim then yield (respond rateResp) else onAuth pk)
688+ if lim then yield rateResp else onAuth pk)
689689
690690-- Variant of `gateClientWrite` that uses the per-key lookup-rate window instead.
691−gateLookup : Text -> Text -> Int<Ms> -> (a -> b) -> (Text -> a) -> a -> (Text -> IO {} b) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} b
692−gateLookup = \auth ip t respond mkErr rateResp onAuth ->
693− gateAuth auth ip t respond mkErr (\pk -> do
691+gateLookup : Text -> Text -> Int<Ms> -> (Text -> a) -> a -> (Text -> IO {} a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions} a
692+gateLookup = \auth ip t mkErr rateResp onAuth ->
693+ gateAuth auth ip t mkErr (\pk -> do
694694 lim <- atomic do
695695 rates <- *lookupRates
696696 let r = checkRate rates pk maxLookupRatePerKey lookupRateWindowMs t
697697 -- TODO: make this no be a `replace`
698698 *lookupRates = r.entries
699699 yield r.limited
700− if lim then yield (respond rateResp) else onAuth pk)
700+ if lim then yield rateResp else onAuth pk)
701701
702702-- Resolve a Bearer token to its session pubkey if the session is unexpired and
703703-- the client IP matches. Runs `onAuth pubkey` on success, `onUnauth` otherwise.
@@ -755,10 +755,10 @@ verifyFederationAuth = \authorization fromServer scope requestTimestamp -> do
755755-- 2. peer not block-listed; 3. peer in allow-list (if any); 4. caller-supplied
756756-- `precondition` holds; 5. clock skew within `clockSkewTolerance`;
757757-- 6. Ed25519 signature verifies; 7. per-peer federation rate limit.
758−withFederationAuth = \authorization t respond fromServer scope requestTimestamp precondition action -> do
758+withFederationAuth = \authorization t mkErr fromServer scope requestTimestamp precondition action -> do
759759 blocked <- *blockedPeers
760760 allowed <- *allowedPeers
761− let err = \e r -> yield (respond {ok: False {}, error: e, retryAfterMs: r})
761+ let err = \e r -> yield (mkErr e r)
762762 let preErr = if isBadServerName fromServer
763763 then "invalid_request"
764764 else if elem fromServer blocked
@@ -1124,14 +1124,14 @@ refreshLocalPresence = \t -> do
11241124-- POST /auth/challenge: issue a fresh signed-nonce challenge for `pubkey`.
11251125-- Capped per-key (maxChallengesPerKey) and rate-limited; the IP is recorded
11261126-- so /auth/verify can require the same client.
1127−handleChallenge : PubkeyHex -> Text -> ({challenge: Text, error: Text, expiresAt: Int, ok: Bool, retryAfterMs: Int} -> a) -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *challengeRates, rw *challenges, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates, clock, random} a
1128−handleChallenge = \pubkey clientIp respond -> do
1127+handleChallenge : PubkeyHex -> Text -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *challengeRates, rw *challenges, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates, clock, random} {challenge: Text, error: Text, expiresAt: Int, ok: Bool, retryAfterMs: Int}
1128+handleChallenge = \pubkey clientIp -> do
11291129 t <- now
11301130 preErr <- if requireClientIp && clientIp == ""
11311131 then yield "client_ip_required"
11321132 else authPreCheck clientIp t
11331133 if preErr != ""
1134− then yield (respond {challenge: "", ok: False {}, expiresAt: 0, retryAfterMs: 0, error: preErr})
1134+ then yield {challenge: "", ok: False {}, expiresAt: 0, retryAfterMs: 0, error: preErr}
11351135 else do
11361136 challenge <- genToken
11371137 result <- atomic (do
@@ -1150,24 +1150,24 @@ handleChallenge = \pubkey clientIp respond -> do
11501150 {pubkey, challenge, expiresAt: t + challengeExpiry, ip: clientIp}
11511151 ]
11521152 yield {ok: True {}, error: ""})
1153− yield (respond {
1153+ yield {
11541154 challenge: if result.ok then challenge else "",
11551155 result.ok,
11561156 expiresAt: if result.ok then t + challengeExpiry else 0,
11571157 retryAfterMs: 0,
11581158 result.error
1159− })
1159+ }
11601160
11611161-- POST /auth/verify: validate `signature` over `challenge` for `pubkey`.
11621162-- On success, mints a session token, records local presence (`pubkey` is now
11631163-- live on this server), and gossips an `online` event to known peers. If
11641164-- `revokeOthers` is set, all other sessions for the same pubkey are dropped.
1165−handleVerifyAuth : PubkeyHex -> Text -> Text -> Bool -> Text -> ({error: Text, expiresAt: Int, token: Text} -> a) -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *challenges, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates, rw *presence, rw *sessions, clock, random} a
1166−handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp respond -> do
1165+handleVerifyAuth : PubkeyHex -> Text -> Text -> Bool -> Text -> IO {rw *authGlobalRateCount, rw *authGlobalRateWindowStart, rw *challenges, rw *globalRateCount, rw *globalRateWindowStart, rw *ipRates, rw *presence, rw *sessions, clock, random} {error: Text, expiresAt: Int, token: Text}
1166+handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do
11671167 t <- now
11681168 preErr <- authPreCheck clientIp t
11691169 if preErr != ""
1170− then yield (respond {token: "", expiresAt: 0, error: preErr})
1170+ then yield {token: "", expiresAt: 0, error: preErr}
11711171 else do
11721172 let expiry = t + sessionExpiry
11731173 token <- genToken
@@ -1197,30 +1197,30 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp respond ->
11971197 *presence = newPres
11981198 yield {valid: True {}, peers: knownPeerServersFromPresence newPres})
11991199 if not result.valid
1200− then yield (respond {token: "", expiresAt: 0, error: "invalid"})
1200+ then yield {token: "", expiresAt: 0, error: "invalid"}
12011201 else do
12021202 when federationEnabled (fork (sendBatchedGossip result.peers [
12031203 mkGossip (GossipOnline {}) pubkey
12041204 ]))
1205− yield (respond {token, expiresAt: expiry, error: ""})
1205+ yield {token, expiresAt: expiry, error: ""}
12061206
12071207-- POST /auth/revoke: caller (any session for the pubkey) revokes a sibling
12081208-- session by token. Returns ok=False if no such sibling existed.
1209−handleRevoke : Text -> Text -> Text -> ({authorized: Bool, ok: Bool} -> a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} a
1210−handleRevoke = \targetToken authorization clientIp respond -> do
1209+handleRevoke : Text -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, ok: Bool}
1210+handleRevoke = \targetToken authorization clientIp -> do
12111211 t <- now
1212− gateAuth authorization clientIp t respond (\_ -> {ok: False {}, authorized: False {}}) (\caller -> do
1212+ gateAuth authorization clientIp t (\_ -> {ok: False {}, authorized: False {}}) (\caller -> do
12131213 result <- atomic (do
12141214 ses <- *sessions
12151215 let pred = \s -> s.pubkey == caller && s.token == targetToken
12161216 *sessions = removeWhere ses pred
12171217 yield (any ses pred))
1218− yield (respond {ok: result, authorized: True {}}))
1218+ yield {ok: result, authorized: True {}})
12191219
12201220-- POST /auth/logout: drop the caller's own session. If this was the last
12211221-- session for the pubkey, also clear local presence and gossip offline.
1222−handleLogout : Text -> Text -> ({authorized: Bool, ok: Bool} -> a) -> IO {rw *presence, rw *sessions, clock} a
1223−handleLogout = \authorization clientIp respond -> do
1222+handleLogout : Text -> Text -> IO {rw *presence, rw *sessions, clock} {authorized: Bool, ok: Bool}
1223+handleLogout = \authorization clientIp -> do
12241224 t <- now
12251225 let myToken = case extractToken authorization of
12261226 Just {value: tk} -> tk
@@ -1243,7 +1243,7 @@ handleLogout = \authorization clientIp respond -> do
12431243 when (removed.ok && federationEnabled) (fork (sendBatchedGossip removed.peers [
12441244 mkGossip (GossipOffline {}) removed.pubkey
12451245 ]))
1246− yield (respond {removed.ok, authorized: removed.ok})
1246+ yield {removed.ok, authorized: removed.ok}
12471247
12481248-- ============================================
12491249-- Handler: poll
@@ -1259,29 +1259,29 @@ handleLogout = \authorization clientIp respond -> do
12591259-- POST /poll: top-level dispatch. Validates the global rate gate, detects a
12601260-- generation mismatch (server restart) to force a cursor reset, then hands
12611261-- off to `pollOnce` for the actual long-poll body.
1262−handlePoll : Int -> Int -> Text -> Text -> ({authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, rateLimited: Bool, retryAfterMs: Int} -> Response) -> IO {r *pollWakeup, r *serverGeneration, r *sessions, rw *activePolls, rw *forwards, rw *globalRateCount, rw *globalRateWindowStart, rw *messages, clock} Response
1263−handlePoll = \cursor generation authorization clientIp respond -> do
1262+handlePoll : Int -> Int -> Text -> Text -> IO {r *pollWakeup, r *serverGeneration, r *sessions, rw *activePolls, rw *forwards, rw *globalRateCount, rw *globalRateWindowStart, rw *messages, clock} {authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, rateLimited: Bool, retryAfterMs: Int}
1263+handlePoll = \cursor generation authorization clientIp -> do
12641264 t <- now
12651265 serverGen <- *serverGeneration
12661266 g <- checkGlobalRate t
12671267 let cursorWasReset = generation != serverGen && cursor > 0
1268− let er = \auth rate retryRate -> yield (respond (emptyPollResp 0 auth rate serverGen retryRate cursorWasReset))
1268+ let er = \auth rate retryRate -> yield (emptyPollResp 0 auth rate serverGen retryRate cursorWasReset)
12691269 if g
12701270 then er (False {}) (True {}) globalRateWindowMs
1271− else pollOnce authorization (if cursorWasReset then 0 else cursor) cursorWasReset clientIp serverGen respond t
1271+ else pollOnce authorization (if cursorWasReset then 0 else cursor) cursorWasReset clientIp serverGen t
12721272
12731273-- Body of a single poll. Treats the cursor advance as an implicit ack
12741274-- (`ackPolledMessages`), acquires a per-pubkey poll slot, runs `doPoll` to
12751275-- collect events (or block until wakeup), then assembles the response.
1276−pollOnce : Text -> Int -> Bool -> Text -> Int -> ({authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, rateLimited: Bool, retryAfterMs: Int} -> Response) -> Int<Ms> -> IO {r *pollWakeup, r *sessions, rw *activePolls, rw *forwards, rw *messages, clock} Response
1277−pollOnce = \authorization cursor cursorWasReset clientIp serverGen respond t -> do
1276+pollOnce : Text -> Int -> Bool -> Text -> Int -> Int<Ms> -> IO {r *pollWakeup, r *sessions, rw *activePolls, rw *forwards, rw *messages, clock} {authorized: Bool, cursor: Timestamp, cursorReset: Bool, cursorStale: Bool, events: [PollEvent], generation: Int, hasMore: Bool, heartbeat: Bool, loadPct: Int, rateLimited: Bool, retryAfterMs: Int}
1277+pollOnce = \authorization cursor cursorWasReset clientIp serverGen t -> do
12781278 setup <- atomic withSessionAuth authorization t clientIp (yield (Nothing {})) (\pubkey -> do
12791279 let clampedCursor = clamp 0 t cursor
12801280 when (clampedCursor > 0) (ackPolledMessages pubkey clampedCursor)
12811281 startWakeup <- *pollWakeup
12821282 yield (Just {value: {pubkey, clampedCursor, startWakeup}}))
12831283 case setup of
1284− Nothing {} -> yield (respond (emptyPollResp 0 (False {}) (False {}) serverGen 0 cursorWasReset))
1284+ Nothing {} -> yield (emptyPollResp 0 (False {}) (False {}) serverGen 0 cursorWasReset)
12851285 Just {value: s} -> do
12861286 acquired <- atomic (do
12871287 aps <- *activePolls
@@ -1291,11 +1291,11 @@ pollOnce = \authorization cursor cursorWasReset clientIp serverGen respond t ->
12911291 *activePolls = union aps [{s.pubkey, startedAt: t}]
12921292 yield (True {}))
12931293 if not acquired
1294− then yield (respond (emptyPollResp cursor (True {}) (True {}) serverGen pollTimeoutMs cursorWasReset))
1294+ then yield (emptyPollResp cursor (True {}) (True {}) serverGen pollTimeoutMs cursorWasReset)
12951295 else do
12961296 pollResult <- doPoll s t
12971297 atomic (do aps <- *activePolls; *activePolls = filter aps (\p -> p.pubkey != s.pubkey))
1298− yield (respond {
1298+ yield {
12991299 pollResult.events,
13001300 pollResult.cursor,
13011301 authorized: True {},
@@ -1307,7 +1307,7 @@ pollOnce = \authorization cursor cursorWasReset clientIp serverGen respond t ->
13071307 pollResult.hasMore,
13081308 cursorStale: False {},
13091309 loadPct: 0
1310− })
1310+ }
13111311
13121312-- One pass: collect events at `t`. If empty, retry-wait on `pollWakeup`
13131313-- (bumped by send/heartbeat) and re-collect once at the new wall time.
@@ -1358,17 +1358,17 @@ ackPolledMessages = \pubkey cursor -> do
13581358-- the rest; federated forwards are forked per entry. Top-level `error`
13591359-- carries global gate failures ("rate_limited" | "unauthorized") and
13601360-- short-circuits with empty `results`.
1361−handleSendMessages : [{encryptedBlob: BlobHex, to: PubkeyHex | a}] -> Text -> Text -> ({error: Text, results: [{error: Text, messageId: MessageIdHex}], retryAfterMs: Int} -> b) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} b
1362−handleSendMessages = \messages authorization clientIp respond -> do
1361+handleSendMessages : [{encryptedBlob: BlobHex, to: PubkeyHex | a}] -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {error: Text, results: [{error: Text, messageId: MessageIdHex}], retryAfterMs: Int}
1362+handleSendMessages = \messages authorization clientIp -> do
13631363 t <- now
13641364 let mkErr = \e -> {results: [], error: e, retryAfterMs: 0}
1365− gateAuth authorization clientIp t respond mkErr (\senderKey -> do
1365+ gateAuth authorization clientIp t mkErr (\senderKey -> do
13661366 results <- mapEach (takeRelation maxBatchSize messages) (\m -> do
13671367 let effMsgId = messageIdOf m.encryptedBlob
13681368 r <- atomic (do sendMessageCore senderKey m.to m.encryptedBlob t)
13691369 when federationEnabled (fork (forkForwardsTo m.to m.encryptedBlob r.remoteServers))
13701370 yield {messageId: effMsgId, r.error})
1371− yield (respond {results, error: "", retryAfterMs: 0}))
1371+ yield {results, error: "", retryAfterMs: 0})
13721372
13731373-- Atomic core of /messages. Charges send/pair/recv rate
13741374-- counters together (so any limit denies the message), enforces caps and
@@ -1470,45 +1470,41 @@ forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
14701470-- GET /lookup/{pubkey}: return our local server name if the key is here,
14711471-- "remote" if known on a peer, "" otherwise. Peer hostnames are deliberately
14721472-- masked (see section header).
1473−handleLookupPresence : PubkeyHex -> Text -> Text -> ({authorized: Bool, error: Text, server: Text} -> a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} a
1474−handleLookupPresence = \pubkey authorization clientIp respond -> do
1473+handleLookupPresence : PubkeyHex -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, error: Text, server: Text}
1474+handleLookupPresence = \pubkey authorization clientIp -> do
14751475 t <- now
14761476 let mkErr = \e -> {server: "", authorized: False {}, error: if e == "rate_limited" then e else ""}
1477− gateLookup authorization clientIp t respond mkErr {
1478− server: "",
1479− authorized: True {},
1480− error: "rate_limited"
1481− } (\_ -> do
1477+ gateLookup authorization clientIp t mkErr {server: "", authorized: True {}, error: "rate_limited"} (\_ -> do
14821478 pres <- *presence
1483− yield (respond {server: maskedServer pres pubkey t, authorized: True {}, error: ""}))
1479+ yield {server: maskedServer pres pubkey t, authorized: True {}, error: ""})
14841480
14851481-- POST /lookup/batch: same masking as `handleLookupPresence`, but for up to
14861482-- 50 pubkeys in one round-trip.
1487−handleBatchLookupPresence : [PubkeyHex] -> Text -> Text -> ({authorized: Bool, error: Text, results: [{pubkey: PubkeyHex, server: Text}]} -> a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} a
1488−handleBatchLookupPresence = \pubkeys authorization clientIp respond -> do
1483+handleBatchLookupPresence : [PubkeyHex] -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, error: Text, results: [{pubkey: PubkeyHex, server: Text}]}
1484+handleBatchLookupPresence = \pubkeys authorization clientIp -> do
14891485 t <- now
14901486 let mkErr = \e -> {
14911487 results: [],
14921488 authorized: False {},
14931489 error: if e == "rate_limited" then e else ""
14941490 }
1495− gateLookup authorization clientIp t respond mkErr {
1491+ gateLookup authorization clientIp t mkErr {
14961492 results: [],
14971493 authorized: True {},
14981494 error: "rate_limited"
14991495 } (\_ -> do
15001496 pres <- *presence
15011497 let results = pluck (takeRelation 50 pubkeys) (\k -> {pubkey: k, server: maskedServer pres k t})
1502− yield (respond {results, authorized: True {}, error: ""}))
1498+ yield {results, authorized: True {}, error: ""})
15031499
15041500-- POST /messages/status: classify a message as
15051501-- pending (in mailbox), forwarding (en-route to a peer),
15061502-- delivered (acked or terminal), or unknown.
1507−handleMessageStatus : PubkeyHex -> MessageIdHex -> Text -> Text -> ({authorized: Bool, status: Text} -> a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} a
1508−handleMessageStatus = \to messageId authorization clientIp respond -> do
1503+handleMessageStatus : PubkeyHex -> MessageIdHex -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, status: Text}
1504+handleMessageStatus = \to messageId authorization clientIp -> do
15091505 t <- now
15101506 let mkErr = \_ -> {status: "", authorized: False {}}
1511− gateAuth authorization clientIp t respond mkErr (\_ -> do
1507+ gateAuth authorization clientIp t mkErr (\_ -> do
15121508 msgs <- *messages
15131509 fwds <- *forwards
15141510 dids <- *deliveredIds
@@ -1519,7 +1515,7 @@ handleMessageStatus = \to messageId authorization clientIp respond -> do
15191515 else if any fwds blobMatches
15201516 then "forwarding"
15211517 else if any dids didMatches then "delivered" else "unknown"
1522− yield (respond {status: s, authorized: True {}}))
1518+ yield {status: s, authorized: True {}})
15231519
15241520-- ============================================
15251521-- Handler: ack / list / delete
@@ -1528,11 +1524,11 @@ handleMessageStatus = \to messageId authorization clientIp respond -> do
15281524
15291525-- POST /messages/ack: explicit ack by message id (alternative to the implicit
15301526-- cursor-based ack in /poll). Drops mailbox+forward rows.
1531−handleAckMessages : [MessageIdHex] -> Text -> Text -> ({ackedCount: Int, authorized: Bool, error: Text, ok: Bool} -> a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} a
1532−handleAckMessages = \messageIds authorization clientIp respond -> do
1527+handleAckMessages : [MessageIdHex] -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {ackedCount: Int, authorized: Bool, error: Text, ok: Bool}
1528+handleAckMessages = \messageIds authorization clientIp -> do
15331529 t <- now
15341530 let mkErr = \e -> {ok: False {}, authorized: False {}, ackedCount: 0, error: e}
1535− gateClientWrite authorization clientIp t respond mkErr {
1531+ gateClientWrite authorization clientIp t mkErr {
15361532 ok: False {},
15371533 authorized: True {},
15381534 ackedCount: 0,
@@ -1541,12 +1537,12 @@ handleAckMessages = \messageIds authorization clientIp respond -> do
15411537 ackedCount <- atomic (do
15421538 toAck <- removeForKey (\x -> x.toKey == pubkey && elem (messageIdOf x.encryptedBlob) (dedupMessageIds messageIds))
15431539 yield (count toAck))
1544− yield (respond {ok: True {}, authorized: True {}, ackedCount, error: ""}))
1540+ yield {ok: True {}, authorized: True {}, ackedCount, error: ""})
15451541
15461542-- POST /messages/list: paginated peek at the caller's mailbox without acking.
15471543-- Returns metadata only (no ciphertext) plus the total count.
1548−handleListMessages : Int -> Text -> Text -> ({authorized: Bool, count: Int, error: Text, messages: [{messageId: MessageIdHex, receivedAt: Int<Ms>}]} -> a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} a
1549−handleListMessages = \offset authorization clientIp respond -> do
1544+handleListMessages : Int -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, count: Int, error: Text, messages: [{messageId: MessageIdHex, receivedAt: Int<Ms>}]}
1545+handleListMessages = \offset authorization clientIp -> do
15501546 t <- now
15511547 let mkErr = \e -> {
15521548 messages: [],
@@ -1554,14 +1550,14 @@ handleListMessages = \offset authorization clientIp respond -> do
15541550 count: 0,
15551551 error: if e == "rate_limited" then e else ""
15561552 }
1557− gateAuth authorization clientIp t respond mkErr (\pubkey -> do
1553+ gateAuth authorization clientIp t mkErr (\pubkey -> do
15581554 lim <- atomic (do
15591555 rates <- *lookupRates
15601556 let r = checkRate rates pubkey maxLookupRatePerKey lookupRateWindowMs t
15611557 *lookupRates = r.entries
15621558 yield r.limited)
15631559 if lim
1564− then yield (respond {messages: [], authorized: True {}, count: 0, error: "rate_limited"})
1560+ then yield {messages: [], authorized: True {}, count: 0, error: "rate_limited"}
15651561 else do
15661562 msgs <- *messages
15671563 let myMsgs = sortBy (\m -> m.receivedAt) (filter msgs (\m -> m.toKey == pubkey && t - m.receivedAt < messageMaxAge))
@@ -1570,15 +1566,15 @@ handleListMessages = \offset authorization clientIp respond -> do
15701566 messageId: messageIdOf m.encryptedBlob,
15711567 m.receivedAt
15721568 })
1573− yield (respond {messages: page, authorized: True {}, count: total, error: ""}))
1569+ yield {messages: page, authorized: True {}, count: total, error: ""})
15741570
15751571-- POST /messages/delete: same effect as ack from the recipient's side, with
15761572-- a "delete" semantic for the response.
1577−handleDeleteMessages : [MessageIdHex] -> Text -> Text -> ({authorized: Bool, deletedCount: Int, error: Text, ok: Bool} -> a) -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} a
1578−handleDeleteMessages = \messageIds authorization clientIp respond -> do
1573+handleDeleteMessages : [MessageIdHex] -> Text -> Text -> IO {rw *globalRateCount, rw *globalRateWindowStart, r *sessions, clock} {authorized: Bool, deletedCount: Int, error: Text, ok: Bool}
1574+handleDeleteMessages = \messageIds authorization clientIp -> do
15791575 t <- now
15801576 let mkErr = \e -> {ok: False {}, authorized: False {}, deletedCount: 0, error: e}
1581− gateClientWrite authorization clientIp t respond mkErr {
1577+ gateClientWrite authorization clientIp t mkErr {
15821578 ok: False {},
15831579 authorized: True {},
15841580 deletedCount: 0,
@@ -1587,7 +1583,7 @@ handleDeleteMessages = \messageIds authorization clientIp respond -> do
15871583 deletedCount <- atomic (do
15881584 toDel <- removeForKey (\x -> x.toKey == pubkey && elem (messageIdOf x.encryptedBlob) (dedupMessageIds messageIds))
15891585 yield (count toDel))
1590− yield (respond {ok: True {}, authorized: True {}, deletedCount, error: ""}))
1586+ yield {ok: True {}, authorized: True {}, deletedCount, error: ""})
15911587
15921588-- ============================================
15931589-- Handler: federation receive
@@ -1600,10 +1596,10 @@ handleDeleteMessages = \messageIds authorization clientIp respond -> do
16001596-- GET /federation/pubkey: publish the Ed25519 public key peers should use to
16011597-- verify our `Signed ...` federation auth headers. Returns ok=False when the
16021598-- keypair has not yet been generated (should not happen post-startup).
1603−handleFederationPubkey : ({pubkey: Text, ok: Bool} -> ret) -> IO {r *federationPublicKeyHex} ret
1604−handleFederationPubkey = \respond -> do
1599+handleFederationPubkey : IO {r *federationPublicKeyHex} {pubkey: Text, ok: Bool}
1600+handleFederationPubkey = do
16051601 hex <- *federationPublicKeyHex
1606− yield (respond {pubkey: hex, ok: hex != ""})
1602+ yield {pubkey: hex, ok: hex != ""}
16071603
16081604-- POST /federation/gossip: ingest peer presence events. The transport-level
16091605-- `fromServer` is the home server for every event. Drops every (pubkey,
@@ -1611,10 +1607,10 @@ handleFederationPubkey = \respond -> do
16111607-- pubkeys with a `GossipOnline` event (so Online wins on collision). For keys
16121608-- that transition offline → online, flushes any locally-buffered messages via
16131609-- `forwardQueuedToServer`.
1614−handleRecvGossip : [{eventType: <GossipOffline {} | GossipOnline {} | a>, pubkey: PubkeyHex | b}] -> Text -> Int -> Text -> ({error: Text, ok: Bool, retryAfterMs: Int} -> c) -> IO {r *allowedPeers, r *blockedPeers, rw *federationRates, rw *presence, clock, network} c
1615−handleRecvGossip = \events fromServer requestTimestamp authorization respond -> do
1610+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}
1611+handleRecvGossip = \events fromServer requestTimestamp authorization -> do
16161612 t <- now
1617− withFederationAuth authorization t respond fromServer "gossip" requestTimestamp (isRemote fromServer && count events <= maxGossipEvents) (do
1613+ withFederationAuth authorization t (\e r -> {ok: False {}, error: e, retryAfterMs: r}) fromServer "gossip" requestTimestamp (isRemote fromServer && count events <= maxGossipEvents) (do
16181614 newlyOnline <- atomic (do
16191615 pres <- *presence
16201616 let touchedPubkeys = pluck events (\e -> e.pubkey)
@@ -1626,7 +1622,7 @@ handleRecvGossip = \events fromServer requestTimestamp authorization respond ->
16261622 *presence = union kept added
16271623 yield (filter onlinePubkeys (\pk -> none pres (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t))))
16281624 fork (forEach newlyOnline (\pk -> forwardQueuedToServer pk fromServer))
1629− yield (respond {ok: True {}, error: "", retryAfterMs: 0}))
1625+ yield {ok: True {}, error: "", retryAfterMs: 0})
16301626
16311627-- Store a federated/forwarded message into the local mailbox. Caller wraps in `atomic`.
16321628-- Returns "" on success (including duplicates), otherwise an error code:
@@ -1671,28 +1667,27 @@ storeFederated = \toKey encryptedBlob checkRecvRate t -> do
16711667-- the blob ourselves so a hostile peer cannot bypass dedup by varying the
16721668-- id. Honest senders derive the same value, so the "forward:" ++ messageId
16731669-- auth scope still verifies.
1674−handleForwardMessage : PubkeyHex -> BlobHex -> Text -> Text -> Int -> Text -> ({error: Text, ok: Bool, retryAfterMs: Int} -> a) -> IO {r *allowedPeers, r *blockedPeers, rw *federationRates, r *deliveredIds, rw *messages, rw *pollWakeup, r *presence, rw *recvRates, rw *seqCounter, clock, network} a
1675−handleForwardMessage = \toKey encryptedBlob _ fromServer requestTimestamp authorization respond -> do
1670+handleForwardMessage : PubkeyHex -> BlobHex -> Text -> Text -> Int -> Text -> IO {r *allowedPeers, r *blockedPeers, rw *federationRates, r *deliveredIds, rw *messages, rw *pollWakeup, r *presence, rw *recvRates, rw *seqCounter, clock, network} {error: Text, ok: Bool, retryAfterMs: Int}
1671+handleForwardMessage = \toKey encryptedBlob _ fromServer requestTimestamp authorization -> do
16761672 let messageId = messageIdOf encryptedBlob
16771673 t <- now
1678− withFederationAuth authorization t respond fromServer ("forward:" ++ messageId) requestTimestamp (isRemote fromServer) (do
1674+ withFederationAuth authorization t (\e r -> {ok: False {}, error: e, retryAfterMs: r}) fromServer ("forward:" ++ messageId) requestTimestamp (isRemote fromServer) (do
16791675 result <- atomic storeFederated toKey encryptedBlob (True {}) t
1680− yield (respond {ok: result == "", error: result, retryAfterMs: 0}))
1676+ yield {ok: result == "", error: result, retryAfterMs: 0})
16811677
16821678-- POST /federation/forward-batch: bulk variant of `handleForwardMessage`.
16831679-- Skips per-entry recv-rate charging (the per-server federation rate limit
16841680-- already gates the call as a whole).
1685−handleFederationBatchForward : [{encryptedBlob: BlobHex, messageId: MessageIdHex, toKey: PubkeyHex | a}] -> Text -> Int -> Text -> ({error: Text, ok: Bool, results: [{messageId: MessageIdHex, ok: Bool}], retryAfterMs: Int} -> b) -> IO {r *allowedPeers, r *blockedPeers, rw *federationRates, clock, network} b
1686−handleFederationBatchForward = \forwards fromServer requestTimestamp authorization respond -> do
1681+handleFederationBatchForward : [{encryptedBlob: BlobHex, messageId: MessageIdHex, toKey: PubkeyHex | a}] -> Text -> Int -> Text -> IO {r *allowedPeers, r *blockedPeers, rw *federationRates, clock, network} {error: Text, ok: Bool, results: [{messageId: MessageIdHex, ok: Bool}], retryAfterMs: Int}
1682+handleFederationBatchForward = \forwards fromServer requestTimestamp authorization -> do
16871683 t <- now
1688− let batchRespond = \r -> respond {r.ok, r.error, results: [], r.retryAfterMs}
1689− withFederationAuth authorization t batchRespond fromServer "forward-batch" requestTimestamp (isRemote fromServer && count forwards <= maxBatchSize) (do
1684+ withFederationAuth authorization t (\e r -> {ok: False {}, error: e, results: [], retryAfterMs: r}) fromServer "forward-batch" requestTimestamp (isRemote fromServer && count forwards <= maxBatchSize) (do
16901685 results <- mapEach (takeRelation maxBatchSize forwards) (\e -> do
16911686 -- Recompute id from blob; ignore e.messageId (untrusted, peer-chosen).
16921687 let messageId = messageIdOf e.encryptedBlob
16931688 result <- atomic storeFederated e.toKey e.encryptedBlob (False {}) t
16941689 yield {messageId, ok: result == ""})
1695− yield (respond {ok: True {}, error: "", results, retryAfterMs: 0}))
1690+ yield {ok: True {}, error: "", results, retryAfterMs: 0})
16961691
16971692-- ============================================
16981693-- Maintenance handlers
@@ -1705,25 +1700,25 @@ handleFederationBatchForward = \forwards fromServer requestTimestamp authorizati
17051700-- POST /maintenance/prune: trigger an out-of-band `pruneAndRetry` tick.
17061701-- Useful when the operator wants to force expiry/forward retries without
17071702-- waiting for the next `backgroundPrune` interval.
1708−handlePrune : Text -> ({ok: Bool} -> a) -> IO {r *runtimeMaintenanceSecret, rw *activePolls, r *blockedPeers, rw *challenges, rw *deliveredIds, rw *forwardFailures, r *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *sessions, clock} a
1709−handlePrune = \authorization respond -> do
1703+handlePrune : Text -> IO {r *runtimeMaintenanceSecret, rw *activePolls, r *blockedPeers, rw *challenges, rw *deliveredIds, rw *forwardFailures, r *forwards, rw *lastPresenceRefresh, rw *lastPrunedAt, rw *messages, rw *presence, rw *sessions, clock} {ok: Bool}
1704+handlePrune = \authorization -> do
17101705 t <- now
17111706 authorized <- verifyMaintenanceAuth authorization
17121707 when authorized (fork (pruneAndRetry t))
1713− yield (respond {ok: authorized})
1708+ yield {ok: authorized}
17141709
17151710-- POST /maintenance/reconcile: stub. Production builds run a state
17161711-- reconciliation pass here; this simplified server reports zero drift.
1717−handleReconcile : Text -> ({messageDrift: Int, ok: Bool, presenceDrift: Int, sessionDrift: Int} -> a) -> IO {r *runtimeMaintenanceSecret} a
1718−handleReconcile = \authorization respond -> do
1712+handleReconcile : Text -> IO {r *runtimeMaintenanceSecret} {messageDrift: Int, ok: Bool, presenceDrift: Int, sessionDrift: Int}
1713+handleReconcile = \authorization -> do
17191714 authorized <- verifyMaintenanceAuth authorization
1720− yield (respond {ok: authorized, messageDrift: 0, presenceDrift: 0, sessionDrift: 0})
1715+ yield {ok: authorized, messageDrift: 0, presenceDrift: 0, sessionDrift: 0}
17211716
17221717-- GET /health: aggregate readiness flags. During an initial warmup window
17231718-- (3 prune intervals after startup) prune/heartbeat checks always pass to
17241719-- avoid false negatives before the background loops have ticked.
1725−handleHealth : a -> ({capacityHealthy: Bool, capacityWarning: Bool, degradedPeers: Int, federationHealthy: Bool, forwardQueueHealthy: Bool, heartbeatHealthy: Bool, nonceHealthy: Bool, ok: Bool, pruneHealthy: Bool, requestPressureHealthy: Bool, version: Text, watchdogHealthy: Bool} -> b) -> IO {r *lastHeartbeatAt, r *lastPrunedAt, r *startedAt, clock} b
1726−handleHealth = \authorization respond -> do
1720+handleHealth : a -> IO {r *lastHeartbeatAt, r *lastPrunedAt, r *startedAt, clock} {capacityHealthy: Bool, capacityWarning: Bool, degradedPeers: Int, federationHealthy: Bool, forwardQueueHealthy: Bool, heartbeatHealthy: Bool, nonceHealthy: Bool, ok: Bool, pruneHealthy: Bool, requestPressureHealthy: Bool, version: Text, watchdogHealthy: Bool}
1721+handleHealth = \authorization -> do
17271722 t <- now
17281723 lastPrune <- *lastPrunedAt
17291724 lastHb <- *lastHeartbeatAt
@@ -1731,7 +1726,7 @@ handleHealth = \authorization respond -> do
17311726 let warmup = t - sa < backgroundPruneInterval * 3
17321727 let pruneOk = warmup || t - lastPrune < backgroundPruneInterval * 3
17331728 let heartbeatOk = warmup || t - lastHb < pollTimeoutMs * 3
1734− yield (respond {
1729+ yield {
17351730 ok: pruneOk && heartbeatOk,
17361731 version: serverBuildVersion,
17371732 pruneHealthy: pruneOk,
@@ -1744,94 +1739,94 @@ handleHealth = \authorization respond -> do
17441739 forwardQueueHealthy: True {},
17451740 requestPressureHealthy: True {},
17461741 degradedPeers: 0
1747− })
1742+ }
17481743
17491744-- GET /ready: signals readiness once the first background prune has run
17501745-- (load-balancer / orchestrator probe).
1751−handleReady : ({ready: Bool} -> a) -> IO {r *lastPrunedAt, r *startedAt} a
1752−handleReady = \respond -> do
1746+handleReady : IO {r *lastPrunedAt, r *startedAt} {ready: Bool}
1747+handleReady = do
17531748 sa <- *startedAt
17541749 lastPrune <- *lastPrunedAt
1755− yield (respond {ready: lastPrune > 0 && lastPrune >= sa})
1750+ yield {ready: lastPrune > 0 && lastPrune >= sa}
17561751
17571752-- POST /maintenance/block: deny-list a peer. Outbound retries skip blocked
17581753-- peers; inbound federation calls from blocked peers fail in `withFederationAuth`.
1759−handleBlockPeer : Text -> Text -> ({blocked: Int, ok: Bool} -> a) -> IO {rw *blockedPeers, r *runtimeMaintenanceSecret} a
1760−handleBlockPeer = \server authorization respond -> withMaintAuth authorization (yield (respond {
1754+handleBlockPeer : Text -> Text -> IO {rw *blockedPeers, r *runtimeMaintenanceSecret} {blocked: Int, ok: Bool}
1755+handleBlockPeer = \server authorization -> withMaintAuth authorization (yield {
17611756 ok: False {},
17621757 blocked: 0
1763−})) (do
1758+}) (do
17641759 n <- atomic (do
17651760 current <- *blockedPeers
17661761 let updated = union current [server]
17671762 *blockedPeers = updated
17681763 yield (count updated))
1769− yield (respond {ok: True {}, blocked: n}))
1764+ yield {ok: True {}, blocked: n})
17701765
17711766-- POST /maintenance/unblock: remove a peer from the deny-list.
1772−handleUnblockPeer : Text -> Text -> ({ok: Bool, unblocked: Bool} -> a) -> IO {rw *blockedPeers, r *runtimeMaintenanceSecret} a
1773−handleUnblockPeer = \server authorization respond -> withMaintAuth authorization (yield (respond {
1767+handleUnblockPeer : Text -> Text -> IO {rw *blockedPeers, r *runtimeMaintenanceSecret} {ok: Bool, unblocked: Bool}
1768+handleUnblockPeer = \server authorization -> withMaintAuth authorization (yield {
17741769 ok: False {},
17751770 unblocked: False {}
1776−})) (do
1771+}) (do
17771772 removed <- atomic (do
17781773 current <- *blockedPeers
17791774 *blockedPeers = removeWhere current (\x -> x == server)
17801775 yield (elem server current))
1781− yield (respond {ok: True {}, unblocked: removed}))
1776+ yield {ok: True {}, unblocked: removed})
17821777
17831778-- GET /maintenance/blocked: list the deny-listed peers (empty for unauthorized).
1784−handleListBlocked : Text -> ({ok: Bool, peers: [Text]} -> a) -> IO {r *blockedPeers, r *runtimeMaintenanceSecret} a
1785−handleListBlocked = \authorization respond -> do
1779+handleListBlocked : Text -> IO {r *blockedPeers, r *runtimeMaintenanceSecret} {ok: Bool, peers: [Text]}
1780+handleListBlocked = \authorization -> do
17861781 ok <- verifyMaintenanceAuth authorization
17871782 list <- *blockedPeers
1788− yield (respond {peers: if ok then list else [], ok})
1783+ yield {peers: if ok then list else [], ok}
17891784
17901785-- POST /maintenance/allow: when the allowed-peers list is non-empty, only
17911786-- federation calls from listed peers are accepted (whitelist mode). An empty
17921787-- list disables the whitelist.
1793−handleAllowPeer : Text -> Text -> ({allowed: Int, ok: Bool} -> a) -> IO {rw *allowedPeers, r *runtimeMaintenanceSecret} a
1794−handleAllowPeer = \server authorization respond -> withMaintAuth authorization (yield (respond {
1788+handleAllowPeer : Text -> Text -> IO {rw *allowedPeers, r *runtimeMaintenanceSecret} {allowed: Int, ok: Bool}
1789+handleAllowPeer = \server authorization -> withMaintAuth authorization (yield {
17951790 ok: False {},
17961791 allowed: 0
1797−})) (do
1792+}) (do
17981793 n <- atomic (do
17991794 current <- *allowedPeers
18001795 let updated = union current [server]
18011796 *allowedPeers = updated
18021797 yield (count updated))
1803− yield (respond {ok: True {}, allowed: n}))
1798+ yield {ok: True {}, allowed: n})
18041799
18051800-- POST /maintenance/unallow: remove an entry from the allow-list. If the
18061801-- list becomes empty, the whitelist gate disengages.
1807−handleUnallowPeer : Text -> Text -> ({ok: Bool, removed: Bool} -> a) -> IO {rw *allowedPeers, r *runtimeMaintenanceSecret} a
1808−handleUnallowPeer = \server authorization respond -> withMaintAuth authorization (yield (respond {
1802+handleUnallowPeer : Text -> Text -> IO {rw *allowedPeers, r *runtimeMaintenanceSecret} {ok: Bool, removed: Bool}
1803+handleUnallowPeer = \server authorization -> withMaintAuth authorization (yield {
18091804 ok: False {},
18101805 removed: False {}
1811−})) (do
1806+}) (do
18121807 removed <- atomic (do
18131808 current <- *allowedPeers
18141809 *allowedPeers = removeWhere current (\x -> x == server)
18151810 yield (elem server current))
1816− yield (respond {ok: True {}, removed}))
1811+ yield {ok: True {}, removed})
18171812
18181813-- GET /maintenance/allowed: list the allow-listed peers (empty for unauthorized).
1819−handleListAllowed : Text -> ({ok: Bool, peers: [Text]} -> a) -> IO {r *allowedPeers, r *runtimeMaintenanceSecret} a
1820−handleListAllowed = \authorization respond -> do
1814+handleListAllowed : Text -> IO {r *allowedPeers, r *runtimeMaintenanceSecret} {ok: Bool, peers: [Text]}
1815+handleListAllowed = \authorization -> do
18211816 ok <- verifyMaintenanceAuth authorization
18221817 list <- *allowedPeers
1823− yield (respond {peers: if ok then list else [], ok})
1818+ yield {peers: if ok then list else [], ok}
18241819
18251820-- POST /maintenance/ping: send a zero-event gossip to a peer and return the
18261821-- round-trip latency. Useful for diagnosing federation reachability without
18271822-- waiting for organic traffic.
1828−handlePingPeer : Text -> Text -> ({error: Text, latencyMs: Int, ok: Bool} -> a) -> IO {r *federationPrivateKeyHex, r *runtimeMaintenanceSecret, network, clock, random} a
1829−handlePingPeer = \server authorization respond -> withMaintAuth authorization (yield (respond {
1823+handlePingPeer : Text -> Text -> IO {r *federationPrivateKeyHex, r *runtimeMaintenanceSecret, network, clock, random} {error: Text, latencyMs: Int, ok: Bool}
1824+handlePingPeer = \server authorization -> withMaintAuth authorization (yield {
18301825 ok: False {},
18311826 latencyMs: 0,
18321827 error: "unauthorized"
1833−})) (if isBadServerName server
1834−then yield (respond {ok: False {}, latencyMs: 0, error: "invalid_server"})
1828+}) (if isBadServerName server
1829+then yield {ok: False {}, latencyMs: 0, error: "invalid_server"}
18351830else do
18361831 startTime <- now
18371832 auth <- generateFederationAuth "gossip" startTime
@@ -1844,27 +1839,27 @@ else do
18441839 })
18451840 endTime <- now
18461841 case result of
1847− Err e -> yield (respond {ok: False {}, latencyMs: endTime - startTime, error: show e})
1848− Ok {value: r} -> yield (respond {r.ok, latencyMs: endTime - startTime, r.error}))
1842+ Err e -> yield {ok: False {}, latencyMs: endTime - startTime, error: show e}
1843+ Ok {value: r} -> yield {r.ok, latencyMs: endTime - startTime, r.error})
18491844
18501845-- GET /maintenance/sessions/{pubkey}: list a single user's active sessions.
18511846-- Token values are masked ("***") — operators see expiry and ip only.
1852−handleAdminListSessions : PubkeyHex -> Text -> ({count: Int, ok: Bool, sessions: [{expiresAt: Int<Ms>, ip: Text, token: Text}]} -> a) -> IO {r *runtimeMaintenanceSecret, r *sessions} a
1853−handleAdminListSessions = \pubkey authorization respond -> do
1847+handleAdminListSessions : PubkeyHex -> Text -> IO {r *runtimeMaintenanceSecret, r *sessions} {count: Int, ok: Bool, sessions: [{expiresAt: Int<Ms>, ip: Text, token: Text}]}
1848+handleAdminListSessions = \pubkey authorization -> do
18541849 ok <- verifyMaintenanceAuth authorization
18551850 ses <- *sessions
18561851 let mine = if ok
18571852 then mapWhere ses (\s -> s.pubkey == pubkey) (\s -> {token: "***", s.expiresAt, s.ip})
18581853 else []
1859− yield (respond {sessions: mine, count: count mine, ok})
1854+ yield {sessions: mine, count: count mine, ok}
18601855
18611856-- POST /maintenance/sessions/revoke-all: drop every session and local presence
18621857-- row for `pubkey`. Operator-side kick for a compromised key.
1863−handleAdminRevokeSessions : PubkeyHex -> Text -> ({ok: Bool, revokedCount: Int} -> a) -> IO {rw *presence, r *runtimeMaintenanceSecret, rw *sessions} a
1864−handleAdminRevokeSessions = \pubkey authorization respond -> withMaintAuth authorization (yield (respond {
1858+handleAdminRevokeSessions : PubkeyHex -> Text -> IO {rw *presence, r *runtimeMaintenanceSecret, rw *sessions} {ok: Bool, revokedCount: Int}
1859+handleAdminRevokeSessions = \pubkey authorization -> withMaintAuth authorization (yield {
18651860 ok: False {},
18661861 revokedCount: 0
1867−})) (do
1862+}) (do
18681863 revoked <- atomic (do
18691864 ses <- *sessions
18701865 let same = \s -> s.pubkey == pubkey
@@ -1872,16 +1867,16 @@ handleAdminRevokeSessions = \pubkey authorization respond -> withMaintAuth autho
18721867 pres <- *presence
18731868 *presence = filter pres (\p -> p.pubkey != pubkey || isRemote p.server)
18741869 yield (countWhere ses same))
1875− yield (respond {ok: True {}, revokedCount: revoked}))
1870+ yield {ok: True {}, revokedCount: revoked})
18761871
18771872-- POST /maintenance/messages/purge: drop all queued/forwarding messages
18781873-- destined for `pubkey`. With the federation ack flow gone, there's nothing
18791874-- to ack back — peers will discover the absence on their next forward attempt.
1880−handleAdminPurgeMessages : PubkeyHex -> Text -> ({ok: Bool, purgedCount: Int} -> a) -> IO {rw *forwards, rw *messages, r *runtimeMaintenanceSecret} a
1881−handleAdminPurgeMessages = \pubkey authorization respond -> withMaintAuth authorization (yield (respond {
1875+handleAdminPurgeMessages : PubkeyHex -> Text -> IO {rw *forwards, rw *messages, r *runtimeMaintenanceSecret} {ok: Bool, purgedCount: Int}
1876+handleAdminPurgeMessages = \pubkey authorization -> withMaintAuth authorization (yield {
18821877 ok: False {},
18831878 purgedCount: 0
1884−})) (do
1879+}) (do
18851880 purged <- atomic (do
18861881 msgs <- *messages
18871882 let mine = \m -> m.toKey == pubkey
@@ -1890,16 +1885,16 @@ handleAdminPurgeMessages = \pubkey authorization respond -> withMaintAuth author
18901885 fwds <- *forwards
18911886 *forwards = filter fwds (\f -> f.toKey != pubkey)
18921887 yield (count purgedMsgs))
1893− yield (respond {ok: True {}, purgedCount: purged}))
1888+ yield {ok: True {}, purgedCount: purged})
18941889
18951890-- POST /maintenance/sessions/revoke-ip: kill every session bound to a given
18961891-- client IP, regardless of pubkey. Reports total revoked + distinct keys.
1897−handleAdminRevokeIp : Text -> Text -> ({affectedKeys: Int, ok: Bool, revokedCount: Int} -> a) -> IO {r *runtimeMaintenanceSecret, rw *sessions} a
1898−handleAdminRevokeIp = \ip authorization respond -> withMaintAuth authorization (yield (respond {
1892+handleAdminRevokeIp : Text -> Text -> IO {r *runtimeMaintenanceSecret, rw *sessions} {affectedKeys: Int, ok: Bool, revokedCount: Int}
1893+handleAdminRevokeIp = \ip authorization -> withMaintAuth authorization (yield {
18991894 ok: False {},
19001895 revokedCount: 0,
19011896 affectedKeys: 0
1902−})) (do
1897+}) (do
19031898 keys <- if ip == ""
19041899 then yield []
19051900 else atomic (do
@@ -1907,31 +1902,31 @@ handleAdminRevokeIp = \ip authorization respond -> withMaintAuth authorization (
19071902 let same = \s -> s.ip == ip
19081903 *sessions = removeWhere ses same
19091904 yield (mapWhere ses same (\s -> s.pubkey)))
1910− yield (respond {ok: ip != "", revokedCount: count keys, affectedKeys: count keys}))
1905+ yield {ok: ip != "", revokedCount: count keys, affectedKeys: count keys})
19111906
19121907-- POST /maintenance/sessions/list: paged session inventory aggregated by
19131908-- pubkey (count, distinct ips, latest expiry). Sorted by descending count.
1914−handleAdminListAllSessions : Int -> Text -> ({ok: Bool, sessions: [{count: Int, ips: [Text], latestExpiry: Int, pubkey: PubkeyHex}], total: Int} -> a) -> IO {r *runtimeMaintenanceSecret, r *sessions, clock} a
1915−handleAdminListAllSessions = \limit authorization respond -> withMaintAuth authorization (yield (respond {
1909+handleAdminListAllSessions : Int -> Text -> IO {r *runtimeMaintenanceSecret, r *sessions, clock} {ok: Bool, sessions: [{count: Int, ips: [Text], latestExpiry: Int, pubkey: PubkeyHex}], total: Int}
1910+handleAdminListAllSessions = \limit authorization -> withMaintAuth authorization (yield {
19161911 sessions: [],
19171912 ok: False {},
19181913 total: 0
1919−})) (do
1914+}) (do
19201915 t <- now
19211916 ses <- *sessions
19221917 let active = filter ses (\s -> s.expiresAt > t)
19231918 let grouped = pluck (pluck active (\s -> s.pubkey)) (\pk -> (\mine -> {pubkey: pk, count: count mine, ips: mapWhere mine (\s -> s.ip != "") (\s -> s.ip), latestExpiry: fold (\acc s -> max acc s.expiresAt) 0 mine}) (filter active (\s -> s.pubkey == pk)))
19241919 let cap = clamp 1 500 (if limit <= 0 then 100 else limit)
19251920 let top = takeRelation cap (sortBy (\g -> 0 - g.count) grouped)
1926− yield (respond {sessions: top, ok: True {}, total: count grouped}))
1921+ yield {sessions: top, ok: True {}, total: count grouped})
19271922
19281923-- GET /maintenance/rate-limits: expose the configured rate ceilings. Returns
19291924-- zeros for unauthenticated callers (response shape stays stable).
1930−handleGetRateLimits : Text -> ({authGlobal: Int, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, sendRate: Int} -> a) -> IO {r *runtimeMaintenanceSecret} a
1931−handleGetRateLimits = \authorization respond -> do
1925+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}
1926+handleGetRateLimits = \authorization -> do
19321927 ok <- verifyMaintenanceAuth authorization
19331928 let v = \x -> if ok then x else 0
1934− yield (respond {
1929+ yield {
19351930 ok,
19361931 globalRequest: v maxGlobalRequestRate,
19371932 ipRate: v maxIpRatePerIp,
@@ -1943,46 +1938,46 @@ handleGetRateLimits = \authorization respond -> do
19431938 pairRate: v maxPairRatePerPair,
19441939 lookupRate: v maxLookupRatePerKey,
19451940 clientWriteRate: v maxClientWriteRatePerKey
1946− })
1941+ }
19471942
19481943-- POST /maintenance/rate-limits: stub. Rate ceilings are compile-time constants
19491944-- in this simplified server, so this just authorizes and returns ok=true.
1950−handleSetRateLimits : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Text -> ({ok: Bool} -> k) -> IO {r *runtimeMaintenanceSecret} k
1951−handleSetRateLimits = \globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization respond -> do
1945+handleSetRateLimits : a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Text -> IO {r *runtimeMaintenanceSecret} {ok: Bool}
1946+handleSetRateLimits = \globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization -> do
19521947 authorized <- verifyMaintenanceAuth authorization
1953− yield (respond {ok: authorized})
1948+ yield {ok: authorized}
19541949
19551950-- POST /maintenance/nonces/flush: stub. Nonce caches were removed; the
19561951-- endpoint is preserved so older operator tooling keeps working.
1957−handleFlushNonces : Text -> ({flushedCount: Int, ok: Bool} -> a) -> IO {r *runtimeMaintenanceSecret} a
1958−handleFlushNonces = \authorization respond -> do
1952+handleFlushNonces : Text -> IO {r *runtimeMaintenanceSecret} {flushedCount: Int, ok: Bool}
1953+handleFlushNonces = \authorization -> do
19591954 authorized <- verifyMaintenanceAuth authorization
1960− yield (respond {ok: authorized, flushedCount: 0})
1955+ yield {ok: authorized, flushedCount: 0}
19611956
19621957-- POST /maintenance/rotate-secret: replace the maintenance Bearer secret.
19631958-- The old secret authenticates the rotation; subsequent calls must use the
19641959-- new value.
1965−handleRotateSecret : Text -> Text -> ({error: Text, ok: Bool} -> a) -> IO {rw *runtimeMaintenanceSecret} a
1966−handleRotateSecret = \newSecret authorization respond -> withMaintAuth authorization (yield (respond {
1960+handleRotateSecret : Text -> Text -> IO {rw *runtimeMaintenanceSecret} {error: Text, ok: Bool}
1961+handleRotateSecret = \newSecret authorization -> withMaintAuth authorization (yield {
19671962 ok: False {},
19681963 error: "unauthorized"
1969−})) (do
1964+}) (do
19701965 atomic *runtimeMaintenanceSecret = newSecret
1971− yield (respond {ok: True {}, error: ""}))
1966+ yield {ok: True {}, error: ""})
19721967
19731968-- GET /maintenance/config: expose a small set of operationally-relevant
19741969-- compile-time constants (poll timeout, ack grace).
1975−handleGetConfig : Text -> ({ackGracePeriod: Int, ok: Bool, pollTimeoutMs: Int} -> a) -> IO {r *runtimeMaintenanceSecret} a
1976−handleGetConfig = \authorization respond -> do
1970+handleGetConfig : Text -> IO {r *runtimeMaintenanceSecret} {ackGracePeriod: Int, ok: Bool, pollTimeoutMs: Int}
1971+handleGetConfig = \authorization -> do
19771972 ok <- verifyMaintenanceAuth authorization
19781973 let v = \x -> if ok then x else 0
1979− yield (respond {ok, pollTimeoutMs: v pollTimeoutMs, ackGracePeriod: v ackGracePeriod})
1974+ yield {ok, pollTimeoutMs: v pollTimeoutMs, ackGracePeriod: v ackGracePeriod}
19801975
19811976-- GET /stats: capacity gauges + minimal federation/timing snapshot. Most of
19821977-- the historical metric fields are zero-filled (see `zeroStats`) — only the
19831978-- counts that come straight from the state refs are populated.
1984−handleStats : Text -> ({capacity: {activePolls: Int, challenges: Int, challengesMax: Int, deliveredIds: Int, deliveredIdsMax: Int, forwardNonces: Int, forwardNoncesMax: Int, forwards: Int, messageBucketMax: Int, messageBucketMin: Int, messages: Int, nonceEvictions: Int, presence: Int, recipientCounts: Int, sessions: Int, sessionsMax: Int, sessionsPct: Int, totalMessageCount: Int}, federation: {avgLatencyMs: Int, blockedPeers: Int, callCount: Int, enabled: Bool, forwardFailures: Int, forwardServers: Int, gossipFail: Int, gossipSuccess: Int, hungSlots: Int, inFlight: Int, latencyBuckets: {gte2000: Int, lt100: Int, lt2000: Int, lt500: Int}, maxForwardQueueDepth: Int, maxLatencyMs: Int, oldestAckAge: Int, oldestForwardAge: Int, recentGossip: Int, slowVerifies: Int, topFailingPeers: [{failures: Int, server: Text}], verifyFailures: Int}, ok: Bool, rates: {challenge: Int, federation: Int, federationPair: Int, global: Int, gossipEvent: Int, ip: Int, lookup: Int, pair: Int, pendingAckCleanups: Int, recv: Int, rejectedAuth: Int, rejectedFederation: Int, rejectedGlobal: Int, rejectedIp: Int, rejectedPerKey: Int, send: Int, uniqueKeyIp: Int, verifyIp: Int}, timing: {activeRequests: Int, authAvgMs: Int, authCount: Int, authMaxMs: Int, heartbeatCount: Int, lastHeartbeatAt: Timestamp, lastPruneAt: Timestamp, peakActiveRequests: Int, pollAvgMs: Int, pollCount: Int, pollLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, pollMaxMs: Int, pruneCount: Int, pruneRunning: Timestamp, sendAvgMs: Int, sendCount: Int, sendLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, sendMaxMs: Int, totalEntries: Int, uptime: Int}, version: Text} -> a) -> IO {r *activePolls, r *blockedPeers, r *challenges, r *deliveredIds, r *forwards, r *heartbeatCount, r *lastHeartbeatAt, r *lastPrunedAt, r *messages, r *presence, r *pruneCount, r *runtimeMaintenanceSecret, r *sessions, r *startedAt, clock} a
1985−handleStats = \authorization respond -> withMaintAuth authorization (yield (respond zeroStats)) (do
1979+handleStats : Text -> IO {r *activePolls, r *blockedPeers, r *challenges, r *deliveredIds, r *forwards, r *heartbeatCount, r *lastHeartbeatAt, r *lastPrunedAt, r *messages, r *presence, r *pruneCount, r *runtimeMaintenanceSecret, r *sessions, r *startedAt, clock} {capacity: {activePolls: Int, challenges: Int, challengesMax: Int, deliveredIds: Int, deliveredIdsMax: Int, forwardNonces: Int, forwardNoncesMax: Int, forwards: Int, messageBucketMax: Int, messageBucketMin: Int, messages: Int, nonceEvictions: Int, presence: Int, recipientCounts: Int, sessions: Int, sessionsMax: Int, sessionsPct: Int, totalMessageCount: Int}, federation: {avgLatencyMs: Int, blockedPeers: Int, callCount: Int, enabled: Bool, forwardFailures: Int, forwardServers: Int, gossipFail: Int, gossipSuccess: Int, hungSlots: Int, inFlight: Int, latencyBuckets: {gte2000: Int, lt100: Int, lt2000: Int, lt500: Int}, maxForwardQueueDepth: Int, maxLatencyMs: Int, oldestAckAge: Int, oldestForwardAge: Int, recentGossip: Int, slowVerifies: Int, topFailingPeers: [{failures: Int, server: Text}], verifyFailures: Int}, ok: Bool, rates: {challenge: Int, federation: Int, federationPair: Int, global: Int, gossipEvent: Int, ip: Int, lookup: Int, pair: Int, pendingAckCleanups: Int, recv: Int, rejectedAuth: Int, rejectedFederation: Int, rejectedGlobal: Int, rejectedIp: Int, rejectedPerKey: Int, send: Int, uniqueKeyIp: Int, verifyIp: Int}, timing: {activeRequests: Int, authAvgMs: Int, authCount: Int, authMaxMs: Int, heartbeatCount: Int, lastHeartbeatAt: Timestamp, lastPruneAt: Timestamp, peakActiveRequests: Int, pollAvgMs: Int, pollCount: Int, pollLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, pollMaxMs: Int, pruneCount: Int, pruneRunning: Timestamp, sendAvgMs: Int, sendCount: Int, sendLatencyBuckets: {gte1000: Int, lt1000: Int, lt200: Int, lt50: Int}, sendMaxMs: Int, totalEntries: Int, uptime: Int}, version: Text}
1980+handleStats = \authorization -> withMaintAuth authorization (yield zeroStats) (do
19861981 t <- now
19871982 sa <- *startedAt
19881983 sessions <- *sessions
@@ -2001,7 +1996,7 @@ handleStats = \authorization respond -> withMaintAuth authorization (yield (resp
20011996 let mCount = count msgs
20021997 let pCount = count pres
20031998 let fCount = count fwds
2004− yield (respond {
1999+ yield {
20052000 ok: True {},
20062001 version: serverBuildVersion,
20072002 capacity: {
@@ -2087,7 +2082,7 @@ handleStats = \authorization respond -> withMaintAuth authorization (yield (resp
20872082 authMaxMs: 0,
20882083 authCount: 0
20892084 }
2090− }))
2085+ })
20912086
20922087-- All-zero /stats payload returned to unauthorized callers. The shape is kept
20932088-- in lockstep with the response in `handleStats` so older operator tooling
@@ -2183,15 +2178,12 @@ zeroStats = {
21832178
21842179-- GET /stats/peers: per-peer failure summary derived from `forwardFailures`,
21852180-- including current backoff and pending forward queue depth.
2186−handleStatsPeers : Text -> ({ok: Bool, peers: [{avgLatencyMs: Int, backoffMs: Int<Ms>, failures: Int, firstFailedAt: Int<Ms>, gossipEventsPerMin: Int, lastFailedAt: Int<Ms>, latencySamples: Int, maxLatencyMs: Int, pendingForwards: Int, retriable: Bool, server: Text}]} -> a) -> IO {r *forwardFailures, r *forwards, r *runtimeMaintenanceSecret, clock} a
2187−handleStatsPeers = \authorization respond -> withMaintAuth authorization (yield (respond {
2188− peers: [],
2189− ok: False {}
2190−})) (do
2181+handleStatsPeers : Text -> IO {r *forwardFailures, r *forwards, r *runtimeMaintenanceSecret, clock} {ok: Bool, peers: [{avgLatencyMs: Int, backoffMs: Int<Ms>, failures: Int, firstFailedAt: Int<Ms>, gossipEventsPerMin: Int, lastFailedAt: Int<Ms>, latencySamples: Int, maxLatencyMs: Int, pendingForwards: Int, retriable: Bool, server: Text}]}
2182+handleStatsPeers = \authorization -> withMaintAuth authorization (yield {peers: [], ok: False {}}) (do
21912183 t <- now
21922184 failures <- *forwardFailures
21932185 fwds <- *forwards
2194− yield (respond {
2186+ yield {
21952187 peers: pluck failures (\f -> {
21962188 f.server,
21972189 f.failures,
@@ -2206,12 +2198,12 @@ handleStatsPeers = \authorization respond -> withMaintAuth authorization (yield
22062198 gossipEventsPerMin: 0
22072199 }),
22082200 ok: True {}
2209− }))
2201+ })
22102202
22112203-- GET /stats/key/{pubkey}: per-key footprint — message count, presence rows,
22122204-- session count, queued forwards (with details), and active long-poll count.
2213−handleStatsKey : PubkeyHex -> Text -> ({activePolls: Int, forwardDetails: [{retries: Int, server: ServerName}], forwards: Int, messages: Int, ok: Bool, presence: [{expiresAt: Int<Ms>, server: ServerName}], sessions: Int} -> a) -> IO {r *activePolls, r *forwards, r *messages, r *presence, r *runtimeMaintenanceSecret, r *sessions, clock} a
2214−handleStatsKey = \pubkey authorization respond -> withMaintAuth authorization (yield (respond {
2205+handleStatsKey : PubkeyHex -> Text -> IO {r *activePolls, r *forwards, r *messages, r *presence, r *runtimeMaintenanceSecret, r *sessions, clock} {activePolls: Int, forwardDetails: [{retries: Int, server: ServerName}], forwards: Int, messages: Int, ok: Bool, presence: [{expiresAt: Int<Ms>, server: ServerName}], sessions: Int}
2206+handleStatsKey = \pubkey authorization -> withMaintAuth authorization (yield {
22152207 messages: 0,
22162208 presence: [],
22172209 sessions: 0,
@@ -2219,7 +2211,7 @@ handleStatsKey = \pubkey authorization respond -> withMaintAuth authorization (y
22192211 forwardDetails: [],
22202212 activePolls: 0,
22212213 ok: False {}
2222−})) (do
2214+}) (do
22232215 t <- now
22242216 msgs <- *messages
22252217 pres <- *presence
@@ -2227,7 +2219,7 @@ handleStatsKey = \pubkey authorization respond -> withMaintAuth authorization (y
22272219 fwds <- *forwards
22282220 aps <- *activePolls
22292221 let myFwds = filter fwds (\x -> x.toKey == pubkey)
2230− yield (respond {
2222+ yield {
22312223 messages: countWhere msgs (\x -> x.toKey == pubkey),
22322224 presence: mapWhere pres (\x -> x.pubkey == pubkey && x.expiresAt > t) (\x -> {
22332225 x.server,
@@ -2238,16 +2230,16 @@ handleStatsKey = \pubkey authorization respond -> withMaintAuth authorization (y
22382230 forwardDetails: pluck myFwds (\x -> {server: x.toServer, x.retries}),
22392231 activePolls: countWhere aps (\x -> x.pubkey == pubkey),
22402232 ok: True {}
2241− }))
2233+ })
22422234
22432235-- POST /stats/top-recipients: ranked list of pubkeys by mailbox depth.
22442236-- `limit` defaults to 20, capped at 100, used to spot hot-spots / abuse.
2245−handleTopRecipients : Int -> Text -> ({ok: Bool, recipients: [RecipientCount], total: Int} -> a) -> IO {r *messages, r *runtimeMaintenanceSecret} a
2246−handleTopRecipients = \limit authorization respond -> withMaintAuth authorization (yield (respond {
2237+handleTopRecipients : Int -> Text -> IO {r *messages, r *runtimeMaintenanceSecret} {ok: Bool, recipients: [RecipientCount], total: Int}
2238+handleTopRecipients = \limit authorization -> withMaintAuth authorization (yield {
22472239 recipients: [],
22482240 ok: False {},
22492241 total: 0
2250−})) (do
2242+}) (do
22512243 msgs <- *messages
22522244 let counts = pluck (pluck msgs (\m -> m.toKey)) (\pk -> {
22532245 pubkey: pk,
@@ -2255,30 +2247,30 @@ handleTopRecipients = \limit authorization respond -> withMaintAuth authorizatio
22552247 })
22562248 let cap = clamp 1 100 (if limit <= 0 then 20 else limit)
22572249 let top = takeRelation cap (sortBy (\c -> 0 - c.count) counts)
2258− yield (respond {recipients: top, ok: True {}, total: count counts}))
2250+ yield {recipients: top, ok: True {}, total: count counts})
22592251
22602252-- GET /stats/forwards: per-destination forward queue summary — count and
22612253-- total accumulated retries.
2262−handleStatsForwards : Text -> ({ok: Bool, servers: [{count: Int<u>, server: ServerName, totalRetries: Int}], total: Int} -> a) -> IO {r *forwards, r *runtimeMaintenanceSecret} a
2263−handleStatsForwards = \authorization respond -> withMaintAuth authorization (yield (respond {
2254+handleStatsForwards : Text -> IO {r *forwards, r *runtimeMaintenanceSecret} {ok: Bool, servers: [{count: Int<u>, server: ServerName, totalRetries: Int}], total: Int}
2255+handleStatsForwards = \authorization -> withMaintAuth authorization (yield {
22642256 servers: [],
22652257 ok: False {},
22662258 total: 0
2267−})) (do
2259+}) (do
22682260 fwds <- *forwards
2269− yield (respond {
2261+ yield {
22702262 servers: pluck (collectPeers fwds (\f -> f.toServer)) (\s -> (\svFwds -> {server: s, count: count svFwds, totalRetries: fold (\acc f -> acc + f.retries) 0 svFwds}) (filter fwds (\f -> f.toServer == s))),
22712263 ok: True {},
22722264 total: count fwds
2273− }))
2265+ })
22742266
22752267-- GET /stats/rates: same shape as /maintenance/rate-limits with an extra
22762268-- scalePct field. Kept separate for backwards compatibility with older clients.
2277−handleStatsRates : Text -> ({authGlobal: Int, challengeRate: Int, clientWriteRate: Int, federationRate: Int, globalRequest: Int, ipRate: Int, lookupRate: Int, ok: Bool, pairRate: Int, recvRate: Int, scalePct: Int, sendRate: Int} -> a) -> IO {r *runtimeMaintenanceSecret} a
2278−handleStatsRates = \authorization respond -> do
2269+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}
2270+handleStatsRates = \authorization -> do
22792271 ok <- verifyMaintenanceAuth authorization
22802272 let v = \x -> if ok then x else 0
2281− yield (respond {
2273+ yield {
22822274 ok,
22832275 scalePct: v 100,
22842276 globalRequest: v maxGlobalRequestRate,
@@ -2291,13 +2283,13 @@ handleStatsRates = \authorization respond -> do
22912283 pairRate: v maxPairRatePerPair,
22922284 lookupRate: v maxLookupRatePerKey,
22932285 clientWriteRate: v maxClientWriteRatePerKey
2294− })
2286+ }
22952287
22962288-- GET /metrics: Prometheus-style text exposition of the most useful gauges.
22972289-- The `authorization` header is accepted but not validated here — operators
22982290-- relying on auth must front this endpoint with a reverse proxy that enforces it.
2299−handleMetrics : a -> ({metrics: Text, ok: Bool} -> b) -> IO {r *activePolls, r *forwards, r *messages, r *presence, r *sessions, r *startedAt, clock} b
2300−handleMetrics = \authorization respond -> do
2291+handleMetrics : a -> IO {r *activePolls, r *forwards, r *messages, r *presence, r *sessions, r *startedAt, clock} {metrics: Text, ok: Bool}
2292+handleMetrics = \authorization -> do
23012293 t <- now
23022294 msgs <- *messages
23032295 ses <- *sessions
@@ -2305,7 +2297,7 @@ handleMetrics = \authorization respond -> do
23052297 fwds <- *forwards
23062298 aps <- *activePolls
23072299 sa <- *startedAt
2308− yield (respond {
2300+ yield {
23092301 metrics: fold (\acc r -> acc ++ r.k ++ " " ++ show r.v ++ "\n") "" [
23102302 {k: "skrepka_messages_total", v: count msgs},
23112303 {k: "skrepka_sessions_total", v: count ses},
@@ -2315,7 +2307,7 @@ handleMetrics = \authorization respond -> do
23152307 {k: "skrepka_uptime_seconds", v: (t - sa) / 1000}
23162308 ],
23172309 ok: True {}
2318− })
2310+ }
23192311
23202312-- ============================================
23212313-- Dispatch
@@ -2326,51 +2318,52 @@ handleMetrics = \authorization respond -> do
23262318
23272319-- Top-level request dispatcher: maps each generated request constructor to
23282320-- its `handleXxx` function. Every route entry above must have a clause here.
2329−serve = \req -> case req of
2330− ReqChallenge {pubkey, clientIp, respond} -> handleChallenge pubkey clientIp respond
2331− VerifyAuth {pubkey, challenge, signature, revokeOthers, clientIp, respond} -> handleVerifyAuth pubkey challenge signature revokeOthers clientIp respond
2332− RevokeSession {targetToken, authorization, clientIp, respond} -> handleRevoke targetToken authorization clientIp respond
2333− Logout {authorization, clientIp, respond} -> handleLogout authorization clientIp respond
2334− Poll {cursor, generation, authorization, clientIp, respond} -> handlePoll cursor generation authorization clientIp respond
2335− SendMessages {messages, authorization, clientIp, respond} -> handleSendMessages messages authorization clientIp respond
2336− MessageStatus {to, messageId, authorization, clientIp, respond} -> handleMessageStatus to messageId authorization clientIp respond
2337− AckMessages {messageIds, authorization, clientIp, respond} -> handleAckMessages messageIds authorization clientIp respond
2338− ListMessages {offset, authorization, clientIp, respond} -> handleListMessages offset authorization clientIp respond
2339− DeleteMessages {messageIds, authorization, clientIp, respond} -> handleDeleteMessages messageIds authorization clientIp respond
2340− LookupPresence {pubkey, authorization, clientIp, respond} -> handleLookupPresence pubkey authorization clientIp respond
2341− BatchLookupPresence {pubkeys, authorization, clientIp, respond} -> handleBatchLookupPresence pubkeys authorization clientIp respond
2342− RecvGossip {events, fromServer, requestTimestamp, authorization, respond} -> handleRecvGossip events fromServer requestTimestamp authorization respond
2343− ForwardMessage {toKey, encryptedBlob, messageId, fromServer, requestTimestamp, authorization, respond} -> handleForwardMessage toKey encryptedBlob messageId fromServer requestTimestamp authorization respond
2344− FederationBatchForward {forwards, fromServer, requestTimestamp, authorization, respond} -> handleFederationBatchForward forwards fromServer requestTimestamp authorization respond
2345− FederationPubkey {respond} -> handleFederationPubkey respond
2346− Prune {authorization, respond} -> handlePrune authorization respond
2347− BlockPeer {server, authorization, respond} -> handleBlockPeer server authorization respond
2348− UnblockPeer {server, authorization, respond} -> handleUnblockPeer server authorization respond
2349− ListBlocked {authorization, respond} -> handleListBlocked authorization respond
2350− PingPeer {server, authorization, respond} -> handlePingPeer server authorization respond
2351− AdminListSessions {pubkey, authorization, respond} -> handleAdminListSessions pubkey authorization respond
2352− AdminRevokeSessions {pubkey, authorization, respond} -> handleAdminRevokeSessions pubkey authorization respond
2353− AdminListAllSessions {limit, authorization, respond} -> handleAdminListAllSessions limit authorization respond
2354− AdminPurgeMessages {pubkey, authorization, respond} -> handleAdminPurgeMessages pubkey authorization respond
2355− AdminRevokeIp {ip, authorization, respond} -> handleAdminRevokeIp ip authorization respond
2356− GetRateLimits {authorization, respond} -> handleGetRateLimits authorization respond
2357− SetRateLimits {globalRequest, ipRate, sendRate, federationRate, authGlobal, recvRate, challengeRate, pairRate, lookupRate, clientWriteRate, authorization, respond} -> handleSetRateLimits globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization respond
2358− FlushNonces {authorization, respond} -> handleFlushNonces authorization respond
2359− AllowPeer {server, authorization, respond} -> handleAllowPeer server authorization respond
2360− UnallowPeer {server, authorization, respond} -> handleUnallowPeer server authorization respond
2361− ListAllowed {authorization, respond} -> handleListAllowed authorization respond
2362− Reconcile {authorization, respond} -> handleReconcile authorization respond
2363− RotateSecret {newSecret, authorization, respond} -> handleRotateSecret newSecret authorization respond
2364− GetConfig {authorization, respond} -> handleGetConfig authorization respond
2365− Health {authorization, respond} -> handleHealth authorization respond
2366− Stats {authorization, respond} -> handleStats authorization respond
2367− StatsPeers {authorization, respond} -> handleStatsPeers authorization respond
2368− StatsKey {pubkey, authorization, respond} -> handleStatsKey pubkey authorization respond
2369− TopRecipients {limit, authorization, respond} -> handleTopRecipients limit authorization respond
2370− StatsForwards {authorization, respond} -> handleStatsForwards authorization respond
2371− StatsRates {authorization, respond} -> handleStatsRates authorization respond
2372− Metrics {authorization, respond} -> handleMetrics authorization respond
2373− Ready {respond} -> handleReady respond
2321+api : Server Api _
2322+api = serve Api where
2323+ ReqChallenge = \{pubkey, clientIp} -> handleChallenge pubkey clientIp
2324+ VerifyAuth = \{pubkey, challenge, signature, revokeOthers, clientIp} -> handleVerifyAuth pubkey challenge signature revokeOthers clientIp
2325+ RevokeSession = \{targetToken, authorization, clientIp} -> handleRevoke targetToken authorization clientIp
2326+ Logout = \{authorization, clientIp} -> handleLogout authorization clientIp
2327+ Poll = \{cursor, generation, authorization, clientIp} -> handlePoll cursor generation authorization clientIp
2328+ SendMessages = \{messages, authorization, clientIp} -> handleSendMessages messages authorization clientIp
2329+ MessageStatus = \{to, messageId, authorization, clientIp} -> handleMessageStatus to messageId authorization clientIp
2330+ AckMessages = \{messageIds, authorization, clientIp} -> handleAckMessages messageIds authorization clientIp
2331+ ListMessages = \{offset, authorization, clientIp} -> handleListMessages offset authorization clientIp
2332+ DeleteMessages = \{messageIds, authorization, clientIp} -> handleDeleteMessages messageIds authorization clientIp
2333+ LookupPresence = \{pubkey, authorization, clientIp} -> handleLookupPresence pubkey authorization clientIp
2334+ BatchLookupPresence = \{pubkeys, authorization, clientIp} -> handleBatchLookupPresence pubkeys authorization clientIp
2335+ RecvGossip = \{events, fromServer, requestTimestamp, authorization} -> handleRecvGossip events fromServer requestTimestamp authorization
2336+ ForwardMessage = \{toKey, encryptedBlob, messageId, fromServer, requestTimestamp, authorization} -> handleForwardMessage toKey encryptedBlob messageId fromServer requestTimestamp authorization
2337+ FederationBatchForward = \{forwards, fromServer, requestTimestamp, authorization} -> handleFederationBatchForward forwards fromServer requestTimestamp authorization
2338+ FederationPubkey = \{} -> handleFederationPubkey
2339+ Prune = \{authorization} -> handlePrune authorization
2340+ BlockPeer = \{server, authorization} -> handleBlockPeer server authorization
2341+ UnblockPeer = \{server, authorization} -> handleUnblockPeer server authorization
2342+ ListBlocked = \{authorization} -> handleListBlocked authorization
2343+ PingPeer = \{server, authorization} -> handlePingPeer server authorization
2344+ AdminListSessions = \{pubkey, authorization} -> handleAdminListSessions pubkey authorization
2345+ AdminRevokeSessions = \{pubkey, authorization} -> handleAdminRevokeSessions pubkey authorization
2346+ AdminListAllSessions = \{limit, authorization} -> handleAdminListAllSessions limit authorization
2347+ AdminPurgeMessages = \{pubkey, authorization} -> handleAdminPurgeMessages pubkey authorization
2348+ AdminRevokeIp = \{ip, authorization} -> handleAdminRevokeIp ip authorization
2349+ GetRateLimits = \{authorization} -> handleGetRateLimits authorization
2350+ SetRateLimits = \{globalRequest, ipRate, sendRate, federationRate, authGlobal, recvRate, challengeRate, pairRate, lookupRate, clientWriteRate, authorization} -> handleSetRateLimits globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization
2351+ FlushNonces = \{authorization} -> handleFlushNonces authorization
2352+ AllowPeer = \{server, authorization} -> handleAllowPeer server authorization
2353+ UnallowPeer = \{server, authorization} -> handleUnallowPeer server authorization
2354+ ListAllowed = \{authorization} -> handleListAllowed authorization
2355+ Reconcile = \{authorization} -> handleReconcile authorization
2356+ RotateSecret = \{newSecret, authorization} -> handleRotateSecret newSecret authorization
2357+ GetConfig = \{authorization} -> handleGetConfig authorization
2358+ Health = \{authorization} -> handleHealth authorization
2359+ Stats = \{authorization} -> handleStats authorization
2360+ StatsPeers = \{authorization} -> handleStatsPeers authorization
2361+ StatsKey = \{pubkey, authorization} -> handleStatsKey pubkey authorization
2362+ TopRecipients = \{limit, authorization} -> handleTopRecipients limit authorization
2363+ StatsForwards = \{authorization} -> handleStatsForwards authorization
2364+ StatsRates = \{authorization} -> handleStatsRates authorization
2365+ Metrics = \{authorization} -> handleMetrics authorization
2366+ Ready = \{} -> handleReady
23742367
23752368-- ============================================
23762369-- Background loops
@@ -2424,4 +2417,4 @@ main = do
24242417 logInfo (" federation: " ++ (if federationEnabled then "enabled" else "disabled"))
24252418 fork backgroundPrune
24262419 fork pollHeartbeat
2427− listenOn bindHost listenPort serve
2420+ listenOn bindHost listenPort api