Reload schema definition on SIGHUP (#570)

src/PostgREST/App.hs

@@ -8,6 +8,7 @@ module PostgREST.App (
 
 import           Control.Applicative
 import           Data.Bifunctor            (first)
+import           Data.IORef                (IORef, readIORef)
 import           Data.List                 (find, delete)
 import           Data.Maybe                (isJust, fromMaybe, fromJust, mapMaybe)
 import           Data.Ranged.Ranges        (emptyRange)
@@ -59,13 +60,14 @@ import           PostgREST.Types
 import           Prelude
 
 
-postgrest :: AppConfig -> DbStructure -> P.Pool -> Application
-postgrest conf dbStructure pool =
+postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> Application
+postgrest conf refDbStructure pool =
   let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in
 
   middle $ \ req respond -> do
     time <- getPOSIXTime
     body <- strictRequestBody req
+    dbStructure <- readIORef refDbStructure
 
     let schema = cs $ configSchema conf
         apiRequest = userApiRequest schema req body

src/PostgREST/Main.hs

@@ -11,6 +11,7 @@ import           PostgREST.Config                     (AppConfig (..),
 import           PostgREST.DbStructure
 
 import           Control.Monad
+import           Control.Monad.IO.Class               (liftIO)
 import           Data.Monoid                          ((<>))
 import           Data.String.Conversions              (cs)
 import qualified Hasql.Query                          as H
@@ -26,6 +27,7 @@ import           Web.JWT                              (secret)
 #ifndef mingw32_HOST_OS
 import           System.Posix.Signals
 import           Control.Concurrent                   (myThreadId)
+import           Data.IORef
 import           Control.Exception.Base               (throwTo, AsyncException(..))
 #endif
 
@@ -58,15 +60,6 @@ main = do
 
   pool <- P.acquire (configPool conf, 10, pgSettings)
 
-#ifndef mingw32_HOST_OS
-  tid <- myThreadId
-  forM_ [sigINT, sigTERM] $ \sig ->
-    void $ installHandler sig (Catch $ do
-        P.release pool
-        throwTo tid UserInterrupt
-      ) Nothing
-#endif
-
   result <- P.use pool $ do
     supported <- isServerVersionSupported
     unless supported $ error (
@@ -74,5 +67,21 @@ main = do
       <> show minimumPgVersion)
     getDbStructure (cs $ configSchema conf)
 
-  let dbStructure = either (error.show) id result
-  runSettings appSettings $ postgrest conf dbStructure pool
+  refDbStructure <- newIORef $ either (error.show) id result
+
+#ifndef mingw32_HOST_OS
+  tid <- myThreadId
+  forM_ [sigINT, sigTERM] $ \sig ->
+    void $ installHandler sig (Catch $ do
+        P.release pool
+        throwTo tid UserInterrupt
+      ) Nothing
+
+  void $ installHandler sigHUP (
+      Catch . void . P.use pool $ do
+        s <- getDbStructure (cs $ configSchema conf)
+        liftIO $ atomicWriteIORef refDbStructure s
+   ) Nothing
+#endif
+
+  runSettings appSettings $ postgrest conf refDbStructure pool