From 7f210df390023dd489c79a6375bf60875e0747bd Mon Sep 17 00:00:00 2001
From: Marcin Szamotulski <coot@coot.me>
Date: Tue, 20 Oct 2026 17:58:26 +0200
Subject: [PATCH 1/2] Fixed a memory leak in `acceptorActions`

---
 .../Trace/Forward/Run/TraceObject/Acceptor.hs | 36 +++++++++----------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs b/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs
index 511fb50e7f8..a781ad40e00 100644
--- a/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs
+++ b/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Trace.Forward.Run.TraceObject.Acceptor
   ( acceptTraceObjectsInit
@@ -20,7 +21,6 @@ import           Control.Exception (Exception, finally, throwIO)
 import           Control.Monad.Extra (ifM)
 import           Control.Monad.STM (atomically, check)
 import qualified Data.ByteString.Lazy as LBS
-import           Data.Typeable (Typeable)
 import           Data.Void (Void)
 
 import           Trace.Forward.Configuration.TraceObject (AcceptorConfiguration (..))
@@ -31,8 +31,7 @@ import           Trace.Forward.Utils.TraceObject (getTraceObjectsFromReply)
 
 acceptTraceObjectsInit
   :: (CBOR.Serialise lo,
-      ShowProxy lo,
-      Typeable lo)
+      ShowProxy lo)
   => AcceptorConfiguration lo -- ^ Acceptor's configuration.
   -> (initiatorCtx -> [lo] -> IO ()) -- ^ The handler for accepted 'TraceObject's.
   -> (initiatorCtx -> IO ())         -- ^ The handler for exceptions from 'runPeer'.
@@ -42,8 +41,7 @@ acceptTraceObjectsInit config loHandler peerErrorHandler =
 
 acceptTraceObjectsResp
   :: (CBOR.Serialise lo,
-      ShowProxy lo,
-      Typeable lo)
+      ShowProxy lo)
   => AcceptorConfiguration lo -- ^ Acceptor's configuration.
   -> (responderCtx -> [lo] -> IO ()) -- ^ The handler for accepted 'TraceObject's.
   -> (responderCtx -> IO ())         -- ^ The handler for exceptions from 'runPeer'.
@@ -52,9 +50,9 @@ acceptTraceObjectsResp config loHandler peerErrorHandler = do
   ResponderProtocolOnly $ runPeerWithHandler config loHandler peerErrorHandler
 
 runPeerWithHandler
-  :: (CBOR.Serialise lo,
-      ShowProxy lo,
-      Typeable lo)
+  :: forall lo ctx.
+     (CBOR.Serialise lo,
+      ShowProxy lo)
   => AcceptorConfiguration lo
   -> (ctx -> [lo] -> IO ())
   -> (ctx -> IO ())
@@ -73,18 +71,20 @@ runPeerWithHandler config@AcceptorConfiguration{acceptorTracer, shouldWeStop} lo
         `finally` peerErrorHandler ctx
 
 acceptorActions
-  :: (CBOR.Serialise lo,
-      ShowProxy lo,
-      Typeable lo)
-  => AcceptorConfiguration lo -- ^ Acceptor's configuration.
+  :: forall lo.
+     AcceptorConfiguration lo -- ^ Acceptor's configuration.
   -> ([lo] -> IO ())          -- ^ The handler for accepted 'TraceObject's.
   -> Acceptor.TraceObjectAcceptor lo IO ()
-acceptorActions config@AcceptorConfiguration{whatToRequest, shouldWeStop} loHandler =
-  Acceptor.SendMsgTraceObjectsRequest TokBlocking whatToRequest $ \replyWithTraceObjects -> do
-    loHandler $ getTraceObjectsFromReply replyWithTraceObjects
-    ifM (readTVarIO shouldWeStop)
-      (return $ Acceptor.SendMsgDone $ return ())
-      (return $ acceptorActions config loHandler)
+acceptorActions AcceptorConfiguration{whatToRequest, shouldWeStop} loHandler =
+    acceptor
+  where
+    acceptor :: Acceptor.TraceObjectAcceptor lo IO ()
+    acceptor =
+      Acceptor.SendMsgTraceObjectsRequest TokBlocking whatToRequest $ \replyWithTraceObjects -> do
+        loHandler $ getTraceObjectsFromReply replyWithTraceObjects
+        ifM (readTVarIO shouldWeStop)
+          (return $ Acceptor.SendMsgDone $ return ())
+          (return   acceptor)
 
 data Timeout = Timeout
   deriving Show

From e5c1e84a82f2876c5a2bf981a3af7d017653a5a6 Mon Sep 17 00:00:00 2001
From: Marcin Szamotulski <coot@coot.me>
Date: Tue, 20 Oct 2026 18:49:47 +0200
Subject: [PATCH 2/2] Bumped trace-forward

---
 trace-forward/CHANGELOG.md        | 4 ++++
 trace-forward/trace-forward.cabal | 2 +-
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/trace-forward/CHANGELOG.md b/trace-forward/CHANGELOG.md
index c027eb6cc6c..ee2752283e5 100644
--- a/trace-forward/CHANGELOG.md
+++ b/trace-forward/CHANGELOG.md
@@ -1,5 +1,9 @@
 # ChangeLog
 
+## 2.5.1 - Oct 2026
+
+* Fixed a small memory leak in `acceptorActions` function (internal API).
+
 ## 2.4.1 - Mar 2026
 
 * Increase robustness of evaluating trace objects to be forwarded
diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal
index b63ba188cdb..8b9801316ef 100644
--- a/trace-forward/trace-forward.cabal
+++ b/trace-forward/trace-forward.cabal
@@ -1,7 +1,7 @@
 cabal-version: 3.0
 
 name:                   trace-forward
-version:                2.5.0
+version:                2.5.1
 synopsis:               The forwarding protocols library for cardano node.
 description:            The library providing typed protocols for forwarding different
                         information from the cardano node to an external application.