-
-
Notifications
You must be signed in to change notification settings - Fork 999
/
Logger.hs
59 lines (47 loc) · 1.9 KB
/
Logger.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
{-|
Module : PostgREST.Logger
Description : Wai Middleware to log requests to stdout.
-}
module PostgREST.Logger
( middleware
, logObservation
, init
) where
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
updateAction)
import Data.Time (ZonedTime, defaultTimeLocale, formatTime,
getZonedTime)
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 PostgREST.Observation
import qualified PostgREST.Auth as Auth
import Protolude
newtype LoggerState = LoggerState
{ stateGetZTime :: IO ZonedTime -- ^ Time with time zone used for logs
}
init :: IO LoggerState
init = do
zTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
pure $ LoggerState zTime
middleware :: LogLevel -> Wai.Middleware
middleware logLevel = case logLevel of
LogInfo -> requestLogger (const True)
LogWarn -> requestLogger (>= status400)
LogError -> requestLogger (>= status500)
LogCrit -> requestLogger (const False)
where
requestLogger filterStatus = unsafePerformIO $ Wai.mkRequestLogger Wai.defaultRequestLoggerSettings
{ Wai.outputFormat = Wai.ApacheWithSettings $
Wai.defaultApacheSettings
& Wai.setApacheRequestFilter (\_ res -> filterStatus $ Wai.responseStatus res)
& Wai.setApacheUserGetter Auth.getRole
}
logObservation :: LoggerState -> Observation -> IO ()
logObservation loggerState obs = logWithZTime loggerState $ observationMessage obs
logWithZTime :: LoggerState -> Text -> IO ()
logWithZTime loggerState txt = do
zTime <- stateGetZTime loggerState
hPutStrLn stderr $ toS (formatTime defaultTimeLocale "%d/%b/%Y:%T %z: " zTime) <> txt