on master help sign in
Simplify server.knot: fix capList overflow, reorder gateRated for point-free, move withIndex, unify federation-auth preconditions
commit8ad4bf2139967161f07f5288001e886a23ae6908 authoriko <mail@iko.soy> dateMon 27 Apr 2026, 19:25 (5 months ago) parent447fba9
1 file changed+19−20
server.knot+19−20
server.knot+19−20
@@ -464,6 +464,9 @@ abs = \x -> if x < 0 then 0 - x else x
464464-- Dedup: keeps first occurrence (O(n^2)).
465465unique = \items -> fold (\acc x -> if elem acc x then acc else union acc [x]) [] items
466466
467+-- Pair each element with its 0-based index.
468+withIndex = fold (\acc x -> union acc [{i: count acc, v: x}]) []
469+
467470-- Replace a ref's contents with the entries that satisfy `keep`. Caller controls atomicity.
468471pruneRef = \ref keep -> do
469472 cur <- *ref
@@ -489,9 +492,8 @@ removeServerFromList = \listRef server -> atomic do
489492
490493headOf = \items -> fold (\_ x -> Just {value: x}) Nothing {} (take 1 items)
491494
492−-- Cap to maxN by dropping the single entry with the smallest key (LRU-style).
493−capList = \items maxN getKey ->
494− if count items > maxN then drop 1 (sortBy getKey items) else items
495+-- Cap to maxN by dropping the smallest-key entries (LRU-style). Always sorts.
496+capList = \items maxN getKey -> drop (max 0 (count items - maxN)) (sortBy getKey items)
495497
496498-- Integer percentage with zero-denominator guard.
497499pct = \cur maxN -> if maxN > 0 then cur * 100 / maxN else 0
@@ -625,16 +627,13 @@ gateAuth = \checkDrain auth ip t respond mkErr onAuth -> do
625627 else withSessionAuth auth t ip (err "unauthorized") onAuth
626628
627629-- gateAuth + per-key rate gate. `rateResp` is the response value when the per-key gate trips.
628−gateRated = \checkDrain auth ip rateRef maxRate windowMs t respond mkErr rateResp onAuth ->
630+gateRated = \rateRef maxRate windowMs checkDrain auth ip t respond mkErr rateResp onAuth ->
629631 gateAuth checkDrain auth ip t respond mkErr (\pk -> do
630632 lim <- checkPubkeyRateGate rateRef pk maxRate windowMs t
631633 if lim then yield (respond rateResp) else onAuth pk)
632634
633−gateClientWrite = \auth ip t respond mkErr rateResp onAuth ->
634− gateRated (True {}) auth ip clientWriteRates maxClientWriteRatePerKey clientWriteRateWindowMs t respond mkErr rateResp onAuth
635−
636−gateLookup = \auth ip t respond mkErr rateResp onAuth ->
637− gateRated (False {}) auth ip lookupRates maxLookupRatePerKey lookupRateWindowMs t respond mkErr rateResp onAuth
635+gateClientWrite = gateRated clientWriteRates maxClientWriteRatePerKey clientWriteRateWindowMs (True {})
636+gateLookup = gateRated lookupRates maxLookupRatePerKey lookupRateWindowMs (False {})
638637
639638withSessionAuth = \authorization t clientIp onUnauth onAuth ->
640639 case extractToken authorization of
@@ -683,17 +682,20 @@ verifyFederationAuth = \authorization fromServer scope requestTimestamp -> do
683682withFederationAuth = \authorization t respond fromServer scope requestTimestamp precondition action -> do
684683 blocked <- *blockedPeers
685684 allowed <- *allowedPeers
686− let err = \e -> yield (respond {ok: False {}, error: e, retryAfterMs: 0})
687− if elem blocked fromServer then err "blocked"
688− else if count allowed > 0 && not (elem allowed fromServer) then err "not_allowed"
689− else if not precondition then err "invalid_request"
690− else if requestTimestamp > 0 && abs (requestTimestamp - t) > clockSkewTolerance then err "clock_skew"
685+ let err = \e r -> yield (respond {ok: False {}, error: e, retryAfterMs: r})
686+ let preErr =
687+ if elem blocked fromServer then "blocked"
688+ else if count allowed > 0 && not (elem allowed fromServer) then "not_allowed"
689+ else if not precondition then "invalid_request"
690+ else if requestTimestamp > 0 && abs (requestTimestamp - t) > clockSkewTolerance then "clock_skew"
691+ else ""
692+ if preErr != "" then err preErr 0
691693 else do
692694 verified <- verifyFederationAuth authorization fromServer scope requestTimestamp
693− if not verified then err "unauthorized"
695+ if not verified then err "unauthorized" 0
694696 else do
695697 limited <- checkServerRateGate fromServer t
696− if limited then yield (respond {ok: False {}, error: "rate_limited", retryAfterMs: federationRateWindowMs})
698+ if limited then err "rate_limited" federationRateWindowMs
697699 else action
698700
699701-- ============================================
@@ -1288,7 +1290,7 @@ handleAckMessages = \messageIds authorization clientIp respond -> do
12881290handleListMessages = \offset authorization clientIp respond -> do
12891291 t <- now
12901292 let mkErr = \e -> {messages: [], authorized: False {}, count: 0, error: if e == "rate_limited" then "rate_limited" else ""}
1291− gateRated (True {}) authorization clientIp lookupRates maxLookupRatePerKey lookupRateWindowMs t respond mkErr
1293+ gateRated lookupRates maxLookupRatePerKey lookupRateWindowMs (True {}) authorization clientIp t respond mkErr
12921294 {messages: [], authorized: True {}, count: 0, error: "rate_limited"} (\pubkey -> do
12931295 msgs <- *messages
12941296 let myMsgs = sortBy (\m -> m.receivedAt) (filter msgs (\m -> m.toKey == pubkey && m.expiresAt > t))
@@ -1508,9 +1510,6 @@ handleFederationDeliveryReceipt = \messageIds toKeys fromServer requestTimestamp
15081510 yield {senderKey: m.senderKey, messageId: p.messageId, toKey: p.toKey, deliveredAt: t}) 10000 (\d -> d.deliveredAt)
15091511 yield (respond {ok: True {}, error: "", receivedCount: count pairs, retryAfterMs: 0}))
15101512
1511−-- Index a list (1-based by virtue of `count` of the partial fold).
1512−withIndex = fold (\acc x -> union acc [{i: count acc, v: x}]) []
1513−
15141513-- ============================================
15151514-- Maintenance handlers
15161515-- ============================================