on master help sign in
Simplify validators and dedups: add all/unique helpers, replace 6 fold patterns
commita98972ee5715d5681a3c006477bc4865d0b43999 authoriko <mail@iko.soy> dateMon 27 Apr 2026, 01:55 (6 months ago) parent5ec7573
1 file changed+31−42
server.knot+31−42
server.knot+31−42
@@ -443,11 +443,16 @@ any : [a] -> (a -> Bool) -> Bool
443443any = \xs pred -> fold (\acc x -> if acc then acc else pred x) (False {}) xs
444444none : [a] -> (a -> Bool) -> Bool
445445none = \xs pred -> not (any xs pred)
446+all : [a] -> (a -> Bool) -> Bool
447+all = \xs pred -> none xs (\x -> not (pred x))
446448when = \cond action -> if cond then action else yield {}
447449clamp = \lo hi x -> if x < lo then lo else if x > hi then hi else x
448450min = \a b -> if a < b then a else b
449451max = \a b -> if a > b then a else b
450452
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
455+
451456headOf = \items -> fold (\acc x -> case acc of
452457 Nothing {} -> Just {value: x}
453458 _ -> acc) Nothing {} items
@@ -511,21 +516,18 @@ tooLong = \s maxLen -> drop maxLen s != ""
511516
512517isValidHex : Text -> Bool
513518isValidHex = \s ->
514− s != "" && drop 1 s != ""
515− && contains (take 1 s) "0123456789abcdef"
516− && contains (take 1 (drop 1 s)) "0123456789abcdef"
517− && (drop 2 s == "" || isValidHex (drop 2 s))
519+ let n = count (chars s) in
520+ n > 0 && n / 2 * 2 == n && all (chars s) (\c -> contains c "0123456789abcdef")
518521
519522normalizeHex : Text -> Text
520523normalizeHex = \s -> bytesToHex (bytesFromHex s)
521524
522−-- Strip all trailing dots by recursing left-to-right; once the tail is all dots, it's dropped.
523525stripTrailingDot : Text -> Text
524526stripTrailingDot = \s ->
525− if s == "" then ""
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
527+ let n = count (chars s) in
528+ if n == 0 then ""
529+ else if drop (n - 1) s == "." then stripTrailingDot (take (n - 1) s)
530+ else s
529531
530532normalizeServerName : Text -> Text
531533normalizeServerName = \s -> toLower (stripTrailingDot s)
@@ -541,26 +543,16 @@ containsSuffix = \suffix s ->
541543 let sLen = count (chars s) in
542544 sLen >= suffixLen && drop (sLen - suffixLen) s == suffix
543545
544−-- Block private/reserved/internal hostnames (SSRF defense). Simplified vs original:
545−-- still rejects the high-value cases (loopback, RFC1918, link-local, metadata services)
546−-- but skips obscure encoding tricks (octal, hex, percent-encoding).
546+-- Block private/reserved/internal hostnames (SSRF defense). Skips obscure encoding
547+-- tricks (octal, hex, percent-encoding) but covers the high-value cases.
547548isBadServerName : Text -> Bool
548549isBadServerName = \sn ->
549550 let fc = take 1 sn in
550551 fc == "" || fc == "." || fc == ":" || fc == "["
551− || any (chars sn) (\c -> not (contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:"))
552+ || not (all (chars sn) (\c -> contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:"))
552553 || sn == "localhost"
553− || containsSuffix ".localhost" sn
554− || containsSuffix ".local" sn
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 == "::"
554+ || any [".localhost", ".local", ".internal", ".arpa", ".onion"] (\suf -> containsSuffix suf sn)
555+ || any ["127.", "10.", "192.168.", "169.254.", "0.", "::"] (\pre -> take (count (chars pre)) sn == pre)
564556
565557-- ============================================
566558-- Auth helpers
@@ -778,9 +770,7 @@ nextSeqTs : Timestamp -> Timestamp -> Timestamp
778770nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
779771
780772dedupMessageIds : [MessageIdHex] -> [MessageIdHex]
781−dedupMessageIds = \ids ->
782− let capped = takeRelation maxMessageIds ids in
783− fold (\acc mid -> if any acc (\a -> a == mid) then acc else union acc [mid]) [] capped
773+dedupMessageIds = \ids -> takeRelation maxMessageIds (unique ids)
784774
785775presenceForKey = \presence pubkey t ->
786776 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
797787
798788collectPeers : [a] -> (a -> Text) -> [Text]
799789collectPeers = \items getServer ->
800− fold (\acc item ->
801− let s = getServer item in
802− if isLocalServer s || any acc (\a -> a == s) then acc
803− else union acc [s]) [] items
790+ unique (do x <- items; let s = getServer x; where not (isLocalServer s); yield s)
804791
805792knownPeerServersFromPresence : [PresenceEntry] -> [Text]
806793knownPeerServersFromPresence = \presence -> collectPeers presence (\p -> p.server)
@@ -969,7 +956,7 @@ refreshLocalPresence = \t -> do
969956 refreshState <- atomic do
970957 sessions <- *sessions
971958 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)
973960 let updated = do
974961 p <- presence
975962 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
14991486 set *forwards = do f <- fwds; where not (f.messageId == messageId && f.toKey == to); yield f
15001487 pres <- *presence
15011488 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)
15031490 cn <- *cancelNotifications
15041491 set *cancelNotifications = capList (union cn [{toKey: to, messageId: messageId, cancelledAt: t}]) 10000 (\c -> c.cancelledAt)
15051492 yield {cancelled: True {}, cancelServers: allServers}
@@ -1986,7 +1973,7 @@ handleAdminRevokeIp = \ip authorization respond -> do
19861973 ses <- *sessions
19871974 let mine = do s <- ses; where s.ip == ip; yield s
19881975 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)
19901977 yield {revoked: count mine, keys: count keys}
19911978 yield (respond {ok: True {}, revokedCount: result.revoked, affectedKeys: result.keys})
19921979
@@ -1997,10 +1984,13 @@ handleAdminListAllSessions = \limit authorization respond -> do
19971984 t <- now
19981985 ses <- *sessions
19991986 let active = do s <- ses; where s.expiresAt > t; yield s
2000− let grouped = fold (\acc s ->
2001− if any acc (\a -> a.pubkey == 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)
2003− else union acc [{pubkey: s.pubkey, count: 1, ips: if s.ip == "" then [] else [s.ip], latestExpiry: s.expiresAt}]) [] active
1987+ let grouped = do
1988+ pk <- unique (do s <- active; yield s.pubkey)
1989+ let mine = do s <- active; where s.pubkey == pk; yield s
1990+ yield {pubkey: pk,
1991+ count: count mine,
1992+ ips: unique (do s <- mine; where s.ip != ""; yield s.ip),
1993+ latestExpiry: fold (\acc s -> max acc s.expiresAt) 0 mine}
20041994 let sorted = sortBy (\g -> 0 - g.count) grouped
20051995 let effLimit = if limit <= 0 then 100 else clamp 1 500 limit
20061996 yield (respond {sessions: takeRelation effLimit sorted, ok: True {}, total: count grouped})
@@ -2101,10 +2091,9 @@ handleTopRecipients = \limit authorization respond -> do
21012091 if not authorized then yield (respond {recipients: [], ok: False {}, total: 0})
21022092 else do
21032093 msgs <- *messages
2104− let counts = fold (\acc m ->
2105− if any acc (\a -> a.pubkey == m.toKey)
2106− then do a <- acc; yield (if a.pubkey == m.toKey then {pubkey: a.pubkey, count: a.count + 1} else a)
2107− else union acc [{pubkey: m.toKey, count: 1}]) [] msgs
2094+ let counts = do
2095+ pk <- unique (do m <- msgs; yield m.toKey)
2096+ yield {pubkey: pk, count: count (do m <- msgs; where m.toKey == pk; yield m)}
21082097 let sorted = sortBy (\c -> 0 - c.count) counts
21092098 let effLimit = if limit <= 0 then 20 else clamp 1 100 limit
21102099 yield (respond {recipients: takeRelation effLimit sorted, ok: True {}, total: count counts})