@@ -439,12 +439,10 @@ recordFailure = \server -> do
439 atomic (do
439 atomic (do
440 failures <- *forwardFailures
440 failures <- *forwardFailures
441 let same = \f -> f.server == server
441 let same = \f -> f.server == server
442− let prev = case findFirst failures same of
442+ let new = case findFirst failures same of
443− Just {value: f} -> {failures: f.failures + 1, f.firstFailedAt}
443+ Just {value: f} -> {server, failedAt: t, failures: f.failures + 1, f.firstFailedAt}
444− _ -> {failures: 1, firstFailedAt: t}
444+ _ -> {server, failedAt: t, failures: 1, firstFailedAt: t}
445− *forwardFailures = union (filter (\f -> not same f) failures) [
445+ *forwardFailures = union (filter (\f -> not same f) failures) [new])
446− {server, failedAt: t, prev.failures, prev.firstFailedAt}
449-- Drop the failure record for `server` (called after any successful peer call).
447-- Drop the failure record for `server` (called after any successful peer call).
450-- Single-success recovery — there is no half-open state.
448-- Single-success recovery — there is no half-open state.
@@ -630,7 +628,7 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do
630 _ -> False {}
628 _ -> False {}
631 let valid = any (\c -> same c && c.expiresAt > t && matchIp clientIp c.ip) ch && sigValid
629 let valid = any (\c -> same c && c.expiresAt > t && matchIp clientIp c.ip) ch && sigValid
632 if not valid
630 if not valid
633− then yield {valid: False {}, peers: []}
631+ then yield (Nothing {})
635 *challenges = filter (\c -> not same c) ch
633 *challenges = filter (\c -> not same c) ch
636 ses <- *sessions
634 ses <- *sessions
@@ -643,12 +641,12 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do
643 let prunedPres = filter (\p -> not (p.pubkey == pubkey && isLocalServer p.server)) pres
641 let prunedPres = filter (\p -> not (p.pubkey == pubkey && isLocalServer p.server)) pres
644 let newPres = union prunedPres [{pubkey, server: serverHost, expiresAt: expiry}]
642 let newPres = union prunedPres [{pubkey, server: serverHost, expiresAt: expiry}]
645 *presence = newPres
643 *presence = newPres
646− yield {valid: True {}, peers: knownPeerServersFromPresence newPres})
644+ yield (Just {value: knownPeerServersFromPresence newPres}))
647− if not result.valid
645+ case result of
648− then yield (Err {error: {status: 401, message: "invalid"}})
646+ Nothing {} -> yield (Err {error: {status: 401, message: "invalid"}})
649− else do
647+ Just {value: peers} -> do
650− when federationEnabled (fork (sendBatchedGossip result.peers [GossipOnline {pubkey}]))
648+ when federationEnabled (fork (sendBatchedGossip peers [GossipOnline {pubkey}]))
651− yield (Ok {value: {token, expiresAt: expiry}})
649+ yield (Ok {value: {token, expiresAt: expiry}})
653-- ============================================
651-- ============================================
654-- Handler: poll
652-- Handler: poll
@@ -853,37 +851,32 @@ handleRecvGossip = \events fromServer -> do
853 yield (Ok {value: {}})
851 yield (Ok {value: {}})
855-- Store a federated/forwarded message into the local mailbox. Caller wraps in `atomic`.
853-- Store a federated/forwarded message into the local mailbox. Caller wraps in `atomic`.
856−-- Returns "" on success, otherwise the error code "no_presence".
858-- The presence gate requires the recipient to be **currently locally online**
855-- The presence gate requires the recipient to be **currently locally online**
859-- (not just visible to gossip somewhere). Without that, an A → B forward based
856-- (not just visible to gossip somewhere). Without that, an A → B forward based
860-- on stale gossip about R could land on B with no actively-polling client and
857-- on stale gossip about R could land on B with no actively-polling client and
861-- get stuck. If B refuses, A retries via `retryPendingForwards` against the
858-- get stuck. If B refuses, A retries via `retryPendingForwards` against the
862-- next presence target.
859-- next presence target.
863−storeFederated : PubkeyHex -> BlobHex -> Int<Ms> -> IO {rw *messages, rw *pollWakeup, r *presence, rw *seqCounter} Text
860+storeFederated : PubkeyHex -> BlobHex -> Int<Ms> -> IO {rw *messages, rw *pollWakeup, r *presence, rw *seqCounter} (Result HttpError {})
864storeFederated = \toKey encryptedBlob t -> do
861storeFederated = \toKey encryptedBlob t -> do
865 pres <- *presence
862 pres <- *presence
866 msgs <- *messages
863 msgs <- *messages
867 if not (hasLocalPresence pres toKey t)
864 if not (hasLocalPresence pres toKey t)
868− then yield "no_presence"
865+ then yield (Err {error: {status: 404, message: "no_presence"}})
870 seq <- *seqCounter
867 seq <- *seqCounter
871 let seqTs = nextSeqTs t seq
868 let seqTs = nextSeqTs t seq
872 *seqCounter = seqTs
869 *seqCounter = seqTs
873 *messages = union msgs [{toKey, encryptedBlob, receivedAt: seqTs}]
870 *messages = union msgs [{toKey, encryptedBlob, receivedAt: seqTs}]
874 *pollWakeup = seqTs
871 *pollWakeup = seqTs
875− yield ""
872+ yield (Ok {value: {}})
877-- POST /federation/forward: receive a single federated message destined for
874-- POST /federation/forward: receive a single federated message destined for
878−-- a local key. Delegates the actual store decision to `storeFederated`,
875+-- a local key. Delegates the store decision to `storeFederated`.
879−-- which returns "" on success.
880handleForwardMessage : PubkeyHex -> BlobHex -> IO {rw *messages, rw *pollWakeup, r *presence, rw *seqCounter, clock} (Result HttpError {})
876handleForwardMessage : PubkeyHex -> BlobHex -> IO {rw *messages, rw *pollWakeup, r *presence, rw *seqCounter, clock} (Result HttpError {})
881handleForwardMessage = \toKey encryptedBlob -> do
877handleForwardMessage = \toKey encryptedBlob -> do
883− result <- atomic storeFederated toKey encryptedBlob t
879+ atomic storeFederated toKey encryptedBlob t
885− then yield (Ok {value: {}})
886− else yield (Err {error: {status: 404, message: result}})
888-- ============================================
881-- ============================================
889-- Dispatch
882-- Dispatch