@@ -10,8 +10,10 @@ serverHost = "localhost:8080"
1010federationSecret = "" -- must be set to enable federation
1111maintenanceSecret = "" -- set to enable /maintenance/prune independently of federation
1212federationScheme = "https://" -- scheme for federation HTTP calls
13−messageMaxAge = 2592000000 -- 30 days in milliseconds
14−maxPresenceTtl = 3600 -- max presence TTL from gossip in seconds
13+messageMaxAge : Int<Ms>
14+messageMaxAge = 2592000000 -- 30 days
15+maxPresenceTtl : Int<S>
16+maxPresenceTtl = 3600 -- max presence TTL from gossip
1517maxPubkeyLen = 256
1618maxBlobLen = 65536
1719maxSignatureLen = 256
@@ -20,6 +22,7 @@ maxGossipEvents = 100
2022maxPollEvents = 50
2123maxPresenceEntries = 10000
2224maxMessagesPerRecipient = 500
25+clockSkewTolerance : Int<Ms>
2326clockSkewTolerance = 5000 -- 5 seconds tolerance for clock skew between federated servers
2427maxForwardsEntries = 10000
2528maxServerNameLen = 128
@@ -30,12 +33,16 @@ maxSessions = 10000
3033maxAckedIds = 10000
3134maxChallengesPerKey = 5
3235maxSessionsPerKey = 10
33−challengeExpiry = 60000 -- 1 minute in milliseconds
34−sessionExpiry = 3600000 -- 1 hour in milliseconds
35−onlineGossipTtl = 3600 -- 1 hour in seconds
36−offlineGossipMinTtl = 60 -- minimum TTL for offline gossip events in seconds
36+challengeExpiry : Int<Ms>
37+challengeExpiry = 60000 -- 1 minute
38+sessionExpiry : Int<Ms>
39+sessionExpiry = 3600000 -- 1 hour
40+onlineGossipTtl : Int<S>
41+onlineGossipTtl = 3600 -- 1 hour
42+offlineGossipMinTtl : Int<S>
43+offlineGossipMinTtl = 60 -- minimum TTL for offline gossip events
3744maxForwardRetriesPerServer = 100
38−federationEnabled = not (federationSecret == "")
45+federationEnabled = federationSecret != ""
3946
4047-- ============================================
4148-- Types
@@ -47,7 +54,7 @@ type PollEvent = {id: MessageIdHex, eventType: PollEventType, payload: {encrypte
4754
4855type GossipEventType = Text where \s -> s == "online" || s == "offline"
4956
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>}
5158
5259type ValidGossipEntry = {eventType: GossipEventType, pubkey: PubkeyHex, server: ServerName, expiresAt: Timestamp, timestamp: Timestamp, ttl: Int<S>}
5360
@@ -57,8 +64,8 @@ type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen) &
5764type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen) && s == normalizeHex s
5865type SignatureHex = Text where \s -> isValidHex s && not (tooLong s maxSignatureLen) && s == normalizeHex s
5966type 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)
61−type OptionalServerName = Text where \s -> s == "" || (not (tooLong s maxServerNameLen) && not (isBadServerName s))
67+type ServerName = Text where \s -> not (tooLong s maxServerNameLen) && not (isBadServerName s) && s == normalizeServerName s
68+type OptionalServerName = Text where \s -> s == "" || (not (tooLong s maxServerNameLen) && not (isBadServerName s) && s == normalizeServerName s)
6269
6370type Timestamp = Int<Ms>
6471
@@ -156,12 +163,7 @@ headOf = \items -> fold (\acc x -> case acc of
156163 Nothing {} -> Just {value: x}
157164 _ -> acc) Nothing {} items
158165
159−hexDigit = \n ->
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"
166+hexDigit = \n -> take 1 (drop (clamp 0 15 n) "0123456789abcdef")
165167
166168byteToHex = \n -> hexDigit (n / 16) ++ hexDigit (n - (n / 16) * 16)
167169
@@ -179,12 +181,9 @@ genTokenN = \n -> if n <= 0 then yield "" else do
179181
180182genToken = genTokenN 8
181183
182−tooLong = \s maxLen -> not (drop maxLen s == "")
184+tooLong = \s maxLen -> drop maxLen s != ""
183185
184−isHexChar = \c ->
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"
186+isHexChar = \c -> contains c "0123456789abcdefABCDEF"
188187
189188isValidHexPairs = \s ->
190189 if s == "" then True {}
@@ -192,27 +191,18 @@ isValidHexPairs = \s ->
192191 else if isHexChar (take 1 s) && isHexChar (take 1 (drop 1 s)) then isValidHexPairs (drop 2 s)
193192 else False {}
194193
195−isValidHex = \s -> not (s == "") && isValidHexPairs s
194+isValidHex = \s -> s != "" && isValidHexPairs s
196195
197196normalizeHex = \s -> bytesToHex (bytesFromHex s)
198197
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"
200199
201−isAllowedServerChar = \c ->
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"
200+isAllowedServerChar = \c -> contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:"
208201
209−containsBadUrlChar = \s ->
210− if s == "" then False {}
211− else if not (isAllowedServerChar (take 1 s)) then True {}
212− else containsBadUrlChar (drop 1 s)
202+containsBadUrlChar = \s -> any (chars s) (\c -> not (isAllowedServerChar c))
213203
214204isCgnatRange = \s ->
215− if not (take 4 s == "100.") then False {}
205+ if take 4 s != "100." then False {}
216206 else if (take 1 (drop 4 s) == "7" || take 1 (drop 4 s) == "8" || take 1 (drop 4 s) == "9")
217207 && isDigitChar (take 1 (drop 5 s)) && take 1 (drop 6 s) == "."
218208 && isAllDigitsOrDotsUntilColonOrEnd (drop 7 s)
@@ -234,15 +224,9 @@ isCgnatRange = \s ->
234224 then True {}
235225 else False {}
236226
237−containsColon = \s ->
238− if s == "" then False {}
239− else if take 1 s == ":" then True {}
240− else containsColon (drop 1 s)
227+containsColon = \s -> contains ":" s
241228
242−containsMultipleColons = \s ->
243− if s == "" then False {}
244− else if take 1 s == ":" then containsColon (drop 1 s)
245− else containsMultipleColons (drop 1 s)
229+containsMultipleColons = \s -> count (do c <- chars s; where c == ":"; yield c) > 1
246230
247231hasOctalOctet = \s ->
248232 if take 1 s == "0" && isDigitChar (take 1 (drop 1 s)) && isAllDigitsOrDotsUntilColonOrEnd (drop 2 s) then True {}
@@ -268,22 +252,6 @@ isAllDigitsOrDotsUntilColonOrEnd = \s ->
268252 else if isDigitChar (take 1 s) || take 1 s == "." then isAllDigitsOrDotsUntilColonOrEnd (drop 1 s)
269253 else False {}
270254
271−toLowerChar = \c ->
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"
281− else c
282−
283−toLower = \s ->
284− if s == "" then ""
285− else toLowerChar (take 1 s) ++ toLower (drop 1 s)
286−
287255isTrailingDots = \s ->
288256 if s == "" then True {}
289257 else if take 1 s == ":" then True {}
@@ -379,7 +347,7 @@ extractToken = \authHeader ->
379347 else ""
380348
381349verifySecret = \token secret ->
382− not (secret == "") && safeCompare token secret
350+ secret != "" && safeCompare token secret
383351
384352verifyFederationAuth = \authorization ->
385353 verifySecret (extractToken authorization) federationSecret
@@ -394,7 +362,7 @@ clampTimestamp = \timestamp t -> clamp (t - messageMaxAge) t timestamp
394362
395363nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
396364
397−isFederatedOrigin = \originServer -> not (originServer == "" || originServer == serverHostN)
365+isFederatedOrigin = \originServer -> originServer != "" && originServer != serverHostN
398366
399367takeN = \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
400368
@@ -508,20 +476,20 @@ countMessagesFor = \messages toKey t ->
508476validGossipEvents : [GossipEvent] -> Timestamp -> [ValidGossipEntry]
509477validGossipEvents = \events t -> do
510478 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)
512480 let server = normalizeServerName e.server
513− where not (server == serverHostN) && e.timestamp <= t + clockSkewTolerance
481+ where server != serverHostN && e.timestamp <= t + clockSkewTolerance
514482 let ttl = clampTtl e.ttl
515483 let expiresAt = e.timestamp + ttl * 1000
516484 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}
518486
519487sendToEach : [ServerName] -> (ServerName -> (a {})) -> a {}
520488sendToEach = \servers action ->
521489 case headOf servers of
522490 Nothing {} -> yield {}
523491 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
525493 fork (action server)
526494 sendToEach rest action
527495
@@ -617,7 +585,7 @@ retryForwardsForServer = \entries remaining ->
617585 else case headOf entries of
618586 Nothing {} -> yield {}
619587 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
621589 result <- fetch (federationScheme ++ f.toServer) (ForwardMessage {
622590 toKey: f.toKey, fromKey: f.fromKey, encryptedBlob: f.encryptedBlob,
623591 timestamp: f.timestamp, originServer: serverHostN, messageId: f.messageId,
@@ -782,7 +750,7 @@ serve = \req -> case req of
782750 else []
783751 yield {pr: pr, verified: True {}, peerServers: peerServers}
784752 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
786754 else result.pr.expiredLocal
787755 fork (do
788756 when (result.verified && federationEnabled)
@@ -826,7 +794,7 @@ serve = \req -> case req of
826794 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: seqTs}]
827795 let toPresence = do p <- presence; where p.pubkey == to && p.expiresAt > t; yield p
828796 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
830798 forwards <- *forwards
831799 let forwardServers = takeN remoteServers (maxForwardsEntries - count forwards)
832800 let shouldForward = federationEnabled && count forwardServers > 0
@@ -911,13 +879,12 @@ serve = \req -> case req of
911879 else acc) {server: "", best: 0} valid).server
912880 yield {pr: pr, authorized: True {}, foundServer: foundServer}
913881 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})
915883
916884 RecvGossip {events, hopsRemaining, fromServer, authorization, respond} -> do
917885 t <- now
918886 let authorized = verifyFederationAuth authorization
919887 let cappedHops = clamp 0 5 hopsRemaining
920− let fromServer = normalizeServerName fromServer
921888 if not authorized || cappedHops < 1 || fromServer == serverHostN || count events > maxGossipEvents
922889 then do
923890 maybePruneAndBroadcast t
@@ -987,7 +954,7 @@ serve = \req -> case req of
987954 when (cappedHops > 1 && federationEnabled && count effectiveEvents > 0) (
988955 let targets = do
989956 s <- gossipResult.gossipPeerServers
990− where not (s == fromServer)
957+ where s != fromServer
991958 yield s
992959 in sendBatchedGossip targets effectiveEvents (cappedHops - 1))
993960 let pr = gossipResult.pr
@@ -995,11 +962,10 @@ serve = \req -> case req of
995962 yield (respond {ok: True {}})
996963
997964 ForwardMessage {toKey, fromKey, encryptedBlob, timestamp, originServer, messageId, authorization, respond} -> do
998− let originServer = normalizeServerName originServer
999965 t <- now
1000966 let authorized = verifyFederationAuth authorization
1001967 let validOrigin = isFederatedOrigin originServer
1002− if not (authorized && validOrigin)
968+ if not authorized || not validOrigin
1003969 then do
1004970 maybePruneAndBroadcast t
1005971 yield (respond {ok: False {}})
@@ -1026,11 +992,9 @@ serve = \req -> case req of
1026992 yield (respond {ok: result.ok})
1027993
1028994 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
1029− let fromServer = normalizeServerName fromServer
1030− let originServer = normalizeServerName originServer
1031995 t <- now
1032996 let authorized = verifyFederationAuth authorization
1033− if not authorized || not (originServer == serverHostN) || fromServer == serverHostN
997+ if not authorized || originServer != serverHostN || fromServer == serverHostN
1034998 then do
1035999 maybePruneAndBroadcast t
10361000 yield (respond {ok: False {}})