@@ -10,7 +10,7 @@ serverHost = "localhost:8080"
1010federationSecret = "" -- must be set to enable federation
1111maintenanceSecret = "" -- set to enable /maintenance/prune independently of federation
1212federationScheme = "https://" -- scheme for federation HTTP calls
13−messageMaxAge = 86400000 -- 24 hours in milliseconds
13+messageMaxAge = 2592000000 -- 30 days in milliseconds
1414maxPresenceTtl = 3600 -- max presence TTL from gossip in seconds
1515maxPubkeyLen = 256
1616maxBlobLen = 65536
@@ -60,6 +60,8 @@ type GossipEvent = {eventType: Text, pubkey: Text, server: Text, timestamp: Int,
6060
6161*ackedIds : [{messageId: Text, toKey: Text, ackedAt: Int}]
6262
63+*lastPrunedAt : Int
64+
6365-- ============================================
6466-- Routes
6567-- ============================================
@@ -112,6 +114,7 @@ route Api = AuthApi | ClientApi | FederationApi | MaintenanceApi
112114-- ============================================
113115
114116hexDigit = \n ->
117+ let n = if n < 0 then 0 else if n > 15 then 15 else n
115118 if n == 0 then "0" else if n == 1 then "1" else if n == 2 then "2" else if n == 3 then "3"
116119 else if n == 4 then "4" else if n == 5 then "5" else if n == 6 then "6" else if n == 7 then "7"
117120 else if n == 8 then "8" else if n == 9 then "9" else if n == 10 then "a" else if n == 11 then "b"
@@ -327,8 +330,10 @@ verifyFederationAuth = \authorization ->
327330 not (federationSecret == "") && safeCompare (extractToken authorization) federationSecret
328331
329332verifyMaintenanceAuth = \authorization ->
330− verifyFederationAuth authorization
331− || (not (maintenanceSecret == "") && safeCompare (extractToken authorization) maintenanceSecret)
333+ let token = extractToken authorization
334+ let fedOk = not (federationSecret == "") && safeCompare token federationSecret
335+ let maintOk = not (maintenanceSecret == "") && safeCompare token maintenanceSecret
336+ fedOk || maintOk
332337
333338clampTtl = \ttl -> if ttl < 1 then 1 else if ttl > maxPresenceTtl then maxPresenceTtl else ttl
334339
@@ -400,6 +405,14 @@ pruneExpired = \t -> do
400405 yield q) == 0
401406 yield p), peerServers: peerServersBefore}
402407
408+maybePrune = \t -> do
409+ lastPruned <- *lastPrunedAt
410+ if t - lastPruned < 1000
411+ then yield {expiredLocal: [], peerServers: []}
412+ else do
413+ set *lastPrunedAt = t
414+ pruneExpired t
415+
403416sendBatchedGossip = \peerServers allEvents ->
404417 if count allEvents == 0
405418 then yield {}
@@ -461,7 +474,7 @@ serve = \req -> case req of
461474 if valid
462475 then do
463476 pruneResult <- atomic do
464− pr <- pruneExpired t
477+ pr <- maybePrune t
465478 challenges <- *challenges
466479 let existingCount = count (do c <- challenges; where c.pubkey == pubkey; yield c)
467480 let oldestChallengeExpiry = fold (\acc c2 -> if c2.pubkey == pubkey && (acc == -1 || c2.expiresAt < acc) then c2.expiresAt else acc) -1 challenges
@@ -494,7 +507,7 @@ serve = \req -> case req of
494507 token <- genToken
495508 let expiry = t + sessionExpiry
496509 result <- atomic do
497− pr <- pruneExpired t
510+ pr <- maybePrune t
498511 challenges <- *challenges
499512 sessions <- *sessions
500513 presence <- *presence
@@ -582,7 +595,7 @@ serve = \req -> case req of
582595 t <- now
583596 let token = extractToken authorization
584597 result <- atomic do
585− pr <- pruneExpired t
598+ pr <- maybePrune t
586599 sessions <- *sessions
587600 messages <- *messages
588601 seqCounter <- *seqCounter
@@ -626,7 +639,7 @@ serve = \req -> case req of
626639 msgId <- genToken
627640 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t - messageMaxAge else timestamp
628641 result <- atomic do
629− pr <- pruneExpired t
642+ pr <- maybePrune t
630643 sessions <- *sessions
631644 messages <- *messages
632645 presence <- *presence
@@ -696,15 +709,16 @@ serve = \req -> case req of
696709
697710 AckMessages {messageIds, authorization, respond} -> do
698711 t <- now
699− let dedupedIds = fold (\acc mid ->
700− if mid == "" then acc
701− else if count acc >= maxMessageIds then acc
702− else if tooLong mid maxMessageIdLen then acc
703− else if not (isValidHex mid) then acc
704− else if count (do a <- acc; where a == normalizeHex mid; yield a) > 0 then acc
705− else union acc [normalizeHex mid]) [] messageIds
712+ let dedupedIds = if count messageIds > maxMessageIds then []
713+ else fold (\acc mid ->
714+ if mid == "" then acc
715+ else if count acc >= maxMessageIds then acc
716+ else if tooLong mid maxMessageIdLen then acc
717+ else if not (isValidHex mid) then acc
718+ else if count (do a <- acc; where a == normalizeHex mid; yield a) > 0 then acc
719+ else union acc [normalizeHex mid]) [] messageIds
706720 result <- atomic do
707− pr <- pruneExpired t
721+ pr <- maybePrune t
708722 sessions <- *sessions
709723 messages <- *messages
710724 let session = lookupSession sessions (extractToken authorization) t
@@ -762,7 +776,7 @@ serve = \req -> case req of
762776 let pubkey = if isValidHex pubkey then normalizeHex pubkey else pubkey
763777 t <- now
764778 result <- atomic do
765− pr <- pruneExpired t
779+ pr <- maybePrune t
766780 sessions <- *sessions
767781 presence <- *presence
768782 let session = lookupSession sessions (extractToken authorization) t
@@ -854,7 +868,7 @@ serve = \req -> case req of
854868 yield a)
855869 [e]) [] filteredOnline
856870 gossipResult <- atomic do
857− pr <- pruneExpired t
871+ pr <- maybePrune t
858872 presence <- *presence
859873 let fromServerTrusted = count (do p <- presence; where p.server == fromServer; yield p) > 0
860874 let trustedDeduped = do
@@ -1042,7 +1056,7 @@ serve = \req -> case req of
10421056 let validOrigin = not (originServer == "") && not (originServer == serverHostN) && not (tooLong originServer maxServerNameLen) && not (isBadServerName originServer)
10431057 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t - messageMaxAge else timestamp
10441058 result <- atomic do
1045− pr <- pruneExpired t
1059+ pr <- maybePrune t
10461060 messages <- *messages
10471061 seqCounter <- *seqCounter
10481062 let seqTs = if t > seqCounter then t else seqCounter + 1
@@ -1080,16 +1094,17 @@ serve = \req -> case req of
10801094 let originServer = normalizeServerName originServer
10811095 t <- now
10821096 let authorized = verifyFederationAuth authorization
1083− let dedupedIds = fold (\acc mid ->
1084− if mid == "" then acc
1085− else if count acc >= maxMessageIds then acc
1086− else if tooLong mid maxMessageIdLen then acc
1087− else if not (isValidHex mid) then acc
1088− else if count (do a <- acc; where a == normalizeHex mid; yield a) > 0 then acc
1089− else union acc [normalizeHex mid]) [] messageIds
1097+ let dedupedIds = if count messageIds > maxMessageIds then []
1098+ else fold (\acc mid ->
1099+ if mid == "" then acc
1100+ else if count acc >= maxMessageIds then acc
1101+ else if tooLong mid maxMessageIdLen then acc
1102+ else if not (isValidHex mid) then acc
1103+ else if count (do a <- acc; where a == normalizeHex mid; yield a) > 0 then acc
1104+ else union acc [normalizeHex mid]) [] messageIds
10901105 let validAckFields = authorized && originServer == serverHostN && not (fromServer == "") && not (fromServer == serverHostN) && not (tooLong fromServer maxServerNameLen) && not (isBadServerName fromServer)
10911106 pruneResult <- atomic do
1092− pr <- pruneExpired t
1107+ pr <- maybePrune t
10931108 forwards <- *forwards
10941109 let validAck = validAckFields
10951110 let forwardsToRemove = do