module PostgREST.Unix
  ( runAppWithSocket
  , installSignalHandlers
  ) where

import qualified Network.Socket           as Socket
import qualified Network.Wai.Handler.Warp as Warp
import qualified System.Posix.Signals     as Signals

import Network.Wai        (Application)
import System.Directory   (removeFile)
import System.IO.Error    (isDoesNotExistError)
import System.Posix.Files (setFileMode)
import System.Posix.Types (FileMode)

import qualified PostgREST.AppState as AppState
import qualified PostgREST.Workers  as Workers

import Protolude


-- | Run the PostgREST application with user defined socket.
runAppWithSocket :: Warp.Settings -> Application -> FileMode -> FilePath -> IO ()
runAppWithSocket :: Settings -> Application -> FileMode -> FilePath -> IO ()
runAppWithSocket Settings
settings Application
app FileMode
socketFileMode FilePath
socketFilePath =
  IO Socket -> (Socket -> IO ()) -> (Socket -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Socket
createAndBindSocket Socket -> IO ()
Socket.close ((Socket -> IO ()) -> IO ()) -> (Socket -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Socket
socket -> do
    Socket -> Int -> IO ()
Socket.listen Socket
socket Int
Socket.maxListenQueue
    Settings -> Socket -> Application -> IO ()
Warp.runSettingsSocket Settings
settings Socket
socket Application
app
  where
    createAndBindSocket :: IO Socket
createAndBindSocket = do
      FilePath -> IO ()
deleteSocketFileIfExist FilePath
socketFilePath
      Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
Socket.socket Family
Socket.AF_UNIX SocketType
Socket.Stream ProtocolNumber
Socket.defaultProtocol
      Socket -> SockAddr -> IO ()
Socket.bind Socket
sock (SockAddr -> IO ()) -> SockAddr -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> SockAddr
Socket.SockAddrUnix FilePath
socketFilePath
      FilePath -> FileMode -> IO ()
setFileMode FilePath
socketFilePath FileMode
socketFileMode
      Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

    deleteSocketFileIfExist :: FilePath -> IO ()
deleteSocketFileIfExist FilePath
path =
      FilePath -> IO ()
removeFile FilePath
path IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO ()
forall (m :: * -> *). MonadIO m => IOError -> m ()
handleDoesNotExist

    handleDoesNotExist :: IOError -> m ()
handleDoesNotExist IOError
e
      | IOError -> Bool
isDoesNotExistError IOError
e = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = IOError -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOError
e

-- | Set signal handlers, only for systems with signals
installSignalHandlers :: AppState.AppState -> IO ()
installSignalHandlers :: AppState -> IO ()
installSignalHandlers AppState
appState = do
  -- Releases the connection pool whenever the program is terminated,
  -- see https://github.com/PostgREST/postgrest/issues/268
  ProtocolNumber -> IO () -> IO ()
install ProtocolNumber
Signals.sigINT (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ AppState -> IO ()
AppState.releasePool AppState
appState
  ProtocolNumber -> IO () -> IO ()
install ProtocolNumber
Signals.sigTERM (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ AppState -> IO ()
AppState.releasePool AppState
appState

  -- The SIGUSR1 signal updates the internal 'DbStructure' by running
  -- 'connectionWorker' exactly as before.
  ProtocolNumber -> IO () -> IO ()
install ProtocolNumber
Signals.sigUSR1 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ AppState -> IO ()
Workers.connectionWorker AppState
appState

  -- Re-read the config on SIGUSR2
  ProtocolNumber -> IO () -> IO ()
install ProtocolNumber
Signals.sigUSR2 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> AppState -> IO ()
Workers.reReadConfig Bool
False AppState
appState
  where
    install :: ProtocolNumber -> IO () -> IO ()
install ProtocolNumber
signal IO ()
handler =
      IO Handler -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Handler -> IO ()) -> IO Handler -> IO ()
forall a b. (a -> b) -> a -> b
$ ProtocolNumber -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler ProtocolNumber
signal (IO () -> Handler
Signals.Catch IO ()
handler) Maybe SignalSet
forall a. Maybe a
Nothing