@@ -129,7 +129,7 @@ type ValidGossipEntry = {pubkey: PubkeyHex, server: ServerName, expiresAt: Times
129-- Status returned to the sender after SendMessage
129-- Status returned to the sender after SendMessage
130-- Delivered: recipient is online locally; Federated: forwarded to remote server;
130-- Delivered: recipient is online locally; Federated: forwarded to remote server;
131-- Queued: stored but recipient location unknown; Unauthorized/Rejected: not accepted
131-- Queued: stored but recipient location unknown; Unauthorized/Rejected: not accepted
132−data MessageStatus = MsDelivered {} | MsFederated {} | MsQueued {} | MsUnauthorized {} | MsRejected {}
132+data MessageStatus = MsDelivered {} | MsFederated {} | MsQueued {} | MsUnauthorized {} | MsRejected {} | MsRateLimited {}
134impl ToJSON MessageStatus where
134impl ToJSON MessageStatus where
135 toJson ms = toJson (case ms of
135 toJson ms = toJson (case ms of
@@ -137,7 +137,8 @@ impl ToJSON MessageStatus where
137 MsFederated {} -> "federated"
137 MsFederated {} -> "federated"
138 MsQueued {} -> "queued"
138 MsQueued {} -> "queued"
139 MsUnauthorized {} -> "unauthorized"
139 MsUnauthorized {} -> "unauthorized"
140− MsRejected {} -> "rejected")
140+ MsRejected {} -> "rejected"
141+ MsRateLimited {} -> "rate_limited")
142-- Internal delivery status (same as MessageStatus but without error variants)
143-- Internal delivery status (same as MessageStatus but without error variants)
143data DeliveryStatus = DsDelivered {} | DsFederated {} | DsQueued {}
144data DeliveryStatus = DsDelivered {} | DsFederated {} | DsQueued {}
@@ -318,7 +319,7 @@ route HealthApi where
318-- Returns counts of in-memory collections (requires federation or maintenance secret)
319-- Returns counts of in-memory collections (requires federation or maintenance secret)
319route StatsApi where
320route StatsApi where
320 GET /stats headers {authorization: Text}
321 GET /stats headers {authorization: Text}
321− -> {sessions: Int, messages: Int, presence: Int, forwards: Int, challenges: Int, ackedIds: Int, ok: Bool}
322+ -> {sessions: Int, messages: Int, presence: Int, forwards: Int, challenges: Int, ackedIds: Int, ackOverflow: Int, deliveredIds: Int, forwardFailures: Int, activePolls: Int, ok: Bool}
324route Api = AuthApi | ClientApi | FederationApi | MaintenanceApi | HealthApi | StatsApi
325route Api = AuthApi | ClientApi | FederationApi | MaintenanceApi | HealthApi | StatsApi
@@ -627,6 +628,20 @@ safeCompare = \a b ->
627 + (if a == "" then 1 else 0)
628 + (if a == "" then 1 else 0)
628 + (if b == "" then 1 else 0) == 0
629 + (if b == "" then 1 else 0) == 0
631+-- Generic sliding-window rate limiter. Returns whether the request is rate-limited
632+-- and the updated entries list. Callers provide match/create/update functions for their entry type.
633+checkRateWindow = \entries matchKey makeNew updateCount maxRate windowMs maxEntries t ->
634+ let entry = headOf (do r <- entries; where matchKey r; yield r) in
635+ let isNewWindow = case entry of Nothing {} -> True {}; Just {value: r} -> t - r.windowStart >= windowMs in
636+ let rateCount = case entry of Nothing {} -> 0; Just {value: r} -> if isNewWindow then 0 else r.count in
637+ if rateCount >= maxRate
638+ then {limited: True {}, entries: entries}
640+ let newEntries = if isNewWindow
641+ then union (do r <- entries; where not (matchKey r); yield r) [makeNew t]
642+ else do r <- entries; yield (if matchKey r then updateCount r else r)
643+ in {limited: False {}, entries: if count newEntries > maxEntries then (do r <- newEntries; where t - r.windowStart < windowMs; yield r) else newEntries}
630-- Remove the single item with the smallest key value (LRU-style eviction)
645-- Remove the single item with the smallest key value (LRU-style eviction)
631evictOneOldest = \items getKey ->
646evictOneOldest = \items getKey ->
632 let result = fold (\acc x ->
647 let result = fold (\acc x ->
@@ -859,17 +874,12 @@ maybePruneAndBroadcast = \t -> do
860checkFederationRate = \server t -> atomic do
875checkFederationRate = \server t -> atomic do
861 federationRates <- *federationRates
876 federationRates <- *federationRates
862− let entry = headOf (do r <- federationRates; where r.server == server; yield r)
877+ let result = checkRateWindow federationRates (\r -> r.server == server)
863− let isNewWindow = case entry of Nothing {} -> True {}; Just {value: r} -> t - r.windowStart >= federationRateWindowMs
878+ (\ts -> {server: server, windowStart: ts, count: 1})
864− let rateCount = case entry of Nothing {} -> 0; Just {value: r} -> if isNewWindow then 0 else r.count
879+ (\r -> {server: r.server, windowStart: r.windowStart, count: r.count + 1})
865− if rateCount >= maxFederationRatePerServer
880+ maxFederationRatePerServer federationRateWindowMs maxFederationRateEntries t
866− then yield (True {})
881+ set *federationRates = result.entries
867− else do
882+ yield result.limited
868− let newRates = if isNewWindow
869− then union (do r <- federationRates; where r.server != server; yield r) [{server: server, windowStart: t, count: 1}]
870− else do r <- federationRates; yield (if r.server == server then {server: r.server, windowStart: r.windowStart, count: r.count + 1} else r)
871− set *federationRates = if count newRates > maxFederationRateEntries then (do r <- newRates; where t - r.windowStart < federationRateWindowMs; yield r) else newRates
874checkGlobalRate = \t -> atomic do
884checkGlobalRate = \t -> atomic do
875 windowStart <- *globalRateWindowStart
885 windowStart <- *globalRateWindowStart
@@ -1000,17 +1010,24 @@ sendBatchedAcksToServer = \serverAcks server ->
1000 forEachBatch serverAcks maxMessageIds (\batch -> do
1010 forEachBatch serverAcks maxMessageIds (\batch -> do
1001 result <- fetchFederationAck server (do a <- batch; yield a.messageId)
1011 result <- fetchFederationAck server (do a <- batch; yield a.messageId)
1002 case result of
1012 case result of
1003− Err _ -> println ("federation: ack to " ++ server ++ " failed")
1014+ println ("federation: ack to " ++ server ++ " failed")
1015+ recordFailure server
1017+ clearFailure server
1004− Ok _ -> atomic do
1018+ atomic do
1005− ackedIds <- *ackedIds
1019+ ackedIds <- *ackedIds
1006− let updatedAckedIds = ackedIdsExcludingBatch ackedIds server batch
1020+ let updatedAckedIds = ackedIdsExcludingBatch ackedIds server batch
1007− set *ackedIds = updatedAckedIds)
1021+ set *ackedIds = updatedAckedIds)
1009-- Send delivery acknowledgments back to origin servers and remove acked entries on success
1023-- Send delivery acknowledgments back to origin servers and remove acked entries on success
1010sendAcksAndClean : [{messageId: MessageIdHex, toKey: PubkeyHex, originServer: ServerName, | a}] -> IO {network} {}
1024sendAcksAndClean : [{messageId: MessageIdHex, toKey: PubkeyHex, originServer: ServerName, | a}] -> IO {network} {}
1011−sendAcksAndClean = \pendingAcks ->
1025+sendAcksAndClean = \pendingAcks -> do
1012− let servers = collectPeerServers pendingAcks (\a -> a.originServer) in
1026+ let servers = collectPeerServers pendingAcks (\a -> a.originServer)
1028+ failures <- *forwardFailures
1029+ let eligibleServers = do s <- servers; where shouldRetryServer s t failures; yield s
1013− sendToEach servers (\server ->
1030+ sendToEach eligibleServers (\server ->
1014 sendBatchedAcksToServer (acksForServer pendingAcks server) server)
1031 sendBatchedAcksToServer (acksForServer pendingAcks server) server)
1016-- Retry sending acks that were evicted from ackedIds due to capacity limits.
1033-- Retry sending acks that were evicted from ackedIds due to capacity limits.
@@ -1057,16 +1074,23 @@ retryEvictedAcks = \evictedEntries pendingAcks ->
1057 Ok _ -> yield {})
1074 Ok _ -> yield {})
1059-- Retry acks sitting in the overflow buffer (last chance before they become deliveredIds)
1076-- Retry acks sitting in the overflow buffer (last chance before they become deliveredIds)
1060−retryOverflowAcks = \overflow ->
1077+retryOverflowAcks = \overflow -> do
1061− let servers = collectPeerServers overflow (\a -> a.originServer) in
1078+ let servers = collectPeerServers overflow (\a -> a.originServer)
1080+ failures <- *forwardFailures
1081+ let eligibleServers = do s <- servers; where shouldRetryServer s t failures; yield s
1062− sendToEach servers (\server ->
1082+ sendToEach eligibleServers (\server ->
1063 forEachBatch (acksForServer overflow server) maxMessageIds (\batch -> do
1083 forEachBatch (acksForServer overflow server) maxMessageIds (\batch -> do
1064 result <- fetchFederationAck server (do a <- batch; yield a.messageId)
1084 result <- fetchFederationAck server (do a <- batch; yield a.messageId)
1065 case result of
1085 case result of
1066− Err _ -> println ("federation: overflow ack to " ++ server ++ " failed")
1087+ println ("federation: overflow ack to " ++ server ++ " failed")
1088+ recordFailure server
1090+ clearFailure server
1067− Ok _ -> atomic do
1091+ atomic do
1068− ackOverflow <- *ackOverflow
1092+ ackOverflow <- *ackOverflow
1069− set *ackOverflow = do a <- ackOverflow; where not (a.originServer == server && hasMessage a.messageId a.toKey batch); yield a))
1093+ set *ackOverflow = do a <- ackOverflow; where not (a.originServer == server && hasMessage a.messageId a.toKey batch); yield a))
1071-- Full maintenance cycle: prune expired state, retry pending forwards and acks,
1095-- Full maintenance cycle: prune expired state, retry pending forwards and acks,
1072-- retry overflow acks, broadcast offline gossip, and refresh presence for local keys
1096-- retry overflow acks, broadcast offline gossip, and refresh presence for local keys
@@ -1391,16 +1415,14 @@ handleChallenge = \pubkey respond -> do
1391 then yield {pr: pr, accepted: False {}, rateLimited: False {}}
1415 then yield {pr: pr, accepted: False {}, rateLimited: False {}}
1393 challengeRates <- *challengeRates
1417 challengeRates <- *challengeRates
1394− let senderEntry = headOf (do r <- challengeRates; where r.pubkey == pubkey; yield r)
1418+ let rateResult = checkRateWindow challengeRates (\r -> r.pubkey == pubkey)
1395− let isNewWindow = case senderEntry of Nothing {} -> True {}; Just {value: r} -> t - r.windowStart >= challengeRateWindowMs
1419+ (\ts -> {pubkey: pubkey, windowStart: ts, count: 1})
1396− let rateCount = case senderEntry of Nothing {} -> 0; Just {value: r} -> if isNewWindow then 0 else r.count
1420+ (\r -> {pubkey: r.pubkey, windowStart: r.windowStart, count: r.count + 1})
1397− if rateCount >= maxChallengeRatePerKey
1421+ maxChallengeRatePerKey challengeRateWindowMs maxChallengeRateEntries t
1422+ if rateResult.limited
1398 then yield {pr: pr, accepted: False {}, rateLimited: True {}}
1423 then yield {pr: pr, accepted: False {}, rateLimited: True {}}
1400− let newRates = if isNewWindow
1425+ set *challengeRates = rateResult.entries
1401− then union (do r <- challengeRates; where r.pubkey != pubkey; yield r) [{pubkey: pubkey, windowStart: t, count: 1}]
1402− else do r <- challengeRates; yield (if r.pubkey == pubkey then {pubkey: r.pubkey, windowStart: r.windowStart, count: r.count + 1} else r)
1403− set *challengeRates = if count newRates > maxChallengeRateEntries then (do r <- newRates; where t - r.windowStart < challengeRateWindowMs; yield r) else newRates
1404 set *challenges = union cappedActive [{pubkey: pubkey, challenge: challenge, expiresAt: t + challengeExpiry}]
1426 set *challenges = union cappedActive [{pubkey: pubkey, challenge: challenge, expiresAt: t + challengeExpiry}]
1405 yield {pr: pr, accepted: True {}, rateLimited: False {}}
1427 yield {pr: pr, accepted: True {}, rateLimited: False {}}
1406 when result.rateLimited
1428 when result.rateLimited
@@ -1412,8 +1434,26 @@ handleChallenge = \pubkey respond -> do
1413-- POST /auth/verify: Verify Ed25519 signature over challenge string.
1435-- POST /auth/verify: Verify Ed25519 signature over challenge string.
1414-- On success: creates a session, registers local presence, and gossips online status.
1436-- On success: creates a session, registers local presence, and gossips online status.
1437+-- Rate-limited globally and per-key (shares auth rate window with challenge requests).
1415handleVerifyAuth = \pubkey challenge signature respond -> do
1438handleVerifyAuth = \pubkey challenge signature respond -> do
1416 t <- now
1439 t <- now
1440+ globalRateLimited <- checkGlobalRate t
1441+ if globalRateLimited then yield (respond {token: "", expiresAt: 0})
1443+ authRateLimited <- atomic do
1444+ challengeRates <- *challengeRates
1445+ let rateResult = checkRateWindow challengeRates (\r -> r.pubkey == pubkey)
1446+ (\ts -> {pubkey: pubkey, windowStart: ts, count: 1})
1447+ (\r -> {pubkey: r.pubkey, windowStart: r.windowStart, count: r.count + 1})
1448+ maxChallengeRatePerKey challengeRateWindowMs maxChallengeRateEntries t
1449+ set *challengeRates = rateResult.entries
1450+ yield rateResult.limited
1451+ if authRateLimited then do
1452+ println ("verify: rate limited (" ++ show maxChallengeRatePerKey ++ "/s per key), rejecting for " ++ pubkey)
1453+ yield (respond {token: "", expiresAt: 0})
1454+ else verifyAuthInner pubkey challenge signature respond t
1456+verifyAuthInner = \pubkey challenge signature respond t -> do
1417 let expiry = t + sessionExpiry
1457 let expiry = t + sessionExpiry
1418 let sigValid = verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
1458 let sigValid = verify (bytesFromHex pubkey) (textToBytes challenge) (bytesFromHex signature)
1419 validation <- atomic do
1459 validation <- atomic do
@@ -1457,15 +1497,19 @@ handleVerifyAuth = \pubkey challenge signature respond -> do
1457-- are acked (removed from mailbox). Blocks until new messages arrive or heartbeat fires.
1497-- are acked (removed from mailbox). Blocks until new messages arrive or heartbeat fires.
1458-- Acks for federated messages are sent to origin servers in the background.
1498-- Acks for federated messages are sent to origin servers in the background.
1459handlePoll = \cursor authorization respond -> do
1499handlePoll = \cursor authorization respond -> do
1501+ globalRateLimited <- checkGlobalRate t
1502+ if globalRateLimited then yield (respond {events: [], cursor: 0, authorized: False {}})
1460− result <- case extractToken authorization of
1504+ result <- case extractToken authorization of
1461− Nothing {} -> yield {authorized: False {}, events: [], cursor: 0, pendingAcks: [], evictedEntries: []}
1505+ Nothing {} -> yield {authorized: False {}, events: [], cursor: 0, pendingAcks: [], evictedEntries: []}
1462− Just {value: token} -> pollOnce token cursor
1506+ Just {value: token} -> pollOnce token cursor
1463− tAfterPoll <- now
1507+ tAfterPoll <- now
1464− maybePruneAndBroadcast tAfterPoll
1508+ maybePruneAndBroadcast tAfterPoll
1465− fork (when federationEnabled (do
1509+ fork (when federationEnabled (do
1466− sendAcksAndClean result.pendingAcks
1510+ sendAcksAndClean result.pendingAcks
1467− retryEvictedAcks result.evictedEntries result.pendingAcks))
1511+ retryEvictedAcks result.evictedEntries result.pendingAcks))
1468− yield (respond {events: result.events, cursor: result.cursor, authorized: result.authorized})
1512+ yield (respond {events: result.events, cursor: result.cursor, authorized: result.authorized})
1470-- POST /messages: Send an encrypted message to a recipient.
1514-- POST /messages: Send an encrypted message to a recipient.
1471-- Deduplicates by messageId across messages, ackedIds, and deliveredIds.
1515-- Deduplicates by messageId across messages, ackedIds, and deliveredIds.
@@ -1473,7 +1517,7 @@ handlePoll = \cursor authorization respond -> do
1473handleSendMessage = \to encryptedBlob timestamp messageId authorization respond -> do
1517handleSendMessage = \to encryptedBlob timestamp messageId authorization respond -> do
1474 t <- now
1518 t <- now
1475 globalRateLimited <- checkGlobalRate t
1519 globalRateLimited <- checkGlobalRate t
1476− if globalRateLimited then yield (respond {status: MsRejected {}, messageId: ""})
1520+ if globalRateLimited then yield (respond {status: MsRateLimited {}, messageId: ""})
1478 effectiveMsgId <- if messageId != "" then yield messageId else genToken
1522 effectiveMsgId <- if messageId != "" then yield messageId else genToken
1479 let clampedTs = clampTimestamp timestamp t
1523 let clampedTs = clampTimestamp timestamp t
@@ -1489,16 +1533,14 @@ handleSendMessage = \to encryptedBlob timestamp messageId authorization respond
1489 then yield {pr: pr, send: SendDuplicate {}}
1533 then yield {pr: pr, send: SendDuplicate {}}
1491 sendRates <- *sendRates
1535 sendRates <- *sendRates
1492− let senderEntry = headOf (do r <- sendRates; where r.pubkey == senderKey; yield r)
1536+ let rateResult = checkRateWindow sendRates (\r -> r.pubkey == senderKey)
1493− let isNewWindow = case senderEntry of Nothing {} -> True {}; Just {value: r} -> t - r.windowStart >= sendRateWindowMs
1537+ (\ts -> {pubkey: senderKey, windowStart: ts, count: 1})
1494− let rateCount = case senderEntry of Nothing {} -> 0; Just {value: r} -> if isNewWindow then 0 else r.count
1538+ (\r -> {pubkey: r.pubkey, windowStart: r.windowStart, count: r.count + 1})
1495− if rateCount >= maxSendRatePerKey
1539+ maxSendRatePerKey sendRateWindowMs maxSendRateEntries t
1540+ if rateResult.limited
1496− then yield {pr: pr, send: SendFailed {status: MsRejected {}}}
1541+ then yield {pr: pr, send: SendFailed {status: MsRateLimited {}}}
1498− let newRates = if isNewWindow
1543+ set *sendRates = rateResult.entries
1499− then union (do r <- sendRates; where r.pubkey != senderKey; yield r) [{pubkey: senderKey, windowStart: t, count: 1}]
1500− else do r <- sendRates; yield (if r.pubkey == senderKey then {pubkey: r.pubkey, windowStart: r.windowStart, count: r.count + 1} else r)
1501− set *sendRates = if count newRates > maxSendRateEntries then (do r <- newRates; where t - r.windowStart < sendRateWindowMs; yield r) else newRates
1502 if countMessagesFor messages to t >= maxMessagesPerRecipient
1544 if countMessagesFor messages to t >= maxMessagesPerRecipient
1503 then yield {pr: pr, send: SendFailed {status: MsRejected {}}}
1545 then yield {pr: pr, send: SendFailed {status: MsRejected {}}}
@@ -1516,24 +1558,29 @@ handleSendMessage = \to encryptedBlob timestamp messageId authorization respond
1516 let delivery = if localOnline then DsDelivered {}
1558 let delivery = if localOnline then DsDelivered {}
1517 else if federationEnabled && count remoteServers > 0 then DsFederated {}
1559 else if federationEnabled && count remoteServers > 0 then DsFederated {}
1518 else DsQueued {}
1560 else DsQueued {}
1561+ -- Create forward entries atomically with message storage (prevents race with ack)
1562+ when (federationEnabled && count remoteServers > 0) (do
1563+ forwards <- *forwards
1564+ let newFwds = do s <- remoteServers; yield {messageId: effectiveMsgId, toServer: s, createdAt: t, toKey: to, encryptedBlob: encryptedBlob, timestamp: clampedTs}
1565+ let cappedFwds = takeRelation (maxForwardsEntries - count forwards) newFwds
1566+ set *forwards = union forwards cappedFwds)
1519 yield {pr: pr, send: SendDone {delivery: delivery, remoteServers: remoteServers}})
1567 yield {pr: pr, send: SendDone {delivery: delivery, remoteServers: remoteServers}})
1520 case result.send of
1568 case result.send of
1521 SendDone {delivery, remoteServers} ->
1569 SendDone {delivery, remoteServers} ->
1522 fork (do
1570 fork (do
1523 when (count remoteServers > 0 && federationEnabled) (
1571 when (count remoteServers > 0 && federationEnabled) (
1524 sendToEach remoteServers (\server -> do
1572 sendToEach remoteServers (\server -> do
1525− -- Pre-register forward entry for dedup and retry on failure
1527− forwards <- *forwards
1528− when (count forwards < maxForwardsEntries)
1529− (set *forwards = union forwards [{messageId: effectiveMsgId, toServer: server, createdAt: t, toKey: to, encryptedBlob: encryptedBlob, timestamp: clampedTs}])
1530 fwdResult <- fetch (federationUrl server) (ForwardMessage {
1573 fwdResult <- fetch (federationUrl server) (ForwardMessage {
1531 toKey: to, encryptedBlob: encryptedBlob,
1574 toKey: to, encryptedBlob: encryptedBlob,
1532 timestamp: clampedTs, originServer: serverHostN, messageId: effectiveMsgId,
1575 timestamp: clampedTs, originServer: serverHostN, messageId: effectiveMsgId,
1533 fromServer: serverHostN, authorization: federationAuth})
1576 fromServer: serverHostN, authorization: federationAuth})
1534 case fwdResult of
1577 case fwdResult of
1535− Err _ -> println ("federation: send forward to " ++ server ++ " failed for " ++ effectiveMsgId)
1579+ println ("federation: send forward to " ++ server ++ " failed for " ++ effectiveMsgId)
1580+ recordFailure server
1536− Ok _ -> removeForward effectiveMsgId server))
1582+ removeForward effectiveMsgId server
1583+ clearFailure server))
1537 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
1584 broadcastOfflineGossip t result.pr.peerServers result.pr.expiredLocal)
1538 _ -> forkBroadcastOffline t result.pr
1585 _ -> forkBroadcastOffline t result.pr
1539 yield (case result.send of
1586 yield (case result.send of
@@ -1545,16 +1592,19 @@ handleSendMessage = \to encryptedBlob timestamp messageId authorization respond
1545-- Returns local server if key is online locally, otherwise the remote with latest expiry.
1592-- Returns local server if key is online locally, otherwise the remote with latest expiry.
1546handleLookupPresence = \pubkey authorization respond -> do
1593handleLookupPresence = \pubkey authorization respond -> do
1547 t <- now
1594 t <- now
1595+ globalRateLimited <- checkGlobalRate t
1596+ if globalRateLimited then yield (respond {server: "", authorized: False {}})
1548− result <- atomic do
1598+ result <- atomic do
1549− pr <- maybePrune t
1599+ pr <- maybePrune t
1550− withSessionAuth authorization t
1600+ withSessionAuth authorization t
1551− (yield {pr: pr, server: "", authorized: False {}})
1601+ (yield {pr: pr, server: "", authorized: False {}})
1552− (\_ -> do
1602+ (\_ -> do
1553− presence <- *presence
1603+ presence <- *presence
1554− let foundServer = bestServerForKey (presenceForKey presence pubkey t)
1604+ let foundServer = bestServerForKey (presenceForKey presence pubkey t)
1555− yield {pr: pr, server: foundServer, authorized: True {}})
1605+ yield {pr: pr, server: foundServer, authorized: True {}})
1556− forkBroadcastOffline t result.pr
1606+ forkBroadcastOffline t result.pr
1557− yield (respond {server: result.server, authorized: result.authorized})
1607+ yield (respond {server: result.server, authorized: result.authorized})
1559-- POST /federation/gossip: Receive presence gossip from a peer server.
1609-- POST /federation/gossip: Receive presence gossip from a peer server.
1560-- Validates events, merges into presence table (last-write-wins), and re-gossips
1610-- Validates events, merges into presence table (last-write-wins), and re-gossips
@@ -1668,9 +1718,13 @@ handleStats = \authorization respond -> do
1668 f <- *forwards
1718 f <- *forwards
1669 c <- *challenges
1719 c <- *challenges
1670 a <- *ackedIds
1720 a <- *ackedIds
1723+ ff <- *forwardFailures
1671− yield {sessions: count s, messages: count m, presence: count p, forwards: count f, challenges: count c, ackedIds: count a}
1725+ yield {sessions: count s, messages: count m, presence: count p, forwards: count f, challenges: count c, ackedIds: count a, ackOverflow: count ao, deliveredIds: count d, forwardFailures: count ff, activePolls: count ap}
1672− yield (respond {sessions: result.sessions, messages: result.messages, presence: result.presence, forwards: result.forwards, challenges: result.challenges, ackedIds: result.ackedIds, ok: True {}})
1726+ yield (respond {sessions: result.sessions, messages: result.messages, presence: result.presence, forwards: result.forwards, challenges: result.challenges, ackedIds: result.ackedIds, ackOverflow: result.ackOverflow, deliveredIds: result.deliveredIds, forwardFailures: result.forwardFailures, activePolls: result.activePolls, ok: True {}})
1673− else yield (respond {sessions: 0, messages: 0, presence: 0, forwards: 0, challenges: 0, ackedIds: 0, ok: False {}})
1727+ else yield (respond {sessions: 0, messages: 0, presence: 0, forwards: 0, challenges: 0, ackedIds: 0, ackOverflow: 0, deliveredIds: 0, forwardFailures: 0, activePolls: 0, ok: False {}})
1675serve = \req -> case req of
1729serve = \req -> case req of
1676 ReqChallenge {pubkey, respond} -> handleChallenge pubkey respond
1730 ReqChallenge {pubkey, respond} -> handleChallenge pubkey respond
@@ -1710,6 +1764,9 @@ pollHeartbeat = do
1711main = do
1765main = do
1712 println "Skrepka relay server starting on port 8080..."
1766 println "Skrepka relay server starting on port 8080..."
1767+ println (" federation: " ++ if federationEnabled then "enabled" else "disabled")
1768+ println (" prune interval: " ++ show backgroundPruneInterval ++ "ms")
1769+ println (" poll timeout: " ++ show pollTimeoutMs ++ "ms")
1713 fork backgroundPrune
1770 fork backgroundPrune
1714 fork pollHeartbeat
1771 fork pollHeartbeat
1715 listen 8080 serve
1772 listen 8080 serve