From a3200ea2788d99594d73c02935dc828151fbf05a Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Sun, 21 Jul 2019 11:55:50 +0700 Subject: [PATCH] Logging --- app/Main.hs | 49 +++++++++++++++++++++++---------- mds.cabal | 1 + src/ATrade/MDS/Database.hs | 25 ++++++++--------- src/ATrade/MDS/HistoryServer.hs | 4 +++ 4 files changed, 52 insertions(+), 27 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index f91a60e..7ecf677 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,23 +1,29 @@ module Main where -import Data.Aeson -import qualified Data.Text as T -import qualified Data.ByteString.Lazy as BL +import Data.Aeson +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T -import ATrade.MDS.Database -import ATrade.MDS.HistoryServer +import ATrade.MDS.Database +import ATrade.MDS.HistoryServer -import Control.Concurrent -import Control.Monad +import Control.Concurrent +import Control.Monad + +import System.IO +import System.Log.Formatter +import System.Log.Handler (setFormatter) +import System.Log.Handler.Simple +import System.Log.Logger +import System.ZMQ4 -import System.ZMQ4 data MdsConfig = MdsConfig { - cfgDbPath :: T.Text, - cfgDbName :: T.Text, - cfgDbAccount :: T.Text, - cfgDbPassword :: T.Text, + cfgDbPath :: T.Text, + cfgDbName :: T.Text, + cfgDbAccount :: T.Text, + cfgDbPassword :: T.Text, cfgQHPEndpoint :: T.Text, cfgHAPEndpoint :: T.Text } deriving (Show, Eq) @@ -32,27 +38,42 @@ instance FromJSON MdsConfig where v .: "qhp_endpoint" <*> v .: "hap_endpoint" +initLogging :: IO () +initLogging = do + handler <- fileHandler "mds.log" DEBUG >>= + (\x -> return $ + setFormatter x (simpleLogFormatter "$utcTime\t {$loggername} <$prio> -> $msg")) + + hSetBuffering stderr LineBuffering + updateGlobalLogger rootLoggerName (setLevel DEBUG) + updateGlobalLogger rootLoggerName (setHandlers [handler]) + getConfig :: IO MdsConfig getConfig = do rawCfg <- BL.readFile "mds.conf" case eitherDecode' rawCfg of - Left err -> error err + Left err -> error err Right cfg -> return cfg - + main :: IO () main = do + initLogging + debugM "main" "Initializing MDS" cfg <- getConfig + debugM "main" "Config OK" let dbConfig = DatabaseConfig { dbPath = cfgDbPath cfg, dbDatabase = cfgDbName cfg, dbUser = cfgDbAccount cfg, dbPassword = cfgDbPassword cfg } db <- initDatabase dbConfig + debugM "main" "DB initialized" let hsConfig = HistoryServerConfig { hspQHPEndpoint = cfgQHPEndpoint cfg, hspHAPEndpoint = cfgHAPEndpoint cfg } + debugM "main" "Starting history server" withContext $ \ctx -> do _ <- startHistoryServer hsConfig db ctx forever $ threadDelay 1000000 diff --git a/mds.cabal b/mds.cabal index 8bcb887..f2807f1 100644 --- a/mds.cabal +++ b/mds.cabal @@ -49,6 +49,7 @@ executable mds-exe , aeson , text , bytestring + , hslogger , zeromq4-haskell default-language: Haskell2010 default-extensions: OverloadedStrings diff --git a/src/ATrade/MDS/Database.hs b/src/ATrade/MDS/Database.hs index a076b59..cefe5f7 100644 --- a/src/ATrade/MDS/Database.hs +++ b/src/ATrade/MDS/Database.hs @@ -14,19 +14,18 @@ module ATrade.MDS.Database ( timeframeMinute ) where -import qualified Data.Text as T -import qualified Data.Vector as V -import ATrade.Types -import Data.Time.Clock -import Data.Time.Clock.POSIX -import Data.Maybe -import Database.HDBC -import Database.HDBC.Sqlite3 -import Control.Monad +import ATrade.Types +import Control.Monad +import Data.Maybe +import qualified Data.Text as T +import Data.Time.Clock +import Data.Time.Clock.POSIX +import qualified Data.Vector as V +import Database.HDBC +import Database.HDBC.Sqlite3 data TimeInterval = TimeInterval UTCTime UTCTime - data Timeframe = Timeframe Int timeframeDaily :: Int -> Timeframe @@ -39,9 +38,9 @@ timeframeMinute :: Int -> Timeframe timeframeMinute mins = Timeframe (mins * 60) data DatabaseConfig = DatabaseConfig { - dbPath :: T.Text, + dbPath :: T.Text, dbDatabase :: T.Text, - dbUser :: T.Text, + dbUser :: T.Text, dbPassword :: T.Text } deriving (Show, Eq) @@ -83,7 +82,7 @@ putData db tickerId (TimeInterval start end) tf@(Timeframe tfSec) bars = do executeMany stmt (map (barToSql tf) $ V.toList bars) runRaw db "COMMIT;" where - barToSql :: Timeframe -> Bar -> [SqlValue] + barToSql :: Timeframe -> Bar -> [SqlValue] barToSql (Timeframe timeframeSecs) bar = [(SqlString . T.unpack . barSecurity) bar, (SqlInteger . toInteger) timeframeSecs, (SqlPOSIXTime . utcTimeToPOSIXSeconds . barTimestamp) bar, diff --git a/src/ATrade/MDS/HistoryServer.hs b/src/ATrade/MDS/HistoryServer.hs index ffdc2e6..b5a86f8 100644 --- a/src/ATrade/MDS/HistoryServer.hs +++ b/src/ATrade/MDS/HistoryServer.hs @@ -21,6 +21,8 @@ import qualified Data.Text as T import Data.Time.Clock.POSIX import qualified Data.Vector as V import Safe + +import System.Log.Logger import System.ZMQ4 data HistoryServer = HistoryServer ThreadId ThreadId @@ -53,6 +55,7 @@ serveQHP db sock = forever $ do handleCmd :: B.ByteString -> QHPRequest -> IO () handleCmd peerId cmd = case cmd of rq -> do + debugM "QHP" $ "Incoming command: " ++ show cmd qdata <- getData db (rqTicker rq) (TimeInterval (rqStartTime rq) (rqEndTime rq)) (Timeframe (periodSeconds $ rqPeriod rq)) let bytes = serializeBars $ V.concat $ fmap snd qdata sendMulti sock $ peerId :| B.empty : [BL.toStrict bytes] @@ -79,6 +82,7 @@ serveHAP db sock = forever $ do where handleCmd :: B.ByteString -> HAPRequest -> [Bar] -> IO () handleCmd peerId rq bars = do + debugM "HAP" $ "Incoming command: " ++ show rq putData db (hapTicker rq) (TimeInterval (hapStartTime rq) (hapEndTime rq)) (Timeframe $ hapTimeframeSec rq) (V.fromList bars) sendMulti sock $ peerId :| B.empty : ["OK"]