on master help sign in
Simplify server.knot: inline storeFederated, collectPollEvents, and genTokenN
commit15ace4d488d8f4fec2f7ce73735519bf85e38de4 authoriko <mail@iko.soy> dateSun 10 May 2026, 19:03 (5 months ago) parent09f28dc
1 file changed+37−50
server.knot+37−50
server.knot+37−50
@@ -316,21 +316,18 @@ capList = \items maxN -> drop (max 0 (count items - maxN)) (sortBy (\x -> x.expi
316316capPerKey : [{pubkey: PubkeyHex, expiresAt: Timestamp | r}] -> PubkeyHex -> Int -> [{pubkey: PubkeyHex, expiresAt: Timestamp | r}]
317317capPerKey = \items pubkey maxN -> union (filter (\x -> not (x.pubkey == pubkey)) items) (capList (filter (\x -> x.pubkey == pubkey) items) (maxN - 1))
318318
319−-- Hex tokens: one random hex char per recursive call. `n` is the desired
320−-- length in characters (so n=48 yields 24 random bytes of entropy).
321−genTokenN : Int -> IO {random} Text
322−genTokenN = \n -> if n <= 0
319+-- Random hex token: one random hex char per recursive call. `n` is the
320+-- desired length in characters (so n=48 yields 24 random bytes of entropy).
321+-- Session bearers, /auth challenges, and federation auth nonces all use n=48
322+-- (192 bits of entropy, well beyond birthday bound).
323+genToken : Int -> IO {random} Text
324+genToken = \n -> if n <= 0
323325then yield ""
324326else do
325327 d <- randomInt 16
326− rest <- genTokenN (n - 1)
328+ rest <- genToken (n - 1)
327329 yield (take 1 (drop d "0123456789abcdef") ++ rest)
328330
329−-- Standard 48-char hex token used for session bearers, /auth challenges, and
330−-- federation auth nonces (192 bits of entropy, well beyond birthday bound).
331−genToken : IO {random} Text
332−genToken = genTokenN 48
333−
334331-- True when `s` is non-empty, even-length, and only lowercase hex digits.
335332isValidHex : Text -> Bool
336333isValidHex = \s -> do
@@ -608,7 +605,7 @@ forwardQueuedToServer = \pubkey server -> atomic (do
608605handleChallenge : PubkeyHex -> Text -> IO {rw *challenges, clock, random} (Result HttpError {challenge: Text, expiresAt: Int})
609606handleChallenge = \pubkey clientIp -> do
610607 t <- now
611− challenge <- genToken
608+ challenge <- genToken 48
612609 atomic (do
613610 ch <- *challenges
614611 let cappedActive = capPerKey (filter (\c -> c.expiresAt > t) ch) pubkey maxChallengesPerKey
@@ -628,7 +625,7 @@ handleVerifyAuth : PubkeyHex -> Text -> Text -> Bool -> Text -> IO {rw *challeng
628625handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do
629626 t <- now
630627 let expiry = t + sessionExpiry
631− token <- genToken
628+ token <- genToken 48
632629 let sigValid = verifySignature pubkey signature challenge
633630 result <- atomic (do
634631 ch <- *challenges
@@ -686,17 +683,24 @@ handlePoll = \cursor authorization clientIp -> do
686683 pollResult <- doPoll s t
687684 yield (Ok {value: {pollResult.events, pollResult.cursor}})
688685
689−-- One pass: collect events at `t`. If empty, retry-wait on `pollWakeup`
690−-- (bumped by send/heartbeat) and re-collect once at the new wall time.
691−-- The retry uses Knot's STM `retry` primitive: the transaction blocks until
692−-- some other transaction commits a change to `*pollWakeup`. Because
693−-- `pollHeartbeat` bumps `*pollWakeup` every `pollTimeoutMs`, no caller waits
694−-- longer than one heartbeat period before getting at least an empty response.
686+-- One pass: collect this pubkey's unexpired messages newer than the cursor,
687+-- sort by receivedAt, take up to `maxPollEvents`. The returned cursor is the
688+-- max `receivedAt` in the page (or the input cursor when the page is empty),
689+-- which the client echoes on the next /poll to advance — and which the
690+-- server treats as an implicit ack.
691+-- If the page is empty, retry-wait on `pollWakeup` (bumped by send/heartbeat)
692+-- and re-collect once at the new wall time. The retry uses Knot's STM `retry`
693+-- primitive: the transaction blocks until some other transaction commits a
694+-- change to `*pollWakeup`. Because `pollHeartbeat` bumps `*pollWakeup` every
695+-- `pollTimeoutMs`, no caller waits longer than one heartbeat period before
696+-- getting at least an empty response.
695697doPoll : {clampedCursor: Int, pubkey: PubkeyHex, startWakeup: Timestamp | a} -> Int<Ms> -> IO {r *pollWakeup, clock} {cursor: Int<Ms>, events: [{encryptedBlob: BlobHex}]}
696698doPoll = \s t -> do
697699 let collectAt = \tnow -> atomic (do
698700 msgs <- *messages
699− yield (collectPollEvents msgs s.pubkey s.clampedCursor tnow))
701+ let fresh = filter (\m -> m.toKey == s.pubkey && tnow - m.receivedAt < messageMaxAge && m.receivedAt > s.clampedCursor) msgs
702+ let limited = take maxPollEvents (sortBy (\m -> m.receivedAt) fresh)
703+ yield {events: map (\m -> {m.encryptedBlob}) limited, cursor: fold (\acc m -> max acc m.receivedAt) s.clampedCursor limited})
700704 initial <- collectAt t
701705 if count initial.events > 0
702706 then yield initial
@@ -705,17 +709,6 @@ doPoll = \s t -> do
705709 t2 <- now
706710 collectAt t2
707711
708−-- Pull this pubkey's unexpired messages newer than `cursor`, sort by
709−-- receivedAt, take up to `maxPollEvents`. The returned cursor is the max
710−-- `receivedAt` in the page (or the input cursor when the page is empty),
711−-- which the client echoes on the next /poll to advance — and which the
712−-- server treats as an implicit ack.
713−collectPollEvents : [Message] -> PubkeyHex -> Timestamp -> Timestamp -> {events: [PollEvent], cursor: Timestamp}
714−collectPollEvents = \messages pubkey cursor t ->
715− let fresh = filter (\m -> m.toKey == pubkey && t - m.receivedAt < messageMaxAge && m.receivedAt > cursor) messages
716− let limited = take maxPollEvents (sortBy (\m -> m.receivedAt) fresh)
717− {events: map (\m -> {m.encryptedBlob}) limited, cursor: fold (\acc m -> max acc m.receivedAt) cursor limited}
718−
719712-- Treat the supplied cursor as an ack: drop all messages with
720713-- receivedAt <= cursor, plus their pending forwards.
721714ackPolledMessages : PubkeyHex -> Int -> IO {rw *forwards, rw *messages} {}
@@ -800,8 +793,8 @@ forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
800793-- Handler: federation receive
801794-- ============================================
802795-- Inbound peer-to-peer endpoints. Federation is open and unauthenticated:
803−-- the `no_presence` check in `storeFederated` bounds forwards to currently-
804−-- online local keys.
796+-- the `no_presence` check in `handleForwardMessage` bounds forwards to
797+-- currently-online local keys.
805798
806799-- POST /federation/gossip: ingest peer presence events. The transport-level
807800-- `fromServer` is the home server for every event. Drops every (pubkey,
@@ -827,28 +820,22 @@ handleRecvGossip = \events fromServer -> do
827820 fork (forEach newlyOnline (\pk -> forwardQueuedToServer pk fromServer))
828821 yield (Ok {value: {}})
829822
830−-- Store a federated/forwarded message into the local mailbox. Caller wraps in `atomic`.
831−--
832−-- The presence gate requires the recipient to be **currently locally online**
833−-- (not just visible to gossip somewhere). Without that, an A → B forward based
834−-- on stale gossip about R could land on B with no actively-polling client and
835−-- get stuck. If B refuses, A retries via `retryPendingForwards` against the
836−-- next presence target.
837−storeFederated : PubkeyHex -> BlobHex -> Int<Ms> -> IO {rw *messages, rw *pollWakeup, r *presence, rw *seqCounter} (Result HttpError {})
838−storeFederated = \toKey encryptedBlob t -> do
839− pres <- *presence
840− if not (hasLocalPresence pres toKey t)
841− then yield (Err {error: {status: 404, message: "no_presence"}})
842− else do
843− appendMessage toKey encryptedBlob t
844− yield (Ok {value: {}})
845−
846823-- POST /federation/forward: receive a single federated message destined for
847−-- a local key. Delegates the store decision to `storeFederated`.
824+-- a local key. The presence gate requires the recipient to be **currently
825+-- locally online** (not just visible to gossip somewhere). Without that, an
826+-- A → B forward based on stale gossip about R could land on B with no
827+-- actively-polling client and get stuck. If B refuses, A retries via
828+-- `retryPendingForwards` against the next presence target.
848829handleForwardMessage : PubkeyHex -> BlobHex -> IO {rw *messages, rw *pollWakeup, r *presence, rw *seqCounter, clock} (Result HttpError {})
849830handleForwardMessage = \toKey encryptedBlob -> do
850831 t <- now
851− atomic storeFederated toKey encryptedBlob t
832+ atomic (do
833+ pres <- *presence
834+ if not (hasLocalPresence pres toKey t)
835+ then yield (Err {error: {status: 404, message: "no_presence"}})
836+ else do
837+ appendMessage toKey encryptedBlob t
838+ yield (Ok {value: {}}))
852839
853840-- ============================================
854841-- Dispatch