@@ -882,31 +882,44 @@ api = serve Api where
882882-- ============================================
883883-- Background loops
884884-- ============================================
885−-- `backgroundPrune` runs the prune/retry sweep every `backgroundPruneInterval` ms.
886−
887−-- Endless tick: prune expired state, gossip offline for locally-expired keys,
888−-- and retry pending forwards. First sweep happens immediately so stale rows
889−-- persisted by the previous process clear before the next interval elapses.
890−backgroundPrune : IO {rw *challenges, rw *forwardFailures, rw *forwards, rw *messages, rw *presence, rw *sessions, network, clock} a
885+-- `backgroundPrune` runs the prune sweep every `backgroundPruneInterval` ms.
886+-- `backgroundRetryForwards` runs the forward-retry sweep on the same cadence
887+-- but as its own sequential loop so two retries can't race.
888+
889+-- Endless tick: prune expired state and gossip offline for locally-expired
890+-- keys. First sweep happens immediately so stale rows persisted by the
891+-- previous process clear before the next interval elapses.
892+backgroundPrune : IO {rw *challenges, rw *forwardFailures, rw *messages, rw *presence, rw *sessions, network, clock} a
891893backgroundPrune = do
892894 t <- now
893895 expiredLocal <- pruneExpired t
894− when federationEnabled (do
895− fork (do
896− pres <- *presence
897− sendBatchedGossip (collectPeers pres (\p -> p.server)) (map (\pk -> GossipOffline {pubkey: pk}) expiredLocal))
898− fork retryPendingForwards)
896+ when federationEnabled (fork (do
897+ pres <- *presence
898+ sendBatchedGossip (collectPeers pres (\p -> p.server)) (map (\pk -> GossipOffline {pubkey: pk}) expiredLocal)))
899899 sleep backgroundPruneInterval
900900 backgroundPrune
901901
902+-- Endless tick: retry pending cross-server forwards. Calls
903+-- `retryPendingForwards` inline (not via `fork`) so a slow run blocks the
904+-- next iteration instead of racing with itself — two concurrent runs would
905+-- see the same `*forwards` snapshot and double-count `recordFailure`,
906+-- inflating the per-peer backoff multiplier.
907+backgroundRetryForwards : IO {rw *forwardFailures, rw *forwards, rw *messages, network, clock} a
908+backgroundRetryForwards = do
909+ retryPendingForwards
910+ sleep backgroundPruneInterval
911+ backgroundRetryForwards
912+
902913-- ============================================
903914-- Entry Point
904915-- ============================================
905916-- Fork the background prune loop (which runs an immediate sweep on its
906−-- first tick) and start the HTTP listener.
917+-- first tick) and start the HTTP listener. The forward-retry loop only
918+-- runs when federation is enabled.
907919main : IO _ {}
908920main = do
909921 logInfo ("Skrepka relay server starting on " ++ bindHost ++ ":" ++ show listenPort ++ " ...")
910922 logInfo (" federation: " ++ (if federationEnabled then "enabled" else "disabled"))
911923 fork backgroundPrune
924+ when federationEnabled (fork backgroundRetryForwards)
912925 listenOn bindHost listenPort api