@@ -327,8 +327,10 @@ verifyFederationAuth = \authorization ->
327327
328328verifyMaintenanceAuth = \authorization ->
329329 let token = extractToken authorization
330− let fedOk = not (federationSecret == "") && safeCompare token federationSecret
331− let maintOk = not (maintenanceSecret == "") && safeCompare token maintenanceSecret
330+ let fedResult = safeCompare token (if federationSecret == "" then "x" else federationSecret)
331+ let maintResult = safeCompare token (if maintenanceSecret == "" then "x" else maintenanceSecret)
332+ let fedOk = not (federationSecret == "") && fedResult
333+ let maintOk = not (maintenanceSecret == "") && maintResult
332334 fedOk || maintOk
333335
334336clampTtl = \ttl -> if ttl < 1 then 1 else if ttl > maxPresenceTtl then maxPresenceTtl else ttl
@@ -351,13 +353,13 @@ evictOldestAckedIds = \items n ->
351353 else acc) {size: 0, heap: [], heapMax: -1} items).heap
352354 in diff items toEvict
353355
354−safeCompareLoop = \s1 s2 result ->
355− if s1 == "" && s2 == ""
356− then result
357− else safeCompareLoop (drop 1 s1) (drop 1 s2) (result + (if take 1 s1 == take 1 s2 then 0 else 1))
356+safeCompareLoop = \s1 s2 n result ->
357+ if n <= 0
358+ then result + (if s1 == "" then 0 else 1) + (if s2 == "" then 0 else 1)
359+ else safeCompareLoop (drop 1 s1) (drop 1 s2) (n - 1) (result + (if take 1 s1 == take 1 s2 then 0 else 1))
358360
359361safeCompare = \a b ->
360− safeCompareLoop a b 0 + (if a == "" then 1 else 0) + (if b == "" then 1 else 0) == 0
362+ safeCompareLoop a b maxTokenLen 0 + (if a == "" then 1 else 0) + (if b == "" then 1 else 0) == 0
361363
362364sendToEach = \servers action ->
363365 if count servers == 0
@@ -500,8 +502,10 @@ pollOnce = \token cursor ->
500502 t <- now
501503 sessions <- *sessions
502504 messages <- *messages
505+ seqCounter <- *seqCounter
503506 let session = lookupSession sessions token t
504− let clampedCursor = if cursor < 0 then 0 else if cursor > t then t else cursor
507+ let cursorCeil = if seqCounter > t then seqCounter else t
508+ let clampedCursor = if cursor < 0 then 0 else if cursor > cursorCeil then cursorCeil else cursor
505509 let matchingMsgs = case session of
506510 Nothing {} -> []
507511 Just {value: s} -> do
@@ -808,11 +812,11 @@ serve = \req -> case req of
808812 else union acc [m.originServer]) [] fedMessages
809813 respond {ok: result.ok}
810814 if result.ok && count originServers > 0 && not (federationSecret == "")
811− then sendToEach originServers (\server ->
812− fetch (federationScheme ++ server) (FederationAck {
813− authorization: "Bearer " ++ federationSecret,
814− messageIds: (do m <- fedMessages; where m.originServer == server; yield m.messageId),
815− originServer: server, fromServer: serverHostN}))
815+ then do
816+ let pendingAcks = do
817+ m <- fedMessages
818+ yield {messageId: m.messageId, toKey: m.toKey, ackedAt: t, originServer: m.originServer}
819+ sendAcksAndClean pendingAcks originServers
816820 else yield {}
817821 broadcastOfflineGossip t result.peerServers result.expiredLocal
818822
@@ -1208,10 +1212,31 @@ backgroundPrune = do
12081212 sleep 30000
12091213 t <- now
12101214 catch (do
1211− pruneResult <- atomic do
1215+ result <- atomic do
12121216 set *lastPrunedAt = t
1213− pruneExpired t
1214− broadcastOfflineGossip t pruneResult.peerServers pruneResult.expiredLocal) (\err ->
1217+ pr <- pruneExpired t
1218+ forwards <- *forwards
1219+ let pendingForwards = do
1220+ f <- forwards
1221+ yield {toServer: f.toServer, toKey: f.toKey, fromKey: f.fromKey, encryptedBlob: f.encryptedBlob, timestamp: f.timestamp, messageId: f.messageId}
1222+ ackedIds <- *ackedIds
1223+ let pendingAcks = do
1224+ a <- ackedIds
1225+ where not (a.originServer == "")
1226+ where not (a.originServer == serverHostN)
1227+ yield a
1228+ yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: pendingForwards, pendingAcks: pendingAcks}
1229+ broadcastOfflineGossip t result.peerServers result.expiredLocal
1230+ if not (federationSecret == "") && count result.pendingForwards > 0
1231+ then retryPendingForwards result.pendingForwards
1232+ else yield {}
1233+ if not (federationSecret == "") && count result.pendingAcks > 0
1234+ then do
1235+ let ackOriginServers = fold (\acc a ->
1236+ if count (do s <- acc; where s == a.originServer; yield s) > 0 then acc
1237+ else union acc [a.originServer]) [] result.pendingAcks
1238+ sendAcksAndClean result.pendingAcks ackOriginServers
1239+ else yield {}) (\err ->
12151240 println ("background prune: " ++ show err))
12161241 backgroundPrune
12171242