@@ -48,9 +48,7 @@ federationEnabled = federationSecret != ""
4848-- Types
4949-- ============================================
5050
51−type PollEventType = Text where \s -> s == "message"
52−
53−type PollEvent = {id: MessageIdHex, eventType: PollEventType, payload: {encryptedBlob: BlobHex, fromKey: PubkeyHex, timestamp: Timestamp, toKey: PubkeyHex}}
51+type PollEvent = {id: MessageIdHex, eventType: Text, payload: {encryptedBlob: BlobHex, fromKey: PubkeyHex, timestamp: Timestamp, toKey: PubkeyHex}}
5452
5553type GossipEventType = Text where \s -> s == "online" || s == "offline"
5654
@@ -58,26 +56,29 @@ type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: Serve
5856
5957type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}
6058
61−type MessageStatus = Text where \s -> s == "unauthorized" || s == "rejected" || s == "delivered" || s == "federated" || s == "queued"
59+isDeliveryStatus = \s -> s == "delivered" || s == "federated" || s == "queued"
60+type MessageStatus = Text where \s -> s == "unauthorized" || s == "rejected" || isDeliveryStatus s
6261
6362type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) && s == normalizeHex s
6463type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s
6564type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen) && s == normalizeHex s
6665type MessageIdHex = Text where \s -> isValidHex s && not (tooLong s maxMessageIdLen) && s == normalizeHex s
67−type ServerName = Text where \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s && not (isBadServerName s)
68−type OptionalServerName = Text where \s -> s == "" || (not (tooLong s maxServerNameLen) && s == normalizeServerName s && not (isBadServerName s))
66+isValidServerName = \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s && not (isBadServerName s)
67+type ServerName = Text where isValidServerName
68+type OptionalServerName = Text where \s -> s == "" || isValidServerName s
69+type AnyServerName = Text where \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s
6970
7071type Timestamp = Int<Ms>
7172
7273type Challenge = {pubkey: PubkeyHex, challenge: Text, expiresAt: Timestamp}
7374type Session = {token: Text, pubkey: PubkeyHex, expiresAt: Timestamp}
7475type Message = {messageId: MessageIdHex, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp, originServer: OptionalServerName, receivedAt: Timestamp}
75−type PresenceEntry = {pubkey: PubkeyHex, server: Text, expiresAt: Timestamp, timestamp: Timestamp}
76+type PresenceEntry = {pubkey: PubkeyHex, server: AnyServerName, expiresAt: Timestamp, timestamp: Timestamp}
7677type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: Timestamp, toKey: PubkeyHex, fromKey: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp}
7778type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}
7879type AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}
7980type PruneResult = {expiredLocal: [PresenceEntry], peerServers: [ServerName]}
80−type DeliveryStatus = Text where \s -> s == "delivered" || s == "federated" || s == "queued"
81+type DeliveryStatus = Text where isDeliveryStatus
8182type SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: DeliveryStatus, remoteServers: [ServerName], fromKey: PubkeyHex}
8283
8384
@@ -265,14 +266,16 @@ normalizeServerName = \s -> toLower (stripTrailingDot s)
265266
266267serverHostN = normalizeServerName serverHost
267268
268−containsSuffix = \suffix suffixLen s ->
269+containsSuffixN = \suffix suffixLen s ->
269270 if s == "" then False {}
270271 else if take suffixLen s == suffix && (drop suffixLen s == "" || take 1 (drop suffixLen s) == ":") then True {}
271− else containsSuffix suffix suffixLen (drop 1 s)
272+ else containsSuffixN suffix suffixLen (drop 1 s)
273+
274+containsSuffix = \suffix s -> containsSuffixN suffix (count (chars suffix)) s
272275
273−containsLocalhostSuffix = \s -> containsSuffix ".localhost" 10 s
274−containsLocalSuffix = \s -> containsSuffix ".local" 6 s
275−containsInternalSuffix = \s -> containsSuffix ".internal" 9 s
276+containsLocalhostSuffix = \s -> containsSuffix ".localhost" s
277+containsLocalSuffix = \s -> containsSuffix ".local" s
278+containsInternalSuffix = \s -> containsSuffix ".internal" s
276279
277280is172Private = \sn ->
278281 take 4 sn == "172."
@@ -463,6 +466,22 @@ removeOffline = \presenceSet offlineOnlyKeys trustedOffline t ->
463466 where samePubkeyServer p k && any trustedOffline (\o -> samePubkeyServer o k && (if o.timestamp > t then t else o.timestamp) > p.timestamp)
464467 yield p)
465468
469+capGossipPresence = \afterOffline appliedOnline trustedDeduped presence offlineOnlyKeys trustedOffline t ->
470+ if count afterOffline <= maxPresenceEntries
471+ then {finalPresence: afterOffline, appliedOnline: appliedOnline, withinCapacity: True {}}
472+ else
473+ let updatesOnly = do e <- trustedDeduped; where any presence (\p -> samePubkeyServer p e); yield e in
474+ let updatesOnlyMerged = mergeByPubkeyServer presence updatesOnly in
475+ let updatesOnlyAfterOffline = removeOffline updatesOnlyMerged offlineOnlyKeys trustedOffline t in
476+ let reclaimSlots = maxPresenceEntries - count updatesOnlyAfterOffline in
477+ let newEntries = do e <- trustedDeduped; where none presence (\p -> samePubkeyServer p e); yield e in
478+ let reclaimedEntries = takeN newEntries reclaimSlots in
479+ {finalPresence: union updatesOnlyAfterOffline reclaimedEntries,
480+ appliedOnline: union
481+ (do e <- updatesOnly; where none presence (\p -> samePubkeyServer p e && p.expiresAt >= e.expiresAt); yield {pubkey: e.pubkey, server: e.server})
482+ (do e <- reclaimedEntries; yield {pubkey: e.pubkey, server: e.server}),
483+ withinCapacity: False {}}
484+
466485countMessagesFor = \messages toKey t ->
467486 count (do
468487 m <- messages
@@ -617,7 +636,7 @@ retryEvictedAcks = \evictedEntries pendingAcks ->
617636 a <- evictedEntries
618637 where none pendingAcks (\a2 -> a2.messageId == a.messageId && a2.toKey == a.toKey)
619638 yield a
620− in when (count evictedToRetry > 0) (do
639+ in do
621640 let evictedOriginServers = collectPeerServers evictedToRetry (\a -> a.originServer)
622641 sendToEach evictedOriginServers (\server -> do
623642 fetchResult <- fetch (federationScheme ++ server) (FederationAck {
@@ -637,7 +656,7 @@ retryEvictedAcks = \evictedEntries pendingAcks ->
637656 yield excess
638657 when (dropped > 0)
639658 (println ("ackMessages: ackedIds at capacity (" ++ show maxAckedIds ++ "), " ++ show dropped ++ " ack entries permanently lost for " ++ server))
640− _ -> yield {}))
659+ _ -> yield {})
641660
642661pruneAndRetry = \t -> do
643662 result <- atomic do
@@ -649,11 +668,9 @@ pruneAndRetry = \t -> do
649668 yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: forwards, pendingAcks: pendingAcks}
650669 broadcastOfflineGossip t result.peerServers result.expiredLocal
651670 when federationEnabled (do
652− when (count result.pendingForwards > 0)
653− (retryPendingForwards result.pendingForwards)
654− when (count result.pendingAcks > 0) (do
655− let ackOriginServers = collectPeerServers result.pendingAcks (\a -> a.originServer)
656− sendAcksAndClean result.pendingAcks ackOriginServers))
671+ retryPendingForwards result.pendingForwards
672+ let ackOriginServers = collectPeerServers result.pendingAcks (\a -> a.originServer)
673+ sendAcksAndClean result.pendingAcks ackOriginServers)
657674
658675pollOnce = \token cursor -> do
659676 t <- now
@@ -920,23 +937,10 @@ serve = \req -> case req of
920937 where any presence (\p -> samePubkeyServer p k && any trustedOffline (\o -> samePubkeyServer o k && (if o.timestamp > t then t else o.timestamp) > p.timestamp))
921938 yield {pubkey: k.pubkey, server: k.server}
922939 let afterOffline = removeOffline merged offlineOnlyKeys trustedOffline t
923− let withinCapacity = count afterOffline <= maxPresenceEntries
924− let capResult = if withinCapacity
925− then {finalPresence: afterOffline, appliedOnline: appliedOnline}
926− else
927− let updatesOnly = do e <- trustedDeduped; where any presence (\p -> samePubkeyServer p e); yield e in
928− let updatesOnlyMerged = mergeByPubkeyServer presence updatesOnly in
929− let updatesOnlyAfterOffline = removeOffline updatesOnlyMerged offlineOnlyKeys trustedOffline t in
930− let reclaimSlots = maxPresenceEntries - count updatesOnlyAfterOffline in
931− let newEntries = do e <- trustedDeduped; where none presence (\p -> samePubkeyServer p e); yield e in
932− let reclaimedEntries = takeN newEntries reclaimSlots in
933− {finalPresence: union updatesOnlyAfterOffline reclaimedEntries,
934− appliedOnline: union
935− (do e <- updatesOnly; where none presence (\p -> samePubkeyServer p e && p.expiresAt >= e.expiresAt); yield {pubkey: e.pubkey, server: e.server})
936− (do e <- reclaimedEntries; yield {pubkey: e.pubkey, server: e.server})}
940+ let capResult = capGossipPresence afterOffline appliedOnline trustedDeduped presence offlineOnlyKeys trustedOffline t
937941 set *presence = capResult.finalPresence
938942 let gossipPeerServers = collectPeerServers capResult.finalPresence (\p -> p.server)
939− yield {appliedKeys: union capResult.appliedOnline appliedOffline, pr: pr, gossipPeerServers: gossipPeerServers, withinCapacity: withinCapacity}
943+ yield {appliedKeys: union capResult.appliedOnline appliedOffline, pr: pr, gossipPeerServers: gossipPeerServers, withinCapacity: capResult.withinCapacity}
940944 let effectiveEvents = do
941945 e <- union filteredOnline filteredOffline
942946 where any gossipResult.appliedKeys (\a -> samePubkeyServer a e)