@@ -40,10 +40,16 @@ maxForwardRetriesPerServer = 100
41-- ============================================
41-- ============================================
43−type PollEvent = {id: Text, eventType: Text, payload: Text}
43+type PollEvent = {id: Text, eventType: Text, payload: {encryptedBlob: Text, fromKey: Text, timestamp: Int, toKey: Text}}
45type GossipEvent = {eventType: Text, pubkey: Text, server: Text, timestamp: Int, ttl: Int}
45type GossipEvent = {eventType: Text, pubkey: Text, server: Text, timestamp: Int, ttl: Int}
47+type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen)
48+type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen)
49+type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen)
50+type MessageIdHex = Text where \s -> isValidHex s && not (tooLong s maxMessageIdLen)
51+type ServerName = Text where \s -> not (tooLong s maxServerNameLen) && not (isBadServerName s)
47-- ============================================
53-- ============================================
48-- Persisted State
54-- Persisted State
49-- ============================================
55-- ============================================
@@ -70,10 +76,10 @@ type GossipEvent = {eventType: Text, pubkey: Text, server: Text, timestamp: Int,
71route AuthApi where
77route AuthApi where
73− POST {pubkey: Text} /challenge
79+ POST {pubkey: PubkeyHex} /challenge
74 -> {challenge: Text}
80 -> {challenge: Text}
75 = ReqChallenge
81 = ReqChallenge
76− POST {pubkey: Text, challenge: Text, signature: Text} /verify
82+ POST {pubkey: PubkeyHex, challenge: Text, signature: SignatureHex} /verify
77 -> {token: Text, expiresAt: Int}
83 -> {token: Text, expiresAt: Int}
78 = VerifyAuth
84 = VerifyAuth
@@ -82,25 +88,25 @@ route ClientApi where
82 -> {events: [PollEvent], cursor: Int, authorized: Bool}
88 -> {events: [PollEvent], cursor: Int, authorized: Bool}
85− POST {to: Text, encryptedBlob: Text, timestamp: Int} / headers {authorization: Text}
91+ POST {to: PubkeyHex, encryptedBlob: BlobHex, timestamp: Int} / headers {authorization: Text}
86 -> {status: Text, messageId: Text}
92 -> {status: Text, messageId: Text}
87 = SendMessage
93 = SendMessage
88− POST {messageIds: [Text]} /ack headers {authorization: Text}
94+ POST {messageIds: [MessageIdHex]} /ack headers {authorization: Text}
89 -> {ok: Bool}
95 -> {ok: Bool}
90 = AckMessages
96 = AckMessages
91− GET /lookup/{pubkey: Text} headers {authorization: Text}
97+ GET /lookup/{pubkey: PubkeyHex} headers {authorization: Text}
92 -> {online: Bool, server: Text, authorized: Bool}
98 -> {online: Bool, server: Text, authorized: Bool}
93 = LookupPresence
99 = LookupPresence
95route FederationApi where
101route FederationApi where
96 /federation
102 /federation
97− POST {events: [GossipEvent], hopsRemaining: Int, fromServer: Text} /gossip headers {authorization: Text}
103+ POST {events: [GossipEvent], hopsRemaining: Int, fromServer: ServerName} /gossip headers {authorization: Text}
98 -> {ok: Bool}
104 -> {ok: Bool}
99 = RecvGossip
105 = RecvGossip
100− POST {toKey: Text, fromKey: Text, encryptedBlob: Text, timestamp: Int, originServer: Text, messageId: Text} /forward headers {authorization: Text}
106+ POST {toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Int, originServer: ServerName, messageId: MessageIdHex} /forward headers {authorization: Text}
101 -> {ok: Bool}
107 -> {ok: Bool}
102 = ForwardMessage
108 = ForwardMessage
103− POST {messageIds: [Text], originServer: Text, fromServer: Text} /ack headers {authorization: Text}
109+ POST {messageIds: [Text], originServer: Text, fromServer: ServerName} /ack headers {authorization: Text}
104 -> {ok: Bool}
110 -> {ok: Bool}
105 = FederationAck
111 = FederationAck
@@ -563,6 +569,7 @@ sendAcksAndClean = \pendingAcks servers ->
564 sendAcksAndClean pendingAcks rest
570 sendAcksAndClean pendingAcks rest
572+pollOnce : Text -> Int -> IO {clock} {authorized: Bool, cursor: Int, events: [PollEvent]}
566pollOnce = \token cursor -> do
573pollOnce = \token cursor -> do
568 atomic do
575 atomic do
@@ -604,16 +611,16 @@ pollOnce = \token cursor -> do
604 let evts = do
611 let evts = do
605 m <- limitedMsgs
612 m <- limitedMsgs
606 yield {id: m.messageId, eventType: "message",
613 yield {id: m.messageId, eventType: "message",
607− payload: toJson {toKey: m.toKey, fromKey: m.fromKey,
614+ payload: {toKey: m.toKey, fromKey: m.fromKey,
608− encryptedBlob: m.encryptedBlob,
615+ encryptedBlob: m.encryptedBlob,
609− timestamp: m.timestamp}}
616+ timestamp: m.timestamp}}
610 let lastReceivedAt = fold (\acc m -> if m.receivedAt > acc then m.receivedAt else acc) clampedCursor limitedMsgs
617 let lastReceivedAt = fold (\acc m -> if m.receivedAt > acc then m.receivedAt else acc) clampedCursor limitedMsgs
611 let newCursor = case session of
618 let newCursor = case session of
612 Nothing {} -> -1
619 Nothing {} -> -1
613 _ -> lastReceivedAt
620 _ -> lastReceivedAt
614 yield {events: evts, cursor: newCursor, authorized: authorized}
621 yield {events: evts, cursor: newCursor, authorized: authorized}
616−pollLoop : Text -> Int -> Int -> IO {clock} {authorized: Bool, cursor: Int, events: [{eventType: Text, id: Text, payload: Text}]}
623+pollLoop : Text -> Int -> Int -> IO {clock} {authorized: Bool, cursor: Int, events: [PollEvent]}
617pollLoop = \token cursor deadline -> do
624pollLoop = \token cursor deadline -> do
618 result <- pollOnce token cursor
625 result <- pollOnce token cursor
@@ -632,45 +639,41 @@ pollLoop = \token cursor deadline -> do
632serve = \req -> case req of
639serve = \req -> case req of
634 ReqChallenge {pubkey, respond} -> do
641 ReqChallenge {pubkey, respond} -> do
635− let valid = not (pubkey == "") && not (tooLong pubkey maxPubkeyLen) && isValidHex pubkey
636− let pubkey = if isValidHex pubkey then normalizeHex pubkey else pubkey
642+ let pubkey = normalizeHex pubkey
637 challenge <- genToken
643 challenge <- genToken
641− pruneResult <- atomic do
645+ pruneResult <- atomic do
642− pr <- maybePrune t
646+ pr <- maybePrune t
643− challenges <- *challenges
647+ challenges <- *challenges
644− let existingCount = count (do c <- challenges; where c.pubkey == pubkey; where c.expiresAt > t; yield c)
648+ let existingCount = count (do c <- challenges; where c.pubkey == pubkey; where c.expiresAt > t; yield c)
645− let oldestChallengeExpiry = fold (\acc c2 -> if c2.pubkey == pubkey && c2.expiresAt > t && (acc == -1 || c2.expiresAt < acc) then c2.expiresAt else acc) (-1) challenges
649+ let oldestChallengeExpiry = fold (\acc c2 -> if c2.pubkey == pubkey && c2.expiresAt > t && (acc == -1 || c2.expiresAt < acc) then c2.expiresAt else acc) (-1) challenges
646− let cappedChallenges = if existingCount >= maxChallengesPerKey && oldestChallengeExpiry >= 0
650+ let cappedChallenges = if existingCount >= maxChallengesPerKey && oldestChallengeExpiry >= 0
647− then fold (\acc c ->
651+ then fold (\acc c ->
648− if not acc.removed && c.pubkey == pubkey && c.expiresAt == oldestChallengeExpiry
652+ if not acc.removed && c.pubkey == pubkey && c.expiresAt == oldestChallengeExpiry
649− then {removed: True {}, items: acc.items}
653+ then {removed: True {}, items: acc.items}
650− else {removed: acc.removed, items: union acc.items [c]}) {removed: False {}, items: []} challenges
654+ else {removed: acc.removed, items: union acc.items [c]}) {removed: False {}, items: []} challenges
651− else {removed: False {}, items: challenges}
655+ else {removed: False {}, items: challenges}
652− let withoutExpired = if count cappedChallenges.items >= maxChallenges
656+ let withoutExpired = if count cappedChallenges.items >= maxChallenges
653− then do c <- cappedChallenges.items; where c.expiresAt > t; yield c
657+ then do c <- cappedChallenges.items; where c.expiresAt > t; yield c
654− else cappedChallenges.items
658+ else cappedChallenges.items
655− let globalOldestExpiry = if count withoutExpired >= maxChallenges
659+ let globalOldestExpiry = if count withoutExpired >= maxChallenges
656− then fold (\acc c -> if acc == -1 || c.expiresAt < acc then c.expiresAt else acc) (-1) withoutExpired
660+ then fold (\acc c -> if acc == -1 || c.expiresAt < acc then c.expiresAt else acc) (-1) withoutExpired
658− let globalCapped = if globalOldestExpiry >= 0
662+ let globalCapped = if globalOldestExpiry >= 0
659− then (fold (\acc c ->
663+ then (fold (\acc c ->
660− if not acc.removed && c.expiresAt == globalOldestExpiry
664+ if not acc.removed && c.expiresAt == globalOldestExpiry
661− then {removed: True {}, items: acc.items}
665+ then {removed: True {}, items: acc.items}
662− else {removed: acc.removed, items: union acc.items [c]}) {removed: False {}, items: []} withoutExpired).items
666+ else {removed: acc.removed, items: union acc.items [c]}) {removed: False {}, items: []} withoutExpired).items
663− else withoutExpired
667+ else withoutExpired
664− set *challenges = union
668+ set *challenges = union
665− globalCapped
669+ globalCapped
666− [{pubkey: pubkey, challenge: challenge, expiresAt: t + challengeExpiry}]
670+ [{pubkey: pubkey, challenge: challenge, expiresAt: t + challengeExpiry}]
667− yield pr
671+ yield pr
668− fork (broadcastOfflineGossip t pruneResult.peerServers pruneResult.expiredLocal)
672+ fork (broadcastOfflineGossip t pruneResult.peerServers pruneResult.expiredLocal)
669− yield (respond {challenge: challenge})
673+ yield (respond {challenge: challenge})
670− else yield (respond {challenge: ""})
672 VerifyAuth {pubkey, challenge, signature, respond} -> do
675 VerifyAuth {pubkey, challenge, signature, respond} -> do
673− let pubkey = if isValidHex pubkey then normalizeHex pubkey else pubkey
676+ let pubkey = normalizeHex pubkey
675 token <- genToken
678 token <- genToken
676 let expiry = t + sessionExpiry
679 let expiry = t + sessionExpiry
@@ -687,11 +690,7 @@ serve = \req -> case req of
688 let sigValid = case matched of
691 let sigValid = case matched of
689 Nothing {} -> False {}
692 Nothing {} -> False {}
690− _ -> if tooLong signature maxSignatureLen
692− else if not (isValidHex pubkey) || not (isValidHex signature)
694− else verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
693+ _ -> verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
695 set *challenges = if sigValid
694 set *challenges = if sigValid
696 then case matched of
695 then case matched of
697 Just {value: _} -> do
696 Just {value: _} -> do
@@ -780,9 +779,8 @@ serve = \req -> case req of
780 yield (respond {events: result.events, cursor: result.cursor, authorized: result.authorized})
779 yield (respond {events: result.events, cursor: result.cursor, authorized: result.authorized})
782 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
781 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
783− let validInput = not (to == "") && not (encryptedBlob == "") && not (tooLong to maxPubkeyLen) && not (tooLong encryptedBlob maxBlobLen) && isValidHex to && isValidHex encryptedBlob
784− let to = if isValidHex to then normalizeHex to else to
782+ let to = normalizeHex to
785− let encryptedBlob = if isValidHex encryptedBlob then normalizeHex encryptedBlob else encryptedBlob
783+ let encryptedBlob = normalizeHex encryptedBlob
787 msgId <- genToken
785 msgId <- genToken
788 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t - messageMaxAge else timestamp
786 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t - messageMaxAge else timestamp
@@ -801,11 +799,11 @@ serve = \req -> case req of
802 let shouldInsert = case session of
800 let shouldInsert = case session of
803 Nothing {} -> False {}
801 Nothing {} -> False {}
804− Just {value: _} -> validInput && recipientMsgCount < maxMessagesPerRecipient
802+ Just {value: _} -> recipientMsgCount < maxMessagesPerRecipient
805 set *seqCounter = if shouldInsert then seqTs else seqCounter
803 set *seqCounter = if shouldInsert then seqTs else seqCounter
806 set *messages = case session of
804 set *messages = case session of
807 Nothing {} -> messages
805 Nothing {} -> messages
808− Just {value: s} -> if validInput && recipientMsgCount < maxMessagesPerRecipient
806+ Just {value: s} -> if recipientMsgCount < maxMessagesPerRecipient
809 then union messages
807 then union messages
810 [{messageId: msgId, toKey: to, fromKey: s.pubkey,
808 [{messageId: msgId, toKey: to, fromKey: s.pubkey,
811 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: seqTs}]
809 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: seqTs}]
@@ -831,8 +829,7 @@ serve = \req -> case req of
831 Just {value: s} -> s.pubkey
829 Just {value: s} -> s.pubkey
832 let status = case session of
830 let status = case session of
833 Nothing {} -> "unauthorized"
831 Nothing {} -> "unauthorized"
834− _ -> if not validInput then "invalid"
835− else if recipientMsgCount >= maxMessagesPerRecipient then "rejected"
832+ _ -> if recipientMsgCount >= maxMessagesPerRecipient then "rejected"
836 else if localOnline then "delivered"
833 else if localOnline then "delivered"
837 else if count remoteServers > 0 then "federated"
834 else if count remoteServers > 0 then "federated"
838 else "queued"
835 else "queued"
@@ -848,7 +845,7 @@ serve = \req -> case req of
848 yield {status: status, remoteServers: remoteServers, fromKey: fromKey, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, forwardsAtCapacity: forwardsAtCapacity}
845 yield {status: status, remoteServers: remoteServers, fromKey: fromKey, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, forwardsAtCapacity: forwardsAtCapacity}
849 let finalStatus = if result.status == "federated" && (federationSecret == "" || result.forwardsAtCapacity) then "queued" else result.status
846 let finalStatus = if result.status == "federated" && (federationSecret == "" || result.forwardsAtCapacity) then "queued" else result.status
851− if count result.remoteServers > 0 && not (result.status == "unauthorized") && not (result.status == "invalid") && not (result.status == "rejected") && not (federationSecret == "")
848+ if count result.remoteServers > 0 && not (result.status == "unauthorized") && not (result.status == "rejected") && not (federationSecret == "")
852 then sendToEach result.remoteServers (\server -> do
849 then sendToEach result.remoteServers (\server -> do
853 fwdResult <- fetch (federationScheme ++ server) (ForwardMessage {
850 fwdResult <- fetch (federationScheme ++ server) (ForwardMessage {
854 toKey: to, fromKey: result.fromKey, encryptedBlob: encryptedBlob,
851 toKey: to, fromKey: result.fromKey, encryptedBlob: encryptedBlob,
@@ -864,21 +861,19 @@ serve = \req -> case req of
864 Err _ -> yield {}
861 Err _ -> yield {}
866 else yield {}
863 else yield {}
867− if result.forwardsAtCapacity && count result.remoteServers > 0 && not (result.status == "unauthorized") && not (result.status == "invalid") && not (result.status == "rejected")
864+ if result.forwardsAtCapacity && count result.remoteServers > 0 && not (result.status == "unauthorized") && not (result.status == "rejected")
868 then println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
865 then println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
869 else yield {}
866 else yield {}
870 broadcastOfflineGossip t result.peerServers result.expiredLocal)
867 broadcastOfflineGossip t result.peerServers result.expiredLocal)
871− yield (respond {status: finalStatus, messageId: (if result.status == "unauthorized" then "" else if result.status == "invalid" then "" else if result.status == "rejected" then "" else msgId)})
868+ yield (respond {status: finalStatus, messageId: (if result.status == "unauthorized" then "" else if result.status == "rejected" then "" else msgId)})
873 AckMessages {messageIds, authorization, respond} -> do
870 AckMessages {messageIds, authorization, respond} -> do
875 let dedupedIds = fold (\acc mid ->
872 let dedupedIds = fold (\acc mid ->
876− if mid == "" then acc
873+ let nmid = normalizeHex mid in
877− else if count acc >= maxMessageIds then acc
874+ if count acc >= maxMessageIds then acc
878− else if tooLong mid maxMessageIdLen then acc
879− else if not (isValidHex mid) then acc
880− else if count (do a <- acc; where a == normalizeHex mid; yield a) > 0 then acc
875+ else if count (do a <- acc; where a == nmid; yield a) > 0 then acc
881− else union acc [normalizeHex mid]) [] messageIds
876+ else union acc [nmid]) [] messageIds
882 result <- atomic do
877 result <- atomic do
883 pr <- maybePrune t
878 pr <- maybePrune t
884 sessions <- *sessions
879 sessions <- *sessions
@@ -966,8 +961,7 @@ serve = \req -> case req of
966 yield (respond {ok: result.ok})
961 yield (respond {ok: result.ok})
968 LookupPresence {pubkey, authorization, respond} -> do
963 LookupPresence {pubkey, authorization, respond} -> do
969− let validPubkey = not (pubkey == "") && not (tooLong pubkey maxPubkeyLen) && isValidHex pubkey
970− let pubkey = if isValidHex pubkey then normalizeHex pubkey else pubkey
964+ let pubkey = normalizeHex pubkey
972 result <- atomic do
966 result <- atomic do
973 pr <- maybePrune t
967 pr <- maybePrune t
@@ -977,7 +971,7 @@ serve = \req -> case req of
977 let authorized = case session of
971 let authorized = case session of
978 Nothing {} -> False {}
972 Nothing {} -> False {}
979 _ -> True {}
973 _ -> True {}
980− let valid = if not validPubkey then [] else do
974+ let valid = do
981 p <- presence
975 p <- presence
982 where p.pubkey == pubkey
976 where p.pubkey == pubkey
983 where p.expiresAt > t
977 where p.expiresAt > t
@@ -985,7 +979,7 @@ serve = \req -> case req of
985 let foundServer = case session of
979 let foundServer = case session of
986 Nothing {} -> ""
980 Nothing {} -> ""
987 Just {value: _} ->
981 Just {value: _} ->
988− if not validPubkey || count valid == 0
982+ if count valid == 0
990 else if count (do p <- valid; where p.server == serverHostN; yield p) > 0
984 else if count (do p <- valid; where p.server == serverHostN; yield p) > 0
991 then serverHostN
985 then serverHostN
@@ -998,8 +992,8 @@ serve = \req -> case req of
999 let authorized = verifyFederationAuth authorization
993 let authorized = verifyFederationAuth authorization
1000 let cappedHops = if hopsRemaining > 5 then 5 else hopsRemaining
994 let cappedHops = if hopsRemaining > 5 then 5 else hopsRemaining
1001− let fromServer = if tooLong fromServer maxServerNameLen then fromServer else normalizeServerName fromServer
995+ let fromServer = normalizeServerName fromServer
1002− let validRequest = authorized && cappedHops >= 1 && not (fromServer == "") && not (fromServer == serverHostN) && not (tooLong fromServer maxServerNameLen) && not (isBadServerName fromServer) && count events <= maxGossipEvents
996+ let validRequest = authorized && cappedHops >= 1 && not (fromServer == serverHostN) && count events <= maxGossipEvents
1003 let onlineEntries = do
997 let onlineEntries = do
1004 e <- events
998 e <- events
1005 where validRequest
999 where validRequest
@@ -1245,42 +1239,41 @@ serve = \req -> case req of
1245 yield (respond {ok: validRequest})
1239 yield (respond {ok: validRequest})
1247 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
1241 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
1248− let validFields = not (toKey == "") && not (fromKey == "") && not (encryptedBlob == "") && not (messageId == "") && not (tooLong toKey maxPubkeyLen) && not (tooLong fromKey maxPubkeyLen) && not (tooLong encryptedBlob maxBlobLen) && not (tooLong messageId maxMessageIdLen) && isValidHex toKey && isValidHex fromKey && isValidHex encryptedBlob && isValidHex messageId
1249− let toKey = if isValidHex toKey then normalizeHex toKey else toKey
1242+ let toKey = normalizeHex toKey
1250− let fromKey = if isValidHex fromKey then normalizeHex fromKey else fromKey
1243+ let fromKey = normalizeHex fromKey
1251− let encryptedBlob = if isValidHex encryptedBlob then normalizeHex encryptedBlob else encryptedBlob
1244+ let encryptedBlob = normalizeHex encryptedBlob
1252− let messageId = if isValidHex messageId then normalizeHex messageId else messageId
1245+ let messageId = normalizeHex messageId
1253− let originServer = if tooLong originServer maxServerNameLen then originServer else normalizeServerName originServer
1246+ let originServer = normalizeServerName originServer
1254 t <- now
1247 t <- now
1255 let authorized = verifyFederationAuth authorization
1248 let authorized = verifyFederationAuth authorization
1256− let validOrigin = not (originServer == "") && not (originServer == serverHostN) && not (tooLong originServer maxServerNameLen) && not (isBadServerName originServer)
1249+ let validOrigin = not (originServer == serverHostN)
1257 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t - messageMaxAge else timestamp
1250 let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t - messageMaxAge else timestamp
1258 result <- atomic do
1251 result <- atomic do
1259 pr <- maybePrune t
1252 pr <- maybePrune t
1260 messages <- *messages
1253 messages <- *messages
1261 seqCounter <- *seqCounter
1254 seqCounter <- *seqCounter
1262 let seqTs = if t > seqCounter then t else seqCounter + 1
1255 let seqTs = if t > seqCounter then t else seqCounter + 1
1263− let recipientMsgCount = if not (authorized && validOrigin && validFields) then 0
1256+ let recipientMsgCount = if not (authorized && validOrigin) then 0
1264 else count (do
1257 else count (do
1265 m <- messages
1258 m <- messages
1266 where m.toKey == toKey
1259 where m.toKey == toKey
1267 where m.receivedAt >= t - messageMaxAge
1260 where m.receivedAt >= t - messageMaxAge
1268 yield m)
1261 yield m)
1269− let existsInMessages = if not (authorized && validOrigin && validFields) then False {}
1262+ let existsInMessages = if not (authorized && validOrigin) then False {}
1270 else count (do
1263 else count (do
1271 m <- messages
1264 m <- messages
1272 where m.messageId == messageId
1265 where m.messageId == messageId
1273 where m.toKey == toKey
1266 where m.toKey == toKey
1274 yield m) > 0
1267 yield m) > 0
1275 ackedIds <- *ackedIds
1268 ackedIds <- *ackedIds
1276− let existsInAcked = if not (authorized && validOrigin && validFields) then False {}
1269+ let existsInAcked = if not (authorized && validOrigin) then False {}
1277 else count (do
1270 else count (do
1278 a <- ackedIds
1271 a <- ackedIds
1279 where a.messageId == messageId
1272 where a.messageId == messageId
1280 where a.toKey == toKey
1273 where a.toKey == toKey
1281 yield a) > 0
1274 yield a) > 0
1282 let exists = existsInMessages || existsInAcked
1275 let exists = existsInMessages || existsInAcked
1283− let shouldInsert = authorized && validOrigin && validFields && not exists && recipientMsgCount < maxMessagesPerRecipient
1276+ let shouldInsert = authorized && validOrigin && not exists && recipientMsgCount < maxMessagesPerRecipient
1284 set *seqCounter = if shouldInsert then seqTs else seqCounter
1277 set *seqCounter = if shouldInsert then seqTs else seqCounter
1285 set *messages = if shouldInsert
1278 set *messages = if shouldInsert
1286 then union messages
1279 then union messages
@@ -1289,10 +1282,10 @@ serve = \req -> case req of
1289 else messages
1282 else messages
1290 yield {peerServers: pr.peerServers, expiredLocal: pr.expiredLocal, inserted: shouldInsert, alreadyExists: exists}
1283 yield {peerServers: pr.peerServers, expiredLocal: pr.expiredLocal, inserted: shouldInsert, alreadyExists: exists}
1291 fork (broadcastOfflineGossip t result.peerServers result.expiredLocal)
1284 fork (broadcastOfflineGossip t result.peerServers result.expiredLocal)
1292− yield (respond {ok: result.inserted || (authorized && validOrigin && validFields && result.alreadyExists)})
1285+ yield (respond {ok: result.inserted || (authorized && validOrigin && result.alreadyExists)})
1294 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
1287 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
1295− let fromServer = if tooLong fromServer maxServerNameLen then fromServer else normalizeServerName fromServer
1288+ let fromServer = normalizeServerName fromServer
1296 let originServer = if tooLong originServer maxServerNameLen then originServer else normalizeServerName originServer
1289 let originServer = if tooLong originServer maxServerNameLen then originServer else normalizeServerName originServer
1297 t <- now
1290 t <- now
1298 let authorized = verifyFederationAuth authorization
1291 let authorized = verifyFederationAuth authorization
@@ -1303,7 +1296,7 @@ serve = \req -> case req of
1303 else if not (isValidHex mid) then acc
1296 else if not (isValidHex mid) then acc
1304 else if count (do a <- acc; where a == normalizeHex mid; yield a) > 0 then acc
1297 else if count (do a <- acc; where a == normalizeHex mid; yield a) > 0 then acc
1305 else union acc [normalizeHex mid]) [] messageIds
1298 else union acc [normalizeHex mid]) [] messageIds
1306− let validAckFields = authorized && originServer == serverHostN && not (fromServer == "") && not (fromServer == serverHostN) && not (tooLong fromServer maxServerNameLen) && not (isBadServerName fromServer)
1299+ let validAckFields = authorized && originServer == serverHostN && not (fromServer == serverHostN)
1307 pruneResult <- atomic do
1300 pruneResult <- atomic do
1308 pr <- maybePrune t
1301 pr <- maybePrune t
1309 forwards <- *forwards
1302 forwards <- *forwards