on master help sign in
Use STM retry for instant poll notifications instead of sleep-based polling loop
commit45437790077563cda478934a3066b5c921bd2276 authoriko <mail@iko.soy> dateSun 19 Apr 2026, 02:27 (6 months ago) parent5feb666
2 files changed+14−29
client/ApiClient.fs+1−1 server.knot+13−28
client/ApiClient.fs+1−1
@@ -55,7 +55,7 @@ module ApiClient =
5555
5656 let private pollClient =
5757 let c = new HttpClient()
58− c.Timeout <- TimeSpan.FromSeconds(120.)
58+ c.Timeout <- TimeSpan.FromSeconds(30.)
5959 c
6060
6161 let private sendRequest (httpClient: HttpClient) (url: string) (body: string) (token: string option) =
server.knot+13−28
@@ -44,8 +44,7 @@ offlineGossipMinTtl = 60 -- minimum TTL for offline gossip events
4444maxForwardRetriesPerServer = 100
4545maxGossipHops = 5
4646gossipOriginHops = 2
47−pollTimeout : Int<Ms>
48−pollTimeout = 20000 -- 20 seconds
47+
4948backgroundPruneInterval : Int<Ms>
5049backgroundPruneInterval = 30000 -- 30 seconds
5150federationEnabled = federationSecret != ""
@@ -824,34 +823,22 @@ pollOnce = \token cursor -> do
824823 yield (PollUnauthorized {})
825824 Authorized {pubkey} -> do
826825 seqCounter <- *seqCounter
827− messages <- *messages
828826 let clampedCursor = clamp 0 (max seqCounter t) cursor
829827 let matchingMsgs = do
830− m <- messages
828+ m <- *messages
831829 where m.toKey == pubkey && m.receivedAt >= t - messageMaxAge && m.receivedAt > clampedCursor
832830 yield m
833831 let limitedMsgs = boundedSmallest matchingMsgs maxPollEvents (\m -> m.receivedAt)
834− let evts = do
835− m <- limitedMsgs
836− yield {id: m.messageId, eventType: "message",
837− payload: {toKey: m.toKey, fromKey: m.fromKey,
838− encryptedBlob: m.encryptedBlob,
839− timestamp: m.timestamp}}
840− let lastReceivedAt = fold (\acc m -> max acc m.receivedAt) clampedCursor limitedMsgs
841− yield (PollOk {events: evts, cursor: lastReceivedAt})
842−
843−pollLoop : Text -> Int -> Int<Ms> -> IO {clock} PollResult
844−pollLoop = \token cursor deadline -> do
845− result <- pollOnce token cursor
846− case result of
847− PollUnauthorized {} -> yield result
848− PollOk {events} -> do
849− t <- now
850− if count events == 0 && t < deadline
851− then do
852− sleep (clamp 1 500 (deadline - t))
853− pollLoop token cursor deadline
854− else yield result
832+ if count limitedMsgs == 0 then retry
833+ else do
834+ let evts = do
835+ m <- limitedMsgs
836+ yield {id: m.messageId, eventType: "message",
837+ payload: {toKey: m.toKey, fromKey: m.fromKey,
838+ encryptedBlob: m.encryptedBlob,
839+ timestamp: m.timestamp}}
840+ let lastReceivedAt = fold (\acc m -> max acc m.receivedAt) clampedCursor limitedMsgs
841+ yield (PollOk {events: evts, cursor: lastReceivedAt})
855842
856843-- ============================================
857844-- Request Handler
@@ -917,11 +904,9 @@ serve = \req -> case req of
917904 yield (respond {token: token, expiresAt: expiry})
918905
919906 Poll {cursor, authorization, respond} -> do
920− t <- now
921− let deadline = t + pollTimeout
922907 result <- case extractToken authorization of
923908 Nothing {} -> yield (PollUnauthorized {})
924− Just {value: token} -> pollLoop token cursor deadline
909+ Just {value: token} -> pollOnce token cursor
925910 tAfterPoll <- now
926911 maybePruneAndBroadcast tAfterPoll
927912 yield (respond (case result of