@@ -107,17 +107,25 @@ forwardToAll = \servers path headers body ->
107107 then yield False {}
108108 else do
109109 let server = fold (\acc s -> if acc == "" then s else acc) "" servers
110− result <- httpPost (federationScheme ++ server ++ path) headers body
111− restOk <- forwardToAll (do s <- servers; where not (s == server); yield s) path headers body
112− yield (if result.ok then True {} else restOk)
110+ let rest = do s <- servers; where not (s == server); yield s
111+ if server == ""
112+ then yield False {}
113+ else do
114+ result <- httpPost (federationScheme ++ server ++ path) headers body
115+ restOk <- forwardToAll rest path headers body
116+ yield (if result.ok then True {} else restOk)
113117
114118sendToEach = \servers action ->
115119 if count servers == 0
116120 then yield {}
117121 else do
118122 let server = fold (\acc s -> if acc == "" then s else acc) "" servers
119− action server
120− sendToEach (do s <- servers; where not (s == server); yield s) action
123+ let rest = do s <- servers; where not (s == server); yield s
124+ if server == ""
125+ then yield {}
126+ else do
127+ action server
128+ sendToEach rest action
121129
122130pruneExpired = \t -> do
123131 challenges <- *challenges
@@ -138,7 +146,7 @@ pruneExpired = \t -> do
138146 messages <- *messages
139147 set *messages = do
140148 m <- messages
141− where m.timestamp > t - messageMaxAge
149+ where m.timestamp >= t - messageMaxAge
142150 yield m
143151
144152-- ============================================
@@ -181,8 +189,20 @@ serve = \req -> case req of
181189 c <- challenges
182190 where not (c.pubkey == pubkey && c.challenge == challenge)
183191 yield c
192+ let existingForKey = do
193+ s <- sessions
194+ where s.pubkey == pubkey
195+ where s.expiresAt > t
196+ yield s
197+ let oldestExpiry = fold (\acc s -> if s.expiresAt < acc then s.expiresAt else acc) expiry existingForKey
198+ let sessionsCapped = if count existingForKey >= 10
199+ then do
200+ s <- sessions
201+ where not (s.pubkey == pubkey && s.expiresAt == oldestExpiry)
202+ yield s
203+ else sessions
184204 set *sessions = if sigValid
185− then union sessions [{token: token, pubkey: pubkey, expiresAt: expiry}]
205+ then union sessionsCapped [{token: token, pubkey: pubkey, expiresAt: expiry}]
186206 else sessions
187207 set *presence = if sigValid
188208 then union
@@ -223,21 +243,21 @@ serve = \req -> case req of
223243 Just {value: s} -> do
224244 m <- messages
225245 where m.toKey == s.pubkey
226− where m.timestamp > t - messageMaxAge
246+ where m.timestamp >= t - messageMaxAge
227247 yield {id: m.messageId, eventType: "message",
228248 payload: toJson {toKey: m.toKey, fromKey: m.fromKey,
229249 encryptedBlob: m.encryptedBlob,
230250 timestamp: m.timestamp}}
231251 let cursor = case session of
232252 Nothing {} -> "unauthorized"
233− _ -> ""
253+ _ -> show t
234254 yield {events: evts, cursor: cursor}
235255 respond result
236256
237257 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
238258 t <- now
239259 msgId <- genToken
240− let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t - messageMaxAge else timestamp
260+ let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t else timestamp
241261 result <- atomic do
242262 pruneExpired t
243263 sessions <- *sessions
@@ -299,9 +319,13 @@ serve = \req -> case req of
299319 where m.messageId == mid
300320 where m.toKey == s.pubkey
301321 yield m
322+ let localAcked = do
323+ m <- ackedMessages
324+ where m.originServer == ""
325+ yield m
302326 set *messages = case session of
303327 Nothing {} -> messages
304− Just {value: _} -> diff messages ackedMessages
328+ Just {value: _} -> diff messages localAcked
305329 let ok = case session of
306330 Nothing {} -> False {}
307331 _ -> True {}
@@ -315,11 +339,20 @@ serve = \req -> case req of
315339 if count (do a <- acc; where a == m.originServer; yield a) > 0 then acc
316340 else union acc [m.originServer]) [] fedMessages
317341 if result.ok && count originServers > 0 && not (federationSecret == "")
318− then sendToEach originServers (\server ->
319− httpPost (federationScheme ++ server ++ "/federation/ack")
342+ then sendToEach originServers (\server -> do
343+ ackResult <- httpPost (federationScheme ++ server ++ "/federation/ack")
320344 {authorization: "Bearer " ++ federationSecret}
321345 {messageIds: (do m <- fedMessages; where m.originServer == server; yield m.messageId),
322− originServer: server, fromServer: serverHost})
346+ originServer: server, fromServer: serverHost}
347+ if ackResult.ok
348+ then atomic do
349+ messages <- *messages
350+ set *messages = diff messages (do
351+ m <- messages
352+ mid <- (do fm <- fedMessages; where fm.originServer == server; yield fm.messageId)
353+ where m.messageId == mid
354+ yield m)
355+ else yield {})
323356 else yield {}
324357 respond {ok: result.ok}
325358
@@ -361,6 +394,8 @@ serve = \req -> case req of
361394 let onlineEntries = do
362395 e <- events
363396 where e.eventType == "online"
397+ where not (e.server == "")
398+ where not (e.pubkey == "")
364399 where not (e.server == serverHost)
365400 where e.timestamp <= t
366401 where e.timestamp + (clampTtl e.ttl) * 1000 > t
@@ -368,6 +403,8 @@ serve = \req -> case req of
368403 let offlineEntries = do
369404 e <- events
370405 where e.eventType == "offline"
406+ where not (e.server == "")
407+ where not (e.pubkey == "")
371408 where not (e.server == serverHost)
372409 where e.timestamp <= t
373410 where t - e.timestamp < (clampTtl e.ttl) * 1000
@@ -378,7 +415,7 @@ serve = \req -> case req of
378415 o <- offlineEntries
379416 where o.pubkey == e.pubkey
380417 where o.server == e.server
381− where o.timestamp > e.timestamp
418+ where o.timestamp >= e.timestamp
382419 yield o) == 0
383420 yield {pubkey: e.pubkey, server: e.server, expiresAt: e.expiresAt}
384421 let affectedKeys = union
@@ -440,14 +477,14 @@ serve = \req -> case req of
440477 t <- now
441478 let authorized = verifyFederationAuth authorization
442479 let validOrigin = not (originServer == "") && not (originServer == serverHost)
443− let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t - messageMaxAge else timestamp
480+ let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t else timestamp
444481 atomic do
445482 pruneExpired t
446483 messages <- *messages
447484 let exists = count (do
448485 m <- messages
449486 where m.messageId == messageId
450− where m.timestamp > t - messageMaxAge
487+ where m.timestamp >= t - messageMaxAge
451488 yield m) > 0
452489 let shouldInsert = authorized && validOrigin && not exists
453490 set *messages = if shouldInsert