@@ -50,19 +50,33 @@ federationEnabled = federationSecret != ""
5050
5151type PollEvent = {id: MessageIdHex, eventType: Text, payload: {encryptedBlob: BlobHex, fromKey: PubkeyHex, timestamp: Timestamp, toKey: PubkeyHex}}
5252
53−type GossipEventType = Text where \s -> s == "online" || s == "offline"
53+type GossipEventType = GossipOnline {} | GossipOffline {}
54+
55+impl ToJSON GossipEventType where
56+ toJson et = toJson (case et of
57+ GossipOnline {} -> "online"
58+ GossipOffline {} -> "offline")
59+
60+impl FromJSON GossipEventType where
61+ parseJson t =
62+ let s : Text = parseJson t in
63+ if s == "online" then GossipOnline {} else GossipOffline {}
64+
65+isGossipOnline = \et -> case et of GossipOnline {} -> True {}; _ -> False {}
66+isGossipOffline = \et -> case et of GossipOffline {} -> True {}; _ -> False {}
5467
5568type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, timestamp: Timestamp, ttl: Int<S>}
5669
5770type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}
5871
59−isDeliveryStatus = \s -> s == "delivered" || s == "federated" || s == "queued"
60−type MessageStatus = Text where \s -> s == "unauthorized" || s == "rejected" || isDeliveryStatus s
72+type MessageStatus = Text where \s -> s == "unauthorized" || s == "rejected" || s == "delivered" || s == "federated" || s == "queued"
6173
6274type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) && s == normalizeHex s
6375type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s
6476type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen) && s == normalizeHex s
65−type MessageIdHex = Text where \s -> isValidHex s && not (tooLong s maxMessageIdLen) && s == normalizeHex s
77+isValidMessageId = \s -> isValidHex s && not (tooLong s maxMessageIdLen) && s == normalizeHex s
78+type MessageIdHex = Text where isValidMessageId
79+type OptionalMessageId = Text where \s -> s == "" || isValidMessageId s
6680isValidServerName = \s -> not (tooLong s maxServerNameLen) && s == normalizeServerName s && not (isBadServerName s)
6781type ServerName = Text where isValidServerName
6882type OptionalServerName = Text where \s -> s == "" || isValidServerName s
@@ -78,7 +92,11 @@ type ForwardEntry = {messageId: MessageIdHex, toServer: ServerName, createdAt: T
7892type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp, originServer: ServerName}
7993type AuthResult = Authorized {pubkey: PubkeyHex} | Unauthorized {}
8094type PruneResult = {expiredLocal: [PresenceEntry], peerServers: [ServerName]}
81−type DeliveryStatus = Text where isDeliveryStatus
95+type DeliveryStatus = Delivered {} | Federated {} | Queued {}
96+deliveryStatusText = \s -> case s of
97+ Delivered {} -> "delivered"
98+ Federated {} -> "federated"
99+ Queued {} -> "queued"
82100type SendResult = SendUnauthorized {} | SendRejected {} | SendDone {status: DeliveryStatus, remoteServers: [ServerName], fromKey: PubkeyHex}
83101
84102
@@ -121,13 +139,13 @@ route ClientApi where
121139 = Poll
122140 /messages
123141 POST {to: PubkeyHex, encryptedBlob: BlobHex, timestamp: Timestamp} / headers {authorization: Text}
124− -> {status: MessageStatus, messageId: Text}
142+ -> {status: MessageStatus, messageId: OptionalMessageId}
125143 = SendMessage
126144 POST {messageIds: [MessageIdHex]} /ack headers {authorization: Text}
127145 -> {ok: Bool}
128146 = AckMessages
129147 GET /lookup/{pubkey: PubkeyHex} headers {authorization: Text}
130− -> {online: Bool, server: Text, authorized: Bool}
148+ -> {online: Bool, server: AnyServerName, authorized: Bool}
131149 = LookupPresence
132150
133151route FederationApi where
@@ -204,28 +222,25 @@ containsBadUrlChar = \s -> any (chars s) (\c -> not (isAllowedServerChar c))
204222
205223isCgnatRange = \s ->
206224 if take 4 s != "100." then False {}
207− else if (take 1 (drop 4 s) == "7" || take 1 (drop 4 s) == "8" || take 1 (drop 4 s) == "9")
208− && isDigitChar (take 1 (drop 5 s)) && take 1 (drop 6 s) == "."
225+ else let d4 = take 1 (drop 4 s) in
226+ let d5 = take 1 (drop 5 s) in
227+ let d6 = take 1 (drop 6 s) in
228+ let d7 = take 1 (drop 7 s) in
229+ if contains d4 "789" && isDigitChar d5 && d6 == "."
209230 && isAllDigitsOrDotsUntilColonOrEnd (drop 7 s)
210231 then True {}
211− else if take 1 (drop 4 s) == "6"
212− && (take 1 (drop 5 s) == "4" || take 1 (drop 5 s) == "5" || take 1 (drop 5 s) == "6" || take 1 (drop 5 s) == "7" || take 1 (drop 5 s) == "8" || take 1 (drop 5 s) == "9")
213− && take 1 (drop 6 s) == "."
232+ else if d4 == "6" && contains d5 "456789" && d6 == "."
214233 && isAllDigitsOrDotsUntilColonOrEnd (drop 7 s)
215234 then True {}
216− else if take 1 (drop 4 s) == "1" && (take 1 (drop 5 s) == "0" || take 1 (drop 5 s) == "1")
217− && isDigitChar (take 1 (drop 6 s)) && take 1 (drop 7 s) == "."
235+ else if d4 == "1" && contains d5 "01" && isDigitChar d6 && d7 == "."
218236 && isAllDigitsOrDotsUntilColonOrEnd (drop 8 s)
219237 then True {}
220− else if take 1 (drop 4 s) == "1" && take 1 (drop 5 s) == "2"
221− && (take 1 (drop 6 s) == "0" || take 1 (drop 6 s) == "1" || take 1 (drop 6 s) == "2" || take 1 (drop 6 s) == "3"
222− || take 1 (drop 6 s) == "4" || take 1 (drop 6 s) == "5" || take 1 (drop 6 s) == "6" || take 1 (drop 6 s) == "7")
223− && take 1 (drop 7 s) == "."
238+ else if d4 == "1" && d5 == "2" && contains d6 "01234567" && d7 == "."
224239 && isAllDigitsOrDotsUntilColonOrEnd (drop 8 s)
225240 then True {}
226241 else False {}
227242
228−containsMultipleColons = \s -> count (do c <- chars s; where c == ":"; yield c) > 1
243+containsMultipleColons = \s -> fold (\n c -> if c == ":" then n + 1 else n) 0 (chars s) > 1
229244
230245hasOctalOctet = \s ->
231246 if take 1 s == "0" && isDigitChar (take 1 (drop 1 s)) && isAllDigitsOrDotsUntilColonOrEnd (drop 2 s) then True {}
@@ -273,30 +288,26 @@ containsSuffixN = \suffix suffixLen s ->
273288
274289containsSuffix = \suffix s -> containsSuffixN suffix (count (chars suffix)) s
275290
276−containsLocalhostSuffix = \s -> containsSuffix ".localhost" s
277−containsLocalSuffix = \s -> containsSuffix ".local" s
278−containsInternalSuffix = \s -> containsSuffix ".internal" s
279−
280291is172Private = \sn ->
281292 take 4 sn == "172."
282293 && let d1 = take 1 (drop 4 sn) in
283294 let d2 = take 1 (drop 5 sn) in
284295 take 1 (drop 6 sn) == "."
285− && ((d1 == "1" && (d2 == "6" || d2 == "7" || d2 == "8" || d2 == "9"))
296+ && ((d1 == "1" && contains d2 "6789")
286297 || (d1 == "2" && isDigitChar d2)
287− || (d1 == "3" && (d2 == "0" || d2 == "1")))
298+ || (d1 == "3" && contains d2 "01"))
288299
289300isHighOctetPrefix = \sn ->
290301 take 1 sn == "2"
291302 && let d2 = take 1 (drop 1 sn) in
292303 let d3 = take 1 (drop 2 sn) in
293304 take 1 (drop 3 sn) == "."
294− && ((d2 == "2" && (d3 == "4" || d3 == "5" || d3 == "6" || d3 == "7" || d3 == "8" || d3 == "9"))
295− || (d2 == "3" && isDigitChar d3)
296− || (d2 == "4" && isDigitChar d3)
297− || (d2 == "5" && (d3 == "0" || d3 == "1" || d3 == "2" || d3 == "3" || d3 == "4" || d3 == "5")))
305+ && ((d2 == "2" && contains d3 "456789")
306+ || (contains d2 "34" && isDigitChar d3)
307+ || (d2 == "5" && contains d3 "012345"))
298308
299−matchesHostname = \sn name nameLen ->
309+matchesHostname = \sn name ->
310+ let nameLen = count (chars name) in
300311 take nameLen sn == name && (drop nameLen sn == "" || take 1 (drop nameLen sn) == ":")
301312
302313isBadServerName = \sn ->
@@ -304,14 +315,14 @@ isBadServerName = \sn ->
304315 || take 1 sn == "."
305316 || take 1 sn == ":"
306317 || containsBadUrlChar sn
307− || matchesHostname sn "localhost" 9
308− || matchesHostname sn "localhost.localdomain" 21
309− || containsLocalhostSuffix sn
310− || matchesHostname sn "local" 5
311− || containsLocalSuffix sn
312− || matchesHostname sn "internal" 8
313− || containsInternalSuffix sn
314− || matchesHostname sn "metadata" 8
318+ || matchesHostname sn "localhost"
319+ || matchesHostname sn "localhost.localdomain"
320+ || containsSuffix ".localhost" sn
321+ || matchesHostname sn "local"
322+ || containsSuffix ".local" sn
323+ || matchesHostname sn "internal"
324+ || containsSuffix ".internal" sn
325+ || matchesHostname sn "metadata"
315326 || take 4 sn == "127." || take 3 sn == "10."
316327 || take 8 sn == "192.168." || take 8 sn == "169.254."
317328 || take 2 sn == "0." || take 1 sn == "["
@@ -573,7 +584,7 @@ broadcastOfflineGossip = \t peerServers expiredLocal ->
573584 let gossipEvents = mergeByKey (\a b -> a.pubkey == b.pubkey) (\x -> x.timestamp) [] (do
574585 p <- expiredLocal
575586 let ttl = clamp offlineGossipMinTtl maxPresenceTtl ((p.expiresAt - p.timestamp) / 1000)
576− yield {eventType: "offline", pubkey: p.pubkey, server: serverHostN, timestamp: p.expiresAt, ttl: ttl})
587+ yield {eventType: GossipOffline {}, pubkey: p.pubkey, server: serverHostN, timestamp: p.expiresAt, ttl: ttl})
577588 sendBatchedGossip peerServers gossipEvents 2)
578589
579590forkBroadcastOffline = \t result ->
@@ -764,7 +775,7 @@ serve = \req -> case req of
764775 else result.pr.expiredLocal
765776 fork (do
766777 when (result.verified && federationEnabled)
767− (sendBatchedGossip result.peerServers [{eventType: "online", pubkey: pubkey, server: serverHostN, timestamp: t, ttl: onlineGossipTtl}] 2)
778+ (sendBatchedGossip result.peerServers [{eventType: GossipOnline {}, pubkey: pubkey, server: serverHostN, timestamp: t, ttl: onlineGossipTtl}] 2)
768779 broadcastOfflineGossip t result.pr.peerServers expiredLocal)
769780 yield (if result.verified
770781 then respond {token: token, expiresAt: expiry}
@@ -808,9 +819,9 @@ serve = \req -> case req of
808819 forwards <- *forwards
809820 let forwardServers = takeN remoteServers (maxForwardsEntries - count forwards)
810821 let shouldForward = federationEnabled && count forwardServers > 0
811− let status = if localOnline then "delivered"
812− else if shouldForward then "federated"
813− else "queued"
822+ let status = if localOnline then Delivered {}
823+ else if shouldForward then Federated {}
824+ else Queued {}
814825 set *forwards = if shouldForward
815826 then union forwards (do s <- forwardServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})
816827 else forwards
@@ -825,14 +836,15 @@ serve = \req -> case req of
825836 timestamp: clampedTs, originServer: serverHostN, messageId: msgId,
826837 authorization: "Bearer " ++ federationSecret})
827838 whenOk fwdResult (removeForward msgId server))
828− when (status == "queued")
829− (println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")))
839+ case status of
840+ Queued {} -> println ("sendMessage: forwards at capacity (" ++ show maxForwardsEntries ++ "), skipping forward tracking")
841+ _ -> yield {})
830842 _ -> yield {}
831843 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
832844 yield (case result.send of
833845 SendUnauthorized _ -> respond {status: "unauthorized", messageId: ""}
834846 SendRejected _ -> respond {status: "rejected", messageId: ""}
835− SendDone {status} -> respond {status: status, messageId: msgId})
847+ SendDone {status} -> respond {status: deliveryStatusText status, messageId: msgId})
836848
837849 AckMessages {messageIds, authorization, respond} -> do
838850 t <- now
@@ -901,8 +913,8 @@ serve = \req -> case req of
901913 yield (respond {ok: False {}})
902914 else do
903915 let allValidEntries = validGossipEvents events t
904− let onlineEntries = do e <- allValidEntries; where e.eventType == "online"; yield e
905− let offlineEntries = do e <- allValidEntries; where e.eventType == "offline"; yield e
916+ let onlineEntries = do e <- allValidEntries; where isGossipOnline e.eventType; yield e
917+ let offlineEntries = do e <- allValidEntries; where isGossipOffline e.eventType; yield e
906918 let filteredOnline = do
907919 e <- onlineEntries
908920 where none offlineEntries (\o -> o.server == fromServer && samePubkeyServer o e && o.timestamp > e.timestamp)