@@ -185,31 +185,32 @@ serve = \req -> case req of
185 Poll {authorization, respond} -> do
185 Poll {authorization, respond} -> do
187 let token = extractToken authorization
187 let token = extractToken authorization
188− session <- atomic do
188+ result <- atomic do
189 pruneExpired t
189 pruneExpired t
190 sessions <- *sessions
190 sessions <- *sessions
191+ messages <- *messages
191− yield (lookupSession sessions token t)
192+ let session = lookupSession sessions token t
192− case session of
193+ let evts = case session of
193− Nothing {} -> respond {events: [], cursor: "unauthorized"}
194+ Nothing {} -> []
194− Just {value: s} -> do
195+ Just {value: s} -> do
196− messages <- *messages
196+ m <- messages
199− where m.toKey == s.pubkey
197+ where m.toKey == s.pubkey
200− where m.timestamp > t - messageMaxAge
198+ where m.timestamp > t - messageMaxAge
201− yield {id: m.messageId, eventType: "message",
199+ yield {id: m.messageId, eventType: "message",
202− payload: toJson {toKey: m.toKey, fromKey: m.fromKey,
200+ payload: toJson {toKey: m.toKey, fromKey: m.fromKey,
203− encryptedBlob: m.encryptedBlob,
201+ encryptedBlob: m.encryptedBlob,
204− timestamp: m.timestamp}}
202+ timestamp: m.timestamp}}
205− yield pending
203+ let cursor = case session of
204+ Nothing {} -> "unauthorized"
206− respond {events: evts, cursor: ""}
206+ yield {events: evts, cursor: cursor}
208 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
209 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
210 msgId <- genToken
211 msgId <- genToken
211 let clampedTs = if timestamp > t then t else timestamp
212 let clampedTs = if timestamp > t then t else timestamp
212− status <- atomic do
213+ result <- atomic do
213 pruneExpired t
214 pruneExpired t
214 sessions <- *sessions
215 sessions <- *sessions
215 messages <- *messages
216 messages <- *messages
@@ -220,7 +221,7 @@ serve = \req -> case req of
220 Just {value: s} -> union messages
221 Just {value: s} -> union messages
221 [{messageId: msgId, toKey: to, fromKey: s.pubkey,
222 [{messageId: msgId, toKey: to, fromKey: s.pubkey,
222 encryptedBlob: encryptedBlob, timestamp: clampedTs}]
223 encryptedBlob: encryptedBlob, timestamp: clampedTs}]
223− let online = case session of
224+ let localOnline = case session of
224 Nothing {} -> False {}
225 Nothing {} -> False {}
225 Just {value: _} -> count (do
226 Just {value: _} -> count (do
226 p <- presence
227 p <- presence
@@ -228,11 +229,30 @@ serve = \req -> case req of
228 where p.server == serverHost
229 where p.server == serverHost
229 where p.expiresAt > t
230 where p.expiresAt > t
230 yield p) > 0
231 yield p) > 0
232+ let remoteServer = case session of
234+ Just {value: _} -> fold (\_ p -> p.server) "" (do
236+ where p.pubkey == to
237+ where not (p.server == serverHost)
238+ where p.expiresAt > t
240+ let fromKey = case session of
242+ Just {value: s} -> s.pubkey
231 let status = case session of
243 let status = case session of
232 Nothing {} -> "unauthorized"
244 Nothing {} -> "unauthorized"
233− _ -> if online then "delivered" else "queued"
245+ _ -> if localOnline then "delivered"
234− yield status
246+ else if not (remoteServer == "") then "federated"
248+ yield {status: status, remoteServer: remoteServer, fromKey: fromKey}
249+ if result.status == "federated" && not (result.remoteServer == "") && not (federationSecret == "")
250+ then httpPost ("http://" ++ result.remoteServer ++ "/federation/forward")
251+ {authorization: "Bearer " ++ federationSecret}
252+ {toKey: to, fromKey: result.fromKey, encryptedBlob: encryptedBlob,
253+ timestamp: clampedTs, originServer: serverHost, messageId: msgId}
235− respond {status: status, messageId: (if status == "unauthorized" then "" else msgId)}
255+ respond {status: result.status, messageId: (if result.status == "unauthorized" then "" else msgId)}
237 AckMessages {messageIds, authorization, respond} -> do
257 AckMessages {messageIds, authorization, respond} -> do
@@ -290,10 +310,16 @@ serve = \req -> case req of
290 where e.eventType == "online"
310 where e.eventType == "online"
291 where not (e.server == serverHost)
311 where not (e.server == serverHost)
292 yield {pubkey: e.pubkey, server: e.server, expiresAt: t + (clampTtl e.ttl) * 1000}
312 yield {pubkey: e.pubkey, server: e.server, expiresAt: t + (clampTtl e.ttl) * 1000}
293− let affectedKeys = do
313+ let offlineEntries = do
294 e <- events
314 e <- events
315+ where e.eventType == "offline"
295 where not (e.server == serverHost)
316 where not (e.server == serverHost)
296 yield {pubkey: e.pubkey, server: e.server}
317 yield {pubkey: e.pubkey, server: e.server}
318+ let affectedKeys = union
321+ yield {pubkey: e.pubkey, server: e.server})
297 let deduped = fold (\acc e ->
323 let deduped = fold (\acc e ->
298 if count (do
324 if count (do
@@ -349,11 +375,18 @@ serve = \req -> case req of
349 atomic do
375 atomic do
350 pruneExpired t
376 pruneExpired t
351 messages <- *messages
377 messages <- *messages
378+ presence <- *presence
352 set *messages = if validAck
379 set *messages = if validAck
353 then diff messages (do
380 then diff messages (do
354 m <- messages
381 m <- messages
355 mid <- messageIds
382 mid <- messageIds
356 where m.messageId == mid
383 where m.messageId == mid
386+ where p.pubkey == m.toKey
387+ where p.server == serverHost
388+ where p.expiresAt > t
358 else messages
391 else messages
359 respond {ok: validAck}
392 respond {ok: validAck}