@@ -443,11 +443,16 @@ any : [a] -> (a -> Bool) -> Bool
443any = \xs pred -> fold (\acc x -> if acc then acc else pred x) (False {}) xs
443any = \xs pred -> fold (\acc x -> if acc then acc else pred x) (False {}) xs
444none : [a] -> (a -> Bool) -> Bool
444none : [a] -> (a -> Bool) -> Bool
445none = \xs pred -> not (any xs pred)
445none = \xs pred -> not (any xs pred)
446+all : [a] -> (a -> Bool) -> Bool
447+all = \xs pred -> none xs (\x -> not (pred x))
446when = \cond action -> if cond then action else yield {}
448when = \cond action -> if cond then action else yield {}
447clamp = \lo hi x -> if x < lo then lo else if x > hi then hi else x
449clamp = \lo hi x -> if x < lo then lo else if x > hi then hi else x
448min = \a b -> if a < b then a else b
450min = \a b -> if a < b then a else b
449max = \a b -> if a > b then a else b
451max = \a b -> if a > b then a else b
453+-- Dedup: keeps first occurrence (O(n^2)).
454+unique = \items -> fold (\acc x -> if any acc (\a -> a == x) then acc else union acc [x]) [] items
451headOf = \items -> fold (\acc x -> case acc of
456headOf = \items -> fold (\acc x -> case acc of
452 Nothing {} -> Just {value: x}
457 Nothing {} -> Just {value: x}
453 _ -> acc) Nothing {} items
458 _ -> acc) Nothing {} items
@@ -511,21 +516,18 @@ tooLong = \s maxLen -> drop maxLen s != ""
512isValidHex : Text -> Bool
517isValidHex : Text -> Bool
513isValidHex = \s ->
518isValidHex = \s ->
514− s != "" && drop 1 s != ""
519+ let n = count (chars s) in
515− && contains (take 1 s) "0123456789abcdef"
520+ n > 0 && n / 2 * 2 == n && all (chars s) (\c -> contains c "0123456789abcdef")
516− && contains (take 1 (drop 1 s)) "0123456789abcdef"
517− && (drop 2 s == "" || isValidHex (drop 2 s))
519normalizeHex : Text -> Text
522normalizeHex : Text -> Text
520normalizeHex = \s -> bytesToHex (bytesFromHex s)
523normalizeHex = \s -> bytesToHex (bytesFromHex s)
522−-- Strip all trailing dots by recursing left-to-right; once the tail is all dots, it's dropped.
523stripTrailingDot : Text -> Text
525stripTrailingDot : Text -> Text
524stripTrailingDot = \s ->
526stripTrailingDot = \s ->
525− if s == "" then ""
527+ let n = count (chars s) in
526− else if take 1 s != "." then take 1 s ++ stripTrailingDot (drop 1 s)
527− else let rest = stripTrailingDot (drop 1 s) in
528− if rest == "" then "" else "." ++ rest
528+ if n == 0 then ""
529+ else if drop (n - 1) s == "." then stripTrailingDot (take (n - 1) s)
530normalizeServerName : Text -> Text
532normalizeServerName : Text -> Text
531normalizeServerName = \s -> toLower (stripTrailingDot s)
533normalizeServerName = \s -> toLower (stripTrailingDot s)
@@ -541,26 +543,16 @@ containsSuffix = \suffix s ->
541 let sLen = count (chars s) in
543 let sLen = count (chars s) in
542 sLen >= suffixLen && drop (sLen - suffixLen) s == suffix
544 sLen >= suffixLen && drop (sLen - suffixLen) s == suffix
544−-- Block private/reserved/internal hostnames (SSRF defense). Simplified vs original:
546+-- Block private/reserved/internal hostnames (SSRF defense). Skips obscure encoding
545−-- still rejects the high-value cases (loopback, RFC1918, link-local, metadata services)
546−-- but skips obscure encoding tricks (octal, hex, percent-encoding).
547+-- tricks (octal, hex, percent-encoding) but covers the high-value cases.
547isBadServerName : Text -> Bool
548isBadServerName : Text -> Bool
548isBadServerName = \sn ->
549isBadServerName = \sn ->
549 let fc = take 1 sn in
550 let fc = take 1 sn in
550 fc == "" || fc == "." || fc == ":" || fc == "["
551 fc == "" || fc == "." || fc == ":" || fc == "["
551− || any (chars sn) (\c -> not (contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:"))
552+ || not (all (chars sn) (\c -> contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:"))
552 || sn == "localhost"
553 || sn == "localhost"
553− || containsSuffix ".localhost" sn
554+ || any [".localhost", ".local", ".internal", ".arpa", ".onion"] (\suf -> containsSuffix suf sn)
554− || containsSuffix ".local" sn
555+ || any ["127.", "10.", "192.168.", "169.254.", "0.", "::"] (\pre -> take (count (chars pre)) sn == pre)
555− || containsSuffix ".internal" sn
556− || containsSuffix ".arpa" sn
557− || containsSuffix ".onion" sn
558− || take 4 sn == "127."
559− || take 3 sn == "10."
560− || take 8 sn == "192.168."
561− || take 8 sn == "169.254."
562− || take 2 sn == "0."
563− || take 2 sn == "::"
565-- ============================================
557-- ============================================
566-- Auth helpers
558-- Auth helpers
@@ -778,9 +770,7 @@ nextSeqTs : Timestamp -> Timestamp -> Timestamp
778nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
770nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
780dedupMessageIds : [MessageIdHex] -> [MessageIdHex]
772dedupMessageIds : [MessageIdHex] -> [MessageIdHex]
781−dedupMessageIds = \ids ->
782− let capped = takeRelation maxMessageIds ids in
773+dedupMessageIds = \ids -> takeRelation maxMessageIds (unique ids)
783− fold (\acc mid -> if any acc (\a -> a == mid) then acc else union acc [mid]) [] capped
785presenceForKey = \presence pubkey t ->
775presenceForKey = \presence pubkey t ->
786 do p <- presence; where p.pubkey == pubkey && p.expiresAt > t; yield p
776 do p <- presence; where p.pubkey == pubkey && p.expiresAt > t; yield p
@@ -797,10 +787,7 @@ hasMessage = \mid toKey items -> any items (\x -> x.messageId == mid && x.toKey
798collectPeers : [a] -> (a -> Text) -> [Text]
788collectPeers : [a] -> (a -> Text) -> [Text]
799collectPeers = \items getServer ->
789collectPeers = \items getServer ->
800− fold (\acc item ->
790+ unique (do x <- items; let s = getServer x; where not (isLocalServer s); yield s)
801− let s = getServer item in
802− if isLocalServer s || any acc (\a -> a == s) then acc
803− else union acc [s]) [] items
805knownPeerServersFromPresence : [PresenceEntry] -> [Text]
792knownPeerServersFromPresence : [PresenceEntry] -> [Text]
806knownPeerServersFromPresence = \presence -> collectPeers presence (\p -> p.server)
793knownPeerServersFromPresence = \presence -> collectPeers presence (\p -> p.server)
@@ -969,7 +956,7 @@ refreshLocalPresence = \t -> do
969 refreshState <- atomic do
956 refreshState <- atomic do
970 sessions <- *sessions
957 sessions <- *sessions
971 presence <- *presence
958 presence <- *presence
972− let activeKeys = fold (\acc s -> if any acc (\a -> a == s.pubkey) then acc else union acc [s.pubkey]) [] sessions
959+ let activeKeys = unique (do s <- sessions; yield s.pubkey)
973 let updated = do
960 let updated = do
974 p <- presence
961 p <- presence
975 yield (if isLocalServer p.server && any activeKeys (\k -> k == p.pubkey) && p.expiresAt - t < sessionExpiry / 2
962 yield (if isLocalServer p.server && any activeKeys (\k -> k == p.pubkey) && p.expiresAt - t < sessionExpiry / 2
@@ -1499,7 +1486,7 @@ handleCancelMessage = \messageId to authorization clientIp respond -> do
1499 set *forwards = do f <- fwds; where not (f.messageId == messageId && f.toKey == to); yield f
1486 set *forwards = do f <- fwds; where not (f.messageId == messageId && f.toKey == to); yield f
1500 pres <- *presence
1487 pres <- *presence
1501 let presServers = collectPeers (presenceForKey pres to t) (\p -> p.server)
1488 let presServers = collectPeers (presenceForKey pres to t) (\p -> p.server)
1502− let allServers = fold (\acc s -> if any acc (\a -> a == s) then acc else union acc [s]) presServers fwdServers
1489+ let allServers = unique (union presServers fwdServers)
1503 cn <- *cancelNotifications
1490 cn <- *cancelNotifications
1504 set *cancelNotifications = capList (union cn [{toKey: to, messageId: messageId, cancelledAt: t}]) 10000 (\c -> c.cancelledAt)
1491 set *cancelNotifications = capList (union cn [{toKey: to, messageId: messageId, cancelledAt: t}]) 10000 (\c -> c.cancelledAt)
1505 yield {cancelled: True {}, cancelServers: allServers}
1492 yield {cancelled: True {}, cancelServers: allServers}
@@ -1986,7 +1973,7 @@ handleAdminRevokeIp = \ip authorization respond -> do
1986 ses <- *sessions
1973 ses <- *sessions
1987 let mine = do s <- ses; where s.ip == ip; yield s
1974 let mine = do s <- ses; where s.ip == ip; yield s
1988 set *sessions = do s <- ses; where s.ip != ip; yield s
1975 set *sessions = do s <- ses; where s.ip != ip; yield s
1989− let keys = fold (\acc s -> if any acc (\a -> a == s.pubkey) then acc else union acc [s.pubkey]) [] mine
1976+ let keys = unique (do s <- mine; yield s.pubkey)
1990 yield {revoked: count mine, keys: count keys}
1977 yield {revoked: count mine, keys: count keys}
1991 yield (respond {ok: True {}, revokedCount: result.revoked, affectedKeys: result.keys})
1978 yield (respond {ok: True {}, revokedCount: result.revoked, affectedKeys: result.keys})
@@ -1997,10 +1984,13 @@ handleAdminListAllSessions = \limit authorization respond -> do
1997 t <- now
1984 t <- now
1998 ses <- *sessions
1985 ses <- *sessions
1999 let active = do s <- ses; where s.expiresAt > t; yield s
1986 let active = do s <- ses; where s.expiresAt > t; yield s
2000− let grouped = fold (\acc s ->
1987+ let grouped = do
2001− if any acc (\a -> a.pubkey == s.pubkey)
1988+ pk <- unique (do s <- active; yield s.pubkey)
2002− then do a <- acc; yield (if a.pubkey == s.pubkey then {pubkey: a.pubkey, count: a.count + 1, ips: if any a.ips (\i -> i == s.ip) || s.ip == "" then a.ips else union a.ips [s.ip], latestExpiry: max a.latestExpiry s.expiresAt} else a)
1989+ let mine = do s <- active; where s.pubkey == pk; yield s
2003− else union acc [{pubkey: s.pubkey, count: 1, ips: if s.ip == "" then [] else [s.ip], latestExpiry: s.expiresAt}]) [] active
1990+ yield {pubkey: pk,
1992+ ips: unique (do s <- mine; where s.ip != ""; yield s.ip),
1993+ latestExpiry: fold (\acc s -> max acc s.expiresAt) 0 mine}
2004 let sorted = sortBy (\g -> 0 - g.count) grouped
1994 let sorted = sortBy (\g -> 0 - g.count) grouped
2005 let effLimit = if limit <= 0 then 100 else clamp 1 500 limit
1995 let effLimit = if limit <= 0 then 100 else clamp 1 500 limit
2006 yield (respond {sessions: takeRelation effLimit sorted, ok: True {}, total: count grouped})
1996 yield (respond {sessions: takeRelation effLimit sorted, ok: True {}, total: count grouped})
@@ -2101,10 +2091,9 @@ handleTopRecipients = \limit authorization respond -> do
2101 if not authorized then yield (respond {recipients: [], ok: False {}, total: 0})
2091 if not authorized then yield (respond {recipients: [], ok: False {}, total: 0})
2103 msgs <- *messages
2093 msgs <- *messages
2104− let counts = fold (\acc m ->
2094+ let counts = do
2105− if any acc (\a -> a.pubkey == m.toKey)
2095+ pk <- unique (do m <- msgs; yield m.toKey)
2106− then do a <- acc; yield (if a.pubkey == m.toKey then {pubkey: a.pubkey, count: a.count + 1} else a)
2096+ yield {pubkey: pk, count: count (do m <- msgs; where m.toKey == pk; yield m)}
2107− else union acc [{pubkey: m.toKey, count: 1}]) [] msgs
2108 let sorted = sortBy (\c -> 0 - c.count) counts
2097 let sorted = sortBy (\c -> 0 - c.count) counts
2109 let effLimit = if limit <= 0 then 20 else clamp 1 100 limit
2098 let effLimit = if limit <= 0 then 20 else clamp 1 100 limit
2110 yield (respond {recipients: takeRelation effLimit sorted, ok: True {}, total: count counts})
2099 yield (respond {recipients: takeRelation effLimit sorted, ok: True {}, total: count counts})