on master help sign in
Simplify server.knot: inline mod, use capList in capPerKey, replace fold parser with withIndex
commit35d67db21dad2879dc2163e774dbae5c6e38ce57 authoriko <mail@iko.soy> dateMon 27 Apr 2026, 19:41 (5 months ago) parent257a697
1 file changed+19−23
server.knot+19−23
server.knot+19−23
@@ -457,7 +457,6 @@ when = \cond action -> if cond then action else yield {}
457457min = \a b -> if a < b then a else b
458458max = \a b -> if a > b then a else b
459459clamp = \lo hi x -> max lo (min hi x)
460−mod = \n m -> n - n / m * m
461460abs = \x -> if x < 0 then 0 - x else x
462461
463462-- Dedup: keeps first occurrence (O(n^2)).
@@ -511,11 +510,9 @@ removeForKey = \pred -> do
511510 pruneRef forwards (\f -> not (pred f))
512511 yield toRemove
513512
514−-- If `pred` matches at least maxN items, drop the oldest matching one.
513+-- Cap pred-matching entries to maxN-1 (caller adds one more).
515514capPerKey = \items pred maxN getKey ->
516− let mine = sortBy getKey (filter items pred) in
517− let dropN = if count mine >= maxN then 1 else 0 in
518− union (removeWhere items pred) (drop dropN mine)
515+ union (removeWhere items pred) (capList (filter items pred) (maxN - 1) getKey)
519516
520517-- Shared empty/error shape for /poll. Only a few fields ever vary.
521518emptyPollResp = \cursor authorized rateLimited draining gen retryAfterMs cursorWasReset ->
@@ -561,8 +558,8 @@ tooLong = \s maxLen -> count (chars s) > maxLen
561558
562559isValidHex : Text -> Bool
563560isValidHex = \s ->
564− let cs = chars s in
565− count cs > 0 && mod (count cs) 2 == 0 && all cs (\c -> contains c "0123456789abcdef")
561+ let n = count (chars s) in
562+ n > 0 && n / 2 * 2 == n && all (chars s) (\c -> contains c "0123456789abcdef")
566563
567564stripTrailingDot : Text -> Text
568565stripTrailingDot = \s -> if containsSuffix "." s then stripTrailingDot (take (count (chars s) - 1) s) else s
@@ -579,10 +576,7 @@ hasPrefix : Text -> Text -> Bool
579576hasPrefix = \pre s -> take (count (chars pre)) s == pre
580577
581578containsSuffix : Text -> Text -> Bool
582−containsSuffix = \suffix s ->
583− let sn = count (chars s) in
584− let pn = count (chars suffix) in
585− drop (max 0 (sn - pn)) s == suffix
579+containsSuffix = \suffix s -> drop (max 0 (count (chars s) - count (chars suffix))) s == suffix
586580
587581-- Block private/reserved/internal hostnames (SSRF defense). Skips obscure encoding
588582-- tricks (octal, hex, percent-encoding) but covers the high-value cases.
@@ -661,14 +655,16 @@ verifyFederationAuth = \authorization fromServer scope requestTimestamp -> do
661655 let payload = drop 7 authorization
662656 if payload == "" || tooLong payload (maxSignatureLen + 25) then yield False
663657 else do
664− -- Split payload on first ':' into {sig, nonce} via a fold over chars.
665− let parts = fold (\acc c ->
666− if acc.split then {sig: acc.sig, nonce: acc.nonce ++ c, split: True {}}
667− else if c == ":" then {sig: acc.sig, nonce: "", split: True {}}
668− else {sig: acc.sig ++ c, nonce: "", split: False {}}) {sig: "", nonce: "", split: False {}} (chars payload)
658+ -- Split payload on first ':' into {sig, nonce}.
659+ let cs = chars payload
660+ let sepIdx = case headOf (mapWhere (withIndex cs) (\p -> p.v == ":") (\p -> p.i)) of
661+ Just {value: i} -> i
662+ _ -> count cs
663+ let sig = take sepIdx payload
664+ let nonce = drop (sepIdx + 1) payload
669665 result <- fetch (federationUrl fromServer) (FederationPubkey {})
670666 case result of
671− Ok r -> yield (r.ok && r.pubkey != "" && verify (bytesFromHex r.pubkey) (textToBytes (scope ++ "|" ++ show requestTimestamp ++ "|" ++ fromServer ++ (if parts.nonce == "" then "" else "|" ++ parts.nonce))) (bytesFromHex parts.sig))
667+ Ok r -> yield (r.ok && r.pubkey != "" && verify (bytesFromHex r.pubkey) (textToBytes (scope ++ "|" ++ show requestTimestamp ++ "|" ++ fromServer ++ (if nonce == "" then "" else "|" ++ nonce))) (bytesFromHex sig))
672668 _ -> yield False
673669 else case extractToken authorization of
674670 Just {value: token} -> do
@@ -1235,7 +1231,7 @@ forkForwardsTo = \effMsgId to encryptedBlob clampedTs servers ->
12351231
12361232handleLookupPresence = \pubkey authorization clientIp respond -> do
12371233 t <- now
1238− let mkErr = \e -> {server: "", authorized: False {}, error: if e == "rate_limited" then "rate_limited" else ""}
1234+ let mkErr = \e -> {server: "", authorized: False {}, error: if e == "rate_limited" then e else ""}
12391235 gateLookup authorization clientIp t respond mkErr
12401236 {server: "", authorized: True {}, error: "rate_limited"} (\_ -> do
12411237 pres <- *presence
@@ -1243,7 +1239,7 @@ handleLookupPresence = \pubkey authorization clientIp respond -> do
12431239
12441240handleBatchLookupPresence = \pubkeys authorization clientIp respond -> do
12451241 t <- now
1246− let mkErr = \e -> {results: [], authorized: False {}, error: if e == "rate_limited" then "rate_limited" else ""}
1242+ let mkErr = \e -> {results: [], authorized: False {}, error: if e == "rate_limited" then e else ""}
12471243 gateLookup authorization clientIp t respond mkErr
12481244 {results: [], authorized: True {}, error: "rate_limited"} (\_ -> do
12491245 pres <- *presence
@@ -1285,7 +1281,7 @@ handleAckMessages = \messageIds authorization clientIp respond -> do
12851281
12861282handleListMessages = \offset authorization clientIp respond -> do
12871283 t <- now
1288− let mkErr = \e -> {messages: [], authorized: False {}, count: 0, error: if e == "rate_limited" then "rate_limited" else ""}
1284+ let mkErr = \e -> {messages: [], authorized: False {}, count: 0, error: if e == "rate_limited" then e else ""}
12891285 gateRated lookupRates maxLookupRatePerKey lookupRateWindowMs (True {}) authorization clientIp t respond mkErr
12901286 {messages: [], authorized: True {}, count: 0, error: "rate_limited"} (\pubkey -> do
12911287 msgs <- *messages
@@ -1521,10 +1517,10 @@ handleDrain = \phase authorization respond -> withMaintAuth authorization
15211517 if effectivePhase == 1 then yield {peers: [], localKeys: []}
15221518 else do
15231519 pres <- *presence
1524− let localEntries = filter pres (\p -> isLocalServer p.server && p.expiresAt > t)
1525− set *presence = filter pres (\p -> not (isLocalServer p.server) || p.expiresAt <= t)
1520+ let isLocalLive = \p -> isLocalServer p.server && p.expiresAt > t
1521+ set *presence = removeWhere pres isLocalLive
15261522 set *pollWakeup = t
1527− yield {peers: knownPeerServersFromPresence pres, localKeys: localEntries}
1523+ yield {peers: knownPeerServersFromPresence pres, localKeys: filter pres isLocalLive}
15281524 when (effectivePhase == 2 && count drainResult.localKeys > 0 && federationEnabled)
15291525 (fork (sendBatchedGossip drainResult.peers (pluck drainResult.localKeys (\p -> mkGossip (GossipOffline {}) p.pubkey t offlineGossipMinTtl)) gossipOriginHops))
15301526 yield (respond {ok: True {}, drained: count drainResult.localKeys, phase: effectivePhase}))