@@ -307,25 +307,14 @@ route Api = AuthApi | ClientApi | FederationApi
307-- ============================================
307-- ============================================
308-- Generic helpers
308-- Generic helpers
309-- ============================================
309-- ============================================
310−-- List/predicate combinators (filter/any/none/findFirst/...), token generation,
310+-- List/predicate combinators (filter/all/findFirst/...), token generation,
311-- and small text/server-name utilities used throughout the rest of the file.
311-- and small text/server-name utilities used throughout the rest of the file.
312-- Everything is intentionally O(n) over flat lists; performance is sacrificed
312-- Everything is intentionally O(n) over flat lists; performance is sacrificed
313-- for clarity per the file header.
313-- for clarity per the file header.
315−-- Filter then map in one pass.
316−mapWhere : a b -> (b -> Bool) -> (b -> c) -> a c
317−mapWhere = \xs pred fn -> map fn (filter pred xs)
318−countWhere : a b -> (b -> Bool) -> Int
319−countWhere = \xs pred -> count (filter pred xs)
320−-- True when at least one element matches.
321−any : [a] -> (a -> Bool) -> Bool
322−any = \xs pred -> countWhere xs pred > 0
323−-- True when no element matches.
324−none : [a] -> (a -> Bool) -> Bool
325−none = \xs pred -> not any xs pred
326-- True when every element matches.
315-- True when every element matches.
327all : [a] -> (a -> Bool) -> Bool
316all : [a] -> (a -> Bool) -> Bool
328−all = \xs pred -> none xs (\x -> not pred x)
317+all = \xs pred -> not (any (\x -> not pred x) xs)
329findFirst : [a] -> (a -> Bool) -> Maybe a
318findFirst : [a] -> (a -> Bool) -> Maybe a
330findFirst = \xs pred -> headOf (filter pred xs)
319findFirst = \xs pred -> headOf (filter pred xs)
331-- Run `action` only when `cond` is True; otherwise no-op.
320-- Run `action` only when `cond` is True; otherwise no-op.
@@ -341,7 +330,7 @@ clamp = \lo hi x -> max lo (min hi x)
342-- First element of a list, or Nothing for an empty list.
331-- First element of a list, or Nothing for an empty list.
343headOf : [a] -> Maybe a
332headOf : [a] -> Maybe a
344−headOf = \items -> fold (\_ x -> Just {value: x}) (Nothing {}) (takeRelation 1 items)
333+headOf = \items -> fold (\_ x -> Just {value: x}) (Nothing {}) (take 1 items)
346-- Cap to maxN by dropping the smallest-key entries (LRU-style). Always sorts.
335-- Cap to maxN by dropping the smallest-key entries (LRU-style). Always sorts.
347-- For session/challenge/rate caps, `getKey` is typically `expiresAt` or
336-- For session/challenge/rate caps, `getKey` is typically `expiresAt` or
@@ -359,7 +348,7 @@ capPerKey = \items pred maxN getKey -> union (filter (\x -> not pred x) items) (
359-- Sequence an IO action over each item, in order. Recurses through the list
348-- Sequence an IO action over each item, in order. Recurses through the list
360-- one element at a time; this is the closest equivalent of `mapM_` here.
349-- one element at a time; this is the closest equivalent of `mapM_` here.
361forEach : [a] -> (a -> IO {} {}) -> IO {} {}
350forEach : [a] -> (a -> IO {} {}) -> IO {} {}
362−forEach = \items action -> case single (takeRelation 1 items) of
351+forEach = \items action -> case single (take 1 items) of
363 Nothing {} -> yield {}
352 Nothing {} -> yield {}
364 Just {value: x} -> do
353 Just {value: x} -> do
@@ -430,7 +419,7 @@ containsSuffix = \suffix s -> drop (max 0 (count (chars s) - count (chars suffix
430-- (so we never `fetch` a peer pubkey from loopback) and on inbound requests
419-- (so we never `fetch` a peer pubkey from loopback) and on inbound requests
431-- (so a peer can't claim a bogus `fromServer`).
420-- (so a peer can't claim a bogus `fromServer`).
432isBadServerName : Text -> Bool
421isBadServerName : Text -> Bool
433−isBadServerName = \sn -> sn == "" || sn == "localhost" || not all (chars sn) (\c -> contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:") || any [
422+isBadServerName = \sn -> sn == "" || sn == "localhost" || not all (chars sn) (\c -> contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:") || any (\p -> hasPrefix p sn) [
@@ -440,7 +429,7 @@ isBadServerName = \sn -> sn == "" || sn == "localhost" || not all (chars sn) (\c
440 "169.254.",
429 "169.254.",
443−] (\p -> hasPrefix p sn) || any [".localhost", ".local", ".internal", ".arpa", ".onion"] (\s -> containsSuffix s sn)
432+] || any (\s -> containsSuffix s sn) [".localhost", ".local", ".internal", ".arpa", ".onion"]
445-- ============================================
434-- ============================================
446-- Auth helpers
435-- Auth helpers
@@ -581,7 +570,7 @@ retryBackoff = \failures -> min retryBackoffMax (retryBackoffBase * max 1 failur
581-- True when enough time has passed since the last failure for `server` to be
570-- True when enough time has passed since the last failure for `server` to be
582-- worth retrying (or no failure recorded at all).
571-- worth retrying (or no failure recorded at all).
583shouldRetryServer : Text -> Timestamp -> [ForwardFailure] -> Bool
572shouldRetryServer : Text -> Timestamp -> [ForwardFailure] -> Bool
584−shouldRetryServer = \server t failures -> none failures (\f -> f.server == server && t - f.failedAt < retryBackoff f.failures)
573+shouldRetryServer = \server t failures -> not (any (\f -> f.server == server && t - f.failedAt < retryBackoff f.failures) failures)
586-- Bump the failure counter for `server`. Preserves `firstFailedAt` across
575-- Bump the failure counter for `server`. Preserves `firstFailedAt` across
587-- subsequent failures.
576-- subsequent failures.
@@ -654,7 +643,7 @@ pruneExpired = \t -> atomic do
654 -- presence: remember locally-expired keys for offline gossip
643 -- presence: remember locally-expired keys for offline gossip
655 pres <- *presence
644 pres <- *presence
656 *presence = filter (\p -> p.expiresAt > t) pres
645 *presence = filter (\p -> p.expiresAt > t) pres
657− let stillLive = \pk -> any pres (\k -> isLocalServer k.server && k.pubkey == pk && k.expiresAt > t)
646+ let stillLive = \pk -> any (\k -> isLocalServer k.server && k.pubkey == pk && k.expiresAt > t) pres
658 yield (filter (\p -> p.expiresAt <= t && isLocalServer p.server && not (stillLive p.pubkey)) pres)
647 yield (filter (\p -> p.expiresAt <= t && isLocalServer p.server && not (stillLive p.pubkey)) pres)
660-- ============================================
649-- ============================================
@@ -702,7 +691,7 @@ retryPendingForwards = do
703 fwds <- *forwards
692 fwds <- *forwards
704 failures <- *forwardFailures
693 failures <- *forwardFailures
705− forEach (filter (\s -> shouldRetryServer s t failures) (collectPeers fwds (\f -> f.toServer))) (\server -> forEach (takeRelation maxBatchSize (filter (\f -> f.toServer == server) fwds)) (\f -> do
694+ forEach (filter (\s -> shouldRetryServer s t failures) (collectPeers fwds (\f -> f.toServer))) (\server -> forEach (take maxBatchSize (filter (\f -> f.toServer == server) fwds)) (\f -> do
706 result <- fetch (federationUrl server) (ForwardMessage {f.toKey, f.encryptedBlob})
695 result <- fetch (federationUrl server) (ForwardMessage {f.toKey, f.encryptedBlob})
707 success <- case result of
696 success <- case result of
708 Err _ -> do
697 Err _ -> do
@@ -724,13 +713,13 @@ forwardQueuedToServer : PubkeyHex -> ServerName -> IO {rw *forwards, r *messages
724forwardQueuedToServer = \pubkey server -> atomic (do
713forwardQueuedToServer = \pubkey server -> atomic (do
725 msgs <- *messages
714 msgs <- *messages
726 fwds <- *forwards
715 fwds <- *forwards
727− let candidates = filter (\m -> m.toKey == pubkey && none fwds (\f -> f.encryptedBlob == m.encryptedBlob && f.toServer == server)) msgs
716+ let candidates = filter (\m -> m.toKey == pubkey && not (any (\f -> f.encryptedBlob == m.encryptedBlob && f.toServer == server) fwds)) msgs
728 let newFwds = map (\m -> {
717 let newFwds = map (\m -> {
729 toServer: server,
718 toServer: server,
731 m.encryptedBlob,
720 m.encryptedBlob,
732 retries: 0
721 retries: 0
733− }) (takeRelation maxForwardsPerServer candidates)
722+ }) (take maxForwardsPerServer candidates)
734 *forwards = union fwds newFwds)
723 *forwards = union fwds newFwds)
736-- ============================================
725-- ============================================
@@ -811,7 +800,7 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do
811 Just {value: sigBytes} -> verify pk (textToBytes challenge) sigBytes
800 Just {value: sigBytes} -> verify pk (textToBytes challenge) sigBytes
812 _ -> False {}
801 _ -> False {}
813 _ -> False {}
802 _ -> False {}
814− let valid = any ch (\c -> same c && c.expiresAt > t && matchIp clientIp c.ip) && sigValid
803+ let valid = any (\c -> same c && c.expiresAt > t && matchIp clientIp c.ip) ch && sigValid
815 if not valid
804 if not valid
816 then yield {valid: False {}, peers: []}
805 then yield {valid: False {}, peers: []}
@@ -864,7 +853,7 @@ pollOnce = \authorization cursor clientIp t -> do
864 startWakeup <- *pollWakeup
853 startWakeup <- *pollWakeup
865 pres <- *presence
854 pres <- *presence
866 let mine = \p -> p.pubkey == pubkey && isLocalServer p.server
855 let mine = \p -> p.pubkey == pubkey && isLocalServer p.server
867− let stale = not any pres (\p -> mine p && p.expiresAt - t >= sessionExpiry / 2)
856+ let stale = not (any (\p -> mine p && p.expiresAt - t >= sessionExpiry / 2) pres)
868 refreshPeers <- if stale
857 refreshPeers <- if stale
870 let kept = filter (\p -> not mine p) pres
859 let kept = filter (\p -> not mine p) pres
@@ -909,7 +898,7 @@ doPoll = \s t -> do
909-- which the client echoes on the next /poll to advance — and which the
898-- which the client echoes on the next /poll to advance — and which the
910-- server treats as an implicit ack.
899-- server treats as an implicit ack.
911collectPollEvents : [Message] -> PubkeyHex -> Timestamp -> Timestamp -> {events: [PollEvent], cursor: Timestamp}
900collectPollEvents : [Message] -> PubkeyHex -> Timestamp -> Timestamp -> {events: [PollEvent], cursor: Timestamp}
912−collectPollEvents = \messages pubkey cursor t -> (\limited -> {events: map (\m -> {m.encryptedBlob}) limited, cursor: fold (\acc m -> max acc m.receivedAt) cursor limited}) (takeRelation maxPollEvents (sortBy (\m -> m.receivedAt) (filter (\m -> m.toKey == pubkey && t - m.receivedAt < messageMaxAge && m.receivedAt > cursor) messages)))
901+collectPollEvents = \messages pubkey cursor t -> (\limited -> {events: map (\m -> {m.encryptedBlob}) limited, cursor: fold (\acc m -> max acc m.receivedAt) cursor limited}) (take maxPollEvents (sortBy (\m -> m.receivedAt) (filter (\m -> m.toKey == pubkey && t - m.receivedAt < messageMaxAge && m.receivedAt > cursor) messages)))
914-- Treat the supplied cursor as an ack: drop all messages with
903-- Treat the supplied cursor as an ack: drop all messages with
915-- receivedAt <= cursor, plus their pending forwards.
904-- receivedAt <= cursor, plus their pending forwards.
@@ -946,7 +935,7 @@ handleSendMessages : [{encryptedBlob: BlobHex, to: PubkeyHex | a}] -> Text -> Te
946handleSendMessages = \messages authorization clientIp -> do
935handleSendMessages = \messages authorization clientIp -> do
948 gateAuth authorization clientIp t (\senderKey -> do
937 gateAuth authorization clientIp t (\senderKey -> do
949− let limited = takeRelation maxBatchSize messages
938+ let limited = take maxBatchSize messages
950 decision <- atomic (do
939 decision <- atomic (do
951 checked <- mapEach limited (\m -> do
940 checked <- mapEach limited (\m -> do
952 c <- checkSendRate senderKey m.to t
941 c <- checkSendRate senderKey m.to t
@@ -999,12 +988,12 @@ commitSendMessage = \to encryptedBlob remoteServers t -> do
999 *pollWakeup = seqTs
988 *pollWakeup = seqTs
1000 when federationEnabled (do
989 when federationEnabled (do
1001 fwds <- *forwards
990 fwds <- *forwards
1002− let newFwds = mapWhere remoteServers (\s -> none fwds (\f -> f.encryptedBlob == encryptedBlob && f.toServer == s)) (\s -> {
991+ let newFwds = map (\s -> {
1003 toServer: s,
992 toServer: s,
1004 toKey: to,
993 toKey: to,
1005 encryptedBlob,
994 encryptedBlob,
1006 retries: 0
995 retries: 0
1007− })
996+ }) (filter (\s -> not (any (\f -> f.encryptedBlob == encryptedBlob && f.toServer == s) fwds)) remoteServers)
1008 *forwards = union fwds newFwds)
997 *forwards = union fwds newFwds)
1010-- Fire one /federation/forward call per pre-staged server. On success the
999-- Fire one /federation/forward call per pre-staged server. On success the
@@ -1031,8 +1020,8 @@ forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> do
1031 let remaining = filter (\x -> not same x) fwds2
1020 let remaining = filter (\x -> not same x) fwds2
1032 *forwards = remaining
1021 *forwards = remaining
1033 pres <- *presence
1022 pres <- *presence
1034− let stillLocal = any pres (\p -> p.pubkey == to && isLocalServer p.server && p.expiresAt > t)
1023+ let stillLocal = any (\p -> p.pubkey == to && isLocalServer p.server && p.expiresAt > t) pres
1035− let othersPending = any remaining (\x -> x.encryptedBlob == encryptedBlob)
1024+ let othersPending = any (\x -> x.encryptedBlob == encryptedBlob) remaining
1036 when (not stillLocal && not othersPending) (do
1025 when (not stillLocal && not othersPending) (do
1037 msgs <- *messages
1026 msgs <- *messages
1038 *messages = filter (\m -> m.encryptedBlob != encryptedBlob) msgs)))
1027 *messages = filter (\m -> m.encryptedBlob != encryptedBlob) msgs)))
@@ -1073,7 +1062,7 @@ handleRecvGossip = \events fromServer -> do
1073 let kept = filter (\p -> p.server != fromServer || not elem p.pubkey touchedPubkeys) pres
1062 let kept = filter (\p -> p.server != fromServer || not elem p.pubkey touchedPubkeys) pres
1074 let added = map (\pk -> {pubkey: pk, server: fromServer, expiresAt: t + onlineGossipTtl}) onlinePubkeys
1063 let added = map (\pk -> {pubkey: pk, server: fromServer, expiresAt: t + onlineGossipTtl}) onlinePubkeys
1075 *presence = union kept added
1064 *presence = union kept added
1076− yield (filter (\pk -> none pres (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t)) onlinePubkeys))
1065+ yield (filter (\pk -> not (any (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t) pres)) onlinePubkeys))
1077 fork (forEach newlyOnline (\pk -> forwardQueuedToServer pk fromServer))
1066 fork (forEach newlyOnline (\pk -> forwardQueuedToServer pk fromServer))
1078 yield (Ok {value: {}})
1067 yield (Ok {value: {}})
@@ -1089,7 +1078,7 @@ storeFederated : PubkeyHex -> BlobHex -> Int<Ms> -> IO {rw *messages, rw *pollWa
1089storeFederated = \toKey encryptedBlob t -> do
1078storeFederated = \toKey encryptedBlob t -> do
1090 pres <- *presence
1079 pres <- *presence
1091 msgs <- *messages
1080 msgs <- *messages
1092− if not any pres (\p -> p.pubkey == toKey && isLocalServer p.server && p.expiresAt > t)
1081+ if not (any (\p -> p.pubkey == toKey && isLocalServer p.server && p.expiresAt > t) pres)
1093 then yield "no_presence"
1082 then yield "no_presence"
1095 seq <- *seqCounter
1084 seq <- *seqCounter