@@ -464,7 +464,7 @@ unique = \items -> fold (\acc x -> if elem acc x then acc else union acc [x]) []
464464-- Replace a ref's contents with the entries that satisfy `keep`. Caller controls atomicity.
465465pruneRef = \ref keep -> do
466466 cur <- *ref
467− set *ref = do x <- cur; where keep x; yield x
467+ set *ref = filter cur keep
468468
469469-- Append `items` to a ref, then cap by `getKey` (drops oldest on overflow).
470470appendCapped = \ref items maxN getKey -> do
@@ -559,9 +559,7 @@ normalizeHex = \s -> bytesToHex (bytesFromHex s)
559559stripTrailingDot : Text -> Text
560560stripTrailingDot = \s ->
561561 let n = count (chars s) in
562− if n == 0 then ""
563− else if drop (n - 1) s == "." then stripTrailingDot (take (n - 1) s)
564− else s
562+ if n > 0 && drop (n - 1) s == "." then stripTrailingDot (take (n - 1) s) else s
565563
566564normalizeServerName : Text -> Text
567565normalizeServerName = \s -> toLower (stripTrailingDot s)
@@ -573,20 +571,17 @@ isLocalServer = \s -> s == serverHostN
573571
574572containsSuffix : Text -> Text -> Bool
575573containsSuffix = \suffix s ->
576− let suffixLen = count (chars suffix) in
577− let sLen = count (chars s) in
578− sLen >= suffixLen && drop (sLen - suffixLen) s == suffix
574+ let d = count (chars s) - count (chars suffix) in
575+ d >= 0 && drop d s == suffix
579576
580577-- Block private/reserved/internal hostnames (SSRF defense). Skips obscure encoding
581578-- tricks (octal, hex, percent-encoding) but covers the high-value cases.
582579isBadServerName : Text -> Bool
583580isBadServerName = \sn ->
584− let fc = take 1 sn in
585− fc == "" || fc == "." || fc == ":" || fc == "["
581+ sn == "" || sn == "localhost"
586582 || not (all (chars sn) (\c -> contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:"))
587− || sn == "localhost"
583+ || any [".", ":", "[", "127.", "10.", "192.168.", "169.254.", "0.", "::"] (\pre -> take (count (chars pre)) sn == pre)
588584 || any [".localhost", ".local", ".internal", ".arpa", ".onion"] (\suf -> containsSuffix suf sn)
589− || any ["127.", "10.", "192.168.", "169.254.", "0.", "::"] (\pre -> take (count (chars pre)) sn == pre)
590585
591586-- ============================================
592587-- Auth helpers
@@ -805,17 +800,12 @@ dedupMessageIds = \ids -> takeRelation maxMessageIds (unique ids)
805800presenceForKey = \presence pubkey t ->
806801 filter presence (\p -> p.pubkey == pubkey && p.expiresAt > t)
807802
808−-- Pick local if present, else the remote with the latest expiresAt; "" when none.
809−bestServerForKey = \entries ->
810− if any entries (\p -> isLocalServer p.server) then serverHostN
811− else case maxBy entries (\p -> p.expiresAt) of
812− Just {value: p} -> p.server
813− _ -> ""
814−
815803-- Resolve a key's server for client lookup, masking remote identities behind "remote".
816804maskedServer = \pres pubkey t ->
817− let found = bestServerForKey (presenceForKey pres pubkey t) in
818− if found == "" then "" else if isLocalServer found then found else "remote"
805+ let entries = presenceForKey pres pubkey t in
806+ if any entries (\p -> isLocalServer p.server) then serverHostN
807+ else if count entries > 0 then "remote"
808+ else ""
819809
820810hasMessage : MessageIdHex -> PubkeyHex -> [{messageId: MessageIdHex, toKey: PubkeyHex | a}] -> Bool
821811hasMessage = \mid toKey items -> any items (\x -> x.messageId == mid && x.toKey == toKey)
@@ -830,8 +820,9 @@ knownPeerServersFromPresence = \presence -> collectPeers presence (\p -> p.serve
830820-- Last-write-wins merge by (pubkey, server), keeping the entry with the larger expiresAt.
831821mergePresence = \existing incoming ->
832822 fold (\acc e ->
833− if any acc (\a -> a.pubkey == e.pubkey && a.server == e.server && a.expiresAt >= e.expiresAt) then acc
834− else union (removeWhere acc (\x -> x.pubkey == e.pubkey && x.server == e.server)) [e]) existing incoming
823+ let same = \x -> x.pubkey == e.pubkey && x.server == e.server in
824+ if any acc (\x -> same x && x.expiresAt >= e.expiresAt) then acc
825+ else union (removeWhere acc same) [e]) existing incoming
835826
836827-- ============================================
837828-- Pruning
@@ -923,15 +914,13 @@ retryPendingForwards = do
923914 case result of Err _ -> recordFailure server; Ok _ -> when success (clearFailure server)
924915 let isMatch = \x -> x.messageId == f.messageId && x.toServer == server
925916 atomic do
926− if success then pruneRef forwards (\x -> not (isMatch x))
927− else do
928− cur <- *forwards
929− set *forwards = do
930− x <- cur
931− where not (isMatch x) || x.retries + 1 < maxForwardRetries
932− yield (if isMatch x
933− then {messageId: x.messageId, toServer: x.toServer, createdAt: x.createdAt, toKey: x.toKey, encryptedBlob: x.encryptedBlob, timestamp: x.timestamp, originServer: x.originServer, retries: x.retries + 1, expiresAt: x.expiresAt, priority: x.priority, senderKey: x.senderKey}
934− else x)))
917+ cur <- *forwards
918+ set *forwards = do
919+ x <- cur
920+ where not (isMatch x && (success || x.retries + 1 >= maxForwardRetries))
921+ yield (if isMatch x
922+ then {messageId: x.messageId, toServer: x.toServer, createdAt: x.createdAt, toKey: x.toKey, encryptedBlob: x.encryptedBlob, timestamp: x.timestamp, originServer: x.originServer, retries: x.retries + 1, expiresAt: x.expiresAt, priority: x.priority, senderKey: x.senderKey}
923+ else x)))
935924
936925sendAcksAndClean = \pendingAcks ->
937926 forEach (collectPeers pendingAcks (\a -> a.originServer)) id (\server -> do
@@ -1005,8 +994,9 @@ handleChallenge = \pubkey clientIp respond -> do
1005994 result <- atomic do
1006995 ch <- *challenges
1007996 let active = filter ch (\c -> c.expiresAt > t)
1008− let cappedActive = if countWhere active (\c -> c.pubkey == pubkey) >= maxChallengesPerKey
1009− then evictOldest active (\c -> if c.pubkey == pubkey then c.expiresAt else 999999999999)
997+ let mine = filter active (\c -> c.pubkey == pubkey)
998+ let cappedActive = if count mine >= maxChallengesPerKey
999+ then union (removeWhere active (\c -> c.pubkey == pubkey)) (evictOldest mine (\c -> c.expiresAt))
10101000 else active
10111001 rates <- *challengeRates
10121002 let r = checkRate rates pubkey maxChallengeRatePerKey challengeRateWindowMs 5000 t
@@ -1053,17 +1043,13 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp respond ->
10531043
10541044handleRevoke = \targetToken authorization clientIp respond -> do
10551045 t <- now
1056− g <- checkGlobalRate t
1057− if g then yield (respond {ok: False {}, authorized: False {}})
1058− else withSessionAuth authorization t clientIp
1059− (yield (respond {ok: False {}, authorized: False {}}))
1060− (\caller -> do
1061− result <- atomic do
1062− ses <- *sessions
1063− let pred = \s -> s.pubkey == caller && s.token == targetToken
1064− set *sessions = removeWhere ses pred
1065− yield (any ses pred)
1066− yield (respond {ok: result, authorized: True {}}))
1046+ gateAuth (False {}) authorization clientIp t respond (\_ -> {ok: False {}, authorized: False {}}) (\caller -> do
1047+ result <- atomic do
1048+ ses <- *sessions
1049+ let pred = \s -> s.pubkey == caller && s.token == targetToken
1050+ set *sessions = removeWhere ses pred
1051+ yield (any ses pred)
1052+ yield (respond {ok: result, authorized: True {}}))
10671053
10681054handleLogout = \authorization clientIp respond -> do
10691055 t <- now
@@ -1181,13 +1167,11 @@ ackPolledMessages = \pubkey cursor t -> do
11811167 msgs <- *messages
11821168 let matches = \m -> m.toKey == pubkey && m.receivedAt <= cursor
11831169 let toAck = filter msgs matches
1184− if count toAck == 0 then yield {pendingAcks: []}
1185− else do
1186− set *messages = removeWhere msgs matches
1187− let mids = pluck toAck (\m -> m.messageId)
1188− pruneRef forwards (\f -> not (f.toKey == pubkey && elem mids f.messageId))
1189− ackedFederated <- recordAcksAndDeliveries toAck t
1190− yield {pendingAcks: ackedFederated}
1170+ let mids = pluck toAck (\m -> m.messageId)
1171+ set *messages = removeWhere msgs matches
1172+ pruneRef forwards (\f -> not (f.toKey == pubkey && elem mids f.messageId))
1173+ ackedFederated <- recordAcksAndDeliveries toAck t
1174+ yield {pendingAcks: ackedFederated}
11911175
11921176-- ============================================
11931177-- Handler: send
@@ -1458,21 +1442,17 @@ handleSendBatch = \messages authorization clientIp respond -> do
14581442-- ============================================
14591443
14601444handleVerifyToken = \token scope clientIp respond -> do
1461− if scope == "" then yield (respond {ok: False {}})
1445+ t <- now
1446+ g <- checkGlobalRate t
1447+ ipLim <- checkIpRateGate clientIp t
1448+ if scope == "" || g || ipLim then yield (respond {ok: False {}})
14621449 else do
1463− t <- now
1464− g <- checkGlobalRate t
1465− if g then yield (respond {ok: False {}})
1466− else do
1467− ipLim <- checkIpRateGate clientIp t
1468− if ipLim then yield (respond {ok: False {}})
1469− else do
1470− found <- atomic do
1471− pending <- *pendingVerifications
1472− let match = any pending (\p -> p.scope == scope && p.token == token && t - p.createdAt < verificationTokenExpiry)
1473− when match (set *pendingVerifications = filter pending (\p -> p.scope != scope || p.token != token))
1474− yield match
1475− yield (respond {ok: found})
1450+ found <- atomic do
1451+ pending <- *pendingVerifications
1452+ let match = any pending (\p -> p.scope == scope && p.token == token && t - p.createdAt < verificationTokenExpiry)
1453+ when match (set *pendingVerifications = filter pending (\p -> p.scope != scope || p.token != token))
1454+ yield match
1455+ yield (respond {ok: found})
14761456
14771457handleFederationPubkey = \respond -> do
14781458 yield (respond {pubkey: serverFederationPublicKeyHex, ok: serverFederationPublicKeyHex != ""})
@@ -1684,9 +1664,9 @@ handlePrune = \authorization respond -> do
16841664 when authorized (fork (pruneAndRetry t))
16851665 yield (respond {ok: authorized})
16861666
1687−handleReconcile = \authorization respond -> withMaintAuth authorization
1688− (yield (respond {ok: False {}, messageDrift: 0, presenceDrift: 0, sessionDrift: 0}))
1689− (yield (respond {ok: True {}, messageDrift: 0, presenceDrift: 0, sessionDrift: 0}))
1667+handleReconcile = \authorization respond -> do
1668+ authorized <- verifyMaintenanceAuth authorization
1669+ yield (respond {ok: authorized, messageDrift: 0, presenceDrift: 0, sessionDrift: 0})
16901670
16911671handleHealth = \authorization respond -> do
16921672 t <- now
@@ -1713,9 +1693,10 @@ handleUnblockPeer = \server authorization respond -> withMaintAuth authorization
17131693 (yield (respond {ok: False {}, unblocked: False {}}))
17141694 (do removed <- removeServerFromList blockedPeers server; yield (respond {ok: True {}, unblocked: removed}))
17151695
1716−handleListBlocked = \authorization respond -> withMaintAuth authorization
1717− (yield (respond {peers: [], ok: False {}}))
1718− (do blocked <- *blockedPeers; yield (respond {peers: blocked, ok: True {}}))
1696+handleListBlocked = \authorization respond -> do
1697+ ok <- verifyMaintenanceAuth authorization
1698+ blocked <- *blockedPeers
1699+ yield (respond {peers: if ok then blocked else [], ok: ok})
17191700
17201701handleAllowPeer = \server authorization respond -> withMaintAuth authorization
17211702 (yield (respond {ok: False {}, allowed: 0}))
@@ -1725,9 +1706,10 @@ handleUnallowPeer = \server authorization respond -> withMaintAuth authorization
17251706 (yield (respond {ok: False {}, removed: False {}}))
17261707 (do removed <- removeServerFromList allowedPeers server; yield (respond {ok: True {}, removed: removed}))
17271708
1728−handleListAllowed = \authorization respond -> withMaintAuth authorization
1729− (yield (respond {peers: [], ok: False {}}))
1730− (do allowed <- *allowedPeers; yield (respond {peers: allowed, ok: True {}}))
1709+handleListAllowed = \authorization respond -> do
1710+ ok <- verifyMaintenanceAuth authorization
1711+ allowed <- *allowedPeers
1712+ yield (respond {peers: if ok then allowed else [], ok: ok})
17311713
17321714handlePingPeer = \server authorization respond -> withMaintAuth authorization
17331715 (yield (respond {ok: False {}, latencyMs: 0, error: "unauthorized"}))
@@ -1743,12 +1725,11 @@ handlePingPeer = \server authorization respond -> withMaintAuth authorization
17431725 Err e -> yield (respond {ok: False {}, latencyMs: endTime - startTime, error: show e})
17441726 Ok r -> yield (respond {ok: r.ok, latencyMs: endTime - startTime, error: r.error}))
17451727
1746−handleAdminListSessions = \pubkey authorization respond -> withMaintAuth authorization
1747− (yield (respond {sessions: [], count: 0, ok: False {}}))
1748− (do
1749− ses <- *sessions
1750− let mine = mapWhere ses (\s -> s.pubkey == pubkey) (\s -> {token: "***", expiresAt: s.expiresAt, ip: s.ip, createdAt: s.createdAt})
1751− yield (respond {sessions: mine, count: count mine, ok: True {}}))
1728+handleAdminListSessions = \pubkey authorization respond -> do
1729+ ok <- verifyMaintenanceAuth authorization
1730+ ses <- *sessions
1731+ let mine = if ok then mapWhere ses (\s -> s.pubkey == pubkey) (\s -> {token: "***", expiresAt: s.expiresAt, ip: s.ip, createdAt: s.createdAt}) else []
1732+ yield (respond {sessions: mine, count: count mine, ok: ok})
17521733
17531734handleAdminRevokeSessions = \pubkey authorization respond -> withMaintAuth authorization
17541735 (yield (respond {ok: False {}, revokedCount: 0}))
@@ -1801,9 +1782,10 @@ handleAdminListAllSessions = \limit authorization respond -> withMaintAuth autho
18011782 let effLimit = if limit <= 0 then 100 else clamp 1 500 limit
18021783 yield (respond {sessions: takeRelation effLimit sorted, ok: True {}, total: count grouped}))
18031784
1804−handleGetRateLimits = \authorization respond -> withMaintAuth authorization
1805− (yield (respond {ok: False {}, globalRequest: 0, ipRate: 0, sendRate: 0, federationRate: 0, authGlobal: 0, recvRate: 0, challengeRate: 0, pairRate: 0, lookupRate: 0, clientWriteRate: 0}))
1806− (yield (respond {ok: True {}, globalRequest: maxGlobalRequestRate, ipRate: maxIpRatePerIp, sendRate: maxSendRatePerKey, federationRate: maxFederationRatePerServer, authGlobal: maxAuthGlobalRate, recvRate: maxRecvRatePerKey, challengeRate: maxChallengeRatePerKey, pairRate: maxPairRatePerPair, lookupRate: maxLookupRatePerKey, clientWriteRate: maxClientWriteRatePerKey}))
1785+handleGetRateLimits = \authorization respond -> do
1786+ ok <- verifyMaintenanceAuth authorization
1787+ let v = \x -> if ok then x else 0
1788+ yield (respond {ok: ok, globalRequest: v maxGlobalRequestRate, ipRate: v maxIpRatePerIp, sendRate: v maxSendRatePerKey, federationRate: v maxFederationRatePerServer, authGlobal: v maxAuthGlobalRate, recvRate: v maxRecvRatePerKey, challengeRate: v maxChallengeRatePerKey, pairRate: v maxPairRatePerPair, lookupRate: v maxLookupRatePerKey, clientWriteRate: v maxClientWriteRatePerKey})
18071789
18081790handleSetRateLimits = \globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization respond -> do
18091791 authorized <- verifyMaintenanceAuth authorization
@@ -1819,9 +1801,10 @@ handleRotateSecret = \newSecret authorization respond -> withMaintAuth authoriza
18191801 atomic do set *runtimeMaintenanceSecret = newSecret
18201802 yield (respond {ok: True {}, error: ""}))
18211803
1822−handleGetConfig = \authorization respond -> withMaintAuth authorization
1823− (yield (respond {ok: False {}, maxMessagesPerRecipient: 0, maxGossipHops: 0, pollTimeoutMs: 0, ackGracePeriod: 0}))
1824− (yield (respond {ok: True {}, maxMessagesPerRecipient: maxMessagesPerRecipient, maxGossipHops: maxGossipHops, pollTimeoutMs: pollTimeoutMs, ackGracePeriod: ackGracePeriod}))
1804+handleGetConfig = \authorization respond -> do
1805+ ok <- verifyMaintenanceAuth authorization
1806+ let v = \x -> if ok then x else 0
1807+ yield (respond {ok: ok, maxMessagesPerRecipient: v maxMessagesPerRecipient, maxGossipHops: v maxGossipHops, pollTimeoutMs: v pollTimeoutMs, ackGracePeriod: v ackGracePeriod})
18251808
18261809-- /stats: zero-fill all metric fields we no longer compute.
18271810handleStats = \authorization respond -> withMaintAuth authorization
@@ -1906,9 +1889,10 @@ handleStatsForwards = \authorization respond -> withMaintAuth authorization
19061889 {server: s, count: count svFwds, oldestAge: oldest, totalRetries: fold (\acc f -> acc + f.retries) 0 svFwds})
19071890 yield (respond {servers: result, ok: True {}, total: count fwds}))
19081891
1909−handleStatsRates = \authorization respond -> withMaintAuth authorization
1910− (yield (respond {ok: False {}, scalePct: 0, globalRequest: 0, ipRate: 0, sendRate: 0, federationRate: 0, authGlobal: 0, recvRate: 0, challengeRate: 0, pairRate: 0, lookupRate: 0, clientWriteRate: 0}))
1911− (yield (respond {ok: True {}, scalePct: 100, globalRequest: maxGlobalRequestRate, ipRate: maxIpRatePerIp, sendRate: maxSendRatePerKey, federationRate: maxFederationRatePerServer, authGlobal: maxAuthGlobalRate, recvRate: maxRecvRatePerKey, challengeRate: maxChallengeRatePerKey, pairRate: maxPairRatePerPair, lookupRate: maxLookupRatePerKey, clientWriteRate: maxClientWriteRatePerKey}))
1892+handleStatsRates = \authorization respond -> do
1893+ ok <- verifyMaintenanceAuth authorization
1894+ let v = \x -> if ok then x else 0
1895+ yield (respond {ok: ok, scalePct: v 100, globalRequest: v maxGlobalRequestRate, ipRate: v maxIpRatePerIp, sendRate: v maxSendRatePerKey, federationRate: v maxFederationRatePerServer, authGlobal: v maxAuthGlobalRate, recvRate: v maxRecvRatePerKey, challengeRate: v maxChallengeRatePerKey, pairRate: v maxPairRatePerPair, lookupRate: v maxLookupRatePerKey, clientWriteRate: v maxClientWriteRatePerKey})
19121896
19131897handleMetrics = \authorization respond -> do
19141898 t <- now