@@ -164,7 +164,10 @@ serve = \req -> case req of
164 where not (c.pubkey == pubkey && c.challenge == challenge)
164 where not (c.pubkey == pubkey && c.challenge == challenge)
166 set *sessions = if sigValid
166 set *sessions = if sigValid
169+ where not (s.pubkey == pubkey)
167− then union sessions [{token: token, pubkey: pubkey, expiresAt: expiry}]
170+ yield s) [{token: token, pubkey: pubkey, expiresAt: expiry}]
168 else sessions
171 else sessions
169 set *presence = if sigValid
172 set *presence = if sigValid
170 then union
173 then union
@@ -183,6 +186,7 @@ serve = \req -> case req of
184 let token = extractToken authorization
187 let token = extractToken authorization
185 session <- atomic do
188 session <- atomic do
186 sessions <- *sessions
190 sessions <- *sessions
187 yield (lookupSession sessions token t)
191 yield (lookupSession sessions token t)
188 case session of
192 case session of
@@ -193,6 +197,7 @@ serve = \req -> case req of
193 let pending = do
197 let pending = do
194 m <- messages
198 m <- messages
195 where m.toKey == s.pubkey
199 where m.toKey == s.pubkey
200+ where m.timestamp > t - messageMaxAge
196 yield {id: m.messageId, eventType: "message",
201 yield {id: m.messageId, eventType: "message",
197 payload: toJson {toKey: m.toKey, fromKey: m.fromKey,
202 payload: toJson {toKey: m.toKey, fromKey: m.fromKey,
198 encryptedBlob: m.encryptedBlob,
203 encryptedBlob: m.encryptedBlob,
@@ -203,23 +208,26 @@ serve = \req -> case req of
203 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
208 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
205 msgId <- genToken
210 msgId <- genToken
211+ let clampedTs = if timestamp > t then t else timestamp
206 status <- atomic do
212 status <- atomic do
207 pruneExpired t
213 pruneExpired t
208 sessions <- *sessions
214 sessions <- *sessions
209 messages <- *messages
215 messages <- *messages
216+ presence <- *presence
210 let session = lookupSession sessions (extractToken authorization) t
217 let session = lookupSession sessions (extractToken authorization) t
211 set *messages = case session of
218 set *messages = case session of
212 Nothing {} -> messages
219 Nothing {} -> messages
213 Just {value: s} -> union messages
220 Just {value: s} -> union messages
214 [{messageId: msgId, toKey: to, fromKey: s.pubkey,
221 [{messageId: msgId, toKey: to, fromKey: s.pubkey,
215− encryptedBlob: encryptedBlob, timestamp: t}]
222+ encryptedBlob: encryptedBlob, timestamp: clampedTs}]
216 let online = case session of
223 let online = case session of
217 Nothing {} -> False {}
224 Nothing {} -> False {}
218 Just {value: _} -> count (do
225 Just {value: _} -> count (do
219− s <- sessions
226+ p <- presence
220− where s.pubkey == to
227+ where p.pubkey == to
228+ where p.server == serverHost
221− where s.expiresAt > t
229+ where p.expiresAt > t
222− yield s) > 0
230+ yield p) > 0
223 let status = case session of
231 let status = case session of
224 Nothing {} -> "unauthorized"
232 Nothing {} -> "unauthorized"
225 _ -> if online then "delivered" else "queued"
233 _ -> if online then "delivered" else "queued"
@@ -229,6 +237,7 @@ serve = \req -> case req of
229 AckMessages {messageIds, authorization, respond} -> do
237 AckMessages {messageIds, authorization, respond} -> do
231 ok <- atomic do
239 ok <- atomic do
232 sessions <- *sessions
241 sessions <- *sessions
233 messages <- *messages
242 messages <- *messages
234 let session = lookupSession sessions (extractToken authorization) t
243 let session = lookupSession sessions (extractToken authorization) t
@@ -249,6 +258,7 @@ serve = \req -> case req of
249 LookupPresence {pubkey, authorization, respond} -> do
258 LookupPresence {pubkey, authorization, respond} -> do
251 foundServer <- atomic do
260 foundServer <- atomic do
252 sessions <- *sessions
262 sessions <- *sessions
253 presence <- *presence
263 presence <- *presence
254 let session = lookupSession sessions (extractToken authorization) t
264 let session = lookupSession sessions (extractToken authorization) t
@@ -278,20 +288,28 @@ serve = \req -> case req of
278 let onlineEntries = do
288 let onlineEntries = do
279 e <- events
289 e <- events
280 where e.eventType == "online"
290 where e.eventType == "online"
291+ where not (e.server == serverHost)
281− yield {pubkey: e.pubkey, server: e.server, expiresAt: t + clampTtl e.ttl * 1000}
292+ yield {pubkey: e.pubkey, server: e.server, expiresAt: t + (clampTtl e.ttl) * 1000}
282 let affectedKeys = do
293 let affectedKeys = do
283 e <- events
294 e <- events
295+ where not (e.server == serverHost)
284 yield {pubkey: e.pubkey, server: e.server}
296 yield {pubkey: e.pubkey, server: e.server}
285− let deduped = do
297+ let deduped = fold (\acc e ->
287− where count (do
298+ if count (do
288− o <- onlineEntries
299+ a <- acc
289− where o.pubkey == e.pubkey
300+ where a.pubkey == e.pubkey
290− where o.server == e.server
301+ where a.server == e.server
291− where o.expiresAt > e.expiresAt
302+ where a.expiresAt >= e.expiresAt
292− yield o) == 0
303+ yield a) > 0
308+ where not (a.pubkey == e.pubkey && a.server == e.server)
293− yield e
309+ yield a)
310+ [e]) [] onlineEntries
294 atomic do
311 atomic do
295 presence <- *presence
313 presence <- *presence
296 let cleaned = diff presence (do
314 let cleaned = diff presence (do
297 p <- presence
315 p <- presence
@@ -309,6 +327,7 @@ serve = \req -> case req of
309 let authorized = verifyFederationAuth authorization
327 let authorized = verifyFederationAuth authorization
310 let clampedTs = if timestamp > t then t else timestamp
328 let clampedTs = if timestamp > t then t else timestamp
311 atomic do
329 atomic do
312 messages <- *messages
331 messages <- *messages
313 let exists = count (do
332 let exists = count (do
314 m <- messages
333 m <- messages
@@ -324,9 +343,11 @@ serve = \req -> case req of
324 respond {ok: authorized}
343 respond {ok: authorized}
326 FederationAck {messageIds, originServer, authorization, respond} -> do
345 FederationAck {messageIds, originServer, authorization, respond} -> do
327 let authorized = verifyFederationAuth authorization
347 let authorized = verifyFederationAuth authorization
328 let validAck = authorized && originServer == serverHost
348 let validAck = authorized && originServer == serverHost
329 atomic do
349 atomic do
330 messages <- *messages
351 messages <- *messages
331 set *messages = if validAck
352 set *messages = if validAck
332 then diff messages (do
353 then diff messages (do