crudely split main, split unix functions

PostgREST · Apr 18, 2021 · df6623c · df6623c
1 parent 21b83e1
commit df6623c
Show file tree

Hide file tree

Showing 3 changed files with 58 additions and 55 deletions.
diff --git a/main/Main.hs b/main/Main.hs
@@ -52,8 +52,7 @@ import Protolude.Conv (toS)
 
 
 #ifndef mingw32_HOST_OS
-import System.Posix.Signals
-import UnixSocket
+import PostgREST.Unix
 #endif
 
 
@@ -101,31 +100,21 @@ main = do
     dbConfigReReader startingUp = when configDbConfig $
       reReadConfig startingUp configDbConfig env cliPath appState dbUriFile secretFile
 
-    -- re-reads jwt-secret external file + config file + db config
-    fullConfigReReader =
-      reReadConfig False configDbConfig env cliPath appState
-        dbUriFile =<< -- db-uri external file could be re-read, but it doesn't make sense as db-uri is not reloadable
-        readSecretFile jwtSecret
-
   -- Override the config with config options from the db
   -- TODO: the same operation is repeated on connectionWorker, ideally this
   -- would be done only once, but dump CmdDumpConfig needs it for tests.
   dbConfigReReader True
 
   case cliCommand of
     CmdDumpConfig ->
-      do
-        dumpedConfig <- dumpAppConfig <$> AppState.config appState
-        putStr dumpedConfig
-        exitSuccess
+      putStr =<< dumpAppConfig <$> AppState.config appState
     CmdDumpSchema ->
-      do
-        dumpedSchema <- dumpSchema (AppState.pool appState) =<< AppState.config appState
-        putStrLn dumpedSchema
-        exitSuccess
+      putStrLn =<< dumpSchema (AppState.pool appState) =<< AppState.config appState
     CmdRun ->
-      pass
+      run conf appState jwtSecret dbConfigReReader dbUriFile env cliPath
 
+run :: AppConfig -> AppState -> Maybe ByteString -> (Bool -> IO ()) -> Maybe Text -> Map [Char] Text -> Maybe FilePath -> IO ()
+run AppConfig{..} appState jwtSecret dbConfigReReader dbUriFile env cliPath = do
   mainTid <- myThreadId
 
   let
@@ -135,9 +124,16 @@ main = do
   -- Sets the initial refDbStructure
   connWorker
 
+  let
+    -- re-reads jwt-secret external file + config file + db config
+    fullConfigReReader =
+      reReadConfig False configDbConfig env cliPath appState
+        dbUriFile =<< -- db-uri external file could be re-read, but it doesn't make sense as db-uri is not reloadable
+        readSecretFile jwtSecret
+
 #ifndef mingw32_HOST_OS
   let releasePool = P.release (AppState.pool appState) >> throwTo mainTid UserInterrupt
-  installHandlers $ SignalHandlers fullConfigReReader connWorker releasePool
+  installSignalHandlers $ SignalHandlers fullConfigReReader connWorker releasePool
 #endif
 
   -- reload schema cache + config on NOTIFY
@@ -178,34 +174,6 @@ setBuffering = do
   hSetBuffering stderr NoBuffering
 
 
--- SIGNALS
-
-#ifndef mingw32_HOST_OS
-data SignalHandlers = SignalHandlers
-  { fullConfigReReader :: IO ()
-  , connWorker         :: IO ()
-  , releasePool        :: IO ()
-  }
-
--- | Set signal handlers, only for systems with signals
-installHandlers :: SignalHandlers -> IO ()
-installHandlers SignalHandlers{..} = do
-  -- Releases the connection pool whenever the program is terminated,
-  -- see https://github.com/PostgREST/postgrest/issues/268
-  install sigINT releasePool
-  install sigTERM releasePool
-
-  -- The SIGUSR1 signal updates the internal 'DbStructure' by running
-  -- 'connectionWorker' exactly as before.
-  install sigUSR1 connWorker
-
-  -- Re-read the config on SIGUSR2
-  install sigUSR2 fullConfigReReader
-  where
-    install signal handler = void $ installHandler signal (Catch handler) Nothing
-#endif
-
-
 readEnvironment :: IO Environment
 readEnvironment =
   M.map T.pack . M.fromList . filter (isPrefixOf "PGRST_" . fst) <$> getEnvironment

diff --git a/postgrest.cabal b/postgrest.cabal
@@ -109,6 +109,7 @@ library
                     , wai-extra                 >= 3.0.19 && < 3.2
                     , wai-logger                >= 2.3.2
                     , wai-middleware-static     >= 0.8.1 && < 0.10
+                    , warp                      >= 3.2.12 && < 3.4
                       -- -fno-spec-constr may help keep compile time memory use in check,
                       --   see https://gitlab.haskell.org/ghc/ghc/issues/16017#note_219304
                       -- -optP-Wno-nonportable-include-path
@@ -124,6 +125,14 @@ library
   else
     ghc-options: -O2
 
+  if !os(windows)
+    build-depends:
+      unix
+      , directory >= 1.2.6 && < 1.4
+      , network   >= 2.6 && < 3.2
+    exposed-modules:
+      PostgREST.Unix
+
 executable postgrest
   default-language:   Haskell2010
   default-extensions: OverloadedStrings
@@ -135,13 +144,11 @@ executable postgrest
                     , base64-bytestring   >= 1 && < 1.3
                     , bytestring          >= 0.10.8 && < 0.11
                     , containers          >= 0.5.7 && < 0.7
-                    , directory           >= 1.2.6 && < 1.4
                     , either              >= 4.4.1 && < 5.1
                     , hasql               >= 1.4 && < 1.5
                     , hasql-pool          >= 0.5 && < 0.6
                     , hasql-transaction   >= 0.7.2 && < 1.1
                     , hasql-notifications >= 0.1 && < 0.2
-                    , network             >= 2.6 && < 3.2
                     , postgrest
                     , protolude           >= 0.3 && < 0.4
                     , retry               >= 0.7.4 && < 0.9
@@ -160,10 +167,6 @@ executable postgrest
   else
     ghc-options: -O2
 
-  if !os(windows)
-    build-depends: unix
-    other-modules: UnixSocket
-
 test-suite spec
   type:               exitcode-stdio-1.0
   default-language:   Haskell2010

diff --git a/main/UnixSocket.hs → src/PostgREST/Unix.hs b/main/UnixSocket.hs → src/PostgREST/Unix.hs
@@ -1,6 +1,10 @@
-module UnixSocket (
-  runAppInSocket
-)where
+{-# LANGUAGE RecordWildCards #-}
+
+module PostgREST.Unix
+  ( runAppInSocket
+  , SignalHandlers(..)
+  , installSignalHandlers
+  ) where
 
 import Network.Socket           (Family (AF_UNIX),
                                  SockAddr (SockAddrUnix), Socket,
@@ -14,6 +18,8 @@ import System.IO.Error          (isDoesNotExistError)
 import System.Posix.Files       (setFileMode)
 import System.Posix.Types       (FileMode)
 
+import System.Posix.Signals
+
 import Protolude
 
 createAndBindSocket :: FilePath -> FileMode -> IO Socket
@@ -38,3 +44,29 @@ runAppInSocket settings app socketFileMode sockPath = do
   runSettingsSocket settings sock app
   -- clean socket up when done
   close sock
+
+
+-- SIGNALS
+
+data SignalHandlers = SignalHandlers
+  { fullConfigReReader :: IO ()
+  , connWorker         :: IO ()
+  , releasePool        :: IO ()
+  }
+
+-- | Set signal handlers, only for systems with signals
+installSignalHandlers :: SignalHandlers -> IO ()
+installSignalHandlers SignalHandlers{..} = do
+  -- Releases the connection pool whenever the program is terminated,
+  -- see https://github.com/PostgREST/postgrest/issues/268
+  install sigINT releasePool
+  install sigTERM releasePool
+
+  -- The SIGUSR1 signal updates the internal 'DbStructure' by running
+  -- 'connectionWorker' exactly as before.
+  install sigUSR1 connWorker
+
+  -- Re-read the config on SIGUSR2
+  install sigUSR2 fullConfigReReader
+  where
+    install signal handler = void $ installHandler signal (Catch handler) Nothing