@@ -89,13 +89,16 @@ impl ToJSON MessageStatus where
8989
9090data DeliveryStatus = DsDelivered {} | DsFederated {} | DsQueued {}
9191
92+isValidBoundedHex : Int -> Text -> Bool
9293isValidBoundedHex = \maxLen s -> isValidHex s && not (tooLong s maxLen) && s == normalizeHex s
9394type PubkeyHex = Text where isValidBoundedHex maxPubkeyLen
9495type BlobHex = Text where isValidBoundedHex maxBlobLen
9596type SignatureHex = Text where isValidBoundedHex maxSignatureLen
97+isValidMessageId : Text -> Bool
9698isValidMessageId = isValidBoundedHex maxMessageIdLen
9799type MessageIdHex = Text where isValidMessageId
98100type OptionalMessageId = Text where \s -> s == "" || isValidMessageId s
101+isValidServerName : Text -> Bool
99102isValidServerName = \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s && not (isBadServerName s)
100103type ServerName = Text where isValidServerName
101104data MessageOrigin = LocalOrigin {} | FederatedOrigin {server: ServerName}
@@ -188,7 +191,9 @@ route Api = AuthApi | ClientApi | FederationApi | MaintenanceApi
188191-- Helpers
189192-- ============================================
190193
194+any : [a] -> (a -> Bool) -> Bool
191195any = \xs pred -> fold (\acc x -> if acc then acc else pred x) (False {}) xs
196+none : [a] -> (a -> Bool) -> Bool
192197none = \xs pred -> not (any xs pred)
193198when = \cond action -> if cond then action else yield {}
194199whenOk = \result action -> case result of
@@ -205,10 +210,17 @@ maxBy = \items getKey -> fold (\acc x -> case acc of
205210 Nothing {} -> Just {value: x}
206211 Just {value: v} -> if getKey x > getKey v then Just {value: x} else acc) Nothing {} items
207212
213+minBy = \items getKey -> fold (\acc x -> case acc of
214+ Nothing {} -> Just {value: x}
215+ Just {value: v} -> if getKey x < getKey v then Just {value: x} else acc) Nothing {} items
216+
217+hexDigit : Int -> Text
208218hexDigit = \n -> take 1 (drop (clamp 0 15 n) "0123456789abcdef")
209219
220+byteToHex : Int -> Text
210221byteToHex = \n -> hexDigit (n / 16) ++ hexDigit (n - (n / 16) * 16)
211222
223+intTo3Hex : Int -> Text
212224intTo3Hex = \n ->
213225 let b0 = n / 65536 in
214226 let r0 = n - b0 * 65536 in
@@ -223,26 +235,35 @@ genTokenN = \n -> if n <= 0 then yield "" else do
223235
224236genToken = genTokenN 8
225237
238+tooLong : Text -> Int -> Bool
226239tooLong = \s maxLen -> drop maxLen s != ""
227240
241+isHexChar : Text -> Bool
228242isHexChar = \c -> contains c "0123456789abcdef"
229243
244+isValidHexPairs : Text -> Bool
230245isValidHexPairs = \s ->
231246 if s == "" then True {}
232247 else if drop 1 s == "" then False {}
233248 else if isHexChar (take 1 s) && isHexChar (take 1 (drop 1 s)) then isValidHexPairs (drop 2 s)
234249 else False {}
235250
251+isValidHex : Text -> Bool
236252isValidHex = \s -> s != "" && isValidHexPairs s
237253
254+normalizeHex : Text -> Text
238255normalizeHex = \s -> bytesToHex (bytesFromHex s)
239256
257+isDigitChar : Text -> Bool
240258isDigitChar = \c -> contains c "0123456789"
241259
260+isAllowedServerChar : Text -> Bool
242261isAllowedServerChar = \c -> contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:"
243262
263+containsBadUrlChar : Text -> Bool
244264containsBadUrlChar = \s -> any (chars s) (\c -> not (isAllowedServerChar c))
245265
266+isCgnatRange : Text -> Bool
246267isCgnatRange = \s ->
247268 take 4 s == "100."
248269 && let d4 = take 1 (drop 4 s) in
@@ -256,31 +277,40 @@ isCgnatRange = \s ->
256277 || (d4 == "1" && contains d5 "01" && isDigitChar d6 && threeDigitOctet)
257278 || (d4 == "1" && d5 == "2" && contains d6 "01234567" && threeDigitOctet))
258279
280+containsMultipleColons : Text -> Bool
259281containsMultipleColons = \s -> count (do c <- chars s; where c == ":"; yield c) > 1
260282
283+hasPatternAfterDot : (Text -> Bool) -> Text -> Bool
261284hasPatternAfterDot = \pred s ->
262285 if s == "" then False {}
263286 else if take 1 s == "." && pred (drop 1 s) then True {}
264287 else hasPatternAfterDot pred (drop 1 s)
265288
289+isOctalStart : Text -> Bool
266290isOctalStart = \s -> take 1 s == "0" && isDigitChar (take 1 (drop 1 s)) && isAllDigitsOrDotsUntilColonOrEnd (drop 2 s)
291+hasOctalOctet : Text -> Bool
267292hasOctalOctet = \s -> isOctalStart s || hasPatternAfterDot isOctalStart s
268293
294+isHexStart : Text -> Bool
269295isHexStart = \s -> take 2 s == "0x" || take 2 s == "0X"
296+hasHexPrefix : Text -> Bool
270297hasHexPrefix = \s -> isHexStart s || hasPatternAfterDot isHexStart s
271298
299+isAllDigitsOrDotsUntilColonOrEnd : Text -> Bool
272300isAllDigitsOrDotsUntilColonOrEnd = \s ->
273301 if s == "" then True {}
274302 else if take 1 s == ":" then True {}
275303 else if isDigitChar (take 1 s) || take 1 s == "." then isAllDigitsOrDotsUntilColonOrEnd (drop 1 s)
276304 else False {}
277305
306+isTrailingDots : Text -> Bool
278307isTrailingDots = \s ->
279308 if s == "" then True {}
280309 else if take 1 s == ":" then True {}
281310 else if take 1 s == "." then isTrailingDots (drop 1 s)
282311 else False {}
283312
313+stripTrailingDot : Text -> Text
284314stripTrailingDot = \s ->
285315 if s == "" then ""
286316 else if take 1 s == "." && isTrailingDots (drop 1 s) then stripTrailingDot (drop 1 s)
@@ -289,17 +319,21 @@ stripTrailingDot = \s ->
289319normalizeServerName : Text -> Text
290320normalizeServerName = \s -> toLower (stripTrailingDot s)
291321
322+serverHostN : Text
292323serverHostN = normalizeServerName serverHost
293324isLocalServer : Text -> Bool
294325isLocalServer = \s -> s == serverHostN
295326
327+containsSuffixN : Text -> Int -> Text -> Bool
296328containsSuffixN = \suffix suffixLen s ->
297329 if s == "" then False {}
298330 else if take suffixLen s == suffix && (drop suffixLen s == "" || take 1 (drop suffixLen s) == ":") then True {}
299331 else containsSuffixN suffix suffixLen (drop 1 s)
300332
333+containsSuffix : Text -> Text -> Bool
301334containsSuffix = \suffix s -> containsSuffixN suffix (count (chars suffix)) s
302335
336+is172Private : Text -> Bool
303337is172Private = \sn ->
304338 take 4 sn == "172."
305339 && let d1 = take 1 (drop 4 sn) in
@@ -309,6 +343,7 @@ is172Private = \sn ->
309343 || (d1 == "2" && isDigitChar d2)
310344 || (d1 == "3" && contains d2 "01"))
311345
346+isHighOctetPrefix : Text -> Bool
312347isHighOctetPrefix = \sn ->
313348 take 1 sn == "2"
314349 && let d2 = take 1 (drop 1 sn) in
@@ -318,10 +353,12 @@ isHighOctetPrefix = \sn ->
318353 || (contains d2 "34" && isDigitChar d3)
319354 || (d2 == "5" && contains d3 "012345"))
320355
356+matchesHostname : Text -> Text -> Bool
321357matchesHostname = \sn name ->
322358 let nameLen = count (chars name) in
323359 take nameLen sn == name && (drop nameLen sn == "" || take 1 (drop nameLen sn) == ":")
324360
361+matchesHostnameOrSubdomain : Text -> Text -> Bool
325362matchesHostnameOrSubdomain = \sn name ->
326363 matchesHostname sn name || containsSuffix ("." ++ name) sn
327364
@@ -370,17 +407,17 @@ verifySecret : Text -> Text -> Bool
370407verifySecret = \token secret ->
371408 secret != "" && safeCompare token secret
372409
373−verifyFederationAuth : Text -> Bool
374−verifyFederationAuth = \authorization ->
410+verifyAuthWith : (Text -> Bool) -> Text -> Bool
411+verifyAuthWith = \check authorization ->
375412 case extractToken authorization of
376413 Nothing {} -> False {}
377− Just {value: token} -> verifySecret token federationSecret
414+ Just {value: token} -> check token
415+
416+verifyFederationAuth : Text -> Bool
417+verifyFederationAuth = verifyAuthWith (\token -> verifySecret token federationSecret)
378418
379419verifyMaintenanceAuth : Text -> Bool
380−verifyMaintenanceAuth = \authorization ->
381− case extractToken authorization of
382− Nothing {} -> False {}
383− Just {value: token} -> verifySecret token federationSecret || verifySecret token maintenanceSecret
420+verifyMaintenanceAuth = verifyAuthWith (\token -> verifySecret token federationSecret || verifySecret token maintenanceSecret)
384421
385422clampTtl : Int<S> -> Int<S>
386423clampTtl = clamp 1 maxPresenceTtl
@@ -394,9 +431,13 @@ deliveryToMessageStatus = \ds -> case ds of
394431 DsFederated {} -> MsFederated {}
395432 DsQueued {} -> MsQueued {}
396433
434+isQueued : DeliveryStatus -> Bool
435+isQueued = \ds -> case ds of DsQueued {} -> True {}; _ -> False {}
436+
397437nextSeqTs : Timestamp -> Timestamp -> Timestamp
398438nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
399439
440+takeN : [a] -> Int -> [a]
400441takeN = \items n -> (fold (\acc e -> if acc.n >= n then acc else {n: acc.n + 1, items: union acc.items [e]}) {n: 0, items: []} items).items
401442
402443dedupMessageIds : [MessageIdHex] -> [MessageIdHex]
@@ -440,16 +481,20 @@ evictOldestAckedIds = \items n ->
440481 if n <= 0 then items
441482 else diff items (boundedSmallest items n (\a -> a.ackedAt))
442483
484+safeCompareLoop : Text -> Text -> Int -> Int -> Int
443485safeCompareLoop = \s1 s2 n result ->
444486 if n <= 0 && s1 == "" && s2 == ""
445487 then result
446488 else safeCompareLoop (drop 1 s1) (drop 1 s2) (n - 1) (result + (if take 1 s1 == take 1 s2 then 0 else 1))
447489
490+safeCompare : Text -> Text -> Bool
448491safeCompare = \a b ->
449492 safeCompareLoop a b maxTokenLen 0 + (if a == "" then 1 else 0) + (if b == "" then 1 else 0) == 0
450493
451494evictOneOldest = \items getKey ->
452− diff items (boundedSmallest items 1 getKey)
495+ case minBy items getKey of
496+ Nothing {} -> items
497+ Just {value: v} -> diff items [v]
453498
454499capPerKey = \items matchKey maxPerKey getExpiry t ->
455500 let active = do x <- items; where getExpiry x > t; yield x in
@@ -467,6 +512,7 @@ capGlobal = \items maxCount getKey ->
467512capPerKeyAndGlobal = \items matchKey maxPerKey getExpiry t maxGlobal ->
468513 capGlobal (capPerKey items matchKey maxPerKey getExpiry t) maxGlobal getExpiry
469514
515+collectPeerServers : [a] -> (a -> Text) -> [Text]
470516collectPeerServers = \items getServer ->
471517 fold (\acc item ->
472518 let s = getServer item in
@@ -908,7 +954,7 @@ serve = \req -> case req of
908954 authorization: federationAuth})
909955 when (any forwardServers (\s -> s == server))
910956 (whenOk fwdResult (removeForward msgId server)))
911− when (case delivery of DsQueued {} -> True {}; _ -> False {})
957+ when (isQueued delivery)
912958 (println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")))
913959 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
914960 _ -> forkBroadcastOffline t result.pr