@@ -235,6 +235,9 @@ type PresenceEntry = {pubkey: PubkeyHex, server: ServerName, expiresAt: Timestam
235235-- Identity is derived from `encryptedBlob` (see `Message`).
236236type ForwardEntry = {toServer: ServerName, toKey: PubkeyHex, encryptedBlob: BlobHex, retries: Int}
237237-- Running failure counter for a peer; keyed by `server`. Drives `shouldRetryServer`.
238+-- `failedAt` is the start time of the last recorded attempt; `failures: 0` is
239+-- the post-success tombstone (no backoff, kept so the timestamp can outrank
240+-- slower concurrent failures).
238241type ForwardFailure = {server: Text, failedAt: Timestamp, failures: Int}
239242
240243-- ============================================
@@ -459,6 +462,12 @@ authedPubkey = \authorization t clientIp -> do
459462-- `retryBackoffBase` (capped at `retryBackoffMax`). `shouldRetryServer` is the
460463-- single read-side gate; `recordFailure`/`clearFailure` are the write side.
461464-- There is no half-open state — a single success clears all accumulated failures.
465+-- Concurrent fetches to the same peer can complete out of order, so both
466+-- writers take the attempt-start time and ignore updates older than the
467+-- recorded one (latest-started attempt wins). `clearFailure` therefore writes
468+-- a zero-count row rather than deleting — the timestamp must survive so a
469+-- slower failure can be recognized as stale. Zero-count rows impose no
470+-- backoff and age out of `*forwardFailures` via `pruneExpired`.
462471
463472-- True when enough time has passed since the last failure for `server` to be
464473-- worth retrying (or no failure recorded at all). Linear backoff:
@@ -466,25 +475,35 @@ authedPubkey = \authorization t clientIp -> do
466475shouldRetryServer : Text -> Timestamp -> [ForwardFailure] -> Bool
467476shouldRetryServer = \server t failures -> not any (\f -> f.server == server && t - f.failedAt < min retryBackoffMax (retryBackoffBase * (f.failures : Int))) failures
468477
469−-- Bump the failure counter for `server`.
470−recordFailure : Text -> IO {rw *forwardFailures, clock} {}
471−recordFailure = \server -> do
472− t <- now
473− atomic (do
474− failures <- *forwardFailures
475− let prevCount = case findFirst failures (\f -> f.server == server) of
478+-- Bump the failure counter for `server`. `attemptAt` is when the failed call
479+-- started; the update is skipped when a more recently started attempt has
480+-- already written its outcome.
481+recordFailure : Text -> Timestamp -> IO {rw *forwardFailures} {}
482+recordFailure = \server attemptAt -> atomic (do
483+ failures <- *forwardFailures
484+ let prev = findFirst failures (\f -> f.server == server)
485+ let stale = case prev of
486+ Just {value: f} -> f.failedAt > attemptAt
487+ _ -> False {}
488+ when (not stale) (do
489+ let prevCount = case prev of
476490 Just {value: f} -> f.failures
477491 _ -> 0
478492 *forwardFailures = union (filter (\f -> f.server != server) failures) [
479− {server, failedAt: t, failures: prevCount + 1}
480− ])
481−
482−-- Drop the failure record for `server` (called after any successful peer call).
483−-- Single-success recovery — there is no half-open state.
484−clearFailure : Text -> IO {rw *forwardFailures} {}
485−clearFailure = \server -> atomic (do
486− forwardFailures <- *forwardFailures
487− *forwardFailures = filter (\f -> f.server != server) forwardFailures)
493+ {server, failedAt: attemptAt, failures: prevCount + 1}
494+ ]))
495+
496+-- Reset the failure counter for `server` to zero (called after any successful
497+-- peer call; single-success recovery — there is no half-open state). Keeps a
498+-- zero-count row so its timestamp can outrank slower concurrent failures.
499+clearFailure : Text -> Timestamp -> IO {rw *forwardFailures} {}
500+clearFailure = \server attemptAt -> atomic (do
501+ failures <- *forwardFailures
502+ let stale = any (\f -> f.server == server && f.failedAt > attemptAt) failures
503+ when (not stale) (do
504+ *forwardFailures = union (filter (\f -> f.server != server) failures) [
505+ {server, failedAt: attemptAt, failures: 0}
506+ ]))
488507
489508-- ============================================
490509-- Common helpers
@@ -572,8 +591,8 @@ sendBatchedGossip = \peers events -> when (count events > 0) (do
572591 forEach peers (\server -> when (shouldRetryServer server t failures) (do
573592 result <- fetch (federationUrl server) (RecvGossip {events, fromServer: serverHost})
574593 case result of
575− Err _ -> recordFailure server
576− Ok _ -> clearFailure server)))
594+ Err _ -> recordFailure server t
595+ Ok _ -> clearFailure server t)))
577596
578597-- ============================================
579598-- Forward retries
@@ -597,10 +616,10 @@ retryPendingForwards = do
597616 result <- fetch (federationUrl server) (ForwardMessage {f.toKey, f.encryptedBlob})
598617 success <- case result of
599618 Err _ -> do
600− recordFailure server
619+ recordFailure server t
601620 yield (False {})
602621 Ok _ -> do
603− clearFailure server
622+ clearFailure server t
604623 yield (True {})
605624 let isMatch = forwardMatches f.encryptedBlob server
606625 let isDone = \x -> isMatch x && (success || x.retries + 1 >= maxForwardRetries)
@@ -836,12 +855,13 @@ handleSendMessages = \messages authorization clientIp -> do
836855-- `retryPendingForwards` can re-attempt with backoff.
837856forkForwardsTo : PubkeyHex -> BlobHex -> [Text] -> IO {rw *forwardFailures, rw *forwards, rw *messages, network, clock} {}
838857forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
858+ t <- now
839859 result <- fetch (federationUrl server) (ForwardMessage {toKey: to, encryptedBlob})
840860 let same = forwardMatches encryptedBlob server
841861 case result of
842− Err _ -> recordFailure server
862+ Err _ -> recordFailure server t
843863 Ok _ -> do
844− clearFailure server
864+ clearFailure server t
845865 atomic (do
846866 fwds <- *forwards
847867 *forwards = filter (\x -> not same x) fwds