@@ -399,9 +399,9 @@ clientIpOf = \h -> case h of
399399-- Pull the token out of an `Authorization: Bearer <token>` header. Returns
400400-- Nothing if the prefix is missing or the token is empty.
401401extractToken : Text -> Maybe Text
402−extractToken = \h -> if hasPrefix "Bearer " h && drop 7 h != ""
403−then Just {value: drop 7 h}
404−else Nothing {}
402+extractToken = \h -> (\token -> if hasPrefix "Bearer " h && token != ""
403+then Just {value: token}
404+else Nothing {}) (drop 7 h)
405405
406406-- Resolve a Bearer token to its session pubkey if the session is unexpired and
407407-- the client IP matches. Runs `onAuth pubkey` on success, `onUnauth` otherwise.
@@ -469,6 +469,10 @@ nextSeqTs = \t seqCounter -> max t (seqCounter + 1)
469469presenceForKey : [PresenceEntry] -> PubkeyHex -> Timestamp -> [PresenceEntry]
470470presenceForKey = \presence pubkey t -> filter (\p -> p.pubkey == pubkey && p.expiresAt > t) presence
471471
472+-- True when `pk` has a live local presence row (i.e. is currently online here).
473+hasLocalPresence : [PresenceEntry] -> PubkeyHex -> Timestamp -> Bool
474+hasLocalPresence = \pres pk t -> any (\p -> p.pubkey == pk && isLocalServer p.server && p.expiresAt > t) pres
475+
472476-- Project items through `getServer`, drop our own hostname, and dedupe.
473477-- Used to derive peer recipient lists from forwards/presence/etc.
474478collectPeers : [a] -> (a -> Text) -> [Text]
@@ -502,8 +506,7 @@ pruneExpired = \t -> atomic do
502506 -- presence: remember locally-expired keys for offline gossip
503507 pres <- *presence
504508 *presence = filter (\p -> p.expiresAt > t) pres
505− let stillLive = \pk -> any (\k -> isLocalServer k.server && k.pubkey == pk && k.expiresAt > t) pres
506− yield (filter (\p -> p.expiresAt <= t && isLocalServer p.server && not (stillLive p.pubkey)) pres)
509+ yield (filter (\p -> p.expiresAt <= t && isLocalServer p.server && not (hasLocalPresence pres p.pubkey t)) pres)
507510
508511-- ============================================
509512-- Federation gossip
@@ -576,19 +579,6 @@ forwardQueuedToServer = \pubkey server -> atomic (do
576579 let newFwds = map (\m -> {toServer: server, m.toKey, m.encryptedBlob, retries: 0}) (take maxForwardsPerServer candidates)
577580 *forwards = union fwds newFwds)
578581
579−-- ============================================
580−-- Background loops
581−-- ============================================
582−-- Composite tick run from `backgroundPrune`: expire stale rows, then
583−-- opportunistically retry pending forwards.
584−
585−-- One composite background tick: prune expired state, gossip offline for
586−-- locally-expired keys, and retry pending forwards.
587−pruneAndRetry = \t -> do
588− expiredLocal <- pruneExpired t
589− fork (broadcastOfflineGossip expiredLocal)
590− when federationEnabled (fork retryPendingForwards)
591−
592582-- ============================================
593583-- Handler: challenge / verify
594584-- ============================================
@@ -610,19 +600,16 @@ handleChallenge : PubkeyHex -> Text -> IO {rw *challenges, clock, random} (Resul
610600handleChallenge = \pubkey clientIp -> do
611601 t <- now
612602 challenge <- genToken
613− full <- atomic (do
603+ atomic (do
614604 ch <- *challenges
615605 let cappedActive = capPerKey (filter (\c -> c.expiresAt > t) ch) pubkey maxChallengesPerKey
616606 if count cappedActive >= maxChallenges
617− then yield (True {})
607+ then yield (Err {error: {status: 503, message: "capacity"}})
618608 else do
619609 *challenges = union cappedActive [
620610 {pubkey, challenge, expiresAt: t + challengeExpiry, ip: clientIp}
621611 ]
622− yield (False {}))
623− if full
624− then yield (Err {error: {status: 503, message: "capacity"}})
625− else yield (Ok {value: {challenge, expiresAt: t + challengeExpiry}})
612+ yield (Ok {value: {challenge, expiresAt: t + challengeExpiry}}))
626613
627614-- POST /auth/verify: validate `signature` over `challenge` for `pubkey`.
628615-- On success, mints a session token, records local presence (`pubkey` is now
@@ -671,19 +658,13 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do
671658-- * Wait on `pollWakeup` (bumped by send/heartbeat) and return new events
672659-- plus piggybacked sender-side expirations/deliveries.
673660
674−-- POST /poll: top-level dispatch. Hands off to `pollOnce` for the actual
675−-- long-poll body.
676−handlePoll : Int -> Text -> Text -> IO {r *pollWakeup, r *sessions, rw *forwardFailures, rw *forwards, rw *messages, rw *presence, network, clock} (Result HttpError {cursor: Timestamp, events: [PollEvent]})
677−handlePoll = \cursor authorization clientIp -> do
678− t <- now
679− pollOnce authorization cursor clientIp t
680−
681−-- Body of a single poll. Treats the cursor advance as an implicit ack
661+-- POST /poll: long-poll body. Treats the cursor advance as an implicit ack
682662-- (`ackPolledMessages`), refreshes the caller's local presence row so peers
683663-- don't time us out mid-session, then runs `doPoll` to collect events (or
684664-- block until wakeup) and assembles the response.
685−pollOnce : Text -> Int -> Text -> Int<Ms> -> IO {r *pollWakeup, r *sessions, rw *forwardFailures, rw *forwards, rw *messages, rw *presence, network, clock} (Result HttpError {cursor: Timestamp, events: [PollEvent]})
686−pollOnce = \authorization cursor clientIp t -> do
665+handlePoll : Int -> Text -> Text -> IO {r *pollWakeup, r *sessions, rw *forwardFailures, rw *forwards, rw *messages, rw *presence, network, clock} (Result HttpError {cursor: Timestamp, events: [PollEvent]})
666+handlePoll = \cursor authorization clientIp -> do
667+ t <- now
687668 setup <- atomic withSessionAuth authorization t clientIp (yield (Nothing {})) (\pubkey -> do
688669 let clampedCursor = clamp 0 t cursor
689670 when (clampedCursor > 0) (ackPolledMessages pubkey clampedCursor)
@@ -825,7 +806,7 @@ forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
825806 let remaining = filter (\x -> not same x) fwds2
826807 *forwards = remaining
827808 pres <- *presence
828− let stillLocal = any (\p -> p.pubkey == to && isLocalServer p.server && p.expiresAt > t) pres
809+ let stillLocal = hasLocalPresence pres to t
829810 let othersPending = any (\x -> x.encryptedBlob == encryptedBlob) remaining
830811 when (not stillLocal && not othersPending) (do
831812 msgs <- *messages
@@ -883,7 +864,7 @@ storeFederated : PubkeyHex -> BlobHex -> Int<Ms> -> IO {rw *messages, rw *pollWa
883864storeFederated = \toKey encryptedBlob t -> do
884865 pres <- *presence
885866 msgs <- *messages
886− if not any (\p -> p.pubkey == toKey && isLocalServer p.server && p.expiresAt > t) pres
867+ if not (hasLocalPresence pres toKey t)
887868 then yield "no_presence"
888869 else do
889870 seq <- *seqCounter
@@ -925,18 +906,20 @@ api = serve Api where
925906-- ============================================
926907-- Background loops
927908-- ============================================
928−-- `backgroundPrune` runs `pruneAndRetry` every `backgroundPruneInterval` ms.
909+-- `backgroundPrune` runs the prune/retry sweep every `backgroundPruneInterval` ms.
929910-- `pollHeartbeat` bumps `pollWakeup` every `pollTimeoutMs` so long-poll
930911-- holders unblock and return an empty heartbeat response, keeping connections
931912-- fresh.
932913
933−-- Endless tick: prune immediately on first call, then every
934−-- `backgroundPruneInterval`. The startup prune clears stale rows persisted
935−-- by the previous process before the next interval elapses.
914+-- Endless tick: prune expired state, gossip offline for locally-expired keys,
915+-- and retry pending forwards. First sweep happens immediately so stale rows
916+-- persisted by the previous process clear before the next interval elapses.
936917backgroundPrune : IO {rw *challenges, rw *forwardFailures, rw *forwards, rw *messages, rw *presence, rw *sessions, network, clock} a
937918backgroundPrune = do
938919 t <- now
939− pruneAndRetry t
920+ expiredLocal <- pruneExpired t
921+ fork (broadcastOfflineGossip expiredLocal)
922+ when federationEnabled (fork retryPendingForwards)
940923 sleep backgroundPruneInterval
941924 backgroundPrune
942925