on master help sign in
Simplify server.knot: inline thin wrappers, refactor handleRecvGossip without empty-string sentinel
commited8ba4856329bf0abecd27ed5385ca8060335cde authoriko <mail@iko.soy> dateSun 10 May 2026, 15:24 (5 months ago) parentab099df
1 file changed+32−40
server.knot+32−40
server.knot+32−40
@@ -329,7 +329,10 @@ tooLong = \s maxLen -> count (chars s) > maxLen
329329
330330-- True when `s` is non-empty, even-length, and only lowercase hex digits.
331331isValidHex : Text -> Bool
332−isValidHex = \s -> (\cs -> (\n -> n > 0 && n / 2 * 2 == n && all (\c -> contains c "0123456789abcdef") cs) (count cs)) (chars s)
332+isValidHex = \s ->
333+ let cs = chars s
334+ let n = count cs
335+ n > 0 && n / 2 * 2 == n && all (\c -> contains c "0123456789abcdef") cs
333336
334337-- Recursively strip every trailing "." from `s` (DNS root form).
335338stripTrailingDot : Text -> Text
@@ -344,9 +347,6 @@ normalizeServerName = \s -> toLower (stripTrailingDot s)
344347-- True when `s` refers to this server.
345348isLocalServer : Text -> Bool
346349isLocalServer = \s -> s == serverHost
347−-- True when `s` refers to any server other than this one.
348−isRemote : Text -> Bool
349−isRemote = \s -> not isLocalServer s
350350
351351-- True when `s` starts with `pre`.
352352hasPrefix : Text -> Text -> Bool
@@ -399,9 +399,11 @@ 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 -> (\token -> if hasPrefix "Bearer " h && token != ""
403−then Just {value: token}
404−else Nothing {}) (drop 7 h)
402+extractToken = \h ->
403+ let token = drop 7 h
404+ if hasPrefix "Bearer " h && token != ""
405+ then Just {value: token}
406+ else Nothing {}
405407
406408-- Resolve a Bearer token to its session pubkey if the session is unexpired and
407409-- the client IP matches. Runs `onAuth pubkey` on success, `onUnauth` otherwise.
@@ -458,11 +460,6 @@ clearFailure = \server -> atomic (do
458460-- generation, presence queries, and atomic mailbox/presence writes
459461-- (callers supply the surrounding `atomic` block).
460462
461−-- Strictly-monotonic next sequence timestamp: max of wall clock and prior+1.
462−-- Guarantees /poll cursors order events even when many arrive in the same ms.
463−nextSeqTs : Timestamp -> Timestamp -> Timestamp
464−nextSeqTs = \t seqCounter -> max t (seqCounter + 1)
465−
466463-- All unexpired presence rows for a given pubkey (may include both local and
467464-- remote entries — the recipient may live on multiple servers simultaneously).
468465presenceForKey : [PresenceEntry] -> PubkeyHex -> Timestamp -> [PresenceEntry]
@@ -475,12 +472,7 @@ hasLocalPresence = \pres pk t -> any (\p -> p.pubkey == pk && isLocalServer p.se
475472-- Project items through `getServer`, drop our own hostname, and dedupe.
476473-- Used to derive peer recipient lists from forwards/presence/etc.
477474collectPeers : [a] -> (a -> Text) -> [Text]
478−collectPeers = \items getServer -> filter isRemote (map getServer items)
479−
480−-- All distinct remote hostnames currently appearing in `presence` (the gossip
481−-- broadcast set we know about, less ourselves).
482−knownPeerServersFromPresence : [PresenceEntry] -> [Text]
483−knownPeerServersFromPresence = \presence -> collectPeers presence (\p -> p.server)
475+collectPeers = \items getServer -> filter (\s -> not isLocalServer s) (map getServer items)
484476
485477-- Append one ciphertext to the local mailbox under a fresh monotonic
486478-- sequence and bump pollWakeup so blocked /poll holders unblock. Caller
@@ -489,7 +481,7 @@ appendMessage : PubkeyHex -> BlobHex -> Int<Ms> -> IO {rw *messages, rw *pollWak
489481appendMessage = \toKey encryptedBlob t -> do
490482 msgs <- *messages
491483 seq <- *seqCounter
492− let seqTs = nextSeqTs t seq
484+ let seqTs = max t (seq + 1)
493485 *seqCounter = seqTs
494486 *messages = union msgs [{toKey, encryptedBlob, receivedAt: seqTs}]
495487 *pollWakeup = seqTs
@@ -497,12 +489,13 @@ appendMessage = \toKey encryptedBlob t -> do
497489-- Replace any local presence rows for `pubkey` with one fresh row at
498490-- `expiry`, and return the post-update peer broadcast set. Caller wraps in
499491-- `atomic`.
500−refreshLocalPresence : [PresenceEntry] -> PubkeyHex -> Timestamp -> IO {rw *presence} [Text]
501−refreshLocalPresence = \pres pubkey expiry -> do
492+refreshLocalPresence : PubkeyHex -> Timestamp -> IO {rw *presence} [Text]
493+refreshLocalPresence = \pubkey expiry -> do
494+ pres <- *presence
502495 let kept = filter (\p -> not (p.pubkey == pubkey && isLocalServer p.server)) pres
503496 let newPres = union kept [{pubkey, server: serverHost, expiresAt: expiry}]
504497 *presence = newPres
505− yield (knownPeerServersFromPresence newPres)
498+ yield (collectPeers newPres (\p -> p.server))
506499
507500-- ============================================
508501-- Pruning
@@ -553,7 +546,7 @@ sendBatchedGossip = \peers events -> forEach peers (\server -> do
553546broadcastOfflineGossip : [{pubkey: PubkeyHex | a}] -> IO {r *presence, rw *forwardFailures, network, clock} {}
554547broadcastOfflineGossip = \expiredLocal -> when (count expiredLocal > 0) (do
555548 presence <- *presence
556− sendBatchedGossip (knownPeerServersFromPresence presence) (map (\p -> GossipOffline {
549+ sendBatchedGossip (collectPeers presence (\p -> p.server)) (map (\p -> GossipOffline {
557550 p.pubkey
558551 }) expiredLocal))
559552
@@ -660,8 +653,7 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do
660653 else capPerKey ses pubkey maxSessionsPerKey
661654 let newSession = {token, pubkey, expiresAt: expiry, ip: clientIp}
662655 *sessions = capList (union pruned [newSession]) maxSessions
663− pres <- *presence
664− peers <- refreshLocalPresence pres pubkey expiry
656+ peers <- refreshLocalPresence pubkey expiry
665657 yield (Just {value: peers}))
666658 case result of
667659 Nothing {} -> yield (Err {error: {status: 401, message: "invalid"}})
@@ -693,7 +685,7 @@ handlePoll = \cursor authorization clientIp -> do
693685 let stale = not any (\p -> mine p && p.expiresAt - t >= sessionExpiry / 2) pres
694686 refreshPeers <- if stale
695687 then do
696− peers <- refreshLocalPresence pres pubkey (t + sessionExpiry)
688+ peers <- refreshLocalPresence pubkey (t + sessionExpiry)
697689 yield (Just {value: peers})
698690 else yield (Nothing {})
699691 yield (Just {value: {pubkey, clampedCursor, startWakeup, refreshPeers}}))
@@ -733,7 +725,10 @@ doPoll = \s t -> do
733725-- which the client echoes on the next /poll to advance — and which the
734726-- server treats as an implicit ack.
735727collectPollEvents : [Message] -> PubkeyHex -> Timestamp -> Timestamp -> {events: [PollEvent], cursor: Timestamp}
736−collectPollEvents = \messages pubkey cursor t -> (\limited -> {events: map (\m -> {m.encryptedBlob}) limited, cursor: fold (\acc m -> max acc m.receivedAt) cursor limited}) (take maxPollEvents (sortBy (\m -> m.receivedAt) (filter (\m -> m.toKey == pubkey && t - m.receivedAt < messageMaxAge && m.receivedAt > cursor) messages)))
728+collectPollEvents = \messages pubkey cursor t ->
729+ let fresh = filter (\m -> m.toKey == pubkey && t - m.receivedAt < messageMaxAge && m.receivedAt > cursor) messages
730+ let limited = take maxPollEvents (sortBy (\m -> m.receivedAt) fresh)
731+ {events: map (\m -> {m.encryptedBlob}) limited, cursor: fold (\acc m -> max acc m.receivedAt) cursor limited}
737732
738733-- Treat the supplied cursor as an ack: drop all messages with
739734-- receivedAt <= cursor, plus their pending forwards.
@@ -838,24 +833,21 @@ forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
838833handleRecvGossip : [GossipEventType] -> Text -> IO {r *messages, rw *forwards, rw *presence, clock} (Result HttpError {})
839834handleRecvGossip = \events fromServer -> do
840835 t <- now
841− if not isRemote fromServer || isBadServerName fromServer || count events > maxGossipEvents
836+ if isLocalServer fromServer || isBadServerName fromServer || count events > maxGossipEvents
842837 then yield (Err {error: {status: 400, message: "invalid_request"}})
843838 else do
844839 newlyOnline <- atomic (do
845840 pres <- *presence
846− let isOnline = \e -> case e of
847− GossipOnline {pubkey: _} -> True {}
848− _ -> False {}
849− let pubkeyOf = \e -> case e of
850− GossipOnline {pubkey} -> pubkey
851− GossipOffline {pubkey} -> pubkey
852− _ -> ""
853− let onlinePubkeys = map pubkeyOf (filter isOnline events)
854− let touchedPubkeys = filter (\pk -> pk != "") (map pubkeyOf events)
855− let kept = filter (\p -> p.server != fromServer || not elem p.pubkey touchedPubkeys) pres
856− let added = map (\pk -> {pubkey: pk, server: fromServer, expiresAt: t + onlineGossipTtl}) onlinePubkeys
841+ let touched = \pk -> any (\e -> case e of
842+ GossipOnline {pubkey} -> pubkey == pk
843+ GossipOffline {pubkey} -> pubkey == pk
844+ _ -> False {}) events
845+ let added = fold (\acc e -> case e of
846+ GossipOnline {pubkey} -> union acc [{pubkey, server: fromServer, expiresAt: t + onlineGossipTtl}]
847+ _ -> acc) [] events
848+ let kept = filter (\p -> p.server != fromServer || not touched p.pubkey) pres
857849 *presence = union kept added
858− yield (filter (\pk -> not any (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t) pres) onlinePubkeys))
850+ yield (filter (\pk -> not any (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t) pres) (map (\p -> p.pubkey) added)))
859851 fork (forEach newlyOnline (\pk -> forwardQueuedToServer pk fromServer))
860852 yield (Ok {value: {}})
861853