@@ -572,6 +572,8 @@ serverHostN : Text
572572serverHostN = normalizeServerName serverHost
573573isLocalServer : Text -> Bool
574574isLocalServer = \s -> s == serverHostN
575+isRemote : Text -> Bool
576+isRemote = \s -> not (isLocalServer s)
575577
576578hasPrefix : Text -> Text -> Bool
577579hasPrefix = \pre s -> take (count (chars pre)) s == pre
@@ -697,14 +699,13 @@ withFederationAuth = \authorization t respond fromServer scope requestTimestamp
697699-- ============================================
698700
699701-- Returns {limited, entries}. Increments count when the key fits within the window.
700−-- Simplified: drop any stale/matching entry, then either reject or insert a fresh entry.
701−checkRate = \entries key maxRate windowMs maxEntries t ->
702+checkRate = \entries key maxRate windowMs t ->
702703 let cur = case findFirst entries (\r -> r.key == key && t - r.windowStart < windowMs) of
703704 Just {value: r} -> {windowStart: r.windowStart, count: r.count + 1}
704705 _ -> {windowStart: t, count: 1} in
705706 if cur.count > maxRate
706707 then {limited: True {}, entries: entries}
707− else {limited: False {}, entries: capList (union (removeWhere entries (\x -> x.key == key)) [{key: key, windowStart: cur.windowStart, count: cur.count}]) maxEntries (\r -> r.windowStart)}
708+ else {limited: False {}, entries: capList (union (removeWhere entries (\x -> x.key == key)) [{key: key, windowStart: cur.windowStart, count: cur.count}]) 5000 (\r -> r.windowStart)}
708709
709710checkWindowRate = \windowRef countRef windowMs maxRate t -> atomic do
710711 ws <- *windowRef
@@ -728,7 +729,7 @@ checkIpRateGate = \ip t ->
728729-- Non-atomic version: caller must wrap in `atomic do`.
729730chargeRate = \rateRef key maxRate windowMs t -> do
730731 rates <- *rateRef
731− let r = checkRate rates key maxRate windowMs 5000 t
732+ let r = checkRate rates key maxRate windowMs t
732733 set *rateRef = r.entries
733734 yield r.limited
734735
@@ -767,10 +768,10 @@ recordFailure = \server -> do
767768 failures <- *forwardFailures
768769 let same = \f -> f.server == server
769770 let prev = case findFirst failures same of
770− Just {value: f} -> {count: f.failures + 1, firstFailedAt: f.firstFailedAt}
771− _ -> {count: 1, firstFailedAt: t}
771+ Just {value: f} -> {failures: f.failures + 1, firstFailedAt: f.firstFailedAt}
772+ _ -> {failures: 1, firstFailedAt: t}
772773 set *forwardFailures = union (removeWhere failures same)
773− [{server: server, failedAt: t, failures: prev.count, firstFailedAt: prev.firstFailedAt}]
774+ [{server: server, failedAt: t, failures: prev.failures, firstFailedAt: prev.firstFailedAt}]
774775
775776clearFailure = \server -> atomic (pruneRef forwardFailures (\f -> f.server != server))
776777
@@ -811,7 +812,7 @@ isDuplicateMessage = \mid toKey msgs aids dids ->
811812
812813collectPeers : [a] -> (a -> Text) -> [Text]
813814collectPeers = \items getServer ->
814− unique (filter (pluck items getServer) (\s -> not (isLocalServer s)))
815+ unique (filter (pluck items getServer) isRemote)
815816
816817knownPeerServersFromPresence : [PresenceEntry] -> [Text]
817818knownPeerServersFromPresence = \presence -> collectPeers presence (\p -> p.server)
@@ -882,7 +883,7 @@ cancelOne = \mid to ownerPred t -> atomic do
882883 msgs <- *messages
883884 let matches = \x -> x.messageId == mid && x.toKey == to
884885 let owns = any msgs (\m -> matches m && ownerPred m)
885− when owns (do _ <- applyCancel msgs matches to mid t; yield {})
886+ when owns (do applyCancel msgs matches to mid t; yield {})
886887 yield owns
887888
888889sendBatchedGossip = \peers events hops -> forEach peers (\server -> do
@@ -969,7 +970,7 @@ pruneAndRetry = \t -> do
969970 when federationEnabled (do
970971 fork retryPendingForwards
971972 aids <- *ackedIds
972− fork (sendAcksAndClean (filter aids (\a -> not (isLocalServer a.originServer))))
973+ fork (sendAcksAndClean (filter aids (\a -> isRemote a.originServer)))
973974 lastRefresh <- *lastPresenceRefresh
974975 when (t - lastRefresh >= presenceRefreshInterval) (do
975976 atomic do set *lastPresenceRefresh = t
@@ -981,7 +982,7 @@ refreshLocalPresence = \t -> do
981982 presence <- *presence
982983 let sessionKeys = unique (pluck sessions (\s -> s.pubkey))
983984 let needsRefresh = \p -> isLocalServer p.server && elem sessionKeys p.pubkey && p.expiresAt - t < sessionExpiry / 2
984− let refreshed = pluck (filter presence needsRefresh) (\p -> {pubkey: p.pubkey, server: p.server, expiresAt: t + sessionExpiry, timestamp: t})
985+ let refreshed = mapWhere presence needsRefresh (\p -> {pubkey: p.pubkey, server: p.server, expiresAt: t + sessionExpiry, timestamp: t})
985986 let updated = union (removeWhere presence needsRefresh) refreshed
986987 set *presence = updated
987988 yield {refreshed: refreshed, peers: knownPeerServersFromPresence updated}
@@ -1377,12 +1378,12 @@ handleFederationPubkey = \respond -> do
13771378
13781379handleRecvGossip = \events hopsRemaining fromServer requestTimestamp authorization respond -> do
13791380 t <- now
1380− withFederationAuth authorization t respond fromServer "gossip" requestTimestamp (clamp 0 maxGossipHops hopsRemaining >= 1 && not (isLocalServer fromServer) && count events <= maxGossipEvents) (do
1381+ withFederationAuth authorization t respond fromServer "gossip" requestTimestamp (clamp 0 maxGossipHops hopsRemaining >= 1 && isRemote fromServer && count events <= maxGossipEvents) (do
13811382 newlyOnline <- atomic do
13821383 pres <- *presence
13831384 let validEvents = do
13841385 e <- events
1385− where not (isLocalServer e.server) && e.timestamp <= t + clockSkewTolerance
1386+ where isRemote e.server && e.timestamp <= t + clockSkewTolerance
13861387 let expiresAt = min e.timestamp t + clampTtl e.ttl * 1000
13871388 where expiresAt > t
13881389 yield {pubkey: e.pubkey, server: e.server, expiresAt: expiresAt, timestamp: e.timestamp, eventType: e.eventType}
@@ -1421,7 +1422,7 @@ storeFederated = \toKey encryptedBlob timestamp originServer messageId expiresAt
14211422
14221423handleForwardMessage = \toKey encryptedBlob timestamp originServer messageId fromServer requestTimestamp expiresAt priority authorization respond -> do
14231424 t <- now
1424− withFederationAuth authorization t respond fromServer ("forward:" ++ messageId) requestTimestamp (not (isLocalServer originServer) && not (isLocalServer fromServer)) (do
1425+ withFederationAuth authorization t respond fromServer ("forward:" ++ messageId) requestTimestamp (isRemote originServer && isRemote fromServer) (do
14251426 if t - timestamp > messageMaxAge
14261427 then yield (respond {ok: False {}, error: "stale_timestamp", retryAfterMs: 0})
14271428 else do
@@ -1431,7 +1432,7 @@ handleForwardMessage = \toKey encryptedBlob timestamp originServer messageId fro
14311432handleFederationAck = \messageIds originServer fromServer requestTimestamp authorization respond -> do
14321433 t <- now
14331434 let ackRespond = \r -> respond {ok: r.ok, error: r.error, ackedCount: 0, results: [], retryAfterMs: r.retryAfterMs}
1434− withFederationAuth authorization t ackRespond fromServer "ack" requestTimestamp (isLocalServer originServer && not (isLocalServer fromServer)) (do
1435+ withFederationAuth authorization t ackRespond fromServer "ack" requestTimestamp (isLocalServer originServer && isRemote fromServer) (do
14351436 let dedupedIds = dedupMessageIds messageIds
14361437 result <- atomic do
14371438 fwds <- *forwards
@@ -1454,14 +1455,14 @@ handleFederationAck = \messageIds originServer fromServer requestTimestamp autho
14541455handleFederationCancel = \messageId toKey fromServer requestTimestamp authorization respond -> do
14551456 t <- now
14561457 let cancelRespond = \r -> respond {ok: r.ok, error: r.error, cancelled: False {}, retryAfterMs: r.retryAfterMs}
1457− withFederationAuth authorization t cancelRespond fromServer ("cancel:" ++ messageId) requestTimestamp (not (isLocalServer fromServer)) (do
1458+ withFederationAuth authorization t cancelRespond fromServer ("cancel:" ++ messageId) requestTimestamp (isRemote fromServer) (do
14581459 cancelled <- cancelOne messageId toKey (\m -> m.originServer == fromServer) t
14591460 yield (respond {ok: True {}, error: "", cancelled: cancelled, retryAfterMs: 0}))
14601461
14611462handleFederationBatchCancel = \cancels fromServer requestTimestamp authorization respond -> do
14621463 t <- now
14631464 let batchRespond = \r -> respond {ok: r.ok, error: r.error, results: [], retryAfterMs: r.retryAfterMs}
1464− withFederationAuth authorization t batchRespond fromServer "cancel-batch" requestTimestamp (not (isLocalServer fromServer) && count cancels <= maxBatchSize) (do
1465+ withFederationAuth authorization t batchRespond fromServer "cancel-batch" requestTimestamp (isRemote fromServer && count cancels <= maxBatchSize) (do
14651466 results <- mapEach (takeRelation maxBatchSize cancels) (\e -> do
14661467 cancelled <- cancelOne e.messageId e.toKey (\m -> m.originServer == fromServer) t
14671468 yield {messageId: e.messageId, cancelled: cancelled})
@@ -1470,7 +1471,7 @@ handleFederationBatchCancel = \cancels fromServer requestTimestamp authorization
14701471handleFederationBatchForward = \forwards fromServer requestTimestamp authorization respond -> do
14711472 t <- now
14721473 let batchRespond = \r -> respond {ok: r.ok, error: r.error, results: [], retryAfterMs: r.retryAfterMs}
1473− withFederationAuth authorization t batchRespond fromServer "forward-batch" requestTimestamp (not (isLocalServer fromServer) && count forwards <= maxBatchSize) (do
1474+ withFederationAuth authorization t batchRespond fromServer "forward-batch" requestTimestamp (isRemote fromServer && count forwards <= maxBatchSize) (do
14741475 results <- mapEach (takeRelation maxBatchSize forwards) (\e -> do
14751476 ok <- if isLocalServer e.originServer || t - e.timestamp > messageMaxAge then yield False
14761477 else do
@@ -1482,7 +1483,7 @@ handleFederationBatchForward = \forwards fromServer requestTimestamp authorizati
14821483handleFederationDeliveryReceipt = \messageIds toKeys fromServer requestTimestamp authorization respond -> do
14831484 t <- now
14841485 let receiptRespond = \r -> respond {ok: r.ok, error: r.error, receivedCount: 0, retryAfterMs: r.retryAfterMs}
1485− withFederationAuth authorization t receiptRespond fromServer "delivery-receipt" requestTimestamp (not (isLocalServer fromServer) && count messageIds <= maxMessageIds) (do
1486+ withFederationAuth authorization t receiptRespond fromServer "delivery-receipt" requestTimestamp (isRemote fromServer && count messageIds <= maxMessageIds) (do
14861487 if count messageIds != count toKeys
14871488 then yield (respond {ok: False {}, error: "mismatched_lengths", receivedCount: 0, retryAfterMs: 0})
14881489 else do
@@ -1612,7 +1613,7 @@ handleAdminRevokeSessions = \pubkey authorization respond -> withMaintAuth autho
16121613 ses <- *sessions
16131614 let same = \s -> s.pubkey == pubkey
16141615 set *sessions = removeWhere ses same
1615− pruneRef presence (\p -> p.pubkey != pubkey || not (isLocalServer p.server))
1616+ pruneRef presence (\p -> p.pubkey != pubkey || isRemote p.server)
16161617 yield (countWhere ses same)
16171618 yield (respond {ok: True {}, revokedCount: revoked}))
16181619
@@ -1652,7 +1653,7 @@ handleAdminListAllSessions = \limit authorization respond -> withMaintAuth autho
16521653 count: count mine,
16531654 ips: unique (mapWhere mine (\s -> s.ip != "") (\s -> s.ip)),
16541655 latestExpiry: fold (\acc s -> max acc s.expiresAt) 0 mine})
1655− let cap = if limit <= 0 then 100 else clamp 1 500 limit
1656+ let cap = clamp 1 500 (if limit <= 0 then 100 else limit)
16561657 let top = takeRelation cap (sortBy (\g -> 0 - g.count) grouped)
16571658 yield (respond {sessions: top, ok: True {}, total: count grouped}))
16581659
@@ -1746,7 +1747,7 @@ handleTopRecipients = \limit authorization respond -> withMaintAuth authorizatio
17461747 (do
17471748 msgs <- *messages
17481749 let counts = pluck (unique (pluck msgs (\m -> m.toKey))) (\pk -> {pubkey: pk, count: countWhere msgs (\m -> m.toKey == pk)})
1749− let cap = if limit <= 0 then 20 else clamp 1 100 limit
1750+ let cap = clamp 1 100 (if limit <= 0 then 20 else limit)
17501751 let top = takeRelation cap (sortBy (\c -> 0 - c.count) counts)
17511752 yield (respond {recipients: top, ok: True {}, total: count counts}))
17521753