Add log-level config

CHANGELOG.md

@@ -12,6 +12,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
  - #1119, Allow config file reloading with SIGUSR2 - @steve-chavez
  - #1558, Allow 'Bearer' with and without capitalization as authentication schema - @wolfgangwalther
  - #1559, No downtime when reloading the schema cache with SIGUSR1 - @steve-chavez
+ - #504, Add `log-level` config option - @steve-chavez
 
 ### Fixed
 

main/Main.hs

@@ -34,8 +34,7 @@ import PostgREST.DbStructure (getDbStructure, getPgVersion)
 import PostgREST.Error       (PgError (PgError), checkIsFatal,
                               errorPayload)
 import PostgREST.Types       (ConnectionStatus (..), DbStructure,
-                              LogSetup (..), PgVersion (..),
+                              PgVersion (..), minimumPgVersion)
-                              minimumPgVersion)
 import Protolude             hiding (hPutStrLn, head, toS)
 import Protolude.Conv        (toS)
 
@@ -78,6 +77,7 @@ main = do
       defaultSettings
     poolSize = configPoolSize conf
     poolTimeout = configPoolTimeout' conf
+    logLevel = configLogLevel conf
 
   -- create connection pool with the provided settings, returns either a 'Connection' or a 'ConnectionError'. Does not throw.
   pool <- P.acquire (poolSize, poolTimeout, dbUri)
@@ -133,7 +133,7 @@ main = do
 
   let postgrestApplication =
         postgrest
-          LogStdout
+          logLevel
           refConf
           refDbStructure
           pool

src/PostgREST/App.hs

@@ -65,9 +65,9 @@ import PostgREST.Types
 import Protolude                  hiding (Proxy, intercalate, toS)
 import Protolude.Conv             (toS)
 
-postgrest :: LogSetup -> IORef AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application
+postgrest :: LogLevel -> IORef AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application
-postgrest logS refConf refDbStructure pool getTime connWorker =
+postgrest logLev refConf refDbStructure pool getTime connWorker =
-  pgrstMiddleware logS $ \ req respond -> do
+  pgrstMiddleware logLev $ \ req respond -> do
     time <- getTime
     body <- strictRequestBody req
     maybeDbStructure <- readIORef refDbStructure

src/PostgREST/Config.hs

@@ -58,7 +58,8 @@ import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
 import PostgREST.Auth             (parseSecret)
 import PostgREST.Parsers          (pRoleClaimKey)
 import PostgREST.Private.ProxyUri (isMalformedProxyUri)
-import PostgREST.Types            (JSPath, JSPathExp (..))
+import PostgREST.Types            (JSPath, JSPathExp (..),
+                                   LogLevel (..))
 import Protolude                  hiding (concat, hPutStrLn,
                                    intercalate, null, replace, take,
                                    toS, (<>))
@@ -94,6 +95,8 @@ data AppConfig = AppConfig {
   , configRawMediaTypes     :: [B.ByteString]
 
   , configJWKS              :: Maybe JWKSet
+
+  , configLogLevel          :: LogLevel
   }
 
 configPoolTimeout' :: (Fractional a) => AppConfig -> a
@@ -190,9 +193,11 @@ readPathShowHelp = customExecParser parserPrefs opts
           |
           |## content types to produce raw output
           |# raw-media-types="image/png, image/jpg"
+          |
+          |## logging level. The admitted values are: info and crit
+          |# log-level = "info"
           |]
 
-
 -- | Parse the config file
 readAppConfig :: FilePath -> IO AppConfig
 readAppConfig cfgPath = do
@@ -234,6 +239,7 @@ readAppConfig cfgPath = do
         <*> optString "root-spec"
         <*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types")
         <*> pure Nothing
+        <*> parseLogLevel "log-level"
 
     parseSocketFileMode :: C.Key -> C.Parser C.Config (Either Text FileMode)
     parseSocketFileMode k =
@@ -257,6 +263,15 @@ readAppConfig cfgPath = do
           (Just "") -> pure Nothing
           aud' -> pure aud'
 
+    parseLogLevel :: C.Key -> C.Parser C.Config LogLevel
+    parseLogLevel k =
+      C.optional k C.string >>= \case
+        Nothing -> pure LogInfo
+        Just "" -> pure LogInfo
+        Just "crit" -> pure LogCrit
+        Just "info" -> pure LogInfo
+        Just _ -> fail "Invalid logging level. Check your configuration."
+
     reqString :: C.Key -> C.Parser C.Config Text
     reqString k = C.required k C.string
 

src/PostgREST/Middleware.hs

@@ -30,7 +30,7 @@ import Network.Wai.Middleware.Static        (only, staticPolicy)
 import PostgREST.ApiRequest   (ApiRequest (..))
 import PostgREST.Config       (AppConfig (..))
 import PostgREST.QueryBuilder (setLocalQuery, setLocalSearchPathQuery)
-import PostgREST.Types        (LogSetup (..))
+import PostgREST.Types        (LogLevel (..))
 import Protolude              hiding (head, toS)
 import Protolude.Conv         (toS)
 
@@ -57,9 +57,9 @@ runPgLocals conf claims app req = do
     anon = JSON.String . toS $ configAnonRole conf
     preReq = (\f -> "select " <> toS f <> "();") <$> configPreReq conf
 
-pgrstMiddleware :: LogSetup -> Application -> Application
+pgrstMiddleware :: LogLevel -> Application -> Application
-pgrstMiddleware logs =
+pgrstMiddleware logLev =
-    (if logs == LogQuiet then id else logStdout)
+    (if logLev == LogCrit then id else logStdout)
   . gzip def
   . cors corsPolicy
   . staticPolicy (only [("favicon.ico", "static/favicon.ico")])

src/PostgREST/Types.hs

@@ -539,5 +539,4 @@ data ConnectionStatus
   | FatalConnectionError Text
   deriving (Eq, Show)
 
--- | Logging setup
+data LogLevel = LogCrit | LogInfo deriving (Eq, Show)
-data LogSetup = LogQuiet | LogStdout deriving (Eq, Show)

test/Main.hs

@@ -15,7 +15,7 @@ import Test.Hspec
 import PostgREST.App         (postgrest)
 import PostgREST.Config      (AppConfig (..))
 import PostgREST.DbStructure (getDbStructure, getPgVersion)
-import PostgREST.Types       (LogSetup (..), pgVersion95, pgVersion96)
+import PostgREST.Types       (LogLevel (..), pgVersion95, pgVersion96)
 import Protolude             hiding (toList, toS)
 import Protolude.Conv        (toS)
 import SpecHelper
@@ -67,13 +67,13 @@ main = do
     -- For tests that run with the same refDbStructure
     app cfg = do
       refConf <- newIORef $ cfg testDbConn
-      return ((), postgrest LogQuiet refConf refDbStructure pool getTime $ pure ())
+      return ((), postgrest LogCrit refConf refDbStructure pool getTime $ pure ())
 
     -- For tests that run with a different DbStructure(depends on configSchemas)
     appDbs cfg = do
       dbs <- (newIORef . Just) =<< setupDbStructure pool (configSchemas $ cfg testDbConn) actualPgVersion
       refConf <- newIORef $ cfg testDbConn
-      return ((), postgrest LogQuiet refConf dbs pool getTime $ pure ())
+      return ((), postgrest LogCrit refConf dbs pool getTime $ pure ())
 
   let withApp              = app testCfg
       maxRowsApp           = app testMaxRowsCfg

test/SpecHelper.hs

@@ -24,7 +24,7 @@ import Text.Heredoc
 
 import PostgREST.Auth   (parseSecret)
 import PostgREST.Config (AppConfig (..))
-import PostgREST.Types  (JSPathExp (..))
+import PostgREST.Types  (JSPathExp (..), LogLevel (..))
 import Protolude        hiding (toS)
 import Protolude.Conv   (toS)
 
@@ -89,6 +89,7 @@ _baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in
   , configRootSpec          = Nothing
   , configRawMediaTypes     = []
   , configJWKS              = parseSecret <$> secret
+  , configLogLevel          = LogCrit
   }
 
 testCfg :: Text -> AppConfig