@@ -28,7 +28,7 @@ type GossipEvent = {eventType: Text, pubkey: Text, server: Text, timestamp: Int,
2828
2929*sessions : [{token: Text, pubkey: Text, expiresAt: Int}]
3030
31−*messages : [{messageId: Text, toKey: Text, fromKey: Text, encryptedBlob: Text, timestamp: Int, originServer: Text}]
31+*messages : [{messageId: Text, toKey: Text, fromKey: Text, encryptedBlob: Text, timestamp: Int, originServer: Text, receivedAt: Int}]
3232
3333*presence : [{pubkey: Text, server: Text, expiresAt: Int}]
3434
@@ -155,15 +155,18 @@ pruneExpired = \t -> do
155155
156156serve = \req -> case req of
157157
158− ReqChallenge {pubkey, respond} -> do
159− challenge <- genToken
160− t <- now
161− atomic do
162− pruneExpired t
163− challenges <- *challenges
164− set *challenges = union challenges
165− [{pubkey: pubkey, challenge: challenge, expiresAt: t + 60000}]
166− respond {challenge: challenge}
158+ ReqChallenge {pubkey, respond} ->
159+ if pubkey == ""
160+ then respond {challenge: ""}
161+ else do
162+ challenge <- genToken
163+ t <- now
164+ atomic do
165+ pruneExpired t
166+ challenges <- *challenges
167+ set *challenges = union challenges
168+ [{pubkey: pubkey, challenge: challenge, expiresAt: t + 60000}]
169+ respond {challenge: challenge}
167170
168171 VerifyAuth {pubkey, challenge, signature, respond} -> do
169172 t <- now
@@ -183,12 +186,12 @@ serve = \req -> case req of
183186 let sigValid = case matched of
184187 Nothing {} -> False {}
185188 _ -> verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
186− set *challenges = case matched of
187− Nothing {} -> challenges
188− _ -> do
189+ set *challenges = if sigValid
190+ then do
189191 c <- challenges
190192 where not (c.pubkey == pubkey && c.challenge == challenge)
191193 yield c
194+ else challenges
192195 let existingForKey = do
193196 s <- sessions
194197 where s.pubkey == pubkey
@@ -245,7 +248,7 @@ serve = \req -> case req of
245248 m <- messages
246249 where m.toKey == s.pubkey
247250 where m.timestamp >= t - messageMaxAge
248− where m.timestamp >= cursor
251+ where m.receivedAt > cursor
249252 yield {id: m.messageId, eventType: "message",
250253 payload: toJson {toKey: m.toKey, fromKey: m.fromKey,
251254 encryptedBlob: m.encryptedBlob,
@@ -272,7 +275,7 @@ serve = \req -> case req of
272275 Just {value: s} -> if validInput
273276 then union messages
274277 [{messageId: msgId, toKey: to, fromKey: s.pubkey,
275− encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: ""}]
278+ encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: t}]
276279 else messages
277280 let localOnline = case session of
278281 Nothing {} -> False {}
@@ -325,13 +328,9 @@ serve = \req -> case req of
325328 where m.messageId == mid
326329 where m.toKey == s.pubkey
327330 yield m
328− let localAcked = do
329− m <- ackedMessages
330− where m.originServer == ""
331− yield m
332331 set *messages = case session of
333332 Nothing {} -> messages
334− Just {value: _} -> diff messages localAcked
333+ Just {value: _} -> diff messages ackedMessages
335334 let ok = case session of
336335 Nothing {} -> False {}
337336 _ -> True {}
@@ -345,20 +344,11 @@ serve = \req -> case req of
345344 if count (do a <- acc; where a == m.originServer; yield a) > 0 then acc
346345 else union acc [m.originServer]) [] fedMessages
347346 if result.ok && count originServers > 0 && not (federationSecret == "")
348− then sendToEach originServers (\server -> do
349− ackResult <- httpPost (federationScheme ++ server ++ "/federation/ack")
347+ then sendToEach originServers (\server ->
348+ httpPost (federationScheme ++ server ++ "/federation/ack")
350349 {authorization: "Bearer " ++ federationSecret}
351350 {messageIds: (do m <- fedMessages; where m.originServer == server; yield m.messageId),
352− originServer: server, fromServer: serverHost}
353− if ackResult.ok
354− then atomic do
355− messages <- *messages
356− set *messages = diff messages (do
357− m <- messages
358− mid <- (do fm <- fedMessages; where fm.originServer == server; yield fm.messageId)
359− where m.messageId == mid
360− yield m)
361− else yield {})
351+ originServer: server, fromServer: serverHost})
362352 else yield {}
363353 respond {ok: result.ok}
364354
@@ -396,7 +386,8 @@ serve = \req -> case req of
396386 RecvGossip {events, hopsRemaining, authorization, respond} -> do
397387 t <- now
398388 let authorized = verifyFederationAuth authorization
399− let validRequest = authorized && hopsRemaining >= 1
389+ let cappedHops = if hopsRemaining > 5 then 5 else hopsRemaining
390+ let validRequest = authorized && cappedHops >= 1
400391 let onlineEntries = do
401392 e <- events
402393 where e.eventType == "online"
@@ -457,7 +448,7 @@ serve = \req -> case req of
457448 set *presence = if validRequest
458449 then union cleaned deduped
459450 else presence
460− if validRequest && hopsRemaining > 1 && not (federationSecret == "")
451+ if validRequest && cappedHops > 1 && not (federationSecret == "")
461452 then do
462453 peerServers <- atomic do
463454 presence <- *presence
@@ -475,7 +466,7 @@ serve = \req -> case req of
475466 sendToEach targets (\server ->
476467 httpPost (federationScheme ++ server ++ "/federation/gossip")
477468 {authorization: "Bearer " ++ federationSecret}
478− {events: events, hopsRemaining: hopsRemaining - 1})
469+ {events: events, hopsRemaining: cappedHops - 1})
479470 else yield {}
480471 respond {ok: validRequest}
481472
@@ -497,7 +488,7 @@ serve = \req -> case req of
497488 set *messages = if shouldInsert
498489 then union messages
499490 [{messageId: messageId, toKey: toKey, fromKey: fromKey,
500− encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer}]
491+ encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: t}]
501492 else messages
502493 respond {ok: authorized && validOrigin && validFields}
503494