@@ -360,18 +360,21 @@ authenticateSession = \sessions token t ->
360360extractToken = \authHeader ->
361361 let token = drop 7 authHeader in
362362 if toLower (take 7 authHeader) == "bearer " && not (tooLong token maxTokenLen)
363− then token
364− else ""
363+ then Just {value: token}
364+ else Nothing {}
365365
366366verifySecret = \token secret ->
367367 secret != "" && safeCompare token secret
368368
369369verifyFederationAuth = \authorization ->
370− verifySecret (extractToken authorization) federationSecret
370+ case extractToken authorization of
371+ Nothing {} -> False {}
372+ Just {value: token} -> verifySecret token federationSecret
371373
372374verifyMaintenanceAuth = \authorization ->
373− let token = extractToken authorization in
374− verifySecret token federationSecret || verifySecret token maintenanceSecret
375+ case extractToken authorization of
376+ Nothing {} -> False {}
377+ Just {value: token} -> verifySecret token federationSecret || verifySecret token maintenanceSecret
375378
376379clampTtl = clamp 1 maxPresenceTtl
377380
@@ -435,17 +438,7 @@ safeCompare = \a b ->
435438 safeCompareLoop a b maxTokenLen 0 + (if a == "" then 1 else 0) + (if b == "" then 1 else 0) == 0
436439
437440evictOneOldest = \items getKey ->
438− let oldest = fold (\acc x -> let k = getKey x in Just {value: case acc of
439− Nothing {} -> k
440− Just {value: v} -> min k v
441− }) Nothing {} items in
442− case oldest of
443− Nothing {} -> items
444− Just {value: oldestKey} ->
445− (fold (\acc x ->
446− if not acc.removed && getKey x == oldestKey
447− then {removed: True {}, items: acc.items}
448− else {removed: acc.removed, items: union acc.items [x]}) {removed: False {}, items: []} items).items
441+ diff items (boundedSmallest items 1 getKey)
449442
450443capPerKey = \items matchKey maxPerKey getExpiry t ->
451444 let active = do x <- items; where getExpiry x > t; yield x in
@@ -638,8 +631,8 @@ rejectFederation = \t respond -> do
638631 maybePruneAndBroadcast t
639632 yield (respond {ok: False {}})
640633
641−withFederationAuth = \authorization t respond extraCheck action ->
642− if not (verifyFederationAuth authorization) || extraCheck
634+withFederationAuth = \authorization t respond precondition action ->
635+ if not (verifyFederationAuth authorization) || not precondition
643636 then rejectFederation t respond
644637 else action
645638
@@ -647,6 +640,15 @@ maybePruneAndBroadcast = \t -> do
647640 pruneResult <- atomic do maybePrune t
648641 forkBroadcastOffline t pruneResult
649642
643+withSessionAuth = \authorization t onUnauth onAuth -> do
644+ sessions <- *sessions
645+ case extractToken authorization of
646+ Nothing {} -> onUnauth
647+ Just {value: token} ->
648+ case authenticateSession sessions token t of
649+ Unauthorized {} -> onUnauth
650+ Authorized {pubkey} -> onAuth pubkey
651+
650652removeForward = \mid srv -> atomic do
651653 forwards <- *forwards
652654 set *forwards = do
@@ -842,8 +844,9 @@ serve = \req -> case req of
842844 t <- now
843845 let clampedTimeout = clamp 0 maxPollTimeout timeout
844846 let deadline = t + clampedTimeout
845− let token = extractToken authorization
846− result <- pollLoop token cursor deadline
847+ result <- case extractToken authorization of
848+ Nothing {} -> yield (PollUnauthorized {})
849+ Just {value: token} -> pollLoop token cursor deadline
847850 tAfterPoll <- now
848851 maybePruneAndBroadcast tAfterPoll
849852 yield (respond (case result of
@@ -856,12 +859,9 @@ serve = \req -> case req of
856859 let clampedTs = clampTimestamp timestamp t
857860 result <- atomic do
858861 pr <- maybePrune t
859− sessions <- *sessions
860− let auth = authenticateSession sessions (extractToken authorization) t
861− case auth of
862− Unauthorized {} ->
863− yield {pr: pr, send: SendFailed {status: MsUnauthorized {}}}
864− Authorized {pubkey: fromKey} -> do
862+ withSessionAuth authorization t
863+ (yield {pr: pr, send: SendFailed {status: MsUnauthorized {}}})
864+ (\fromKey -> do
865865 messages <- *messages
866866 if countMessagesFor messages to t >= maxMessagesPerRecipient
867867 then yield {pr: pr, send: SendFailed {status: MsRejected {}}}
@@ -885,7 +885,7 @@ serve = \req -> case req of
885885 set *forwards = if shouldForward
886886 then union forwards (do s <- forwardServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})
887887 else forwards
888− yield {pr: pr, send: SendDone {delivery: delivery, remoteServers: remoteServers, forwardServers: forwardServers, fromKey: fromKey}}
888+ yield {pr: pr, send: SendDone {delivery: delivery, remoteServers: remoteServers, forwardServers: forwardServers, fromKey: fromKey}})
889889 case result.send of
890890 SendDone {delivery, remoteServers, forwardServers, fromKey} ->
891891 fork (do
@@ -897,9 +897,8 @@ serve = \req -> case req of
897897 authorization: federationAuth})
898898 when (any forwardServers (\s -> s == server))
899899 (whenOk fwdResult (removeForward msgId server)))
900− case delivery of
901− DsQueued {} -> println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
902− _ -> yield {})
900+ when (case delivery of DsQueued {} -> True {}; _ -> False {})
901+ (println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")))
903902 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
904903 _ -> forkBroadcastOffline t result.pr
905904 yield (case result.send of
@@ -911,12 +910,9 @@ serve = \req -> case req of
911910 let dedupedIds = dedupMessageIds messageIds
912911 result <- atomic do
913912 pr <- maybePrune t
914− sessions <- *sessions
915− let auth = authenticateSession sessions (extractToken authorization) t
916− case auth of
917− Unauthorized {} ->
918− yield {pr: pr, ack: AckUnauthorized {}}
919− Authorized {pubkey} -> do
913+ withSessionAuth authorization t
914+ (yield {pr: pr, ack: AckUnauthorized {}})
915+ (\pubkey -> do
920916 messages <- *messages
921917 let ackedMessages = do
922918 m <- messages
@@ -933,7 +929,7 @@ serve = \req -> case req of
933929 let evictedEntries = let excessCount = count combinedAckedIds - maxAckedIds in
934930 if excessCount <= 0 then [] else boundedSmallest combinedAckedIds excessCount (\a -> a.ackedAt)
935931 set *ackedIds = diff combinedAckedIds evictedEntries
936− yield {pr: pr, ack: AckDone {pendingAcks: ackedFederated, evictedEntries: evictedEntries}}
932+ yield {pr: pr, ack: AckDone {pendingAcks: ackedFederated, evictedEntries: evictedEntries}})
937933 fork (do
938934 case result.ack of
939935 AckDone {pendingAcks, evictedEntries} ->
@@ -948,12 +944,9 @@ serve = \req -> case req of
948944 t <- now
949945 result <- atomic do
950946 pr <- maybePrune t
951− sessions <- *sessions
952− let auth = authenticateSession sessions (extractToken authorization) t
953− case auth of
954− Unauthorized {} ->
955− yield {pr: pr, server: "", authorized: False {}}
956− Authorized _ -> do
947+ withSessionAuth authorization t
948+ (yield {pr: pr, server: "", authorized: False {}})
949+ (\_ -> do
957950 presence <- *presence
958951 let valid = do
959952 p <- presence
@@ -964,14 +957,14 @@ serve = \req -> case req of
964957 let bestRemote = maxBy remoteValid (\p -> p.expiresAt)
965958 let foundServer = if localOnline then serverHostN
966959 else case bestRemote of Just {value: p} -> p.server; Nothing {} -> ""
967− yield {pr: pr, server: foundServer, authorized: True {}}
960+ yield {pr: pr, server: foundServer, authorized: True {}})
968961 forkBroadcastOffline t result.pr
969962 yield (respond {server: result.server, authorized: result.authorized})
970963
971964 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
972965 t <- now
973966 let cappedHops = clamp 0 maxGossipHops hopsRemaining
974− withFederationAuth authorization t respond (cappedHops < 1 || isLocalServer fromServer || count events > maxGossipEvents) (do
967+ withFederationAuth authorization t respond (cappedHops >= 1 && not (isLocalServer fromServer) && count events <= maxGossipEvents) (do
975968 let validated = validGossipEvents events t
976969 let onlineEntries = validated.online
977970 let trustedOffline = do e <- validated.offline; where e.server == fromServer; yield e
@@ -999,7 +992,7 @@ serve = \req -> case req of
999992
1000993 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
1001994 t <- now
1002− withFederationAuth authorization t respond (isLocalServer originServer) (do
995+ withFederationAuth authorization t respond (not (isLocalServer originServer)) (do
1003996 let clampedTs = clampTimestamp timestamp t
1004997 result <- atomic do
1005998 pr <- maybePrune t
@@ -1020,12 +1013,11 @@ serve = \req -> case req of
10201013 forkBroadcastOffline t result.pr
10211014 yield (respond {ok: case result.forward of
10221015 ForwardRejected {} -> False {}
1023− ForwardDuplicate {} -> True {}
1024− ForwardStored {} -> True {}}))
1016+ _ -> True {}}))
10251017
10261018 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
10271019 t <- now
1028− withFederationAuth authorization t respond (not (isLocalServer originServer) || isLocalServer fromServer) (do
1020+ withFederationAuth authorization t respond (isLocalServer originServer && not (isLocalServer fromServer)) (do
10291021 let dedupedIds = dedupMessageIds messageIds
10301022 pruneResult <- atomic do
10311023 pr <- maybePrune t