From 1fc264a226419355683657e1f1ca692062c0dcea Mon Sep 17 00:00:00 2001
From: Trolli Schmittlauch <t.schmittlauch@orlives.de>
Date: Fri, 11 Sep 2020 14:04:35 +0200
Subject: [PATCH] manage logging via file handle

reason: `appendFile` combined with lazy evaluation lead to exhaustion of
open file descriptors, as each file is opened again for each write and
due to lazy evaluation is kept open multiple times.
---
 src/Hash2Pub/PostService.hs | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs
index 5e6ddcb..bb94e86 100644
--- a/src/Hash2Pub/PostService.hs
+++ b/src/Hash2Pub/PostService.hs
@@ -32,10 +32,11 @@ import           Data.Time.Clock.POSIX
 import           Data.Typeable             (Typeable)
 import qualified Network.HTTP.Client       as HTTP
 import qualified Network.HTTP.Types        as HTTPT
+import           System.IO
 import           System.Random
 import           Text.Read                 (readEither)
 
-import           Formatting                (float, format, (%), fixed)
+import           Formatting                (fixed, float, format, (%))
 import qualified Network.Wai.Handler.Warp  as Warp
 import           Servant
 import           Servant.Client
@@ -66,6 +67,7 @@ data PostService d = PostService
     , httpMan              :: HTTP.Manager
     , statsQueue           :: TQueue StatsEvent
     , loadStats            :: TVar RelayStats
+    , logFileHandle        :: Handle
     }
     deriving (Typeable)
 
@@ -96,6 +98,7 @@ instance DHT d => Service PostService d where
         httpMan' <- HTTP.newManager HTTP.defaultManagerSettings
         statsQueue' <- newTQueueIO
         loadStats' <- newTVarIO emptyStats
+        loggingFile <- openFile (confLogfilePath conf) WriteMode
         let
             thisService = PostService
               { serviceConf = conf
@@ -110,12 +113,13 @@ instance DHT d => Service PostService d where
               , httpMan = httpMan'
               , statsQueue = statsQueue'
               , loadStats = loadStats'
+              , logFileHandle = loggingFile
               }
             port' = fromIntegral (confServicePort conf)
             warpSettings = Warp.setPort port' . Warp.setHost (fromString . confServiceHost $ conf) $ Warp.defaultSettings
         -- log a start message, this also truncates existing files
-        TxtI.writeFile (confLogfilePath conf) $ Txt.unlines
-            [ "# Starting mock relay implementation\n"
+        TxtI.hPutStrLn loggingFile $ Txt.unlines
+            [ "# Starting mock relay implementation"
             , "#relay receive rate   ;relay delivery rate   ;instance publish rate ;instance fetch rate"
             ]
         -- Run 'concurrently_' from another thread to be able to return the
@@ -816,8 +820,8 @@ evaluateStatsThread serv statsAcc = getPOSIXTime >>= loop
           -- and now what? write a log to file
           -- format: total relayReceiveRates;total relayDeliveryRates;postFetchRate;postPublishRate
           -- later: current (reported) load, target load
-          TxtI.appendFile (confLogfilePath . serviceConf $ serv) $
-              format (fixed 20 % ";" % fixed 20 % ";" % fixed 20 % ";" % fixed 20 % "\n")
+          TxtI.hPutStrLn (logFileHandle serv) $
+              format (fixed 20 % ";" % fixed 20 % ";" % fixed 20 % ";" % fixed 20)
                   (sum . relayReceiveRates $ rateStats)
                   (sum . relayDeliveryRates $ rateStats)
                   (postPublishRate rateStats)