@@ -549,7 +549,9 @@ tooLong : Text -> Int -> Bool
549tooLong = \s maxLen -> count (chars s) > maxLen
549tooLong = \s maxLen -> count (chars s) > maxLen
551isValidHex : Text -> Bool
551isValidHex : Text -> Bool
552−isValidHex = \s -> count (chars s) > 0 && mod (count (chars s)) 2 == 0 && all (chars s) (\c -> contains c "0123456789abcdef")
554+ count cs > 0 && mod (count cs) 2 == 0 && all cs (\c -> contains c "0123456789abcdef")
554normalizeHex : Text -> Text
556normalizeHex : Text -> Text
555normalizeHex = \s -> bytesToHex (bytesFromHex s)
557normalizeHex = \s -> bytesToHex (bytesFromHex s)
@@ -672,17 +674,17 @@ verifyFederationAuth = \authorization fromServer scope requestTimestamp -> do
672withFederationAuth = \authorization t respond fromServer scope requestTimestamp precondition action -> do
674withFederationAuth = \authorization t respond fromServer scope requestTimestamp precondition action -> do
673 blocked <- *blockedPeers
675 blocked <- *blockedPeers
674 allowed <- *allowedPeers
676 allowed <- *allowedPeers
675− let err = \e -> respond {ok: False {}, error: e, retryAfterMs: 0}
677+ let err = \e retry -> respond {ok: False {}, error: e, retryAfterMs: retry}
676− if elem blocked fromServer then yield (err "blocked")
678+ if elem blocked fromServer then yield (err "blocked" 0)
677− else if count allowed > 0 && not (elem allowed fromServer) then yield (err "not_allowed")
679+ else if count allowed > 0 && not (elem allowed fromServer) then yield (err "not_allowed" 0)
678− else if not precondition then yield (err "invalid_request")
680+ else if not precondition then yield (err "invalid_request" 0)
679− else if requestTimestamp > 0 && abs (requestTimestamp - t) > clockSkewTolerance then yield (err "clock_skew")
681+ else if requestTimestamp > 0 && abs (requestTimestamp - t) > clockSkewTolerance then yield (err "clock_skew" 0)
681 verified <- verifyFederationAuth authorization fromServer scope requestTimestamp
683 verified <- verifyFederationAuth authorization fromServer scope requestTimestamp
682− if not verified then yield (err "unauthorized")
684+ if not verified then yield (err "unauthorized" 0)
684 limited <- checkServerRateGate fromServer t
686 limited <- checkServerRateGate fromServer t
685− if limited then yield (respond {ok: False {}, error: "rate_limited", retryAfterMs: federationRateWindowMs})
687+ if limited then yield (err "rate_limited" federationRateWindowMs)
686 else action
688 else action
688-- ============================================
690-- ============================================
@@ -789,8 +791,9 @@ presenceForKey = \presence pubkey t ->
790-- Resolve a key's server for client lookup, masking remote identities behind "remote".
792-- Resolve a key's server for client lookup, masking remote identities behind "remote".
791maskedServer = \pres pubkey t ->
793maskedServer = \pres pubkey t ->
794+ let entries = presenceForKey pres pubkey t in
792− if any (presenceForKey pres pubkey t) (\p -> isLocalServer p.server) then serverHostN
795+ if any entries (\p -> isLocalServer p.server) then serverHostN
793− else if count (presenceForKey pres pubkey t) > 0 then "remote"
796+ else if count entries > 0 then "remote"
796hasMessage : MessageIdHex -> PubkeyHex -> [{messageId: MessageIdHex, toKey: PubkeyHex | a}] -> Bool
799hasMessage : MessageIdHex -> PubkeyHex -> [{messageId: MessageIdHex, toKey: PubkeyHex | a}] -> Bool
@@ -1069,8 +1072,7 @@ handlePoll = \cursor generation watchKeys authorization clientIp respond -> do
1069 else case extractToken authorization of
1072 else case extractToken authorization of
1070 Nothing {} -> yield (respond (emptyPollResp 0 (False {}) (False {}) (False {}) serverGen 0 cursorWasReset))
1073 Nothing {} -> yield (respond (emptyPollResp 0 (False {}) (False {}) (False {}) serverGen 0 cursorWasReset))
1071 Just {value: token} ->
1074 Just {value: token} ->
1072− let effectiveCursor = if generation != serverGen then 0 else cursor in
1073− pollOnce token effectiveCursor cursorWasReset (takeRelation maxWatchKeys watchKeys) clientIp serverGen respond t
1075+ pollOnce token (if generation != serverGen then 0 else cursor) cursorWasReset (takeRelation maxWatchKeys watchKeys) clientIp serverGen respond t
1075pollOnce = \token cursor cursorWasReset watchKeys clientIp serverGen respond t -> do
1077pollOnce = \token cursor cursorWasReset watchKeys clientIp serverGen respond t -> do
1076 setup <- atomic do
1078 setup <- atomic do
@@ -1079,9 +1081,9 @@ pollOnce = \token cursor cursorWasReset watchKeys clientIp serverGen respond t -
1079 Nothing {} -> yield Nothing {}
1081 Nothing {} -> yield Nothing {}
1080 Just {value: s} -> do
1082 Just {value: s} -> do
1081 let clampedCursor = clamp 0 t cursor
1083 let clampedCursor = clamp 0 t cursor
1082− ackResult <- if clampedCursor > 0 then ackPolledMessages s.pubkey clampedCursor t else yield {pendingAcks: []}
1084+ pendingAcks <- if clampedCursor > 0 then ackPolledMessages s.pubkey clampedCursor t else yield []
1083 startWakeup <- *pollWakeup
1085 startWakeup <- *pollWakeup
1084− yield (Just {value: {pubkey: s.pubkey, clampedCursor: clampedCursor, startWakeup: startWakeup, pendingAcks: ackResult.pendingAcks}})
1086+ yield (Just {value: {pubkey: s.pubkey, clampedCursor: clampedCursor, startWakeup: startWakeup, pendingAcks: pendingAcks}})
1085 case setup of
1087 case setup of
1086 Nothing {} -> yield (respond (emptyPollResp 0 (False {}) (False {}) (False {}) serverGen 0 cursorWasReset))
1088 Nothing {} -> yield (respond (emptyPollResp 0 (False {}) (False {}) (False {}) serverGen 0 cursorWasReset))
1087 Just {value: s} -> do
1089 Just {value: s} -> do
@@ -1109,8 +1111,7 @@ pollOnce = \token cursor cursorWasReset watchKeys clientIp serverGen respond t -
1109 myDel <- collectAndPrune senderDeliveries (\x -> x.senderKey == s.pubkey) (\x -> {messageId: x.messageId, toKey: x.toKey, deliveredAt: x.deliveredAt})
1111 myDel <- collectAndPrune senderDeliveries (\x -> x.senderKey == s.pubkey) (\x -> {messageId: x.messageId, toKey: x.toKey, deliveredAt: x.deliveredAt})
1110 myCancels <- collectAndPrune cancelNotifications (\x -> x.toKey == s.pubkey) (\x -> {messageId: x.messageId, cancelledAt: x.cancelledAt})
1112 myCancels <- collectAndPrune cancelNotifications (\x -> x.toKey == s.pubkey) (\x -> {messageId: x.messageId, cancelledAt: x.cancelledAt})
1111 yield {expirations: myExp, deliveries: myDel, cancellations: myCancels}
1113 yield {expirations: myExp, deliveries: myDel, cancellations: myCancels}
1112− let isHeartbeat = pollResult.authorized && count pollResult.events == 0
1113− yield (respond {events: pollResult.events, cursor: pollResult.cursor, authorized: pollResult.authorized, rateLimited: False {}, draining: False {}, generation: serverGen, presenceUpdates: presenceUpdates, heartbeat: isHeartbeat, retryAfterMs: 0, cursorReset: cursorWasReset, hasMore: pollResult.hasMore, cursorStale: False {}, messageExpirations: drains.expirations, messageDeliveries: drains.deliveries, droppedDeliveryReceipts: 0, droppedExpirationNotifs: 0, loadPct: 0, messageCancellations: drains.cancellations})
1114+ yield (respond {events: pollResult.events, cursor: pollResult.cursor, authorized: pollResult.authorized, rateLimited: False {}, draining: False {}, generation: serverGen, presenceUpdates: presenceUpdates, heartbeat: pollResult.authorized && count pollResult.events == 0, retryAfterMs: 0, cursorReset: cursorWasReset, hasMore: pollResult.hasMore, cursorStale: False {}, messageExpirations: drains.expirations, messageDeliveries: drains.deliveries, droppedDeliveryReceipts: 0, droppedExpirationNotifs: 0, loadPct: 0, messageCancellations: drains.cancellations})
1115doPoll = \s t -> do
1116doPoll = \s t -> do
1116 let collectAt = \tnow -> atomic do
1117 let collectAt = \tnow -> atomic do
@@ -1140,8 +1141,7 @@ ackPolledMessages = \pubkey cursor t -> do
1140 let mids = pluck toAck (\m -> m.messageId)
1141 let mids = pluck toAck (\m -> m.messageId)
1141 set *messages = removeWhere msgs matches
1142 set *messages = removeWhere msgs matches
1142 pruneRef forwards (\f -> not (f.toKey == pubkey && elem mids f.messageId))
1143 pruneRef forwards (\f -> not (f.toKey == pubkey && elem mids f.messageId))
1143− ackedFederated <- recordAcksAndDeliveries toAck t
1144+ recordAcksAndDeliveries toAck t
1144− yield {pendingAcks: ackedFederated}
1146-- ============================================
1146-- ============================================
1147-- Handler: send
1147-- Handler: send