@@ -460,7 +460,8 @@ pruneExpired = \t -> atomic do
460460 -- presence: remember locally-expired keys for offline gossip
461461 pres <- *presence
462462 *presence = filter (\p -> p.expiresAt > t) pres
463− yield (map (\p -> p.pubkey) (filter (\p -> p.expiresAt <= t && isLocalServer p.server && not (hasLocalPresence pres p.pubkey t)) pres))
463+ let liveLocalPubkeys = map (\p -> p.pubkey) (filter (\p -> isLocalServer p.server && p.expiresAt > t) pres)
464+ yield (map (\p -> p.pubkey) (filter (\p -> p.expiresAt <= t && isLocalServer p.server && not elem p.pubkey liveLocalPubkeys) pres))
464465
465466-- ============================================
466467-- Federation gossip
@@ -728,25 +729,23 @@ handleSendMessages = \messages authorization clientIp -> do
728729-- stays so `retryPendingForwards` can re-attempt with backoff.
729730forkForwardsTo : PubkeyHex -> BlobHex -> [Text] -> IO {r *presence, rw *forwardFailures, rw *forwards, rw *messages, network, clock} {}
730731forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
731− fwds <- *forwards
732+ t <- now
733+ result <- fetch (federationUrl server) (ForwardMessage {toKey: to, encryptedBlob})
732734 let same = forwardMatches encryptedBlob server
733− when (any same fwds) (do
734− t <- now
735− result <- fetch (federationUrl server) (ForwardMessage {toKey: to, encryptedBlob})
736− case result of
737− Err _ -> recordFailure server
738− Ok _ -> do
739− clearFailure server
740− atomic (do
741− fwds2 <- *forwards
742− let remaining = filter (\x -> not same x) fwds2
743− *forwards = remaining
744− pres <- *presence
745− let stillLocal = hasLocalPresence pres to t
746− let othersPending = any (\x -> x.encryptedBlob == encryptedBlob) remaining
747− when (not (stillLocal || othersPending)) (do
748− msgs <- *messages
749− *messages = filter (\m -> m.encryptedBlob != encryptedBlob) msgs))))
735+ case result of
736+ Err _ -> recordFailure server
737+ Ok _ -> do
738+ clearFailure server
739+ atomic (do
740+ fwds <- *forwards
741+ let remaining = filter (\x -> not same x) fwds
742+ *forwards = remaining
743+ pres <- *presence
744+ let stillLocal = hasLocalPresence pres to t
745+ let othersPending = any (\x -> x.encryptedBlob == encryptedBlob) remaining
746+ when (not (stillLocal || othersPending)) (do
747+ msgs <- *messages
748+ *messages = filter (\m -> m.encryptedBlob != encryptedBlob) msgs)))
750749
751750-- ============================================
752751-- Handler: federation receive
@@ -769,16 +768,16 @@ handleRecvGossip = \events fromServer -> do
769768 else do
770769 newlyOnline <- atomic (do
771770 pres <- *presence
772− let touchedPubkeys = fold (\acc e -> case e of
773− GossipOnline {pubkey} -> union acc [pubkey]
774− GossipOffline {pubkey} -> union acc [pubkey]
775− _ -> acc) [] events
776− let added = fold (\acc e -> case e of
777− GossipOnline {pubkey} -> union acc [{pubkey, server: fromServer, expiresAt: t + onlineGossipTtl}]
778− _ -> acc) [] events
779− let kept = filter (\p -> p.server != fromServer || not elem p.pubkey touchedPubkeys) pres
780− *presence = union kept added
781− yield (filter (\pk -> not any (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t) pres) (map (\p -> p.pubkey) added)))
771+ let collected = fold (\acc e -> case e of
772+ GossipOnline {pubkey} -> {
773+ touched: union acc.touched [pubkey],
774+ added: union acc.added [{pubkey, server: fromServer, expiresAt: t + onlineGossipTtl}]
775+ }
776+ GossipOffline {pubkey} -> {acc.added, touched: union acc.touched [pubkey]}
777+ _ -> acc) {touched: [], added: []} events
778+ let kept = filter (\p -> p.server != fromServer || not elem p.pubkey collected.touched) pres
779+ *presence = union kept collected.added
780+ yield (filter (\pk -> not any (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t) pres) (map (\p -> p.pubkey) collected.added)))
782781 fork (forEach newlyOnline (\pk -> forwardQueuedToServer pk fromServer))
783782 yield (Ok {value: {}})
784783