Merge pull request #34 from input-output-hk/mkarg/fix-space-leak

FIX: Remove potentially leaky continuation passing of `EKGForwarder`

CHANGELOG.md

@@ -1,5 +1,10 @@
 # Changelog
 
+## 0.6.0 - Sep 2024
+
+* Remove potentially leaky continuation passing of `EKGForwarder`.
+* Bump dependency version bounds.
+
 ## 0.5.0
 
 * Bump dependency version bounds

README.md

@@ -16,7 +16,7 @@ There is `ekg` [package](https://hackage.haskell.org/package/ekg) that already l
 
 1. `ekg` provides HTTP server for monitoring, `ekg-forward` is a lightweight library without HTTP and REST API.
 2. `ekg-forward` is based on Haskell typed protocol, which provides type-level guarantees of correctness.
-3. `ekg-forward`'s network layer uses `ouroboros-network-framework` [package](https://github.com/input-output-hk/ouroboros-network/) which supports both network sockets and local pipes for connection.
+3. `ekg-forward`'s network layer uses `ouroboros-network-framework` [package](https://github.com/IntersectMBO/ouroboros-network/) which supports both network sockets and local pipes for connection.
 
 ## How To Use It
 
@@ -29,4 +29,4 @@ Please note that **not all** EKG metrics are supported in the current release:
 1. [Gauge](https://hackage.haskell.org/package/ekg-core-0.1.1.7/docs/System-Metrics-Gauge.html) - supported
 2. [Label](https://hackage.haskell.org/package/ekg-core-0.1.1.7/docs/System-Metrics-Label.html) - supported
 3. [Counter](https://hackage.haskell.org/package/ekg-core-0.1.1.7/docs/System-Metrics-Counter.html) - supported
-4. [Distribution](https://hackage.haskell.org/package/ekg-core-0.1.1.7/docs/System-Metrics-Distribution.html) - does **not** supported
+4. [Distribution](https://hackage.haskell.org/package/ekg-core-0.1.1.7/docs/System-Metrics-Distribution.html) - **not** supported

cabal.project

@@ -16,8 +16,8 @@ repository cardano-haskell-packages
 -- Bump this if you need newer packages from Hackage
 
 index-state:
-  , hackage.haskell.org 2024-03-18T08:58:07Z
-  , cardano-haskell-packages 2024-03-15T18:07:40Z
+  , hackage.haskell.org 2024-09-05T18:39:40Z
+  , cardano-haskell-packages 2024-09-10T12:51:27Z
 
 packages: ./.
 

ekg-forward.cabal

@@ -1,15 +1,15 @@
 cabal-version:       2.4
 name:                ekg-forward
-version:             0.5
+version:             0.6
 synopsis:            See README for more info
 description:         See README for more info
 homepage:            https://github.com/input-output-hk/ekg-forward
 bug-reports:         https://github.com/input-output-hk/ekg-forward/issues
 license:             Apache-2.0
 license-file:        LICENSE
-copyright:           2021 Input Output (Hong Kong) Ltd.
-author:              Denis Shevchenko
-maintainer:          Denis Shevchenko <denis.shevchenko@iohk.io>
+copyright:           2021-2023 Input Output Global Inc (IOG), 2023-2024 Intersect.
+author:              IOHK
+maintainer:          operations@iohk.io
 category:            System, Network
 build-type:          Simple
 extra-doc-files:     README.md
@@ -65,12 +65,12 @@ library
                        , io-classes >= 1.4.1
                        , network
                        , ouroboros-network-api
-                       , ouroboros-network-framework >= 0.8 && < 0.13
+                       , ouroboros-network-framework >= 0.8 && < 0.14
                        , serialise
                        , stm
                        , text
                        , time
-                       , typed-protocols ^>= 0.1
+                       , typed-protocols ^>= 0.1.1
                        , typed-protocols-cborg
                        , unordered-containers
 

src/System/Metrics/Protocol/Acceptor.hs

@@ -2,6 +2,8 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 
+{- HLINT ignore "Use <$>" -}
+
 -- | A view of the EKG forwarding/accepting protocol from the point of view of the
 -- client.
 --

src/System/Metrics/Protocol/Forwarder.hs

@@ -21,7 +21,7 @@ import           System.Metrics.Protocol.Type
 --
 data EKGForwarder req resp m a = EKGForwarder {
     -- | The acceptor sent us a request for new metrics.
-    recvMsgReq   :: req -> m (resp, EKGForwarder req resp m a)
+    recvMsgReq   :: req -> m resp
 
     -- | The acceptor terminated. Here we have a pure return value, but we
     -- could have done another action in 'm' if we wanted to.
@@ -35,17 +35,19 @@ ekgForwarderPeer
   :: Monad m
   => EKGForwarder req resp m a
   -> Peer (EKGForward req resp) 'AsServer 'StIdle m a
-ekgForwarderPeer EKGForwarder{..} =
-  -- In the 'StIdle' state the forwarder is awaiting a request message
-  -- from the acceptor.
-  Await (ClientAgency TokIdle) $ \case
-    -- The acceptor sent us a request for new metrics, so now we're
-    -- in the 'StBusy' state which means it's the forwarder's turn to send
-    -- a reply.
-    MsgReq req -> Effect $ do
-      (resp, next) <- recvMsgReq req
-      return $ Yield (ServerAgency TokBusy) (MsgResp resp) (ekgForwarderPeer next)
+ekgForwarderPeer EKGForwarder{..} = go
+  where
+    go =
+      -- In the 'StIdle' state the forwarder is awaiting a request message
+      -- from the acceptor.
+      Await (ClientAgency TokIdle) $ \case
+        -- The acceptor sent us a request for new metrics, so now we're
+        -- in the 'StBusy' state which means it's the forwarder's turn to send
+        -- a reply.
+        MsgReq req -> Effect $ do
+          resp <- recvMsgReq req
+          return $ Yield (ServerAgency TokBusy) (MsgResp resp) go
 
-    -- The acceptor sent the done transition, so we're in the 'StDone' state
-    -- so all we can do is stop using 'done', with a return value.
-    MsgDone -> Effect $ Done TokDone <$> recvMsgDone
+        -- The acceptor sent the done transition, so we're in the 'StDone' state
+        -- so all we can do is stop using 'done', with a return value.
+        MsgDone -> Effect $ Done TokDone <$> recvMsgDone

src/System/Metrics/Store/Forwarder.hs

@@ -20,22 +20,18 @@ mkResponse
   :: ForwarderConfiguration
   -> EKG.Store
   -> Forwarder.EKGForwarder Request Response IO ()
-mkResponse config@ForwarderConfiguration{..} ekgStore =
+mkResponse ForwarderConfiguration{..} ekgStore =
   Forwarder.EKGForwarder
     { Forwarder.recvMsgReq = \request -> do
         actionOnRequest request
         allMetrics <- HM.toList <$> EKG.sampleAll ekgStore
         case request of
           GetAllMetrics -> do
             let supportedMetrics = mapMaybe filterMetrics allMetrics
-            return ( ResponseMetrics supportedMetrics
-                   , mkResponse config ekgStore
-                   )
+            return $ ResponseMetrics supportedMetrics
           GetMetrics (NE.toList -> mNames) -> do
             let metricsWeNeed = mapMaybe (filterMetricsWeNeed mNames) allMetrics
-            return ( ResponseMetrics metricsWeNeed
-                   , mkResponse config ekgStore
-                   )
+            return $ ResponseMetrics metricsWeNeed
     , Forwarder.recvMsgDone = return ()
     }
 
@@ -67,6 +63,6 @@ mkResponseDummy
   :: Forwarder.EKGForwarder Request Response IO ()
 mkResponseDummy =
   Forwarder.EKGForwarder
-    { Forwarder.recvMsgReq  = const $ return (ResponseMetrics [], mkResponseDummy)
+    { Forwarder.recvMsgReq  = const $ return $ ResponseMetrics []
     , Forwarder.recvMsgDone = return ()
     }