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:
parent
da579a0756
commit
1fc264a226
|
@ -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)
|
||||||
|
|
Loading…
Reference in a new issue