@@ -87,20 +87,6 @@ impl ToJSON MessageStatus where
8787 MsUnauthorized {} -> "unauthorized"
8888 MsRejected {} -> "rejected")
8989
90−data DeliveryStatus = Delivered {} | Federated {} | Queued {}
91−
92−impl ToJSON DeliveryStatus where
93− toJson ds = toJson (case ds of
94− Delivered {} -> "delivered"
95− Federated {} -> "federated"
96− Queued {} -> "queued")
97−
98−deliveryToStatus : DeliveryStatus -> MessageStatus
99−deliveryToStatus = \ds -> case ds of
100− Delivered {} -> MsDelivered {}
101− Federated {} -> MsFederated {}
102− Queued {} -> MsQueued {}
103−
10490isValidBoundedHex = \maxLen s -> isValidHex s && not (tooLong s maxLen) && s == normalizeHex s
10591type PubkeyHex = Text where isValidBoundedHex maxPubkeyLen
10692type BlobHex = Text where isValidBoundedHex maxBlobLen
@@ -122,8 +108,10 @@ type PresenceEntry = {pubkey: PubkeyHex, server: AnyServerName, expiresAt: Times
122108type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: Timestamp, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp}
123109type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}
124110data AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}
125−data SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: DeliveryStatus, remoteServers: [ServerName], fromKey: PubkeyHex}
111+data SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: MessageStatus, remoteServers: [ServerName], fromKey: PubkeyHex}
126112data VerifyResult = VerifyFailed {} | VerifyOk {peerServers: [ServerName]}
113+data AckResult = AckUnauthorized {} | AckDone {pendingAcks: [AckedEntry], evictedEntries: [AckedEntry]}
114+data LookupResult = LookupUnauthorized {} | LookupDone {server: AnyServerName}
127115type PollResponse = {events: [PollEvent], cursor: Timestamp, authorized: Bool}
128116
129117
@@ -621,6 +609,11 @@ broadcastOfflineGossip = \t peerServers expiredLocal ->
621609forkBroadcastOffline = \t result ->
622610 fork (broadcastOfflineGossip t result.peerServers result.expiredLocal)
623611
612+effectiveGossipEvents = \entries appliedKeys eventType -> do
613+ e <- entries
614+ where any appliedKeys (\a -> samePubkeyServer a e)
615+ yield {eventType: eventType, pubkey: e.pubkey, server: e.server, timestamp: e.timestamp, ttl: e.ttl}
616+
624617rejectFederation = \t respond -> do
625618 maybePruneAndBroadcast t
626619 yield (respond {ok: False {}})
@@ -857,16 +850,16 @@ serve = \req -> case req of
857850 forwards <- *forwards
858851 let forwardServers = takeN remoteServers (maxForwardsEntries - count forwards)
859852 let shouldForward = federationEnabled && count forwardServers > 0
860− let status = if localOnline then Delivered {}
861− else if shouldForward then Federated {}
862− else Queued {}
853+ let status = if localOnline then MsDelivered {}
854+ else if shouldForward then MsFederated {}
855+ else MsQueued {}
863856 set *forwards = if shouldForward
864857 then union forwards (do s <- forwardServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})
865858 else forwards
866859 yield {pr: pr, send: SendDone {status: status, remoteServers: remoteServers, fromKey: fromKey}}
867− fork (do
868− case result.send of
869− SendDone {status, remoteServers, fromKey} ->
860+ case result.send of
861+ SendDone {status, remoteServers, fromKey} ->
862+ fork (do
870863 when (count remoteServers > 0 && federationEnabled) (do
871864 sendToEach remoteServers (\server -> do
872865 fwdResult <- fetch (federationUrl server) (ForwardMessage {
@@ -875,14 +868,14 @@ serve = \req -> case req of
875868 authorization: federationAuth})
876869 whenOk fwdResult (removeForward msgId server))
877870 case status of
878− Queued {} -> println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
871+ MsQueued {} -> println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
879872 _ -> yield {})
880− _ -> yield {}
881− broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
873+ broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
874+ _ -> forkBroadcastOffline t result.pr
882875 yield (case result.send of
883876 SendUnauthorized {} -> respond {status: MsUnauthorized {}, messageId: ""}
884877 SendRejected {} -> respond {status: MsRejected {}, messageId: ""}
885− SendDone {status} -> respond {status: deliveryToStatus status, messageId: msgId})
878+ SendDone {status} -> respond {status: status, messageId: msgId})
886879
887880 AckMessages {messageIds, authorization, respond} -> do
888881 t <- now
@@ -892,7 +885,7 @@ serve = \req -> case req of
892885 auth <- authenticateRequest authorization t
893886 case auth of
894887 Unauthorized {} ->
895− yield {pr: pr, authorized: False {}, pendingAcks: [], evictedEntries: []}
888+ yield {pr: pr, ack: AckUnauthorized {}}
896889 Authorized {pubkey} -> do
897890 messages <- *messages
898891 let ackedMessages = do
@@ -910,13 +903,16 @@ serve = \req -> case req of
910903 let evictedEntries = let excessCount = count combinedAckedIds - maxAckedIds in
911904 if excessCount <= 0 then [] else boundedSmallest combinedAckedIds excessCount (\a -> a.ackedAt)
912905 set *ackedIds = diff combinedAckedIds evictedEntries
913− yield {pr: pr, authorized: True {}, pendingAcks: ackedFederated, evictedEntries: evictedEntries}
906+ yield {pr: pr, ack: AckDone {pendingAcks: ackedFederated, evictedEntries: evictedEntries}}
914907 fork (do
915− when (result.authorized && federationEnabled) (do
916− sendAcksAndClean result.pendingAcks
917− retryEvictedAcks result.evictedEntries result.pendingAcks)
908+ case result.ack of
909+ AckDone {pendingAcks, evictedEntries} ->
910+ when federationEnabled (do
911+ sendAcksAndClean pendingAcks
912+ retryEvictedAcks evictedEntries pendingAcks)
913+ AckUnauthorized {} -> yield {}
918914 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
919− yield (respond {ok: result.authorized})
915+ yield (respond {ok: case result.ack of AckDone _ -> True {}; _ -> False {}})
920916
921917 LookupPresence {pubkey, authorization, respond} -> do
922918 t <- now
@@ -925,7 +921,7 @@ serve = \req -> case req of
925921 auth <- authenticateRequest authorization t
926922 case auth of
927923 Unauthorized {} ->
928− yield {pr: pr, server: "", authorized: False {}}
924+ yield {pr: pr, lookup: LookupUnauthorized {}}
929925 Authorized _ -> do
930926 presence <- *presence
931927 let valid = do
@@ -938,9 +934,11 @@ serve = \req -> case req of
938934 if not (isLocalServer p.server) && dominated then Just {value: p} else acc) Nothing {} valid
939935 let foundServer = if localOnline then serverHostN
940936 else case bestRemote of Just {value: p} -> p.server; Nothing {} -> ""
941− yield {pr: pr, server: foundServer, authorized: True {}}
937+ yield {pr: pr, lookup: LookupDone {server: foundServer}}
942938 forkBroadcastOffline t result.pr
943− yield (respond {server: result.server, authorized: result.authorized})
939+ yield (case result.lookup of
940+ LookupUnauthorized {} -> respond {server: "", authorized: False {}}
941+ LookupDone {server} -> respond {server: server, authorized: True {}})
944942
945943 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
946944 t <- now
@@ -973,11 +971,7 @@ serve = \req -> case req of
973971 set *presence = capResult.finalPresence
974972 let gossipPeerServers = collectPeerServers capResult.finalPresence (\p -> p.server)
975973 yield {appliedKeys: union capResult.appliedOnline appliedOffline, pr: pr, gossipPeerServers: gossipPeerServers, withinCapacity: capResult.withinCapacity}
976− let effectiveFor = \entries eventType -> do
977− e <- entries
978− where any gossipResult.appliedKeys (\a -> samePubkeyServer a e)
979− yield {eventType: eventType, pubkey: e.pubkey, server: e.server, timestamp: e.timestamp, ttl: e.ttl}
980− let effectiveEvents = union (effectiveFor filteredOnline (GossipOnline {})) (effectiveFor filteredOffline (GossipOffline {}))
974+ let effectiveEvents = union (effectiveGossipEvents filteredOnline gossipResult.appliedKeys (GossipOnline {})) (effectiveGossipEvents filteredOffline gossipResult.appliedKeys (GossipOffline {}))
981975 when (not gossipResult.withinCapacity)
982976 (println ("gossip: presence at capacity (" ++ show maxPresenceEntries ++ "), limiting new entries from " ++ fromServer))
983977 fork (do