@@ -8,6 +8,7 @@
88
99serverHost = "localhost:8080"
1010federationSecret = "" -- must be set to enable federation
11+federationScheme = "https://" -- scheme for federation HTTP calls
1112messageMaxAge = 86400000 -- 24 hours in milliseconds
1213maxPresenceTtl = 3600 -- max presence TTL from gossip in seconds
1314
@@ -106,7 +107,7 @@ forwardToAll = \servers path headers body ->
106107 then yield False {}
107108 else do
108109 let server = fold (\acc s -> if acc == "" then s else acc) "" servers
109− result <- httpPost ("http://" ++ server ++ path) headers body
110+ result <- httpPost (federationScheme ++ server ++ path) headers body
110111 restOk <- forwardToAll (do s <- servers; where not (s == server); yield s) path headers body
111112 yield (if result.ok then True {} else restOk)
112113
@@ -302,7 +303,7 @@ serve = \req -> case req of
302303 else union acc [m.originServer]) [] fedMessages
303304 if result.ok && count originServers > 0 && not (federationSecret == "")
304305 then sendToEach originServers (\server ->
305− httpPost ("http://" ++ server ++ "/federation/ack")
306+ httpPost (federationScheme ++ server ++ "/federation/ack")
306307 {authorization: "Bearer " ++ federationSecret}
307308 {messageIds: (do m <- fedMessages; where m.originServer == server; yield m.messageId),
308309 originServer: server})
@@ -343,11 +344,15 @@ serve = \req -> case req of
343344 e <- events
344345 where e.eventType == "online"
345346 where not (e.server == serverHost)
346− yield {pubkey: e.pubkey, server: e.server, expiresAt: t + (clampTtl e.ttl) * 1000}
347+ where e.timestamp <= t
348+ where e.timestamp + (clampTtl e.ttl) * 1000 > t
349+ yield {pubkey: e.pubkey, server: e.server, expiresAt: e.timestamp + (clampTtl e.ttl) * 1000}
347350 let offlineEntries = do
348351 e <- events
349352 where e.eventType == "offline"
350353 where not (e.server == serverHost)
354+ where e.timestamp <= t
355+ where t - e.timestamp < (clampTtl e.ttl) * 1000
351356 yield {pubkey: e.pubkey, server: e.server}
352357 let affectedKeys = union
353358 (do
@@ -380,12 +385,32 @@ serve = \req -> case req of
380385 set *presence = if validRequest
381386 then union cleaned deduped
382387 else presence
388+ if validRequest && hopsRemaining > 1 && not (federationSecret == "")
389+ then do
390+ peerServers <- atomic do
391+ presence <- *presence
392+ yield (fold (\acc p ->
393+ if p.server == serverHost then acc
394+ else if count (do a <- acc; where a == p.server; yield a) > 0 then acc
395+ else union acc [p.server]) [] presence)
396+ let senderServers = fold (\acc e ->
397+ if count (do a <- acc; where a == e.server; yield a) > 0 then acc
398+ else union acc [e.server]) [] events
399+ let targets = do
400+ s <- peerServers
401+ where count (do ss <- senderServers; where ss == s; yield ss) == 0
402+ yield s
403+ sendToEach targets (\server ->
404+ httpPost (federationScheme ++ server ++ "/federation/gossip")
405+ {authorization: "Bearer " ++ federationSecret}
406+ {events: events, hopsRemaining: hopsRemaining - 1})
407+ else yield {}
383408 respond {ok: validRequest}
384409
385410 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
386411 t <- now
387412 let authorized = verifyFederationAuth authorization
388− let clampedTs = if timestamp > t then t else timestamp
413+ let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t - messageMaxAge else timestamp
389414 atomic do
390415 pruneExpired t
391416 messages <- *messages