@@ -506,10 +506,8 @@ countMessagesFor = \messages toKey t ->
506validGossipEvents : [GossipEvent] -> Timestamp -> [ValidGossipEntry]
506validGossipEvents : [GossipEvent] -> Timestamp -> [ValidGossipEntry]
507validGossipEvents = \events t -> do
507validGossipEvents = \events t -> do
508 e <- events
508 e <- events
509− where not (tooLong e.pubkey maxPubkeyLen)
509+ where isValidHex e.pubkey && not (tooLong e.pubkey maxPubkeyLen)
510− where not (tooLong e.server maxServerNameLen)
510+ where not (tooLong e.server maxServerNameLen) && not (isBadServerName e.server)
511− where not (isBadServerName e.server)
512− where isValidHex e.pubkey
513 let server = normalizeServerName e.server
511 let server = normalizeServerName e.server
514 where not (server == serverHostN)
512 where not (server == serverHostN)
515 where e.timestamp <= t + clockSkewTolerance
513 where e.timestamp <= t + clockSkewTolerance
@@ -590,12 +588,12 @@ sendBatchedGossip : [Text] -> [GossipEvent] -> IO {network} {}
590sendBatchedGossip = \peerServers allEvents ->
588sendBatchedGossip = \peerServers allEvents ->
591 sendToEach peerServers (\server -> sendBatchedGossipToServer server allEvents)
589 sendToEach peerServers (\server -> sendBatchedGossipToServer server allEvents)
593−broadcastOfflineGossip = \t peerServers expiredLocal -> do
591+broadcastOfflineGossip = \t peerServers expiredLocal ->
592+ when (federationEnabled && count peerServers > 0 && count expiredLocal > 0) (do
594− let expiredEntries = mergeByKey (\a b -> a.pubkey == b.pubkey) [] (do
593+ let expiredEntries = mergeByKey (\a b -> a.pubkey == b.pubkey) [] (do
595− p <- expiredLocal
594+ p <- expiredLocal
596− let ttl = clamp offlineGossipMinTtl maxPresenceTtl ((p.expiresAt - p.timestamp) / 1000)
595+ let ttl = clamp offlineGossipMinTtl maxPresenceTtl ((p.expiresAt - p.timestamp) / 1000)
597− yield {pubkey: p.pubkey, ttl: ttl, expiresAt: p.expiresAt})
596+ yield {pubkey: p.pubkey, ttl: ttl, expiresAt: p.expiresAt})
598− when (federationEnabled && count expiredEntries > 0 && count peerServers > 0) (do
599 let gossipEvents = do
597 let gossipEvents = do
600 e <- expiredEntries
598 e <- expiredEntries
601 yield {eventType: "offline", pubkey: e.pubkey, server: serverHostN, timestamp: e.expiresAt, ttl: e.ttl}
599 yield {eventType: "offline", pubkey: e.pubkey, server: serverHostN, timestamp: e.expiresAt, ttl: e.ttl}
@@ -767,20 +765,18 @@ serve = \req -> case req of
767 then collectPeerServers updatedPresence (\p -> p.server)
765 then collectPeerServers updatedPresence (\p -> p.server)
769 yield {pr: pr, verify: VerifyOk {peerServers: peerServers}}
767 yield {pr: pr, verify: VerifyOk {peerServers: peerServers}}
771− case result.verify of
768+ fork (case result.verify of
772− VerifyOk {peerServers} ->
769+ VerifyOk {peerServers} -> do
773− when federationEnabled
770+ when federationEnabled
774− (sendToEach peerServers (\server -> do
771+ (sendToEach peerServers (\server -> do
775− _ <- fetch (federationScheme ++ server) (RecvGossip {
772+ _ <- fetch (federationScheme ++ server) (RecvGossip {
776− authorization: "Bearer " ++ federationSecret,
773+ authorization: "Bearer " ++ federationSecret,
777− events: [{eventType: "online", pubkey: pubkey, server: serverHostN, timestamp: t, ttl: onlineGossipTtl}], hopsRemaining: 2, fromServer: serverHostN})
774+ events: [{eventType: "online", pubkey: pubkey, server: serverHostN, timestamp: t, ttl: onlineGossipTtl}], hopsRemaining: 2, fromServer: serverHostN})
778− yield {}))
775+ yield {}))
779− _ -> yield {}
776+ broadcastOfflineGossip t result.pr.peerServers
780− let expiredLocal = case result.verify of
781− VerifyOk _ -> do p <- result.pr.expiredLocal; where not (p.pubkey == pubkey); yield p
777+ (do p <- result.pr.expiredLocal; where not (p.pubkey == pubkey); yield p)
782− _ -> result.pr.expiredLocal
778+ _ ->
783− broadcastOfflineGossip t result.pr.peerServers expiredLocal)
779+ broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
784 yield (case result.verify of
780 yield (case result.verify of
785 VerifyFailed _ -> respond {token: "", expiresAt: 0}
781 VerifyFailed _ -> respond {token: "", expiresAt: 0}
786 VerifyOk _ -> respond {token: token, expiresAt: expiry})
782 VerifyOk _ -> respond {token: token, expiresAt: expiry})
@@ -800,13 +796,14 @@ serve = \req -> case req of
800 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
796 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
801 let to = normalizeHex to
797 let to = normalizeHex to
802 let encryptedBlob = normalizeHex encryptedBlob
798 let encryptedBlob = normalizeHex encryptedBlob
799+ let token = extractToken authorization
804 msgId <- genToken
801 msgId <- genToken
805 let clampedTs = clampTimestamp timestamp t
802 let clampedTs = clampTimestamp timestamp t
806 result <- atomic do
803 result <- atomic do
807 pr <- maybePrune t
804 pr <- maybePrune t
808 sessions <- *sessions
805 sessions <- *sessions
809− let auth = authenticateSession sessions (extractToken authorization) t
806+ let auth = authenticateSession sessions token t
810 case auth of
807 case auth of
811 Unauthorized {} ->
808 Unauthorized {} ->
812 yield {pr: pr, send: SendUnauthorized {}}
809 yield {pr: pr, send: SendUnauthorized {}}
@@ -855,12 +852,13 @@ serve = \req -> case req of
855 SendDone {status} -> respond {status: status, messageId: msgId})
852 SendDone {status} -> respond {status: status, messageId: msgId})
857 AckMessages {messageIds, authorization, respond} -> do
854 AckMessages {messageIds, authorization, respond} -> do
855+ let token = extractToken authorization
859 let dedupedIds = dedupMessageIds messageIds
857 let dedupedIds = dedupMessageIds messageIds
860 result <- atomic do
858 result <- atomic do
861 pr <- maybePrune t
859 pr <- maybePrune t
862 sessions <- *sessions
860 sessions <- *sessions
863− let auth = authenticateSession sessions (extractToken authorization) t
861+ let auth = authenticateSession sessions token t
864 case auth of
862 case auth of
865 Unauthorized {} ->
863 Unauthorized {} ->
866 yield {pr: pr, ack: AckUnauthorized {}}
864 yield {pr: pr, ack: AckUnauthorized {}}
@@ -888,35 +886,36 @@ serve = \req -> case req of
888 yield {pr: pr, ack: AckDone {pendingAcks: ackedFederated, evictedEntries: evictedEntries}}
886 yield {pr: pr, ack: AckDone {pendingAcks: ackedFederated, evictedEntries: evictedEntries}}
890 case result.ack of
888 case result.ack of
891− AckDone {pendingAcks, evictedEntries} -> do
889+ AckDone {pendingAcks, evictedEntries} ->
890+ when federationEnabled (do
892− let originServers = collectPeerServers pendingAcks (\a -> a.originServer)
891+ let originServers = collectPeerServers pendingAcks (\a -> a.originServer)
893− when (count originServers > 0 && federationEnabled)
892+ when (count originServers > 0)
894− (sendAcksAndClean pendingAcks originServers)
893+ (sendAcksAndClean pendingAcks originServers)
895− let evictedToRetry = do
894+ let evictedToRetry = do
896− a <- evictedEntries
895+ a <- evictedEntries
897− where none pendingAcks (\a2 -> a2.messageId == a.messageId && a2.toKey == a.toKey)
896+ where none pendingAcks (\a2 -> a2.messageId == a.messageId && a2.toKey == a.toKey)
899− when (count evictedToRetry > 0 && federationEnabled) (do
898+ when (count evictedToRetry > 0) (do
900− let evictedOriginServers = collectPeerServers evictedToRetry (\a -> a.originServer)
899+ let evictedOriginServers = collectPeerServers evictedToRetry (\a -> a.originServer)
901− sendToEach evictedOriginServers (\server -> do
900+ sendToEach evictedOriginServers (\server -> do
902− fetchResult <- fetch (federationScheme ++ server) (FederationAck {
901+ fetchResult <- fetch (federationScheme ++ server) (FederationAck {
903− authorization: "Bearer " ++ federationSecret,
902+ authorization: "Bearer " ++ federationSecret,
904− messageIds: (do a <- evictedToRetry; where a.originServer == server; yield a.messageId),
903+ messageIds: (do a <- evictedToRetry; where a.originServer == server; yield a.messageId),
905− originServer: server, fromServer: serverHostN})
904+ originServer: server, fromServer: serverHostN})
906− case fetchResult of
905+ case fetchResult of
907− Err _ -> do
906+ Err _ -> do
908− dropped <- atomic do
907+ dropped <- atomic do
909− ackedIds <- *ackedIds
908+ ackedIds <- *ackedIds
910− let reinsert = do a <- evictedToRetry; where a.originServer == server; yield a
909+ let reinsert = do a <- evictedToRetry; where a.originServer == server; yield a
911− let combined = union ackedIds reinsert
910+ let combined = union ackedIds reinsert
912− let excess = count combined - maxAckedIds
911+ let excess = count combined - maxAckedIds
913− let afterEviction = if excess <= 0 then combined
912+ let afterEviction = if excess <= 0 then combined
914− else evictOldestAckedIds combined excess
913+ else evictOldestAckedIds combined excess
915− set *ackedIds = afterEviction
914+ set *ackedIds = afterEviction
916− yield excess
915+ yield excess
917− when (dropped > 0)
916+ when (dropped > 0)
918− (println ("ackMessages: ackedIds at capacity (" ++ show maxAckedIds ++ "), " ++ show dropped ++ " ack entries permanently lost for " ++ server))
917+ (println ("ackMessages: ackedIds at capacity (" ++ show maxAckedIds ++ "), " ++ show dropped ++ " ack entries permanently lost for " ++ server))
919− _ -> yield {}))
918+ _ -> yield {})))
920 _ -> yield {}
919 _ -> yield {}
921 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
920 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
922 yield (case result.ack of
921 yield (case result.ack of
@@ -925,11 +924,12 @@ serve = \req -> case req of
926 LookupPresence {pubkey, authorization, respond} -> do
925 LookupPresence {pubkey, authorization, respond} -> do
927 let pubkey = normalizeHex pubkey
926 let pubkey = normalizeHex pubkey
927+ let token = extractToken authorization
929 result <- atomic do
929 result <- atomic do
930 pr <- maybePrune t
930 pr <- maybePrune t
931 sessions <- *sessions
931 sessions <- *sessions
932− let auth = authenticateSession sessions (extractToken authorization) t
932+ let auth = authenticateSession sessions token t
933 case auth of
933 case auth of
934 Unauthorized {} ->
934 Unauthorized {} ->
935 yield {pr: pr, lookup: LookupUnauthorized {}}
935 yield {pr: pr, lookup: LookupUnauthorized {}}
@@ -953,7 +953,7 @@ serve = \req -> case req of
953 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
953 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
955 let authorized = verifyFederationAuth authorization
955 let authorized = verifyFederationAuth authorization
956− let cappedHops = if hopsRemaining > 5 then 5 else hopsRemaining
956+ let cappedHops = clamp 0 5 hopsRemaining
957 let fromServer = normalizeServerName fromServer
957 let fromServer = normalizeServerName fromServer
958 if not authorized || cappedHops < 1 || fromServer == serverHostN || count events > maxGossipEvents
958 if not authorized || cappedHops < 1 || fromServer == serverHostN || count events > maxGossipEvents