jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add basic ARCHITECTURE.md (#2503)

Browse Source 
* refactor: move ApiRequest a top-level module
* refactor: rename DbStructure to SchemaCache
* refactor: GucHeader inside Response
* refactor: admin app to Workers
This commit is contained in:
Steve Chavez
2022-10-10 11:24:45 -05:00
committed by GitHub
parent e4b98d51be
commit 0fbb116dd2
35 changed files with 451 additions and 385 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ARCHITECTURE.md
+70
View File
@@ -0,0 +1,70 @@
# Architecture
This document describes the high-level architecture of PostgREST.
## Bird's Eye View
```haskell
postgrest :: Request -> Either Error SQLStatement -> Response
```
On the highest level, PostgREST processes an HTTP request, if it's accepted it builds a SQL statement for it, executes it, and produces a response.
## Code Map
This section talks briefly about various important modules.
The starting point of the program is `main/Main.hs`, which calls `src/PostgREST/CLI.hs` which then calls `src/PostgREST/App.hs`.
`App.hs` is then in charge of composing the different modules.
### ApiRequest.hs
PostgREST operates over two types of resources: database relations(tables or views) and database functions; providing different representations(depending on the media type)
for them.
This module is in charge of representing the operation over an `ApiRequest` type. It parses the URL querystring following PostgREST syntax, the request headers, and the request body
(if possible it avoids parsing the body and sends it directly to the db).
A request might be rejected at this level if it's invalid, e.g. providing an unknown media type to PostgREST or using an unknown HTTP method.
### Plan.hs
Using the Schema Cache, this module enables more complex functionality(like resource embedding) by enriching the ApiRequest. It generates Plan types(`ReadPlan`, `MutatePlan`)
that then will be used to generate a SQL statement.
A request might be rejected at this level if it's invalid, e.g. by doing resource embedding on a nonexistent resource.
An OPTIONS request doesn't require a plan to be generated.
### Query.hs
This module constructs single SQL statements that can be parametrized and prepared. Only at this stage a PostgreSQL connection from the pool is used.
A query might fail(and be rollbacked) at this level if it doesn't comply to certain conditions, e.g. by not returning a single row when a ``Accept: application/vnd.pgrst.object`` header is specified.
An OPTIONS request doesn't require a query to be executed.
### Response.hs
This module constructs the HTTP response body with the right headers.
It builds the OpenAPI response using the schema cache.
### Auth.hs
This module provides functions to deal with JWT authorization.
### Workers.hs
This spawns threads which are used to execute concurrent jobs.
Jobs include connection recovery, a listener for the PostgreSQL LISTEN command, and an admin server.
### SchemaCache.hs
This queries the PostgreSQL system catalogs and caches the metadata into a SchemaCache type,
### AppState.hs
The state of the App which is kept across requests.
nix/tools/tests.nix
+1 -1
View File
@@ -105,7 +105,7 @@ let
checkedShellScript checkedShellScript
{ {
name = "postgrest-dump-schema"; name = "postgrest-dump-schema";
docs = "Dump the loaded schema's DbStructure as a yaml file."; docs = "Dump the loaded schema's SchemaCache as a yaml file.";
inRootDir = true; inRootDir = true;
withEnv = postgrest.env; withEnv = postgrest.env;
withPath = [ jq ]; withPath = [ jq ];
postgrest.cabal
+10 -11
View File
@@ -35,7 +35,6 @@ library
NoImplicitPrelude NoImplicitPrelude
hs-source-dirs: src hs-source-dirs: src
exposed-modules: PostgREST.App exposed-modules: PostgREST.App
PostgREST.Admin
PostgREST.AppState PostgREST.AppState
PostgREST.Auth PostgREST.Auth
PostgREST.CLI PostgREST.CLI
@@ -45,13 +44,12 @@ library
PostgREST.Config.PgVersion PostgREST.Config.PgVersion
PostgREST.Config.Proxy PostgREST.Config.Proxy
PostgREST.Cors PostgREST.Cors
PostgREST.DbStructure PostgREST.SchemaCache
PostgREST.DbStructure.Identifiers PostgREST.SchemaCache.Identifiers
PostgREST.DbStructure.Proc PostgREST.SchemaCache.Proc
PostgREST.DbStructure.Relationship PostgREST.SchemaCache.Relationship
PostgREST.DbStructure.Table PostgREST.SchemaCache.Table
PostgREST.Error PostgREST.Error
PostgREST.GucHeader
PostgREST.Logger PostgREST.Logger
PostgREST.MediaType PostgREST.MediaType
PostgREST.Query PostgREST.Query
@@ -63,12 +61,13 @@ library
PostgREST.Plan.MutatePlan PostgREST.Plan.MutatePlan
PostgREST.Plan.ReadPlan PostgREST.Plan.ReadPlan
PostgREST.RangeQuery PostgREST.RangeQuery
PostgREST.Request.ApiRequest PostgREST.ApiRequest
PostgREST.Request.Preferences PostgREST.ApiRequest.Preferences
PostgREST.Request.QueryParams PostgREST.ApiRequest.QueryParams
PostgREST.Request.Types PostgREST.ApiRequest.Types
PostgREST.Response PostgREST.Response
PostgREST.Response.OpenAPI PostgREST.Response.OpenAPI
PostgREST.Response.GucHeader
PostgREST.Version PostgREST.Version
PostgREST.Workers PostgREST.Workers
other-modules: Paths_postgrest other-modules: Paths_postgrest
src/PostgREST/Admin.hs
-74
View File
@@ -1,74 +0,0 @@
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Admin
( postgrestAdmin
) where
import qualified Data.Text as T
import Network.Socket
import Network.Socket.ByteString
import qualified Network.HTTP.Types.Status as HTTP
import qualified Network.Wai as Wai
import qualified Hasql.Session as SQL
import qualified PostgREST.AppState as AppState
import PostgREST.Config (AppConfig (..))
import Protolude
-- | PostgREST admin application
postgrestAdmin :: AppState.AppState -> AppConfig -> Wai.Application
postgrestAdmin appState appConfig req respond = do
isMainAppReachable <- any isRight <$> reachMainApp appConfig
isSchemaCacheLoaded <- isJust <$> AppState.getDbStructure appState
isConnectionUp <-
if configDbChannelEnabled appConfig
then AppState.getIsListenerOn appState
else isRight <$> AppState.usePool appState (SQL.sql "SELECT 1")
case Wai.pathInfo req of
["ready"] ->
respond $ Wai.responseLBS (if isMainAppReachable && isConnectionUp && isSchemaCacheLoaded then HTTP.status200 else HTTP.status503) [] mempty
["live"] ->
respond $ Wai.responseLBS (if isMainAppReachable then HTTP.status200 else HTTP.status503) [] mempty
_ ->
respond $ Wai.responseLBS HTTP.status404 [] mempty
-- Try to connect to the main app socket
-- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections
-- The code for resolving the "*4", "!4", "*6", "!6", "*" special values is taken from
-- https://hackage.haskell.org/package/streaming-commons-0.2.2.4/docs/src/Data.Streaming.Network.html#bindPortGenEx
reachMainApp :: AppConfig -> IO [Either IOException ()]
reachMainApp AppConfig{..} =
case configServerUnixSocket of
Just path -> do
sock <- socket AF_UNIX Stream 0
(:[]) <$> try (do
connect sock $ SockAddrUnix path
withSocketsDo $ bracket (pure sock) close sendEmpty)
Nothing -> do
let
host | configServerHost `elem` ["*4", "!4", "*6", "!6", "*"] = Nothing
| otherwise = Just configServerHost
filterAddrs xs =
case configServerHost of
"*4" -> ipv4Addrs xs ++ ipv6Addrs xs
"!4" -> ipv4Addrs xs
"*6" -> ipv6Addrs xs ++ ipv4Addrs xs
"!6" -> ipv6Addrs xs
_ -> xs
ipv4Addrs = filter ((/=) AF_INET6 . addrFamily)
ipv6Addrs = filter ((==) AF_INET6 . addrFamily)
addrs <- getAddrInfo (Just $ defaultHints { addrSocketType = Stream }) (T.unpack <$> host) (Just . show $ configServerPort)
tryAddr `traverse` filterAddrs addrs
where
sendEmpty sock = void $ send sock mempty
tryAddr :: AddrInfo -> IO (Either IOException ())
tryAddr addr = do
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
try $ do
connect sock $ addrAddress addr
withSocketsDo $ bracket (pure sock) close sendEmpty
src/PostgREST/Request/ApiRequest.hs → src/PostgREST/ApiRequest.hs
+25 -25
View File
@@ -6,7 +6,7 @@ Description : PostgREST functions to translate HTTP request to a domain type cal
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
module PostgREST.Request.ApiRequest module PostgREST.ApiRequest
( ApiRequest(..) ( ApiRequest(..)
, InvokeMethod(..) , InvokeMethod(..)
, Mutation(..) , Mutation(..)
@@ -44,15 +44,16 @@ import Network.Wai (Request (..))
import Network.Wai.Parse (parseHttpAccept) import Network.Wai.Parse (parseHttpAccept)
import Web.Cookie (parseCookies) import Web.Cookie (parseCookies)
import PostgREST.ApiRequest.Preferences (PreferCount (..),
PreferParameters (..),
PreferRepresentation (..),
PreferResolution (..),
PreferTransaction (..))
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
import PostgREST.ApiRequest.Types (ApiRequestError (..),
RangeError (..), SelectItem)
import PostgREST.Config (AppConfig (..), import PostgREST.Config (AppConfig (..),
OpenAPIMode (..)) OpenAPIMode (..))
import PostgREST.DbStructure (DbStructure (..))
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema)
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcParam (..), ProcsMap,
procReturnsScalar)
import PostgREST.MediaType (MTPlanAttrs (..), import PostgREST.MediaType (MTPlanAttrs (..),
MTPlanFormat (..), MTPlanFormat (..),
MediaType (..)) MediaType (..))
@@ -60,18 +61,17 @@ import PostgREST.RangeQuery (NonnegRange, allRange,
hasLimitZero, hasLimitZero,
limitZeroRange, limitZeroRange,
rangeRequested) rangeRequested)
import PostgREST.Request.Preferences (PreferCount (..), import PostgREST.SchemaCache (SchemaCache (..))
PreferParameters (..), import PostgREST.SchemaCache.Identifiers (FieldName,
PreferRepresentation (..), QualifiedIdentifier (..),
PreferResolution (..), Schema)
PreferTransaction (..)) import PostgREST.SchemaCache.Proc (ProcDescription (..),
import PostgREST.Request.QueryParams (QueryParams (..)) ProcParam (..), ProcsMap,
import PostgREST.Request.Types (ApiRequestError (..), procReturnsScalar)
RangeError (..), SelectItem)
import qualified PostgREST.MediaType as MediaType import qualified PostgREST.ApiRequest.Preferences as Preferences
import qualified PostgREST.Request.Preferences as Preferences import qualified PostgREST.ApiRequest.QueryParams as QueryParams
import qualified PostgREST.Request.QueryParams as QueryParams import qualified PostgREST.MediaType as MediaType
import Protolude import Protolude
@@ -179,14 +179,14 @@ data ApiRequest = ApiRequest {
} }
-- | Examines HTTP request and translates it into user intent. -- | Examines HTTP request and translates it into user intent.
userApiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest userApiRequest :: AppConfig -> SchemaCache -> Request -> RequestBody -> Either ApiRequestError ApiRequest
userApiRequest conf dbStructure req reqBody = do userApiRequest conf sCache req reqBody = do
qPrms <- first QueryParamError $ QueryParams.parse $ rawQueryString req qPrms <- first QueryParamError $ QueryParams.parse $ rawQueryString req
pInfo <- getPathInfo conf $ pathInfo req pInfo <- getPathInfo conf $ pathInfo req
act <- getAction pInfo $ requestMethod req act <- getAction pInfo $ requestMethod req
mediaTypes <- getMediaTypes conf (requestHeaders req) act pInfo mediaTypes <- getMediaTypes conf (requestHeaders req) act pInfo
negotiatedSchema <- getSchema conf (requestHeaders req) (requestMethod req) negotiatedSchema <- getSchema conf (requestHeaders req) (requestMethod req)
apiRequest conf dbStructure req reqBody qPrms pInfo act mediaTypes negotiatedSchema apiRequest conf sCache req reqBody qPrms pInfo act mediaTypes negotiatedSchema
getPathInfo :: AppConfig -> [Text] -> Either ApiRequestError PathInfo getPathInfo :: AppConfig -> [Text] -> Either ApiRequestError PathInfo
getPathInfo AppConfig{configOpenApiMode, configDbRootSpec} path = getPathInfo AppConfig{configOpenApiMode, configDbRootSpec} path =
@@ -248,8 +248,8 @@ getSchema AppConfig{configDbSchemas} hdrs method = do
acceptProfile = T.decodeUtf8 <$> lookupHeader "Accept-Profile" acceptProfile = T.decodeUtf8 <$> lookupHeader "Accept-Profile"
lookupHeader = flip lookup hdrs lookupHeader = flip lookup hdrs
apiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action -> (MediaType, MediaType) -> (Schema, Bool) -> Either ApiRequestError ApiRequest apiRequest :: AppConfig -> SchemaCache -> Request -> RequestBody -> QueryParams.QueryParams -> PathInfo -> Action -> (MediaType, MediaType) -> (Schema, Bool) -> Either ApiRequestError ApiRequest
apiRequest conf dbStructure req reqBody queryparams@QueryParams{..} PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action (acceptMediaType, contentMediaType) (schema, negotiatedByProfile) apiRequest conf sCache req reqBody queryparams@QueryParams{..} PathInfo{pathName, pathIsProc, pathIsRootSpec, pathIsDefSpec} action (acceptMediaType, contentMediaType) (schema, negotiatedByProfile)
| isInvalidRange = Left $ InvalidRange (if rangeIsEmpty headerRange then LowerGTUpper else NegativeLimit) | isInvalidRange = Left $ InvalidRange (if rangeIsEmpty headerRange then LowerGTUpper else NegativeLimit)
| shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload | shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload
| not expectParams && not (L.null qsParams) = Left $ ParseRequestError "Unexpected param or filter missing operator" ("Failed to parse " <> show qsParams) | not expectParams && not (L.null qsParams) = Left $ ParseRequestError "Unexpected param or filter missing operator" ("Failed to parse " <> show qsParams)
@@ -325,7 +325,7 @@ apiRequest conf dbStructure req reqBody queryparams@QueryParams{..} PathInfo{pat
| otherwise = Right $ TargetIdent $ QualifiedIdentifier schema pathName | otherwise = Right $ TargetIdent $ QualifiedIdentifier schema pathName
where where
callFindProc procSch procNam = findProc callFindProc procSch procNam = findProc
(QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs dbStructure) (QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs sCache)
contentMediaType (action == ActionInvoke InvPost) contentMediaType (action == ActionInvoke InvPost)
shouldParsePayload = case (action, contentMediaType) of shouldParsePayload = case (action, contentMediaType) of
src/PostgREST/Request/Preferences.hs → src/PostgREST/ApiRequest/Preferences.hs
+2 -2
View File
@@ -1,12 +1,12 @@
-- | -- |
-- Module: PostgREST.Request.Preferences -- Module: PostgREST.ApiRequest.Preferences
-- Description: Track client preferences to be employed when processing requests -- Description: Track client preferences to be employed when processing requests
-- --
-- Track client prefences set in HTTP 'Prefer' headers according to RFC7240[1]. -- Track client prefences set in HTTP 'Prefer' headers according to RFC7240[1].
-- --
-- [1] https://datatracker.ietf.org/doc/html/rfc7240 -- [1] https://datatracker.ietf.org/doc/html/rfc7240
-- --
module PostgREST.Request.Preferences module PostgREST.ApiRequest.Preferences
( Preferences(..) ( Preferences(..)
, PreferCount(..) , PreferCount(..)
, PreferParameters(..) , PreferParameters(..)
src/PostgREST/Request/QueryParams.hs → src/PostgREST/ApiRequest/QueryParams.hs
+15 -13
View File
@@ -1,12 +1,12 @@
-- | -- |
-- Module : PostgREST.Request.QueryParams -- Module : PostgREST.ApiRequest.QueryParams
-- Description : Parser for PostgREST Query parameters -- Description : Parser for PostgREST Query parameters
-- --
-- This module is in charge of parsing all the querystring values in an url, e.g. -- This module is in charge of parsing all the querystring values in an url, e.g.
-- the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`. -- the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`.
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
module PostgREST.Request.QueryParams module PostgREST.ApiRequest.QueryParams
( parse ( parse
, QueryParams(..) , QueryParams(..)
, pRequestRange , pRequestRange
@@ -39,21 +39,23 @@ import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser,
optionMaybe, sepBy1, string, optionMaybe, sepBy1, string,
try, (<?>)) try, (<?>))
import PostgREST.DbStructure.Identifiers (FieldName)
import PostgREST.RangeQuery (NonnegRange, allRange, import PostgREST.RangeQuery (NonnegRange, allRange,
rangeGeq, rangeLimit, rangeGeq, rangeLimit,
rangeOffset, restrictRange) rangeOffset, restrictRange)
import PostgREST.SchemaCache.Identifiers (FieldName)
import PostgREST.Request.Types (EmbedParam (..), EmbedPath, Field, import PostgREST.ApiRequest.Types (EmbedParam (..), EmbedPath, Field,
Filter (..), FtsOperator (..), Filter (..), FtsOperator (..),
JoinType (..), JsonOperand (..), JoinType (..), JsonOperand (..),
JsonOperation (..), JsonPath, ListVal, JsonOperation (..), JsonPath,
LogicOperator (..), LogicTree (..), ListVal, LogicOperator (..),
OpExpr (..), Operation (..), LogicTree (..), OpExpr (..),
OrderDirection (..), OrderNulls (..), Operation (..),
OrderTerm (..), QPError (..), OrderDirection (..),
SelectItem, SimpleOperator (..), OrderNulls (..), OrderTerm (..),
SingleVal, TrileanVal (..)) QPError (..), SelectItem,
SimpleOperator (..), SingleVal,
TrileanVal (..))
import Protolude hiding (try) import Protolude hiding (try)
src/PostgREST/Request/Types.hs → src/PostgREST/ApiRequest/Types.hs
+5 -5
View File
@@ -1,5 +1,5 @@
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
module PostgREST.Request.Types module PostgREST.ApiRequest.Types
( Alias ( Alias
, Cast , Cast
, Depth , Depth
@@ -32,11 +32,11 @@ module PostgREST.Request.Types
, SelectItem , SelectItem
) where ) where
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.DbStructure.Proc (ProcDescription (..))
import PostgREST.DbStructure.Relationship (Relationship)
import PostgREST.MediaType (MediaType (..)) import PostgREST.MediaType (MediaType (..))
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.SchemaCache.Proc (ProcDescription (..))
import PostgREST.SchemaCache.Relationship (Relationship)
import Protolude import Protolude
src/PostgREST/App.hs
+46 -53
View File
@@ -30,29 +30,28 @@ import qualified Hasql.Transaction.Sessions as SQL
import qualified Network.Wai as Wai import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp as Warp
import qualified PostgREST.Admin as Admin import qualified PostgREST.ApiRequest as ApiRequest
import qualified PostgREST.AppState as AppState import qualified PostgREST.ApiRequest.Types as ApiRequestTypes
import qualified PostgREST.Auth as Auth import qualified PostgREST.AppState as AppState
import qualified PostgREST.Cors as Cors import qualified PostgREST.Auth as Auth
import qualified PostgREST.Error as Error import qualified PostgREST.Cors as Cors
import qualified PostgREST.Logger as Logger import qualified PostgREST.Error as Error
import qualified PostgREST.Plan as Plan import qualified PostgREST.Logger as Logger
import qualified PostgREST.Query as Query import qualified PostgREST.Plan as Plan
import qualified PostgREST.Request.ApiRequest as ApiRequest import qualified PostgREST.Query as Query
import qualified PostgREST.Request.Types as ApiRequestTypes import qualified PostgREST.Response as Response
import qualified PostgREST.Response as Response import qualified PostgREST.Workers as Workers
import PostgREST.AppState (AppState) import PostgREST.ApiRequest (Action (..), ApiRequest (..),
import PostgREST.Auth (AuthResult (..)) Mutation (..), Target (..))
import PostgREST.Config (AppConfig (..), LogLevel (..)) import PostgREST.AppState (AppState)
import PostgREST.Config.PgVersion (PgVersion (..)) import PostgREST.Auth (AuthResult (..))
import PostgREST.DbStructure (DbStructure (..)) import PostgREST.Config (AppConfig (..), LogLevel (..))
import PostgREST.Error (Error) import PostgREST.Config.PgVersion (PgVersion (..))
import PostgREST.Query (DbHandler) import PostgREST.Error (Error)
import PostgREST.Request.ApiRequest (Action (..), ApiRequest (..), import PostgREST.Query (DbHandler)
Mutation (..), Target (..)) import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.Version (prettyVersion) import PostgREST.Version (prettyVersion)
import PostgREST.Workers (connectionWorker, listener)
import Protolude hiding (Handler) import Protolude hiding (Handler)
@@ -65,17 +64,14 @@ type SocketRunner = Warp.Settings -> Wai.Application -> FileMode -> FilePath ->
run :: SignalHandlerInstaller -> Maybe SocketRunner -> AppState -> IO () run :: SignalHandlerInstaller -> Maybe SocketRunner -> AppState -> IO ()
run installHandlers maybeRunWithSocket appState = do run installHandlers maybeRunWithSocket appState = do
conf@AppConfig{..} <- AppState.getConfig appState conf@AppConfig{..} <- AppState.getConfig appState
connectionWorker appState -- Loads the initial DbStructure Workers.connectionWorker appState -- Loads the initial SchemaCache
installHandlers appState installHandlers appState
-- reload schema cache + config on NOTIFY -- reload schema cache + config on NOTIFY
when configDbChannelEnabled $ listener appState Workers.runListener conf appState
let app = postgrest configLogLevel appState (connectionWorker appState) Workers.runAdmin conf appState $ serverSettings conf
adminApp = Admin.postgrestAdmin appState conf
whenJust configAdminServerPort $ \adminPort -> do let app = postgrest configLogLevel appState (Workers.connectionWorker appState)
AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort
void . forkIO $ Warp.runSettings (serverSettings conf & setPort adminPort) adminApp
case configServerUnixSocket of case configServerUnixSocket of
Just socket -> Just socket ->
@@ -90,9 +86,6 @@ run installHandlers maybeRunWithSocket appState = do
do do
AppState.logWithZTime appState $ "Listening on port " <> show configServerPort AppState.logWithZTime appState $ "Listening on port " <> show configServerPort
Warp.runSettings (serverSettings conf) app Warp.runSettings (serverSettings conf) app
where
whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
whenJust mg f = maybe (pure ()) f mg
serverSettings :: AppConfig -> Warp.Settings serverSettings :: AppConfig -> Warp.Settings
serverSettings AppConfig{..} = serverSettings AppConfig{..} =
@@ -113,14 +106,14 @@ postgrest logLevel appState connWorker =
Left err -> respond $ Error.errorResponseFor err Left err -> respond $ Error.errorResponseFor err
Right authResult -> do Right authResult -> do
conf <- AppState.getConfig appState conf <- AppState.getConfig appState
maybeDbStructure <- AppState.getDbStructure appState maybeSchemaCache <- AppState.getSchemaCache appState
pgVer <- AppState.getPgVersion appState pgVer <- AppState.getPgVersion appState
jsonDbS <- AppState.getJsonDbS appState jsonDbS <- AppState.getJsonDbS appState
let let
eitherResponse :: IO (Either Error Wai.Response) eitherResponse :: IO (Either Error Wai.Response)
eitherResponse = eitherResponse =
runExceptT $ postgrestResponse appState conf maybeDbStructure jsonDbS pgVer authResult req runExceptT $ postgrestResponse appState conf maybeSchemaCache jsonDbS pgVer authResult req
response <- either Error.errorResponseFor identity <$> eitherResponse response <- either Error.errorResponseFor identity <$> eitherResponse
-- Launch the connWorker when the connection is down. The postgrest -- Launch the connWorker when the connection is down. The postgrest
@@ -135,17 +128,17 @@ postgrest logLevel appState connWorker =
postgrestResponse postgrestResponse
:: AppState.AppState :: AppState.AppState
-> AppConfig -> AppConfig
-> Maybe DbStructure -> Maybe SchemaCache
-> ByteString -> ByteString
-> PgVersion -> PgVersion
-> AuthResult -> AuthResult
-> Wai.Request -> Wai.Request
-> Handler IO Wai.Response -> Handler IO Wai.Response
postgrestResponse appState conf@AppConfig{..} maybeDbStructure jsonDbS pgVer authResult@AuthResult{..} req = do postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jsonDbS pgVer authResult@AuthResult{..} req = do
dbStructure <- sCache <-
case maybeDbStructure of case maybeSchemaCache of
Just dbStructure -> Just sCache ->
return dbStructure return sCache
Nothing -> Nothing ->
throwError Error.NoSchemaCacheError throwError Error.NoSchemaCacheError
@@ -153,10 +146,10 @@ postgrestResponse appState conf@AppConfig{..} maybeDbStructure jsonDbS pgVer aut
apiRequest <- apiRequest <-
liftEither . mapLeft Error.ApiRequestError $ liftEither . mapLeft Error.ApiRequestError $
ApiRequest.userApiRequest conf dbStructure req body ApiRequest.userApiRequest conf sCache req body
Response.optionalRollback conf apiRequest $ Response.optionalRollback conf apiRequest $
handleRequest authResult conf appState (Query.txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements jsonDbS pgVer apiRequest dbStructure handleRequest authResult conf appState (Query.txMode apiRequest) (Just authRole /= configDbAnonRole) configDbPreparedStatements jsonDbS pgVer apiRequest sCache
runDbHandler :: AppState.AppState -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b runDbHandler :: AppState.AppState -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
runDbHandler appState mode authenticated prepared handler = do runDbHandler appState mode authenticated prepared handler = do
@@ -170,45 +163,45 @@ runDbHandler appState mode authenticated prepared handler = do
liftEither resp liftEither resp
handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> SQL.Mode -> Bool -> Bool -> ByteString -> PgVersion -> ApiRequest -> DbStructure -> Handler IO Wai.Response handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> SQL.Mode -> Bool -> Bool -> ByteString -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response
handleRequest AuthResult{..} conf appState mode authenticated prepared jsonDbS pgVer apiReq@ApiRequest{..} dbStructure = handleRequest AuthResult{..} conf appState mode authenticated prepared jsonDbS pgVer apiReq@ApiRequest{..} sCache =
case (iAction, iTarget) of case (iAction, iTarget) of
(ActionRead headersOnly, TargetIdent identifier) -> do (ActionRead headersOnly, TargetIdent identifier) -> do
rPlan <- liftEither $ Plan.readPlan identifier conf dbStructure apiReq rPlan <- liftEither $ Plan.readPlan identifier conf sCache apiReq
resultSet <- runQuery $ Query.readQuery rPlan conf apiReq resultSet <- runQuery $ Query.readQuery rPlan conf apiReq
return $ Response.readResponse headersOnly identifier apiReq resultSet return $ Response.readResponse headersOnly identifier apiReq resultSet
(ActionMutate MutationCreate, TargetIdent identifier) -> do (ActionMutate MutationCreate, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf dbStructure mrPlan <- liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache
resultSet <- runQuery $ Query.createQuery mrPlan apiReq conf resultSet <- runQuery $ Query.createQuery mrPlan apiReq conf
return $ Response.createResponse identifier mrPlan apiReq resultSet return $ Response.createResponse identifier mrPlan apiReq resultSet
(ActionMutate MutationUpdate, TargetIdent identifier) -> do (ActionMutate MutationUpdate, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf dbStructure mrPlan <- liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache
resultSet <- runQuery $ Query.updateQuery mrPlan apiReq conf resultSet <- runQuery $ Query.updateQuery mrPlan apiReq conf
return $ Response.updateResponse apiReq resultSet return $ Response.updateResponse apiReq resultSet
(ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do (ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf dbStructure mrPlan <- liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache
resultSet <- runQuery $ Query.singleUpsertQuery mrPlan apiReq conf resultSet <- runQuery $ Query.singleUpsertQuery mrPlan apiReq conf
return $ Response.singleUpsertResponse apiReq resultSet return $ Response.singleUpsertResponse apiReq resultSet
(ActionMutate MutationDelete, TargetIdent identifier) -> do (ActionMutate MutationDelete, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf dbStructure mrPlan <- liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache
resultSet <- runQuery $ Query.deleteQuery mrPlan apiReq conf resultSet <- runQuery $ Query.deleteQuery mrPlan apiReq conf
return $ Response.deleteResponse apiReq resultSet return $ Response.deleteResponse apiReq resultSet
(ActionInvoke invMethod, TargetProc proc _) -> do (ActionInvoke invMethod, TargetProc proc _) -> do
cPlan <- liftEither $ Plan.callReadPlan proc conf dbStructure apiReq cPlan <- liftEither $ Plan.callReadPlan proc conf sCache apiReq
resultSet <- runQuery $ Query.invokeQuery proc cPlan apiReq conf resultSet <- runQuery $ Query.invokeQuery proc cPlan apiReq conf
return $ Response.invokeResponse invMethod proc apiReq resultSet return $ Response.invokeResponse invMethod proc apiReq resultSet
(ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
oaiResult <- runQuery $ Query.openApiQuery dbStructure pgVer conf tSchema oaiResult <- runQuery $ Query.openApiQuery sCache pgVer conf tSchema
return $ Response.openApiResponse headersOnly oaiResult conf dbStructure iSchema iNegotiatedByProfile return $ Response.openApiResponse headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile
(ActionInfo, _) -> (ActionInfo, _) ->
return $ Response.infoResponse iTarget dbStructure return $ Response.infoResponse iTarget sCache
_ -> _ ->
-- This is unreachable as the ApiRequest.hs rejects it before -- This is unreachable as the ApiRequest.hs rejects it before
src/PostgREST/AppState.hs
+9 -9
View File
@@ -5,7 +5,7 @@ module PostgREST.AppState
, destroy , destroy
, flushPool , flushPool
, getConfig , getConfig
, getDbStructure , getSchemaCache
, getIsListenerOn , getIsListenerOn
, getJsonDbS , getJsonDbS
, getMainThreadId , getMainThreadId
@@ -17,7 +17,7 @@ module PostgREST.AppState
, initWithPool , initWithPool
, logWithZTime , logWithZTime
, putConfig , putConfig
, putDbStructure , putSchemaCache
, putIsListenerOn , putIsListenerOn
, putJsonDbS , putJsonDbS
, putPgVersion , putPgVersion
@@ -40,7 +40,7 @@ import Data.Time.Clock (UTCTime, getCurrentTime)
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion) import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
import PostgREST.DbStructure (DbStructure) import PostgREST.SchemaCache (SchemaCache)
import Protolude import Protolude
@@ -51,8 +51,8 @@ data AppState = AppState
-- | Database server version, will be updated by the connectionWorker -- | Database server version, will be updated by the connectionWorker
, statePgVersion :: IORef PgVersion , statePgVersion :: IORef PgVersion
-- | No schema cache at the start. Will be filled in by the connectionWorker -- | No schema cache at the start. Will be filled in by the connectionWorker
, stateDbStructure :: IORef (Maybe DbStructure) , stateSchemaCache :: IORef (Maybe SchemaCache)
-- | Cached DbStructure in json -- | Cached SchemaCache in json
, stateJsonDbS :: IORef ByteString , stateJsonDbS :: IORef ByteString
-- | Binary semaphore to make sure just one connectionWorker can run at a time -- | Binary semaphore to make sure just one connectionWorker can run at a time
, stateWorkerSem :: MVar () , stateWorkerSem :: MVar ()
@@ -121,11 +121,11 @@ getPgVersion = readIORef . statePgVersion
putPgVersion :: AppState -> PgVersion -> IO () putPgVersion :: AppState -> PgVersion -> IO ()
putPgVersion = atomicWriteIORef . statePgVersion putPgVersion = atomicWriteIORef . statePgVersion
getDbStructure :: AppState -> IO (Maybe DbStructure) getSchemaCache :: AppState -> IO (Maybe SchemaCache)
getDbStructure = readIORef . stateDbStructure getSchemaCache = readIORef . stateSchemaCache
putDbStructure :: AppState -> Maybe DbStructure -> IO () putSchemaCache :: AppState -> Maybe SchemaCache -> IO ()
putDbStructure appState = atomicWriteIORef (stateDbStructure appState) putSchemaCache appState = atomicWriteIORef (stateSchemaCache appState)
getJsonDbS :: AppState -> IO ByteString getJsonDbS :: AppState -> IO ByteString
getJsonDbS = readIORef . stateJsonDbS getJsonDbS = readIORef . stateJsonDbS
src/PostgREST/CLI.hs
+4 -4
View File
@@ -19,7 +19,7 @@ import Text.Heredoc (str)
import PostgREST.AppState (AppState) import PostgREST.AppState (AppState)
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.DbStructure (queryDbStructure) import PostgREST.SchemaCache (querySchemaCache)
import PostgREST.Version (prettyVersion) import PostgREST.Version (prettyVersion)
import PostgREST.Workers (reReadConfig) import PostgREST.Workers (reReadConfig)
@@ -48,7 +48,7 @@ main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
CmdDumpSchema -> putStrLn =<< dumpSchema appState CmdDumpSchema -> putStrLn =<< dumpSchema appState
CmdRun -> App.run installSignalHandlers runAppWithSocket appState) CmdRun -> App.run installSignalHandlers runAppWithSocket appState)
-- | Dump DbStructure schema to JSON -- | Dump SchemaCache schema to JSON
dumpSchema :: AppState -> IO LBS.ByteString dumpSchema :: AppState -> IO LBS.ByteString
dumpSchema appState = do dumpSchema appState = do
AppConfig{..} <- AppState.getConfig appState AppConfig{..} <- AppState.getConfig appState
@@ -56,7 +56,7 @@ dumpSchema appState = do
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
AppState.usePool appState $ AppState.usePool appState $
transaction SQL.ReadCommitted SQL.Read $ transaction SQL.ReadCommitted SQL.Read $
queryDbStructure querySchemaCache
(toList configDbSchemas) (toList configDbSchemas)
configDbExtraSearchPath configDbExtraSearchPath
configDbPreparedStatements configDbPreparedStatements
@@ -64,7 +64,7 @@ dumpSchema appState = do
Left e -> do Left e -> do
hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
exitFailure exitFailure
Right dbStructure -> return $ JSON.encode dbStructure Right sCache -> return $ JSON.encode sCache
-- | Command line interface options -- | Command line interface options
data CLI = CLI data CLI = CLI
src/PostgREST/Config.hs
+2 -2
View File
@@ -54,9 +54,9 @@ import PostgREST.Config.JSPath (JSPath, JSPathExp (..),
dumpJSPath, pRoleClaimKey) dumpJSPath, pRoleClaimKey)
import PostgREST.Config.Proxy (Proxy (..), import PostgREST.Config.Proxy (Proxy (..),
isMalformedProxyUri, toURI) isMalformedProxyUri, toURI)
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi,
toQi)
import PostgREST.MediaType (MediaType (..), toMime) import PostgREST.MediaType (MediaType (..), toMime)
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier, dumpQi,
toQi)
import Protolude hiding (Proxy, toList) import Protolude hiding (Proxy, toList)
src/PostgREST/Error.hs
+8 -8
View File
@@ -29,16 +29,16 @@ import Network.Wai (Response, responseLBS)
import Network.HTTP.Types.Header (Header) import Network.HTTP.Types.Header (Header)
import PostgREST.MediaType (MediaType (..)) import PostgREST.ApiRequest.Types (ApiRequestError (..),
import qualified PostgREST.MediaType as MediaType QPError (..),
import PostgREST.Request.Types (ApiRequestError (..), RangeError (..))
QPError (..), import PostgREST.MediaType (MediaType (..))
RangeError (..)) import qualified PostgREST.MediaType as MediaType
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..)) import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
import PostgREST.DbStructure.Proc (ProcDescription (..), import PostgREST.SchemaCache.Proc (ProcDescription (..),
ProcParam (..)) ProcParam (..))
import PostgREST.DbStructure.Relationship (Cardinality (..), import PostgREST.SchemaCache.Relationship (Cardinality (..),
Junction (..), Junction (..),
Relationship (..)) Relationship (..))
import Protolude import Protolude
src/PostgREST/Plan.hs
+34 -34
View File
@@ -25,43 +25,43 @@ module PostgREST.Plan
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S import qualified Data.Set as S
import qualified PostgREST.DbStructure.Proc as Proc import qualified PostgREST.SchemaCache.Proc as Proc
import Data.Either.Combinators (mapLeft) import Data.Either.Combinators (mapLeft)
import Data.List (delete) import Data.List (delete)
import Data.Tree (Tree (..)) import Data.Tree (Tree (..))
import PostgREST.Config (AppConfig (..)) import PostgREST.ApiRequest (Action (..),
import PostgREST.DbStructure (DbStructure (..))
import PostgREST.DbStructure.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema)
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcParam (..),
procReturnsScalar)
import PostgREST.DbStructure.Relationship (Cardinality (..),
Junction (..),
Relationship (..),
RelationshipsMap)
import PostgREST.DbStructure.Table (tablePKCols)
import PostgREST.Error (Error (..))
import PostgREST.Query.SqlFragment (sourceCTEName)
import PostgREST.RangeQuery (NonnegRange, allRange,
restrictRange)
import PostgREST.Request.ApiRequest (Action (..),
ApiRequest (..), ApiRequest (..),
InvokeMethod (..), InvokeMethod (..),
Mutation (..), Mutation (..),
Payload (..)) Payload (..))
import PostgREST.Config (AppConfig (..))
import PostgREST.Error (Error (..))
import PostgREST.Query.SqlFragment (sourceCTEName)
import PostgREST.RangeQuery (NonnegRange, allRange,
restrictRange)
import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier (..),
Schema)
import PostgREST.SchemaCache.Proc (ProcDescription (..),
ProcParam (..),
procReturnsScalar)
import PostgREST.SchemaCache.Relationship (Cardinality (..),
Junction (..),
Relationship (..),
RelationshipsMap)
import PostgREST.SchemaCache.Table (tablePKCols)
import PostgREST.Plan.CallPlan import PostgREST.Plan.CallPlan
import PostgREST.Plan.MutatePlan import PostgREST.Plan.MutatePlan
import PostgREST.Plan.ReadPlan as ReadPlan import PostgREST.Plan.ReadPlan as ReadPlan
import PostgREST.Request.Preferences import PostgREST.ApiRequest.Preferences
import PostgREST.Request.Types import PostgREST.ApiRequest.Types
import qualified PostgREST.Request.QueryParams as QueryParams import qualified PostgREST.ApiRequest.QueryParams as QueryParams
import Protolude hiding (from) import Protolude hiding (from)
@@ -75,24 +75,24 @@ data CallReadPlan = CallReadPlan {
, crCallPlan :: CallPlan , crCallPlan :: CallPlan
} }
mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> DbStructure -> Either Error MutateReadPlan mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error MutateReadPlan
mutateReadPlan mutation apiRequest identifier conf dbStructure = do mutateReadPlan mutation apiRequest identifier conf sCache = do
rPlan <- readPlan identifier conf dbStructure apiRequest rPlan <- readPlan identifier conf sCache apiRequest
mPlan <- mutatePlan mutation identifier apiRequest dbStructure rPlan mPlan <- mutatePlan mutation identifier apiRequest sCache rPlan
return $ MutateReadPlan rPlan mPlan return $ MutateReadPlan rPlan mPlan
callReadPlan :: ProcDescription -> AppConfig -> DbStructure -> ApiRequest -> Either Error CallReadPlan callReadPlan :: ProcDescription -> AppConfig -> SchemaCache -> ApiRequest -> Either Error CallReadPlan
callReadPlan proc conf dbStructure apiRequest = do callReadPlan proc conf sCache apiRequest = do
let identifier = QualifiedIdentifier (pdSchema proc) (fromMaybe (pdName proc) $ Proc.procTableName proc) let identifier = QualifiedIdentifier (pdSchema proc) (fromMaybe (pdName proc) $ Proc.procTableName proc)
rPlan <- readPlan identifier conf dbStructure apiRequest rPlan <- readPlan identifier conf sCache apiRequest
let cPlan = callPlan proc apiRequest rPlan let cPlan = callPlan proc apiRequest rPlan
return $ CallReadPlan rPlan cPlan return $ CallReadPlan rPlan cPlan
-- | Builds the ReadPlan tree on a number of stages. -- | Builds the ReadPlan tree on a number of stages.
-- | Adds filters, order, limits on its respective nodes. -- | Adds filters, order, limits on its respective nodes.
-- | Adds joins conditions obtained from resource embedding. -- | Adds joins conditions obtained from resource embedding.
readPlan :: QualifiedIdentifier -> AppConfig -> DbStructure -> ApiRequest -> Either Error ReadPlanTree readPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error ReadPlanTree
readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows} DbStructure{dbRelationships} apiRequest = readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows} SchemaCache{dbRelationships} apiRequest =
mapLeft ApiRequestError $ mapLeft ApiRequestError $
treeRestrictRange configDbMaxRows (iAction apiRequest) =<< treeRestrictRange configDbMaxRows (iAction apiRequest) =<<
augmentRequestWithJoin qiSchema dbRelationships =<< augmentRequestWithJoin qiSchema dbRelationships =<<
@@ -335,8 +335,8 @@ updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
findNode :: Maybe ReadPlanTree findNode :: Maybe ReadPlanTree
findNode = find (\(Node ReadPlan{nodeName, nodeAlias} _) -> nodeName == targetNodeName || nodeAlias == Just targetNodeName) forest findNode = find (\(Node ReadPlan{nodeName, nodeAlias} _) -> nodeName == targetNodeName || nodeAlias == Just targetNodeName) forest
mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> DbStructure -> ReadPlanTree -> Either Error MutatePlan mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> SchemaCache -> ReadPlanTree -> Either Error MutatePlan
mutatePlan mutation qi ApiRequest{..} dbStructure readReq = mapLeft ApiRequestError $ mutatePlan mutation qi ApiRequest{..} sCache readReq = mapLeft ApiRequestError $
case mutation of case mutation of
MutationCreate -> MutationCreate ->
Right $ Insert qi iColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings pkCols Right $ Insert qi iColumns body ((,) <$> iPreferResolution <*> Just confCols) [] returnings pkCols
@@ -359,7 +359,7 @@ mutatePlan mutation qi ApiRequest{..} dbStructure readReq = mapLeft ApiRequestEr
if iPreferRepresentation == None if iPreferRepresentation == None
then [] then []
else returningCols readReq pkCols else returningCols readReq pkCols
pkCols = maybe mempty tablePKCols $ HM.lookup qi $ dbTables dbStructure pkCols = maybe mempty tablePKCols $ HM.lookup qi $ dbTables sCache
logic = map snd qsLogic logic = map snd qsLogic
rootOrder = maybe [] snd $ find (\(x, _) -> null x) qsOrder rootOrder = maybe [] snd $ find (\(x, _) -> null x) qsOrder
combinedLogic = foldr addFilterToLogicForest logic qsFiltersRoot combinedLogic = foldr addFilterToLogicForest logic qsFiltersRoot
src/PostgREST/Plan/CallPlan.hs
+2 -2
View File
@@ -5,9 +5,9 @@ module PostgREST.Plan.CallPlan
where where
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import PostgREST.DbStructure.Identifiers (FieldName, import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier) QualifiedIdentifier)
import PostgREST.DbStructure.Proc (ProcParam (..)) import PostgREST.SchemaCache.Proc (ProcParam (..))
import Protolude import Protolude
src/PostgREST/Plan/MutatePlan.hs
+4 -4
View File
@@ -6,11 +6,11 @@ where
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import qualified Data.Set as S import qualified Data.Set as S
import PostgREST.DbStructure.Identifiers (FieldName, import PostgREST.ApiRequest.Preferences (PreferResolution)
QualifiedIdentifier) import PostgREST.ApiRequest.Types (LogicTree, OrderTerm)
import PostgREST.RangeQuery (NonnegRange) import PostgREST.RangeQuery (NonnegRange)
import PostgREST.Request.Preferences (PreferResolution) import PostgREST.SchemaCache.Identifiers (FieldName,
import PostgREST.Request.Types (LogicTree, OrderTerm) QualifiedIdentifier)
import Protolude import Protolude
src/PostgREST/Plan/ReadPlan.hs
+5 -5
View File
@@ -7,14 +7,14 @@ module PostgREST.Plan.ReadPlan
import Data.Tree (Tree (..)) import Data.Tree (Tree (..))
import PostgREST.DbStructure.Identifiers (FieldName, import PostgREST.ApiRequest.Types (Alias, Depth, Hint,
QualifiedIdentifier)
import PostgREST.DbStructure.Relationship (Relationship)
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.Request.Types (Alias, Depth, Hint,
JoinCondition, JoinType, JoinCondition, JoinType,
LogicTree, NodeName, LogicTree, NodeName,
OrderTerm, SelectItem) OrderTerm, SelectItem)
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier)
import PostgREST.SchemaCache.Relationship (Relationship)
import Protolude import Protolude
src/PostgREST/Query.hs
+25 -25
View File
@@ -25,26 +25,27 @@ import qualified Hasql.DynamicStatements.Statement as SQL
import qualified Hasql.Transaction as SQL import qualified Hasql.Transaction as SQL
import qualified Hasql.Transaction.Sessions as SQL import qualified Hasql.Transaction.Sessions as SQL
import qualified PostgREST.DbStructure as DbStructure
import qualified PostgREST.DbStructure.Proc as Proc
import qualified PostgREST.Error as Error import qualified PostgREST.Error as Error
import qualified PostgREST.Query.QueryBuilder as QueryBuilder import qualified PostgREST.Query.QueryBuilder as QueryBuilder
import qualified PostgREST.Query.Statements as Statements import qualified PostgREST.Query.Statements as Statements
import qualified PostgREST.RangeQuery as RangeQuery import qualified PostgREST.RangeQuery as RangeQuery
import qualified PostgREST.SchemaCache as SchemaCache
import qualified PostgREST.SchemaCache.Proc as Proc
import Data.Scientific (FPFormat (..), formatScientific, isInteger) import Data.Scientific (FPFormat (..), formatScientific, isInteger)
import PostgREST.ApiRequest (Action (..),
ApiRequest (..),
InvokeMethod (..),
Target (..))
import PostgREST.ApiRequest.Preferences (PreferCount (..),
PreferParameters (..),
PreferTransaction (..),
shouldCount)
import PostgREST.Config (AppConfig (..), import PostgREST.Config (AppConfig (..),
OpenAPIMode (..)) OpenAPIMode (..))
import PostgREST.Config.PgVersion (PgVersion (..), import PostgREST.Config.PgVersion (PgVersion (..),
pgVersion140) pgVersion140)
import PostgREST.DbStructure (DbStructure (..))
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
Schema)
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcVolatility (..),
ProcsMap)
import PostgREST.DbStructure.Table (TablesMap)
import PostgREST.Error (Error) import PostgREST.Error (Error)
import PostgREST.MediaType (MediaType (..)) import PostgREST.MediaType (MediaType (..))
import PostgREST.Plan (CallReadPlan (..), import PostgREST.Plan (CallReadPlan (..),
@@ -56,14 +57,13 @@ import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet,
setConfigLocal, setConfigLocal,
setConfigLocalJson) setConfigLocalJson)
import PostgREST.Query.Statements (ResultSet (..)) import PostgREST.Query.Statements (ResultSet (..))
import PostgREST.Request.ApiRequest (Action (..), import PostgREST.SchemaCache (SchemaCache (..))
ApiRequest (..), import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
InvokeMethod (..), Schema)
Target (..)) import PostgREST.SchemaCache.Proc (ProcDescription (..),
import PostgREST.Request.Preferences (PreferCount (..), ProcVolatility (..),
PreferParameters (..), ProcsMap)
PreferTransaction (..), import PostgREST.SchemaCache.Table (TablesMap)
shouldCount)
import Protolude hiding (Handler) import Protolude hiding (Handler)
@@ -174,19 +174,19 @@ invokeQuery proc CallReadPlan{crReadPlan, crCallPlan} apiReq@ApiRequest{..} conf
failNotSingular iAcceptMediaType resultSet failNotSingular iAcceptMediaType resultSet
pure resultSet pure resultSet
openApiQuery :: DbStructure -> PgVersion -> AppConfig -> Schema -> DbHandler (Maybe (TablesMap, ProcsMap, Maybe Text)) openApiQuery :: SchemaCache -> PgVersion -> AppConfig -> Schema -> DbHandler (Maybe (TablesMap, ProcsMap, Maybe Text))
openApiQuery dbStructure pgVer AppConfig{..} tSchema = openApiQuery sCache pgVer AppConfig{..} tSchema =
lift $ case configOpenApiMode of lift $ case configOpenApiMode of
OAFollowPriv -> OAFollowPriv ->
Just <$> ((,,) Just <$> ((,,)
<$> SQL.statement [tSchema] (DbStructure.accessibleTables pgVer configDbPreparedStatements) <$> SQL.statement [tSchema] (SchemaCache.accessibleTables pgVer configDbPreparedStatements)
<*> SQL.statement tSchema (DbStructure.accessibleProcs pgVer configDbPreparedStatements) <*> SQL.statement tSchema (SchemaCache.accessibleProcs pgVer configDbPreparedStatements)
<*> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)) <*> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
OAIgnorePriv -> OAIgnorePriv ->
Just <$> ((,,) Just <$> ((,,)
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbTables dbStructure) (HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ SchemaCache.dbTables sCache)
(HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure) (HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ SchemaCache.dbProcs sCache)
<$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)) <$> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
OADisabled -> OADisabled ->
pure Nothing pure Nothing
src/PostgREST/Query/QueryBuilder.hs
+5 -5
View File
@@ -22,19 +22,19 @@ import qualified Hasql.DynamicStatements.Snippet as SQL
import Data.Tree (Tree (..)) import Data.Tree (Tree (..))
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..)) import PostgREST.ApiRequest.Preferences (PreferResolution (..))
import PostgREST.DbStructure.Proc (ProcParam (..)) import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
import PostgREST.DbStructure.Relationship (Cardinality (..), import PostgREST.SchemaCache.Proc (ProcParam (..))
import PostgREST.SchemaCache.Relationship (Cardinality (..),
Junction (..), Junction (..),
Relationship (..)) Relationship (..))
import PostgREST.Request.Preferences (PreferResolution (..))
import PostgREST.ApiRequest.Types
import PostgREST.Plan.CallPlan import PostgREST.Plan.CallPlan
import PostgREST.Plan.MutatePlan import PostgREST.Plan.MutatePlan
import PostgREST.Plan.ReadPlan import PostgREST.Plan.ReadPlan
import PostgREST.Query.SqlFragment import PostgREST.Query.SqlFragment
import PostgREST.RangeQuery (allRange) import PostgREST.RangeQuery (allRange)
import PostgREST.Request.Types
import Protolude import Protolude
src/PostgREST/Query/SqlFragment.hs
+7 -7
View File
@@ -56,13 +56,7 @@ import Control.Arrow ((***))
import Data.Foldable (foldr1) import Data.Foldable (foldr1)
import Text.InterpolatedString.Perl6 (qc) import Text.InterpolatedString.Perl6 (qc)
import PostgREST.DbStructure.Identifiers (FieldName, import PostgREST.ApiRequest.Types (Alias, Field, Filter (..),
QualifiedIdentifier (..))
import PostgREST.MediaType (MTPlanFormat (..),
MTPlanOption (..))
import PostgREST.RangeQuery (NonnegRange, allRange,
rangeLimit, rangeOffset)
import PostgREST.Request.Types (Alias, Field, Filter (..),
FtsOperator (..), FtsOperator (..),
JoinCondition (..), JoinCondition (..),
JsonOperand (..), JsonOperand (..),
@@ -76,6 +70,12 @@ import PostgREST.Request.Types (Alias, Field, Filter (..),
OrderTerm (..), SelectItem, OrderTerm (..), SelectItem,
SimpleOperator (..), SimpleOperator (..),
TrileanVal (..)) TrileanVal (..))
import PostgREST.MediaType (MTPlanFormat (..),
MTPlanOption (..))
import PostgREST.RangeQuery (NonnegRange, allRange,
rangeLimit, rangeOffset)
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier (..))
import Protolude hiding (cast) import Protolude hiding (cast)
src/PostgREST/Query/Statements.hs
+2 -2
View File
@@ -25,13 +25,13 @@ import qualified Hasql.Statement as SQL
import Control.Lens ((^?)) import Control.Lens ((^?))
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import PostgREST.DbStructure.Identifiers (FieldName) import PostgREST.ApiRequest.Preferences
import PostgREST.MediaType (MTPlanAttrs (..), import PostgREST.MediaType (MTPlanAttrs (..),
MTPlanFormat (..), MTPlanFormat (..),
MediaType (..), MediaType (..),
getMediaType) getMediaType)
import PostgREST.Query.SqlFragment import PostgREST.Query.SqlFragment
import PostgREST.Request.Preferences import PostgREST.SchemaCache.Identifiers (FieldName)
import Protolude import Protolude
src/PostgREST/Response.hs
+30 -26
View File
@@ -30,32 +30,30 @@ import qualified PostgREST.MediaType as MediaType
import qualified PostgREST.RangeQuery as RangeQuery import qualified PostgREST.RangeQuery as RangeQuery
import qualified PostgREST.Response.OpenAPI as OpenAPI import qualified PostgREST.Response.OpenAPI as OpenAPI
import PostgREST.ApiRequest (ApiRequest (..),
InvokeMethod (..),
Target (..))
import PostgREST.ApiRequest.Preferences (PreferRepresentation (..),
PreferTransaction (..),
shouldCount,
toAppliedHeader)
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.DbStructure (DbStructure (..))
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
Schema)
import PostgREST.DbStructure.Proc (ProcDescription (..),
ProcVolatility (..),
ProcsMap)
import PostgREST.DbStructure.Table (Table (..), TablesMap)
import PostgREST.GucHeader (GucHeader,
addHeadersIfNotIncluded,
unwrapGucHeader)
import PostgREST.MediaType (MediaType (..)) import PostgREST.MediaType (MediaType (..))
import PostgREST.Plan (MutateReadPlan (..)) import PostgREST.Plan (MutateReadPlan (..))
import PostgREST.Plan.MutatePlan (MutatePlan (..)) import PostgREST.Plan.MutatePlan (MutatePlan (..))
import PostgREST.Query.Statements (ResultSet (..)) import PostgREST.Query.Statements (ResultSet (..))
import PostgREST.Request.ApiRequest (ApiRequest (..), import PostgREST.Response.GucHeader (GucHeader, unwrapGucHeader)
InvokeMethod (..), import PostgREST.SchemaCache (SchemaCache (..))
Target (..)) import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
import PostgREST.Request.Preferences (PreferRepresentation (..), Schema)
PreferTransaction (..), import PostgREST.SchemaCache.Proc (ProcDescription (..),
shouldCount, ProcVolatility (..),
toAppliedHeader) ProcsMap)
import PostgREST.Request.QueryParams (QueryParams (..)) import PostgREST.SchemaCache.Table (Table (..), TablesMap)
import qualified PostgREST.DbStructure.Proc as Proc import qualified PostgREST.ApiRequest.Types as ApiRequestTypes
import qualified PostgREST.Request.Types as ApiRequestTypes import qualified PostgREST.SchemaCache.Proc as Proc
import Protolude hiding (Handler, toS) import Protolude hiding (Handler, toS)
import Protolude.Conv (toS) import Protolude.Conv (toS)
@@ -176,11 +174,11 @@ deleteResponse ctxApiRequest@ApiRequest{..} resultSet = case resultSet of
RSPlan plan -> RSPlan plan ->
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
infoResponse :: Target -> DbStructure -> Wai.Response infoResponse :: Target -> SchemaCache -> Wai.Response
infoResponse target dbStructure = infoResponse target sCache =
case target of case target of
TargetIdent identifier -> TargetIdent identifier ->
case HM.lookup identifier (dbTables dbStructure) of case HM.lookup identifier (dbTables sCache) of
Just tbl -> respondInfo $ allowH tbl Just tbl -> respondInfo $ allowH tbl
Nothing -> Error.errorResponseFor $ Error.ApiRequestError ApiRequestTypes.NotFound Nothing -> Error.errorResponseFor $ Error.ApiRequestError ApiRequestTypes.NotFound
TargetProc pd _ TargetProc pd _
@@ -222,11 +220,11 @@ invokeResponse invMethod proc ctxApiRequest@ApiRequest{..} resultSet = case resu
RSPlan plan -> RSPlan plan ->
Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan Wai.responseLBS HTTP.status200 (contentTypeHeaders ctxApiRequest) $ LBS.fromStrict plan
openApiResponse :: Bool -> Maybe (TablesMap, ProcsMap, Maybe Text) -> AppConfig -> DbStructure -> Schema -> Bool -> Wai.Response openApiResponse :: Bool -> Maybe (TablesMap, ProcsMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Wai.Response
openApiResponse headersOnly body conf dbStructure schema negotiatedByProfile = openApiResponse headersOnly body conf sCache schema negotiatedByProfile =
Wai.responseLBS HTTP.status200 Wai.responseLBS HTTP.status200
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile)) (MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile))
(maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode conf dbStructure x y z) body) (maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode conf sCache x y z) body)
-- | Response with headers and status overridden from GUCs. -- | Response with headers and status overridden from GUCs.
gucResponse gucResponse
@@ -287,3 +285,9 @@ optionalRollback AppConfig{..} ApiRequest{..} resp = do
[toAppliedHeader Rollback] [toAppliedHeader Rollback]
| otherwise = | otherwise =
identity identity
-- | Add headers not already included to allow the user to override them instead of duplicating them
addHeadersIfNotIncluded :: [HTTP.Header] -> [HTTP.Header] -> [HTTP.Header]
addHeadersIfNotIncluded newHeaders initialHeaders =
filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++
initialHeaders
src/PostgREST/GucHeader.hs → src/PostgREST/Response/GucHeader.hs
+1 -8
View File
@@ -1,7 +1,6 @@
module PostgREST.GucHeader module PostgREST.Response.GucHeader
( GucHeader ( GucHeader
, unwrapGucHeader , unwrapGucHeader
, addHeadersIfNotIncluded
) where ) where
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
@@ -29,9 +28,3 @@ instance JSON.FromJSON GucHeader where
unwrapGucHeader :: GucHeader -> Header unwrapGucHeader :: GucHeader -> Header
unwrapGucHeader (GucHeader (k, v)) = (k, v) unwrapGucHeader (GucHeader (k, v)) = (k, v)
-- | Add headers not already included to allow the user to override them instead of duplicating them
addHeadersIfNotIncluded :: [Header] -> [Header] -> [Header]
addHeadersIfNotIncluded newHeaders initialHeaders =
filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++
initialHeaders
src/PostgREST/Response/OpenAPI.hs
+8 -8
View File
@@ -26,14 +26,14 @@ import Data.Swagger
import PostgREST.Config (AppConfig (..), Proxy (..), import PostgREST.Config (AppConfig (..), Proxy (..),
isMalformedProxyUri, toURI) isMalformedProxyUri, toURI)
import PostgREST.DbStructure (DbStructure (..)) import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..)) import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
import PostgREST.DbStructure.Proc (ProcDescription (..), import PostgREST.SchemaCache.Proc (ProcDescription (..),
ProcParam (..)) ProcParam (..))
import PostgREST.DbStructure.Relationship (Cardinality (..), import PostgREST.SchemaCache.Relationship (Cardinality (..),
Relationship (..), Relationship (..),
RelationshipsMap) RelationshipsMap)
import PostgREST.DbStructure.Table (Column (..), Table (..), import PostgREST.SchemaCache.Table (Column (..), Table (..),
TablesMap) TablesMap)
import PostgREST.Version (docsVersion, prettyVersion) import PostgREST.Version (docsVersion, prettyVersion)
@@ -41,11 +41,11 @@ import PostgREST.MediaType
import Protolude hiding (Proxy, get) import Protolude hiding (Proxy, get)
encode :: AppConfig -> DbStructure -> TablesMap -> HM.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString encode :: AppConfig -> SchemaCache -> TablesMap -> HM.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
encode conf dbStructure tables procs schemaDescription = encode conf sCache tables procs schemaDescription =
JSON.encode $ JSON.encode $
postgrestSpec postgrestSpec
(dbRelationships dbStructure) (dbRelationships sCache)
(concat $ HM.elems procs) (concat $ HM.elems procs)
(snd <$> HM.toList tables) (snd <$> HM.toList tables)
(proxyUri conf) (proxyUri conf)
src/PostgREST/DbStructure.hs → src/PostgREST/SchemaCache.hs
+16 -16
View File
@@ -1,8 +1,8 @@
{-| {-|
Module : PostgREST.DbStructure Module : PostgREST.SchemaCache
Description : PostgREST schema cache Description : PostgREST schema cache
This module contains queries that target PostgreSQL system catalogs, these are used to build the schema cache(DbStructure). This module(used to be named DbStructure) contains queries that target PostgreSQL system catalogs, these are used to build the schema cache(SchemaCache).
The schema cache is necessary for resource embedding, foreign keys are used for inferring the relationships between tables. The schema cache is necessary for resource embedding, foreign keys are used for inferring the relationships between tables.
@@ -18,9 +18,9 @@ These queries are executed once at startup or when PostgREST is reloaded.
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
module PostgREST.DbStructure module PostgREST.SchemaCache
( DbStructure(..) ( SchemaCache(..)
, queryDbStructure , querySchemaCache
, accessibleTables , accessibleTables
, accessibleProcs , accessibleProcs
, schemaDescription , schemaDescription
@@ -40,25 +40,25 @@ import Text.InterpolatedString.Perl6 (q)
import PostgREST.Config.Database (pgVersionStatement) import PostgREST.Config.Database (pgVersionStatement)
import PostgREST.Config.PgVersion (PgVersion, pgVersion100, import PostgREST.Config.PgVersion (PgVersion, pgVersion100,
pgVersion110) pgVersion110)
import PostgREST.DbStructure.Identifiers (FieldName, import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier (..), QualifiedIdentifier (..),
Schema) Schema)
import PostgREST.DbStructure.Proc (PgType (..), import PostgREST.SchemaCache.Proc (PgType (..),
ProcDescription (..), ProcDescription (..),
ProcParam (..), ProcParam (..),
ProcVolatility (..), ProcVolatility (..),
ProcsMap, RetType (..)) ProcsMap, RetType (..))
import PostgREST.DbStructure.Relationship (Cardinality (..), import PostgREST.SchemaCache.Relationship (Cardinality (..),
Junction (..), Junction (..),
Relationship (..), Relationship (..),
RelationshipsMap) RelationshipsMap)
import PostgREST.DbStructure.Table (Column (..), Table (..), import PostgREST.SchemaCache.Table (Column (..), Table (..),
TablesMap) TablesMap)
import Protolude import Protolude
data DbStructure = DbStructure data SchemaCache = SchemaCache
{ dbTables :: TablesMap { dbTables :: TablesMap
, dbRelationships :: RelationshipsMap , dbRelationships :: RelationshipsMap
, dbProcs :: ProcsMap , dbProcs :: ProcsMap
@@ -82,8 +82,8 @@ data KeyDep
-- | A SQL query that can be executed independently -- | A SQL query that can be executed independently
type SqlQuery = ByteString type SqlQuery = ByteString
queryDbStructure :: [Schema] -> [Schema] -> Bool -> SQL.Transaction DbStructure querySchemaCache :: [Schema] -> [Schema] -> Bool -> SQL.Transaction SchemaCache
queryDbStructure schemas extraSearchPath prepared = do querySchemaCache schemas extraSearchPath prepared = do
SQL.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object SQL.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object
pgVer <- SQL.statement mempty pgVersionStatement pgVer <- SQL.statement mempty pgVersionStatement
tabs <- SQL.statement schemas $ allTables pgVer prepared tabs <- SQL.statement schemas $ allTables pgVer prepared
@@ -95,7 +95,7 @@ queryDbStructure schemas extraSearchPath prepared = do
let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps
rels = addInverseRels $ addM2MRels tabsWViewsPks $ addViewM2OAndO2ORels keyDeps m2oRels rels = addInverseRels $ addM2MRels tabsWViewsPks $ addViewM2OAndO2ORels keyDeps m2oRels
return $ removeInternal schemas $ DbStructure { return $ removeInternal schemas $ SchemaCache {
dbTables = tabsWViewsPks dbTables = tabsWViewsPks
, dbRelationships = getOverrideRelationshipsMap rels cRels , dbRelationships = getOverrideRelationshipsMap rels cRels
, dbProcs = procs , dbProcs = procs
@@ -121,10 +121,10 @@ getOverrideRelationshipsMap rels cRels =
deformedRelMap = HM.fromListWith (++) . fmap addDeformedRelKey . HM.toList deformedRelMap = HM.fromListWith (++) . fmap addDeformedRelKey . HM.toList
addDeformedRelKey ((relT, relFT), rls) = ((relT, qiSchema relFT), rls) addDeformedRelKey ((relT, relFT), rls) = ((relT, qiSchema relFT), rls)
-- | Remove db objects that belong to an internal schema(not exposed through the API) from the DbStructure. -- | Remove db objects that belong to an internal schema(not exposed through the API) from the SchemaCache.
removeInternal :: [Schema] -> DbStructure -> DbStructure removeInternal :: [Schema] -> SchemaCache -> SchemaCache
removeInternal schemas dbStruct = removeInternal schemas dbStruct =
DbStructure { SchemaCache {
dbTables = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct dbTables = HM.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct
, dbRelationships = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$> , dbRelationships = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$>
HM.filterWithKey (\(QualifiedIdentifier sch _, _) _ -> sch `elem` schemas ) (dbRelationships dbStruct) HM.filterWithKey (\(QualifiedIdentifier sch _, _) _ -> sch `elem` schemas ) (dbRelationships dbStruct)
src/PostgREST/DbStructure/Identifiers.hs → src/PostgREST/SchemaCache/Identifiers.hs
+1 -1
View File
@@ -1,7 +1,7 @@
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
module PostgREST.DbStructure.Identifiers module PostgREST.SchemaCache.Identifiers
( QualifiedIdentifier(..) ( QualifiedIdentifier(..)
, Schema , Schema
, TableName , TableName
src/PostgREST/DbStructure/Proc.hs → src/PostgREST/SchemaCache/Proc.hs
+2 -2
View File
@@ -1,7 +1,7 @@
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
module PostgREST.DbStructure.Proc module PostgREST.SchemaCache.Proc
( PgType(..) ( PgType(..)
, ProcDescription(..) , ProcDescription(..)
, ProcParam(..) , ProcParam(..)
@@ -17,7 +17,7 @@ module PostgREST.DbStructure.Proc
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..), import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
Schema, TableName) Schema, TableName)
import Protolude import Protolude
src/PostgREST/DbStructure/Relationship.hs → src/PostgREST/SchemaCache/Relationship.hs
+2 -2
View File
@@ -1,7 +1,7 @@
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
module PostgREST.DbStructure.Relationship module PostgREST.SchemaCache.Relationship
( Cardinality(..) ( Cardinality(..)
, Relationship(..) , Relationship(..)
, Junction(..) , Junction(..)
@@ -11,7 +11,7 @@ module PostgREST.DbStructure.Relationship
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import PostgREST.DbStructure.Identifiers (FieldName, import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier, Schema) QualifiedIdentifier, Schema)
import Protolude import Protolude
src/PostgREST/DbStructure/Table.hs → src/PostgREST/SchemaCache/Table.hs
+2 -2
View File
@@ -1,7 +1,7 @@
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
module PostgREST.DbStructure.Table module PostgREST.SchemaCache.Table
( Column(..) ( Column(..)
, Table(..) , Table(..)
, TablesMap , TablesMap
@@ -10,7 +10,7 @@ module PostgREST.DbStructure.Table
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import PostgREST.DbStructure.Identifiers (FieldName, import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier (..), QualifiedIdentifier (..),
Schema, TableName) Schema, TableName)
src/PostgREST/Unix.hs
+1 -1
View File
@@ -47,7 +47,7 @@ installSignalHandlers appState = do
install Signals.sigINT interrupt install Signals.sigINT interrupt
install Signals.sigTERM interrupt install Signals.sigTERM interrupt
-- The SIGUSR1 signal updates the internal 'DbStructure' by running -- The SIGUSR1 signal updates the internal 'SchemaCache' by running
-- 'connectionWorker' exactly as before. -- 'connectionWorker' exactly as before.
install Signals.sigUSR1 $ Workers.connectionWorker appState install Signals.sigUSR1 $ Workers.connectionWorker appState
src/PostgREST/Workers.hs
+89 -10
View File
@@ -1,30 +1,40 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
module PostgREST.Workers module PostgREST.Workers
( connectionWorker ( connectionWorker
, reReadConfig , reReadConfig
, listener , runListener
, runAdmin
) where ) where
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding as T
import qualified Hasql.Notifications as SQL import qualified Hasql.Notifications as SQL
import qualified Hasql.Session as SQL
import qualified Hasql.Transaction.Sessions as SQL import qualified Hasql.Transaction.Sessions as SQL
import qualified Network.HTTP.Types.Status as HTTP
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import Control.Retry (RetryStatus, capDelay, exponentialBackoff, import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
retrying, rsPreviousDelay) retrying, rsPreviousDelay)
import Hasql.Connection (acquire) import Hasql.Connection (acquire)
import Network.Socket
import Network.Socket.ByteString
import PostgREST.AppState (AppState) import PostgREST.AppState (AppState)
import PostgREST.Config (AppConfig (..), readAppConfig) import PostgREST.Config (AppConfig (..), readAppConfig)
import PostgREST.Config.Database (queryDbSettings, queryPgVersion) import PostgREST.Config.Database (queryDbSettings, queryPgVersion)
import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion) import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
import PostgREST.DbStructure (queryDbStructure)
import PostgREST.Error (PgError (PgError), checkIsFatal, import PostgREST.Error (PgError (PgError), checkIsFatal,
errorPayload) errorPayload)
import PostgREST.SchemaCache (querySchemaCache)
import qualified PostgREST.AppState as AppState import qualified PostgREST.AppState as AppState
@@ -45,7 +55,7 @@ data SCacheStatus
| SCFatalFail | SCFatalFail
-- | The purpose of this worker is to obtain a healthy connection to pg and an -- | The purpose of this worker is to obtain a healthy connection to pg and an
-- up-to-date schema cache(DbStructure). This method is meant to be called -- up-to-date schema cache(SchemaCache). This method is meant to be called
-- multiple times by the same thread, but does nothing if the previous -- multiple times by the same thread, but does nothing if the previous
-- invocation has not terminated. In all cases this method does not halt the -- invocation has not terminated. In all cases this method does not halt the
-- calling thread, the work is performed in a separate thread. -- calling thread, the work is performed in a separate thread.
@@ -54,7 +64,7 @@ data SCacheStatus
-- 1. Tries to connect to pg server and will keep trying until success. -- 1. Tries to connect to pg server and will keep trying until success.
-- 2. Checks if the pg version is supported and if it's not it kills the main -- 2. Checks if the pg version is supported and if it's not it kills the main
-- program. -- program.
-- 3. Obtains the dbStructure. If this fails, it goes back to 1. -- 3. Obtains the sCache. If this fails, it goes back to 1.
connectionWorker :: AppState -> IO () connectionWorker :: AppState -> IO ()
connectionWorker appState = do connectionWorker appState = do
runExclusively (AppState.getWorkerSem appState) work runExclusively (AppState.getWorkerSem appState) work
@@ -148,14 +158,14 @@ establishConnection appState =
when itShould $ AppState.putRetryNextIn appState delay when itShould $ AppState.putRetryNextIn appState delay
return itShould return itShould
-- | Load the DbStructure by using a connection from the pool. -- | Load the SchemaCache by using a connection from the pool.
loadSchemaCache :: AppState -> IO SCacheStatus loadSchemaCache :: AppState -> IO SCacheStatus
loadSchemaCache appState = do loadSchemaCache appState = do
AppConfig{..} <- AppState.getConfig appState AppConfig{..} <- AppState.getConfig appState
result <- result <-
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
AppState.usePool appState . transaction SQL.ReadCommitted SQL.Read $ AppState.usePool appState . transaction SQL.ReadCommitted SQL.Read $
queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements querySchemaCache (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
case result of case result of
Left e -> do Left e -> do
let let
@@ -168,18 +178,22 @@ loadSchemaCache appState = do
AppState.logWithZTime appState hint AppState.logWithZTime appState hint
return SCFatalFail return SCFatalFail
Nothing -> do Nothing -> do
AppState.putDbStructure appState Nothing AppState.putSchemaCache appState Nothing
AppState.logWithZTime appState "An error ocurred when loading the schema cache" AppState.logWithZTime appState "An error ocurred when loading the schema cache"
putErr putErr
return SCOnRetry return SCOnRetry
Right dbStructure -> do Right sCache -> do
AppState.putDbStructure appState (Just dbStructure) AppState.putSchemaCache appState (Just sCache)
when (isJust configDbRootSpec) . when (isJust configDbRootSpec) .
AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode dbStructure AppState.putJsonDbS appState . LBS.toStrict $ JSON.encode sCache
AppState.logWithZTime appState "Schema cache loaded" AppState.logWithZTime appState "Schema cache loaded"
return SCLoaded return SCLoaded
runListener :: AppConfig -> AppState -> IO ()
runListener AppConfig{configDbChannelEnabled} appState =
when configDbChannelEnabled $ listener appState
-- | Starts a dedicated pg connection to LISTEN for notifications. When a -- | Starts a dedicated pg connection to LISTEN for notifications. When a
-- NOTIFY <db-channel> - with an empty payload - is done, it refills the schema -- NOTIFY <db-channel> - with an empty payload - is done, it refills the schema
-- cache. It uses the connectionWorker in case the LISTEN connection dies. -- cache. It uses the connectionWorker in case the LISTEN connection dies.
@@ -264,3 +278,68 @@ reReadConfig startingUp appState = do
pass pass
else else
AppState.logWithZTime appState "Config reloaded" AppState.logWithZTime appState "Config reloaded"
runAdmin :: AppConfig -> AppState -> Warp.Settings -> IO ()
runAdmin conf@AppConfig{configAdminServerPort} appState settings =
whenJust configAdminServerPort $ \adminPort -> do
AppState.logWithZTime appState $ "Admin server listening on port " <> show adminPort
void . forkIO $ Warp.runSettings (settings & Warp.setPort adminPort) adminApp
where
whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
whenJust mg f = maybe (pure ()) f mg
adminApp = admin appState conf
-- | PostgREST admin application
admin :: AppState.AppState -> AppConfig -> Wai.Application
admin appState appConfig req respond = do
isMainAppReachable <- any isRight <$> reachMainApp appConfig
isSchemaCacheLoaded <- isJust <$> AppState.getSchemaCache appState
isConnectionUp <-
if configDbChannelEnabled appConfig
then AppState.getIsListenerOn appState
else isRight <$> AppState.usePool appState (SQL.sql "SELECT 1")
case Wai.pathInfo req of
["ready"] ->
respond $ Wai.responseLBS (if isMainAppReachable && isConnectionUp && isSchemaCacheLoaded then HTTP.status200 else HTTP.status503) [] mempty
["live"] ->
respond $ Wai.responseLBS (if isMainAppReachable then HTTP.status200 else HTTP.status503) [] mempty
_ ->
respond $ Wai.responseLBS HTTP.status404 [] mempty
-- Try to connect to the main app socket
-- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections
-- The code for resolving the "*4", "!4", "*6", "!6", "*" special values is taken from
-- https://hackage.haskell.org/package/streaming-commons-0.2.2.4/docs/src/Data.Streaming.Network.html#bindPortGenEx
reachMainApp :: AppConfig -> IO [Either IOException ()]
reachMainApp AppConfig{..} =
case configServerUnixSocket of
Just path -> do
sock <- socket AF_UNIX Stream 0
(:[]) <$> try (do
connect sock $ SockAddrUnix path
withSocketsDo $ bracket (pure sock) close sendEmpty)
Nothing -> do
let
host | configServerHost `elem` ["*4", "!4", "*6", "!6", "*"] = Nothing
| otherwise = Just configServerHost
filterAddrs xs =
case configServerHost of
"*4" -> ipv4Addrs xs ++ ipv6Addrs xs
"!4" -> ipv4Addrs xs
"*6" -> ipv6Addrs xs ++ ipv4Addrs xs
"!6" -> ipv6Addrs xs
_ -> xs
ipv4Addrs = filter ((/=) AF_INET6 . addrFamily)
ipv6Addrs = filter ((==) AF_INET6 . addrFamily)
addrs <- getAddrInfo (Just $ defaultHints { addrSocketType = Stream }) (T.unpack <$> host) (Just . show $ configServerPort)
tryAddr `traverse` filterAddrs addrs
where
sendEmpty sock = void $ send sock mempty
tryAddr :: AddrInfo -> IO (Either IOException ())
tryAddr addr = do
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
try $ do
connect sock $ addrAddress addr
withSocketsDo $ bracket (pure sock) close sendEmpty
test/doc/Main.hs
+2 -2
View File
@@ -13,6 +13,6 @@ main =
, "-XStandaloneDeriving" , "-XStandaloneDeriving"
, "-isrc" , "-isrc"
, "src/PostgREST/Query/SqlFragment.hs" , "src/PostgREST/Query/SqlFragment.hs"
, "src/PostgREST/Request/Preferences.hs" , "src/PostgREST/ApiRequest/Preferences.hs"
, "src/PostgREST/Request/QueryParams.hs" , "src/PostgREST/ApiRequest/QueryParams.hs"
] ]
test/spec/Main.hs
+13 -13
View File
@@ -12,7 +12,7 @@ import Test.Hspec
import PostgREST.App (postgrest) import PostgREST.App (postgrest)
import PostgREST.Config (AppConfig (..), LogLevel (..)) import PostgREST.Config (AppConfig (..), LogLevel (..))
import PostgREST.Config.Database (queryPgVersion) import PostgREST.Config.Database (queryPgVersion)
import PostgREST.DbStructure (queryDbStructure) import PostgREST.SchemaCache (querySchemaCache)
import Protolude hiding (toList, toS) import Protolude hiding (toList, toS)
import Protolude.Conv (toS) import Protolude.Conv (toS)
import SpecHelper import SpecHelper
@@ -68,32 +68,32 @@ main = do
actualPgVersion <- either (panic . show) id <$> P.use pool queryPgVersion actualPgVersion <- either (panic . show) id <$> P.use pool queryPgVersion
baseDbStructure <- baseSchemaCache <-
loadDbStructure pool loadSchemaCache pool
(configDbSchemas testCfg) (configDbSchemas testCfg)
(configDbExtraSearchPath testCfg) (configDbExtraSearchPath testCfg)
let let
-- For tests that run with the same refDbStructure -- For tests that run with the same refSchemaCache
app config = do app config = do
appState <- AppState.initWithPool pool config appState <- AppState.initWithPool pool config
AppState.putPgVersion appState actualPgVersion AppState.putPgVersion appState actualPgVersion
AppState.putDbStructure appState (Just baseDbStructure) AppState.putSchemaCache appState (Just baseSchemaCache)
when (isJust $ configDbRootSpec config) $ when (isJust $ configDbRootSpec config) $
AppState.putJsonDbS appState $ toS $ JSON.encode baseDbStructure AppState.putJsonDbS appState $ toS $ JSON.encode baseSchemaCache
return ((), postgrest LogCrit appState $ pure ()) return ((), postgrest LogCrit appState $ pure ())
-- For tests that run with a different DbStructure(depends on configSchemas) -- For tests that run with a different SchemaCache(depends on configSchemas)
appDbs config = do appDbs config = do
customDbStructure <- customSchemaCache <-
loadDbStructure pool loadSchemaCache pool
(configDbSchemas config) (configDbSchemas config)
(configDbExtraSearchPath config) (configDbExtraSearchPath config)
appState <- AppState.initWithPool pool config appState <- AppState.initWithPool pool config
AppState.putPgVersion appState actualPgVersion AppState.putPgVersion appState actualPgVersion
AppState.putDbStructure appState (Just customDbStructure) AppState.putSchemaCache appState (Just customSchemaCache)
when (isJust $ configDbRootSpec config) $ when (isJust $ configDbRootSpec config) $
AppState.putJsonDbS appState $ toS $ JSON.encode baseDbStructure AppState.putJsonDbS appState $ toS $ JSON.encode baseSchemaCache
return ((), postgrest LogCrit appState $ pure ()) return ((), postgrest LogCrit appState $ pure ())
let withApp = app testCfg let withApp = app testCfg
@@ -259,5 +259,5 @@ main = do
describe "Feature.RollbackForcedSpec" Feature.RollbackSpec.forced describe "Feature.RollbackForcedSpec" Feature.RollbackSpec.forced
where where
loadDbStructure pool schemas extraSearchPath = loadSchemaCache pool schemas extraSearchPath =
either (panic.show) id <$> P.use pool (HT.transaction HT.ReadCommitted HT.Read $ queryDbStructure (toList schemas) extraSearchPath True) either (panic.show) id <$> P.use pool (HT.transaction HT.ReadCommitted HT.Read $ querySchemaCache (toList schemas) extraSearchPath True)
test/spec/QueryCost.hs
+2 -2
View File
@@ -17,8 +17,8 @@ import Protolude hiding (get, toS)
import PostgREST.Plan.CallPlan import PostgREST.Plan.CallPlan
import PostgREST.Query.QueryBuilder (callPlanToQuery) import PostgREST.Query.QueryBuilder (callPlanToQuery)
import PostgREST.DbStructure.Identifiers import PostgREST.SchemaCache.Identifiers
import PostgREST.DbStructure.Proc import PostgREST.SchemaCache.Proc
import Test.Hspec import Test.Hspec
test/spec/SpecHelper.hs
+1 -1
View File
@@ -26,8 +26,8 @@ import PostgREST.Config (AppConfig (..),
LogLevel (..), LogLevel (..),
OpenAPIMode (..), OpenAPIMode (..),
parseSecret) parseSecret)
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
import PostgREST.MediaType (MediaType (..)) import PostgREST.MediaType (MediaType (..))
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
import Protolude hiding (get, toS) import Protolude hiding (get, toS)
import Protolude.Conv (toS) import Protolude.Conv (toS)