@@ -438,12 +438,16 @@ safeCompare = \a b ->
438 safeCompareLoop a b maxTokenLen 0 + (if a == "" then 1 else 0) + (if b == "" then 1 else 0) == 0
438 safeCompareLoop a b maxTokenLen 0 + (if a == "" then 1 else 0) + (if b == "" then 1 else 0) == 0
440evictOneOldest = \items getKey ->
440evictOneOldest = \items getKey ->
441− let oldest = fold (\acc x -> let k = getKey x in if acc == -1 || k < acc then k else acc) (-1) items in
441+ let oldest = fold (\acc x -> let k = getKey x in case acc of
442+ Nothing {} -> Just {value: k}
443+ Just {value: v} -> if k < v then Just {value: k} else acc) Nothing {} items in
442− if oldest == -1 then items
444+ case oldest of
446+ Just {value: oldestKey} ->
443− else (fold (\acc x ->
447+ (fold (\acc x ->
444− if not acc.removed && getKey x == oldest
448+ if not acc.removed && getKey x == oldestKey
445− then {removed: True {}, items: acc.items}
449+ then {removed: True {}, items: acc.items}
446− else {removed: acc.removed, items: union acc.items [x]}) {removed: False {}, items: []} items).items
450+ else {removed: acc.removed, items: union acc.items [x]}) {removed: False {}, items: []} items).items
448capPerKey = \items matchKey maxPerKey getExpiry t ->
452capPerKey = \items matchKey maxPerKey getExpiry t ->
449 let activeCount = count (do x <- items; where matchKey x; where getExpiry x > t; yield x) in
453 let activeCount = count (do x <- items; where matchKey x; where getExpiry x > t; yield x) in
@@ -655,9 +659,8 @@ pruneAndRetry = \t -> do
655 forwards <- *forwards
659 forwards <- *forwards
656 ackedIds <- *ackedIds
660 ackedIds <- *ackedIds
657 let pendingAcks = do a <- ackedIds; where isFederatedOrigin a.originServer; yield a
661 let pendingAcks = do a <- ackedIds; where isFederatedOrigin a.originServer; yield a
658− yield {pr: pr, pendingForwards: forwards, pendingAcks: pendingAcks}
662+ yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: forwards, pendingAcks: pendingAcks}
660− broadcastOfflineGossip t pr.peerServers pr.expiredLocal
663+ broadcastOfflineGossip t result.peerServers result.expiredLocal
661 when (federationEnabled && count result.pendingForwards > 0)
664 when (federationEnabled && count result.pendingForwards > 0)
662 (retryPendingForwards result.pendingForwards)
665 (retryPendingForwards result.pendingForwards)
663 when (federationEnabled && count result.pendingAcks > 0) (do
666 when (federationEnabled && count result.pendingAcks > 0) (do
@@ -1054,12 +1057,15 @@ serve = \req -> case req of
1054 t <- now
1057 t <- now
1055 let authorized = verifyFederationAuth authorization
1058 let authorized = verifyFederationAuth authorization
1056 let validOrigin = isFederatedOrigin originServer
1059 let validOrigin = isFederatedOrigin originServer
1057− let clampedTs = clampTimestamp timestamp t
1058− result <- atomic do
1060− if not (authorized && validOrigin)
1060+ if not (authorized && validOrigin)
1062+ pruneResult <- atomic do maybePrune t
1063+ forkBroadcastOffline t pruneResult
1061− then yield {pr: pr, ok: False {}}
1064+ yield (respond {ok: False {}})
1062− else do
1065+ else do
1066+ let clampedTs = clampTimestamp timestamp t
1067+ result <- atomic do
1063 messages <- *messages
1069 messages <- *messages
1064 ackedIds <- *ackedIds
1070 ackedIds <- *ackedIds
1065 if any messages (\m -> m.messageId == messageId && m.toKey == toKey)
1071 if any messages (\m -> m.messageId == messageId && m.toKey == toKey)
@@ -1075,8 +1081,8 @@ serve = \req -> case req of
1075 [{messageId: messageId, toKey: toKey, fromKey: fromKey,
1081 [{messageId: messageId, toKey: toKey, fromKey: fromKey,
1076 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs}]
1082 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs}]
1077 yield {pr: pr, ok: True {}}
1083 yield {pr: pr, ok: True {}}
1078− forkBroadcastOffline t result.pr
1084+ forkBroadcastOffline t result.pr
1079− yield (respond {ok: result.ok})
1085+ yield (respond {ok: result.ok})
1081 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
1087 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
1082 let fromServer = normalizeServerName fromServer
1088 let fromServer = normalizeServerName fromServer
@@ -1087,16 +1093,12 @@ serve = \req -> case req of
1087 let validAck = authorized && originServer == serverHostN && not (fromServer == serverHostN)
1093 let validAck = authorized && originServer == serverHostN && not (fromServer == serverHostN)
1088 pruneResult <- atomic do
1094 pruneResult <- atomic do
1089 pr <- maybePrune t
1095 pr <- maybePrune t
1090− forwards <- *forwards
1097+ forwards <- *forwards
1091− let forwardsToRemove = do
1098+ set *forwards = do
1092− f <- forwards
1099+ f <- forwards
1094− where f.messageId == mid
1095− where f.toServer == fromServer
1100+ where not (f.toServer == fromServer && any dedupedIds (\mid -> f.messageId == mid))
1096− yield f
1101+ yield f)
1097− set *forwards = if validAck
1098− then diff forwards forwardsToRemove
1100 yield pr
1102 yield pr
1101 forkBroadcastOffline t pruneResult
1103 forkBroadcastOffline t pruneResult
1102 yield (respond {ok: validAck})
1104 yield (respond {ok: validAck})