@@ -453,6 +453,26 @@ max = \a b -> if a > b then a else b
453453-- Dedup: keeps first occurrence (O(n^2)).
454454unique = \items -> fold (\acc x -> if any acc (\a -> a == x) then acc else union acc [x]) [] items
455455
456+-- Replace a ref's contents with the entries that satisfy `keep`. Caller controls atomicity.
457+pruneRef = \ref keep -> do
458+ cur <- *ref
459+ set *ref = do x <- cur; where keep x; yield x
460+
461+-- Add `server` to the named list ref if absent. Returns the new total.
462+addServerToList = \listRef server -> atomic do
463+ current <- *listRef
464+ if any current (\x -> x == server) then yield (count current)
465+ else do
466+ set *listRef = union current [server]
467+ yield (count current + 1)
468+
469+-- Remove `server` from the named list ref. Returns whether it was present.
470+removeServerFromList = \listRef server -> atomic do
471+ current <- *listRef
472+ let had = any current (\x -> x == server)
473+ set *listRef = do x <- current; where x != server; yield x
474+ yield had
475+
456476headOf = \items -> fold (\acc x -> case acc of
457477 Nothing {} -> Just {value: x}
458478 _ -> acc) Nothing {} items
@@ -574,6 +594,10 @@ verifyMaintenanceAuth = \authorization -> do
574594 Just {value: token} -> yield (secret != "" && token == secret)
575595 _ -> yield False
576596
597+withMaintAuth = \authorization onUnauth onAuth -> do
598+ authorized <- verifyMaintenanceAuth authorization
599+ if authorized then onAuth else onUnauth
600+
577601authenticateSession : [Session] -> Text -> Timestamp -> AuthResult
578602authenticateSession = \sessions token t ->
579603 case headOf (do s <- sessions; where s.expiresAt > t && s.token == token; yield s) of
@@ -767,7 +791,7 @@ effectiveMessageTtl = \expiresInMs ->
767791 else clamp minMessageTtl unackedMessageMaxAge expiresInMs
768792
769793nextSeqTs : Timestamp -> Timestamp -> Timestamp
770−nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
794+nextSeqTs = \t seqCounter -> max t (seqCounter + 1)
771795
772796dedupMessageIds : [MessageIdHex] -> [MessageIdHex]
773797dedupMessageIds = \ids -> takeRelation maxMessageIds (unique ids)
@@ -802,50 +826,25 @@ mergePresence = \existing incoming ->
802826-- Pruning
803827-- ============================================
804828
805−pruneExpired = \t -> do
806− expiredLocalKeys <- atomic do
807− -- challenges
808− ch <- *challenges
809− set *challenges = do x <- ch; where x.expiresAt > t; yield x
810− -- sessions
811− ses <- *sessions
812− set *sessions = do x <- ses; where x.expiresAt > t; yield x
813− -- messages
814− msgs <- *messages
815− set *messages = do m <- msgs; where m.expiresAt > t; yield m
816− -- forwards
817− fwds <- *forwards
818− set *forwards = do f <- fwds; where f.expiresAt > t; yield f
819− -- ackedIds, deliveredIds
820− aids <- *ackedIds
821− set *ackedIds = do a <- aids; where t - a.ackedAt < messageMaxAge; yield a
822− dids <- *deliveredIds
823− set *deliveredIds = do d <- dids; where t - d.deliveredAt < messageMaxAge; yield d
824− -- presence: remember locally-expired keys for offline gossip
825− pres <- *presence
826− let keptPres = do p <- pres; where p.expiresAt > t; yield p
827− let expiredLocal = do p <- pres; where p.expiresAt <= t && isLocalServer p.server && none keptPres (\k -> k.pubkey == p.pubkey && isLocalServer k.server); yield p
828− set *presence = keptPres
829− -- forwardFailures
830− ff <- *forwardFailures
831− set *forwardFailures = do f <- ff; where t - f.failedAt < 86400000; yield f
832− -- activePolls (clean up stale entries beyond 3x poll timeout)
833− aps <- *activePolls
834− set *activePolls = do p <- aps; where t - p.startedAt < pollTimeoutMs * 3; yield p
835− -- pendingVerifications
836− pv <- *pendingVerifications
837− set *pendingVerifications = do p <- pv; where t - p.createdAt < verificationTokenExpiry; yield p
838− -- sender notifications
839− se <- *senderExpirations
840− set *senderExpirations = do x <- se; where t - x.expiredAt < unackedMessageMaxAge; yield x
841− sd <- *senderDeliveries
842− set *senderDeliveries = do x <- sd; where t - x.deliveredAt < unackedMessageMaxAge; yield x
843− cn <- *cancelNotifications
844− set *cancelNotifications = do x <- cn; where t - x.cancelledAt < unackedMessageMaxAge; yield x
845− pfc <- *pendingFederationCancels
846− set *pendingFederationCancels = do x <- pfc; where t - x.createdAt < messageMaxAge; yield x
847− yield expiredLocal
848− yield expiredLocalKeys
829+pruneExpired = \t -> atomic do
830+ pruneRef challenges (\x -> x.expiresAt > t)
831+ pruneRef sessions (\x -> x.expiresAt > t)
832+ pruneRef messages (\m -> m.expiresAt > t)
833+ pruneRef forwards (\f -> f.expiresAt > t)
834+ pruneRef ackedIds (\a -> t - a.ackedAt < messageMaxAge)
835+ pruneRef deliveredIds (\d -> t - d.deliveredAt < messageMaxAge)
836+ pruneRef forwardFailures (\f -> t - f.failedAt < 86400000)
837+ pruneRef activePolls (\p -> t - p.startedAt < pollTimeoutMs * 3)
838+ pruneRef pendingVerifications (\p -> t - p.createdAt < verificationTokenExpiry)
839+ pruneRef senderExpirations (\x -> t - x.expiredAt < unackedMessageMaxAge)
840+ pruneRef senderDeliveries (\x -> t - x.deliveredAt < unackedMessageMaxAge)
841+ pruneRef cancelNotifications (\x -> t - x.cancelledAt < unackedMessageMaxAge)
842+ pruneRef pendingFederationCancels (\x -> t - x.createdAt < messageMaxAge)
843+ -- presence: remember locally-expired keys for offline gossip
844+ pres <- *presence
845+ let keptPres = do p <- pres; where p.expiresAt > t; yield p
846+ set *presence = keptPres
847+ yield (do p <- pres; where p.expiresAt <= t && isLocalServer p.server && none keptPres (\k -> k.pubkey == p.pubkey && isLocalServer k.server); yield p)
849848
850849-- ============================================
851850-- Federation gossip
@@ -1785,10 +1784,9 @@ zipPairs = \mids keys ->
17851784-- Maintenance handlers
17861785-- ============================================
17871786
1788−handleDrain = \phase authorization respond -> do
1789− authorized <- verifyMaintenanceAuth authorization
1790− if not authorized then yield (respond {ok: False {}, drained: 0, phase: 0})
1791− else do
1787+handleDrain = \phase authorization respond -> withMaintAuth authorization
1788+ (yield (respond {ok: False {}, drained: 0, phase: 0}))
1789+ (do
17921790 let effectivePhase = if phase == 1 then 1 else 2
17931791 t <- now
17941792 drainResult <- atomic do
@@ -1804,21 +1802,19 @@ handleDrain = \phase authorization respond -> do
18041802 yield {drainedCount: count localEntries, peers: peers, localKeys: localEntries}
18051803 when (effectivePhase == 2 && count drainResult.localKeys > 0 && count drainResult.peers > 0 && federationEnabled)
18061804 (fork (sendBatchedGossip drainResult.peers (do p <- drainResult.localKeys; yield {eventType: GossipOffline {}, pubkey: p.pubkey, server: serverHostN, timestamp: t, ttl: offlineGossipMinTtl, seenBy: [serverHostN]}) gossipOriginHops))
1807− yield (respond {ok: True {}, drained: drainResult.drainedCount, phase: effectivePhase})
1805+ yield (respond {ok: True {}, drained: drainResult.drainedCount, phase: effectivePhase}))
18081806
1809−handleUndrain = \authorization respond -> do
1810− authorized <- verifyMaintenanceAuth authorization
1811− if not authorized then yield (respond {ok: False {}})
1812− else do
1807+handleUndrain = \authorization respond -> withMaintAuth authorization
1808+ (yield (respond {ok: False {}}))
1809+ (do
18131810 atomic do
18141811 set *drainPhase = 0
18151812 set *drainCompletedAt = 0
1816− yield (respond {ok: True {}})
1813+ yield (respond {ok: True {}}))
18171814
1818−handleShutdown = \authorization respond -> do
1819− authorized <- verifyMaintenanceAuth authorization
1820− if not authorized then yield (respond {ok: False {}, drained: 0})
1821− else handleDrain 2 authorization (\r -> respond {ok: r.ok, drained: r.drained})
1815+handleShutdown = \authorization respond -> withMaintAuth authorization
1816+ (yield (respond {ok: False {}, drained: 0}))
1817+ (handleDrain 2 authorization (\r -> respond {ok: r.ok, drained: r.drained}))
18221818
18231819handlePrune = \authorization respond -> do
18241820 t <- now
@@ -1826,10 +1822,9 @@ handlePrune = \authorization respond -> do
18261822 when authorized (fork (pruneAndRetry t))
18271823 yield (respond {ok: authorized})
18281824
1829−handleReconcile = \authorization respond -> do
1830− authorized <- verifyMaintenanceAuth authorization
1831− if not authorized then yield (respond {ok: False {}, messageDrift: 0, presenceDrift: 0, sessionDrift: 0})
1832− else yield (respond {ok: True {}, messageDrift: 0, presenceDrift: 0, sessionDrift: 0})
1825+handleReconcile = \authorization respond -> withMaintAuth authorization
1826+ (yield (respond {ok: False {}, messageDrift: 0, presenceDrift: 0, sessionDrift: 0}))
1827+ (yield (respond {ok: True {}, messageDrift: 0, presenceDrift: 0, sessionDrift: 0}))
18331828
18341829handleHealth = \authorization respond -> do
18351830 t <- now
@@ -1848,72 +1843,33 @@ handleReady = \respond -> do
18481843 lastPrune <- *lastPrunedAt
18491844 yield (respond {ready: lastPrune > 0 && lastPrune >= sa})
18501845
1851−handleBlockPeer = \server authorization respond -> do
1852− authorized <- verifyMaintenanceAuth authorization
1853− if not authorized then yield (respond {ok: False {}, blocked: 0})
1854− else do
1855− n <- atomic do
1856− blocked <- *blockedPeers
1857− if any blocked (\b -> b == server) then yield (count blocked)
1858− else do
1859− let updated = union blocked [server]
1860− set *blockedPeers = updated
1861− yield (count updated)
1862− yield (respond {ok: True {}, blocked: n})
1846+handleBlockPeer = \server authorization respond -> withMaintAuth authorization
1847+ (yield (respond {ok: False {}, blocked: 0}))
1848+ (do n <- addServerToList blockedPeers server; yield (respond {ok: True {}, blocked: n}))
18631849
1864−handleUnblockPeer = \server authorization respond -> do
1865− authorized <- verifyMaintenanceAuth authorization
1866− if not authorized then yield (respond {ok: False {}, unblocked: False {}})
1867− else do
1868− removed <- atomic do
1869− blocked <- *blockedPeers
1870− let had = any blocked (\b -> b == server)
1871− set *blockedPeers = do b <- blocked; where b != server; yield b
1872− yield had
1873− yield (respond {ok: True {}, unblocked: removed})
1874−
1875−handleListBlocked = \authorization respond -> do
1876− authorized <- verifyMaintenanceAuth authorization
1877− if not authorized then yield (respond {peers: [], ok: False {}})
1878− else do
1879− blocked <- *blockedPeers
1880− yield (respond {peers: blocked, ok: True {}})
1850+handleUnblockPeer = \server authorization respond -> withMaintAuth authorization
1851+ (yield (respond {ok: False {}, unblocked: False {}}))
1852+ (do removed <- removeServerFromList blockedPeers server; yield (respond {ok: True {}, unblocked: removed}))
18811853
1882−handleAllowPeer = \server authorization respond -> do
1883− authorized <- verifyMaintenanceAuth authorization
1884− if not authorized then yield (respond {ok: False {}, allowed: 0})
1885− else do
1886− n <- atomic do
1887− allowed <- *allowedPeers
1888− if any allowed (\a -> a == server) then yield (count allowed)
1889− else do
1890− let updated = union allowed [server]
1891− set *allowedPeers = updated
1892− yield (count updated)
1893− yield (respond {ok: True {}, allowed: n})
1854+handleListBlocked = \authorization respond -> withMaintAuth authorization
1855+ (yield (respond {peers: [], ok: False {}}))
1856+ (do blocked <- *blockedPeers; yield (respond {peers: blocked, ok: True {}}))
18941857
1895−handleUnallowPeer = \server authorization respond -> do
1896− authorized <- verifyMaintenanceAuth authorization
1897− if not authorized then yield (respond {ok: False {}, removed: False {}})
1898− else do
1899− removed <- atomic do
1900− allowed <- *allowedPeers
1901− let had = any allowed (\a -> a == server)
1902− set *allowedPeers = do a <- allowed; where a != server; yield a
1903− yield had
1904− yield (respond {ok: True {}, removed: removed})
1905−
1906−handleListAllowed = \authorization respond -> do
1907− authorized <- verifyMaintenanceAuth authorization
1908− if not authorized then yield (respond {peers: [], ok: False {}})
1909− else do
1910− allowed <- *allowedPeers
1911− yield (respond {peers: allowed, ok: True {}})
1858+handleAllowPeer = \server authorization respond -> withMaintAuth authorization
1859+ (yield (respond {ok: False {}, allowed: 0}))
1860+ (do n <- addServerToList allowedPeers server; yield (respond {ok: True {}, allowed: n}))
19121861
1913−handlePingPeer = \server authorization respond -> do
1914− authorized <- verifyMaintenanceAuth authorization
1915− if not authorized then yield (respond {ok: False {}, latencyMs: 0, error: "unauthorized"})
1916− else do
1862+handleUnallowPeer = \server authorization respond -> withMaintAuth authorization
1863+ (yield (respond {ok: False {}, removed: False {}}))
1864+ (do removed <- removeServerFromList allowedPeers server; yield (respond {ok: True {}, removed: removed}))
1865+
1866+handleListAllowed = \authorization respond -> withMaintAuth authorization
1867+ (yield (respond {peers: [], ok: False {}}))
1868+ (do allowed <- *allowedPeers; yield (respond {peers: allowed, ok: True {}}))
1869+
1870+handlePingPeer = \server authorization respond -> withMaintAuth authorization
1871+ (yield (respond {ok: False {}, latencyMs: 0, error: "unauthorized"}))
1872+ (do
19171873 startTime <- now
19181874 auth <- generateFederationAuth "gossip" startTime
19191875 result <- fetch (federationUrl server) (RecvGossip {
@@ -1923,21 +1879,18 @@ handlePingPeer = \server authorization respond -> do
19231879 endTime <- now
19241880 case result of
19251881 Err e -> yield (respond {ok: False {}, latencyMs: endTime - startTime, error: show e})
1926− Ok r -> yield (respond {ok: r.ok, latencyMs: endTime - startTime, error: r.error})
1882+ Ok r -> yield (respond {ok: r.ok, latencyMs: endTime - startTime, error: r.error}))
19271883
1928−handleAdminListSessions = \pubkey authorization respond -> do
1929− authorized <- verifyMaintenanceAuth authorization
1930− if not authorized then yield (respond {sessions: [], count: 0, ok: False {}})
1931− else do
1884+handleAdminListSessions = \pubkey authorization respond -> withMaintAuth authorization
1885+ (yield (respond {sessions: [], count: 0, ok: False {}}))
1886+ (do
19321887 ses <- *sessions
19331888 let mine = do s <- ses; where s.pubkey == pubkey; yield {token: "***", expiresAt: s.expiresAt, ip: s.ip, createdAt: s.createdAt}
1934− yield (respond {sessions: mine, count: count mine, ok: True {}})
1889+ yield (respond {sessions: mine, count: count mine, ok: True {}}))
19351890
1936−handleAdminRevokeSessions = \pubkey authorization respond -> do
1937− authorized <- verifyMaintenanceAuth authorization
1938− if not authorized then yield (respond {ok: False {}, revokedCount: 0})
1939− else do
1940− t <- now
1891+handleAdminRevokeSessions = \pubkey authorization respond -> withMaintAuth authorization
1892+ (yield (respond {ok: False {}, revokedCount: 0}))
1893+ (do
19411894 revoked <- atomic do
19421895 ses <- *sessions
19431896 let mine = do s <- ses; where s.pubkey == pubkey; yield s
@@ -1945,12 +1898,11 @@ handleAdminRevokeSessions = \pubkey authorization respond -> do
19451898 pres <- *presence
19461899 set *presence = do p <- pres; where p.pubkey != pubkey || not (isLocalServer p.server); yield p
19471900 yield (count mine)
1948− yield (respond {ok: True {}, revokedCount: revoked})
1901+ yield (respond {ok: True {}, revokedCount: revoked}))
19491902
1950−handleAdminPurgeMessages = \pubkey authorization respond -> do
1951− authorized <- verifyMaintenanceAuth authorization
1952− if not authorized then yield (respond {ok: False {}, purgedCount: 0})
1953− else do
1903+handleAdminPurgeMessages = \pubkey authorization respond -> withMaintAuth authorization
1904+ (yield (respond {ok: False {}, purgedCount: 0}))
1905+ (do
19541906 t <- now
19551907 purged <- atomic do
19561908 msgs <- *messages
@@ -1962,25 +1914,23 @@ handleAdminPurgeMessages = \pubkey authorization respond -> do
19621914 aids <- *ackedIds
19631915 set *ackedIds = capList (union aids federated) maxAckedIds (\a -> a.ackedAt)
19641916 yield (count mine)
1965− yield (respond {ok: True {}, purgedCount: purged})
1917+ yield (respond {ok: True {}, purgedCount: purged}))
19661918
1967−handleAdminRevokeIp = \ip authorization respond -> do
1968− authorized <- verifyMaintenanceAuth authorization
1969− if not authorized then yield (respond {ok: False {}, revokedCount: 0, affectedKeys: 0})
1970− else if ip == "" then yield (respond {ok: False {}, revokedCount: 0, affectedKeys: 0})
1971− else do
1919+handleAdminRevokeIp = \ip authorization respond -> withMaintAuth authorization
1920+ (yield (respond {ok: False {}, revokedCount: 0, affectedKeys: 0}))
1921+ (if ip == "" then yield (respond {ok: False {}, revokedCount: 0, affectedKeys: 0})
1922+ else do
19721923 result <- atomic do
19731924 ses <- *sessions
19741925 let mine = do s <- ses; where s.ip == ip; yield s
19751926 set *sessions = do s <- ses; where s.ip != ip; yield s
19761927 let keys = unique (do s <- mine; yield s.pubkey)
19771928 yield {revoked: count mine, keys: count keys}
1978− yield (respond {ok: True {}, revokedCount: result.revoked, affectedKeys: result.keys})
1929+ yield (respond {ok: True {}, revokedCount: result.revoked, affectedKeys: result.keys}))
19791930
1980−handleAdminListAllSessions = \limit authorization respond -> do
1981− authorized <- verifyMaintenanceAuth authorization
1982− if not authorized then yield (respond {sessions: [], ok: False {}, total: 0})
1983− else do
1931+handleAdminListAllSessions = \limit authorization respond -> withMaintAuth authorization
1932+ (yield (respond {sessions: [], ok: False {}, total: 0}))
1933+ (do
19841934 t <- now
19851935 ses <- *sessions
19861936 let active = do s <- ses; where s.expiresAt > t; yield s
@@ -1993,12 +1943,11 @@ handleAdminListAllSessions = \limit authorization respond -> do
19931943 latestExpiry: fold (\acc s -> max acc s.expiresAt) 0 mine}
19941944 let sorted = sortBy (\g -> 0 - g.count) grouped
19951945 let effLimit = if limit <= 0 then 100 else clamp 1 500 limit
1996− yield (respond {sessions: takeRelation effLimit sorted, ok: True {}, total: count grouped})
1946+ yield (respond {sessions: takeRelation effLimit sorted, ok: True {}, total: count grouped}))
19971947
1998−handleGetRateLimits = \authorization respond -> do
1999− authorized <- verifyMaintenanceAuth authorization
2000− if not authorized then yield (respond {ok: False {}, globalRequest: 0, ipRate: 0, sendRate: 0, federationRate: 0, authGlobal: 0, recvRate: 0, challengeRate: 0, pairRate: 0, lookupRate: 0, clientWriteRate: 0})
2001− else yield (respond {ok: True {}, globalRequest: maxGlobalRequestRate, ipRate: maxIpRatePerIp, sendRate: maxSendRatePerKey, federationRate: maxFederationRatePerServer, authGlobal: maxAuthGlobalRate, recvRate: maxRecvRatePerKey, challengeRate: maxChallengeRatePerKey, pairRate: maxPairRatePerPair, lookupRate: maxLookupRatePerKey, clientWriteRate: maxClientWriteRatePerKey})
1948+handleGetRateLimits = \authorization respond -> withMaintAuth authorization
1949+ (yield (respond {ok: False {}, globalRequest: 0, ipRate: 0, sendRate: 0, federationRate: 0, authGlobal: 0, recvRate: 0, challengeRate: 0, pairRate: 0, lookupRate: 0, clientWriteRate: 0}))
1950+ (yield (respond {ok: True {}, globalRequest: maxGlobalRequestRate, ipRate: maxIpRatePerIp, sendRate: maxSendRatePerKey, federationRate: maxFederationRatePerServer, authGlobal: maxAuthGlobalRate, recvRate: maxRecvRatePerKey, challengeRate: maxChallengeRatePerKey, pairRate: maxPairRatePerPair, lookupRate: maxLookupRatePerKey, clientWriteRate: maxClientWriteRatePerKey}))
20021951
20031952handleSetRateLimits = \globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization respond -> do
20041953 authorized <- verifyMaintenanceAuth authorization
@@ -2008,23 +1957,20 @@ handleFlushNonces = \authorization respond -> do
20081957 authorized <- verifyMaintenanceAuth authorization
20091958 yield (respond {ok: authorized, flushedCount: 0})
20101959
2011−handleRotateSecret = \newSecret authorization respond -> do
2012− authorized <- verifyMaintenanceAuth authorization
2013− if not authorized then yield (respond {ok: False {}, error: "unauthorized"})
2014− else do
1960+handleRotateSecret = \newSecret authorization respond -> withMaintAuth authorization
1961+ (yield (respond {ok: False {}, error: "unauthorized"}))
1962+ (do
20151963 atomic do set *runtimeMaintenanceSecret = newSecret
2016− yield (respond {ok: True {}, error: ""})
1964+ yield (respond {ok: True {}, error: ""}))
20171965
2018−handleGetConfig = \authorization respond -> do
2019− authorized <- verifyMaintenanceAuth authorization
2020− if not authorized then yield (respond {ok: False {}, maxMessagesPerRecipient: 0, maxGossipHops: 0, pollTimeoutMs: 0, ackGracePeriod: 0})
2021− else yield (respond {ok: True {}, maxMessagesPerRecipient: maxMessagesPerRecipient, maxGossipHops: maxGossipHops, pollTimeoutMs: pollTimeoutMs, ackGracePeriod: ackGracePeriod})
1966+handleGetConfig = \authorization respond -> withMaintAuth authorization
1967+ (yield (respond {ok: False {}, maxMessagesPerRecipient: 0, maxGossipHops: 0, pollTimeoutMs: 0, ackGracePeriod: 0}))
1968+ (yield (respond {ok: True {}, maxMessagesPerRecipient: maxMessagesPerRecipient, maxGossipHops: maxGossipHops, pollTimeoutMs: pollTimeoutMs, ackGracePeriod: ackGracePeriod}))
20221969
20231970-- /stats: zero-fill all metric fields we no longer compute.
2024−handleStats = \authorization respond -> do
2025− authorized <- verifyMaintenanceAuth authorization
2026− if not authorized then yield (respond zeroStats)
2027− else do
1971+handleStats = \authorization respond -> withMaintAuth authorization
1972+ (yield (respond zeroStats))
1973+ (do
20281974 t <- now
20291975 sa <- *startedAt
20301976 sessions <- *sessions
@@ -2050,14 +1996,13 @@ handleStats = \authorization respond -> do
20501996 let zeroRates = {send: 0, challenge: 0, federation: 0, federationPair: 0, global: 0, ip: 0, lookup: 0, recv: 0, pair: 0, gossipEvent: 0, verifyIp: 0, uniqueKeyIp: 0, pendingAckCleanups: 0, senderExpirations: 0, senderDeliveries: 0, rejectedGlobal: 0, rejectedIp: 0, rejectedAuth: 0, rejectedPerKey: 0, rejectedFederation: 0, clientCancels: 0, federationCancels: 0}
20511997 let cap = {sessions: sCount, sessionsMax: maxSessions, sessionsPct: if maxSessions > 0 then sCount * 100 / maxSessions else 0, messages: mCount, messagesMax: maxMessages, messagesPct: if maxMessages > 0 then mCount * 100 / maxMessages else 0, totalMessageCount: mCount, presence: pCount, presenceMax: maxPresenceEntries, presencePct: if maxPresenceEntries > 0 then pCount * 100 / maxPresenceEntries else 0, forwards: fCount, forwardsMax: maxForwardsEntries, forwardsPct: if maxForwardsEntries > 0 then fCount * 100 / maxForwardsEntries else 0, challenges: count chs, challengesMax: maxChallenges, ackedIds: count aids, ackedIdsMax: maxAckedIds, ackOverflow: 0, ackOverflowMax: 0, deliveredIds: count dids, deliveredIdsMax: maxDeliveredIds, forwardNonces: 0, forwardNoncesMax: 0, nonceEvictions: 0, activePolls: count aps, activePollsMax: maxActivePolls, recipientCounts: 0, messageBucketMax: 0, messageBucketMin: 0}
20521998 let timing = {pruneCount: pc, pruneRunning: 0, heartbeatCount: hc, uptime: t - sa, lastPruneAt: lp, lastHeartbeatAt: lh, draining: dp > 0, drainPhase: dp, totalEntries: sCount + mCount + pCount + fCount, activeRequests: 0, peakActiveRequests: 0, pollAvgMs: 0, pollMaxMs: 0, pollCount: 0, pollLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0}, sendAvgMs: 0, sendMaxMs: 0, sendCount: 0, sendLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0}, authAvgMs: 0, authMaxMs: 0, authCount: 0}
2053− yield (respond {ok: True {}, version: serverBuildVersion, capacity: cap, federation: zeroFed, rates: zeroRates, timing: timing})
1999+ yield (respond {ok: True {}, version: serverBuildVersion, capacity: cap, federation: zeroFed, rates: zeroRates, timing: timing}))
20542000
20552001zeroStats = {ok: False {}, version: serverBuildVersion, capacity: {sessions: 0, sessionsMax: 0, sessionsPct: 0, messages: 0, messagesMax: 0, messagesPct: 0, totalMessageCount: 0, presence: 0, presenceMax: 0, presencePct: 0, forwards: 0, forwardsMax: 0, forwardsPct: 0, challenges: 0, challengesMax: 0, ackedIds: 0, ackedIdsMax: 0, ackOverflow: 0, ackOverflowMax: 0, deliveredIds: 0, deliveredIdsMax: 0, forwardNonces: 0, forwardNoncesMax: 0, nonceEvictions: 0, activePolls: 0, activePollsMax: 0, recipientCounts: 0, messageBucketMax: 0, messageBucketMin: 0}, federation: {enabled: False {}, inFlight: 0, hungSlots: 0, avgLatencyMs: 0, maxLatencyMs: 0, callCount: 0, slowVerifies: 0, verifyFailures: 0, forwardFailures: 0, oldestForwardAge: 0, oldestAckAge: 0, recentGossip: 0, blockedPeers: 0, drainCompletedAt: 0, forwardServers: 0, maxForwardQueueDepth: 0, topFailingPeers: [], pendingCancels: 0, gossipSuccess: 0, gossipFail: 0, latencyBuckets: {lt100: 0, lt500: 0, lt2000: 0, gte2000: 0}}, rates: {send: 0, challenge: 0, federation: 0, federationPair: 0, global: 0, ip: 0, lookup: 0, recv: 0, pair: 0, gossipEvent: 0, verifyIp: 0, uniqueKeyIp: 0, pendingAckCleanups: 0, senderExpirations: 0, senderDeliveries: 0, rejectedGlobal: 0, rejectedIp: 0, rejectedAuth: 0, rejectedPerKey: 0, rejectedFederation: 0, clientCancels: 0, federationCancels: 0}, timing: {pruneCount: 0, pruneRunning: 0, heartbeatCount: 0, uptime: 0, lastPruneAt: 0, lastHeartbeatAt: 0, draining: False {}, drainPhase: 0, totalEntries: 0, activeRequests: 0, peakActiveRequests: 0, pollAvgMs: 0, pollMaxMs: 0, pollCount: 0, pollLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0}, sendAvgMs: 0, sendMaxMs: 0, sendCount: 0, sendLatencyBuckets: {lt50: 0, lt200: 0, lt1000: 0, gte1000: 0}, authAvgMs: 0, authMaxMs: 0, authCount: 0}}
20562002
2057−handleStatsPeers = \authorization respond -> do
2058− authorized <- verifyMaintenanceAuth authorization
2059− if not authorized then yield (respond {peers: [], ok: False {}})
2060− else do
2003+handleStatsPeers = \authorization respond -> withMaintAuth authorization
2004+ (yield (respond {peers: [], ok: False {}}))
2005+ (do
20612006 t <- now
20622007 failures <- *forwardFailures
20632008 fwds <- *forwards
@@ -2065,12 +2010,11 @@ handleStatsPeers = \authorization respond -> do
20652010 f <- failures
20662011 let pending = count (do x <- fwds; where x.toServer == f.server; yield x)
20672012 yield {server: f.server, failures: f.failures, lastFailedAt: f.failedAt, firstFailedAt: f.firstFailedAt, backoffMs: retryBackoff f.failures, retriable: shouldRetryServer f.server t failures, pendingForwards: pending, avgLatencyMs: 0, maxLatencyMs: 0, latencySamples: 0, gossipEventsPerMin: 0}
2068− yield (respond {peers: peers, ok: True {}})
2013+ yield (respond {peers: peers, ok: True {}}))
20692014
2070−handleStatsKey = \pubkey authorization respond -> do
2071− authorized <- verifyMaintenanceAuth authorization
2072− if not authorized then yield (respond {messages: 0, presence: [], sessions: 0, forwards: 0, forwardDetails: [], activePolls: 0, ok: False {}})
2073− else do
2015+handleStatsKey = \pubkey authorization respond -> withMaintAuth authorization
2016+ (yield (respond {messages: 0, presence: [], sessions: 0, forwards: 0, forwardDetails: [], activePolls: 0, ok: False {}}))
2017+ (do
20742018 t <- now
20752019 msgs <- *messages
20762020 pres <- *presence
@@ -2084,24 +2028,22 @@ handleStatsKey = \pubkey authorization respond -> do
20842028 let f = count myFwds
20852029 let fd = do x <- myFwds; yield {server: x.toServer, retries: x.retries, createdAt: x.createdAt}
20862030 let a = count (do x <- aps; where x.pubkey == pubkey; yield x)
2087− yield (respond {messages: m, presence: p, sessions: s, forwards: f, forwardDetails: fd, activePolls: a, ok: True {}})
2031+ yield (respond {messages: m, presence: p, sessions: s, forwards: f, forwardDetails: fd, activePolls: a, ok: True {}}))
20882032
2089−handleTopRecipients = \limit authorization respond -> do
2090− authorized <- verifyMaintenanceAuth authorization
2091− if not authorized then yield (respond {recipients: [], ok: False {}, total: 0})
2092− else do
2033+handleTopRecipients = \limit authorization respond -> withMaintAuth authorization
2034+ (yield (respond {recipients: [], ok: False {}, total: 0}))
2035+ (do
20932036 msgs <- *messages
20942037 let counts = do
20952038 pk <- unique (do m <- msgs; yield m.toKey)
20962039 yield {pubkey: pk, count: count (do m <- msgs; where m.toKey == pk; yield m)}
20972040 let sorted = sortBy (\c -> 0 - c.count) counts
20982041 let effLimit = if limit <= 0 then 20 else clamp 1 100 limit
2099− yield (respond {recipients: takeRelation effLimit sorted, ok: True {}, total: count counts})
2042+ yield (respond {recipients: takeRelation effLimit sorted, ok: True {}, total: count counts}))
21002043
2101−handleStatsForwards = \authorization respond -> do
2102− authorized <- verifyMaintenanceAuth authorization
2103− if not authorized then yield (respond {servers: [], ok: False {}, total: 0})
2104− else do
2044+handleStatsForwards = \authorization respond -> withMaintAuth authorization
2045+ (yield (respond {servers: [], ok: False {}, total: 0}))
2046+ (do
21052047 t <- now
21062048 fwds <- *forwards
21072049 let servers = collectPeers fwds (\f -> f.toServer)
@@ -2111,12 +2053,11 @@ handleStatsForwards = \authorization respond -> do
21112053 let oldest = case minBy svFwds (\f -> f.createdAt) of Nothing {} -> 0; Just {value: x} -> t - x.createdAt
21122054 let retries = fold (\acc f -> acc + f.retries) 0 svFwds
21132055 yield {server: s, count: count svFwds, oldestAge: oldest, totalRetries: retries}
2114− yield (respond {servers: result, ok: True {}, total: count fwds})
2056+ yield (respond {servers: result, ok: True {}, total: count fwds}))
21152057
2116−handleStatsRates = \authorization respond -> do
2117− authorized <- verifyMaintenanceAuth authorization
2118− if not authorized then yield (respond {ok: False {}, scalePct: 0, globalRequest: 0, ipRate: 0, sendRate: 0, federationRate: 0, authGlobal: 0, recvRate: 0, challengeRate: 0, pairRate: 0, lookupRate: 0, clientWriteRate: 0})
2119− else yield (respond {ok: True {}, scalePct: 100, globalRequest: maxGlobalRequestRate, ipRate: maxIpRatePerIp, sendRate: maxSendRatePerKey, federationRate: maxFederationRatePerServer, authGlobal: maxAuthGlobalRate, recvRate: maxRecvRatePerKey, challengeRate: maxChallengeRatePerKey, pairRate: maxPairRatePerPair, lookupRate: maxLookupRatePerKey, clientWriteRate: maxClientWriteRatePerKey})
2058+handleStatsRates = \authorization respond -> withMaintAuth authorization
2059+ (yield (respond {ok: False {}, scalePct: 0, globalRequest: 0, ipRate: 0, sendRate: 0, federationRate: 0, authGlobal: 0, recvRate: 0, challengeRate: 0, pairRate: 0, lookupRate: 0, clientWriteRate: 0}))
2060+ (yield (respond {ok: True {}, scalePct: 100, globalRequest: maxGlobalRequestRate, ipRate: maxIpRatePerIp, sendRate: maxSendRatePerKey, federationRate: maxFederationRatePerServer, authGlobal: maxAuthGlobalRate, recvRate: maxRecvRatePerKey, challengeRate: maxChallengeRatePerKey, pairRate: maxPairRatePerPair, lookupRate: maxLookupRatePerKey, clientWriteRate: maxClientWriteRatePerKey}))
21202061
21212062handleMetrics = \authorization respond -> do
21222063 t <- now