@@ -449,7 +449,7 @@ countWhere = \xs pred -> count (filter xs pred)
449any : [a] -> (a -> Bool) -> Bool
449any : [a] -> (a -> Bool) -> Bool
450any = \xs pred -> countWhere xs pred > 0
450any = \xs pred -> countWhere xs pred > 0
451none : [a] -> (a -> Bool) -> Bool
451none : [a] -> (a -> Bool) -> Bool
452−none = \xs pred -> countWhere xs pred == 0
452+none = \xs pred -> not (any xs pred)
453all : [a] -> (a -> Bool) -> Bool
453all : [a] -> (a -> Bool) -> Bool
454all = \xs pred -> countWhere xs pred == count xs
454all = \xs pred -> countWhere xs pred == count xs
455elem = \xs x -> any xs (\y -> y == x)
455elem = \xs x -> any xs (\y -> y == x)
@@ -562,7 +562,7 @@ tooLong : Text -> Int -> Bool
562tooLong = \s maxLen -> count (chars s) > maxLen
562tooLong = \s maxLen -> count (chars s) > maxLen
564isValidHex : Text -> Bool
564isValidHex : Text -> Bool
565−isValidHex = \s -> let cs = chars s in count cs > 0 && mod (count cs) 2 == 0 && all cs (\c -> contains c "0123456789abcdef")
565+isValidHex = \s -> let cs = chars s in let n = count cs in n > 0 && mod n 2 == 0 && all cs (\c -> contains c "0123456789abcdef")
567normalizeHex : Text -> Text
567normalizeHex : Text -> Text
568normalizeHex = \s -> bytesToHex (bytesFromHex s)
568normalizeHex = \s -> bytesToHex (bytesFromHex s)
@@ -621,9 +621,10 @@ withMaintAuth = \authorization onUnauth onAuth -> do
621gateAuth = \checkDrain auth ip t respond mkErr onAuth -> do
621gateAuth = \checkDrain auth ip t respond mkErr onAuth -> do
622 dp <- *drainPhase
622 dp <- *drainPhase
623 g <- checkGlobalRate t
623 g <- checkGlobalRate t
624+ let err = \e -> yield (respond (mkErr e))
624− if checkDrain && dp >= 2 then yield (respond (mkErr "draining"))
625+ if checkDrain && dp >= 2 then err "draining"
625− else if g then yield (respond (mkErr "rate_limited"))
626+ else if g then err "rate_limited"
626− else withSessionAuth auth t ip (yield (respond (mkErr "unauthorized"))) onAuth
627+ else withSessionAuth auth t ip (err "unauthorized") onAuth
628-- gateAuth + per-key rate gate. `rateResp` is the response value when the per-key gate trips.
629-- gateAuth + per-key rate gate. `rateResp` is the response value when the per-key gate trips.
629gateRated = \checkDrain auth ip rateRef maxRate windowMs t respond mkErr rateResp onAuth ->
630gateRated = \checkDrain auth ip rateRef maxRate windowMs t respond mkErr rateResp onAuth ->
@@ -673,9 +674,7 @@ verifyFederationAuth = \authorization fromServer scope requestTimestamp -> do
673 else {sig: acc.sig ++ c, nonce: "", split: False {}}) {sig: "", nonce: "", split: False {}} (chars payload)
674 else {sig: acc.sig ++ c, nonce: "", split: False {}}) {sig: "", nonce: "", split: False {}} (chars payload)
674 result <- fetch (federationUrl fromServer) (FederationPubkey {})
675 result <- fetch (federationUrl fromServer) (FederationPubkey {})
675 case result of
676 case result of
677− if not r.ok || r.pubkey == "" then yield False
678− else yield (verify (bytesFromHex r.pubkey) (textToBytes (scope ++ "|" ++ show requestTimestamp ++ "|" ++ fromServer ++ (if parts.nonce == "" then "" else "|" ++ parts.nonce))) (bytesFromHex parts.sig))
677+ 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))
679 _ -> yield False
678 _ -> yield False
680 else case extractToken authorization of
679 else case extractToken authorization of
681 Just {value: token} -> do
680 Just {value: token} -> do
@@ -987,12 +986,14 @@ refreshLocalPresence = \t -> do
987 refreshState <- atomic do
986 refreshState <- atomic do
988 sessions <- *sessions
987 sessions <- *sessions
989 presence <- *presence
988 presence <- *presence
989+ let newExpiry = t + sessionExpiry
990+ let sessionKeys = unique (pluck sessions (\s -> s.pubkey))
990 let updated = pluck presence (\p ->
991 let updated = pluck presence (\p ->
991− if isLocalServer p.server && elem (unique (pluck sessions (\s -> s.pubkey))) p.pubkey && p.expiresAt - t < sessionExpiry / 2
992+ if isLocalServer p.server && elem sessionKeys p.pubkey && p.expiresAt - t < sessionExpiry / 2
992− then {pubkey: p.pubkey, server: p.server, expiresAt: t + sessionExpiry, timestamp: t}
993+ then {pubkey: p.pubkey, server: p.server, expiresAt: newExpiry, timestamp: t}
994 set *presence = updated
995 set *presence = updated
995− yield {refreshed: filter updated (\p -> isLocalServer p.server && p.expiresAt == t + sessionExpiry), peers: knownPeerServersFromPresence updated}
996+ yield {refreshed: filter updated (\p -> isLocalServer p.server && p.expiresAt == newExpiry), peers: knownPeerServersFromPresence updated}
996 when (count refreshState.refreshed > 0)
997 when (count refreshState.refreshed > 0)
997 (fork (sendBatchedGossip refreshState.peers (pluck refreshState.refreshed (\p -> mkGossip (GossipOnline {}) p.pubkey t (clampTtl (sessionExpiry / 1000)))) gossipOriginHops))
998 (fork (sendBatchedGossip refreshState.peers (pluck refreshState.refreshed (\p -> mkGossip (GossipOnline {}) p.pubkey t (clampTtl (sessionExpiry / 1000)))) gossipOriginHops))
@@ -1063,11 +1064,12 @@ handleRevoke = \targetToken authorization clientIp respond -> do
1064handleLogout = \authorization clientIp respond -> do
1065handleLogout = \authorization clientIp respond -> do
1065 t <- now
1066 t <- now
1067+ let myToken = extractToken authorization
1066 removed <- atomic (withSessionAuth authorization t clientIp
1068 removed <- atomic (withSessionAuth authorization t clientIp
1067 (yield {ok: False {}, pubkey: "", peers: []})
1069 (yield {ok: False {}, pubkey: "", peers: []})
1068 (\pubkey -> do
1070 (\pubkey -> do
1069 ses <- *sessions
1071 ses <- *sessions
1070− set *sessions = removeWhere ses (\s -> Just {value: s.token} == extractToken authorization)
1072+ set *sessions = removeWhere ses (\s -> Just {value: s.token} == myToken)
1071 after <- *sessions
1073 after <- *sessions
1072 peers <- if any after (\s -> s.pubkey == pubkey) then yield []
1074 peers <- if any after (\s -> s.pubkey == pubkey) then yield []
@@ -1089,8 +1091,9 @@ handlePoll = \cursor generation watchKeys authorization clientIp respond -> do
1089 dp <- *drainPhase
1091 dp <- *drainPhase
1090 g <- checkGlobalRate t
1092 g <- checkGlobalRate t
1091 let cursorWasReset = generation != serverGen && cursor > 0
1093 let cursorWasReset = generation != serverGen && cursor > 0
1094+ let er = \auth rate drain retry -> yield (respond (emptyPollResp 0 auth rate drain serverGen retry cursorWasReset))
1092− if dp >= 2 then yield (respond (emptyPollResp 0 (True {}) (False {}) (True {}) serverGen 0 cursorWasReset))
1095+ if dp >= 2 then er (True {}) (False {}) (True {}) 0
1093− else if g then yield (respond (emptyPollResp 0 (False {}) (True {}) (False {}) serverGen globalRateWindowMs cursorWasReset))
1096+ else if g then er (False {}) (True {}) (False {}) globalRateWindowMs
1094 else pollOnce authorization (if cursorWasReset then 0 else cursor) cursorWasReset (takeRelation maxWatchKeys watchKeys) clientIp serverGen respond t
1097 else pollOnce authorization (if cursorWasReset then 0 else cursor) cursorWasReset (takeRelation maxWatchKeys watchKeys) clientIp serverGen respond t
1096pollOnce = \authorization cursor cursorWasReset watchKeys clientIp serverGen respond t -> do
1099pollOnce = \authorization cursor cursorWasReset watchKeys clientIp serverGen respond t -> do