@@ -8,6 +8,7 @@
9serverHost = "localhost:8080"
9serverHost = "localhost:8080"
10federationSecret = "" -- must be set to enable federation
10federationSecret = "" -- must be set to enable federation
11+federationScheme = "https://" -- scheme for federation HTTP calls
11messageMaxAge = 86400000 -- 24 hours in milliseconds
12messageMaxAge = 86400000 -- 24 hours in milliseconds
12maxPresenceTtl = 3600 -- max presence TTL from gossip in seconds
13maxPresenceTtl = 3600 -- max presence TTL from gossip in seconds
@@ -106,7 +107,7 @@ forwardToAll = \servers path headers body ->
106 then yield False {}
107 then yield False {}
108 let server = fold (\acc s -> if acc == "" then s else acc) "" servers
109 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
110 restOk <- forwardToAll (do s <- servers; where not (s == server); yield s) path headers body
111 restOk <- forwardToAll (do s <- servers; where not (s == server); yield s) path headers body
111 yield (if result.ok then True {} else restOk)
112 yield (if result.ok then True {} else restOk)
@@ -302,7 +303,7 @@ serve = \req -> case req of
302 else union acc [m.originServer]) [] fedMessages
303 else union acc [m.originServer]) [] fedMessages
303 if result.ok && count originServers > 0 && not (federationSecret == "")
304 if result.ok && count originServers > 0 && not (federationSecret == "")
304 then sendToEach originServers (\server ->
305 then sendToEach originServers (\server ->
305− httpPost ("http://" ++ server ++ "/federation/ack")
306+ httpPost (federationScheme ++ server ++ "/federation/ack")
306 {authorization: "Bearer " ++ federationSecret}
307 {authorization: "Bearer " ++ federationSecret}
307 {messageIds: (do m <- fedMessages; where m.originServer == server; yield m.messageId),
308 {messageIds: (do m <- fedMessages; where m.originServer == server; yield m.messageId),
308 originServer: server})
309 originServer: server})
@@ -343,11 +344,15 @@ serve = \req -> case req of
343 e <- events
344 e <- events
344 where e.eventType == "online"
345 where e.eventType == "online"
345 where not (e.server == serverHost)
346 where not (e.server == serverHost)
347+ where e.timestamp <= t
348+ where e.timestamp + (clampTtl e.ttl) * 1000 > t
346− yield {pubkey: e.pubkey, server: e.server, expiresAt: t + (clampTtl e.ttl) * 1000}
349+ yield {pubkey: e.pubkey, server: e.server, expiresAt: e.timestamp + (clampTtl e.ttl) * 1000}
347 let offlineEntries = do
350 let offlineEntries = do
348 e <- events
351 e <- events
349 where e.eventType == "offline"
352 where e.eventType == "offline"
350 where not (e.server == serverHost)
353 where not (e.server == serverHost)
354+ where e.timestamp <= t
355+ where t - e.timestamp < (clampTtl e.ttl) * 1000
351 yield {pubkey: e.pubkey, server: e.server}
356 yield {pubkey: e.pubkey, server: e.server}
352 let affectedKeys = union
357 let affectedKeys = union
@@ -380,12 +385,32 @@ serve = \req -> case req of
380 set *presence = if validRequest
385 set *presence = if validRequest
381 then union cleaned deduped
386 then union cleaned deduped
382 else presence
387 else presence
388+ if validRequest && hopsRemaining > 1 && not (federationSecret == "")
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
401+ where count (do ss <- senderServers; where ss == s; yield ss) == 0
403+ sendToEach targets (\server ->
404+ httpPost (federationScheme ++ server ++ "/federation/gossip")
405+ {authorization: "Bearer " ++ federationSecret}
406+ {events: events, hopsRemaining: hopsRemaining - 1})
383 respond {ok: validRequest}
408 respond {ok: validRequest}
385 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
410 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
387 let authorized = verifyFederationAuth authorization
412 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
389 atomic do
414 atomic do
390 pruneExpired t
415 pruneExpired t
391 messages <- *messages
416 messages <- *messages