From f2364e742e159baa763fcfbf647feaa81f01c377 Mon Sep 17 00:00:00 2001 From: Keagan McClelland Date: Sat, 11 Sep 2021 21:25:03 -0600 Subject: [PATCH] implements error log reporting --- config/routes | 5 +++-- config/settings.yml | 9 ++++---- src/Application.hs | 4 ++++ src/Foundation.hs | 5 ++--- src/Handler/ErrorLogs.hs | 46 ++++++++++++++++++++++++++++++++++++++++ src/Settings.hs | 7 ++++-- 6 files changed, 65 insertions(+), 11 deletions(-) create mode 100644 src/Handler/ErrorLogs.hs diff --git a/config/routes b/config/routes index 69f94f7..827c4a5 100644 --- a/config/routes +++ b/config/routes @@ -1,4 +1,3 @@ - !/package/#S9PK AppR GET -- get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec} /package/data CategoriesR GET -- get all marketplace categories /package/index PackageListR GET -- filter marketplace services by various query params @@ -18,4 +17,6 @@ -- TODO deprecate !/sys/#SYS_EXTENSIONLESS SysR GET -- get most recent sys app -- ?spec={semver-spec} /version VersionR GET -/sys/version/#Text VersionSysR GET -- get most recent sys app version \ No newline at end of file +/sys/version/#Text VersionSysR GET -- get most recent sys app version + +/error-logs ErrorLogsR POST \ No newline at end of file diff --git a/config/settings.yml b/config/settings.yml index c5c0020..a8ef529 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -1,9 +1,9 @@ # Values formatted like "_env:YESOD_ENV_VAR_NAME:default_value" can be overridden by the specified environment variable. # See https://github.com/yesodweb/yesod/wiki/Configuration#overriding-configuration-values-with-environment-variables -static-dir: "_env:YESOD_STATIC_DIR:static" -host: "_env:YESOD_HOST:*4" # any IPv4 host -port: "_env:YESOD_PORT:443" # NB: The port `yesod devel` uses is distinct from this value. Set the `yesod devel` port from the command line. +static-dir: "_env:YESOD_STATIC_DIR:static" +host: "_env:YESOD_HOST:*4" # any IPv4 host +port: "_env:YESOD_PORT:443" # NB: The port `yesod devel` uses is distinct from this value. Set the `yesod devel` port from the command line. ip-from-header: "_env:YESOD_IP_FROM_HEADER:false" # Default behavior: determine the application root from the request headers. @@ -34,6 +34,7 @@ ssl-auto: "_env:SSL_AUTO:true" registry-hostname: "_env:REGISTRY_HOSTNAME:alpha-registry.start9labs.com" tor-port: "_env:TOR_PORT:447" static-bin-dir: "_env:STATIC_BIN:/usr/local/bin/" +error-log-root: "_env:ERROR_LOG_ROOT:/var/log/embassy-os/" database: database: "_env:PG_DATABASE:start9_registry" @@ -41,4 +42,4 @@ database: user: "_env:PG_USER:user" password: "_env:PG_PASSWORD:password" host: "_env:PG_HOST:localhost" - port: "_env:PG_PORT:5432" \ No newline at end of file + port: "_env:PG_PORT:5432" diff --git a/src/Application.hs b/src/Application.hs index d231161..7950184 100644 --- a/src/Application.hs +++ b/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) diff --git a/src/Foundation.hs b/src/Foundation.hs index f1e8cf5..7e7ebad 100644 --- a/src/Foundation.hs +++ b/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 diff --git a/src/Handler/ErrorLogs.hs b/src/Handler/ErrorLogs.hs new file mode 100644 index 0000000..76946ec --- /dev/null +++ b/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 diff --git a/src/Settings.hs b/src/Settings.hs index 2c40086..da08761 100644 --- a/src/Settings.hs +++ b/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"