@@ -114,10 +114,6 @@ verifyFederationAuth = \authorization ->
115clampTtl = \ttl -> if ttl < 1 then 1 else if ttl > maxPresenceTtl then maxPresenceTtl else ttl
115clampTtl = \ttl -> if ttl < 1 then 1 else if ttl > maxPresenceTtl then maxPresenceTtl else ttl
117−forwardToAll = \servers action -> do
118− sendToEach servers (\server -> action server)
119− yield (count servers > 0)
121sendToEach = \servers action ->
117sendToEach = \servers action ->
122 if count servers == 0
118 if count servers == 0
123 then yield {}
119 then yield {}
@@ -270,7 +266,10 @@ serve = \req -> case req of
270 authorization: "Bearer " ++ federationSecret,
266 authorization: "Bearer " ++ federationSecret,
271 events: [{eventType: "online", pubkey: pubkey, server: serverHost, timestamp: t, ttl: 3600}], hopsRemaining: 2, fromServer: serverHost}))
267 events: [{eventType: "online", pubkey: pubkey, server: serverHost, timestamp: t, ttl: 3600}], hopsRemaining: 2, fromServer: serverHost}))
272 else yield {}
268 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)
274 if result.sigValid
273 if result.sigValid
275 then respond {token: token, expiresAt: expiry}
274 then respond {token: token, expiresAt: expiry}
276 else respond {token: "", expiresAt: 0}
275 else respond {token: "", expiresAt: 0}
@@ -309,7 +308,7 @@ serve = \req -> case req of
310 msgId <- genToken
309 msgId <- genToken
311 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t else timestamp
310 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
313 result <- atomic do
312 result <- atomic do
314 pr <- pruneExpired t
313 pr <- pruneExpired t
315 sessions <- *sessions
314 sessions <- *sessions
@@ -357,13 +356,13 @@ serve = \req -> case req of
357 yield {status: status, remoteServers: remoteServers, fromKey: fromKey, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}
356 yield {status: status, remoteServers: remoteServers, fromKey: fromKey, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}
358 finalStatus <- if result.status == "federated" && not (federationSecret == "")
357 finalStatus <- if result.status == "federated" && not (federationSecret == "")
360− anyOk <- forwardToAll result.remoteServers (\server ->
359+ sendToEach result.remoteServers (\server ->
361 fetch (federationScheme ++ server) (ForwardMessage {
360 fetch (federationScheme ++ server) (ForwardMessage {
362 toKey: to, fromKey: result.fromKey, encryptedBlob: encryptedBlob,
361 toKey: to, fromKey: result.fromKey, encryptedBlob: encryptedBlob,
363 timestamp: clampedTs, originServer: serverHost, messageId: msgId,
362 timestamp: clampedTs, originServer: serverHost, messageId: msgId,
364 authorization: "Bearer " ++ federationSecret}))
363 authorization: "Bearer " ++ federationSecret}))
365− yield (if anyOk then "federated" else "queued")
364+ yield "federated"
366− else yield result.status
365+ else yield (if result.status == "federated" then "queued" else result.status)
367 broadcastOfflineGossip t result.peerServers result.expiredLocal
366 broadcastOfflineGossip t result.peerServers result.expiredLocal
368 respond {status: finalStatus, messageId: (if result.status == "unauthorized" then "" else if result.status == "invalid" then "" else msgId)}
367 respond {status: finalStatus, messageId: (if result.status == "unauthorized" then "" else if result.status == "invalid" then "" else msgId)}
@@ -371,9 +370,9 @@ serve = \req -> case req of
372 let dedupedIds = fold (\acc mid ->
371 let dedupedIds = fold (\acc mid ->
373 if mid == "" then acc
372 if mid == "" then acc
374− else if not (isValidHex mid) then acc
375− else if tooLong mid maxPubkeyLen then acc
376 else if count acc >= maxMessageIds then acc
373 else if count acc >= maxMessageIds then acc
374+ else if tooLong mid maxPubkeyLen then acc
375+ else if not (isValidHex mid) then acc
377 else if count (do a <- acc; where a == mid; yield a) > 0 then acc
376 else if count (do a <- acc; where a == mid; yield a) > 0 then acc
378 else union acc [mid]) [] messageIds
377 else union acc [mid]) [] messageIds
379 result <- atomic do
378 result <- atomic do
@@ -439,7 +438,7 @@ serve = \req -> case req of
439 where p.server == serverHost
438 where p.server == serverHost
440 yield p) of
439 yield p) of
441 Just {value: p} -> p.server
440 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
443 yield {foundServer: foundServer, authorized: authorized, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}
442 yield {foundServer: foundServer, authorized: authorized, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}
444 broadcastOfflineGossip t result.peerServers result.expiredLocal
443 broadcastOfflineGossip t result.peerServers result.expiredLocal
445 respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: result.authorized}
444 respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: result.authorized}
@@ -455,9 +454,9 @@ serve = \req -> case req of
455 where e.eventType == "online"
454 where e.eventType == "online"
456 where not (e.server == "")
455 where not (e.server == "")
457 where not (e.pubkey == "")
456 where not (e.pubkey == "")
458− where isValidHex e.pubkey
459 where not (tooLong e.pubkey maxPubkeyLen)
457 where not (tooLong e.pubkey maxPubkeyLen)
460 where not (tooLong e.server maxPubkeyLen)
458 where not (tooLong e.server maxPubkeyLen)
459+ where isValidHex e.pubkey
461 where not (e.server == serverHost)
460 where not (e.server == serverHost)
462 where e.timestamp <= t + clockSkewTolerance
461 where e.timestamp <= t + clockSkewTolerance
463 where e.timestamp + (clampTtl e.ttl) * 1000 > t
462 where e.timestamp + (clampTtl e.ttl) * 1000 > t
@@ -468,9 +467,9 @@ serve = \req -> case req of
468 where e.eventType == "offline"
467 where e.eventType == "offline"
469 where not (e.server == "")
468 where not (e.server == "")
470 where not (e.pubkey == "")
469 where not (e.pubkey == "")
471− where isValidHex e.pubkey
472 where not (tooLong e.pubkey maxPubkeyLen)
470 where not (tooLong e.pubkey maxPubkeyLen)
473 where not (tooLong e.server maxPubkeyLen)
471 where not (tooLong e.server maxPubkeyLen)
472+ where isValidHex e.pubkey
474 where not (e.server == serverHost)
473 where not (e.server == serverHost)
475 where e.timestamp <= t + clockSkewTolerance
474 where e.timestamp <= t + clockSkewTolerance
476 where t - e.timestamp < (clampTtl e.ttl) * 1000
475 where t - e.timestamp < (clampTtl e.ttl) * 1000
@@ -570,9 +569,9 @@ serve = \req -> case req of
570 where validRequest
569 where validRequest
571 where not (e.server == "")
570 where not (e.server == "")
572 where not (e.pubkey == "")
571 where not (e.pubkey == "")
573− where isValidHex e.pubkey
574 where not (tooLong e.pubkey maxPubkeyLen)
572 where not (tooLong e.pubkey maxPubkeyLen)
575 where not (tooLong e.server maxPubkeyLen)
573 where not (tooLong e.server maxPubkeyLen)
574+ where isValidHex e.pubkey
576 where not (e.server == serverHost)
575 where not (e.server == serverHost)
577 where e.timestamp <= t + clockSkewTolerance
576 where e.timestamp <= t + clockSkewTolerance
578 where e.timestamp + (clampTtl e.ttl) * 1000 > t
577 where e.timestamp + (clampTtl e.ttl) * 1000 > t
@@ -614,7 +613,7 @@ serve = \req -> case req of
615 let authorized = verifyFederationAuth authorization
614 let authorized = verifyFederationAuth authorization
616 let validOrigin = not (originServer == "") && not (originServer == serverHost) && not (tooLong originServer maxPubkeyLen)
615 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
618 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t else timestamp
617 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t else timestamp
619 pruneResult <- atomic do
618 pruneResult <- atomic do
620 pr <- pruneExpired t
619 pr <- pruneExpired t
@@ -643,9 +642,9 @@ serve = \req -> case req of
643 let authorized = verifyFederationAuth authorization
642 let authorized = verifyFederationAuth authorization
644 let dedupedIds = fold (\acc mid ->
643 let dedupedIds = fold (\acc mid ->
645 if mid == "" then acc
644 if mid == "" then acc
646− else if not (isValidHex mid) then acc
647− else if tooLong mid maxPubkeyLen then acc
648 else if count acc >= maxMessageIds then acc
645 else if count acc >= maxMessageIds then acc
646+ else if tooLong mid maxPubkeyLen then acc
647+ else if not (isValidHex mid) then acc
649 else if count (do a <- acc; where a == mid; yield a) > 0 then acc
648 else if count (do a <- acc; where a == mid; yield a) > 0 then acc
650 else union acc [mid]) [] messageIds
649 else union acc [mid]) [] messageIds
651 let validAck = authorized && originServer == serverHost && not (fromServer == "") && not (fromServer == serverHost) && not (tooLong fromServer maxPubkeyLen)
650 let validAck = authorized && originServer == serverHost && not (fromServer == "") && not (fromServer == serverHost) && not (tooLong fromServer maxPubkeyLen)