105 lines
3.9 KiB
Haskell
105 lines
3.9 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
|
|
module Main where
|
|
|
|
|
|
import PostgREST.App
|
|
import PostgREST.Config (AppConfig (..),
|
|
minimumPgVersion,
|
|
prettyVersion,
|
|
readOptions)
|
|
import PostgREST.DbStructure
|
|
import PostgREST.Error (errResponse, pgErrResponse)
|
|
import PostgREST.Middleware
|
|
import PostgREST.QueryBuilder (inTransaction, Isolation(..))
|
|
|
|
import Control.Monad (unless, void)
|
|
import Data.Monoid ((<>))
|
|
import Data.Pool
|
|
import Data.String.Conversions (cs)
|
|
import Data.Time.Clock.POSIX (getPOSIXTime)
|
|
import qualified Hasql.Query as H
|
|
import qualified Hasql.Connection as H
|
|
import qualified Hasql.Session as H
|
|
import qualified Hasql.Decoders as HD
|
|
import qualified Hasql.Encoders as HE
|
|
import qualified Network.HTTP.Types.Status as HT
|
|
import Network.Wai
|
|
import Network.Wai.Handler.Warp
|
|
import Network.Wai.Middleware.RequestLogger (logStdout)
|
|
import System.IO (BufferMode (..),
|
|
hSetBuffering, stderr,
|
|
stdin, stdout)
|
|
import Web.JWT (secret)
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
import System.Posix.Signals
|
|
import Control.Concurrent (myThreadId)
|
|
import Control.Exception.Base (throwTo, AsyncException(..))
|
|
#endif
|
|
|
|
isServerVersionSupported :: H.Session Bool
|
|
isServerVersionSupported = do
|
|
ver <- H.query () pgVersion
|
|
return $ read (cs ver) >= minimumPgVersion
|
|
where
|
|
pgVersion =
|
|
H.statement "SHOW server_version_num"
|
|
HE.unit (HD.singleRow $ HD.value HD.text) True
|
|
|
|
main :: IO ()
|
|
main = do
|
|
hSetBuffering stdout LineBuffering
|
|
hSetBuffering stdin LineBuffering
|
|
hSetBuffering stderr NoBuffering
|
|
|
|
conf <- readOptions
|
|
let port = configPort conf
|
|
|
|
unless (secret "secret" /= configJwtSecret conf) $
|
|
putStrLn "WARNING, running in insecure mode, JWT secret is the default value"
|
|
Prelude.putStrLn $ "Listening on port " ++
|
|
(show $ configPort conf :: String)
|
|
|
|
let pgSettings = cs (configDatabase conf)
|
|
appSettings = setPort port
|
|
. setServerName (cs $ "postgrest/" <> prettyVersion)
|
|
$ defaultSettings
|
|
middle = logStdout . defaultMiddle
|
|
|
|
pool <- createPool (H.acquire pgSettings)
|
|
(either (const $ return ()) H.release) 1 1 (configPool conf)
|
|
|
|
dbStructure <- withResource pool $ \case
|
|
Left err -> error $ show err
|
|
Right c -> do
|
|
supported <- H.run isServerVersionSupported c
|
|
case supported of
|
|
Left e -> error $ show e
|
|
Right good -> unless good $
|
|
error (
|
|
"Cannot run in this PostgreSQL version, PostgREST needs at least "
|
|
<> show minimumPgVersion)
|
|
|
|
dbOrError <- H.run (getDbStructure (cs $ configSchema conf)) c
|
|
either (error . show) return dbOrError
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
tid <- myThreadId
|
|
void $ installHandler keyboardSignal (Catch $ do
|
|
destroyAllResources pool
|
|
throwTo tid UserInterrupt
|
|
) Nothing
|
|
#endif
|
|
|
|
runSettings appSettings $ middle $ \ req respond -> do
|
|
time <- getPOSIXTime
|
|
body <- strictRequestBody req
|
|
let handleReq = H.run $ inTransaction ReadCommitted
|
|
(runWithClaims conf time (app dbStructure conf body) req)
|
|
withResource pool $ \case
|
|
Left err -> respond $ errResponse HT.status500 (cs . show $ err)
|
|
Right c -> do
|
|
resOrError <- handleReq c
|
|
either (respond . pgErrResponse) respond resOrError
|