@@ -53,10 +53,10 @@ type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server:
5353
5454type MessageStatus = Text where \s -> s == "unauthorized" || s == "rejected" || s == "delivered" || s == "federated" || s == "queued"
5555
56−type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen)
57−type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen)
58−type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen)
59−type MessageIdHex = Text where \s -> isValidHex s && not (tooLong s maxMessageIdLen)
56+type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) && s == normalizeHex s
57+type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s
58+type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen) && s == normalizeHex s
59+type MessageIdHex = Text where \s -> isValidHex s && not (tooLong s maxMessageIdLen) && s == normalizeHex s
6060type ServerName = Text where \s -> not (tooLong s maxServerNameLen) && not (isBadServerName s)
6161type OptionalServerName = Text where \s -> s == "" || (not (tooLong s maxServerNameLen) && not (isBadServerName s))
6262
@@ -70,10 +70,8 @@ type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: T
7070type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}
7171type AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}
7272type PruneResult = {expiredLocal: [PresenceEntry], peerServers: [ServerName]}
73−type PollResult = PollUnauthorized {} | PollAuthorized {events: [PollEvent], cursor: Timestamp}
7473type DeliveryStatus = Text where \s -> s == "delivered" || s == "federated" || s == "queued"
7574type SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: DeliveryStatus, remoteServers: [ServerName], fromKey: PubkeyHex}
76−type AckResult = AckUnauthorized {} | AckDone {pendingAcks: [AckedEntry], evictedEntries: [AckedEntry]}
7775
7876
7977-- ============================================
@@ -370,8 +368,9 @@ authenticateSession = \sessions token t ->
370368 Nothing {} -> Unauthorized {}
371369 Just {value: s} -> Authorized {pubkey: s.pubkey}
372370
373−authenticateRequest = \sessions authorization t ->
374− authenticateSession sessions (extractToken authorization) t
371+authenticateRequest = \authorization t -> do
372+ sessions <- *sessions
373+ yield (authenticateSession sessions (extractToken authorization) t)
375374
376375extractToken = \authHeader ->
377376 let token = drop 7 authHeader in
@@ -401,10 +400,9 @@ takeN = \items n -> (fold (\acc e -> if acc.n >= n then acc else {n: acc.n + 1,
401400
402401dedupMessageIds = \messageIds ->
403402 fold (\acc mid ->
404− let nmid = normalizeHex mid in
405403 if count acc >= maxMessageIds then acc
406− else if any acc (\a -> a == nmid) then acc
407− else union acc [nmid]) [] messageIds
404+ else if any acc (\a -> a == mid) then acc
405+ else union acc [mid]) [] messageIds
408406
409407boundedSmallest = \items n getKey ->
410408 (fold (\acc a ->
@@ -703,7 +701,7 @@ pollOnce = \token cursor -> do
703701 let auth = authenticateSession sessions token t
704702 case auth of
705703 Unauthorized {} ->
706− yield PollUnauthorized {}
704+ yield {events: [], cursor: -1, authorized: False {}}
707705 Authorized {pubkey} -> do
708706 seqCounter <- *seqCounter
709707 messages <- *messages
@@ -721,21 +719,16 @@ pollOnce = \token cursor -> do
721719 encryptedBlob: m.encryptedBlob,
722720 timestamp: m.timestamp}}
723721 let lastReceivedAt = fold (\acc m -> if m.receivedAt > acc then m.receivedAt else acc) clampedCursor limitedMsgs
724− yield PollAuthorized {events: evts, cursor: lastReceivedAt}
722+ yield {events: evts, cursor: lastReceivedAt, authorized: True {}}
725723
726724pollLoop = \token cursor deadline -> do
727725 result <- pollOnce token cursor
728726 t <- now
729− case result of
730− PollUnauthorized {} -> yield result
731− PollAuthorized {events} ->
732− if count events == 0 && t < deadline
733− then do
734− let remaining = deadline - t
735− let sleepMs = if remaining > 500 then 500<Ms> else remaining
736− sleep sleepMs
737− pollLoop token cursor deadline
738− else yield result
727+ if result.authorized && count result.events == 0 && t < deadline
728+ then do
729+ sleep (clamp 1 500 (deadline - t))
730+ pollLoop token cursor deadline
731+ else yield result
739732
740733-- ============================================
741734-- Request Handler
@@ -744,7 +737,6 @@ pollLoop = \token cursor deadline -> do
744737serve = \req -> case req of
745738
746739 ReqChallenge {pubkey, respond} -> do
747− let pubkey = normalizeHex pubkey
748740 challenge <- genToken
749741 t <- now
750742 pruneResult <- atomic do
@@ -759,7 +751,6 @@ serve = \req -> case req of
759751 yield (respond {challenge: challenge})
760752
761753 VerifyAuth {pubkey, challenge, signature, respond} -> do
762− let pubkey = normalizeHex pubkey
763754 t <- now
764755 token <- genToken
765756 let expiry = t + sessionExpiry
@@ -809,20 +800,15 @@ serve = \req -> case req of
809800 result <- pollLoop token cursor deadline
810801 tAfterPoll <- now
811802 maybePruneAndBroadcast tAfterPoll
812− yield (case result of
813− PollUnauthorized {} -> respond {events: [], cursor: -1, authorized: False {}}
814− PollAuthorized {events, cursor: c} -> respond {events: events, cursor: c, authorized: True {}})
803+ yield (respond result)
815804
816805 SendMessage {to, encryptedBlob, timestamp, authorization, respond} -> do
817− let to = normalizeHex to
818− let encryptedBlob = normalizeHex encryptedBlob
819806 t <- now
820807 msgId <- genToken
821808 let clampedTs = clampTimestamp timestamp t
822809 result <- atomic do
823810 pr <- maybePrune t
824− sessions <- *sessions
825− let auth = authenticateRequest sessions authorization t
811+ auth <- authenticateRequest authorization t
826812 case auth of
827813 Unauthorized {} ->
828814 yield {pr: pr, send: SendUnauthorized {}}
@@ -875,11 +861,10 @@ serve = \req -> case req of
875861 let dedupedIds = dedupMessageIds messageIds
876862 result <- atomic do
877863 pr <- maybePrune t
878− sessions <- *sessions
879− let auth = authenticateRequest sessions authorization t
864+ auth <- authenticateRequest authorization t
880865 case auth of
881866 Unauthorized {} ->
882− yield {pr: pr, ack: AckUnauthorized {}}
867+ yield {pr: pr, ok: False {}, pendingAcks: [], evictedEntries: []}
883868 Authorized {pubkey} -> do
884869 messages <- *messages
885870 let ackedMessages = do
@@ -896,27 +881,20 @@ serve = \req -> case req of
896881 let evictedEntries = let excessCount = count combinedAckedIds - maxAckedIds in
897882 if excessCount <= 0 then [] else boundedSmallest combinedAckedIds excessCount (\a -> a.ackedAt)
898883 set *ackedIds = diff combinedAckedIds evictedEntries
899− yield {pr: pr, ack: AckDone {pendingAcks: ackedFederated, evictedEntries: evictedEntries}}
884+ yield {pr: pr, ok: True {}, pendingAcks: ackedFederated, evictedEntries: evictedEntries}
900885 fork (do
901− case result.ack of
902− AckDone {pendingAcks, evictedEntries} ->
903− when federationEnabled (do
904− let originServers = collectPeerServers pendingAcks (\a -> a.originServer)
905− sendAcksAndClean pendingAcks originServers
906− retryEvictedAcks evictedEntries pendingAcks)
907− _ -> yield {}
886+ when (result.ok && federationEnabled) (do
887+ let originServers = collectPeerServers result.pendingAcks (\a -> a.originServer)
888+ sendAcksAndClean result.pendingAcks originServers
889+ retryEvictedAcks result.evictedEntries result.pendingAcks)
908890 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
909− yield (case result.ack of
910− AckUnauthorized _ -> respond {ok: False {}}
911− AckDone _ -> respond {ok: True {}})
891+ yield (respond {ok: result.ok})
912892
913893 LookupPresence {pubkey, authorization, respond} -> do
914− let pubkey = normalizeHex pubkey
915894 t <- now
916895 result <- atomic do
917896 pr <- maybePrune t
918− sessions <- *sessions
919− let auth = authenticateRequest sessions authorization t
897+ auth <- authenticateRequest authorization t
920898 case auth of
921899 Unauthorized {} ->
922900 yield {pr: pr, authorized: False {}, foundServer: ""}
@@ -933,9 +911,7 @@ serve = \req -> case req of
933911 else acc) {server: "", best: 0} valid).server
934912 yield {pr: pr, authorized: True {}, foundServer: foundServer}
935913 forkBroadcastOffline t result.pr
936− yield (if result.authorized
937− then respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: True {}}
938− else respond {online: False {}, server: "", authorized: False {}})
914+ yield (respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: result.authorized})
939915
940916 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
941917 t <- now
@@ -1019,10 +995,6 @@ serve = \req -> case req of
1019995 yield (respond {ok: True {}})
1020996
1021997 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
1022− let toKey = normalizeHex toKey
1023− let fromKey = normalizeHex fromKey
1024− let encryptedBlob = normalizeHex encryptedBlob
1025− let messageId = normalizeHex messageId
1026998 let originServer = normalizeServerName originServer
1027999 t <- now
10281000 let authorized = verifyFederationAuth authorization