{-|
Module      : PostgREST.Logger
Description : Wai Middleware to log requests to stdout.
-}
module PostgREST.Logger (middleware) where

import qualified Network.Wai                          as Wai
import qualified Network.Wai.Middleware.RequestLogger as Wai

import Network.HTTP.Types.Status (status400, status500)
import System.IO.Unsafe          (unsafePerformIO)

import PostgREST.Config (LogLevel (..))

import Protolude

middleware :: LogLevel -> Wai.Middleware
middleware :: LogLevel -> Middleware
middleware LogLevel
logLevel = case LogLevel
logLevel of
  LogLevel
LogInfo  -> (Status -> Bool) -> Middleware
requestLogger (Bool -> Status -> Bool
forall a b. a -> b -> a
const Bool
True)
  LogLevel
LogWarn  -> (Status -> Bool) -> Middleware
requestLogger (Status -> Status -> Bool
forall a. Ord a => a -> a -> Bool
>= Status
status400)
  LogLevel
LogError -> (Status -> Bool) -> Middleware
requestLogger (Status -> Status -> Bool
forall a. Ord a => a -> a -> Bool
>= Status
status500)
  LogLevel
LogCrit  -> (Status -> Bool) -> Middleware
requestLogger (Bool -> Status -> Bool
forall a b. a -> b -> a
const Bool
False)
  where
    requestLogger :: (Status -> Bool) -> Middleware
requestLogger Status -> Bool
filterStatus = IO Middleware -> Middleware
forall a. IO a -> a
unsafePerformIO (IO Middleware -> Middleware) -> IO Middleware -> Middleware
forall a b. (a -> b) -> a -> b
$ RequestLoggerSettings -> IO Middleware
Wai.mkRequestLogger RequestLoggerSettings
Wai.defaultRequestLoggerSettings
      { outputFormat :: OutputFormat
Wai.outputFormat = ApacheSettings -> OutputFormat
Wai.ApacheWithSettings (ApacheSettings -> OutputFormat) -> ApacheSettings -> OutputFormat
forall a b. (a -> b) -> a -> b
$
          ApacheSettings
Wai.defaultApacheSettings
            ApacheSettings
-> (ApacheSettings -> ApacheSettings) -> ApacheSettings
forall a b. a -> (a -> b) -> b
& (Request -> Response -> Bool) -> ApacheSettings -> ApacheSettings
Wai.setApacheRequestFilter (\Request
_ Response
res -> Status -> Bool
filterStatus (Status -> Bool) -> Status -> Bool
forall a b. (a -> b) -> a -> b
$ Response -> Status
Wai.responseStatus Response
res)
      }