@@ -400,15 +400,6 @@ authedPubkey = \authorization t clientIp -> do
400400 Just {value: s} -> yield (Just {value: s.pubkey})
401401 _ -> yield (Nothing {})
402402
403−-- True when `signature` is a valid Ed25519 signature by `pubkey` over `challenge`.
404−-- False on any hex-decoding failure.
405−verifySignature : PubkeyHex -> SignatureHex -> Text -> Bool
406−verifySignature = \pubkey signature challenge -> case bytesFromHex pubkey of
407− Just {value: pk} -> case bytesFromHex signature of
408− Just {value: sigBytes} -> verify pk (textToBytes challenge) sigBytes
409− _ -> False {}
410− _ -> False {}
411−
412403-- ============================================
413404-- Federation failure tracking (simple, no circuit breaker)
414405-- ============================================
@@ -470,6 +461,11 @@ appendMessage = \toKey encryptedBlob t -> do
470461 *messages = union msgs [{toKey, encryptedBlob, receivedAt: seqTs}]
471462 *pollWakeup = seqTs
472463
464+-- True when `f` is the queued forward of `blob` to `server`. Used to dedupe
465+-- per-(blob, server) entries on the forwards outbox.
466+forwardMatches : BlobHex -> ServerName -> ForwardEntry -> Bool
467+forwardMatches = \blob server f -> f.encryptedBlob == blob && f.toServer == server
468+
473469-- Replace any local presence rows for `pubkey` with one fresh row at
474470-- `expiry`, and return the post-update peer broadcast set. Caller wraps in
475471-- `atomic`.
@@ -512,25 +508,17 @@ pruneExpired = \t -> atomic do
512508-- subsystems back off together.
513509
514510-- Fan out one bundle of gossip events to each peer, skipping peers in backoff.
515−-- Records or clears federation-failure counters per call.
511+-- No-op when `events` is empty so callers don't need to guard. Records or
512+-- clears federation-failure counters per call.
516513sendBatchedGossip : [Text] -> [GossipEventType] -> IO {rw *forwardFailures, network, clock} {}
517−sendBatchedGossip = \peers events -> do
514+sendBatchedGossip = \peers events -> when (count events > 0) (do
518515 t <- now
519516 failures <- *forwardFailures
520517 forEach peers (\server -> when (shouldRetryServer server t failures) (do
521518 result <- fetch (federationUrl server) (RecvGossip {events, fromServer: serverHost})
522519 case result of
523520 Err _ -> recordFailure server
524− Ok _ -> clearFailure server))
525−
526−-- Tell known peers that the listed local pubkeys just went offline. No-op when
527−-- the list is empty. Caller is responsible for the `federationEnabled` gate.
528−broadcastOfflineGossip : [{pubkey: PubkeyHex | a}] -> IO {r *presence, rw *forwardFailures, network, clock} {}
529−broadcastOfflineGossip = \expiredLocal -> when (count expiredLocal > 0) (do
530− presence <- *presence
531− sendBatchedGossip (collectPeers presence (\p -> p.server)) (map (\p -> GossipOffline {
532− p.pubkey
533− }) expiredLocal))
521+ Ok _ -> clearFailure server)))
534522
535523-- ============================================
536524-- Forward retries
@@ -558,7 +546,7 @@ retryPendingForwards = do
558546 Ok _ -> do
559547 clearFailure server
560548 yield (True {})
561− let isMatch = \x -> x.encryptedBlob == f.encryptedBlob && x.toServer == server
549+ let isMatch = forwardMatches f.encryptedBlob server
562550 let isDone = \x -> isMatch x && (success || x.retries + 1 >= maxForwardRetries)
563551 atomic (do
564552 cur <- *forwards
@@ -571,7 +559,7 @@ forwardQueuedToServer : PubkeyHex -> ServerName -> IO {rw *forwards, r *messages
571559forwardQueuedToServer = \pubkey server -> atomic (do
572560 msgs <- *messages
573561 fwds <- *forwards
574− let candidates = filter (\m -> m.toKey == pubkey && not any (\f -> f.encryptedBlob == m.encryptedBlob && f.toServer == server) fwds) msgs
562+ let candidates = filter (\m -> m.toKey == pubkey && not any (forwardMatches m.encryptedBlob server) fwds) msgs
575563 let newFwds = map (\m -> {toServer: server, m.toKey, m.encryptedBlob, retries: 0}) (take maxForwardsPerServer candidates)
576564 *forwards = union fwds newFwds)
577565
@@ -616,7 +604,11 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do
616604 t <- now
617605 let expiry = t + sessionExpiry
618606 token <- genToken 48
619− let sigValid = verifySignature pubkey signature challenge
607+ let sigValid = case bytesFromHex pubkey of
608+ Just {value: pk} -> case bytesFromHex signature of
609+ Just {value: sigBytes} -> verify pk (textToBytes challenge) sigBytes
610+ _ -> False {}
611+ _ -> False {}
620612 result <- atomic (do
621613 ch <- *challenges
622614 let same = \c -> c.pubkey == pubkey && c.challenge == challenge
@@ -671,7 +663,7 @@ handlePoll = \cursor authorization clientIp -> do
671663 case setup of
672664 Nothing {} -> yield (Err {error: {status: 401, message: "unauthorized"}})
673665 Just {value: s} -> do
674− when (federationEnabled && count s.refreshPeers > 0) (fork (sendBatchedGossip s.refreshPeers [
666+ when federationEnabled (fork (sendBatchedGossip s.refreshPeers [
675667 GossipOnline {s.pubkey}
676668 ]))
677669 pollResult <- doPoll s t
@@ -752,7 +744,7 @@ handleSendMessages = \messages authorization clientIp -> do
752744 appendMessage c.to c.encryptedBlob t
753745 when federationEnabled (do
754746 fwds <- *forwards
755− let newFwds = map (\s -> {toServer: s, toKey: c.to, encryptedBlob: c.encryptedBlob, retries: 0}) (filter (\s -> not any (\f -> f.encryptedBlob == c.encryptedBlob && f.toServer == s) fwds) c.remoteServers)
747+ let newFwds = map (\s -> {toServer: s, toKey: c.to, encryptedBlob: c.encryptedBlob, retries: 0}) (filter (\s -> not any (forwardMatches c.encryptedBlob s) fwds) c.remoteServers)
756748 *forwards = union fwds newFwds))
757749 yield staged)
758750 when federationEnabled (forEach committed (\c -> fork (forkForwardsTo c.to c.encryptedBlob c.remoteServers)))
@@ -767,7 +759,7 @@ handleSendMessages = \messages authorization clientIp -> do
767759forkForwardsTo : PubkeyHex -> BlobHex -> [Text] -> IO {r *presence, rw *forwardFailures, rw *forwards, rw *messages, network, clock} {}
768760forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
769761 fwds <- *forwards
770− let same = \x -> x.encryptedBlob == encryptedBlob && x.toServer == server
762+ let same = forwardMatches encryptedBlob server
771763 when (any same fwds) (do
772764 t <- now
773765 result <- fetch (federationUrl server) (ForwardMessage {toKey: to, encryptedBlob})
@@ -868,7 +860,9 @@ backgroundPrune = do
868860 t <- now
869861 expiredLocal <- pruneExpired t
870862 when federationEnabled (do
871− fork (broadcastOfflineGossip expiredLocal)
863+ fork (do
864+ pres <- *presence
865+ sendBatchedGossip (collectPeers pres (\p -> p.server)) (map (\p -> GossipOffline {p.pubkey}) expiredLocal))
872866 fork retryPendingForwards)
873867 sleep backgroundPruneInterval
874868 backgroundPrune