@@ -68,6 +68,7 @@ type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: T
6868type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}
6969type AuthResult = {authorized: Bool, pubkey: Text}
7070type PruneResult = {expiredLocal: [PresenceEntry], peerServers: [Text]}
71+type ForwardInfo = {messageId: MessageIdHex, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, toServer: ServerName}
7172
7273-- ============================================
7374-- Persisted State
@@ -140,7 +141,7 @@ route Api = AuthApi | ClientApi | FederationApi | MaintenanceApi
140141-- Helpers
141142-- ============================================
142143
143−any = \xs pred -> count (do x <- xs; where pred x; yield x) > 0
144+any = \xs pred -> fold (\acc x -> if acc then acc else pred x) (False {}) xs
144145none = \xs pred -> not (any xs pred)
145146headOf = \items -> fold (\acc x -> case acc of
146147 Nothing {} -> Just {value: x}
@@ -374,7 +375,7 @@ extractToken = \authHeader ->
374375 else ""
375376
376377verifySecret = \token secret ->
377− safeCompare token (if secret == "" then "x" else secret) && not (secret == "")
378+ not (secret == "") && safeCompare token secret
378379
379380verifyFederationAuth = \authorization ->
380381 verifySecret (extractToken authorization) federationSecret
@@ -609,7 +610,7 @@ removeForward = \mid srv -> atomic do
609610 where not (x.messageId == mid && x.toServer == srv)
610611 yield x
611612
612−retryForwardsForServer : [{encryptedBlob: BlobHex, fromKey: PubkeyHex, messageId: MessageIdHex, timestamp: Timestamp, toKey: PubkeyHex, toServer: ServerName}] -> Int -> IO {network} {}
613+retryForwardsForServer : [ForwardInfo] -> Int -> IO {network} {}
613614retryForwardsForServer = \entries remaining ->
614615 if remaining <= 0
615616 then yield {}
@@ -628,7 +629,7 @@ retryForwardsForServer = \entries remaining ->
628629 Err _ -> yield {}
629630 retryForwardsForServer rest (remaining - 1)
630631
631−retryPendingForwards : [{encryptedBlob: BlobHex, fromKey: PubkeyHex, messageId: MessageIdHex, timestamp: Timestamp, toKey: PubkeyHex, toServer: ServerName}] -> IO {network} {}
632+retryPendingForwards : [ForwardInfo] -> IO {network} {}
632633retryPendingForwards = \pending -> do
633634 let servers = collectPeerServers pending (\x -> x.toServer)
634635 sendToEach servers (\server ->
@@ -975,13 +976,11 @@ serve = \req -> case req of
975976 where p.pubkey == pubkey
976977 where p.expiresAt > t
977978 yield p
978− let foundServer = if not authorized
979+ let foundServer = if not authorized || count valid == 0
979980 then ""
980− else if count valid == 0
981− then ""
982− else if any valid (\p -> p.server == serverHostN)
983− then serverHostN
984− else (fold (\acc p -> if p.expiresAt > acc.best then {server: p.server, best: p.expiresAt} else acc) {server: "", best: 0} valid).server
981+ else if any valid (\p -> p.server == serverHostN)
982+ then serverHostN
983+ else (fold (\acc p -> if p.expiresAt > acc.best then {server: p.server, best: p.expiresAt} else acc) {server: "", best: 0} valid).server
985984 yield {foundServer: foundServer, authorized: authorized, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}
986985 forkBroadcastOffline t result
987986 yield (respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: result.authorized})
@@ -1108,7 +1107,7 @@ serve = \req -> case req of
11081107 let originServer = normalizeServerName originServer
11091108 t <- now
11101109 let authorized = verifyFederationAuth authorization
1111− let validOrigin = not (originServer == serverHostN)
1110+ let validOrigin = isFederatedOrigin originServer
11121111 let clampedTs = clampTimestamp timestamp t
11131112 result <- atomic do
11141113 pr <- maybePrune t
@@ -1127,9 +1126,9 @@ serve = \req -> case req of
11271126 [{messageId: messageId, toKey: toKey, fromKey: fromKey,
11281127 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs}]
11291128 else messages
1130− yield {peerServers: pr.peerServers, expiredLocal: pr.expiredLocal, inserted: shouldInsert, alreadyExists: exists}
1129+ yield {peerServers: pr.peerServers, expiredLocal: pr.expiredLocal, ok: shouldInsert || exists}
11311130 forkBroadcastOffline t result
1132− yield (respond {ok: result.inserted || result.alreadyExists})
1131+ yield (respond {ok: result.ok})
11331132
11341133 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
11351134 let fromServer = normalizeServerName fromServer
@@ -1157,11 +1156,8 @@ serve = \req -> case req of
11571156 Prune {authorization, respond} -> do
11581157 t <- now
11591158 let authorized = verifyMaintenanceAuth authorization
1160− if authorized
1161− then do
1162− fork (pruneAndRetry t)
1163− yield (respond {ok: True {}})
1164− else yield (respond {ok: False {}})
1159+ if authorized then fork (pruneAndRetry t) else yield {}
1160+ yield (respond {ok: authorized})
11651161
11661162-- ============================================
11671163-- Entry Point