This commit is contained in:
Ruslan Talpa
2016-03-01 17:54:55 +02:00
6 changed files with 77 additions and 73 deletions
+2
View File
@@ -9,7 +9,9 @@ dependencies:
- createdb -O postgrest_test -U ubuntu postgrest_test - createdb -O postgrest_test -U ubuntu postgrest_test
override: override:
- stack setup - stack setup
- rm -fr $(stack path --dist-dir) $(stack path --local-install-root)
- stack install hlint packdeps cabal-install - stack install hlint packdeps cabal-install
- stack build
- stack build --test --no-run-tests - stack build --test --no-run-tests
test: test:
+2 -1
View File
@@ -26,7 +26,7 @@ executable postgrest
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010 default-language: Haskell2010
build-depends: aeson >= 0.8 && < 0.10 build-depends: aeson (>= 0.8 && < 0.10) || (>= 0.11 && < 0.12)
, base >= 4.8 && < 5 , base >= 4.8 && < 5
, bytestring , bytestring
, case-insensitive , case-insensitive
@@ -139,6 +139,7 @@ Test-Suite spec
, Feature.DeleteSpec , Feature.DeleteSpec
, Feature.InsertSpec , Feature.InsertSpec
, Feature.QuerySpec , Feature.QuerySpec
, Feature.QueryLimitedSpec
, Feature.RangeSpec , Feature.RangeSpec
, Feature.StructureSpec , Feature.StructureSpec
, Paths_postgrest , Paths_postgrest
+45 -45
View File
@@ -1,70 +1,71 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
--module PostgREST.App where
module PostgREST.App ( module PostgREST.App (
handleRequest postgrest
) where ) where
import Control.Applicative import Control.Applicative
import Control.Arrow ((***)) import Control.Arrow ((***))
import Control.Monad (join) import Control.Monad (join)
import Data.Bifunctor (first) import Data.Bifunctor (first)
import Data.List (delete, find, sortBy) import Data.List (find, sortBy, delete)
import Data.Maybe (fromJust, fromMaybe, import Data.Maybe (isJust, fromMaybe, fromJust, mapMaybe)
isJust, mapMaybe) import Data.Ord (comparing)
import Data.Ord (comparing) import Data.Ranged.Ranges (emptyRange)
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.Time.Clock.POSIX (getPOSIXTime)
import Data.Tree import Data.Tree
import Text.Parsec.Error import qualified Hasql.Pool as P
import Text.ParserCombinators.Parsec (parse) import qualified Hasql.Transaction as HT
import Network.HTTP.Base (urlEncodeVars) import Text.Parsec.Error
import Text.ParserCombinators.Parsec (parse)
import Network.HTTP.Base (urlEncodeVars)
import Network.HTTP.Types.Header 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 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 Data.Time.Clock.POSIX (getPOSIXTime)
import qualified Hasql.Transaction as H import qualified Data.Vector as V
import qualified Hasql.Transaction as HT import qualified Hasql.Transaction as H
import PostgREST.ApiRequest (Action (..),
ApiRequest (..), import PostgREST.ApiRequest (ApiRequest(..), ContentType(..)
ContentType (..), PreferRepresentation (..), , Action(..), Target(..)
Target (..), , PreferRepresentation (..)
userApiRequest) , userApiRequest)
import PostgREST.Auth (tokenJWT) import PostgREST.Auth (tokenJWT)
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.DbStructure import PostgREST.DbStructure
import PostgREST.Error (errResponse, import PostgREST.Error (errResponse, pgErrResponse)
pgErrResponse)
import PostgREST.Middleware
import PostgREST.Parsers import PostgREST.Parsers
import PostgREST.RangeQuery import PostgREST.RangeQuery
import PostgREST.Middleware
import PostgREST.QueryBuilder ( callProc
, addJoinConditions
, sourceCTEName
, requestToQuery
, requestToCountQuery
, addRelations
, createReadStatement
, createWriteStatement
, ResultsWithCount
)
import PostgREST.Types import PostgREST.Types
import PostgREST.QueryBuilder (ResultsWithCount,
addJoinConditions,
addRelations, callProc,
createReadStatement,
createWriteStatement,
requestToCountQuery,
requestToQuery,
sourceCTEName)
import Prelude import Prelude
handleRequest :: AppConfig -> DbStructure -> P.Pool -> Application
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 let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in
middle $ \ req respond -> do middle $ \ req respond -> do
@@ -76,7 +77,6 @@ handleRequest conf dbStructure pool =
(HT.run handleReq HT.ReadCommitted HT.Write) (HT.run handleReq HT.ReadCommitted HT.Write)
respond resp 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
+19 -18
View File
@@ -3,29 +3,30 @@
module Main where module Main where
import PostgREST.App (handleRequest) import PostgREST.App
import PostgREST.Config (AppConfig (..), minimumPgVersion, import PostgREST.Config (AppConfig (..),
prettyVersion, readOptions) minimumPgVersion,
prettyVersion,
readOptions)
import PostgREST.DbStructure import PostgREST.DbStructure
import Control.Monad import Control.Monad
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import qualified Hasql.Query as H
import qualified Hasql.Decoders as HD import qualified Hasql.Session as H
import qualified Hasql.Encoders as HE import qualified Hasql.Decoders as HD
import qualified Hasql.Pool as P import qualified Hasql.Encoders as HE
import qualified Hasql.Query as H import qualified Hasql.Pool as P
import qualified Hasql.Session as H
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import System.IO (BufferMode (..),
import System.IO (BufferMode (..), hSetBuffering, hSetBuffering, stderr,
stderr, stdin, stdout) stdin, stdout)
import Web.JWT (secret) import Web.JWT (secret)
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
import Control.Concurrent (myThreadId)
import Control.Exception.Base (AsyncException (..), throwTo)
import System.Posix.Signals import System.Posix.Signals
import Control.Concurrent (myThreadId)
import Control.Exception.Base (throwTo, AsyncException(..))
#endif #endif
isServerVersionSupported :: H.Session Bool isServerVersionSupported :: H.Session Bool
@@ -73,4 +74,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 $ handleRequest conf dbStructure pool runSettings appSettings $ postgrest conf dbStructure pool
+1 -1
View File
@@ -1,4 +1,4 @@
resolver: lts-5.0 resolver: lts-5.5
extra-deps: extra-deps:
- Ranged-sets-0.3.0 - Ranged-sets-0.3.0
- bytestring-tree-builder-0.2.5 - bytestring-tree-builder-0.2.5
+8 -8
View File
@@ -1,13 +1,13 @@
module Main where module Main where
import SpecHelper import Test.Hspec
import Test.Hspec import SpecHelper
import qualified Hasql.Pool as P import qualified Hasql.Pool as P
import Data.String.Conversions (cs) import PostgREST.DbStructure (getDbStructure)
import PostgREST.App (handleRequest) import PostgREST.App (postgrest)
import PostgREST.DbStructure (getDbStructure) import Data.String.Conversions (cs)
import qualified Feature.AuthSpec import qualified Feature.AuthSpec
import qualified Feature.ConcurrentSpec import qualified Feature.ConcurrentSpec
@@ -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 $ handleRequest testCfg dbStructure pool withApp = return $ postgrest testCfg dbStructure pool
ltdApp = return $ handleRequest testLtdRowsCfg dbStructure pool ltdApp = return $ postgrest testLtdRowsCfg dbStructure pool
hspec $ do hspec $ do
mapM_ (beforeAll_ resetDb . before withApp) specs mapM_ (beforeAll_ resetDb . before withApp) specs