implements error log reporting

src/Application.hs

@@ -52,6 +52,7 @@ import           Yesod.Default.Config2
 -- Don't forget to add new modules to your cabal file!
 import           Foundation
 import           Handler.Apps
+import           Handler.ErrorLogs
 import           Handler.Icons
 import           Handler.Version
 import           Handler.Marketplace
@@ -65,6 +66,7 @@ import           Control.Arrow ((***))
 import           Network.HTTP.Types.Header ( hOrigin )
 import           Data.List (lookup)
 import Network.Wai.Middleware.RequestLogger.JSON
+import System.Directory (createDirectoryIfMissing)
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
@@ -96,6 +98,8 @@ makeFoundation appSettings = do
         tempFoundation = mkFoundation $ panic "connPool forced in tempFoundation"
         logFunc = messageLoggerSource tempFoundation appLogger
 
+    createDirectoryIfMissing True (errorLogRoot appSettings)
+
     -- Create the database connection pool
     pool <- flip runLoggingT logFunc $ createPostgresqlPool
         (pgConnStr $ appDatabaseConf appSettings)

src/Foundation.hs

@@ -6,7 +6,7 @@
 {-# LANGUAGE ViewPatterns          #-}
 module Foundation where
 
-import           Startlude hiding (Handler)
+import           Startlude               hiding ( Handler )
 
 import           Control.Monad.Logger           ( LogSource )
 import           Database.Persist.Sql
@@ -15,10 +15,9 @@ import           Yesod.Core
 import           Yesod.Core.Types               ( Logger )
 import qualified Yesod.Core.Unsafe             as Unsafe
 
+import           Lib.Types.AppIndex
 import           Settings
 import           Yesod.Persist.Core
-import           Lib.Types.AppIndex
-import Network.Wai
 
 -- | The foundation datatype for your application. This can be a good place to
 -- keep settings and values requiring initialization before your application

src/Handler/ErrorLogs.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
+module Handler.ErrorLogs where
+
+import           Control.Monad                  ( MonadFail(fail) )
+import           Data.Aeson                     ( (.:)
+                                                , FromJSON(parseJSON)
+                                                , eitherDecode
+                                                , withObject
+                                                , withText
+                                                )
+import           Foundation
+import           Settings                       ( AppSettings(errorLogRoot) )
+import           Startlude               hiding ( Handler )
+import           System.FilePath                ( (<.>)
+                                                , (</>)
+                                                )
+import           Yesod.Core                     ( getsYesod
+                                                , requireCheckJsonBody
+                                                )
+
+data ErrorLog = ErrorLog
+    { errorLogEpoch   :: Word64
+    , errorLogMessage :: Text
+    }
+    deriving (Eq, Show)
+
+-- >>> eitherDecode "{ \"log-epoch\": \"1234\", \"log-message\": \"This is the famous budweiser beer\" }" :: Either String ErrorLog
+-- Variable not in scope: eitherDecode :: t0 -> Either String ErrorLog
+instance FromJSON ErrorLog where
+    parseJSON = withObject "Error Log" $ \o -> do
+        errorLogEpoch <- o .: "log-epoch" >>= withText
+            "Word64"
+            (\t -> case readMaybe t of
+                Nothing -> fail "Invalid Log Epoch"
+                Just x  -> pure x
+            )
+        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") errorLogMessage

src/Settings.hs

@@ -11,11 +11,11 @@ import           Paths_start9_registry          ( version )
 import           Startlude
 
 import qualified Control.Exception             as Exception
-import           Data.Maybe
 import           Data.Aeson
 import           Data.Aeson.Types
-import           Data.Version                   ( showVersion )
 import           Data.FileEmbed                 ( embedFile )
+import           Data.Maybe
+import           Data.Version                   ( showVersion )
 import           Data.Yaml                      ( decodeEither' )
 import           Data.Yaml.Config
 import           Database.Persist.Postgresql    ( PostgresConf )
@@ -24,6 +24,7 @@ import           System.FilePath                ( (</>) )
 import           Yesod.Default.Config2          ( configSettingsYml )
 
 import           Lib.Types.Emver
+import           Network.Wai                    ( FilePart )
 import           Orphans.Emver                  ( )
 -- | Runtime settings to configure this application. These settings can be
 -- loaded from various sources: defaults, environment variables, config files,
@@ -52,6 +53,7 @@ data AppSettings = AppSettings
     , sslCertLocation           :: FilePath
     , torPort                   :: AppPort
     , staticBinDir              :: FilePath
+    , errorLogRoot              :: FilePath
     }
 
 instance FromJSON AppSettings where
@@ -68,6 +70,7 @@ instance FromJSON AppSettings where
         registryHostname          <- o .: "registry-hostname"
         torPort                   <- o .: "tor-port"
         staticBinDir              <- o .: "static-bin-dir"
+        errorLogRoot              <- o .: "error-log-root"
 
         let sslKeyLocation  = sslPath </> "key.pem"
         let sslCsrLocation  = sslPath </> "certificate.csr"