@@ -115,6 +115,10 @@ retryBackoffBase = 30000
115115-- Cap on federation retry backoff (8 min).
116116retryBackoffMax : Int<Ms>
117117retryBackoffMax = 480000
118+-- How long a peer's failure record survives past its most recent failure (24 h).
119+-- After this, accumulated backoff resets — the next attempt is treated as fresh.
120+forwardFailureMaxAge : Int<Ms>
121+forwardFailureMaxAge = 86400000
118122
119123-- Cadence of the background prune/cleanup task (30 s).
120124backgroundPruneInterval : Int<Ms>
@@ -399,25 +403,18 @@ clientIpOf = \h -> case h of
399403 Just {value: ip} -> ip
400404 Nothing {} -> ""
401405
402−-- Pull the token out of an `Authorization: Bearer <token>` header. Returns
403−-- Nothing if the prefix is missing or the token is empty.
404−extractToken : Text -> Maybe Text
405−extractToken = \h ->
406− let token = drop 7 h
407− if hasPrefix "Bearer " h && token != ""
408− then Just {value: token}
409− else Nothing {}
410−
411406-- Resolve a Bearer token to its session pubkey if the session is unexpired and
412407-- the client IP matches. Runs `onAuth pubkey` on success, `onUnauth` otherwise.
413408withSessionAuth : Text -> Int<Ms> -> Text -> IO e a -> (PubkeyHex -> IO e a) -> IO {r *sessions | e} a
414409withSessionAuth = \authorization t clientIp onUnauth onAuth -> do
415410 ses <- *sessions
416− case extractToken authorization of
417− Nothing {} -> onUnauth
418− Just {value: token} -> case findFirst ses (\s -> s.expiresAt > t && s.token == token && matchIp clientIp s.ip) of
419− Just {value: s} -> onAuth s.pubkey
420− _ -> onUnauth
411+ let token = drop 7 authorization
412+ let match = if hasPrefix "Bearer " authorization && token != ""
413+ then findFirst ses (\s -> s.expiresAt > t && s.token == token && matchIp clientIp s.ip)
414+ else Nothing {}
415+ case match of
416+ Just {value: s} -> onAuth s.pubkey
417+ _ -> onUnauth
421418
422419-- True when `signature` is a valid Ed25519 signature by `pubkey` over `challenge`.
423420-- False on any hex-decoding failure.
@@ -471,11 +468,6 @@ clearFailure = \server -> atomic (do
471468-- generation, presence queries, and atomic mailbox/presence writes
472469-- (callers supply the surrounding `atomic` block).
473470
474−-- All unexpired presence rows for a given pubkey (may include both local and
475−-- remote entries — the recipient may live on multiple servers simultaneously).
476−presenceForKey : [PresenceEntry] -> PubkeyHex -> Timestamp -> [PresenceEntry]
477−presenceForKey = \presence pubkey t -> filter (\p -> p.pubkey == pubkey && p.expiresAt > t) presence
478−
479471-- True when `pk` has a live local presence row (i.e. is currently online here).
480472hasLocalPresence : [PresenceEntry] -> PubkeyHex -> Timestamp -> Bool
481473hasLocalPresence = \pres pk t -> any (\p -> p.pubkey == pk && isLocalServer p.server && p.expiresAt > t) pres
@@ -527,7 +519,7 @@ pruneExpired = \t -> atomic do
527519 msgs <- *messages
528520 *messages = filter (\m -> t - m.receivedAt < messageMaxAge) msgs
529521 ff <- *forwardFailures
530− *forwardFailures = filter (\f -> t - f.failedAt < 86400000) ff
522+ *forwardFailures = filter (\f -> t - f.failedAt < forwardFailureMaxAge) ff
531523 -- presence: remember locally-expired keys for offline gossip
532524 pres <- *presence
533525 *presence = filter (\p -> p.expiresAt > t) pres
@@ -688,8 +680,7 @@ handlePoll = \cursor authorization clientIp -> do
688680 when (clampedCursor > 0) (ackPolledMessages pubkey clampedCursor)
689681 startWakeup <- *pollWakeup
690682 pres <- *presence
691− let mine = \p -> p.pubkey == pubkey && isLocalServer p.server
692− let stale = not any (\p -> mine p && p.expiresAt - t >= sessionExpiry / 2) pres
683+ let stale = not any (\p -> p.pubkey == pubkey && isLocalServer p.server && p.expiresAt - t >= sessionExpiry / 2) pres
693684 refreshPeers <- if stale
694685 then refreshLocalPresence pubkey (t + sessionExpiry)
695686 else yield []
@@ -773,7 +764,7 @@ handleSendMessages = \messages authorization clientIp -> do
773764 let staged = map (\m -> {
774765 m.to,
775766 m.encryptedBlob,
776− remoteServers: collectPeers (presenceForKey pres m.to t) (\p -> p.server)
767+ remoteServers: collectPeers (filter (\p -> p.pubkey == m.to && p.expiresAt > t) pres) (\p -> p.server)
777768 }) limited
778769 forEach staged (\c -> commitSendMessage c.to c.encryptedBlob c.remoteServers t)
779770 yield staged)