@@ -453,6 +453,26 @@ max = \a b -> if a > b then a else b
453-- Dedup: keeps first occurrence (O(n^2)).
453-- Dedup: keeps first occurrence (O(n^2)).
454unique = \items -> fold (\acc x -> if any acc (\a -> a == x) then acc else union acc [x]) [] items
454unique = \items -> fold (\acc x -> if any acc (\a -> a == x) then acc else union acc [x]) [] items
456+-- Replace a ref's contents with the entries that satisfy `keep`. Caller controls atomicity.
457+pruneRef = \ref keep -> do
459+ set *ref = do x <- cur; where keep x; yield x
461+-- Add `server` to the named list ref if absent. Returns the new total.
462+addServerToList = \listRef server -> atomic do
464+ if any current (\x -> x == server) then yield (count current)
466+ set *listRef = union current [server]
467+ yield (count current + 1)
469+-- Remove `server` from the named list ref. Returns whether it was present.
470+removeServerFromList = \listRef server -> atomic do
472+ let had = any current (\x -> x == server)
473+ set *listRef = do x <- current; where x != server; yield x
456headOf = \items -> fold (\acc x -> case acc of
476headOf = \items -> fold (\acc x -> case acc of
457 Nothing {} -> Just {value: x}
477 Nothing {} -> Just {value: x}
458 _ -> acc) Nothing {} items
478 _ -> acc) Nothing {} items
@@ -574,6 +594,10 @@ verifyMaintenanceAuth = \authorization -> do
574 Just {value: token} -> yield (secret != "" && token == secret)
594 Just {value: token} -> yield (secret != "" && token == secret)
575 _ -> yield False
595 _ -> yield False
597+withMaintAuth = \authorization onUnauth onAuth -> do
598+ authorized <- verifyMaintenanceAuth authorization
599+ if authorized then onAuth else onUnauth
577authenticateSession : [Session] -> Text -> Timestamp -> AuthResult
601authenticateSession : [Session] -> Text -> Timestamp -> AuthResult
578authenticateSession = \sessions token t ->
602authenticateSession = \sessions token t ->
579 case headOf (do s <- sessions; where s.expiresAt > t && s.token == token; yield s) of
603 case headOf (do s <- sessions; where s.expiresAt > t && s.token == token; yield s) of
@@ -767,7 +791,7 @@ effectiveMessageTtl = \expiresInMs ->
767 else clamp minMessageTtl unackedMessageMaxAge expiresInMs
791 else clamp minMessageTtl unackedMessageMaxAge expiresInMs
769nextSeqTs : Timestamp -> Timestamp -> Timestamp
793nextSeqTs : Timestamp -> Timestamp -> Timestamp
770−nextSeqTs = \t seqCounter -> if t > seqCounter then t else seqCounter + 1
794+nextSeqTs = \t seqCounter -> max t (seqCounter + 1)
772dedupMessageIds : [MessageIdHex] -> [MessageIdHex]
796dedupMessageIds : [MessageIdHex] -> [MessageIdHex]
773dedupMessageIds = \ids -> takeRelation maxMessageIds (unique ids)
797dedupMessageIds = \ids -> takeRelation maxMessageIds (unique ids)
@@ -802,50 +826,25 @@ mergePresence = \existing incoming ->
802-- Pruning
826-- Pruning
803-- ============================================
827-- ============================================
805−pruneExpired = \t -> do
829+pruneExpired = \t -> atomic do
806− expiredLocalKeys <- atomic do
809− set *challenges = do x <- ch; where x.expiresAt > t; yield x
830+ pruneRef challenges (\x -> x.expiresAt > t)
812− set *sessions = do x <- ses; where x.expiresAt > t; yield x
831+ pruneRef sessions (\x -> x.expiresAt > t)
814− msgs <- *messages
832+ pruneRef messages (\m -> m.expiresAt > t)
815− set *messages = do m <- msgs; where m.expiresAt > t; yield m
817− fwds <- *forwards
833+ pruneRef forwards (\f -> f.expiresAt > t)
818− set *forwards = do f <- fwds; where f.expiresAt > t; yield f
819− -- ackedIds, deliveredIds
821− set *ackedIds = do a <- aids; where t - a.ackedAt < messageMaxAge; yield a
834+ pruneRef ackedIds (\a -> t - a.ackedAt < messageMaxAge)
822− dids <- *deliveredIds
835+ pruneRef deliveredIds (\d -> t - d.deliveredAt < messageMaxAge)
823− set *deliveredIds = do d <- dids; where t - d.deliveredAt < messageMaxAge; yield d
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)
824− -- presence: remember locally-expired keys for offline gossip
843+ -- presence: remember locally-expired keys for offline gossip
825− pres <- *presence
844+ pres <- *presence
826− let keptPres = do p <- pres; where p.expiresAt > t; yield p
845+ let keptPres = do p <- pres; where p.expiresAt > t; yield p
846+ set *presence = keptPres
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
847+ yield (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
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)
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
848− yield expiredLocalKeys
850-- ============================================
849-- ============================================
851-- Federation gossip
850-- Federation gossip
@@ -1785,10 +1784,9 @@ zipPairs = \mids keys ->
1785-- Maintenance handlers
1784-- Maintenance handlers
1786-- ============================================
1785-- ============================================
1788−handleDrain = \phase authorization respond -> do
1787+handleDrain = \phase authorization respond -> withMaintAuth authorization
1789− authorized <- verifyMaintenanceAuth authorization
1790− if not authorized then yield (respond {ok: False {}, drained: 0, phase: 0})
1788+ (yield (respond {ok: False {}, drained: 0, phase: 0}))
1792 let effectivePhase = if phase == 1 then 1 else 2
1790 let effectivePhase = if phase == 1 then 1 else 2
1793 t <- now
1791 t <- now
1794 drainResult <- atomic do
1792 drainResult <- atomic do
@@ -1804,21 +1802,19 @@ handleDrain = \phase authorization respond -> do
1804 yield {drainedCount: count localEntries, peers: peers, localKeys: localEntries}
1802 yield {drainedCount: count localEntries, peers: peers, localKeys: localEntries}
1805 when (effectivePhase == 2 && count drainResult.localKeys > 0 && count drainResult.peers > 0 && federationEnabled)
1803 when (effectivePhase == 2 && count drainResult.localKeys > 0 && count drainResult.peers > 0 && federationEnabled)
1806 (fork (sendBatchedGossip drainResult.peers (do p <- drainResult.localKeys; yield {eventType: GossipOffline {}, pubkey: p.pubkey, server: serverHostN, timestamp: t, ttl: offlineGossipMinTtl, seenBy: [serverHostN]}) gossipOriginHops))
1804 (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}))
1809−handleUndrain = \authorization respond -> do
1807+handleUndrain = \authorization respond -> withMaintAuth authorization
1810− authorized <- verifyMaintenanceAuth authorization
1811− if not authorized then yield (respond {ok: False {}})
1808+ (yield (respond {ok: False {}}))
1813 atomic do
1810 atomic do
1814 set *drainPhase = 0
1811 set *drainPhase = 0
1815 set *drainCompletedAt = 0
1812 set *drainCompletedAt = 0
1816− yield (respond {ok: True {}})
1813+ yield (respond {ok: True {}}))
1818−handleShutdown = \authorization respond -> do
1815+handleShutdown = \authorization respond -> withMaintAuth authorization
1819− authorized <- verifyMaintenanceAuth authorization
1820− if not authorized then yield (respond {ok: False {}, drained: 0})
1816+ (yield (respond {ok: False {}, drained: 0}))
1821− else handleDrain 2 authorization (\r -> respond {ok: r.ok, drained: r.drained})
1817+ (handleDrain 2 authorization (\r -> respond {ok: r.ok, drained: r.drained}))
1823handlePrune = \authorization respond -> do
1819handlePrune = \authorization respond -> do
1824 t <- now
1820 t <- now
@@ -1826,10 +1822,9 @@ handlePrune = \authorization respond -> do
1826 when authorized (fork (pruneAndRetry t))
1822 when authorized (fork (pruneAndRetry t))
1827 yield (respond {ok: authorized})
1823 yield (respond {ok: authorized})
1829−handleReconcile = \authorization respond -> do
1825+handleReconcile = \authorization respond -> withMaintAuth authorization
1830− authorized <- verifyMaintenanceAuth authorization
1831− if not authorized then yield (respond {ok: False {}, messageDrift: 0, presenceDrift: 0, sessionDrift: 0})
1826+ (yield (respond {ok: False {}, messageDrift: 0, presenceDrift: 0, sessionDrift: 0}))
1832− else yield (respond {ok: True {}, messageDrift: 0, presenceDrift: 0, sessionDrift: 0})
1827+ (yield (respond {ok: True {}, messageDrift: 0, presenceDrift: 0, sessionDrift: 0}))
1834handleHealth = \authorization respond -> do
1829handleHealth = \authorization respond -> do
1835 t <- now
1830 t <- now
@@ -1848,72 +1843,33 @@ handleReady = \respond -> do
1848 lastPrune <- *lastPrunedAt
1843 lastPrune <- *lastPrunedAt
1849 yield (respond {ready: lastPrune > 0 && lastPrune >= sa})
1844 yield (respond {ready: lastPrune > 0 && lastPrune >= sa})
1851−handleBlockPeer = \server authorization respond -> do
1846+handleBlockPeer = \server authorization respond -> withMaintAuth authorization
1852− authorized <- verifyMaintenanceAuth authorization
1853− if not authorized then yield (respond {ok: False {}, blocked: 0})
1847+ (yield (respond {ok: False {}, blocked: 0}))
1856− blocked <- *blockedPeers
1857− if any blocked (\b -> b == server) then yield (count blocked)
1859− let updated = union blocked [server]
1860− set *blockedPeers = updated
1861− yield (count updated)
1862− yield (respond {ok: True {}, blocked: n})
1848+ (do n <- addServerToList blockedPeers server; yield (respond {ok: True {}, blocked: n}))
1864−handleUnblockPeer = \server authorization respond -> do
1850+handleUnblockPeer = \server authorization respond -> withMaintAuth authorization
1865− authorized <- verifyMaintenanceAuth authorization
1866− if not authorized then yield (respond {ok: False {}, unblocked: False {}})
1851+ (yield (respond {ok: False {}, unblocked: False {}}))
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
1873− yield (respond {ok: True {}, unblocked: removed})
1852+ (do removed <- removeServerFromList blockedPeers server; yield (respond {ok: True {}, unblocked: removed}))
1875−handleListBlocked = \authorization respond -> do
1876− authorized <- verifyMaintenanceAuth authorization
1877− if not authorized then yield (respond {peers: [], ok: False {}})
1879− blocked <- *blockedPeers
1880− yield (respond {peers: blocked, ok: True {}})
1882−handleAllowPeer = \server authorization respond -> do
1854+handleListBlocked = \authorization respond -> withMaintAuth authorization
1883− authorized <- verifyMaintenanceAuth authorization
1855+ (yield (respond {peers: [], ok: False {}}))
1884− if not authorized then yield (respond {ok: False {}, allowed: 0})
1887− allowed <- *allowedPeers
1888− if any allowed (\a -> a == server) then yield (count allowed)
1890− let updated = union allowed [server]
1891− set *allowedPeers = updated
1892− yield (count updated)
1893− yield (respond {ok: True {}, allowed: n})
1856+ (do blocked <- *blockedPeers; yield (respond {peers: blocked, ok: True {}}))
1895−handleUnallowPeer = \server authorization respond -> do
1858+handleAllowPeer = \server authorization respond -> withMaintAuth authorization
1896− authorized <- verifyMaintenanceAuth authorization
1897− if not authorized then yield (respond {ok: False {}, removed: False {}})
1859+ (yield (respond {ok: False {}, allowed: 0}))
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
1860+ (do n <- addServerToList allowedPeers server; yield (respond {ok: True {}, allowed: n}))
1904− yield (respond {ok: True {}, removed: removed})
1906−handleListAllowed = \authorization respond -> do
1907− authorized <- verifyMaintenanceAuth authorization
1908− if not authorized then yield (respond {peers: [], ok: False {}})
1910− allowed <- *allowedPeers
1911− yield (respond {peers: allowed, ok: True {}})
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}))
1866+handleListAllowed = \authorization respond -> withMaintAuth authorization
1867+ (yield (respond {peers: [], ok: False {}}))
1868+ (do allowed <- *allowedPeers; yield (respond {peers: allowed, ok: True {}}))
1913−handlePingPeer = \server authorization respond -> do
1870+handlePingPeer = \server authorization respond -> withMaintAuth authorization
1914− authorized <- verifyMaintenanceAuth authorization
1915− if not authorized then yield (respond {ok: False {}, latencyMs: 0, error: "unauthorized"})
1871+ (yield (respond {ok: False {}, latencyMs: 0, error: "unauthorized"}))
1917 startTime <- now
1873 startTime <- now
1918 auth <- generateFederationAuth "gossip" startTime
1874 auth <- generateFederationAuth "gossip" startTime
1919 result <- fetch (federationUrl server) (RecvGossip {
1875 result <- fetch (federationUrl server) (RecvGossip {
@@ -1923,21 +1879,18 @@ handlePingPeer = \server authorization respond -> do
1923 endTime <- now
1879 endTime <- now
1924 case result of
1880 case result of
1925 Err e -> yield (respond {ok: False {}, latencyMs: endTime - startTime, error: show e})
1881 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}))
1928−handleAdminListSessions = \pubkey authorization respond -> do
1884+handleAdminListSessions = \pubkey authorization respond -> withMaintAuth authorization
1929− authorized <- verifyMaintenanceAuth authorization
1930− if not authorized then yield (respond {sessions: [], count: 0, ok: False {}})
1885+ (yield (respond {sessions: [], count: 0, ok: False {}}))
1932 ses <- *sessions
1887 ses <- *sessions
1933 let mine = do s <- ses; where s.pubkey == pubkey; yield {token: "***", expiresAt: s.expiresAt, ip: s.ip, createdAt: s.createdAt}
1888 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 {}}))
1936−handleAdminRevokeSessions = \pubkey authorization respond -> do
1891+handleAdminRevokeSessions = \pubkey authorization respond -> withMaintAuth authorization
1937− authorized <- verifyMaintenanceAuth authorization
1938− if not authorized then yield (respond {ok: False {}, revokedCount: 0})
1892+ (yield (respond {ok: False {}, revokedCount: 0}))
1941 revoked <- atomic do
1894 revoked <- atomic do
1942 ses <- *sessions
1895 ses <- *sessions
1943 let mine = do s <- ses; where s.pubkey == pubkey; yield s
1896 let mine = do s <- ses; where s.pubkey == pubkey; yield s
@@ -1945,12 +1898,11 @@ handleAdminRevokeSessions = \pubkey authorization respond -> do
1945 pres <- *presence
1898 pres <- *presence
1946 set *presence = do p <- pres; where p.pubkey != pubkey || not (isLocalServer p.server); yield p
1899 set *presence = do p <- pres; where p.pubkey != pubkey || not (isLocalServer p.server); yield p
1947 yield (count mine)
1900 yield (count mine)
1948− yield (respond {ok: True {}, revokedCount: revoked})
1901+ yield (respond {ok: True {}, revokedCount: revoked}))
1950−handleAdminPurgeMessages = \pubkey authorization respond -> do
1903+handleAdminPurgeMessages = \pubkey authorization respond -> withMaintAuth authorization
1951− authorized <- verifyMaintenanceAuth authorization
1952− if not authorized then yield (respond {ok: False {}, purgedCount: 0})
1904+ (yield (respond {ok: False {}, purgedCount: 0}))
1954 t <- now
1906 t <- now
1955 purged <- atomic do
1907 purged <- atomic do
1956 msgs <- *messages
1908 msgs <- *messages
@@ -1962,25 +1914,23 @@ handleAdminPurgeMessages = \pubkey authorization respond -> do
1962 aids <- *ackedIds
1914 aids <- *ackedIds
1963 set *ackedIds = capList (union aids federated) maxAckedIds (\a -> a.ackedAt)
1915 set *ackedIds = capList (union aids federated) maxAckedIds (\a -> a.ackedAt)
1964 yield (count mine)
1916 yield (count mine)
1965− yield (respond {ok: True {}, purgedCount: purged})
1917+ yield (respond {ok: True {}, purgedCount: purged}))
1967−handleAdminRevokeIp = \ip authorization respond -> do
1919+handleAdminRevokeIp = \ip authorization respond -> withMaintAuth authorization
1968− authorized <- verifyMaintenanceAuth authorization
1969− if not authorized then yield (respond {ok: False {}, revokedCount: 0, affectedKeys: 0})
1920+ (yield (respond {ok: False {}, revokedCount: 0, affectedKeys: 0}))
1970− else if ip == "" then yield (respond {ok: False {}, revokedCount: 0, affectedKeys: 0})
1921+ (if ip == "" then yield (respond {ok: False {}, revokedCount: 0, affectedKeys: 0})
1971− else do
1922+ else do
1972 result <- atomic do
1923 result <- atomic do
1973 ses <- *sessions
1924 ses <- *sessions
1974 let mine = do s <- ses; where s.ip == ip; yield s
1925 let mine = do s <- ses; where s.ip == ip; yield s
1975 set *sessions = do s <- ses; where s.ip != ip; yield s
1926 set *sessions = do s <- ses; where s.ip != ip; yield s
1976 let keys = unique (do s <- mine; yield s.pubkey)
1927 let keys = unique (do s <- mine; yield s.pubkey)
1977 yield {revoked: count mine, keys: count keys}
1928 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}))
1980−handleAdminListAllSessions = \limit authorization respond -> do
1931+handleAdminListAllSessions = \limit authorization respond -> withMaintAuth authorization
1981− authorized <- verifyMaintenanceAuth authorization
1982− if not authorized then yield (respond {sessions: [], ok: False {}, total: 0})
1932+ (yield (respond {sessions: [], ok: False {}, total: 0}))
1984 t <- now
1934 t <- now
1985 ses <- *sessions
1935 ses <- *sessions
1986 let active = do s <- ses; where s.expiresAt > t; yield s
1936 let active = do s <- ses; where s.expiresAt > t; yield s
@@ -1993,12 +1943,11 @@ handleAdminListAllSessions = \limit authorization respond -> do
1993 latestExpiry: fold (\acc s -> max acc s.expiresAt) 0 mine}
1943 latestExpiry: fold (\acc s -> max acc s.expiresAt) 0 mine}
1994 let sorted = sortBy (\g -> 0 - g.count) grouped
1944 let sorted = sortBy (\g -> 0 - g.count) grouped
1995 let effLimit = if limit <= 0 then 100 else clamp 1 500 limit
1945 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}))
1998−handleGetRateLimits = \authorization respond -> do
1948+handleGetRateLimits = \authorization respond -> withMaintAuth authorization
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})
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}))
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})
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}))
2003handleSetRateLimits = \globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization respond -> do
1952handleSetRateLimits = \globalRequest ipRate sendRate federationRate authGlobal recvRate challengeRate pairRate lookupRate clientWriteRate authorization respond -> do
2004 authorized <- verifyMaintenanceAuth authorization
1953 authorized <- verifyMaintenanceAuth authorization
@@ -2008,23 +1957,20 @@ handleFlushNonces = \authorization respond -> do
2008 authorized <- verifyMaintenanceAuth authorization
1957 authorized <- verifyMaintenanceAuth authorization
2009 yield (respond {ok: authorized, flushedCount: 0})
1958 yield (respond {ok: authorized, flushedCount: 0})
2011−handleRotateSecret = \newSecret authorization respond -> do
1960+handleRotateSecret = \newSecret authorization respond -> withMaintAuth authorization
2012− authorized <- verifyMaintenanceAuth authorization
2013− if not authorized then yield (respond {ok: False {}, error: "unauthorized"})
1961+ (yield (respond {ok: False {}, error: "unauthorized"}))
2015 atomic do set *runtimeMaintenanceSecret = newSecret
1963 atomic do set *runtimeMaintenanceSecret = newSecret
2016− yield (respond {ok: True {}, error: ""})
1964+ yield (respond {ok: True {}, error: ""}))
2018−handleGetConfig = \authorization respond -> do
1966+handleGetConfig = \authorization respond -> withMaintAuth authorization
2019− authorized <- verifyMaintenanceAuth authorization
2020− if not authorized then yield (respond {ok: False {}, maxMessagesPerRecipient: 0, maxGossipHops: 0, pollTimeoutMs: 0, ackGracePeriod: 0})
1967+ (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})
1968+ (yield (respond {ok: True {}, maxMessagesPerRecipient: maxMessagesPerRecipient, maxGossipHops: maxGossipHops, pollTimeoutMs: pollTimeoutMs, ackGracePeriod: ackGracePeriod}))
2023-- /stats: zero-fill all metric fields we no longer compute.
1970-- /stats: zero-fill all metric fields we no longer compute.
2024−handleStats = \authorization respond -> do
1971+handleStats = \authorization respond -> withMaintAuth authorization
2025− authorized <- verifyMaintenanceAuth authorization
2026− if not authorized then yield (respond zeroStats)
1972+ (yield (respond zeroStats))
2028 t <- now
1974 t <- now
2029 sa <- *startedAt
1975 sa <- *startedAt
2030 sessions <- *sessions
1976 sessions <- *sessions
@@ -2050,14 +1996,13 @@ handleStats = \authorization respond -> do
2050 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}
1996 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}
2051 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}
1997 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}
2052 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}
1998 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}))
2055zeroStats = {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}}
2001zeroStats = {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}}
2057−handleStatsPeers = \authorization respond -> do
2003+handleStatsPeers = \authorization respond -> withMaintAuth authorization
2058− authorized <- verifyMaintenanceAuth authorization
2059− if not authorized then yield (respond {peers: [], ok: False {}})
2004+ (yield (respond {peers: [], ok: False {}}))
2061 t <- now
2006 t <- now
2062 failures <- *forwardFailures
2007 failures <- *forwardFailures
2063 fwds <- *forwards
2008 fwds <- *forwards
@@ -2065,12 +2010,11 @@ handleStatsPeers = \authorization respond -> do
2065 f <- failures
2010 f <- failures
2066 let pending = count (do x <- fwds; where x.toServer == f.server; yield x)
2011 let pending = count (do x <- fwds; where x.toServer == f.server; yield x)
2067 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}
2012 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 {}}))
2070−handleStatsKey = \pubkey authorization respond -> do
2015+handleStatsKey = \pubkey authorization respond -> withMaintAuth authorization
2071− authorized <- verifyMaintenanceAuth authorization
2072− if not authorized then yield (respond {messages: 0, presence: [], sessions: 0, forwards: 0, forwardDetails: [], activePolls: 0, ok: False {}})
2016+ (yield (respond {messages: 0, presence: [], sessions: 0, forwards: 0, forwardDetails: [], activePolls: 0, ok: False {}}))
2074 t <- now
2018 t <- now
2075 msgs <- *messages
2019 msgs <- *messages
2076 pres <- *presence
2020 pres <- *presence
@@ -2084,24 +2028,22 @@ handleStatsKey = \pubkey authorization respond -> do
2084 let f = count myFwds
2028 let f = count myFwds
2085 let fd = do x <- myFwds; yield {server: x.toServer, retries: x.retries, createdAt: x.createdAt}
2029 let fd = do x <- myFwds; yield {server: x.toServer, retries: x.retries, createdAt: x.createdAt}
2086 let a = count (do x <- aps; where x.pubkey == pubkey; yield x)
2030 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 {}}))
2089−handleTopRecipients = \limit authorization respond -> do
2033+handleTopRecipients = \limit authorization respond -> withMaintAuth authorization
2090− authorized <- verifyMaintenanceAuth authorization
2091− if not authorized then yield (respond {recipients: [], ok: False {}, total: 0})
2034+ (yield (respond {recipients: [], ok: False {}, total: 0}))
2093 msgs <- *messages
2036 msgs <- *messages
2094 let counts = do
2037 let counts = do
2095 pk <- unique (do m <- msgs; yield m.toKey)
2038 pk <- unique (do m <- msgs; yield m.toKey)
2096 yield {pubkey: pk, count: count (do m <- msgs; where m.toKey == pk; yield m)}
2039 yield {pubkey: pk, count: count (do m <- msgs; where m.toKey == pk; yield m)}
2097 let sorted = sortBy (\c -> 0 - c.count) counts
2040 let sorted = sortBy (\c -> 0 - c.count) counts
2098 let effLimit = if limit <= 0 then 20 else clamp 1 100 limit
2041 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}))
2101−handleStatsForwards = \authorization respond -> do
2044+handleStatsForwards = \authorization respond -> withMaintAuth authorization
2102− authorized <- verifyMaintenanceAuth authorization
2103− if not authorized then yield (respond {servers: [], ok: False {}, total: 0})
2045+ (yield (respond {servers: [], ok: False {}, total: 0}))
2105 t <- now
2047 t <- now
2106 fwds <- *forwards
2048 fwds <- *forwards
2107 let servers = collectPeers fwds (\f -> f.toServer)
2049 let servers = collectPeers fwds (\f -> f.toServer)
@@ -2111,12 +2053,11 @@ handleStatsForwards = \authorization respond -> do
2111 let oldest = case minBy svFwds (\f -> f.createdAt) of Nothing {} -> 0; Just {value: x} -> t - x.createdAt
2053 let oldest = case minBy svFwds (\f -> f.createdAt) of Nothing {} -> 0; Just {value: x} -> t - x.createdAt
2112 let retries = fold (\acc f -> acc + f.retries) 0 svFwds
2054 let retries = fold (\acc f -> acc + f.retries) 0 svFwds
2113 yield {server: s, count: count svFwds, oldestAge: oldest, totalRetries: retries}
2055 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}))
2116−handleStatsRates = \authorization respond -> do
2058+handleStatsRates = \authorization respond -> withMaintAuth authorization
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})
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}))
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})
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}))
2121handleMetrics = \authorization respond -> do
2062handleMetrics = \authorization respond -> do
2122 t <- now
2063 t <- now