@@ -491,13 +491,19 @@ headOf = \items -> fold (\acc x -> case acc of
491-- Sort then take head: O(n log n) but no fold-with-Maybe boilerplate.
491-- Sort then take head: O(n log n) but no fold-with-Maybe boilerplate.
492minBy = \items getKey -> headOf (sortBy getKey items)
492minBy = \items getKey -> headOf (sortBy getKey items)
494−-- Drop entries with the oldest key (LRU-style eviction; ties drop together).
494+-- LRU-style eviction: drop the single entry with the smallest key.
495−-- O(n^2): keep entries that have something strictly smaller below them.
496−evictOldest = \items getKey -> filter items (\x -> any items (\y -> getKey y < getKey x))
495+evictOldest = \items getKey -> drop 1 (sortBy getKey items)
498capList = \items maxN getKey ->
497capList = \items maxN getKey ->
499 if count items > maxN then evictOldest items getKey else items
498 if count items > maxN then evictOldest items getKey else items
500+-- If `pred` matches at least maxN items, drop the oldest matching one.
501+capPerKey = \items pred maxN getKey ->
502+ let mine = filter items pred in
503+ if count mine >= maxN
504+ then union (removeWhere items pred) (evictOldest mine getKey)
501-- Shared empty/error shape for /poll. Only a few fields ever vary.
507-- Shared empty/error shape for /poll. Only a few fields ever vary.
502emptyPollResp = \cursor authorized rateLimited draining gen retryAfterMs cursorWasReset ->
508emptyPollResp = \cursor authorized rateLimited draining gen retryAfterMs cursorWasReset ->
503 {events: [], cursor: cursor, authorized: authorized, rateLimited: rateLimited, draining: draining, generation: gen, presenceUpdates: [], heartbeat: False {}, retryAfterMs: retryAfterMs, cursorReset: cursorWasReset, hasMore: False {}, cursorStale: False {}, messageExpirations: [], messageDeliveries: [], droppedDeliveryReceipts: 0, droppedExpirationNotifs: 0, loadPct: 0, messageCancellations: []}
509 {events: [], cursor: cursor, authorized: authorized, rateLimited: rateLimited, draining: draining, generation: gen, presenceUpdates: [], heartbeat: False {}, retryAfterMs: retryAfterMs, cursorReset: cursorWasReset, hasMore: False {}, cursorStale: False {}, messageExpirations: [], messageDeliveries: [], droppedDeliveryReceipts: 0, droppedExpirationNotifs: 0, loadPct: 0, messageCancellations: []}
@@ -525,15 +531,10 @@ hexDigit : Int -> Text
525hexDigit = \n -> take 1 (drop (clamp 0 15 n) "0123456789abcdef")
531hexDigit = \n -> take 1 (drop (clamp 0 15 n) "0123456789abcdef")
527byteToHex : Int -> Text
533byteToHex : Int -> Text
528−byteToHex = \n -> hexDigit (n / 16) ++ hexDigit (n - (n / 16) * 16)
534+byteToHex = \n -> let m = n - n / 256 * 256 in hexDigit (m / 16) ++ hexDigit (m - m / 16 * 16)
530intTo3Hex : Int -> Text
536intTo3Hex : Int -> Text
531−intTo3Hex = \n ->
537+intTo3Hex = \n -> byteToHex (n / 65536) ++ byteToHex (n / 256) ++ byteToHex n
532− let b0 = n / 65536 in
533− let r0 = n - b0 * 65536 in
534− let b1 = r0 / 256 in
535− let b2 = r0 - b1 * 256 in
536− byteToHex b0 ++ byteToHex b1 ++ byteToHex b2
538genTokenN = \n -> if n <= 0 then yield "" else do
539genTokenN = \n -> if n <= 0 then yield "" else do
539 chunk <- randomInt 16777216
540 chunk <- randomInt 16777216
@@ -596,9 +597,9 @@ extractToken = \authHeader ->
596verifyMaintenanceAuth : Text -> IO Bool
597verifyMaintenanceAuth : Text -> IO Bool
597verifyMaintenanceAuth = \authorization -> do
598verifyMaintenanceAuth = \authorization -> do
598 secret <- *runtimeMaintenanceSecret
599 secret <- *runtimeMaintenanceSecret
599− case extractToken authorization of
600+ yield (case extractToken authorization of
600− Just {value: token} -> yield (secret != "" && token == secret)
601+ Just {value: token} -> secret != "" && token == secret
601− _ -> yield False
602+ _ -> False)
603withMaintAuth = \authorization onUnauth onAuth -> do
604withMaintAuth = \authorization onUnauth onAuth -> do
604 authorized <- verifyMaintenanceAuth authorization
605 authorized <- verifyMaintenanceAuth authorization
@@ -697,13 +698,12 @@ withFederationAuth = \authorization t respond fromServer scope requestTimestamp
697-- Returns {limited, entries}. Increments count when the key fits within the window.
698-- Returns {limited, entries}. Increments count when the key fits within the window.
698-- Simplified: drop any stale/matching entry, then either reject or insert a fresh entry.
699-- Simplified: drop any stale/matching entry, then either reject or insert a fresh entry.
699checkRate = \entries key maxRate windowMs maxEntries t ->
700checkRate = \entries key maxRate windowMs maxEntries t ->
700− let cur = findFirst entries (\r -> r.key == key && t - r.windowStart < windowMs) in
701+ let cur = case findFirst entries (\r -> r.key == key && t - r.windowStart < windowMs) of
701− let nextCount = case cur of Just {value: r} -> r.count + 1; _ -> 1 in
702+ Just {value: r} -> {windowStart: r.windowStart, count: r.count + 1}
703+ _ -> {windowStart: t, count: 1} in
702− if nextCount > maxRate
704+ if cur.count > maxRate
703 then {limited: True {}, entries: entries}
705 then {limited: True {}, entries: entries}
705− let windowStart = case cur of Just {value: r} -> r.windowStart; _ -> t in
706− {limited: False {}, entries: capList (union (removeWhere entries (\x -> x.key == key)) [{key: key, windowStart: windowStart, count: nextCount}]) maxEntries (\r -> r.windowStart)}
706+ else {limited: False {}, entries: capList (union (removeWhere entries (\x -> x.key == key)) [{key: key, windowStart: cur.windowStart, count: cur.count}]) maxEntries (\r -> r.windowStart)}
708checkWindowRate = \windowRef countRef windowMs maxRate t -> atomic do
708checkWindowRate = \windowRef countRef windowMs maxRate t -> atomic do
709 ws <- *windowRef
709 ws <- *windowRef
@@ -989,10 +989,7 @@ handleChallenge = \pubkey clientIp respond -> do
989 result <- atomic do
989 result <- atomic do
990 ch <- *challenges
990 ch <- *challenges
991 let active = filter ch (\c -> c.expiresAt > t)
991 let active = filter ch (\c -> c.expiresAt > t)
992− let mine = filter active (\c -> c.pubkey == pubkey)
993− let cappedActive = if count mine >= maxChallengesPerKey
992+ let cappedActive = capPerKey active (\c -> c.pubkey == pubkey) maxChallengesPerKey (\c -> c.expiresAt)
994− then union (removeWhere active (\c -> c.pubkey == pubkey)) (evictOldest mine (\c -> c.expiresAt))
996 rates <- *challengeRates
993 rates <- *challengeRates
997 let r = checkRate rates pubkey maxChallengeRatePerKey challengeRateWindowMs 5000 t
994 let r = checkRate rates pubkey maxChallengeRatePerKey challengeRateWindowMs 5000 t
998 if count cappedActive >= maxChallenges then yield {ok: False {}, error: "capacity"}
995 if count cappedActive >= maxChallenges then yield {ok: False {}, error: "capacity"}
@@ -1020,10 +1017,7 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp respond ->
1020 set *challenges = removeWhere ch (\c -> c.pubkey == pubkey && c.challenge == challenge)
1017 set *challenges = removeWhere ch (\c -> c.pubkey == pubkey && c.challenge == challenge)
1021 ses <- *sessions
1018 ses <- *sessions
1022 let kept = if revokeOthers then removeWhere ses (\s -> s.pubkey == pubkey) else ses
1019 let kept = if revokeOthers then removeWhere ses (\s -> s.pubkey == pubkey) else ses
1023− let forKey = filter kept (\s -> s.pubkey == pubkey)
1024− let afterPerKey = if count forKey >= maxSessionsPerKey
1020+ let afterPerKey = capPerKey kept (\s -> s.pubkey == pubkey) maxSessionsPerKey (\s -> s.expiresAt)
1025− then union (removeWhere kept (\s -> s.pubkey == pubkey)) (evictOldest forKey (\s -> s.expiresAt))
1027 set *sessions = capList (union afterPerKey [{token: token, pubkey: pubkey, expiresAt: expiry, ip: clientIp, createdAt: t}]) maxSessions (\s -> s.expiresAt)
1021 set *sessions = capList (union afterPerKey [{token: token, pubkey: pubkey, expiresAt: expiry, ip: clientIp, createdAt: t}]) maxSessions (\s -> s.expiresAt)
1028 pres <- *presence
1022 pres <- *presence
1029 let withoutLocal = removeWhere pres (\p -> p.pubkey == pubkey && isLocalServer p.server)
1023 let withoutLocal = removeWhere pres (\p -> p.pubkey == pubkey && isLocalServer p.server)