junction: logging

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 initialLogger = fmtMessage >$< logTextStdout
-  let log = logWith logger
 
-  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
+  withFile (logBasePath cfg <> "/all.log") AppendMode $ \h -> do
-
+
-  log Info "Junction" $ "Connecting to redis: " <> redisSocket cfg
+    let log = logWith (logger h)
-  redis <- checkedConnect (defaultConnectInfo { connectPort = UnixSocket (T.unpack $ redisSocket cfg) })
+
-  log Info "Junction" "redis: connected"
+    barsMap <- newIORef M.empty
-  withContext $ \ctx -> do
+
-    log Debug "Junction" "0mq context created"
+    log Info "Junction" $ "Connecting to redis: " <> redisSocket cfg
-    let downloaderLogAction = fmtMessage >$< logTextStdout
+    redis <- checkedConnect (defaultConnectInfo { connectPort = UnixSocket (T.unpack $ redisSocket cfg) })
-    let downloaderEnv = DownloaderEnv (mkQHPHandle ctx (qhpEndpoint cfg)) ctx (qtisEndpoint cfg) downloaderLogAction
+    log Info "Junction" "redis: connected"
-    robotsMap <- newIORef M.empty
+    withContext $ \ctx -> do
-    ordersMap <- newIORef M.empty
+      log Debug "Junction" "0mq context created"
-    handledNotifications <- newIORef S.empty
+      let downloaderLogAction = logger h
-    withBroker cfg ctx robotsMap ordersMap handledNotifications logger $ \bro ->
+      let downloaderEnv = DownloaderEnv (mkQHPHandle ctx (qhpEndpoint cfg)) ctx (qtisEndpoint cfg) downloaderLogAction
-      withQThread downloaderEnv barsMap cfg ctx $ \qt -> do
+      robotsMap <- newIORef M.empty
-        broService <- mkBrokerService bro ordersMap
+      ordersMap <- newIORef M.empty
-        let junctionLogAction = fmtMessage >$< logTextStdout
+      handledNotifications <- newIORef S.empty
-        let env =
+      withBroker cfg ctx robotsMap ordersMap handledNotifications (logger h) $ \bro ->
-              JunctionEnv
+        withQThread downloaderEnv barsMap cfg ctx $ \qt -> do
-              {
+          broService <- mkBrokerService bro ordersMap
-                peRedisSocket = redis,
+          let junctionLogAction = logger h
-                peConfigPath = robotsConfigsPath cfg,
+          let env =
-                peQuoteThread = qt,
+                JunctionEnv
-                peBroker = bro,
+                {
-                peRobots = robotsMap,
+                  peRedisSocket = redis,
-                peLogAction = junctionLogAction
+                  peConfigPath = robotsConfigsPath cfg,
-              }
+                  peQuoteThread = qt,
-        withJunction env $ do
+                  peBroker = bro,
-          startRobots cfg barsMap broService
+                  peRobots = robotsMap,
-          forever $ do
+                  peLogAction = junctionLogAction
-            saveRobots
+                }
-            liftIO $ threadDelay 5000000
+          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 :: Handle -> ProgramConfiguration -> IORef Bars -> BrokerService -> JunctionM ()
-    startRobots cfg barsMap broService = forM_ (instances cfg) $ \inst -> do
+    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,

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)
 

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