conflict resolution (#77)

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           Model                          ( EntityField(ErrorLogRecordIncidents)
-import           Startlude               hiding ( Handler )
+                                                , ErrorLogRecord(ErrorLogRecord)
-import           System.FilePath                ( (<.>)
-                                                , (</>)
                                                 )
-import           Yesod.Core                     ( getsYesod
+import           Startlude               hiding ( Handler )
-                                                , requireCheckJsonBody
+import           Yesod.Core                     ( requireCheckJsonBody )
+import           Yesod.Persist                  ( (+=.)
+                                                , runDB
+                                                , upsert
                                                 )
 
 data ErrorLog = ErrorLog
-    { errorLogEpoch   :: Word64
+    { errorLogEpoch      :: Word64
-    , errorLogMessage :: Text
+    , 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 $ runDB $ do
-    void $ liftIO $ forkIO $ appendFile (root </> show errorLogEpoch <.> "log") $ if "\n" `T.isSuffixOf` errorLogMessage
+        now <- liftIO getCurrentTime
-        then errorLogMessage
+        let logRecord = ErrorLogRecord now
-        else T.snoc errorLogMessage '\n'
+                                       errorLogEpoch
+                                       errorLogCommitHash
+                                       errorLogSourceFile
+                                       errorLogLine
+                                       errorLogTarget
+                                       errorLogLevel
+                                       errorLogMessage
+                                       1
+        upsert logRecord [ErrorLogRecordIncidents +=. 1]

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