@@ -81,6 +81,8 @@ retryBackoffBase = 30000 -- 30 seconds
8181retryBackoffMax : Int<Ms>
8282retryBackoffMax = 480000 -- 8 minutes
8383maxForwardFailures = 1000 -- max tracked server failure records
84+maxServerDowntime : Int<Ms>
85+maxServerDowntime = 86400000 -- 24 hours; stop retrying a server after this duration of consecutive failures
8486
8587-- Background task intervals
8688backgroundPruneInterval : Int<Ms>
@@ -178,7 +180,7 @@ type AckedEntry = {messageId: MessageIdHex, toKey: PubkeyHex, ackedAt: Timestamp
178180-- Terminal state: message delivered and ack confirmed (used for dedup after ack overflow)
179181type DeliveredEntry = {messageId: MessageIdHex, toKey: PubkeyHex, deliveredAt: Timestamp}
180182-- Tracks consecutive failures per federation peer for exponential backoff
181−type ForwardFailure = {server: Text, failedAt: Timestamp, failures: Int}
183+type ForwardFailure = {server: Text, failedAt: Timestamp, failures: Int, firstFailedAt: Timestamp}
182184-- Sliding-window rate limit state per pubkey
183185type SendRateEntry = {pubkey: PubkeyHex, windowStart: Timestamp, count: Int}
184186type ChallengeRateEntry = {pubkey: PubkeyHex, windowStart: Timestamp, count: Int}
@@ -264,6 +266,10 @@ data ForwardResult = ForwardDuplicate {} | ForwardRejected {} | ForwardStored {}
264266
265267*heartbeatCount : Int
266268
269+*startedAt : Timestamp
270+
271+*lastHeartbeatAt : Timestamp
272+
267273-- ============================================
268274-- Routes
269275-- ============================================
@@ -285,7 +291,7 @@ route AuthApi where
285291route ClientApi where
286292 -- Long-poll for new messages; cursor tracks last-seen receivedAt timestamp
287293 POST {cursor: Timestamp} /poll headers {authorization: Text}
288− -> {events: [PollEvent], cursor: Timestamp, authorized: Bool}
294+ -> {events: [PollEvent], cursor: Timestamp, authorized: Bool, rateLimited: Bool}
289295 = Poll
290296 /messages
291297 -- Send an E2E encrypted message to a recipient pubkey
@@ -328,7 +334,7 @@ route HealthApi where
328334-- Returns counts of in-memory collections (requires federation or maintenance secret)
329335route StatsApi where
330336 GET /stats headers {authorization: Text}
331− -> {sessions: Int, messages: Int, presence: Int, forwards: Int, challenges: Int, ackedIds: Int, ackOverflow: Int, deliveredIds: Int, forwardFailures: Int, activePolls: Int, sendRates: Int, challengeRates: Int, federationRates: Int, pruneCount: Int, heartbeatCount: Int, ok: Bool}
337+ -> {sessions: Int, messages: Int, presence: Int, forwards: Int, challenges: Int, ackedIds: Int, ackOverflow: Int, deliveredIds: Int, forwardFailures: Int, activePolls: Int, sendRates: Int, challengeRates: Int, federationRates: Int, pruneCount: Int, heartbeatCount: Int, uptime: Int, lastPruneAt: Timestamp, lastHeartbeatAt: Timestamp, ok: Bool}
332338 = Stats
333339
334340route Api = AuthApi | ClientApi | FederationApi | MaintenanceApi | HealthApi | StatsApi
@@ -803,7 +809,7 @@ pruneExpired = \t -> do
803809 sendRates <- *sendRates
804810 set *sendRates = do r <- sendRates; where t - r.windowStart < sendRateWindowMs; yield r
805811 forwardFailures <- *forwardFailures
806− set *forwardFailures = do f <- forwardFailures; where t - f.failedAt < retryBackoffMax * 2; yield f
812+ set *forwardFailures = do f <- forwardFailures; where t - f.failedAt < maxServerDowntime; yield f
807813 challengeRates <- *challengeRates
808814 set *challengeRates = do r <- challengeRates; where t - r.windowStart < challengeRateWindowMs; yield r
809815 federationRates <- *federationRates
@@ -950,7 +956,7 @@ shouldRetryServer : Text -> Timestamp -> [ForwardFailure] -> Bool
950956shouldRetryServer = \server t failures ->
951957 case headOf (do f <- failures; where f.server == server; yield f) of
952958 Nothing {} -> True {}
953− Just {value: f} -> t - f.failedAt >= retryBackoff f.failures
959+ Just {value: f} -> t - f.firstFailedAt < maxServerDowntime && t - f.failedAt >= retryBackoff f.failures
954960
955961recordFailure = \server -> do
956962 t <- now
@@ -958,8 +964,8 @@ recordFailure = \server -> do
958964 failures <- *forwardFailures
959965 let existing = headOf (do f <- failures; where f.server == server; yield f)
960966 let updated = case existing of
961− Nothing {} -> union failures [{server: server, failedAt: t, failures: 1}]
962− Just {value: f} -> union (do x <- failures; where x.server != server; yield x) [{server: server, failedAt: t, failures: min (f.failures + 1) 10}]
967+ Nothing {} -> union failures [{server: server, failedAt: t, failures: 1, firstFailedAt: t}]
968+ Just {value: f} -> union (do x <- failures; where x.server != server; yield x) [{server: server, failedAt: t, failures: min (f.failures + 1) 10, firstFailedAt: f.firstFailedAt}]
963969 set *forwardFailures = if count updated > maxForwardFailures then evictOneOldest updated (\x -> x.failedAt) else updated
964970
965971clearFailure = \server -> atomic do
@@ -1012,7 +1018,9 @@ forwardQueuedMessages = \targets t -> do
10121018 set *forwards = updatedForwards
10131019 yield capped
10141020 let servers = collectPeerServers newForwards (\x -> x.toServer)
1015− sendToEach servers (\server ->
1021+ failures <- *forwardFailures
1022+ let eligibleServers = do s <- servers; where shouldRetryServer s t failures; yield s
1023+ sendToEach eligibleServers (\server ->
10161024 retryForwardsForServer (forwardsForServer newForwards server) maxForwardRetriesPerServer)
10171025
10181026fetchFederationAck = \origin messageIds ->
@@ -1512,7 +1520,7 @@ verifyAuthInner = \pubkey challenge signature respond t -> do
15121520handlePoll = \cursor authorization respond -> do
15131521 t <- now
15141522 globalRateLimited <- checkGlobalRate t
1515− if globalRateLimited then yield (respond {events: [], cursor: 0, authorized: False {}})
1523+ if globalRateLimited then yield (respond {events: [], cursor: 0, authorized: False {}, rateLimited: True {}})
15161524 else do
15171525 result <- case extractToken authorization of
15181526 Nothing {} -> yield {authorized: False {}, events: [], cursor: 0, pendingAcks: [], evictedEntries: []}
@@ -1522,7 +1530,7 @@ handlePoll = \cursor authorization respond -> do
15221530 fork (when federationEnabled (do
15231531 sendAcksAndClean result.pendingAcks
15241532 retryEvictedAcks result.evictedEntries result.pendingAcks))
1525− yield (respond {events: result.events, cursor: result.cursor, authorized: result.authorized})
1533+ yield (respond {events: result.events, cursor: result.cursor, authorized: result.authorized, rateLimited: False {}})
15261534
15271535-- POST /messages: Send an encrypted message to a recipient.
15281536-- Deduplicates by messageId across messages, ackedIds, and deliveredIds.
@@ -1722,6 +1730,7 @@ handleDrain = \authorization respond -> do
17221730 presence <- *presence
17231731 let localEntries = do p <- presence; where isLocalServer p.server && p.expiresAt > t; yield p
17241732 set *presence = do p <- presence; where not (isLocalServer p.server) || p.expiresAt <= t; yield p
1733+ set *pollWakeup = t
17251734 yield {localEntries: localEntries, peerServers: collectPeerServers presence (\p -> p.server)}
17261735 let drainedCount = count drainResult.localEntries
17271736 when (federationEnabled && drainedCount > 0 && count drainResult.peerServers > 0) (do
@@ -1744,6 +1753,7 @@ handleStats = \authorization respond -> do
17441753 let authorized = verifyMaintenanceAuth authorization
17451754 if authorized
17461755 then do
1756+ t <- now
17471757 result <- atomic do
17481758 s <- *sessions
17491759 m <- *messages
@@ -1760,9 +1770,12 @@ handleStats = \authorization respond -> do
17601770 fr <- *federationRates
17611771 pc <- *pruneCount
17621772 hc <- *heartbeatCount
1763− 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, sendRates: count sr, challengeRates: count cr, federationRates: count fr, pruneCount: pc, heartbeatCount: hc}
1764− 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, sendRates: result.sendRates, challengeRates: result.challengeRates, federationRates: result.federationRates, pruneCount: result.pruneCount, heartbeatCount: result.heartbeatCount, ok: True {}})
1765− else yield (respond {sessions: 0, messages: 0, presence: 0, forwards: 0, challenges: 0, ackedIds: 0, ackOverflow: 0, deliveredIds: 0, forwardFailures: 0, activePolls: 0, sendRates: 0, challengeRates: 0, federationRates: 0, pruneCount: 0, heartbeatCount: 0, ok: False {}})
1773+ sa <- *startedAt
1774+ lp <- *lastPrunedAt
1775+ lh <- *lastHeartbeatAt
1776+ 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, sendRates: count sr, challengeRates: count cr, federationRates: count fr, pruneCount: pc, heartbeatCount: hc, uptime: t - sa, lastPruneAt: lp, lastHeartbeatAt: lh}
1777+ 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, sendRates: result.sendRates, challengeRates: result.challengeRates, federationRates: result.federationRates, pruneCount: result.pruneCount, heartbeatCount: result.heartbeatCount, uptime: result.uptime, lastPruneAt: result.lastPruneAt, lastHeartbeatAt: result.lastHeartbeatAt, ok: True {}})
1778+ else yield (respond {sessions: 0, messages: 0, presence: 0, forwards: 0, challenges: 0, ackedIds: 0, ackOverflow: 0, deliveredIds: 0, forwardFailures: 0, activePolls: 0, sendRates: 0, challengeRates: 0, federationRates: 0, pruneCount: 0, heartbeatCount: 0, uptime: 0, lastPruneAt: 0, lastHeartbeatAt: 0, ok: False {}})
17661779
17671780serve = \req -> case req of
17681781 ReqChallenge {pubkey, respond} -> handleChallenge pubkey respond
@@ -1802,11 +1815,14 @@ pollHeartbeat = do
18021815 t <- now
18031816 atomic do
18041817 set *pollWakeup = t
1818+ set *lastHeartbeatAt = t
18051819 hc <- *heartbeatCount
18061820 set *heartbeatCount = hc + 1
18071821 pollHeartbeat
18081822
18091823main = do
1824+ t <- now
1825+ atomic do set *startedAt = t
18101826 println "Skrepka relay server starting on port 8080..."
18111827 println (" federation: " ++ if federationEnabled then "enabled" else "disabled")
18121828 println (" prune interval: " ++ show backgroundPruneInterval ++ "ms")