diff --git a/src/Handler/ErrorLogs.hs b/src/Handler/ErrorLogs.hs index bfeac13..b16d8eb 100644 --- a/src/Handler/ErrorLogs.hs +++ b/src/Handler/ErrorLogs.hs @@ -8,20 +8,25 @@ import Data.Aeson ( (.:) , withObject , withText ) -import qualified Data.Text as T import Foundation -import Settings ( AppSettings(errorLogRoot) ) -import Startlude hiding ( Handler ) -import System.FilePath ( (<.>) - , () +import Model ( EntityField(ErrorLogRecordIncidents) + , ErrorLogRecord(ErrorLogRecord) ) -import Yesod.Core ( getsYesod - , requireCheckJsonBody +import Startlude hiding ( Handler ) +import Yesod.Core ( requireCheckJsonBody ) +import Yesod.Persist ( (+=.) + , runDB + , upsert ) data ErrorLog = ErrorLog - { errorLogEpoch :: Word64 - , errorLogMessage :: Text + { errorLogEpoch :: Word64 + , errorLogCommitHash :: Text + , errorLogSourceFile :: Text + , errorLogLine :: Word32 + , errorLogTarget :: Text + , errorLogLevel :: Text + , errorLogMessage :: Text } deriving (Eq, Show) @@ -33,14 +38,27 @@ instance FromJSON ErrorLog where Nothing -> fail "Invalid Log Epoch" Just x -> pure x ) - errorLogMessage <- o .: "log-message" + errorLogCommitHash <- o .: "commit-hash" + errorLogSourceFile <- o .: "file" + errorLogLine <- o .: "line" + errorLogLevel <- o .: "level" + errorLogTarget <- o .: "target" + errorLogMessage <- o .: "log-message" pure ErrorLog { .. } postErrorLogsR :: Handler () postErrorLogsR = do ErrorLog {..} <- requireCheckJsonBody @_ @ErrorLog - root <- getsYesod $ errorLogRoot . appSettings - void $ liftIO $ forkIO $ appendFile (root show errorLogEpoch <.> "log") $ if "\n" `T.isSuffixOf` errorLogMessage - then errorLogMessage - else T.snoc errorLogMessage '\n' + void $ runDB $ do + now <- liftIO getCurrentTime + let logRecord = ErrorLogRecord now + errorLogEpoch + errorLogCommitHash + errorLogSourceFile + errorLogLine + errorLogTarget + errorLogLevel + errorLogMessage + 1 + upsert logRecord [ErrorLogRecordIncidents +=. 1] diff --git a/src/Model.hs b/src/Model.hs index 5891d72..d65f088 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -79,4 +79,16 @@ EosHash version Version hash Text UniqueVersion version + +ErrorLogRecord + createdAt UTCTime + epoch Word64 + commitHash Text + sourceFile Text + line Word32 + target Text + level Text + message Text + incidents Word32 + UniqueLogRecord epoch commitHash sourceFile line target level message |]