From 9963fbd536f5c732f41e9407d651e24e93b98ecd Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Thu, 2 Dec 2021 19:04:55 +0700 Subject: [PATCH] junction: logging --- src/ATrade/Driver/Junction.hs | 89 +++++++++++-------- .../Driver/Junction/ProgramConfiguration.hs | 2 +- .../Driver/Junction/RobotDriverThread.hs | 4 +- 3 files changed, 56 insertions(+), 39 deletions(-) diff --git a/src/ATrade/Driver/Junction.hs b/src/ATrade/Driver/Junction.hs index 95e0936..e482c71 100644 --- a/src/ATrade/Driver/Junction.hs +++ b/src/ATrade/Driver/Junction.hs @@ -55,6 +55,7 @@ import Colog (HasLog (getLogActi LogAction, logTextStdout, (>$<)) +import Colog.Actions (logTextHandle) import Control.Concurrent (threadDelay) import Control.Exception.Safe (MonadThrow, bracket) @@ -98,6 +99,12 @@ import Options.Applicative (Parser, (<**>)) import Prelude hiding (log, readFile) +import System.IO (BufferMode (LineBuffering), + Handle, + IOMode (AppendMode), + hSetBuffering, + openFile, + withFile) import System.ZMQ4 (withContext) import System.ZMQ4.ZAP (loadCertificateFromFile) @@ -161,48 +168,54 @@ instance QuoteStream JunctionM where return (SubscriptionId 0) -- TODO subscription Ids removeSubscription _ = undefined +logger :: (MonadIO m) => Handle -> LogAction m Message +logger h = fmtMessage >$< (logTextStdout <> logTextHandle h) + junctionMain :: M.Map T.Text StrategyDescriptorE -> IO () junctionMain descriptors = do opts <- parseOptions - let logger = fmtMessage >$< logTextStdout - let log = logWith logger + let initialLogger = fmtMessage >$< logTextStdout - log Info "Junction" $ "Reading config from: " <> (T.pack . show) (configPath opts) + logWith initialLogger Info "Junction" $ "Reading config from: " <> (T.pack . show) (configPath opts) cfg <- readFile (configPath opts) >>= input auto - barsMap <- newIORef M.empty - - log Info "Junction" $ "Connecting to redis: " <> redisSocket cfg - redis <- checkedConnect (defaultConnectInfo { connectPort = UnixSocket (T.unpack $ redisSocket cfg) }) - log Info "Junction" "redis: connected" - withContext $ \ctx -> do - log Debug "Junction" "0mq context created" - let downloaderLogAction = fmtMessage >$< logTextStdout - let downloaderEnv = DownloaderEnv (mkQHPHandle ctx (qhpEndpoint cfg)) ctx (qtisEndpoint cfg) downloaderLogAction - robotsMap <- newIORef M.empty - ordersMap <- newIORef M.empty - handledNotifications <- newIORef S.empty - withBroker cfg ctx robotsMap ordersMap handledNotifications logger $ \bro -> - withQThread downloaderEnv barsMap cfg ctx $ \qt -> do - broService <- mkBrokerService bro ordersMap - let junctionLogAction = fmtMessage >$< logTextStdout - let env = - JunctionEnv - { - peRedisSocket = redis, - peConfigPath = robotsConfigsPath cfg, - peQuoteThread = qt, - peBroker = bro, - peRobots = robotsMap, - peLogAction = junctionLogAction - } - withJunction env $ do - startRobots cfg barsMap broService - forever $ do - saveRobots - liftIO $ threadDelay 5000000 + withFile (logBasePath cfg <> "/all.log") AppendMode $ \h -> do + + let log = logWith (logger h) + + barsMap <- newIORef M.empty + + log Info "Junction" $ "Connecting to redis: " <> redisSocket cfg + redis <- checkedConnect (defaultConnectInfo { connectPort = UnixSocket (T.unpack $ redisSocket cfg) }) + log Info "Junction" "redis: connected" + withContext $ \ctx -> do + log Debug "Junction" "0mq context created" + let downloaderLogAction = logger h + let downloaderEnv = DownloaderEnv (mkQHPHandle ctx (qhpEndpoint cfg)) ctx (qtisEndpoint cfg) downloaderLogAction + robotsMap <- newIORef M.empty + ordersMap <- newIORef M.empty + handledNotifications <- newIORef S.empty + withBroker cfg ctx robotsMap ordersMap handledNotifications (logger h) $ \bro -> + withQThread downloaderEnv barsMap cfg ctx $ \qt -> do + broService <- mkBrokerService bro ordersMap + let junctionLogAction = logger h + let env = + JunctionEnv + { + peRedisSocket = redis, + peConfigPath = robotsConfigsPath cfg, + peQuoteThread = qt, + peBroker = bro, + peRobots = robotsMap, + peLogAction = junctionLogAction + } + withJunction env $ do + startRobots h cfg barsMap broService + forever $ do + saveRobots + liftIO $ threadDelay 5000000 where saveRobots :: JunctionM () saveRobots = do @@ -216,8 +229,8 @@ junctionMain descriptors = do currentTimers <- liftIO $ readIORef (strategyTimers inst) saveState currentTimers (strategyInstanceId inst <> ":timers") - startRobots :: ProgramConfiguration -> IORef Bars -> BrokerService -> JunctionM () - startRobots cfg barsMap broService = forM_ (instances cfg) $ \inst -> do + startRobots :: Handle -> ProgramConfiguration -> IORef Bars -> BrokerService -> JunctionM () + startRobots logHandle cfg barsMap broService = forM_ (instances cfg) $ \inst -> do now <- liftIO getCurrentTime case M.lookup (strategyBaseName inst) descriptors of Just (StrategyDescriptorE desc) -> do @@ -225,7 +238,9 @@ junctionMain descriptors = do rConf <- liftIO $ newIORef (confStrategy bigConf) rState <- loadState (stateKey inst) >>= liftIO . newIORef rTimers <- loadState (stateKey inst <> ":timers") >>= liftIO . newIORef - let robotLogAction = fmtMessage >$< logTextStdout + localH <- liftIO $ openFile (logBasePath cfg <> "/" <> T.unpack (strategyId inst) <> ".log") AppendMode + liftIO $ hSetBuffering localH LineBuffering + let robotLogAction = logger logHandle <> (fmtMessage >$< logTextHandle localH) stratEnv <- liftIO $ newIORef StrategyEnvironment { _seInstanceId = strategyId inst, diff --git a/src/ATrade/Driver/Junction/ProgramConfiguration.hs b/src/ATrade/Driver/Junction/ProgramConfiguration.hs index ec36c1b..af2cde5 100644 --- a/src/ATrade/Driver/Junction/ProgramConfiguration.hs +++ b/src/ATrade/Driver/Junction/ProgramConfiguration.hs @@ -30,7 +30,7 @@ data ProgramConfiguration = qtisEndpoint :: T.Text, redisSocket :: T.Text, robotsConfigsPath :: FilePath, - globalLog :: FilePath, + logBasePath :: FilePath, instances :: [StrategyInstanceDescriptor] } deriving (Generic, Show) diff --git a/src/ATrade/Driver/Junction/RobotDriverThread.hs b/src/ATrade/Driver/Junction/RobotDriverThread.hs index f8177bb..d06554a 100644 --- a/src/ATrade/Driver/Junction/RobotDriverThread.hs +++ b/src/ATrade/Driver/Junction/RobotDriverThread.hs @@ -159,7 +159,9 @@ instance MonadRobot (RobotM c s) c s where bro <- asks brokerService liftIO . void $ Bro.cancelOrder bro oid - appendToLog = logInfo "RobotM" . TL.toStrict -- TODO get instance id from environment and better use it instead of generic 'RobotM' + appendToLog t = do + instId <- _seInstanceId <$> (asks env >>= liftIO . readIORef) + logInfo instId . TL.toStrict $ t setupTimer t = do ref <- asks timersRef