move log middleware out of App.hs

PostgREST · Jan 31, 2021 · a6ba878 · a6ba878
1 parent 1e6c272
commit a6ba878
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 20 deletions.
diff --git a/main/Main.hs b/main/Main.hs
@@ -35,6 +35,7 @@ import PostgREST.Config
 import PostgREST.DbStructure (getDbStructure, getPgVersion)
 import PostgREST.Error       (PgError (PgError), checkIsFatal,
                               errorPayload)
+import PostgREST.Middleware  (pgrstMiddleware)
 import PostgREST.Statements  (dbSettingsStatement)
 import PostgREST.Types       (ConnectionStatus (..), DbStructure,
                               PgVersion (..), SCacheStatus (..),
@@ -160,9 +161,10 @@ main = do
   -- ask for the OS time at most once per second
   getTime <- mkAutoUpdate defaultUpdateSettings {updateAction = getCurrentTime}
 
-  let postgrestApplication =
+  let
+    postgrestApplication =
+      pgrstMiddleware logLevel $
         postgrest
-          logLevel
           refConf
           refDbStructure
           pool

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
@@ -66,33 +66,30 @@ type DbHandler = Handler SQL.Transaction
 
 -- | PostgREST application
 postgrest
-  :: Types.LogLevel
-  -> IORef AppConfig
+  :: IORef AppConfig
   -> IORef (Maybe DbStructure)
   -> SQL.Pool
   -> IO UTCTime
   -> IO () -- ^ Lauch connection worker in a separate thread
   -> Wai.Application
-postgrest logLev refConf refDbStructure pool getTime connWorker =
-  Middleware.pgrstMiddleware logLev $
-    \req respond -> do
-      time <- getTime
-      conf <- readIORef refConf
-      maybeDbStructure <- readIORef refDbStructure
+postgrest refConf refDbStructure pool getTime connWorker req respond = do
+  time <- getTime
+  conf <- readIORef refConf
+  maybeDbStructure <- readIORef refDbStructure
 
-      let
-        eitherResponse :: IO (Either Error Wai.Response)
-        eitherResponse =
-          runExceptT $ postgrestResponse conf maybeDbStructure pool time req
+  let
+    eitherResponse :: IO (Either Error Wai.Response)
+    eitherResponse =
+      runExceptT $ postgrestResponse conf maybeDbStructure pool time req
 
-      response <- either Error.errorResponseFor identity <$> eitherResponse
+  response <- either Error.errorResponseFor identity <$> eitherResponse
 
-      -- Launch the connWorker when the connection is down.  The postgrest
-      -- function can respond successfully (with a stale schema cache) before
-      -- the connWorker is done.
-      when (Wai.responseStatus response == HTTP.status503) connWorker
+  -- Launch the connWorker when the connection is down.  The postgrest
+  -- function can respond successfully (with a stale schema cache) before
+  -- the connWorker is done.
+  when (Wai.responseStatus response == HTTP.status503) connWorker
 
-      respond response
+  respond response
 
 postgrestResponse
   :: AppConfig