@@ -599,9 +599,7 @@ extractToken = \authHeader ->
599verifyMaintenanceAuth : Text -> IO Bool
599verifyMaintenanceAuth : Text -> IO Bool
600verifyMaintenanceAuth = \authorization -> do
600verifyMaintenanceAuth = \authorization -> do
601 secret <- *runtimeMaintenanceSecret
601 secret <- *runtimeMaintenanceSecret
602− yield (case extractToken authorization of
602+ yield (secret != "" && extractToken authorization == Just {value: secret})
603− Just {value: token} -> secret != "" && token == secret
606withMaintAuth = \authorization onUnauth onAuth -> do
604withMaintAuth = \authorization onUnauth onAuth -> do
607 authorized <- verifyMaintenanceAuth authorization
605 authorized <- verifyMaintenanceAuth authorization
@@ -611,11 +609,10 @@ withMaintAuth = \authorization onUnauth onAuth -> do
611-- mkErr is called with one of: "draining", "rate_limited", "unauthorized".
609-- mkErr is called with one of: "draining", "rate_limited", "unauthorized".
612gateAuth = \checkDrain auth ip t respond mkErr onAuth -> do
610gateAuth = \checkDrain auth ip t respond mkErr onAuth -> do
613 dp <- *drainPhase
611 dp <- *drainPhase
612+ g <- checkGlobalRate t
614 if checkDrain && dp >= 2 then yield (respond (mkErr "draining"))
613 if checkDrain && dp >= 2 then yield (respond (mkErr "draining"))
616− g <- checkGlobalRate t
617− if g then yield (respond (mkErr "rate_limited"))
614+ else if g then yield (respond (mkErr "rate_limited"))
618− else withSessionAuth auth t ip (yield (respond (mkErr "unauthorized"))) onAuth
615+ else withSessionAuth auth t ip (yield (respond (mkErr "unauthorized"))) onAuth
620-- gateAuth + per-key rate gate. `rateResp` is the response value when the per-key gate trips.
617-- gateAuth + per-key rate gate. `rateResp` is the response value when the per-key gate trips.
621gateRated = \checkDrain auth ip rateRef maxRate windowMs t respond mkErr rateResp onAuth ->
618gateRated = \checkDrain auth ip rateRef maxRate windowMs t respond mkErr rateResp onAuth ->
@@ -1060,23 +1057,18 @@ handleLogout = \authorization clientIp respond -> do
1060 case extractToken authorization of
1057 case extractToken authorization of
1061 Nothing {} -> yield (respond {ok: False {}, authorized: False {}})
1058 Nothing {} -> yield (respond {ok: False {}, authorized: False {}})
1062 Just {value: token} -> do
1059 Just {value: token} -> do
1063− removed <- atomic do
1060+ removed <- atomic (withSessionAuth authorization t clientIp
1064− ses <- *sessions
1061+ (yield {ok: False {}, pubkey: "", peers: []})
1065− case authenticateSession ses token t of
1062+ (\pubkey -> do
1066− Unauthorized {} -> yield {ok: False {}, pubkey: "", peers: []}
1063+ ses <- *sessions
1067− Authorized {pubkey, ip} ->
1064+ set *sessions = removeWhere ses (\s -> s.token == token)
1068− if not (matchIp clientIp ip) then yield {ok: False {}, pubkey: "", peers: []}
1065+ after <- *sessions
1066+ peers <- if any after (\s -> s.pubkey == pubkey) then yield []
1070− set *sessions = removeWhere ses (\s -> s.token == token)
1071− -- If no remaining sessions for this key, drop local presence
1073− let stillHas = any after (\s -> s.pubkey == pubkey)
1074− peers <- if stillHas then yield []
1076− pres <- *presence
1068+ pres <- *presence
1077− set *presence = removeWhere pres (\p -> p.pubkey == pubkey && isLocalServer p.server)
1069+ set *presence = removeWhere pres (\p -> p.pubkey == pubkey && isLocalServer p.server)
1078− yield (knownPeerServersFromPresence pres)
1070+ yield (knownPeerServersFromPresence pres)
1079− yield {ok: True {}, pubkey: pubkey, peers: peers}
1071+ yield {ok: True {}, pubkey: pubkey, peers: peers}))
1080 when (removed.ok && removed.pubkey != "" && count removed.peers > 0 && federationEnabled)
1072 when (removed.ok && removed.pubkey != "" && count removed.peers > 0 && federationEnabled)
1081 (fork (sendBatchedGossip removed.peers [mkGossip (GossipOffline {}) removed.pubkey t offlineGossipMinTtl] gossipOriginHops))
1073 (fork (sendBatchedGossip removed.peers [mkGossip (GossipOffline {}) removed.pubkey t offlineGossipMinTtl] gossipOriginHops))
1082 yield (respond {ok: removed.ok, authorized: removed.ok})
1074 yield (respond {ok: removed.ok, authorized: removed.ok})
@@ -1616,9 +1608,8 @@ handleUndrain = \authorization respond -> withMaintAuth authorization
1616 set *drainCompletedAt = 0
1608 set *drainCompletedAt = 0
1617 yield (respond {ok: True {}}))
1609 yield (respond {ok: True {}}))
1619−handleShutdown = \authorization respond -> withMaintAuth authorization
1611+handleShutdown = \authorization respond ->
1620− (yield (respond {ok: False {}, drained: 0}))
1621− (handleDrain 2 authorization (\r -> respond {ok: r.ok, drained: r.drained}))
1612+ handleDrain 2 authorization (\r -> respond {ok: r.ok, drained: r.drained})
1623handlePrune = \authorization respond -> do
1614handlePrune = \authorization respond -> do
1624 t <- now
1615 t <- now
@@ -1655,13 +1646,11 @@ handleUnblockPeer = \server authorization respond -> withMaintAuth authorization
1655 (yield (respond {ok: False {}, unblocked: False {}}))
1646 (yield (respond {ok: False {}, unblocked: False {}}))
1656 (do removed <- removeServerFromList blockedPeers server; yield (respond {ok: True {}, unblocked: removed}))
1647 (do removed <- removeServerFromList blockedPeers server; yield (respond {ok: True {}, unblocked: removed}))
1658−handleListPeers = \listRef authorization respond -> do
1649+handleListBlocked = \authorization respond -> do
1659 ok <- verifyMaintenanceAuth authorization
1650 ok <- verifyMaintenanceAuth authorization
1660− list <- *listRef
1651+ list <- *blockedPeers
1661 yield (respond {peers: if ok then list else [], ok: ok})
1652 yield (respond {peers: if ok then list else [], ok: ok})
1663−handleListBlocked = \authorization respond -> handleListPeers blockedPeers authorization respond
1665handleAllowPeer = \server authorization respond -> withMaintAuth authorization
1654handleAllowPeer = \server authorization respond -> withMaintAuth authorization
1666 (yield (respond {ok: False {}, allowed: 0}))
1655 (yield (respond {ok: False {}, allowed: 0}))
1667 (do n <- addServerToList allowedPeers server; yield (respond {ok: True {}, allowed: n}))
1656 (do n <- addServerToList allowedPeers server; yield (respond {ok: True {}, allowed: n}))
@@ -1670,7 +1659,10 @@ handleUnallowPeer = \server authorization respond -> withMaintAuth authorization
1670 (yield (respond {ok: False {}, removed: False {}}))
1659 (yield (respond {ok: False {}, removed: False {}}))
1671 (do removed <- removeServerFromList allowedPeers server; yield (respond {ok: True {}, removed: removed}))
1660 (do removed <- removeServerFromList allowedPeers server; yield (respond {ok: True {}, removed: removed}))
1673−handleListAllowed = \authorization respond -> handleListPeers allowedPeers authorization respond
1662+handleListAllowed = \authorization respond -> do
1663+ ok <- verifyMaintenanceAuth authorization
1664+ list <- *allowedPeers
1665+ yield (respond {peers: if ok then list else [], ok: ok})
1675handlePingPeer = \server authorization respond -> withMaintAuth authorization
1667handlePingPeer = \server authorization respond -> withMaintAuth authorization
1676 (yield (respond {ok: False {}, latencyMs: 0, error: "unauthorized"}))
1668 (yield (respond {ok: False {}, latencyMs: 0, error: "unauthorized"}))
@@ -1740,8 +1732,7 @@ handleAdminListAllSessions = \limit authorization respond -> withMaintAuth autho
1740 ips: unique (mapWhere mine (\s -> s.ip != "") (\s -> s.ip)),
1732 ips: unique (mapWhere mine (\s -> s.ip != "") (\s -> s.ip)),
1741 latestExpiry: fold (\acc s -> max acc s.expiresAt) 0 mine})
1733 latestExpiry: fold (\acc s -> max acc s.expiresAt) 0 mine})
1742 let sorted = sortBy (\g -> 0 - g.count) grouped
1734 let sorted = sortBy (\g -> 0 - g.count) grouped
1743− let effLimit = if limit <= 0 then 100 else clamp 1 500 limit
1735+ yield (respond {sessions: takeRelation (if limit <= 0 then 100 else clamp 1 500 limit) sorted, ok: True {}, total: count grouped}))
1744− yield (respond {sessions: takeRelation effLimit sorted, ok: True {}, total: count grouped}))
1746handleGetRateLimits = \authorization respond -> do
1737handleGetRateLimits = \authorization respond -> do
1747 ok <- verifyMaintenanceAuth authorization
1738 ok <- verifyMaintenanceAuth authorization
@@ -1792,11 +1783,11 @@ handleStats = \authorization respond -> withMaintAuth authorization
1792 let mCount = count msgs
1783 let mCount = count msgs
1793 let pCount = count pres
1784 let pCount = count pres
1794 let fCount = count fwds
1785 let fCount = count fwds
1786+ yield (respond {ok: True {}, version: serverBuildVersion,
1787+ capacity: {sessions: sCount, sessionsMax: maxSessions, sessionsPct: pct sCount maxSessions, messages: mCount, messagesMax: maxMessages, messagesPct: pct mCount maxMessages, totalMessageCount: mCount, presence: pCount, presenceMax: maxPresenceEntries, presencePct: pct pCount maxPresenceEntries, forwards: fCount, forwardsMax: maxForwardsEntries, forwardsPct: pct fCount maxForwardsEntries, 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},
1795− let zeroFed = {enabled: federationEnabled, inFlight: 0, hungSlots: 0, avgLatencyMs: 0, maxLatencyMs: 0, callCount: 0, slowVerifies: 0, verifyFailures: 0, forwardFailures: 0, oldestForwardAge: 0, oldestAckAge: 0, recentGossip: 0, blockedPeers: count bp, drainCompletedAt: 0, forwardServers: 0, maxForwardQueueDepth: 0, topFailingPeers: [], pendingCancels: count pfc, gossipSuccess: 0, gossipFail: 0, latencyBuckets: {lt100: 0, lt500: 0, lt2000: 0, gte2000: 0}}
1788+ federation: {enabled: federationEnabled, inFlight: 0, hungSlots: 0, avgLatencyMs: 0, maxLatencyMs: 0, callCount: 0, slowVerifies: 0, verifyFailures: 0, forwardFailures: 0, oldestForwardAge: 0, oldestAckAge: 0, recentGossip: 0, blockedPeers: count bp, drainCompletedAt: 0, forwardServers: 0, maxForwardQueueDepth: 0, topFailingPeers: [], pendingCancels: count pfc, gossipSuccess: 0, gossipFail: 0, latencyBuckets: {lt100: 0, lt500: 0, lt2000: 0, gte2000: 0}},
1796− 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}
1789+ 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},
1797− let cap = {sessions: sCount, sessionsMax: maxSessions, sessionsPct: pct sCount maxSessions, messages: mCount, messagesMax: maxMessages, messagesPct: pct mCount maxMessages, totalMessageCount: mCount, presence: pCount, presenceMax: maxPresenceEntries, presencePct: pct pCount maxPresenceEntries, forwards: fCount, forwardsMax: maxForwardsEntries, forwardsPct: pct fCount maxForwardsEntries, 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}
1798− 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}
1790+ 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}}))
1799− yield (respond {ok: True {}, version: serverBuildVersion, capacity: cap, federation: zeroFed, rates: zeroRates, timing: timing}))
1801zeroStats = {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}}
1792zeroStats = {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}}
@@ -1835,8 +1826,7 @@ handleTopRecipients = \limit authorization respond -> withMaintAuth authorizatio
1835 msgs <- *messages
1826 msgs <- *messages
1836 let counts = pluck (unique (pluck msgs (\m -> m.toKey))) (\pk -> {pubkey: pk, count: countWhere msgs (\m -> m.toKey == pk)})
1827 let counts = pluck (unique (pluck msgs (\m -> m.toKey))) (\pk -> {pubkey: pk, count: countWhere msgs (\m -> m.toKey == pk)})
1837 let sorted = sortBy (\c -> 0 - c.count) counts
1828 let sorted = sortBy (\c -> 0 - c.count) counts
1838− let effLimit = if limit <= 0 then 20 else clamp 1 100 limit
1829+ yield (respond {recipients: takeRelation (if limit <= 0 then 20 else clamp 1 100 limit) sorted, ok: True {}, total: count counts}))
1839− yield (respond {recipients: takeRelation effLimit sorted, ok: True {}, total: count counts}))
1841handleStatsForwards = \authorization respond -> withMaintAuth authorization
1831handleStatsForwards = \authorization respond -> withMaintAuth authorization
1842 (yield (respond {servers: [], ok: False {}, total: 0}))
1832 (yield (respond {servers: [], ok: False {}, total: 0}))