main module of the executable needs to be Main, with PostgREST.Main build fails

This commit is contained in:
Ruslan Talpa
2016-02-29 13:57:34 +02:00
parent 40a30d7b02
commit 0548d65911
4 changed files with 35 additions and 33 deletions
+5 -5
View File
@@ -104,12 +104,13 @@ library
, time , time
, unordered-containers , unordered-containers
, vector , vector
, wai
, wai-cors
, wai-extra
, wai-middleware-static
, HTTP , HTTP
, Ranged-sets , Ranged-sets
, wai >= 3.0.1
, wai-cors
, wai-extra
, wai-middleware-static >= 0.6.0
, warp >= 3.1.0
Other-Modules: Paths_postgrest Other-Modules: Paths_postgrest
Exposed-Modules: PostgREST.App Exposed-Modules: PostgREST.App
@@ -145,7 +146,6 @@ Test-Suite spec
, PostgREST.Auth , PostgREST.Auth
, PostgREST.Config , PostgREST.Config
, PostgREST.Error , PostgREST.Error
, PostgREST.Main
, PostgREST.Middleware , PostgREST.Middleware
, PostgREST.Parsers , PostgREST.Parsers
, PostgREST.DbStructure , PostgREST.DbStructure
+22 -2
View File
@@ -3,7 +3,7 @@
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
--module PostgREST.App where --module PostgREST.App where
module PostgREST.App ( module PostgREST.App (
app handleRequest
) where ) where
import Control.Applicative import Control.Applicative
@@ -17,6 +17,7 @@ import Data.Ranged.Ranges (emptyRange)
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.Text (Text, replace, strip) import Data.Text (Text, replace, strip)
import Data.Tree import Data.Tree
import Data.Time.Clock.POSIX (getPOSIXTime)
import Text.Parsec.Error import Text.Parsec.Error
import Text.ParserCombinators.Parsec (parse) import Text.ParserCombinators.Parsec (parse)
@@ -26,13 +27,18 @@ import Network.HTTP.Types.Header
import Network.HTTP.Types.Status import Network.HTTP.Types.Status
import Network.HTTP.Types.URI (parseSimpleQuery) import Network.HTTP.Types.URI (parseSimpleQuery)
import Network.Wai import Network.Wai
import Network.Wai.Middleware.RequestLogger (logStdout)
import qualified Hasql.Pool as P
import Data.Aeson import Data.Aeson
import Data.Aeson.Types (emptyArray) import Data.Aeson.Types (emptyArray)
import Data.Monoid import Data.Monoid
import qualified Data.Vector as V import qualified Data.Vector as V
import qualified Hasql.Transaction as H import qualified Hasql.Transaction as H
import qualified Hasql.Transaction as HT
import PostgREST.Error (pgErrResponse)
import PostgREST.Middleware
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.Parsers import PostgREST.Parsers
import PostgREST.DbStructure import PostgREST.DbStructure
@@ -58,6 +64,20 @@ import PostgREST.QueryBuilder ( callProc
import Prelude import Prelude
handleRequest :: AppConfig -> DbStructure -> P.Pool -> Application
handleRequest conf dbStructure pool =
let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in
middle $ \ req respond -> do
time <- getPOSIXTime
body <- strictRequestBody req
let handleReq = runWithClaims conf time (app dbStructure conf body) req
resp <- either pgErrResponse id <$> P.use pool
(HT.run handleReq HT.ReadCommitted HT.Write)
respond resp
app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Transaction Response app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Transaction Response
app dbStructure conf reqBody req = app dbStructure conf reqBody req =
let let
+5 -23
View File
@@ -1,31 +1,26 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module PostgREST.Main where module Main where
import PostgREST.App import PostgREST.App (handleRequest)
import PostgREST.Config (AppConfig (..), import PostgREST.Config (AppConfig (..),
minimumPgVersion, minimumPgVersion,
prettyVersion, prettyVersion,
readOptions) readOptions)
import PostgREST.DbStructure import PostgREST.DbStructure
import PostgREST.Error (pgErrResponse)
import PostgREST.Middleware
import PostgREST.Types (DbStructure)
import Control.Monad import Control.Monad
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.Time.Clock.POSIX (getPOSIXTime)
import qualified Hasql.Query as H import qualified Hasql.Query as H
import qualified Hasql.Session as H import qualified Hasql.Session as H
import qualified Hasql.Transaction as HT
import qualified Hasql.Decoders as HD import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE import qualified Hasql.Encoders as HE
import qualified Hasql.Pool as P import qualified Hasql.Pool as P
import Network.Wai
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import Network.Wai.Middleware.RequestLogger (logStdout)
import System.IO (BufferMode (..), import System.IO (BufferMode (..),
hSetBuffering, stderr, hSetBuffering, stderr,
stdin, stdout) stdin, stdout)
@@ -81,17 +76,4 @@ main = do
getDbStructure (cs $ configSchema conf) getDbStructure (cs $ configSchema conf)
let dbStructure = either (error.show) id result let dbStructure = either (error.show) id result
runSettings appSettings $ postgrest conf dbStructure pool runSettings appSettings $ handleRequest conf dbStructure pool
postgrest :: AppConfig -> DbStructure -> P.Pool -> Application
postgrest conf dbStructure pool =
let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in
middle $ \ req respond -> do
time <- getPOSIXTime
body <- strictRequestBody req
let handleReq = runWithClaims conf time (app dbStructure conf body) req
resp <- either pgErrResponse id <$> P.use pool
(HT.run handleReq HT.ReadCommitted HT.Write)
respond resp
+3 -3
View File
@@ -6,7 +6,7 @@ import SpecHelper
import qualified Hasql.Pool as P import qualified Hasql.Pool as P
import PostgREST.DbStructure (getDbStructure) import PostgREST.DbStructure (getDbStructure)
import PostgREST.Main (postgrest) import PostgREST.App (handleRequest)
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import qualified Feature.AuthSpec import qualified Feature.AuthSpec
@@ -27,8 +27,8 @@ main = do
result <- P.use pool $ getDbStructure "test" result <- P.use pool $ getDbStructure "test"
let dbStructure = either (error.show) id result let dbStructure = either (error.show) id result
withApp = return $ postgrest testCfg dbStructure pool withApp = return $ handleRequest testCfg dbStructure pool
ltdApp = return $ postgrest testLtdRowsCfg dbStructure pool ltdApp = return $ handleRequest testLtdRowsCfg dbStructure pool
hspec $ do hspec $ do
mapM_ (beforeAll_ resetDb . before withApp) specs mapM_ (beforeAll_ resetDb . before withApp) specs