Add error log level

postgrest.cabal

@@ -59,6 +59,7 @@ library
                     , contravariant-extras      >= 0.3.3 && < 0.4
                     , cookie                    >= 0.4.2 && < 0.5
                     , either                    >= 4.4.1 && < 5.1
+                    , fast-logger               >= 2.4.5
                     , gitrev                    >= 1.2 && < 1.4
                     , hasql                     >= 1.4 && < 1.5
                     , hasql-pool                >= 0.5 && < 0.6
@@ -84,6 +85,7 @@ library
                     , wai                       >= 3.2.1 && < 3.3
                     , wai-cors                  >= 0.2.5 && < 0.3
                     , wai-extra                 >= 3.0.19 && < 3.2
+                    , wai-logger                >= 2.3.2
                     , wai-middleware-static     >= 0.8.1 && < 0.10
   default-language:   Haskell2010
   default-extensions: OverloadedStrings

src/PostgREST/Config.hs

@@ -266,11 +266,12 @@ readAppConfig cfgPath = do
     parseLogLevel :: C.Key -> C.Parser C.Config LogLevel
     parseLogLevel k =
       C.optional k C.string >>= \case
-        Nothing -> pure LogInfo
+        Nothing      -> pure LogInfo
-        Just "" -> pure LogInfo
+        Just ""      -> pure LogInfo
-        Just "crit" -> pure LogCrit
+        Just "crit"  -> pure LogCrit
-        Just "info" -> pure LogInfo
+        Just "error" -> pure LogError
-        Just _ -> fail "Invalid logging level. Check your configuration."
+        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

@@ -8,23 +8,26 @@ Description : Sets CORS policy. Also the PostgreSQL GUCs, role, search_path and
 
 module PostgREST.Middleware where
 
-import qualified Data.Aeson            as JSON
+import qualified Data.Aeson                as JSON
-import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Char8     as BS
-import qualified Data.CaseInsensitive  as CI
+import qualified Data.CaseInsensitive      as CI
-import           Data.Function         (id)
+import           Data.Function             (id)
-import qualified Data.HashMap.Strict   as M
+import qualified Data.HashMap.Strict       as M
-import           Data.List             (lookup)
+import           Data.List                 (lookup)
-import           Data.Scientific       (FPFormat (..),
+import           Data.Scientific           (FPFormat (..),
-                                        formatScientific, isInteger)
+                                            formatScientific,
-import           Data.Text             (strip)
+                                            isInteger)
-import qualified Hasql.Transaction     as H
+import qualified Data.Text                 as T
+import qualified Hasql.Transaction         as H
+import           Network.HTTP.Types.Status (statusCode)
+import           Network.Wai.Logger        (showSockAddr)
+import           System.Log.FastLogger     (toLogStr)
 
-import Network.Wai                          (Application, Request,
+import Network.Wai
-                                             Response, requestHeaders)
 import Network.Wai.Middleware.Cors          (CorsResourcePolicy (..),
                                              cors)
 import Network.Wai.Middleware.Gzip          (def, gzip)
-import Network.Wai.Middleware.RequestLogger (logStdout)
+import Network.Wai.Middleware.RequestLogger
 import Network.Wai.Middleware.Static        (only, staticPolicy)
 
 import PostgREST.ApiRequest   (ApiRequest (..))
@@ -33,6 +36,7 @@ import PostgREST.QueryBuilder (setLocalQuery, setLocalSearchPathQuery)
 import PostgREST.Types        (LogLevel (..))
 import Protolude              hiding (head, toS)
 import Protolude.Conv         (toS)
+import System.IO.Unsafe       (unsafePerformIO)
 
 -- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
 runPgLocals :: AppConfig   -> M.HashMap Text JSON.Value ->
@@ -57,12 +61,46 @@ runPgLocals conf claims app req = do
     anon = JSON.String . toS $ configAnonRole conf
     preReq = (\f -> "select " <> toS f <> "();") <$> configPreReq conf
 
+-- | Log in apache format. Only requests with a failure status.
+-- | There's no easy way to filter logs in the apache format on https://hackage.haskell.org/package/wai-extra-3.0.29.2/docs/Network-Wai-Middleware-RequestLogger.html#t:OutputFormat.
+-- | So here we copy https://github.com/kazu-yamamoto/logger/blob/a4f51b909a099c51af7a3f75cf16e19a06f9e257/wai-logger/Network/Wai/Logger/Apache.hs#L45
+-- | TODO: Add the ability to filter apache logs on wai-extra and remove this function.
+pgrstFormat :: OutputFormatter
+pgrstFormat date req status responseSize =
+  if statusCode status < 400
+    then toLogStr BS.empty
+  else toLogStr (getSourceFromSocket req)
+    <> " - - ["
+    <> toLogStr date
+    <> "] \""
+    <> toLogStr (requestMethod req)
+    <> " "
+    <> toLogStr (rawPathInfo req <> rawQueryString req)
+    <> " "
+    <> toLogStr (show (httpVersion req)::Text)
+    <> "\" "
+    <> toLogStr (show (statusCode status)::Text)
+    <> " "
+    <> toLogStr (maybe "-" show responseSize::Text)
+    <> " \""
+    <> toLogStr (fromMaybe mempty $ requestHeaderReferer req)
+    <> "\" \""
+    <> toLogStr (fromMaybe mempty $ requestHeaderUserAgent req)
+    <> "\"\n"
+  where
+    getSourceFromSocket = BS.pack . showSockAddr . remoteHost
+
 pgrstMiddleware :: LogLevel -> Application -> Application
-pgrstMiddleware logLev =
+pgrstMiddleware logLevel =
-    (if logLev == LogCrit then id else logStdout)
+    logger
   . gzip def
   . cors corsPolicy
   . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
+  where
+    logger = case logLevel of
+      LogCrit  -> id
+      LogError -> unsafePerformIO $ mkRequestLogger def { outputFormat = CustomOutputFormat pgrstFormat }
+      LogInfo  -> logStdout
 
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing
@@ -84,7 +122,7 @@ corsPolicy req = case lookup "origin" headers of
   where
     headers = requestHeaders req
     accHeaders = case lookup "access-control-request-headers" headers of
-      Just hdrs -> map (CI.mk . toS . strip . toS) $ BS.split ',' hdrs
+      Just hdrs -> map (CI.mk . toS . T.strip . toS) $ BS.split ',' hdrs
       Nothing -> []
 
 unquoted :: JSON.Value -> Text

src/PostgREST/Types.hs

@@ -539,4 +539,4 @@ data ConnectionStatus
   | FatalConnectionError Text
   deriving (Eq, Show)
 
-data LogLevel = LogCrit | LogInfo deriving (Eq, Show)
+data LogLevel = LogCrit | LogError | LogInfo deriving (Eq, Show)