77e2bb1 · skrepka · git.iko.soy

git.iko.soy/skrepka

on master help sign in

Simplify code and improve type safety with helper functions and refined types

77e2bb1iko6 months ago

server.knot+80−147

compare with master

unifiedsplit

@@ -35,6 +35,7 @@ sessionExpiry = 3600000 -- 1 hour in milliseconds

35onlineGossipTtl = 3600 -- 1 hour in seconds

36offlineGossipMinTtl = 60 -- minimum TTL for offline gossip events in seconds

37maxForwardRetriesPerServer = 100

38+federationEnabled = not (federationSecret == "")

39-- ============================================

40-- ============================================

40-- Types

41-- Types

@@ -42,7 +43,9 @@ maxForwardRetriesPerServer = 100

43type PollEvent = {id: Text, eventType: Text, payload: {encryptedBlob: Text, fromKey: Text, timestamp: Timestamp, toKey: Text}}

44type PollEvent = {id: Text, eventType: Text, payload: {encryptedBlob: Text, fromKey: Text, timestamp: Timestamp, toKey: Text}}

46+type GossipEventType = Text where \s -> s == "online" || s == "offline"

47+

45−type GossipEvent = {eventType: Text, pubkey: Text, server: Text, timestamp: Timestamp, ttl: Int<S>}

48+type GossipEvent = {eventType: GossipEventType, pubkey: Text, server: Text, timestamp: Timestamp, ttl: Int<S>}

47type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen)

50type PubkeyHex = Text where \s -> isValidHex s && not (tooLong s maxPubkeyLen)

48type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen)

51type BlobHex = Text where \s -> isValidHex s && not (tooLong s maxBlobLen)

@@ -124,6 +127,12 @@ route Api = AuthApi | ClientApi | FederationApi | MaintenanceApi

124-- Helpers

127-- Helpers

125-- ============================================

128-- ============================================

126

129

130+any = \xs pred -> count (do x <- xs; where pred x; yield x) > 0

131+none = \xs pred -> count (do x <- xs; where pred x; yield x) == 0

132+isJust = \m -> case m of

133+ Nothing {} -> False {}

134+ _ -> True {}

135+

127msToS : Int<Ms> -> Int<S>

136msToS : Int<Ms> -> Int<S>

128msToS = \x -> x / 1000

137msToS = \x -> x / 1000

129

138

@@ -288,6 +297,25 @@ containsLocalhostSuffix = \s -> containsSuffix ".localhost" 10 s

288containsLocalSuffix = \s -> containsSuffix ".local" 6 s

297containsLocalSuffix = \s -> containsSuffix ".local" 6 s

289containsInternalSuffix = \s -> containsSuffix ".internal" 9 s

298containsInternalSuffix = \s -> containsSuffix ".internal" 9 s

290

299

300+is172Private = \sn ->

301+ take 4 sn == "172."

302+ && let d1 = take 1 (drop 4 sn) in

303+ let d2 = take 1 (drop 5 sn) in

304+ take 1 (drop 6 sn) == "."

305+ && ((d1 == "1" && (d2 == "6" || d2 == "7" || d2 == "8" || d2 == "9"))

306+ || (d1 == "2" && isDigitChar d2)

307+ || (d1 == "3" && (d2 == "0" || d2 == "1")))

308+

309+isHighOctetPrefix = \sn ->

310+ take 1 sn == "2"

311+ && let d2 = take 1 (drop 1 sn) in

312+ let d3 = take 1 (drop 2 sn) in

313+ take 1 (drop 3 sn) == "."

314+ && ((d2 == "2" && (d3 == "4" || d3 == "5" || d3 == "6" || d3 == "7" || d3 == "8" || d3 == "9"))

315+ || (d2 == "3" && isDigitChar d3)

316+ || (d2 == "4" && isDigitChar d3)

317+ || (d2 == "5" && (d3 == "0" || d3 == "1" || d3 == "2" || d3 == "3" || d3 == "4" || d3 == "5")))

318+

291isBadServerName = \s ->

319isBadServerName = \s ->

292 let sn = toLower (stripTrailingDot s) in

320 let sn = toLower (stripTrailingDot s) in

293 sn == ""

321 sn == ""

@@ -305,10 +333,7 @@ isBadServerName = \s ->

305 || take 4 sn == "127." || take 3 sn == "10."

333 || take 4 sn == "127." || take 3 sn == "10."

306 || take 8 sn == "192.168." || take 8 sn == "169.254."

334 || take 8 sn == "192.168." || take 8 sn == "169.254."

307 || take 2 sn == "0." || take 1 sn == "["

335 || take 2 sn == "0." || take 1 sn == "["

308− || take 7 sn == "172.16." || take 7 sn == "172.17." || take 7 sn == "172.18." || take 7 sn == "172.19."

336+ || is172Private sn

309− || take 7 sn == "172.20." || take 7 sn == "172.21." || take 7 sn == "172.22." || take 7 sn == "172.23."

310− || take 7 sn == "172.24." || take 7 sn == "172.25." || take 7 sn == "172.26." || take 7 sn == "172.27."

311− || take 7 sn == "172.28." || take 7 sn == "172.29." || take 7 sn == "172.30." || take 7 sn == "172.31."

312 || take 7 sn == "198.18." || take 7 sn == "198.19."

337 || take 7 sn == "198.18." || take 7 sn == "198.19."

313 || take 8 sn == "192.0.0."

338 || take 8 sn == "192.0.0."

314 || take 8 sn == "192.0.2."

339 || take 8 sn == "192.0.2."

@@ -321,14 +346,7 @@ isBadServerName = \s ->

321 || hasOctalOctet sn

346 || hasOctalOctet sn

322 || hasHexPrefix sn

347 || hasHexPrefix sn

323 || (isDigitChar (take 1 sn) && isAllDigitsOrDotsUntilColonOrEnd sn)

348 || (isDigitChar (take 1 sn) && isAllDigitsOrDotsUntilColonOrEnd sn)

324− || take 4 sn == "224." || take 4 sn == "225." || take 4 sn == "226." || take 4 sn == "227."

349+ || isHighOctetPrefix sn

325− || take 4 sn == "228." || take 4 sn == "229." || take 4 sn == "230." || take 4 sn == "231."

326− || take 4 sn == "232." || take 4 sn == "233." || take 4 sn == "234." || take 4 sn == "235."

327− || take 4 sn == "236." || take 4 sn == "237." || take 4 sn == "238." || take 4 sn == "239."

328− || take 4 sn == "240." || take 4 sn == "241." || take 4 sn == "242." || take 4 sn == "243."

329− || take 4 sn == "244." || take 4 sn == "245." || take 4 sn == "246." || take 4 sn == "247."

330− || take 4 sn == "248." || take 4 sn == "249." || take 4 sn == "250." || take 4 sn == "251."

331− || take 4 sn == "252." || take 4 sn == "253." || take 4 sn == "254." || take 4 sn == "255."

332

350

333lookupSession = \sessions token t ->

351lookupSession = \sessions token t ->

334 fold (\acc s ->

352 fold (\acc s ->

@@ -345,21 +363,17 @@ extractToken = \authHeader ->

345 then drop 7 authHeader

363 then drop 7 authHeader

346 else ""

364 else ""

347

365

348−verifyFederationAuth = \authorization ->

366+verifySecret = \token secret ->

349− let token = extractToken authorization in

350− let result = safeCompare token (if federationSecret == "" then "x" else federationSecret) in

367+ let result = safeCompare token (if secret == "" then "x" else secret) in

351− let secretSet = if federationSecret == "" then 0 else 1 in

368+ let secretSet = if secret == "" then 0 else 1 in

352 (if result then 1 else 0) * secretSet > 0

369 (if result then 1 else 0) * secretSet > 0

353

370

371+verifyFederationAuth = \authorization ->

372+ verifySecret (extractToken authorization) federationSecret

373+

354verifyMaintenanceAuth = \authorization ->

374verifyMaintenanceAuth = \authorization ->

355 let token = extractToken authorization in

375 let token = extractToken authorization in

356− let fedResult = safeCompare token (if federationSecret == "" then "x" else federationSecret) in

376+ verifySecret token federationSecret || verifySecret token maintenanceSecret

357− let maintResult = safeCompare token (if maintenanceSecret == "" then "x" else maintenanceSecret) in

358− let fedN = if fedResult then 1 else 0 in

359− let maintN = if maintResult then 1 else 0 in

360− let fedSecretSet = if federationSecret == "" then 0 else 1 in

361− let maintSecretSet = if maintenanceSecret == "" then 0 else 1 in

362− fedN * fedSecretSet + maintN * maintSecretSet > 0

363

377

364clampTtl = \ttl -> if ttl < 1 then 1 else if ttl > maxPresenceTtl then maxPresenceTtl else ttl

378clampTtl = \ttl -> if ttl < 1 then 1 else if ttl > maxPresenceTtl then maxPresenceTtl else ttl

365

379

@@ -369,7 +383,7 @@ dedupMessageIds = \messageIds ->

369 fold (\acc mid ->

383 fold (\acc mid ->

370 let nmid = normalizeHex mid in

384 let nmid = normalizeHex mid in

371 if count acc >= maxMessageIds then acc

385 if count acc >= maxMessageIds then acc

372− else if count (do a <- acc; where a == nmid; yield a) > 0 then acc

386+ else if any acc (\a -> a == nmid) then acc

373 else union acc [nmid]) [] messageIds

387 else union acc [nmid]) [] messageIds

374

388

375boundedSmallest = \items n getKey ->

389boundedSmallest = \items n getKey ->

@@ -417,7 +431,7 @@ collectPeerServers = \items getServer ->

417 fold (\acc item ->

431 fold (\acc item ->

418 let s = getServer item in

432 let s = getServer item in

419 if s == serverHostN then acc

433 if s == serverHostN then acc

420− else if count (do a <- acc; where a == s; yield a) > 0 then acc

434+ else if any acc (\a -> a == s) then acc

421 else union acc [s]) [] items

435 else union acc [s]) [] items

422

436

423validGossipEvents = \events validRequest t eventType ->

437validGossipEvents = \events validRequest t eventType ->

@@ -481,11 +495,7 @@ pruneExpired = \t -> do

481 p <- presenceBefore

495 p <- presenceBefore

482 where p.expiresAt <= t

496 where p.expiresAt <= t

483 where p.server == serverHostN

497 where p.server == serverHostN

484− where count (do

485− q <- presenceAfter

486− where q.pubkey == p.pubkey

487− where q.server == serverHostN

498+ where none presenceAfter (\q -> q.pubkey == p.pubkey && q.server == serverHostN)

488− yield q) == 0

489 yield p), peerServers: peerServersBefore}

499 yield p), peerServers: peerServersBefore}

490

500

491maybePrune = \t -> do

501maybePrune = \t -> do

@@ -522,11 +532,11 @@ sendBatchedGossip = \peerServers allEvents ->

522

532

523broadcastOfflineGossip = \t peerServers expiredLocal -> do

533broadcastOfflineGossip = \t peerServers expiredLocal -> do

524 let expiredEntries = fold (\acc p ->

534 let expiredEntries = fold (\acc p ->

525− if count (do a <- acc; where a.pubkey == p.pubkey; where a.expiresAt >= p.expiresAt; yield a) > 0 then acc

535+ if any acc (\a -> a.pubkey == p.pubkey && a.expiresAt >= p.expiresAt) then acc

526 else union

536 else union

527 (do a <- acc; where not (a.pubkey == p.pubkey); yield a)

537 (do a <- acc; where not (a.pubkey == p.pubkey); yield a)

528 [{pubkey: p.pubkey, ttl: (let rawTtl = (p.expiresAt - p.timestamp) / 1000 in clampTtl (if rawTtl < offlineGossipMinTtl then offlineGossipMinTtl else rawTtl)), expiresAt: p.expiresAt}]) [] expiredLocal

538 [{pubkey: p.pubkey, ttl: (let rawTtl = (p.expiresAt - p.timestamp) / 1000 in clampTtl (if rawTtl < offlineGossipMinTtl then offlineGossipMinTtl else rawTtl)), expiresAt: p.expiresAt}]) [] expiredLocal

529− if not (federationSecret == "") && count expiredEntries > 0 && count peerServers > 0

539+ if federationEnabled && count expiredEntries > 0 && count peerServers > 0

530 then do

540 then do

531 let gossipEvents = do

541 let gossipEvents = do

532 e <- expiredEntries

542 e <- expiredEntries

@@ -586,7 +596,7 @@ sendBatchedAcksToServer = \serverAcks server ->

586 ackedIds <- *ackedIds

596 ackedIds <- *ackedIds

587 set *ackedIds = do

597 set *ackedIds = do

588 a <- ackedIds

598 a <- ackedIds

589− where not (a.originServer == server && count (do sa <- batch; where sa.messageId == a.messageId; where sa.toKey == a.toKey; yield sa) > 0)

599+ where not (a.originServer == server && any batch (\sa -> sa.messageId == a.messageId && sa.toKey == a.toKey))

590 yield a

600 yield a

591 Err _ -> yield {}

601 Err _ -> yield {}

592 sendBatchedAcksToServer rest server

602 sendBatchedAcksToServer rest server

@@ -612,10 +622,10 @@ pruneAndRetry = \t -> do

612 yield a

622 yield a

613 yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: pendingForwards, pendingAcks: pendingAcks}

623 yield {expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, pendingForwards: pendingForwards, pendingAcks: pendingAcks}

614 broadcastOfflineGossip t result.peerServers result.expiredLocal

624 broadcastOfflineGossip t result.peerServers result.expiredLocal

615− if not (federationSecret == "") && count result.pendingForwards > 0

625+ if federationEnabled && count result.pendingForwards > 0

616 then retryPendingForwards result.pendingForwards

626 then retryPendingForwards result.pendingForwards

617 else yield {}

627 else yield {}

618− if not (federationSecret == "") && count result.pendingAcks > 0

628+ if federationEnabled && count result.pendingAcks > 0

619 then do

629 then do

620 let ackOriginServers = collectPeerServers result.pendingAcks (\a -> a.originServer)

630 let ackOriginServers = collectPeerServers result.pendingAcks (\a -> a.originServer)

621 sendAcksAndClean result.pendingAcks ackOriginServers

631 sendAcksAndClean result.pendingAcks ackOriginServers

@@ -640,9 +650,7 @@ pollOnce = \token cursor -> do

640 where m.receivedAt > clampedCursor

650 where m.receivedAt > clampedCursor

641 yield m

651 yield m

642 let limitedMsgs = boundedSmallest matchingMsgs maxPollEvents (\m -> m.receivedAt)

652 let limitedMsgs = boundedSmallest matchingMsgs maxPollEvents (\m -> m.receivedAt)

643− let authorized = case session of

653+ let authorized = isJust session

644− Nothing {} -> False {}

645− _ -> True {}

646 let evts = do

654 let evts = do

647 m <- limitedMsgs

655 m <- limitedMsgs

648 yield {id: m.messageId, eventType: "message",

656 yield {id: m.messageId, eventType: "message",

@@ -750,12 +758,12 @@ serve = \req -> case req of

750 then union presenceEvicted [{pubkey: pubkey, server: serverHostN, expiresAt: expiry, timestamp: t}]

758 then union presenceEvicted [{pubkey: pubkey, server: serverHostN, expiresAt: expiry, timestamp: t}]

751 else presence

759 else presence

752 set *presence = updatedPresence

760 set *presence = updatedPresence

753− let peerServers = if sigValid && not (federationSecret == "")

761+ let peerServers = if sigValid && federationEnabled

754 then collectPeerServers updatedPresence (\p -> p.server)

762 then collectPeerServers updatedPresence (\p -> p.server)

755 else []

763 else []

756 yield {sigValid: sigValid, peerServers: peerServers, expiredLocal: pr.expiredLocal, offlinePeers: pr.peerServers}

764 yield {sigValid: sigValid, peerServers: peerServers, expiredLocal: pr.expiredLocal, offlinePeers: pr.peerServers}

757 fork (do

765 fork (do

758− if result.sigValid && not (federationSecret == "")

766+ if result.sigValid && federationEnabled

759 then sendToEach result.peerServers (\server -> do

767 then sendToEach result.peerServers (\server -> do

760 fetchResult <- fetch (federationScheme ++ server) (RecvGossip {

768 fetchResult <- fetch (federationScheme ++ server) (RecvGossip {

761 authorization: "Bearer " ++ federationSecret,

769 authorization: "Bearer " ++ federationSecret,

@@ -800,9 +808,7 @@ serve = \req -> case req of

800 let fromKey = case session of

808 let fromKey = case session of

801 Nothing {} -> ""

809 Nothing {} -> ""

802 Just {value: s} -> s.pubkey

810 Just {value: s} -> s.pubkey

803− let authorized = case session of

811+ let authorized = isJust session

804− Nothing {} -> False {}

805− _ -> True {}

806 seqCounter <- *seqCounter

812 seqCounter <- *seqCounter

807 let seqTs = if t > seqCounter then t else seqCounter + 1

813 let seqTs = if t > seqCounter then t else seqCounter + 1

808 let recipientMsgCount = count (do

814 let recipientMsgCount = count (do

@@ -817,12 +823,7 @@ serve = \req -> case req of

817 [{messageId: msgId, toKey: to, fromKey: fromKey,

823 [{messageId: msgId, toKey: to, fromKey: fromKey,

818 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: seqTs}]

824 encryptedBlob: encryptedBlob, timestamp: clampedTs, originServer: "", receivedAt: seqTs}]

819 else messages

825 else messages

820− let localOnline = authorized && count (do

826+ let localOnline = authorized && any presence (\p -> p.pubkey == to && p.server == serverHostN && p.expiresAt > t)

821− p <- presence

822− where p.pubkey == to

823− where p.server == serverHostN

824− where p.expiresAt > t

825− yield p) > 0

826 let remoteServers = if authorized

827 let remoteServers = if authorized

827 then do

828 then do

828 p <- presence

829 p <- presence

@@ -842,13 +843,13 @@ serve = \req -> case req of

842 let forwardServers = fold (\acc s ->

843 let forwardServers = fold (\acc s ->

843 if count acc >= forwardSlots then acc

844 if count acc >= forwardSlots then acc

844 else union acc [s]) [] remoteServers

845 else union acc [s]) [] remoteServers

845− set *forwards = if shouldInsert && not forwardsAtCapacity && count forwardServers > 0 && not (federationSecret == "")

846+ set *forwards = if shouldInsert && not forwardsAtCapacity && count forwardServers > 0 && federationEnabled

846 then union forwards (do s <- forwardServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})

847 then union forwards (do s <- forwardServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})

847 else forwards

848 else forwards

848 yield {status: status, remoteServers: remoteServers, fromKey: fromKey, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, forwardsAtCapacity: forwardsAtCapacity}

849 yield {status: status, remoteServers: remoteServers, fromKey: fromKey, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, forwardsAtCapacity: forwardsAtCapacity}

849− let finalStatus = if result.status == "federated" && (federationSecret == "" || result.forwardsAtCapacity) then "queued" else result.status

850+ let finalStatus = if result.status == "federated" && (not federationEnabled || result.forwardsAtCapacity) then "queued" else result.status

850 fork (do

851 fork (do

851− if count result.remoteServers > 0 && not (result.status == "unauthorized") && not (result.status == "rejected") && not (federationSecret == "")

852+ if count result.remoteServers > 0 && not (result.status == "unauthorized") && not (result.status == "rejected") && federationEnabled

852 then sendToEach result.remoteServers (\server -> do

853 then sendToEach result.remoteServers (\server -> do

853 fwdResult <- fetch (federationScheme ++ server) (ForwardMessage {

854 fwdResult <- fetch (federationScheme ++ server) (ForwardMessage {

854 toKey: to, fromKey: result.fromKey, encryptedBlob: encryptedBlob,

855 toKey: to, fromKey: result.fromKey, encryptedBlob: encryptedBlob,

@@ -902,9 +903,7 @@ serve = \req -> case req of

902 let evictedEntries = if excessCount <= 0 then []

903 let evictedEntries = if excessCount <= 0 then []

903 else diff combinedAckedIds afterEviction

904 else diff combinedAckedIds afterEviction

904 set *ackedIds = afterEviction

905 set *ackedIds = afterEviction

905− let ok = case session of

906+ let ok = isJust session

906− Nothing {} -> False {}

907− _ -> True {}

908 yield {ok: ok, ackedMessages: ackedMessages, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, evictedEntries: evictedEntries}

907 yield {ok: ok, ackedMessages: ackedMessages, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, evictedEntries: evictedEntries}

909 let fedMessages = do

908 let fedMessages = do

910 m <- result.ackedMessages

909 m <- result.ackedMessages

@@ -913,7 +912,7 @@ serve = \req -> case req of

913 yield m

912 yield m

914 let originServers = collectPeerServers fedMessages (\m -> m.originServer)

913 let originServers = collectPeerServers fedMessages (\m -> m.originServer)

915 fork (do

914 fork (do

916− if result.ok && count originServers > 0 && not (federationSecret == "")

915+ if result.ok && count originServers > 0 && federationEnabled

917 then do

916 then do

918 let pendingAcks = do

917 let pendingAcks = do

919 m <- fedMessages

918 m <- fedMessages

@@ -924,9 +923,9 @@ serve = \req -> case req of

924 then do

923 then do

925 let evictedToRetry = do

924 let evictedToRetry = do

926 a <- result.evictedEntries

925 a <- result.evictedEntries

927− where count (do m <- fedMessages; where m.messageId == a.messageId; where m.toKey == a.toKey; yield m) == 0

926+ where none fedMessages (\m -> m.messageId == a.messageId && m.toKey == a.toKey)

928 yield a

927 yield a

929− if count evictedToRetry > 0 && not (federationSecret == "")

928+ if count evictedToRetry > 0 && federationEnabled

930 then do

929 then do

931 let evictedOriginServers = collectPeerServers evictedToRetry (\a -> a.originServer)

930 let evictedOriginServers = collectPeerServers evictedToRetry (\a -> a.originServer)

932 sendToEach evictedOriginServers (\server -> do

931 sendToEach evictedOriginServers (\server -> do

@@ -963,9 +962,7 @@ serve = \req -> case req of

963 sessions <- *sessions

962 sessions <- *sessions

964 presence <- *presence

963 presence <- *presence

965 let session = lookupSession sessions (extractToken authorization) t

964 let session = lookupSession sessions (extractToken authorization) t

966− let authorized = case session of

965+ let authorized = isJust session

967− Nothing {} -> False {}

968− _ -> True {}

969 let valid = do

966 let valid = do

970 p <- presence

967 p <- presence

971 where p.pubkey == pubkey

968 where p.pubkey == pubkey

@@ -976,7 +973,7 @@ serve = \req -> case req of

976 Just {value: _} ->

973 Just {value: _} ->

977 if count valid == 0

974 if count valid == 0

978 then ""

975 then ""

979− else if count (do p <- valid; where p.server == serverHostN; yield p) > 0

976+ else if any valid (\p -> p.server == serverHostN)

980 then serverHostN

977 then serverHostN

981 else (fold (\acc p -> if p.expiresAt > acc.best then {server: p.server, best: p.expiresAt} else acc) {server: "", best: 0} valid).server

978 else (fold (\acc p -> if p.expiresAt > acc.best then {server: p.server, best: p.expiresAt} else acc) {server: "", best: 0} valid).server

982 yield {foundServer: foundServer, authorized: authorized, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}

979 yield {foundServer: foundServer, authorized: authorized, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}

@@ -993,13 +990,7 @@ serve = \req -> case req of

993 let offlineEntries = validGossipEvents events validRequest t "offline"

990 let offlineEntries = validGossipEvents events validRequest t "offline"

994 let filteredOnline = do

991 let filteredOnline = do

995 e <- onlineEntries

992 e <- onlineEntries

996− where count (do

993+ where none offlineEntries (\o -> o.server == fromServer && o.pubkey == e.pubkey && o.server == e.server && o.timestamp > e.timestamp)

997− o <- offlineEntries

998− where o.server == fromServer

999− where o.pubkey == e.pubkey

1000− where o.server == e.server

1001− where o.timestamp > e.timestamp

1002− yield o) == 0

1003 yield {pubkey: e.pubkey, server: e.server, expiresAt: e.expiresAt, timestamp: e.timestamp, ttl: e.ttl}

994 yield {pubkey: e.pubkey, server: e.server, expiresAt: e.expiresAt, timestamp: e.timestamp, ttl: e.ttl}

1004 let affectedKeys = union

995 let affectedKeys = union

1005 (do

996 (do

@@ -1009,12 +1000,7 @@ serve = \req -> case req of

1009 e <- offlineEntries

1000 e <- offlineEntries

1010 yield {pubkey: e.pubkey, server: e.server})

1001 yield {pubkey: e.pubkey, server: e.server})

1011 let deduped = fold (\acc e ->

1002 let deduped = fold (\acc e ->

1012− if count (do

1013− a <- acc

1014− where a.pubkey == e.pubkey

1015− where a.server == e.server

1016− where a.expiresAt >= e.expiresAt

1003+ if any acc (\a -> a.pubkey == e.pubkey && a.server == e.server && a.expiresAt >= e.expiresAt)

1017− yield a) > 0

1018 then acc

1004 then acc

1019 else union

1005 else union

1020 (do

1006 (do

@@ -1027,7 +1013,7 @@ serve = \req -> case req of

1027 presence <- *presence

1013 presence <- *presence

1028 let trustedDeduped = do

1014 let trustedDeduped = do

1029 e <- deduped

1015 e <- deduped

1030− where e.server == fromServer || count (do p <- presence; where p.server == e.server; where p.expiresAt > t; yield p) > 0

1016+ where e.server == fromServer || any presence (\p -> p.server == e.server && p.expiresAt > t)

1031 yield e

1017 yield e

1032 let trustedOffline = do

1018 let trustedOffline = do

1033 e <- offlineEntries

1019 e <- offlineEntries

@@ -1035,20 +1021,10 @@ serve = \req -> case req of

1035 yield e

1021 yield e

1036 let appliedOnline = do

1022 let appliedOnline = do

1037 e <- trustedDeduped

1023 e <- trustedDeduped

1038− where count (do

1039− p <- presence

1040− where p.pubkey == e.pubkey

1041− where p.server == e.server

1042− where p.expiresAt >= e.expiresAt

1024+ where none presence (\p -> p.pubkey == e.pubkey && p.server == e.server && p.expiresAt >= e.expiresAt)

1043− yield p) == 0

1044 yield {pubkey: e.pubkey, server: e.server}

1025 yield {pubkey: e.pubkey, server: e.server}

1045 let merged = fold (\acc e ->

1026 let merged = fold (\acc e ->

1046− if count (do

1047− p <- acc

1048− where p.pubkey == e.pubkey

1049− where p.server == e.server

1050− where p.expiresAt >= e.expiresAt

1027+ if any acc (\p -> p.pubkey == e.pubkey && p.server == e.server && p.expiresAt >= e.expiresAt)

1051− yield p) > 0

1052 then acc

1028 then acc

1053 else union

1029 else union

1054 (do

1030 (do

@@ -1058,45 +1034,25 @@ serve = \req -> case req of

1058 [e]) presence trustedDeduped

1034 [e]) presence trustedDeduped

1059 let offlineOnlyKeys = do

1035 let offlineOnlyKeys = do

1060 k <- affectedKeys

1036 k <- affectedKeys

1061− where count (do d <- trustedDeduped; where d.pubkey == k.pubkey; where d.server == k.server; yield d) == 0

1037+ where none trustedDeduped (\d -> d.pubkey == k.pubkey && d.server == k.server)

1062 yield k

1038 yield k

1063 let appliedOffline = do

1039 let appliedOffline = do

1064 k <- offlineOnlyKeys

1040 k <- offlineOnlyKeys

1065− where count (do

1066− p <- presence

1067− where p.pubkey == k.pubkey

1068− where p.server == k.server

1069− where count (do

1070− o <- trustedOffline

1071− where o.pubkey == k.pubkey

1072− where o.server == k.server

1073− where (if o.timestamp > t then t else o.timestamp) > p.timestamp

1041+ where any presence (\p -> p.pubkey == k.pubkey && p.server == k.server && any trustedOffline (\o -> o.pubkey == k.pubkey && o.server == k.server && (if o.timestamp > t then t else o.timestamp) > p.timestamp))

1074− yield o) > 0

1075− yield p) > 0

1076 yield {pubkey: k.pubkey, server: k.server}

1042 yield {pubkey: k.pubkey, server: k.server}

1077 let afterOffline = diff merged (do

1043 let afterOffline = diff merged (do

1078 p <- merged

1044 p <- merged

1079 k <- offlineOnlyKeys

1045 k <- offlineOnlyKeys

1080 where p.pubkey == k.pubkey

1046 where p.pubkey == k.pubkey

1081 where p.server == k.server

1047 where p.server == k.server

1082− where count (do

1083− o <- trustedOffline

1084− where o.pubkey == k.pubkey

1085− where o.server == k.server

1086− where (if o.timestamp > t then t else o.timestamp) > p.timestamp

1048+ where any trustedOffline (\o -> o.pubkey == k.pubkey && o.server == k.server && (if o.timestamp > t then t else o.timestamp) > p.timestamp)

1087− yield o) > 0

1088 yield p)

1049 yield p)

1089 let withinCapacity = count afterOffline <= maxPresenceEntries

1050 let withinCapacity = count afterOffline <= maxPresenceEntries

1090 let updatesOnlyMerged = if withinCapacity then afterOffline

1051 let updatesOnlyMerged = if withinCapacity then afterOffline

1091 else fold (\acc e ->

1052 else fold (\acc e ->

1092− if count (do

1093− p <- acc

1094− where p.pubkey == e.pubkey

1095− where p.server == e.server

1096− where p.expiresAt >= e.expiresAt

1053+ if any acc (\p -> p.pubkey == e.pubkey && p.server == e.server && p.expiresAt >= e.expiresAt)

1097− yield p) > 0

1098 then acc

1054 then acc

1099− else if count (do p <- presence; where p.pubkey == e.pubkey; where p.server == e.server; yield p) > 0

1055+ else if any presence (\p -> p.pubkey == e.pubkey && p.server == e.server)

1100 then union

1056 then union

1101 (do

1057 (do

1102 p <- acc

1058 p <- acc

@@ -1110,19 +1066,14 @@ serve = \req -> case req of

1110 k <- offlineOnlyKeys

1066 k <- offlineOnlyKeys

1111 where p.pubkey == k.pubkey

1067 where p.pubkey == k.pubkey

1112 where p.server == k.server

1068 where p.server == k.server

1113− where count (do

1114− o <- trustedOffline

1115− where o.pubkey == k.pubkey

1116− where o.server == k.server

1117− where (if o.timestamp > t then t else o.timestamp) > p.timestamp

1069+ where any trustedOffline (\o -> o.pubkey == k.pubkey && o.server == k.server && (if o.timestamp > t then t else o.timestamp) > p.timestamp)

1118− yield o) > 0

1119 yield p)

1070 yield p)

1120 let reclaimCapacity = if withinCapacity then 0 else maxPresenceEntries - count updatesOnlyAfterOffline

1071 let reclaimCapacity = if withinCapacity then 0 else maxPresenceEntries - count updatesOnlyAfterOffline

1121 let newEntries = if withinCapacity then []

1072 let newEntries = if withinCapacity then []

1122 else do

1073 else do

1123 e <- trustedDeduped

1074 e <- trustedDeduped

1124− where count (do p <- presence; where p.pubkey == e.pubkey; where p.server == e.server; yield p) == 0

1075+ where none presence (\p -> p.pubkey == e.pubkey && p.server == e.server)

1125− where count (do p <- updatesOnlyAfterOffline; where p.pubkey == e.pubkey; where p.server == e.server; yield p) == 0

1076+ where none updatesOnlyAfterOffline (\p -> p.pubkey == e.pubkey && p.server == e.server)

1126 yield e

1077 yield e

1127 let reclaimedEntries = if withinCapacity then []

1078 let reclaimedEntries = if withinCapacity then []

1128 else fold (\acc e ->

1079 else fold (\acc e ->

@@ -1134,13 +1085,8 @@ serve = \req -> case req of

1134 else union

1085 else union

1135 (do

1086 (do

1136 e <- trustedDeduped

1087 e <- trustedDeduped

1137− where count (do p <- presence; where p.pubkey == e.pubkey; where p.server == e.server; yield p) > 0

1088+ where any presence (\p -> p.pubkey == e.pubkey && p.server == e.server)

1138− where count (do

1139− p <- presence

1140− where p.pubkey == e.pubkey

1141− where p.server == e.server

1142− where p.expiresAt >= e.expiresAt

1089+ where none presence (\p -> p.pubkey == e.pubkey && p.server == e.server && p.expiresAt >= e.expiresAt)

1143− yield p) == 0

1144 yield {pubkey: e.pubkey, server: e.server})

1090 yield {pubkey: e.pubkey, server: e.server})

1145 (do

1091 (do

1146 e <- reclaimedEntries

1092 e <- reclaimedEntries

@@ -1153,24 +1099,19 @@ serve = \req -> case req of

1153 yield {appliedKeys: (if withinCapacity then union appliedOnline appliedOffline else union appliedOnlineUpdates appliedOffline), expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, gossipPeerServers: gossipPeerServers, withinCapacity: withinCapacity}

1099 yield {appliedKeys: (if withinCapacity then union appliedOnline appliedOffline else union appliedOnlineUpdates appliedOffline), expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, gossipPeerServers: gossipPeerServers, withinCapacity: withinCapacity}

1154 let filteredOffline = do

1100 let filteredOffline = do

1155 e <- offlineEntries

1101 e <- offlineEntries

1156− where count (do

1157− o <- onlineEntries

1158− where o.pubkey == e.pubkey

1159− where o.server == e.server

1160− where o.timestamp > e.timestamp

1102+ where none onlineEntries (\o -> o.pubkey == e.pubkey && o.server == e.server && o.timestamp > e.timestamp)

1161− yield o) == 0

1162 yield e

1103 yield e

1163 let effectiveEvents = do

1104 let effectiveEvents = do

1164 e <- union

1105 e <- union

1165 (do e <- filteredOnline; yield {eventType: "online", pubkey: e.pubkey, server: e.server, timestamp: e.timestamp, ttl: e.ttl})

1106 (do e <- filteredOnline; yield {eventType: "online", pubkey: e.pubkey, server: e.server, timestamp: e.timestamp, ttl: e.ttl})

1166 (do e <- filteredOffline; yield {eventType: "offline", pubkey: e.pubkey, server: e.server, timestamp: e.timestamp, ttl: e.ttl})

1107 (do e <- filteredOffline; yield {eventType: "offline", pubkey: e.pubkey, server: e.server, timestamp: e.timestamp, ttl: e.ttl})

1167− where count (do a <- gossipResult.appliedKeys; where a.pubkey == e.pubkey; where a.server == e.server; yield a) > 0

1108+ where any gossipResult.appliedKeys (\a -> a.pubkey == e.pubkey && a.server == e.server)

1168 yield e

1109 yield e

1169 if not gossipResult.withinCapacity

1110 if not gossipResult.withinCapacity

1170 then println ("gossip: presence at capacity (" ++ show maxPresenceEntries ++ "), limiting new entries from " ++ fromServer)

1111 then println ("gossip: presence at capacity (" ++ show maxPresenceEntries ++ "), limiting new entries from " ++ fromServer)

1171 else yield {}

1112 else yield {}

1172 fork (do

1113 fork (do

1173− if validRequest && cappedHops > 1 && not (federationSecret == "") && count effectiveEvents > 0

1114+ if validRequest && cappedHops > 1 && federationEnabled && count effectiveEvents > 0

1174 then do

1115 then do

1175 let targets = do

1116 let targets = do

1176 s <- gossipResult.gossipPeerServers

1117 s <- gossipResult.gossipPeerServers

@@ -1210,18 +1151,10 @@ serve = \req -> case req of

1210 where m.receivedAt >= t - messageMaxAge

1151 where m.receivedAt >= t - messageMaxAge

1211 yield m)

1152 yield m)

1212 let existsInMessages = if not (authorized && validOrigin) then False {}

1153 let existsInMessages = if not (authorized && validOrigin) then False {}

1213− else count (do

1214− m <- messages

1215− where m.messageId == messageId

1154+ else any messages (\m -> m.messageId == messageId && m.toKey == toKey)

1216− where m.toKey == toKey

1217− yield m) > 0

1218 ackedIds <- *ackedIds

1155 ackedIds <- *ackedIds

1219 let existsInAcked = if not (authorized && validOrigin) then False {}

1156 let existsInAcked = if not (authorized && validOrigin) then False {}

1220− else count (do

1221− a <- ackedIds

1222− where a.messageId == messageId

1157+ else any ackedIds (\a -> a.messageId == messageId && a.toKey == toKey)

1223− where a.toKey == toKey

1224− yield a) > 0

1225 let exists = existsInMessages || existsInAcked

1158 let exists = existsInMessages || existsInAcked

1226 let shouldInsert = authorized && validOrigin && not exists && recipientMsgCount < maxMessagesPerRecipient

1159 let shouldInsert = authorized && validOrigin && not exists && recipientMsgCount < maxMessagesPerRecipient

1227 set *seqCounter = if shouldInsert then seqTs else seqCounter

1160 set *seqCounter = if shouldInsert then seqTs else seqCounter