@@ -114,10 +114,6 @@ verifyFederationAuth = \authorization ->
114114
115115clampTtl = \ttl -> if ttl < 1 then 1 else if ttl > maxPresenceTtl then maxPresenceTtl else ttl
116116
117−forwardToAll = \servers action -> do
118− sendToEach servers (\server -> action server)
119− yield (count servers > 0)
120−
121117sendToEach = \servers action ->
122118 if count servers == 0
123119 then yield {}
@@ -270,7 +266,10 @@ serve = \req -> case req of
270266 authorization: "Bearer " ++ federationSecret,
271267 events: [{eventType: "online", pubkey: pubkey, server: serverHost, timestamp: t, ttl: 3600}], hopsRemaining: 2, fromServer: serverHost}))
272268 else yield {}
273− broadcastOfflineGossip t result.offlinePeers result.expiredLocal
269+ broadcastOfflineGossip t result.offlinePeers (do
270+ p <- result.expiredLocal
271+ where not (p.pubkey == pubkey)
272+ yield p)
274273 if result.sigValid
275274 then respond {token: token, expiresAt: expiry}
276275 else respond {token: "", expiresAt: 0}
@@ -309,7 +308,7 @@ serve = \req -> case req of
309308 t <- now
310309 msgId <- genToken
311310 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t else timestamp
312− let validInput = not (to == "") && not (encryptedBlob == "") && isValidHex to && isValidHex encryptedBlob && not (tooLong to maxPubkeyLen) && not (tooLong encryptedBlob maxBlobLen)
311+ let validInput = not (to == "") && not (encryptedBlob == "") && not (tooLong to maxPubkeyLen) && not (tooLong encryptedBlob maxBlobLen) && isValidHex to && isValidHex encryptedBlob
313312 result <- atomic do
314313 pr <- pruneExpired t
315314 sessions <- *sessions
@@ -357,13 +356,13 @@ serve = \req -> case req of
357356 yield {status: status, remoteServers: remoteServers, fromKey: fromKey, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}
358357 finalStatus <- if result.status == "federated" && not (federationSecret == "")
359358 then do
360− anyOk <- forwardToAll result.remoteServers (\server ->
359+ sendToEach result.remoteServers (\server ->
361360 fetch (federationScheme ++ server) (ForwardMessage {
362361 toKey: to, fromKey: result.fromKey, encryptedBlob: encryptedBlob,
363362 timestamp: clampedTs, originServer: serverHost, messageId: msgId,
364363 authorization: "Bearer " ++ federationSecret}))
365− yield (if anyOk then "federated" else "queued")
366− else yield result.status
364+ yield "federated"
365+ else yield (if result.status == "federated" then "queued" else result.status)
367366 broadcastOfflineGossip t result.peerServers result.expiredLocal
368367 respond {status: finalStatus, messageId: (if result.status == "unauthorized" then "" else if result.status == "invalid" then "" else msgId)}
369368
@@ -371,9 +370,9 @@ serve = \req -> case req of
371370 t <- now
372371 let dedupedIds = fold (\acc mid ->
373372 if mid == "" then acc
374− else if not (isValidHex mid) then acc
375− else if tooLong mid maxPubkeyLen then acc
376373 else if count acc >= maxMessageIds then acc
374+ else if tooLong mid maxPubkeyLen then acc
375+ else if not (isValidHex mid) then acc
377376 else if count (do a <- acc; where a == mid; yield a) > 0 then acc
378377 else union acc [mid]) [] messageIds
379378 result <- atomic do
@@ -439,7 +438,7 @@ serve = \req -> case req of
439438 where p.server == serverHost
440439 yield p) of
441440 Just {value: p} -> p.server
442− Nothing {} -> fold (\_ p -> p.server) "" valid
441+ Nothing {} -> (fold (\acc p -> if p.expiresAt > acc.best then {server: p.server, best: p.expiresAt} else acc) {server: "", best: 0} valid).server
443442 yield {foundServer: foundServer, authorized: authorized, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}
444443 broadcastOfflineGossip t result.peerServers result.expiredLocal
445444 respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: result.authorized}
@@ -455,9 +454,9 @@ serve = \req -> case req of
455454 where e.eventType == "online"
456455 where not (e.server == "")
457456 where not (e.pubkey == "")
458− where isValidHex e.pubkey
459457 where not (tooLong e.pubkey maxPubkeyLen)
460458 where not (tooLong e.server maxPubkeyLen)
459+ where isValidHex e.pubkey
461460 where not (e.server == serverHost)
462461 where e.timestamp <= t + clockSkewTolerance
463462 where e.timestamp + (clampTtl e.ttl) * 1000 > t
@@ -468,9 +467,9 @@ serve = \req -> case req of
468467 where e.eventType == "offline"
469468 where not (e.server == "")
470469 where not (e.pubkey == "")
471− where isValidHex e.pubkey
472470 where not (tooLong e.pubkey maxPubkeyLen)
473471 where not (tooLong e.server maxPubkeyLen)
472+ where isValidHex e.pubkey
474473 where not (e.server == serverHost)
475474 where e.timestamp <= t + clockSkewTolerance
476475 where t - e.timestamp < (clampTtl e.ttl) * 1000
@@ -570,9 +569,9 @@ serve = \req -> case req of
570569 where validRequest
571570 where not (e.server == "")
572571 where not (e.pubkey == "")
573− where isValidHex e.pubkey
574572 where not (tooLong e.pubkey maxPubkeyLen)
575573 where not (tooLong e.server maxPubkeyLen)
574+ where isValidHex e.pubkey
576575 where not (e.server == serverHost)
577576 where e.timestamp <= t + clockSkewTolerance
578577 where e.timestamp + (clampTtl e.ttl) * 1000 > t
@@ -614,7 +613,7 @@ serve = \req -> case req of
614613 t <- now
615614 let authorized = verifyFederationAuth authorization
616615 let validOrigin = not (originServer == "") && not (originServer == serverHost) && not (tooLong originServer maxPubkeyLen)
617− let validFields = not (toKey == "") && not (fromKey == "") && not (encryptedBlob == "") && not (messageId == "") && isValidHex toKey && isValidHex fromKey && isValidHex encryptedBlob && isValidHex messageId && not (tooLong toKey maxPubkeyLen) && not (tooLong fromKey maxPubkeyLen) && not (tooLong encryptedBlob maxBlobLen) && not (tooLong messageId maxPubkeyLen)
616+ let validFields = not (toKey == "") && not (fromKey == "") && not (encryptedBlob == "") && not (messageId == "") && not (tooLong toKey maxPubkeyLen) && not (tooLong fromKey maxPubkeyLen) && not (tooLong encryptedBlob maxBlobLen) && not (tooLong messageId maxPubkeyLen) && isValidHex toKey && isValidHex fromKey && isValidHex encryptedBlob && isValidHex messageId
618617 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t else timestamp
619618 pruneResult <- atomic do
620619 pr <- pruneExpired t
@@ -643,9 +642,9 @@ serve = \req -> case req of
643642 let authorized = verifyFederationAuth authorization
644643 let dedupedIds = fold (\acc mid ->
645644 if mid == "" then acc
646− else if not (isValidHex mid) then acc
647− else if tooLong mid maxPubkeyLen then acc
648645 else if count acc >= maxMessageIds then acc
646+ else if tooLong mid maxPubkeyLen then acc
647+ else if not (isValidHex mid) then acc
649648 else if count (do a <- acc; where a == mid; yield a) > 0 then acc
650649 else union acc [mid]) [] messageIds
651650 let validAck = authorized && originServer == serverHost && not (fromServer == "") && not (fromServer == serverHost) && not (tooLong fromServer maxPubkeyLen)