@@ -67,20 +67,21 @@ impl FromJSON GossipEventType where
6767
6868isGossipOnline = \et -> case et of GossipOnline {} -> True {}; _ -> False {}
6969isGossipOffline = \et -> case et of GossipOffline {} -> True {}; _ -> False {}
70+isGossipUnknown = \et -> case et of GossipUnknown {} -> True {}; _ -> False {}
7071
7172type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, timestamp: Timestamp, ttl: Int<S>}
7273
7374type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}
7475
75−type MessageStatus = MsUnauthorized {} | MsRejected {} | MsDelivered {} | MsFederated {} | MsQueued {}
76+type MessageStatus = MsDelivered {} | MsFederated {} | MsQueued {}
77+
78+messageStatusText = \ms -> case ms of
79+ MsDelivered {} -> "delivered"
80+ MsFederated {} -> "federated"
81+ MsQueued {} -> "queued"
7682
7783impl ToJSON MessageStatus where
78− toJson ms = toJson (case ms of
79− MsUnauthorized {} -> "unauthorized"
80− MsRejected {} -> "rejected"
81− MsDelivered {} -> "delivered"
82− MsFederated {} -> "federated"
83− MsQueued {} -> "queued")
84+ toJson ms = toJson (messageStatusText ms)
8485
8586type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) && s == normalizeHex s
8687type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s
@@ -90,14 +91,14 @@ type MessageIdHex = Text where isValidMessageId
9091type OptionalMessageId = Text where \s -> s == "" || isValidMessageId s
9192isValidServerName = \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s && not (isBadServerName s)
9293type ServerName = Text where isValidServerName
93−type OptionalServerName = Text where \s -> s == "" || isValidServerName s
94+type MessageOrigin = LocalOrigin {} | FederatedOrigin {server: ServerName}
9495type AnyServerName = Text where \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s
9596
9697type Timestamp = Int<Ms>
9798
9899type Challenge = {pubkey: PubkeyHex, challenge: Text, expiresAt: Timestamp}
99100type Session = {token: Text, pubkey: PubkeyHex, expiresAt: Timestamp}
100−type Message = {messageId: MessageIdHex, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, originServer: OptionalServerName, receivedAt: Timestamp}
101+type Message = {messageId: MessageIdHex, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, origin: MessageOrigin, receivedAt: Timestamp}
101102type PresenceEntry = {pubkey: PubkeyHex, server: AnyServerName, expiresAt: Timestamp, timestamp: Timestamp}
102103type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: Timestamp, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp}
103104type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}
@@ -149,13 +150,13 @@ route ClientApi where
149150 = Poll
150151 /messages
151152 POST {to: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp} / headers {authorization: Text}
152− -> {status: MessageStatus, messageId: OptionalMessageId}
153+ -> {status: Text, messageId: OptionalMessageId}
153154 = SendMessage
154155 POST {messageIds: [MessageIdHex]} /ack headers {authorization: Text}
155156 -> {ok: Bool}
156157 = AckMessages
157158 GET /lookup/{pubkey: PubkeyHex} headers {authorization: Text}
158− -> {online: Bool, server: AnyServerName, authorized: Bool}
159+ -> {server: AnyServerName, authorized: Bool}
159160 = LookupPresence
160161
161162route FederationApi where
@@ -385,7 +386,8 @@ clampTimestamp = \timestamp t -> clamp (t - messageMaxAge) t timestamp
385386
386387nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
387388
388−isFederatedOrigin = \originServer -> originServer != "" && originServer != serverHostN
389+isFederatedOrigin = \origin -> case origin of FederatedOrigin _ -> True {}; _ -> False {}
390+originServerName = \origin -> case origin of FederatedOrigin {server} -> server; LocalOrigin {} -> ""
389391
390392takeN = \items n -> (fold (\acc e -> if acc.n >= n then acc else {n: acc.n + 1, items: union acc.items [e]}) {n: 0, items: []} items).items
391393
@@ -493,19 +495,19 @@ removeOffline = \presenceSet trustedOffline t ->
493495 where samePubkeyServer p o && min o.timestamp t > p.timestamp
494496 yield p)
495497
496−capGossipPresence = \afterOffline appliedOnline trustedDeduped presence trustedOffline t ->
497− if count afterOffline <= maxPresenceEntries
498− then {finalPresence: afterOffline, appliedOnline: appliedOnline, withinCapacity: True {}}
498+capGossipPresence = \args ->
499+ if count args.afterOffline <= maxPresenceEntries
500+ then {finalPresence: args.afterOffline, appliedOnline: args.appliedOnline, withinCapacity: True {}}
499501 else
500− let updatesOnly = do e <- trustedDeduped; where any presence (\p -> samePubkeyServer p e); yield e in
501− let updatesOnlyMerged = mergeByPubkeyServer presence updatesOnly in
502− let updatesOnlyAfterOffline = removeOffline updatesOnlyMerged trustedOffline t in
502+ let updatesOnly = do e <- args.trustedDeduped; where any args.presence (\p -> samePubkeyServer p e); yield e in
503+ let updatesOnlyMerged = mergeByPubkeyServer args.presence updatesOnly in
504+ let updatesOnlyAfterOffline = removeOffline updatesOnlyMerged args.trustedOffline args.t in
503505 let reclaimSlots = maxPresenceEntries - count updatesOnlyAfterOffline in
504− let newEntries = do e <- trustedDeduped; where none presence (\p -> samePubkeyServer p e); yield e in
506+ let newEntries = do e <- args.trustedDeduped; where none args.presence (\p -> samePubkeyServer p e); yield e in
505507 let reclaimedEntries = takeN newEntries reclaimSlots in
506508 {finalPresence: union updatesOnlyAfterOffline reclaimedEntries,
507509 appliedOnline: union
508− (do e <- updatesOnly; where none presence (\p -> samePubkeyServer p e && p.expiresAt >= e.expiresAt); yield (pubkeyServer e))
510+ (do e <- updatesOnly; where none args.presence (\p -> samePubkeyServer p e && p.expiresAt >= e.expiresAt); yield (pubkeyServer e))
509511 (do e <- reclaimedEntries; yield (pubkeyServer e)),
510512 withinCapacity: False {}}
511513
@@ -516,6 +518,7 @@ countMessagesFor = \messages toKey t ->
516518validGossipEvents : [GossipEvent] -> Timestamp -> [ValidGossipEntry]
517519validGossipEvents = \events t -> do
518520 e <- events
521+ where not (isGossipUnknown e.eventType)
519522 where e.server != serverHostN && e.timestamp <= t + clockSkewTolerance
520523 let ttl = clampTtl e.ttl
521524 let expiresAt = e.timestamp + ttl * 1000
@@ -608,6 +611,10 @@ broadcastOfflineGossip = \t peerServers expiredLocal ->
608611forkBroadcastOffline = \t result ->
609612 fork (broadcastOfflineGossip t result.peerServers result.expiredLocal)
610613
614+rejectFederation = \t respond -> do
615+ maybePruneAndBroadcast t
616+ yield (respond {ok: False {}})
617+
611618maybePruneAndBroadcast = \t -> do
612619 pruneResult <- atomic do maybePrune t
613620 forkBroadcastOffline t pruneResult
@@ -693,7 +700,7 @@ pruneAndRetry = \t -> do
693700 pr <- pruneExpired t
694701 forwards <- *forwards
695702 ackedIds <- *ackedIds
696− let pendingAcks = do a <- ackedIds; where isFederatedOrigin a.originServer; yield a
703+ let pendingAcks = do a <- ackedIds; where a.originServer != serverHostN; yield a
697704 yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: forwards, pendingAcks: pendingAcks}
698705 broadcastOfflineGossip t result.peerServers result.expiredLocal
699706 when federationEnabled (do
@@ -835,7 +842,7 @@ serve = \req -> case req of
835842 set *seqCounter = seqTs
836843 set *messages = union messages
837844 [{messageId: msgId, toKey: to, fromKey: fromKey,
838− encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: seqTs}]
845+ encryptedBlob: encryptedBlob, timestamp: clampedTs, origin: LocalOrigin {}, receivedAt: seqTs}]
839846 let toPresence = do p <- presence; where p.pubkey == to && p.expiresAt > t; yield p
840847 let localOnline = any toPresence (\p -> p.server == serverHostN)
841848 let remoteServers = do p <- toPresence; where p.server != serverHostN; yield p.server
@@ -865,9 +872,9 @@ serve = \req -> case req of
865872 _ -> yield {}
866873 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
867874 yield (case result.send of
868− SendUnauthorized {} -> respond {status: MsUnauthorized {}, messageId: ""}
869− SendRejected {} -> respond {status: MsRejected {}, messageId: ""}
870− SendDone {status} -> respond {status: status, messageId: msgId})
875+ SendUnauthorized {} -> respond {status: "unauthorized", messageId: ""}
876+ SendRejected {} -> respond {status: "rejected", messageId: ""}
877+ SendDone {status} -> respond {status: messageStatusText status, messageId: msgId})
871878
872879 AckMessages {messageIds, authorization, respond} -> do
873880 t <- now
@@ -887,26 +894,24 @@ serve = \req -> case req of
887894 set *messages = diff messages ackedMessages
888895 let ackedFederated = do
889896 m <- ackedMessages
890− where isFederatedOrigin m.originServer
891− yield {messageId: m.messageId, toKey: m.toKey, ackedAt: t, originServer: m.originServer}
897+ where isFederatedOrigin m.origin
898+ yield {messageId: m.messageId, toKey: m.toKey, ackedAt: t, originServer: originServerName m.origin}
892899 ackedIds <- *ackedIds
893900 let combinedAckedIds = union ackedIds ackedFederated
894901 let evictedEntries = let excessCount = count combinedAckedIds - maxAckedIds in
895902 if excessCount <= 0 then [] else boundedSmallest combinedAckedIds excessCount (\a -> a.ackedAt)
896903 set *ackedIds = diff combinedAckedIds evictedEntries
897904 yield {pr: pr, ack: AckDone {pendingAcks: ackedFederated, evictedEntries: evictedEntries}}
898− case result.ack of
899− AckDone {pendingAcks, evictedEntries} -> do
900− fork (do
905+ fork (do
906+ case result.ack of
907+ AckDone {pendingAcks, evictedEntries} ->
901908 when federationEnabled (do
902909 let originServers = collectPeerServers pendingAcks (\a -> a.originServer)
903910 sendAcksAndClean pendingAcks originServers
904911 retryEvictedAcks evictedEntries pendingAcks)
905− broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
906− yield (respond {ok: True {}})
907− AckUnauthorized {} -> do
908− forkBroadcastOffline t result.pr
909− yield (respond {ok: False {}})
912+ _ -> yield {}
913+ broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
914+ yield (respond {ok: case result.ack of AckDone _ -> True {}; _ -> False {}})
910915
911916 LookupPresence {pubkey, authorization, respond} -> do
912917 t <- now
@@ -929,17 +934,15 @@ serve = \req -> case req of
929934 yield {pr: pr, lookup: LookupDone {server: foundServer}}
930935 forkBroadcastOffline t result.pr
931936 yield (case result.lookup of
932− LookupUnauthorized {} -> respond {online: False {}, server: "", authorized: False {}}
933− LookupDone {server} -> respond {online: server != "", server: server, authorized: True {}})
937+ LookupUnauthorized {} -> respond {server: "", authorized: False {}}
938+ LookupDone {server} -> respond {server: server, authorized: True {}})
934939
935940 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
936941 t <- now
937942 let authorized = verifyFederationAuth authorization
938943 let cappedHops = clamp 0 5 hopsRemaining
939944 if not authorized || cappedHops < 1 || fromServer == serverHostN || count events > maxGossipEvents
940− then do
941− maybePruneAndBroadcast t
942− yield (respond {ok: False {}})
945+ then rejectFederation t respond
943946 else do
944947 let allValidEntries = validGossipEvents events t
945948 let onlineEntries = do e <- allValidEntries; where isGossipOnline e.eventType; yield e
@@ -961,7 +964,7 @@ serve = \req -> case req of
961964 let merged = mergeByPubkeyServer presence trustedDeduped
962965 let afterOffline = removeOffline merged trustedOffline t
963966 let appliedOffline = do p <- diff merged afterOffline; yield (pubkeyServer p)
964− let capResult = capGossipPresence afterOffline appliedOnline trustedDeduped presence trustedOffline t
967+ let capResult = capGossipPresence {afterOffline: afterOffline, appliedOnline: appliedOnline, trustedDeduped: trustedDeduped, presence: presence, trustedOffline: trustedOffline, t: t}
965968 set *presence = capResult.finalPresence
966969 let gossipPeerServers = collectPeerServers capResult.finalPresence (\p -> p.server)
967970 yield {appliedKeys: union capResult.appliedOnline appliedOffline, pr: pr, gossipPeerServers: gossipPeerServers, withinCapacity: capResult.withinCapacity}
@@ -984,11 +987,9 @@ serve = \req -> case req of
984987 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
985988 t <- now
986989 let authorized = verifyFederationAuth authorization
987− let validOrigin = isFederatedOrigin originServer
990+ let validOrigin = originServer != serverHostN
988991 if not authorized || not validOrigin
989− then do
990− maybePruneAndBroadcast t
991− yield (respond {ok: False {}})
992+ then rejectFederation t respond
992993 else do
993994 let clampedTs = clampTimestamp timestamp t
994995 result <- atomic do
@@ -1006,7 +1007,7 @@ serve = \req -> case req of
10061007 set *seqCounter = seqTs
10071008 set *messages = union messages
10081009 [{messageId: messageId, toKey: toKey, fromKey: fromKey,
1009− encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: originServer, receivedAt: seqTs}]
1010+ encryptedBlob: encryptedBlob, timestamp: clampedTs, origin: FederatedOrigin {server: originServer}, receivedAt: seqTs}]
10101011 yield {pr: pr, forward: ForwardStored {}}
10111012 forkBroadcastOffline t result.pr
10121013 yield (respond {ok: case result.forward of ForwardFull {} -> False {}; _ -> True {}})
@@ -1015,9 +1016,7 @@ serve = \req -> case req of
10151016 t <- now
10161017 let authorized = verifyFederationAuth authorization
10171018 if not authorized || originServer != serverHostN || fromServer == serverHostN
1018− then do
1019− maybePruneAndBroadcast t
1020− yield (respond {ok: False {}})
1019+ then rejectFederation t respond
10211020 else do
10221021 let dedupedIds = dedupMessageIds messageIds
10231022 pruneResult <- atomic do