@@ -211,8 +211,10 @@ type Session = {token: Text, pubkey: PubkeyHex, expiresAt: Timestamp, ip: Text}
211211-- Mailbox row: a stored message awaiting recipient pickup or federation forward.
212212-- Storage TTL is fixed at `messageMaxAge`, so expiry is derived from
213213-- `receivedAt`. Any send time the sender wants to convey lives inside
214−-- `encryptedBlob` (the server cannot read it).
215−type Message = {toKey: PubkeyHex, encryptedBlob: BlobHex, receivedAt: Timestamp}
214+-- `encryptedBlob` (the server cannot read it). `deliveredTo` records peers
215+-- that have already accepted a federated forward of this blob, so a later
216+-- presence re-announce of `toKey` doesn't trigger a duplicate delivery.
217+type Message = {toKey: PubkeyHex, encryptedBlob: BlobHex, receivedAt: Timestamp, deliveredTo: [ServerName]}
216218-- Last-known location of a pubkey, either local (`server == serverHost`) or
217219-- learned from a peer via gossip. Multiple entries per pubkey are allowed.
218220type PresenceEntry = {pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp}
@@ -466,7 +468,7 @@ appendMessage = \toKey encryptedBlob t -> do
466468 seq <- *seqCounter
467469 let seqTs = max t (seq + 1)
468470 *seqCounter = seqTs
469− *messages = union msgs [{toKey, encryptedBlob, receivedAt: seqTs}]
471+ *messages = union msgs [{toKey, encryptedBlob, receivedAt: seqTs, deliveredTo: []}]
470472
471473-- True when `f` is the queued forward of `blob` to `server`. Used to dedupe
472474-- per-(blob, server) entries on the forwards outbox.
@@ -540,9 +542,10 @@ sendBatchedGossip = \peers events -> when (count events > 0) (do
540542-- as forwards to the newly-known server.
541543
542544-- Walk pending forwards grouped by destination, retry each (up to maxBatchSize
543−-- per peer) using `/federation/forward`. Drops successful entries; for failures
544−-- bumps the retry count and gives up after `maxForwardRetries`.
545−retryPendingForwards : IO {rw *forwardFailures, rw *forwards, network, clock} {}
545+-- per peer) using `/federation/forward`. Drops successful entries and records
546+-- the peer on the message's `deliveredTo`; for failures bumps the retry count
547+-- and gives up after `maxForwardRetries`.
548+retryPendingForwards : IO {rw *forwardFailures, rw *forwards, rw *messages, network, clock} {}
546549retryPendingForwards = do
547550 t <- now
548551 fwds <- *forwards
@@ -562,16 +565,23 @@ retryPendingForwards = do
562565 cur <- *forwards
563566 *forwards = map (\x -> if isMatch x
564567 then {x.toServer, x.toKey, x.encryptedBlob, retries: x.retries + 1}
565− else x) (filter (\x -> not isDone x) cur))))
568+ else x) (filter (\x -> not isDone x) cur)
569+ when success (do
570+ msgs <- *messages
571+ *messages = map (\m -> if m.toKey == f.toKey && m.encryptedBlob == f.encryptedBlob && not elem server m.deliveredTo
572+ then {m.toKey, m.encryptedBlob, m.receivedAt, deliveredTo: union m.deliveredTo [server]}
573+ else m) msgs))))
566574
567575-- Forward queued messages to a server when a remote key comes online.
576+-- Skips messages already delivered to `server` (tracked via Message.deliveredTo)
577+-- so a presence re-announce after a TTL lapse doesn't duplicate delivery.
568578forwardQueuedToServer : PubkeyHex -> ServerName -> IO {rw *forwards, r *messages} {}
569579forwardQueuedToServer = \pubkey server -> atomic (do
570580 msgs <- *messages
571581 fwds <- *forwards
572582 let existing = count (filter (\f -> f.toServer == server) fwds)
573583 let budget = max 0 (maxForwardsPerServer - existing)
574− let candidates = filter (\m -> m.toKey == pubkey && not any (forwardMatches m.encryptedBlob server) fwds) msgs
584+ let candidates = filter (\m -> m.toKey == pubkey && not any (forwardMatches m.encryptedBlob server) fwds && not elem server m.deliveredTo) msgs
575585 let newFwds = map (\m -> {toServer: server, m.toKey, m.encryptedBlob, retries: 0}) (take budget candidates)
576586 *forwards = union fwds newFwds)
577587
@@ -772,14 +782,17 @@ handleSendMessages = \messages authorization clientIp -> do
772782 yield (Ok {value: {}})
773783
774784-- Fire one /federation/forward call per pre-staged server. On success the
775−-- corresponding row in `forwards` is pruned, and if no other forwards remain
776−-- for this blob AND the recipient has no local presence, the backing
777−-- `*messages` row is dropped too: the origin's job is done and the message
778−-- now lives on the receiving peer's mailbox. On failure the forwards row
779−-- stays so `retryPendingForwards` can re-attempt with backoff.
780−forkForwardsTo : PubkeyHex -> BlobHex -> [Text] -> IO {r *presence, rw *forwardFailures, rw *forwards, rw *messages, network, clock} {}
785+-- corresponding row in `forwards` is pruned and the peer is appended to the
786+-- message's `deliveredTo` set. The backing `*messages` row itself stays —
787+-- cleaned up by `ackPolledMessages` when the recipient polls here, or by
788+-- `pruneExpired` once `messageMaxAge` lapses. Keeping the row lets
789+-- `forwardQueuedToServer` re-forward to peers learned after send time (so a
790+-- multi-homed recipient who appears on a new peer post-send still receives
791+-- the message), and `deliveredTo` prevents re-forwards to peers that already
792+-- have the message. On failure the forwards row stays so
793+-- `retryPendingForwards` can re-attempt with backoff.
794+forkForwardsTo : PubkeyHex -> BlobHex -> [Text] -> IO {rw *forwardFailures, rw *forwards, rw *messages, network, clock} {}
781795forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
782− t <- now
783796 result <- fetch (federationUrl server) (ForwardMessage {toKey: to, encryptedBlob})
784797 let same = forwardMatches encryptedBlob server
785798 case result of
@@ -788,14 +801,11 @@ forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
788801 clearFailure server
789802 atomic (do
790803 fwds <- *forwards
791− let remaining = filter (\x -> not same x) fwds
792− *forwards = remaining
793− pres <- *presence
794− let stillLocal = hasLocalPresence pres to t
795− let othersPending = any (\x -> x.toKey == to && x.encryptedBlob == encryptedBlob) remaining
796− when (not (stillLocal || othersPending)) (do
797− msgs <- *messages
798− *messages = filter (\m -> not (m.toKey == to && m.encryptedBlob == encryptedBlob)) msgs)))
804+ *forwards = filter (\x -> not same x) fwds
805+ msgs <- *messages
806+ *messages = map (\m -> if m.toKey == to && m.encryptedBlob == encryptedBlob && not elem server m.deliveredTo
807+ then {m.toKey, m.encryptedBlob, m.receivedAt, deliveredTo: union m.deliveredTo [server]}
808+ else m) msgs))
799809
800810-- ============================================
801811-- Handler: federation receive