@@ -32,6 +32,7 @@ maxChallenges = 10000
3232maxSessions = 10000
3333maxAckedIds = 10000
3434maxAckOverflow = 200
35+maxDeliveredIds = 10000
3536maxChallengesPerKey = 5
3637maxSessionsPerKey = 10
3738challengeExpiry : Int<Ms>
@@ -132,6 +133,7 @@ type Message = {messageId: MessageIdHex, toKey: PubkeyHex, encryptedBlob: BlobHe
132133type PresenceEntry = {pubkey: PubkeyHex, server: AnyServerName, expiresAt: Timestamp, timestamp: Timestamp}
133134type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: Timestamp, toKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp}
134135type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}
136+type DeliveredEntry = {messageId: MessageIdHex, toKey: PubkeyHex, deliveredAt: Timestamp}
135137type ForwardFailure = {server: Text, failedAt: Timestamp, failures: Int}
136138type SendRateEntry = {pubkey: PubkeyHex, windowStart: Timestamp, count: Int}
137139type ChallengeRateEntry = {pubkey: PubkeyHex, windowStart: Timestamp, count: Int}
@@ -191,6 +193,8 @@ data ForwardResult = ForwardDuplicate {} | ForwardRejected {} | ForwardStored {}
191193
192194*ackOverflow : [AckedEntry]
193195
196+*deliveredIds : [DeliveredEntry]
197+
194198-- ============================================
195199-- Routes
196200-- ============================================
@@ -420,6 +424,13 @@ matchesHostnameOrSubdomain : Text -> Text -> Bool
420424matchesHostnameOrSubdomain = \sn name ->
421425 matchesHostname sn name || containsSuffix ("." ++ name) sn
422426
427+hasDotBeforePort : Text -> Bool
428+hasDotBeforePort = \s ->
429+ if s == "" then False {}
430+ else if take 1 s == ":" then False {}
431+ else if take 1 s == "." then True {}
432+ else hasDotBeforePort (drop 1 s)
433+
423434isBadServerName : Text -> Bool
424435isBadServerName = \sn ->
425436 sn == ""
@@ -448,6 +459,8 @@ isBadServerName = \sn ->
448459 || hasHexPrefix sn
449460 || (isDigitChar (take 1 sn) && isAllDigitsOrDotsUntilColonOrEnd sn)
450461 || isHighOctetPrefix sn
462+ || not (hasDotBeforePort sn)
463+ || containsSuffix ".arpa" sn
451464
452465authenticateSession : [Session] -> Text -> Timestamp -> AuthResult
453466authenticateSession = \sessions token t ->
@@ -658,6 +671,8 @@ pruneExpired = \t -> do
658671 set *activePolls = do p <- activePolls; where t - p.startedAt < pollTimeoutMs * 3; yield p
659672 ackOverflow <- *ackOverflow
660673 set *ackOverflow = do a <- ackOverflow; where a.ackedAt > messageCutoff; yield a
674+ deliveredIds <- *deliveredIds
675+ set *deliveredIds = do d <- deliveredIds; where d.deliveredAt > messageCutoff; yield d
661676 yield {expiredLocal: expiredLocalPresence presenceBefore presenceAfter t, peerServers: peerServersBefore}
662677
663678maybePrune = \t -> do
@@ -868,9 +883,18 @@ retryEvictedAcks = \evictedEntries pendingAcks ->
868883 let overflowExcess = count updated - maxAckOverflow
869884 if overflowExcess <= 0
870885 then do set *ackOverflow = updated; yield 0
871− else do set *ackOverflow = evictOldestAckedIds updated overflowExcess; yield overflowExcess
886+ else do
887+ let oldest = takeRelation overflowExcess (sortBy (\a -> a.ackedAt) updated)
888+ set *ackOverflow = diff updated oldest
889+ deliveredIds <- *deliveredIds
890+ let newDelivered = do a <- oldest; yield {messageId: a.messageId, toKey: a.toKey, deliveredAt: a.ackedAt}
891+ let combinedDelivered = union deliveredIds newDelivered
892+ let deliveredExcess = count combinedDelivered - maxDeliveredIds
893+ set *deliveredIds = if deliveredExcess <= 0 then combinedDelivered
894+ else diff combinedDelivered (takeRelation deliveredExcess (sortBy (\d -> d.deliveredAt) combinedDelivered))
895+ yield overflowExcess
872896 when (dropped > 0)
873− (println ("ackMessages: overflow at capacity (" ++ show maxAckOverflow ++ "), " ++ show dropped ++ " ack entries permanently lost for " ++ server)))
897+ (println ("ackMessages: overflow at capacity (" ++ show maxAckOverflow ++ "), " ++ show dropped ++ " ack entries moved to delivered set for " ++ server)))
874898 Ok _ -> yield {})
875899
876900retryOverflowAcks = \overflow ->
@@ -1089,6 +1113,7 @@ forwardCandidates = \targets messages forwards t ->
10891113 union acc (do
10901114 m <- messages
10911115 where m.toKey == target.pubkey
1116+ where m.originServer == ""
10921117 where none serverFwdIds (\fid -> fid == m.messageId)
10931118 yield {messageId: m.messageId, toServer: target.server, createdAt: t,
10941119 toKey: m.toKey, encryptedBlob: m.encryptedBlob, timestamp: m.timestamp})) [] targets
@@ -1155,24 +1180,27 @@ serve = \req -> case req of
11551180 challenges <- *challenges
11561181 let active = do c <- challenges; where c.expiresAt > t; yield c
11571182 let activeForKey = count (do c <- active; where c.pubkey == pubkey; yield c)
1158− if activeForKey >= maxChallengesPerKey
1183+ let cappedActive = if activeForKey >= maxChallengesPerKey
1184+ then let forKey = do c <- active; where c.pubkey == pubkey; yield c in
1185+ let others = do c <- active; where c.pubkey != pubkey; yield c in
1186+ union others (evictOneOldest forKey (\c -> c.expiresAt))
1187+ else active
1188+ if count cappedActive >= maxChallenges
11591189 then yield {pr: pr, accepted: False {}, rateLimited: False {}}
1160− else if count active >= maxChallenges
1161− then yield {pr: pr, accepted: False {}, rateLimited: False {}}
1162− else do
1163− challengeRates <- *challengeRates
1164− let senderEntry = headOf (do r <- challengeRates; where r.pubkey == pubkey; yield r)
1165− let isNewWindow = case senderEntry of Nothing {} -> True {}; Just {value: r} -> t - r.windowStart >= challengeRateWindowMs
1166− let rateCount = case senderEntry of Nothing {} -> 0; Just {value: r} -> if isNewWindow then 0 else r.count
1167− if rateCount >= maxChallengeRatePerKey
1168− then yield {pr: pr, accepted: False {}, rateLimited: True {}}
1169− else do
1170− let newRates = if isNewWindow
1171− then union (do r <- challengeRates; where r.pubkey != pubkey; yield r) [{pubkey: pubkey, windowStart: t, count: 1}]
1172− else do r <- challengeRates; yield (if r.pubkey == pubkey then {pubkey: r.pubkey, windowStart: r.windowStart, count: r.count + 1} else r)
1173− set *challengeRates = if count newRates > maxChallengeRateEntries then (do r <- newRates; where t - r.windowStart < challengeRateWindowMs; yield r) else newRates
1174− set *challenges = union active [{pubkey: pubkey, challenge: challenge, expiresAt: t + challengeExpiry}]
1175− yield {pr: pr, accepted: True {}, rateLimited: False {}}
1190+ else do
1191+ challengeRates <- *challengeRates
1192+ let senderEntry = headOf (do r <- challengeRates; where r.pubkey == pubkey; yield r)
1193+ let isNewWindow = case senderEntry of Nothing {} -> True {}; Just {value: r} -> t - r.windowStart >= challengeRateWindowMs
1194+ let rateCount = case senderEntry of Nothing {} -> 0; Just {value: r} -> if isNewWindow then 0 else r.count
1195+ if rateCount >= maxChallengeRatePerKey
1196+ then yield {pr: pr, accepted: False {}, rateLimited: True {}}
1197+ else do
1198+ let newRates = if isNewWindow
1199+ then union (do r <- challengeRates; where r.pubkey != pubkey; yield r) [{pubkey: pubkey, windowStart: t, count: 1}]
1200+ else do r <- challengeRates; yield (if r.pubkey == pubkey then {pubkey: r.pubkey, windowStart: r.windowStart, count: r.count + 1} else r)
1201+ set *challengeRates = if count newRates > maxChallengeRateEntries then (do r <- newRates; where t - r.windowStart < challengeRateWindowMs; yield r) else newRates
1202+ set *challenges = union cappedActive [{pubkey: pubkey, challenge: challenge, expiresAt: t + challengeExpiry}]
1203+ yield {pr: pr, accepted: True {}, rateLimited: False {}}
11761204 when result.rateLimited
11771205 (println ("challenge: rate limited (" ++ show maxChallengeRatePerKey ++ "/s per key), rejecting for " ++ pubkey))
11781206 when (not result.accepted && not result.rateLimited)
@@ -1183,16 +1211,19 @@ serve = \req -> case req of
11831211 VerifyAuth {pubkey, challenge, signature, respond} -> do
11841212 t <- now
11851213 let expiry = t + sessionExpiry
1214+ let sigValid = verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
11861215 validation <- atomic do
11871216 pr <- maybePrune t
1188− challenges <- *challenges
1189− let hasMatch = challengeMatch challenges pubkey challenge t
1190− let sigValid = hasMatch && verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
11911217 if not sigValid
11921218 then yield {pr: pr, valid: False {}}
11931219 else do
1194− set *challenges = challengesExcluding challenges pubkey challenge
1195− yield {pr: pr, valid: True {}}
1220+ challenges <- *challenges
1221+ let hasMatch = challengeMatch challenges pubkey challenge t
1222+ if not hasMatch
1223+ then yield {pr: pr, valid: False {}}
1224+ else do
1225+ set *challenges = challengesExcluding challenges pubkey challenge
1226+ yield {pr: pr, valid: True {}}
11961227 if validation.valid
11971228 then do
11981229 token <- genToken
@@ -1240,7 +1271,8 @@ serve = \req -> case req of
12401271 (\senderKey -> do
12411272 messages <- *messages
12421273 ackedIds <- *ackedIds
1243− if messageId != "" && (hasMessage messageId to messages || hasMessage messageId to ackedIds)
1274+ deliveredIds <- *deliveredIds
1275+ if messageId != "" && (hasMessage messageId to messages || hasMessage messageId to ackedIds || hasMessage messageId to deliveredIds)
12441276 then yield {pr: pr, send: SendDuplicate {}}
12451277 else do
12461278 sendRates <- *sendRates
@@ -1346,7 +1378,8 @@ serve = \req -> case req of
13461378 pr <- maybePrune t
13471379 messages <- *messages
13481380 ackedIds <- *ackedIds
1349− if hasMessage messageId toKey messages || hasMessage messageId toKey ackedIds
1381+ deliveredIds <- *deliveredIds
1382+ if hasMessage messageId toKey messages || hasMessage messageId toKey ackedIds || hasMessage messageId toKey deliveredIds
13501383 then yield {pr: pr, forward: ForwardDuplicate {}}
13511384 else if countMessagesFor messages toKey t >= maxMessagesPerRecipient
13521385 then yield {pr: pr, forward: ForwardRejected {}}
@@ -1375,7 +1408,17 @@ serve = \req -> case req of
13751408 pruneResult <- atomic do
13761409 pr <- maybePrune t
13771410 forwards <- *forwards
1378− set *forwards = forwardsExcluding forwards fromServer dedupedIds
1411+ let ackedForwards = do f <- forwards; where f.toServer == fromServer && any dedupedIds (\mid -> f.messageId == mid); yield f
1412+ let updatedForwards = forwardsExcluding forwards fromServer dedupedIds
1413+ set *forwards = updatedForwards
1414+ messages <- *messages
1415+ presence <- *presence
1416+ let removable = do
1417+ f <- ackedForwards
1418+ where none updatedForwards (\rf -> rf.messageId == f.messageId && rf.toKey == f.toKey)
1419+ where none presence (\p -> p.pubkey == f.toKey && isLocalServer p.server && p.expiresAt > t)
1420+ yield f
1421+ set *messages = do m <- messages; where none removable (\f -> m.messageId == f.messageId && m.toKey == f.toKey); yield m
13791422 yield pr
13801423 forkBroadcastOffline t pruneResult
13811424 yield (respond {ok: True {}}))