@@ -10,8 +10,10 @@ serverHost = "localhost:8080"
10federationSecret = "" -- must be set to enable federation
10federationSecret = "" -- must be set to enable federation
11maintenanceSecret = "" -- set to enable /maintenance/prune independently of federation
11maintenanceSecret = "" -- set to enable /maintenance/prune independently of federation
12federationScheme = "https://" -- scheme for federation HTTP calls
12federationScheme = "https://" -- scheme for federation HTTP calls
13+messageMaxAge : Int<Ms>
13−messageMaxAge = 2592000000 -- 30 days in milliseconds
14+messageMaxAge = 2592000000 -- 30 days
15+maxPresenceTtl : Int<S>
14−maxPresenceTtl = 3600 -- max presence TTL from gossip in seconds
16+maxPresenceTtl = 3600 -- max presence TTL from gossip
15maxPubkeyLen = 256
17maxPubkeyLen = 256
16maxBlobLen = 65536
18maxBlobLen = 65536
17maxSignatureLen = 256
19maxSignatureLen = 256
@@ -20,6 +22,7 @@ maxGossipEvents = 100
20maxPollEvents = 50
22maxPollEvents = 50
21maxPresenceEntries = 10000
23maxPresenceEntries = 10000
22maxMessagesPerRecipient = 500
24maxMessagesPerRecipient = 500
25+clockSkewTolerance : Int<Ms>
23clockSkewTolerance = 5000 -- 5 seconds tolerance for clock skew between federated servers
26clockSkewTolerance = 5000 -- 5 seconds tolerance for clock skew between federated servers
24maxForwardsEntries = 10000
27maxForwardsEntries = 10000
25maxServerNameLen = 128
28maxServerNameLen = 128
@@ -30,12 +33,16 @@ maxSessions = 10000
30maxAckedIds = 10000
33maxAckedIds = 10000
31maxChallengesPerKey = 5
34maxChallengesPerKey = 5
32maxSessionsPerKey = 10
35maxSessionsPerKey = 10
33−challengeExpiry = 60000 -- 1 minute in milliseconds
36+challengeExpiry : Int<Ms>
37+challengeExpiry = 60000 -- 1 minute
38+sessionExpiry : Int<Ms>
34−sessionExpiry = 3600000 -- 1 hour in milliseconds
39+sessionExpiry = 3600000 -- 1 hour
40+onlineGossipTtl : Int<S>
35−onlineGossipTtl = 3600 -- 1 hour in seconds
41+onlineGossipTtl = 3600 -- 1 hour
42+offlineGossipMinTtl : Int<S>
36−offlineGossipMinTtl = 60 -- minimum TTL for offline gossip events in seconds
43+offlineGossipMinTtl = 60 -- minimum TTL for offline gossip events
37maxForwardRetriesPerServer = 100
44maxForwardRetriesPerServer = 100
38−federationEnabled = not (federationSecret == "")
45+federationEnabled = federationSecret != ""
40-- ============================================
47-- ============================================
@@ -47,7 +54,7 @@ type PollEvent = {id: MessageIdHex, eventType: PollEventType, payload: {encrypte
48type GossipEventType = Text where \s -> s == "online" || s == "offline"
55type GossipEventType = Text where \s -> s == "online" || s == "offline"
50−type GossipEvent = {eventType: GossipEventType, pubkey: Text, server: Text, timestamp: Timestamp, ttl: Int<S>}
57+type GossipEvent = {eventType: GossipEventType, pubkey: PubkeyHex, server: Text, timestamp: Timestamp, ttl: Int<S>}
52type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}
59type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}
@@ -57,8 +64,8 @@ type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) &
57type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s
64type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s
58type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen) && s == normalizeHex s
65type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen) && s == normalizeHex s
59type MessageIdHex = Text where \s -> isValidHex s && not (tooLong s maxMessageIdLen) && s == normalizeHex s
66type MessageIdHex = Text where \s -> isValidHex s && not (tooLong s maxMessageIdLen) && s == normalizeHex s
60−type ServerName = Text where \s -> not (tooLong s maxServerNameLen) && not (isBadServerName s)
67+type ServerName = Text where \s -> not (tooLong s maxServerNameLen) && not (isBadServerName s) && s == normalizeServerName s
61−type OptionalServerName = Text where \s -> s == "" || (not (tooLong s maxServerNameLen) && not (isBadServerName s))
68+type OptionalServerName = Text where \s -> s == "" || (not (tooLong s maxServerNameLen) && not (isBadServerName s) && s == normalizeServerName s)
63type Timestamp = Int<Ms>
70type Timestamp = Int<Ms>
@@ -156,12 +163,7 @@ headOf = \items -> fold (\acc x -> case acc of
156 Nothing {} -> Just {value: x}
163 Nothing {} -> Just {value: x}
157 _ -> acc) Nothing {} items
164 _ -> acc) Nothing {} items
159−hexDigit = \n ->
166+hexDigit = \n -> take 1 (drop (clamp 0 15 n) "0123456789abcdef")
160− let n = if n < 0 then 0 else if n > 15 then 15 else n in
161− if n == 0 then "0" else if n == 1 then "1" else if n == 2 then "2" else if n == 3 then "3"
162− else if n == 4 then "4" else if n == 5 then "5" else if n == 6 then "6" else if n == 7 then "7"
163− else if n == 8 then "8" else if n == 9 then "9" else if n == 10 then "a" else if n == 11 then "b"
164− else if n == 12 then "c" else if n == 13 then "d" else if n == 14 then "e" else "f"
166byteToHex = \n -> hexDigit (n / 16) ++ hexDigit (n - (n / 16) * 16)
168byteToHex = \n -> hexDigit (n / 16) ++ hexDigit (n - (n / 16) * 16)
@@ -179,12 +181,9 @@ genTokenN = \n -> if n <= 0 then yield "" else do
180genToken = genTokenN 8
182genToken = genTokenN 8
182−tooLong = \s maxLen -> not (drop maxLen s == "")
184+tooLong = \s maxLen -> drop maxLen s != ""
184−isHexChar = \c ->
186+isHexChar = \c -> contains c "0123456789abcdefABCDEF"
185− c == "0" || c == "1" || c == "2" || c == "3" || c == "4" || c == "5" || c == "6" || c == "7" || c == "8" || c == "9" ||
186− c == "a" || c == "b" || c == "c" || c == "d" || c == "e" || c == "f" ||
187− c == "A" || c == "B" || c == "C" || c == "D" || c == "E" || c == "F"
189isValidHexPairs = \s ->
188isValidHexPairs = \s ->
190 if s == "" then True {}
189 if s == "" then True {}
@@ -192,27 +191,18 @@ isValidHexPairs = \s ->
192 else if isHexChar (take 1 s) && isHexChar (take 1 (drop 1 s)) then isValidHexPairs (drop 2 s)
191 else if isHexChar (take 1 s) && isHexChar (take 1 (drop 1 s)) then isValidHexPairs (drop 2 s)
193 else False {}
192 else False {}
195−isValidHex = \s -> not (s == "") && isValidHexPairs s
194+isValidHex = \s -> s != "" && isValidHexPairs s
197normalizeHex = \s -> bytesToHex (bytesFromHex s)
196normalizeHex = \s -> bytesToHex (bytesFromHex s)
199−isDigitChar = \c -> c == "0" || c == "1" || c == "2" || c == "3" || c == "4" || c == "5" || c == "6" || c == "7" || c == "8" || c == "9"
198+isDigitChar = \c -> contains c "0123456789"
201−isAllowedServerChar = \c ->
200+isAllowedServerChar = \c -> contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:"
202− isDigitChar c || c == "-" || c == "." || c == ":"
203− || c == "a" || c == "b" || c == "c" || c == "d" || c == "e" || c == "f"
204− || c == "g" || c == "h" || c == "i" || c == "j" || c == "k" || c == "l"
205− || c == "m" || c == "n" || c == "o" || c == "p" || c == "q" || c == "r"
206− || c == "s" || c == "t" || c == "u" || c == "v" || c == "w" || c == "x"
207− || c == "y" || c == "z"
209−containsBadUrlChar = \s ->
202+containsBadUrlChar = \s -> any (chars s) (\c -> not (isAllowedServerChar c))
210− if s == "" then False {}
211− else if not (isAllowedServerChar (take 1 s)) then True {}
212− else containsBadUrlChar (drop 1 s)
214isCgnatRange = \s ->
204isCgnatRange = \s ->
215− if not (take 4 s == "100.") then False {}
205+ if take 4 s != "100." then False {}
216 else if (take 1 (drop 4 s) == "7" || take 1 (drop 4 s) == "8" || take 1 (drop 4 s) == "9")
206 else if (take 1 (drop 4 s) == "7" || take 1 (drop 4 s) == "8" || take 1 (drop 4 s) == "9")
217 && isDigitChar (take 1 (drop 5 s)) && take 1 (drop 6 s) == "."
207 && isDigitChar (take 1 (drop 5 s)) && take 1 (drop 6 s) == "."
218 && isAllDigitsOrDotsUntilColonOrEnd (drop 7 s)
208 && isAllDigitsOrDotsUntilColonOrEnd (drop 7 s)
@@ -234,15 +224,9 @@ isCgnatRange = \s ->
234 then True {}
224 then True {}
235 else False {}
225 else False {}
237−containsColon = \s ->
227+containsColon = \s -> contains ":" s
238− if s == "" then False {}
239− else if take 1 s == ":" then True {}
240− else containsColon (drop 1 s)
242−containsMultipleColons = \s ->
229+containsMultipleColons = \s -> count (do c <- chars s; where c == ":"; yield c) > 1
243− if s == "" then False {}
244− else if take 1 s == ":" then containsColon (drop 1 s)
245− else containsMultipleColons (drop 1 s)
247hasOctalOctet = \s ->
231hasOctalOctet = \s ->
248 if take 1 s == "0" && isDigitChar (take 1 (drop 1 s)) && isAllDigitsOrDotsUntilColonOrEnd (drop 2 s) then True {}
232 if take 1 s == "0" && isDigitChar (take 1 (drop 1 s)) && isAllDigitsOrDotsUntilColonOrEnd (drop 2 s) then True {}
@@ -268,22 +252,6 @@ isAllDigitsOrDotsUntilColonOrEnd = \s ->
268 else if isDigitChar (take 1 s) || take 1 s == "." then isAllDigitsOrDotsUntilColonOrEnd (drop 1 s)
252 else if isDigitChar (take 1 s) || take 1 s == "." then isAllDigitsOrDotsUntilColonOrEnd (drop 1 s)
269 else False {}
253 else False {}
272− if c == "A" then "a" else if c == "B" then "b" else if c == "C" then "c"
273− else if c == "D" then "d" else if c == "E" then "e" else if c == "F" then "f"
274− else if c == "G" then "g" else if c == "H" then "h" else if c == "I" then "i"
275− else if c == "J" then "j" else if c == "K" then "k" else if c == "L" then "l"
276− else if c == "M" then "m" else if c == "N" then "n" else if c == "O" then "o"
277− else if c == "P" then "p" else if c == "Q" then "q" else if c == "R" then "r"
278− else if c == "S" then "s" else if c == "T" then "t" else if c == "U" then "u"
279− else if c == "V" then "v" else if c == "W" then "w" else if c == "X" then "x"
280− else if c == "Y" then "y" else if c == "Z" then "z"
285− else toLowerChar (take 1 s) ++ toLower (drop 1 s)
287isTrailingDots = \s ->
255isTrailingDots = \s ->
288 if s == "" then True {}
256 if s == "" then True {}
289 else if take 1 s == ":" then True {}
257 else if take 1 s == ":" then True {}
@@ -379,7 +347,7 @@ extractToken = \authHeader ->
381verifySecret = \token secret ->
349verifySecret = \token secret ->
382− not (secret == "") && safeCompare token secret
350+ secret != "" && safeCompare token secret
384verifyFederationAuth = \authorization ->
352verifyFederationAuth = \authorization ->
385 verifySecret (extractToken authorization) federationSecret
353 verifySecret (extractToken authorization) federationSecret
@@ -394,7 +362,7 @@ clampTimestamp = \timestamp t -> clamp (t - messageMaxAge) t timestamp
395nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
363nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
397−isFederatedOrigin = \originServer -> not (originServer == "" || originServer == serverHostN)
365+isFederatedOrigin = \originServer -> originServer != "" && originServer != serverHostN
399takeN = \items n -> (fold (\acc e -> if acc.n >= n then acc else {n: acc.n + 1, items: union acc.items [e]}) {n: 0, items: []} items).items
367takeN = \items n -> (fold (\acc e -> if acc.n >= n then acc else {n: acc.n + 1, items: union acc.items [e]}) {n: 0, items: []} items).items
@@ -508,20 +476,20 @@ countMessagesFor = \messages toKey t ->
508validGossipEvents : [GossipEvent] -> Timestamp -> [ValidGossipEntry]
476validGossipEvents : [GossipEvent] -> Timestamp -> [ValidGossipEntry]
509validGossipEvents = \events t -> do
477validGossipEvents = \events t -> do
510 e <- events
478 e <- events
511− where isValidHex e.pubkey && not (tooLong e.pubkey maxPubkeyLen) && not (tooLong e.server maxServerNameLen) && not (isBadServerName e.server)
479+ where not (tooLong e.server maxServerNameLen) && not (isBadServerName e.server)
512 let server = normalizeServerName e.server
480 let server = normalizeServerName e.server
513− where not (server == serverHostN) && e.timestamp <= t + clockSkewTolerance
481+ where server != serverHostN && e.timestamp <= t + clockSkewTolerance
514 let ttl = clampTtl e.ttl
482 let ttl = clampTtl e.ttl
515 let expiresAt = e.timestamp + ttl * 1000
483 let expiresAt = e.timestamp + ttl * 1000
516 where expiresAt > t
484 where expiresAt > t
517− yield {eventType: e.eventType, pubkey: normalizeHex e.pubkey, server: server, expiresAt: expiresAt, timestamp: e.timestamp, ttl: ttl}
485+ yield {eventType: e.eventType, pubkey: e.pubkey, server: server, expiresAt: expiresAt, timestamp: e.timestamp, ttl: ttl}
519sendToEach : [ServerName] -> (ServerName -> (a {})) -> a {}
487sendToEach : [ServerName] -> (ServerName -> (a {})) -> a {}
520sendToEach = \servers action ->
488sendToEach = \servers action ->
521 case headOf servers of
489 case headOf servers of
522 Nothing {} -> yield {}
490 Nothing {} -> yield {}
523 Just {value: server} -> do
491 Just {value: server} -> do
524− let rest = do s <- servers; where not (s == server); yield s
492+ let rest = do s <- servers; where s != server; yield s
525 fork (action server)
493 fork (action server)
526 sendToEach rest action
494 sendToEach rest action
@@ -617,7 +585,7 @@ retryForwardsForServer = \entries remaining ->
617 else case headOf entries of
585 else case headOf entries of
618 Nothing {} -> yield {}
586 Nothing {} -> yield {}
619 Just {value: f} -> do
587 Just {value: f} -> do
620− let rest = do x <- entries; where not (x.messageId == f.messageId); yield x
588+ let rest = do x <- entries; where x.messageId != f.messageId; yield x
621 result <- fetch (federationScheme ++ f.toServer) (ForwardMessage {
589 result <- fetch (federationScheme ++ f.toServer) (ForwardMessage {
622 toKey: f.toKey, fromKey: f.fromKey, encryptedBlob: f.encryptedBlob,
590 toKey: f.toKey, fromKey: f.fromKey, encryptedBlob: f.encryptedBlob,
623 timestamp: f.timestamp, originServer: serverHostN, messageId: f.messageId,
591 timestamp: f.timestamp, originServer: serverHostN, messageId: f.messageId,
@@ -782,7 +750,7 @@ serve = \req -> case req of
783 yield {pr: pr, verified: True {}, peerServers: peerServers}
751 yield {pr: pr, verified: True {}, peerServers: peerServers}
784 let expiredLocal = if result.verified
752 let expiredLocal = if result.verified
785− then do p <- result.pr.expiredLocal; where not (p.pubkey == pubkey); yield p
753+ then do p <- result.pr.expiredLocal; where p.pubkey != pubkey; yield p
786 else result.pr.expiredLocal
754 else result.pr.expiredLocal
788 when (result.verified && federationEnabled)
756 when (result.verified && federationEnabled)
@@ -826,7 +794,7 @@ serve = \req -> case req of
826 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: seqTs}]
794 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: seqTs}]
827 let toPresence = do p <- presence; where p.pubkey == to && p.expiresAt > t; yield p
795 let toPresence = do p <- presence; where p.pubkey == to && p.expiresAt > t; yield p
828 let localOnline = any toPresence (\p -> p.server == serverHostN)
796 let localOnline = any toPresence (\p -> p.server == serverHostN)
829− let remoteServers = do p <- toPresence; where not (p.server == serverHostN); yield p.server
797+ let remoteServers = do p <- toPresence; where p.server != serverHostN; yield p.server
830 forwards <- *forwards
798 forwards <- *forwards
831 let forwardServers = takeN remoteServers (maxForwardsEntries - count forwards)
799 let forwardServers = takeN remoteServers (maxForwardsEntries - count forwards)
832 let shouldForward = federationEnabled && count forwardServers > 0
800 let shouldForward = federationEnabled && count forwardServers > 0
@@ -911,13 +879,12 @@ serve = \req -> case req of
911 else acc) {server: "", best: 0} valid).server
879 else acc) {server: "", best: 0} valid).server
912 yield {pr: pr, authorized: True {}, foundServer: foundServer}
880 yield {pr: pr, authorized: True {}, foundServer: foundServer}
913 forkBroadcastOffline t result.pr
881 forkBroadcastOffline t result.pr
914− yield (respond {online: not (result.foundServer == ""), server: result.foundServer, authorized: result.authorized})
882+ yield (respond {online: result.foundServer != "", server: result.foundServer, authorized: result.authorized})
916 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
884 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
918 let authorized = verifyFederationAuth authorization
886 let authorized = verifyFederationAuth authorization
919 let cappedHops = clamp 0 5 hopsRemaining
887 let cappedHops = clamp 0 5 hopsRemaining
920− let fromServer = normalizeServerName fromServer
921 if not authorized || cappedHops < 1 || fromServer == serverHostN || count events > maxGossipEvents
888 if not authorized || cappedHops < 1 || fromServer == serverHostN || count events > maxGossipEvents
923 maybePruneAndBroadcast t
890 maybePruneAndBroadcast t
@@ -987,7 +954,7 @@ serve = \req -> case req of
987 when (cappedHops > 1 && federationEnabled && count effectiveEvents > 0) (
954 when (cappedHops > 1 && federationEnabled && count effectiveEvents > 0) (
988 let targets = do
955 let targets = do
989 s <- gossipResult.gossipPeerServers
956 s <- gossipResult.gossipPeerServers
990− where not (s == fromServer)
957+ where s != fromServer
992 in sendBatchedGossip targets effectiveEvents (cappedHops - 1))
959 in sendBatchedGossip targets effectiveEvents (cappedHops - 1))
993 let pr = gossipResult.pr
960 let pr = gossipResult.pr
@@ -995,11 +962,10 @@ serve = \req -> case req of
995 yield (respond {ok: True {}})
962 yield (respond {ok: True {}})
997 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
964 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
998− let originServer = normalizeServerName originServer
1000 let authorized = verifyFederationAuth authorization
966 let authorized = verifyFederationAuth authorization
1001 let validOrigin = isFederatedOrigin originServer
967 let validOrigin = isFederatedOrigin originServer
1002− if not (authorized && validOrigin)
968+ if not authorized || not validOrigin
1004 maybePruneAndBroadcast t
970 maybePruneAndBroadcast t
1005 yield (respond {ok: False {}})
971 yield (respond {ok: False {}})
@@ -1026,11 +992,9 @@ serve = \req -> case req of
1026 yield (respond {ok: result.ok})
992 yield (respond {ok: result.ok})
1028 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
994 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
1029− let fromServer = normalizeServerName fromServer
1030− let originServer = normalizeServerName originServer
1031 t <- now
995 t <- now
1032 let authorized = verifyFederationAuth authorization
996 let authorized = verifyFederationAuth authorization
1033− if not authorized || not (originServer == serverHostN) || fromServer == serverHostN
997+ if not authorized || originServer != serverHostN || fromServer == serverHostN
1035 maybePruneAndBroadcast t
999 maybePruneAndBroadcast t
1036 yield (respond {ok: False {}})
1000 yield (respond {ok: False {}})