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.
This commit is contained in:
Trolli Schmittlauch 2020-09-11 14:04:35 +02:00
parent da579a0756
commit 1fc264a226

View file

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