smp-server: fix service subscription memory leak (#1827)

Service subscription counters (totalServiceSubs, serviceSubsCount,
ntfServiceSubsCount) are TVar (Int64, IdsHash). modifyTVar' only forces
the pair to WHNF, so `n +/- n'` and `idsHash <> idsHash'` stay
unevaluated and accumulate an unbounded thunk chain under subscription
and delivery churn (the IdsHash chain also retains a bytestring per
update) - a space leak proportional to the number of updates.

Force both components in addServiceSubs/subtractServiceSubs. Verified
with the load bench: svc churn drops from +5.4 KiB/iter (linear) to flat.
This commit is contained in:
sh
2026-07-10 09:00:40 +01:00
committed by GitHub
parent 551de8039f
commit 43e46dd8cc
+5 -2
View File
@@ -1546,11 +1546,14 @@ queueIdHash = IdsHash . C.md5Hash . unEntityId
{-# INLINE queueIdHash #-}
addServiceSubs :: (Int64, IdsHash) -> (Int64, IdsHash) -> (Int64, IdsHash)
addServiceSubs (n', idsHash') (n, idsHash) = (n + n', idsHash <> idsHash')
addServiceSubs (n', idsHash') (n, idsHash) =
let !n'' = n + n'
!h = idsHash <> idsHash'
in (n'', h)
subtractServiceSubs :: (Int64, IdsHash) -> (Int64, IdsHash) -> (Int64, IdsHash)
subtractServiceSubs (n', idsHash') (n, idsHash)
| n > n' = (n - n', idsHash <> idsHash') -- concat is a reversible xor: (x `xor` y) `xor` y == x
| n > n' = let !n'' = n - n'; !h = idsHash <> idsHash' in (n'', h) -- concat is a reversible xor: (x `xor` y) `xor` y == x
| otherwise = (0, mempty)
data ProtocolErrorType = PECmdSyntax | PECmdUnknown | PESession | PEBlock