@@ -512,10 +512,9 @@ removeForKey = \pred -> do
512512
513513-- If `pred` matches at least maxN items, drop the oldest matching one.
514514capPerKey = \items pred maxN getKey ->
515− let mine = filter items pred in
516− if count mine >= maxN
517− then union (removeWhere items pred) (drop 1 (sortBy getKey mine))
518− else items
515+ let mine = sortBy getKey (filter items pred) in
516+ let dropN = if count mine >= maxN then 1 else 0 in
517+ union (removeWhere items pred) (drop dropN mine)
519518
520519-- Shared empty/error shape for /poll. Only a few fields ever vary.
521520emptyPollResp = \cursor authorized rateLimited draining gen retryAfterMs cursorWasReset ->
@@ -562,7 +561,9 @@ tooLong : Text -> Int -> Bool
562561tooLong = \s maxLen -> count (chars s) > maxLen
563562
564563isValidHex : Text -> Bool
565−isValidHex = \s -> count (chars s) > 0 && mod (count (chars s)) 2 == 0 && all (chars s) (\c -> contains c "0123456789abcdef")
564+isValidHex = \s ->
565+ let cs = chars s in
566+ count cs > 0 && mod (count cs) 2 == 0 && all cs (\c -> contains c "0123456789abcdef")
566567
567568normalizeHex : Text -> Text
568569normalizeHex = \s -> bytesToHex (bytesFromHex s)
@@ -583,7 +584,9 @@ hasPrefix = \pre s -> take (count (chars pre)) s == pre
583584
584585containsSuffix : Text -> Text -> Bool
585586containsSuffix = \suffix s ->
586− drop (max 0 (count (chars s) - count (chars suffix))) s == suffix
587+ let sn = count (chars s) in
588+ let pn = count (chars suffix) in
589+ drop (max 0 (sn - pn)) s == suffix
587590
588591-- Block private/reserved/internal hostnames (SSRF defense). Skips obscure encoding
589592-- tricks (octal, hex, percent-encoding) but covers the high-value cases.
@@ -602,8 +605,9 @@ isBadServerName = \sn ->
602605matchIp = \clientIp sessionIp -> sessionIp == "" || clientIp == sessionIp
603606
604607extractToken = \authHeader ->
605− if hasPrefix "Bearer " authHeader && drop 7 authHeader != "" && not (tooLong (drop 7 authHeader) maxTokenLen)
606− then Just {value: drop 7 authHeader}
608+ let rest = drop 7 authHeader in
609+ if hasPrefix "Bearer " authHeader && rest != "" && not (tooLong rest maxTokenLen)
610+ then Just {value: rest}
607611 else Nothing {}
608612
609613verifyMaintenanceAuth : Text -> IO Bool
@@ -802,8 +806,9 @@ presenceForKey = \presence pubkey t ->
802806
803807-- Resolve a key's server for client lookup, masking remote identities behind "remote".
804808maskedServer = \pres pubkey t ->
805− if any (presenceForKey pres pubkey t) (\p -> isLocalServer p.server) then serverHostN
806− else if count (presenceForKey pres pubkey t) > 0 then "remote"
809+ let here = presenceForKey pres pubkey t in
810+ if any here (\p -> isLocalServer p.server) then serverHostN
811+ else if count here > 0 then "remote"
807812 else ""
808813
809814hasMessage : MessageIdHex -> PubkeyHex -> [{messageId: MessageIdHex, toKey: PubkeyHex | a}] -> Bool
@@ -822,8 +827,9 @@ knownPeerServersFromPresence = \presence -> collectPeers presence (\p -> p.serve
822827-- Last-write-wins merge by (pubkey, server), keeping the entry with the larger expiresAt.
823828mergePresence = \existing incoming ->
824829 fold (\acc e ->
825− if any acc (\x -> x.pubkey == e.pubkey && x.server == e.server && x.expiresAt >= e.expiresAt) then acc
826− else union (removeWhere acc (\x -> x.pubkey == e.pubkey && x.server == e.server)) [e]) existing incoming
830+ let same = \x -> x.pubkey == e.pubkey && x.server == e.server in
831+ if any acc (\x -> same x && x.expiresAt >= e.expiresAt) then acc
832+ else union (removeWhere acc same) [e]) existing incoming
827833
828834-- ============================================
829835-- Pruning
@@ -864,9 +870,10 @@ mkAckedEntry = \m t -> {messageId: m.messageId, toKey: m.toKey, ackedAt: t, orig
864870-- Returns the federated-ack entries (the caller flushes them remotely later).
865871recordAcksAndDeliveries = \toAck t -> do
866872 let ackedFed = mapWhere toAck (\m -> m.originServer != "") (\m -> mkAckedEntry m t)
873+ let myDel = mapWhere toAck (\m -> m.senderKey != "" && m.originServer == "")
874+ (\m -> {senderKey: m.senderKey, messageId: m.messageId, toKey: m.toKey, deliveredAt: t})
867875 appendCapped ackedIds ackedFed maxAckedIds (\a -> a.ackedAt)
868− appendCapped senderDeliveries (mapWhere toAck (\m -> m.senderKey != "" && m.originServer == "")
869− (\m -> {senderKey: m.senderKey, messageId: m.messageId, toKey: m.toKey, deliveredAt: t})) 10000 (\d -> d.deliveredAt)
876+ appendCapped senderDeliveries myDel 10000 (\d -> d.deliveredAt)
870877 yield ackedFed
871878
872879-- Common cancel block: drop matching messages + forwards, record cancel notification.
@@ -1026,10 +1033,10 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp respond ->
10261033 ch <- *challenges
10271034 dp <- *drainPhase
10281035 let same = \c -> c.pubkey == pubkey && c.challenge == challenge
1029− if dp >= 1
1030− || none ch (\c -> same c && c.expiresAt > t && matchIp clientIp c.ip)
1031− || not (verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature))
1032− then yield {valid: False {}, peers: []}
1036+ let valid = dp < 1
1037+ && any ch (\c -> same c && c.expiresAt > t && matchIp clientIp c.ip)
1038+ && verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
1039+ if not valid then yield {valid: False {}, peers: []}
10331040 else do
10341041 set *challenges = removeWhere ch same
10351042 ses <- *sessions
@@ -1115,16 +1122,15 @@ pollOnce = \authorization cursor cursorWasReset watchKeys clientIp serverGen res
11151122 pollResult <- doPoll s t
11161123 atomic (pruneRef activePolls (\p -> p.pubkey != s.pubkey))
11171124 when federationEnabled (fork (sendAcksAndClean s.pendingAcks))
1118− presenceUpdates <- atomic do
1125+ extras <- atomic do
11191126 t2 <- now
11201127 pres <- *presence
1121− yield (pluck watchKeys (\k -> {pubkey: k, online: count (presenceForKey pres k t2) > 0}))
1122− drains <- atomic do
1123− myExp <- collectAndPrune senderExpirations (\x -> x.senderKey == s.pubkey) (\x -> {messageId: x.messageId, toKey: x.toKey, expiredAt: x.expiredAt})
1124− myDel <- collectAndPrune senderDeliveries (\x -> x.senderKey == s.pubkey) (\x -> {messageId: x.messageId, toKey: x.toKey, deliveredAt: x.deliveredAt})
1128+ let mine = \x -> x.senderKey == s.pubkey
1129+ myExp <- collectAndPrune senderExpirations mine (\x -> {messageId: x.messageId, toKey: x.toKey, expiredAt: x.expiredAt})
1130+ myDel <- collectAndPrune senderDeliveries mine (\x -> {messageId: x.messageId, toKey: x.toKey, deliveredAt: x.deliveredAt})
11251131 myCancels <- collectAndPrune cancelNotifications (\x -> x.toKey == s.pubkey) (\x -> {messageId: x.messageId, cancelledAt: x.cancelledAt})
1126− yield {expirations: myExp, deliveries: myDel, cancellations: myCancels}
1127− yield (respond {events: pollResult.events, cursor: pollResult.cursor, authorized: True {}, rateLimited: False {}, draining: False {}, generation: serverGen, presenceUpdates: presenceUpdates, heartbeat: count pollResult.events == 0, retryAfterMs: 0, cursorReset: cursorWasReset, hasMore: pollResult.hasMore, cursorStale: False {}, messageExpirations: drains.expirations, messageDeliveries: drains.deliveries, droppedDeliveryReceipts: 0, droppedExpirationNotifs: 0, loadPct: 0, messageCancellations: drains.cancellations})
1132+ yield {presenceUpdates: pluck watchKeys (\k -> {pubkey: k, online: count (presenceForKey pres k t2) > 0}), expirations: myExp, deliveries: myDel, cancellations: myCancels}
1133+ yield (respond {events: pollResult.events, cursor: pollResult.cursor, authorized: True {}, rateLimited: False {}, draining: False {}, generation: serverGen, presenceUpdates: extras.presenceUpdates, heartbeat: count pollResult.events == 0, retryAfterMs: 0, cursorReset: cursorWasReset, hasMore: pollResult.hasMore, cursorStale: False {}, messageExpirations: extras.expirations, messageDeliveries: extras.deliveries, droppedDeliveryReceipts: 0, droppedExpirationNotifs: 0, loadPct: 0, messageCancellations: extras.cancellations})
11281134
11291135doPoll = \s t -> do
11301136 let collectAt = \tnow -> atomic do