diff --git a/postgrest.cabal b/postgrest.cabal index af08f499e..55d5fcc68 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -37,6 +37,7 @@ executable postgrest , case-insensitive , scientific, time , aeson >= 0.8, network >= 2.6 + , aeson-pretty >= 0.7 && < 0.8 , bytestring, text, split, string-conversions , stringsearch , containers, unordered-containers diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs index 180bde91a..565eef737 100644 --- a/src/PostgREST/Main.hs +++ b/src/PostgREST/Main.hs @@ -1,39 +1,41 @@ module Main where +import PostgREST.App +import PostgREST.Config (AppConfig (..), + minimumPgVersion, + prettyVersion, + readOptions) +import PostgREST.Error (errResponse, PgError) +import PostgREST.Middleware import PostgREST.PgStructure import PostgREST.Types -import Network.Wai - -import PostgREST.App -import PostgREST.Error (errResponse) -import PostgREST.Middleware import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) +import Data.Aeson.Encode.Pretty (encodePretty) import Data.Functor.Identity import Data.Monoid ((<>)) import Data.String.Conversions (cs) import Data.Text (Text) import qualified Hasql as H import qualified Hasql.Postgres as P +import Network.Wai import Network.Wai.Handler.Warp hiding (Connection) import Network.Wai.Middleware.RequestLogger (logStdout) - import System.IO (BufferMode (..), hSetBuffering, stderr, stdin, stdout) -import PostgREST.Config (AppConfig (..), - prettyVersion, - readOptions, - minimumPgVersion) isServerVersionSupported :: H.Session P.Postgres IO Bool isServerVersionSupported = do Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|] return $ read (cs row) >= minimumPgVersion +hasqlError :: PgError -> IO a +hasqlError = error . cs . encodePretty + main :: IO () main = do hSetBuffering stdout LineBuffering @@ -61,15 +63,17 @@ main = do pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings supportedOrError <- H.session pool isServerVersionSupported - either (fail . show) + either hasqlError (\supported -> unless supported $ - fail "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0" + error "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0" ) supportedOrError - Right authenticator <- H.session pool $ do - Identity (role :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SELECT SESSION_USER|] + roleOrError <- H.session pool $ do + Identity (role :: Text) <- H.tx Nothing $ H.singleEx + [H.stmt|SELECT SESSION_USER|] return role + authenticator <- either hasqlError return roleOrError let txSettings = Just (H.ReadCommitted, Just True) metadata <- H.session pool $ H.tx txSettings $ do @@ -79,15 +83,15 @@ main = do keys <- allPrimaryKeys return (tabs, rels, cols, keys) - dbstructure <- case metadata of - Left e -> fail $ show e - Right (tabs, rels, cols, keys) -> + dbstructure <- either hasqlError + (\(tabs, rels, cols, keys) -> return DbStructure { tables=tabs , columns=cols , relations=rels , primaryKeys=keys } + ) metadata runSettings appSettings $ middle $ \ req respond -> do body <- strictRequestBody req