Implement log file backend (#178)

* Implement log file backend

* Add logs directory contents to .gitignore

* Lint

* Use Cabal-syntax everywhere

* Remove CoverageReport

.gitignore

@@ -26,4 +26,4 @@ pgdata/
 .DS_Store
 tags.lock
 cabal.project.local
-
+logs/*

app/cli/Main.hs

@@ -1,6 +1,5 @@
 module Main where
 
-import CoverageReport
 import Data.Maybe
 import Data.Password.Types
 import Data.Text (Text)
@@ -26,7 +25,6 @@ data Options = Options
 
 data Command
   = Provision ProvisionTarget
-  | CoverageReport CoverageReportOptions
   | CreateUser UserCreationOptions
   | GenDesignSystemComponents
   | ImportPackages FilePath
@@ -62,7 +60,6 @@ parseCommand :: Parser Command
 parseCommand =
   subparser $
     command "provision" (parseProvision `withInfo` "Load the test fixtures into the database")
-      <> command "coverage-report" (parseCoverageReport `withInfo` "Run a coverage report of the category mapping")
       <> command "create-user" (parseCreateUser `withInfo` "Create a user in the system")
       <> command "gen-design-system" (parseGenDesignSystem `withInfo` "Generate Design System components from the code")
       <> command "import-packages" (parseImportPackages `withInfo` "Import cabal packages from a directory")
@@ -73,11 +70,6 @@ parseProvision =
     command "categories" (pure (Provision Categories) `withInfo` "Load the canonical categories in the system")
       <> command "test-packages" (pure (Provision TestPackages) `withInfo` "Load the test packages in the database")
 
-parseCoverageReport :: Parser Command
-parseCoverageReport =
-  CoverageReport . CoverageReportOptions
-    <$> switch (long "force-download" <> help "Always download and extract the package index")
-
 parseCreateUser :: Parser Command
 parseCreateUser =
   CreateUser
@@ -96,7 +88,6 @@ parseImportPackages :: Parser Command
 parseImportPackages = ImportPackages <$> argument str (metavar "PATH")
 
 runOptions :: ([DB, IOE] :>> es) => Options -> Eff es ()
-runOptions (Options (CoverageReport opts)) = unsafeEff_ $ runCoverageReport opts
 runOptions (Options (Provision Categories)) = importCategories
 runOptions (Options (Provision TestPackages)) = importFolderOfCabalFiles "./test/fixtures/Cabal/"
 runOptions (Options (CreateUser opts)) = do

flora.cabal

@@ -179,6 +179,7 @@ library
     FloraWeb.Templates.Pages.Sessions
     FloraWeb.Templates.Types
     FloraWeb.Types
+    Log.Backend.File
     Lucid.Orphans
 
   build-depends:
@@ -282,16 +283,13 @@ executable flora-cli
   import:         common-ghc-options
   import:         common-rts-options
   main-is:        Main.hs
-  other-modules:
-    CoverageReport
-    DesignSystem
-
+  other-modules:  DesignSystem
   hs-source-dirs: app/cli
   build-depends:
     , ansi-terminal
     , base
     , bytestring
-    , Cabal
+    , Cabal-syntax
     , colourista
     , directory
     , effectful
@@ -329,7 +327,7 @@ test-suite flora-test
     , aeson
     , base
     , bytestring
-    , Cabal
+    , Cabal-syntax
     , containers
     , effectful-core
     , exceptions

src/Flora/Environment/Config.hs

@@ -53,6 +53,8 @@ data LoggingDestination
     StdOut
   | -- | Logs are printed on the standard output in JSON format
     Json
+  | -- | Logs are sent to a file as JSON
+    JSONFile
   deriving (Show, Generic)
 
 data LoggingEnv = LoggingEnv
@@ -176,4 +178,5 @@ deploymentEnv e = Left $ unread e
 loggingDestination :: Reader Error LoggingDestination
 loggingDestination "stdout" = Right StdOut
 loggingDestination "json" = Right Json
+loggingDestination "json-file" = Right JSONFile
 loggingDestination e = Left $ unread e

src/FloraWeb/Server.hs

@@ -7,7 +7,7 @@ import Data.Maybe (isJust)
 import qualified Data.Pool as Pool
 import Data.Text.Display (display)
 import Effectful
-import Log (Logger, defaultLogLevel)
+import Log (Logger)
 import qualified Log
 import Network.HTTP.Client.TLS (tlsManagerSettings)
 import Network.Wai.Handler.Warp
@@ -36,7 +36,6 @@ import Servant.Server.Generic (AsServerT, genericServeTWithContext)
 import qualified Control.Exception.Safe as Safe
 import qualified Database.PostgreSQL.Simple as PG
 import Effectful.Concurrent
-import Effectful.Log (runLogging)
 import Effectful.Reader.Static (runReader, withReader)
 import Effectful.Servant (effToHandler)
 import Effectful.Time (Time, runCurrentTimeIO)
@@ -59,6 +58,7 @@ import qualified FloraWeb.Autoreload as Autoreload
 import FloraWeb.Routes
 import qualified FloraWeb.Routes.Pages as Pages
 import FloraWeb.Server.Auth (FloraAuthContext, authHandler, runVisitorSession)
+import FloraWeb.Server.Logging (runLog)
 import qualified FloraWeb.Server.Logging as Logging
 import FloraWeb.Server.Metrics
 import qualified FloraWeb.Server.Pages as Pages
@@ -144,7 +144,7 @@ runServer appLogger floraEnv = do
 
 mkServer :: Logger -> WebEnvStore -> FloraEnv -> OddJobs.UIConfig -> OddJobs.Env -> Application
 mkServer logger webEnvStore floraEnv cfg jobsRunnerEnv = do
-  genericServeTWithContext (naturalTransform logger webEnvStore) (floraServer (floraEnv ^. #pool) cfg jobsRunnerEnv) (genAuthServerContext logger floraEnv)
+  genericServeTWithContext (naturalTransform (floraEnv ^. #environment) logger webEnvStore) (floraServer (floraEnv ^. #pool) cfg jobsRunnerEnv) (genAuthServerContext logger floraEnv)
 
 floraServer :: Pool Connection -> OddJobs.UIConfig -> OddJobs.Env -> Routes (AsServerT Flora)
 floraServer pool cfg jobsRunnerEnv =
@@ -170,10 +170,10 @@ floraServer pool cfg jobsRunnerEnv =
           Autoreload.server
     }
 
-naturalTransform :: Logger -> WebEnvStore -> Flora a -> Handler a
-naturalTransform logger webEnvStore app =
+naturalTransform :: DeploymentEnv -> Logger -> WebEnvStore -> Flora a -> Handler a
+naturalTransform deploymentEnv logger webEnvStore app =
   effToHandler
-    . runLogging "flora" logger defaultLogLevel
+    . runLog deploymentEnv logger
     . runReader webEnvStore
     $ app
 

src/FloraWeb/Server/Logging.hs

@@ -1,22 +1,19 @@
 module FloraWeb.Server.Logging
-  ( alert
-  , makeLogger
+  ( makeLogger
   , runLog
   )
 where
 
-import Data.Aeson.Types (Pair)
 import Data.Kind (Type)
-import Data.Text (Text)
 import qualified Effectful.Log as Log
 import Flora.Environment.Config
-import Log (LogLevel (..), Logger, defaultLogLevel, object, (.=))
+import Log (Logger, defaultLogLevel)
 
 import Data.Text.Display (display)
 import Effectful
-import Effectful.Log (Logging, logMessageEff')
+import Effectful.Log (Logging)
 import qualified Effectful.Log.Backend.StandardOutput as Log
-import Effectful.Time
+import Log.Backend.File (FileBackendConfig (..), withJSONFileBackend)
 
 -- | Wrapper around 'Log.runLogT' with necessary metadata
 runLog ::
@@ -34,13 +31,4 @@ runLog env logger logAction =
 makeLogger :: (IOE :> es) => LoggingDestination -> (Logger -> Eff es a) -> Eff es a
 makeLogger StdOut = Log.withStdOutLogger
 makeLogger Json = Log.withJsonStdOutLogger
-
-alert ::
-  ([Time, Logging] :>> es) =>
-  Text ->
-  [Pair] ->
-  Eff es ()
-alert message details = do
-  timestamp <- getCurrentTime
-  let metadata = object $ ("timestamp" .= timestamp) : details
-  logMessageEff' LogAttention message metadata
+makeLogger JSONFile = withJSONFileBackend FileBackendConfig{destinationFile = "logs/flora.json"}

src/Log/Backend/File.hs

@@ -0,0 +1,28 @@
+module Log.Backend.File where
+
+import qualified Data.Aeson as Aeson
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy as BSL
+import Data.Kind (Type)
+import Effectful
+import qualified Effectful.Log.Logger as Log
+import GHC.Generics (Generic)
+import Log (Logger)
+import System.IO (stdout)
+
+data FileBackendConfig = FileBackendConfig
+  { destinationFile :: FilePath
+  }
+  deriving stock (Eq, Ord, Show, Generic)
+
+withJSONFileBackend ::
+  forall (es :: [Effect]) (a :: Type).
+  IOE :> es =>
+  FileBackendConfig ->
+  (Logger -> Eff es a) ->
+  Eff es a
+withJSONFileBackend FileBackendConfig{destinationFile} action = do
+  liftIO $ BS.hPutStrLn stdout $ BS.pack $ "Redirecting logs to " <> destinationFile
+  logger <- Log.mkLogger "file-json" $ \msg -> liftIO $ do
+    BS.appendFile destinationFile (BSL.toStrict $ Aeson.encode msg)
+  Log.withLogger logger action