Logging

app/Main.hs

@@ -1,23 +1,29 @@
 
 module Main where
 
-import Data.Aeson
+import           Data.Aeson
-import qualified Data.Text as T
+import qualified Data.ByteString.Lazy      as BL
-import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text                 as T
 
-import ATrade.MDS.Database
+import           ATrade.MDS.Database
-import ATrade.MDS.HistoryServer
+import           ATrade.MDS.HistoryServer
 
-import Control.Concurrent
+import           Control.Concurrent
-import Control.Monad
+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,
+  cfgDbPath      :: T.Text,
-  cfgDbName :: T.Text,
+  cfgDbName      :: T.Text,
-  cfgDbAccount :: T.Text,
+  cfgDbAccount   :: T.Text,
-  cfgDbPassword :: 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

mds.cabal

@@ -49,6 +49,7 @@ executable mds-exe
                      , aeson
                      , text
                      , bytestring
+                     , hslogger
                      , zeromq4-haskell
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings

src/ATrade/MDS/Database.hs

@@ -14,19 +14,18 @@ module ATrade.MDS.Database (
   timeframeMinute
 ) where
 
-import qualified Data.Text as T
+import           ATrade.Types
-import qualified Data.Vector as V
+import           Control.Monad
-import ATrade.Types
+import           Data.Maybe
-import Data.Time.Clock
+import qualified Data.Text             as T
-import Data.Time.Clock.POSIX
+import           Data.Time.Clock
-import Data.Maybe
+import           Data.Time.Clock.POSIX
-import Database.HDBC
+import qualified Data.Vector           as V
-import Database.HDBC.Sqlite3
+import           Database.HDBC
-import Control.Monad
+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)
 

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"]