on master help sign in
Improve server type safety: add ForwardResult and PollResult variants, simplify removeForward
commit476d6fff9f9f011c32feb31bb758bb823b925727 authoriko <mail@iko.soy> dateSat 11 Apr 2026, 10:00 (6 months ago) parent36a884b
1 file changed+21−14
server.knot+21−14
server.knot+21−14
@@ -106,6 +106,8 @@ type SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: Mess
106106type VerifyResult = VerifyFailed {} | VerifyOk {peerServers: [ServerName]}
107107type AckResult = AckUnauthorized {} | AckDone {pendingAcks: [AckedEntry], evictedEntries: [AckedEntry]}
108108type LookupResult = LookupUnauthorized {} | LookupDone {server: AnyServerName}
109+type ForwardResult = ForwardDuplicate {} | ForwardStored {} | ForwardFull {}
110+type PollResult = PollUnauthorized {} | PollDone {events: [PollEvent], cursor: Timestamp}
109111
110112
111113-- ============================================
@@ -614,7 +616,7 @@ removeForward = \mid srv -> atomic do
614616 forwards <- *forwards
615617 set *forwards = do
616618 x <- forwards
617− where x.messageId != mid || x.toServer != srv
619+ where not (x.messageId == mid && x.toServer == srv)
618620 yield x
619621
620622retryForwardsForServer : [ForwardEntry] -> Int -> IO {network} {}
@@ -706,7 +708,7 @@ pollOnce = \token cursor -> do
706708 let auth = authenticateSession sessions token t
707709 case auth of
708710 Unauthorized {} ->
709− yield {events: [], cursor: -1, authorized: False {}}
711+ yield PollUnauthorized {}
710712 Authorized {pubkey} -> do
711713 seqCounter <- *seqCounter
712714 messages <- *messages
@@ -723,16 +725,19 @@ pollOnce = \token cursor -> do
723725 encryptedBlob: m.encryptedBlob,
724726 timestamp: m.timestamp}}
725727 let lastReceivedAt = fold (\acc m -> max acc m.receivedAt) clampedCursor limitedMsgs
726− yield {events: evts, cursor: lastReceivedAt, authorized: True {}}
728+ yield PollDone {events: evts, cursor: lastReceivedAt}
727729
728730pollLoop = \token cursor deadline -> do
729731 result <- pollOnce token cursor
730− t <- now
731− if result.authorized && count result.events == 0 && t < deadline
732− then do
733− sleep (clamp 1 500 (deadline - t))
734− pollLoop token cursor deadline
735− else yield result
732+ case result of
733+ PollUnauthorized {} -> yield result
734+ PollDone {events} -> do
735+ t <- now
736+ if count events == 0 && t < deadline
737+ then do
738+ sleep (clamp 1 500 (deadline - t))
739+ pollLoop token cursor deadline
740+ else yield result
736741
737742-- ============================================
738743-- Request Handler
@@ -805,7 +810,9 @@ serve = \req -> case req of
805810 result <- pollLoop token cursor deadline
806811 tAfterPoll <- now
807812 maybePruneAndBroadcast tAfterPoll
808− yield (respond result)
813+ yield (respond (case result of
814+ PollUnauthorized {} -> {events: [], cursor: 0, authorized: False {}}
815+ PollDone r -> {events: r.events, cursor: r.cursor, authorized: True {}}))
809816
810817 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
811818 t <- now
@@ -990,9 +997,9 @@ serve = \req -> case req of
990997 ackedIds <- *ackedIds
991998 if any messages (\m -> m.messageId == messageId && m.toKey == toKey)
992999 || any ackedIds (\a -> a.messageId == messageId && a.toKey == toKey)
993− then yield {pr: pr, ok: True {}}
1000+ then yield {pr: pr, forward: ForwardDuplicate {}}
9941001 else if countMessagesFor messages toKey t >= maxMessagesPerRecipient
995− then yield {pr: pr, ok: False {}}
1002+ then yield {pr: pr, forward: ForwardFull {}}
9961003 else do
9971004 seqCounter <- *seqCounter
9981005 let seqTs = nextSeqTs t seqCounter
@@ -1000,9 +1007,9 @@ serve = \req -> case req of
10001007 set *messages = union messages
10011008 [{messageId: messageId, toKey: toKey, fromKey: fromKey,
10021009 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs}]
1003− yield {pr: pr, ok: True {}}
1010+ yield {pr: pr, forward: ForwardStored {}}
10041011 forkBroadcastOffline t result.pr
1005− yield (respond {ok: result.ok})
1012+ yield (respond {ok: case result.forward of ForwardFull {} -> False {}; _ -> True {}})
10061013
10071014 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
10081015 t <- now