@@ -87,6 +87,20 @@ 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+
90104isValidBoundedHex = \maxLen s -> isValidHex s && not (tooLong s maxLen) && s == normalizeHex s
91105type PubkeyHex = Text where isValidBoundedHex maxPubkeyLen
92106type BlobHex = Text where isValidBoundedHex maxBlobLen
@@ -108,12 +122,9 @@ type PresenceEntry = {pubkey: PubkeyHex, server: AnyServerName, expiresAt: Times
108122type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: Timestamp, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp}
109123type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}
110124data AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}
111−data SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: MessageStatus, remoteServers: [ServerName], fromKey: PubkeyHex}
125+data SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: DeliveryStatus, remoteServers: [ServerName], fromKey: PubkeyHex}
112126data VerifyResult = VerifyFailed {} | VerifyOk {peerServers: [ServerName]}
113−data AckResult = AckUnauthorized {} | AckDone {pendingAcks: [AckedEntry], evictedEntries: [AckedEntry]}
114−data LookupResult = LookupUnauthorized {} | LookupDone {server: AnyServerName}
115−data ForwardResult = ForwardDuplicate {} | ForwardStored {} | ForwardFull {}
116−data PollResult = PollUnauthorized {} | PollDone {events: [PollEvent], cursor: Timestamp}
127+type PollResponse = {events: [PollEvent], cursor: Timestamp, authorized: Bool}
117128
118129
119130-- ============================================
@@ -714,7 +725,7 @@ pollOnce = \token cursor -> do
714725 let auth = authenticateSession sessions token t
715726 case auth of
716727 Unauthorized {} ->
717− yield PollUnauthorized {}
728+ yield {events: [], cursor: 0, authorized: False {}}
718729 Authorized {pubkey} -> do
719730 seqCounter <- *seqCounter
720731 messages <- *messages
@@ -731,20 +742,19 @@ pollOnce = \token cursor -> do
731742 encryptedBlob: m.encryptedBlob,
732743 timestamp: m.timestamp}}
733744 let lastReceivedAt = fold (\acc m -> max acc m.receivedAt) clampedCursor limitedMsgs
734− yield PollDone {events: evts, cursor: lastReceivedAt}
745+ yield {events: evts, cursor: lastReceivedAt, authorized: True {}}
735746
736−pollLoop : Text -> Int -> Int<Ms> -> IO {clock} PollResult
747+pollLoop : Text -> Int -> Int<Ms> -> IO {clock} PollResponse
737748pollLoop = \token cursor deadline -> do
738749 result <- pollOnce token cursor
739− case result of
740− PollUnauthorized {} -> yield result
741− PollDone {events} -> do
742− t <- now
743− if count events == 0 && t < deadline
744− then do
745− sleep (clamp 1 500 (deadline - t))
746− pollLoop token cursor deadline
747− else yield result
750+ if not result.authorized then yield result
751+ else do
752+ t <- now
753+ if count result.events == 0 && t < deadline
754+ then do
755+ sleep (clamp 1 500 (deadline - t))
756+ pollLoop token cursor deadline
757+ else yield result
748758
749759-- ============================================
750760-- Request Handler
@@ -817,9 +827,7 @@ serve = \req -> case req of
817827 result <- pollLoop token cursor deadline
818828 tAfterPoll <- now
819829 maybePruneAndBroadcast tAfterPoll
820− yield (respond (case result of
821− PollUnauthorized {} -> {events: [], cursor: 0, authorized: False {}}
822− PollDone r -> {events: r.events, cursor: r.cursor, authorized: True {}}))
830+ yield (respond result)
823831
824832 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
825833 t <- now
@@ -849,9 +857,9 @@ serve = \req -> case req of
849857 forwards <- *forwards
850858 let forwardServers = takeN remoteServers (maxForwardsEntries - count forwards)
851859 let shouldForward = federationEnabled && count forwardServers > 0
852− let status = if localOnline then MsDelivered {}
853− else if shouldForward then MsFederated {}
854− else MsQueued {}
860+ let status = if localOnline then Delivered {}
861+ else if shouldForward then Federated {}
862+ else Queued {}
855863 set *forwards = if shouldForward
856864 then union forwards (do s <- forwardServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})
857865 else forwards
@@ -867,14 +875,14 @@ serve = \req -> case req of
867875 authorization: federationAuth})
868876 whenOk fwdResult (removeForward msgId server))
869877 case status of
870− MsQueued {} -> println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
878+ Queued {} -> println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
871879 _ -> yield {})
872880 _ -> yield {}
873881 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
874882 yield (case result.send of
875883 SendUnauthorized {} -> respond {status: MsUnauthorized {}, messageId: ""}
876884 SendRejected {} -> respond {status: MsRejected {}, messageId: ""}
877− SendDone {status} -> respond {status: status, messageId: msgId})
885+ SendDone {status} -> respond {status: deliveryToStatus status, messageId: msgId})
878886
879887 AckMessages {messageIds, authorization, respond} -> do
880888 t <- now
@@ -884,7 +892,7 @@ serve = \req -> case req of
884892 auth <- authenticateRequest authorization t
885893 case auth of
886894 Unauthorized {} ->
887− yield {pr: pr, ack: AckUnauthorized {}}
895+ yield {pr: pr, authorized: False {}, pendingAcks: [], evictedEntries: []}
888896 Authorized {pubkey} -> do
889897 messages <- *messages
890898 let ackedMessages = do
@@ -902,16 +910,13 @@ serve = \req -> case req of
902910 let evictedEntries = let excessCount = count combinedAckedIds - maxAckedIds in
903911 if excessCount <= 0 then [] else boundedSmallest combinedAckedIds excessCount (\a -> a.ackedAt)
904912 set *ackedIds = diff combinedAckedIds evictedEntries
905− yield {pr: pr, ack: AckDone {pendingAcks: ackedFederated, evictedEntries: evictedEntries}}
913+ yield {pr: pr, authorized: True {}, pendingAcks: ackedFederated, evictedEntries: evictedEntries}
906914 fork (do
907− case result.ack of
908− AckDone {pendingAcks, evictedEntries} ->
909− when federationEnabled (do
910− sendAcksAndClean pendingAcks
911− retryEvictedAcks evictedEntries pendingAcks)
912− _ -> yield {}
915+ when (result.authorized && federationEnabled) (do
916+ sendAcksAndClean result.pendingAcks
917+ retryEvictedAcks result.evictedEntries result.pendingAcks)
913918 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
914− yield (respond {ok: case result.ack of AckDone _ -> True {}; _ -> False {}})
919+ yield (respond {ok: result.authorized})
915920
916921 LookupPresence {pubkey, authorization, respond} -> do
917922 t <- now
@@ -920,7 +925,7 @@ serve = \req -> case req of
920925 auth <- authenticateRequest authorization t
921926 case auth of
922927 Unauthorized {} ->
923− yield {pr: pr, lookup: LookupUnauthorized {}}
928+ yield {pr: pr, server: "", authorized: False {}}
924929 Authorized _ -> do
925930 presence <- *presence
926931 let valid = do
@@ -933,11 +938,9 @@ serve = \req -> case req of
933938 if not (isLocalServer p.server) && dominated then Just {value: p} else acc) Nothing {} valid
934939 let foundServer = if localOnline then serverHostN
935940 else case bestRemote of Just {value: p} -> p.server; Nothing {} -> ""
936− yield {pr: pr, lookup: LookupDone {server: foundServer}}
941+ yield {pr: pr, server: foundServer, authorized: True {}}
937942 forkBroadcastOffline t result.pr
938− yield (case result.lookup of
939− LookupUnauthorized {} -> respond {server: "", authorized: False {}}
940− LookupDone {server} -> respond {server: server, authorized: True {}})
943+ yield (respond {server: result.server, authorized: result.authorized})
941944
942945 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
943946 t <- now
@@ -999,9 +1002,9 @@ serve = \req -> case req of
9991002 messages <- *messages
10001003 ackedIds <- *ackedIds
10011004 if hasMessage messageId toKey messages || hasMessage messageId toKey ackedIds
1002− then yield {pr: pr, forward: ForwardDuplicate {}}
1005+ then yield {pr: pr, ok: True {}}
10031006 else if countMessagesFor messages toKey t >= maxMessagesPerRecipient
1004− then yield {pr: pr, forward: ForwardFull {}}
1007+ then yield {pr: pr, ok: False {}}
10051008 else do
10061009 seqCounter <- *seqCounter
10071010 let seqTs = nextSeqTs t seqCounter
@@ -1009,9 +1012,9 @@ serve = \req -> case req of
10091012 set *messages = union messages
10101013 [{messageId: messageId, toKey: toKey, fromKey: fromKey,
10111014 encryptedBlob: encryptedBlob, timestamp: clampedTs, origin: FederatedOrigin {server: originServer}, receivedAt: seqTs}]
1012− yield {pr: pr, forward: ForwardStored {}}
1015+ yield {pr: pr, ok: True {}}
10131016 forkBroadcastOffline t result.pr
1014− yield (respond {ok: case result.forward of ForwardFull {} -> False {}; _ -> True {}})
1017+ yield (respond {ok: result.ok})
10151018
10161019 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
10171020 t <- now