@@ -185,31 +185,32 @@ serve = \req -> case req of
185185 Poll {authorization, respond} -> do
186186 t <- now
187187 let token = extractToken authorization
188− session <- atomic do
188+ result <- atomic do
189189 pruneExpired t
190190 sessions <- *sessions
191− yield (lookupSession sessions token t)
192− case session of
193− Nothing {} -> respond {events: [], cursor: "unauthorized"}
194− Just {value: s} -> do
195− evts <- atomic do
196− messages <- *messages
197− let pending = do
198− m <- messages
199− where m.toKey == s.pubkey
200− where m.timestamp > t - messageMaxAge
201− yield {id: m.messageId, eventType: "message",
202− payload: toJson {toKey: m.toKey, fromKey: m.fromKey,
203− encryptedBlob: m.encryptedBlob,
204− timestamp: m.timestamp}}
205− yield pending
206− respond {events: evts, cursor: ""}
191+ messages <- *messages
192+ let session = lookupSession sessions token t
193+ let evts = case session of
194+ Nothing {} -> []
195+ Just {value: s} -> do
196+ m <- messages
197+ where m.toKey == s.pubkey
198+ where m.timestamp > t - messageMaxAge
199+ yield {id: m.messageId, eventType: "message",
200+ payload: toJson {toKey: m.toKey, fromKey: m.fromKey,
201+ encryptedBlob: m.encryptedBlob,
202+ timestamp: m.timestamp}}
203+ let cursor = case session of
204+ Nothing {} -> "unauthorized"
205+ _ -> ""
206+ yield {events: evts, cursor: cursor}
207+ respond result
207208
208209 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
209210 t <- now
210211 msgId <- genToken
211212 let clampedTs = if timestamp > t then t else timestamp
212− status <- atomic do
213+ result <- atomic do
213214 pruneExpired t
214215 sessions <- *sessions
215216 messages <- *messages
@@ -220,7 +221,7 @@ serve = \req -> case req of
220221 Just {value: s} -> union messages
221222 [{messageId: msgId, toKey: to, fromKey: s.pubkey,
222223 encryptedBlob: encryptedBlob, timestamp: clampedTs}]
223− let online = case session of
224+ let localOnline = case session of
224225 Nothing {} -> False {}
225226 Just {value: _} -> count (do
226227 p <- presence
@@ -228,11 +229,30 @@ serve = \req -> case req of
228229 where p.server == serverHost
229230 where p.expiresAt > t
230231 yield p) > 0
232+ let remoteServer = case session of
233+ Nothing {} -> ""
234+ Just {value: _} -> fold (\_ p -> p.server) "" (do
235+ p <- presence
236+ where p.pubkey == to
237+ where not (p.server == serverHost)
238+ where p.expiresAt > t
239+ yield p)
240+ let fromKey = case session of
241+ Nothing {} -> ""
242+ Just {value: s} -> s.pubkey
231243 let status = case session of
232244 Nothing {} -> "unauthorized"
233− _ -> if online then "delivered" else "queued"
234− yield status
235− respond {status: status, messageId: (if status == "unauthorized" then "" else msgId)}
245+ _ -> if localOnline then "delivered"
246+ else if not (remoteServer == "") then "federated"
247+ else "queued"
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}
254+ else yield {}
255+ respond {status: result.status, messageId: (if result.status == "unauthorized" then "" else msgId)}
236256
237257 AckMessages {messageIds, authorization, respond} -> do
238258 t <- now
@@ -290,10 +310,16 @@ serve = \req -> case req of
290310 where e.eventType == "online"
291311 where not (e.server == serverHost)
292312 yield {pubkey: e.pubkey, server: e.server, expiresAt: t + (clampTtl e.ttl) * 1000}
293− let affectedKeys = do
313+ let offlineEntries = do
294314 e <- events
315+ where e.eventType == "offline"
295316 where not (e.server == serverHost)
296317 yield {pubkey: e.pubkey, server: e.server}
318+ let affectedKeys = union
319+ (do
320+ e <- onlineEntries
321+ yield {pubkey: e.pubkey, server: e.server})
322+ offlineEntries
297323 let deduped = fold (\acc e ->
298324 if count (do
299325 a <- acc
@@ -349,11 +375,18 @@ serve = \req -> case req of
349375 atomic do
350376 pruneExpired t
351377 messages <- *messages
378+ presence <- *presence
352379 set *messages = if validAck
353380 then diff messages (do
354381 m <- messages
355382 mid <- messageIds
356383 where m.messageId == mid
384+ where count (do
385+ p <- presence
386+ where p.pubkey == m.toKey
387+ where p.server == serverHost
388+ where p.expiresAt > t
389+ yield p) == 0
357390 yield m)
358391 else messages
359392 respond {ok: validAck}