@@ -145,16 +145,48 @@ pruneExpired = \t -> do
145145 s <- sessions
146146 where s.expiresAt > t
147147 yield s
148− presence <- *presence
149− set *presence = do
150− p <- presence
148+ presenceBefore <- *presence
149+ let presenceAfter = do
150+ p <- presenceBefore
151151 where p.expiresAt > t
152152 yield p
153+ set *presence = presenceAfter
153154 messages <- *messages
154155 set *messages = do
155156 m <- messages
156157 where m.timestamp >= t - messageMaxAge
157158 yield m
159+ yield (do
160+ p <- presenceBefore
161+ where p.expiresAt <= t
162+ where p.server == serverHost
163+ where count (do
164+ q <- presenceAfter
165+ where q.pubkey == p.pubkey
166+ where q.server == serverHost
167+ yield q) == 0
168+ yield p)
169+
170+broadcastOfflineGossip = \t expiredLocal -> do
171+ let expiredPubkeys = fold (\acc p ->
172+ if count (do a <- acc; where a == p.pubkey; yield a) > 0 then acc
173+ else union acc [p.pubkey]) [] expiredLocal
174+ if not (federationSecret == "") && count expiredPubkeys > 0
175+ then do
176+ peerServers <- atomic do
177+ presence <- *presence
178+ yield (fold (\acc p ->
179+ if p.server == serverHost then acc
180+ else if count (do a <- acc; where a == p.server; yield a) > 0 then acc
181+ else union acc [p.server]) [] presence)
182+ let gossipEvents = do
183+ pk <- expiredPubkeys
184+ yield {eventType: "offline", pubkey: pk, server: serverHost, timestamp: t, ttl: 3600}
185+ sendToEach peerServers (\server ->
186+ httpPost (federationScheme ++ server ++ "/federation/gossip")
187+ {authorization: "Bearer " ++ federationSecret}
188+ {events: gossipEvents, hopsRemaining: 2, fromServer: serverHost})
189+ else yield {}
158190
159191-- ============================================
160192-- Request Handler
@@ -180,7 +212,7 @@ serve = \req -> case req of
180212 token <- genToken
181213 let expiry = t + 3600000
182214 result <- atomic do
183− pruneExpired t
215+ expiredLocal <- pruneExpired t
184216 challenges <- *challenges
185217 sessions <- *sessions
186218 presence <- *presence
@@ -192,7 +224,9 @@ serve = \req -> case req of
192224 yield c)
193225 let sigValid = case matched of
194226 Nothing {} -> False {}
195− _ -> verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
227+ _ -> if tooLong signature maxSignatureLen
228+ then False {}
229+ else verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
196230 set *challenges = if sigValid
197231 then do
198232 c <- challenges
@@ -230,7 +264,7 @@ serve = \req -> case req of
230264 else if count (do a <- acc; where a == p.server; yield a) > 0 then acc
231265 else union acc [p.server]) [] updatedPresence
232266 else []
233− yield {sigValid: sigValid, peerServers: peerServers}
267+ yield {sigValid: sigValid, peerServers: peerServers, expiredLocal: expiredLocal}
234268 if result.sigValid
235269 then respond {token: token, expiresAt: expiry}
236270 else respond {token: "", expiresAt: 0}
@@ -240,24 +274,13 @@ serve = \req -> case req of
240274 {authorization: "Bearer " ++ federationSecret}
241275 {events: [{eventType: "online", pubkey: pubkey, server: serverHost, timestamp: t, ttl: 3600}], hopsRemaining: 2, fromServer: serverHost})
242276 else yield {}
277+ broadcastOfflineGossip t result.expiredLocal
243278
244279 Poll {cursor, authorization, respond} -> do
245280 t <- now
246281 let token = extractToken authorization
247282 result <- atomic do
248− presenceBeforePrune <- *presence
249− pruneExpired t
250− presenceAfterPrune <- *presence
251− let expiredLocal = do
252− p <- presenceBeforePrune
253− where p.expiresAt <= t
254− where p.server == serverHost
255− where count (do
256− q <- presenceAfterPrune
257− where q.pubkey == p.pubkey
258− where q.server == serverHost
259− yield q) == 0
260− yield p
283+ expiredLocal <- pruneExpired t
261284 sessions <- *sessions
262285 messages <- *messages
263286 let session = lookupSession sessions token t
@@ -275,28 +298,10 @@ serve = \req -> case req of
275298 timestamp: m.timestamp}}
276299 let newCursor = case session of
277300 Nothing {} -> 0
278− _ -> maxReceived
301+ _ -> if maxReceived > cursor then maxReceived else cursor
279302 yield {events: evts, cursor: newCursor, expiredLocal: expiredLocal}
280303 respond {events: result.events, cursor: result.cursor}
281− let expiredPubkeys = fold (\acc p ->
282− if count (do a <- acc; where a == p.pubkey; yield a) > 0 then acc
283− else union acc [p.pubkey]) [] result.expiredLocal
284− if not (federationSecret == "") && count expiredPubkeys > 0
285− then do
286− peerServers <- atomic do
287− presence <- *presence
288− yield (fold (\acc p ->
289− if p.server == serverHost then acc
290− else if count (do a <- acc; where a == p.server; yield a) > 0 then acc
291− else union acc [p.server]) [] presence)
292− let gossipEvents = do
293− pk <- expiredPubkeys
294− yield {eventType: "offline", pubkey: pk, server: serverHost, timestamp: t, ttl: 3600}
295− sendToEach peerServers (\server ->
296− httpPost (federationScheme ++ server ++ "/federation/gossip")
297− {authorization: "Bearer " ++ federationSecret}
298− {events: gossipEvents, hopsRemaining: 2, fromServer: serverHost})
299− else yield {}
304+ broadcastOfflineGossip t result.expiredLocal
300305
301306 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
302307 t <- now
@@ -304,7 +309,7 @@ serve = \req -> case req of
304309 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t else timestamp
305310 let validInput = not (to == "") && not (encryptedBlob == "") && not (tooLong to maxPubkeyLen) && not (tooLong encryptedBlob maxBlobLen)
306311 result <- atomic do
307− pruneExpired t
312+ expiredLocal <- pruneExpired t
308313 sessions <- *sessions
309314 messages <- *messages
310315 presence <- *presence
@@ -343,7 +348,7 @@ serve = \req -> case req of
343348 else if localOnline then "delivered"
344349 else if count remoteServers > 0 then "federated"
345350 else "queued"
346− yield {status: status, remoteServers: remoteServers, fromKey: fromKey}
351+ yield {status: status, remoteServers: remoteServers, fromKey: fromKey, expiredLocal: expiredLocal}
347352 finalStatus <- if result.status == "federated" && not (federationSecret == "")
348353 then do
349354 anyOk <- forwardToAll result.remoteServers "/federation/forward"
@@ -353,6 +358,7 @@ serve = \req -> case req of
353358 yield (if anyOk then "federated" else "queued")
354359 else yield result.status
355360 respond {status: finalStatus, messageId: (if result.status == "unauthorized" then "" else if result.status == "invalid" then "" else msgId)}
361+ broadcastOfflineGossip t result.expiredLocal
356362
357363 AckMessages {messageIds, authorization, respond} -> do
358364 t <- now
@@ -362,7 +368,7 @@ serve = \req -> case req of
362368 else if count (do a <- acc; where a == mid; yield a) > 0 then acc
363369 else union acc [mid]) [] messageIds
364370 result <- atomic do
365− pruneExpired t
371+ expiredLocal <- pruneExpired t
366372 sessions <- *sessions
367373 messages <- *messages
368374 let session = lookupSession sessions (extractToken authorization) t
@@ -380,7 +386,7 @@ serve = \req -> case req of
380386 let ok = case session of
381387 Nothing {} -> False {}
382388 _ -> True {}
383− yield {ok: ok, ackedMessages: ackedMessages}
389+ yield {ok: ok, ackedMessages: ackedMessages, expiredLocal: expiredLocal}
384390 let fedMessages = do
385391 m <- result.ackedMessages
386392 where not (m.originServer == "")
@@ -397,6 +403,7 @@ serve = \req -> case req of
397403 originServer: server, fromServer: serverHost})
398404 else yield {}
399405 respond {ok: result.ok}
406+ broadcastOfflineGossip t result.expiredLocal
400407
401408 LookupPresence {pubkey, authorization, respond} -> do
402409 t <- now
@@ -438,6 +445,8 @@ serve = \req -> case req of
438445 where e.eventType == "online"
439446 where not (e.server == "")
440447 where not (e.pubkey == "")
448+ where not (tooLong e.pubkey maxPubkeyLen)
449+ where not (tooLong e.server maxPubkeyLen)
441450 where not (e.server == serverHost)
442451 where e.timestamp <= t
443452 where e.timestamp + (clampTtl e.ttl) * 1000 > t
@@ -448,6 +457,8 @@ serve = \req -> case req of
448457 where e.eventType == "offline"
449458 where not (e.server == "")
450459 where not (e.pubkey == "")
460+ where not (tooLong e.pubkey maxPubkeyLen)
461+ where not (tooLong e.server maxPubkeyLen)
451462 where not (e.server == serverHost)
452463 where e.timestamp <= t
453464 where t - e.timestamp < (clampTtl e.ttl) * 1000
@@ -482,9 +493,18 @@ serve = \req -> case req of
482493 where not (a.pubkey == e.pubkey && a.server == e.server)
483494 yield a)
484495 [e]) [] filteredOnline
485− atomic do
496+ appliedKeys <- atomic do
486497 pruneExpired t
487498 presence <- *presence
499+ let appliedOnline = do
500+ e <- deduped
501+ where count (do
502+ p <- presence
503+ where p.pubkey == e.pubkey
504+ where p.server == e.server
505+ where p.expiresAt >= e.expiresAt
506+ yield p) == 0
507+ yield {pubkey: e.pubkey, server: e.server}
488508 let merged = fold (\acc e ->
489509 if count (do
490510 p <- acc
@@ -503,6 +523,20 @@ serve = \req -> case req of
503523 k <- affectedKeys
504524 where count (do d <- deduped; where d.pubkey == k.pubkey; where d.server == k.server; yield d) == 0
505525 yield k
526+ let appliedOffline = do
527+ k <- offlineOnlyKeys
528+ where count (do
529+ p <- presence
530+ where p.pubkey == k.pubkey
531+ where p.server == k.server
532+ where count (do
533+ o <- offlineEntries
534+ where o.pubkey == k.pubkey
535+ where o.server == k.server
536+ where o.timestamp >= p.timestamp
537+ yield o) > 0
538+ yield p) > 0
539+ yield {pubkey: k.pubkey, server: k.server}
506540 let afterOffline = diff merged (do
507541 p <- merged
508542 k <- offlineOnlyKeys
@@ -518,16 +552,23 @@ serve = \req -> case req of
518552 set *presence = if validRequest
519553 then afterOffline
520554 else presence
555+ yield (union appliedOnline appliedOffline)
521556 let validEvents = do
522557 e <- events
523558 where validRequest
524559 where not (e.server == "")
525560 where not (e.pubkey == "")
561+ where not (tooLong e.pubkey maxPubkeyLen)
562+ where not (tooLong e.server maxPubkeyLen)
526563 where not (e.server == serverHost)
527564 where e.timestamp <= t
528565 where e.timestamp + (clampTtl e.ttl) * 1000 > t
529566 yield e
530− if validRequest && cappedHops > 1 && not (federationSecret == "") && count validEvents > 0
567+ let effectiveEvents = do
568+ e <- validEvents
569+ where count (do a <- appliedKeys; where a.pubkey == e.pubkey; where a.server == e.server; yield a) > 0
570+ yield e
571+ if validRequest && cappedHops > 1 && not (federationSecret == "") && count effectiveEvents > 0
531572 then do
532573 peerServers <- atomic do
533574 presence <- *presence
@@ -537,7 +578,7 @@ serve = \req -> case req of
537578 else union acc [p.server]) [] presence)
538579 let senderServers = fold (\acc e ->
539580 if count (do a <- acc; where a == e.server; yield a) > 0 then acc
540− else union acc [e.server]) (if fromServer == "" then [] else [fromServer]) events
581+ else union acc [e.server]) (if fromServer == "" then [] else [fromServer]) validEvents
541582 let targets = do
542583 s <- peerServers
543584 where count (do ss <- senderServers; where ss == s; yield ss) == 0
@@ -545,7 +586,7 @@ serve = \req -> case req of
545586 sendToEach targets (\server ->
546587 httpPost (federationScheme ++ server ++ "/federation/gossip")
547588 {authorization: "Bearer " ++ federationSecret}
548− {events: validEvents, hopsRemaining: cappedHops - 1, fromServer: serverHost})
589+ {events: effectiveEvents, hopsRemaining: cappedHops - 1, fromServer: serverHost})
549590 else yield {}
550591 respond {ok: validRequest}
551592
@@ -553,7 +594,7 @@ serve = \req -> case req of
553594 t <- now
554595 let authorized = verifyFederationAuth authorization
555596 let validOrigin = not (originServer == "") && not (originServer == serverHost)
556− let validFields = not (toKey == "") && not (fromKey == "") && not (encryptedBlob == "") && not (messageId == "") && not (tooLong toKey maxPubkeyLen) && not (tooLong fromKey maxPubkeyLen) && not (tooLong encryptedBlob maxBlobLen)
597+ let validFields = not (toKey == "") && not (fromKey == "") && not (encryptedBlob == "") && not (messageId == "") && not (tooLong toKey maxPubkeyLen) && not (tooLong fromKey maxPubkeyLen) && not (tooLong encryptedBlob maxBlobLen) && not (tooLong messageId maxPubkeyLen)
557598 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t else timestamp
558599 atomic do
559600 pruneExpired t
@@ -576,7 +617,12 @@ serve = \req -> case req of
576617 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
577618 t <- now
578619 let authorized = verifyFederationAuth authorization
579− let validAck = authorized && originServer == serverHost && not (fromServer == "") && not (fromServer == serverHost) && count messageIds <= maxMessageIds
620+ let dedupedIds = fold (\acc mid ->
621+ if mid == "" then acc
622+ else if count acc >= maxMessageIds then acc
623+ else if count (do a <- acc; where a == mid; yield a) > 0 then acc
624+ else union acc [mid]) [] messageIds
625+ let validAck = authorized && originServer == serverHost && not (fromServer == "") && not (fromServer == serverHost) && not (tooLong fromServer maxPubkeyLen) && count messageIds <= maxMessageIds
580626 atomic do
581627 pruneExpired t
582628 messages <- *messages
@@ -584,7 +630,7 @@ serve = \req -> case req of
584630 set *messages = if validAck
585631 then diff messages (do
586632 m <- messages
587− mid <- messageIds
633+ mid <- dedupedIds
588634 where m.messageId == mid
589635 where count (do
590636 p <- presence