refactor: Split up Types.hs and logically organize modules (#1793)
This commit is contained in:
+25
-10
@@ -30,17 +30,18 @@ import System.CPUTime (getCPUTime)
|
||||
import System.IO (BufferMode (..), hSetBuffering)
|
||||
import Text.Printf (hPrintf)
|
||||
|
||||
import PostgREST.App (postgrest)
|
||||
import PostgREST.App (postgrest)
|
||||
import PostgREST.Config
|
||||
import PostgREST.DbStructure (getDbStructure, getPgVersion)
|
||||
import PostgREST.Error (PgError (PgError), checkIsFatal,
|
||||
errorPayload)
|
||||
import PostgREST.Statements (dbSettingsStatement)
|
||||
import PostgREST.Types (ConnectionStatus (..), DbStructure,
|
||||
PgVersion (..), SCacheStatus (..),
|
||||
minimumPgVersion)
|
||||
import Protolude hiding (hPutStrLn, head, toS)
|
||||
import Protolude.Conv (toS)
|
||||
import PostgREST.DbStructure (DbStructure, getDbStructure,
|
||||
getPgVersion)
|
||||
import PostgREST.DbStructure.PgVersion (PgVersion (..),
|
||||
minimumPgVersion)
|
||||
import PostgREST.Error (PgError (PgError),
|
||||
checkIsFatal, errorPayload)
|
||||
import PostgREST.Query.Statements (dbSettingsStatement)
|
||||
|
||||
import Protolude hiding (hPutStrLn, head, toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
|
||||
#ifndef mingw32_HOST_OS
|
||||
@@ -48,6 +49,20 @@ import System.Posix.Signals
|
||||
import UnixSocket
|
||||
#endif
|
||||
|
||||
|
||||
-- | Current database connection status data ConnectionStatus
|
||||
data ConnectionStatus
|
||||
= NotConnected
|
||||
| Connected PgVersion
|
||||
| FatalConnectionError Text
|
||||
deriving (Eq)
|
||||
|
||||
-- | Schema cache status
|
||||
data SCacheStatus
|
||||
= SCLoaded
|
||||
| SCOnRetry
|
||||
| SCFatalFail
|
||||
|
||||
-- | This is where everything starts.
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
||||
+18
-10
@@ -34,24 +34,32 @@ library
|
||||
default-extensions: OverloadedStrings
|
||||
NoImplicitPrelude
|
||||
hs-source-dirs: src
|
||||
exposed-modules: PostgREST.ApiRequest
|
||||
PostgREST.App
|
||||
exposed-modules: PostgREST.App
|
||||
PostgREST.Auth
|
||||
PostgREST.Config
|
||||
PostgREST.DbRequestBuilder
|
||||
PostgREST.Config.JSPath
|
||||
PostgREST.Config.Proxy
|
||||
PostgREST.ContentType
|
||||
PostgREST.DbStructure
|
||||
PostgREST.DbStructure.Identifiers
|
||||
PostgREST.DbStructure.PgVersion
|
||||
PostgREST.DbStructure.Proc
|
||||
PostgREST.DbStructure.Relation
|
||||
PostgREST.DbStructure.Table
|
||||
PostgREST.Error
|
||||
PostgREST.GucHeader
|
||||
PostgREST.Middleware
|
||||
PostgREST.OpenAPI
|
||||
PostgREST.Parsers
|
||||
PostgREST.QueryBuilder
|
||||
PostgREST.Statements
|
||||
PostgREST.Query.QueryBuilder
|
||||
PostgREST.Query.SqlFragment
|
||||
PostgREST.Query.Statements
|
||||
PostgREST.RangeQuery
|
||||
PostgREST.Types
|
||||
PostgREST.Request.ApiRequest
|
||||
PostgREST.Request.DbRequestBuilder
|
||||
PostgREST.Request.Parsers
|
||||
PostgREST.Request.Preferences
|
||||
PostgREST.Request.Types
|
||||
other-modules: Paths_postgrest
|
||||
PostgREST.Private.Common
|
||||
PostgREST.Private.ProxyUri
|
||||
PostgREST.Private.QueryFragment
|
||||
build-depends: base >= 4.9 && < 4.15
|
||||
, HTTP >= 4000.3.7 && < 4000.4
|
||||
, Ranged-sets >= 0.3 && < 0.5
|
||||
|
||||
+43
-23
@@ -30,23 +30,43 @@ import qualified Network.HTTP.Types.Status as HTTP
|
||||
import qualified Network.HTTP.Types.URI as HTTP
|
||||
import qualified Network.Wai as Wai
|
||||
|
||||
import qualified PostgREST.ApiRequest as ApiRequest
|
||||
import qualified PostgREST.Auth as Auth
|
||||
import qualified PostgREST.DbRequestBuilder as ReqBuilder
|
||||
import qualified PostgREST.DbStructure as DbStructure
|
||||
import qualified PostgREST.Error as Error
|
||||
import qualified PostgREST.Middleware as Middleware
|
||||
import qualified PostgREST.OpenAPI as OpenAPI
|
||||
import qualified PostgREST.QueryBuilder as QueryBuilder
|
||||
import qualified PostgREST.RangeQuery as RangeQuery
|
||||
import qualified PostgREST.Statements as Statements
|
||||
import qualified PostgREST.Auth as Auth
|
||||
import qualified PostgREST.DbStructure as DbStructure
|
||||
import qualified PostgREST.Error as Error
|
||||
import qualified PostgREST.Middleware as Middleware
|
||||
import qualified PostgREST.OpenAPI as OpenAPI
|
||||
import qualified PostgREST.Query.QueryBuilder as QueryBuilder
|
||||
import qualified PostgREST.Query.Statements as Statements
|
||||
import qualified PostgREST.RangeQuery as RangeQuery
|
||||
import qualified PostgREST.Request.ApiRequest as ApiRequest
|
||||
import qualified PostgREST.Request.DbRequestBuilder as ReqBuilder
|
||||
|
||||
import PostgREST.ApiRequest (Action (..), ApiRequest (..),
|
||||
InvokeMethod (..), Target (..))
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.Error (Error)
|
||||
import PostgREST.Config (AppConfig (..),
|
||||
LogLevel (..))
|
||||
import PostgREST.ContentType (ContentType (..))
|
||||
import PostgREST.DbStructure (DbStructure (..),
|
||||
tablePKCols)
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema)
|
||||
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||
ProcVolatility (..))
|
||||
import PostgREST.DbStructure.Table (Table (..))
|
||||
import PostgREST.Error (Error)
|
||||
import PostgREST.GucHeader (GucHeader,
|
||||
addHeadersIfNotIncluded,
|
||||
unwrapGucHeader)
|
||||
import PostgREST.Request.ApiRequest (Action (..),
|
||||
ApiRequest (..),
|
||||
InvokeMethod (..),
|
||||
Target (..))
|
||||
import PostgREST.Request.Preferences (PreferCount (..),
|
||||
PreferParameters (..),
|
||||
PreferRepresentation (..))
|
||||
import PostgREST.Request.Types (ReadRequest, fstFieldNames)
|
||||
|
||||
import PostgREST.Types
|
||||
import qualified PostgREST.ContentType as ContentType
|
||||
import qualified PostgREST.DbStructure.Proc as Proc
|
||||
|
||||
import Protolude hiding (Handler, toS)
|
||||
import Protolude.Conv (toS)
|
||||
@@ -123,7 +143,7 @@ postgrestResponse conf@AppConfig{..} maybeDbStructure pool time req = do
|
||||
Just ct ->
|
||||
return ct
|
||||
Nothing ->
|
||||
throwError . Error.ContentTypeError $ map toMime iAccepts
|
||||
throwError . Error.ContentTypeError $ map ContentType.toMime iAccepts
|
||||
|
||||
let
|
||||
handleReq apiReq =
|
||||
@@ -352,9 +372,9 @@ handleInvoke invMethod proc context@RequestContext{..} = do
|
||||
identifier =
|
||||
QualifiedIdentifier
|
||||
(pdSchema proc)
|
||||
(fromMaybe (pdName proc) $ procTableName proc)
|
||||
(fromMaybe (pdName proc) $ Proc.procTableName proc)
|
||||
|
||||
returnsSingle (ApiRequest.TargetProc target _) = procReturnsSingle target
|
||||
returnsSingle (ApiRequest.TargetProc target _) = Proc.procReturnsSingle target
|
||||
returnsSingle _ = False
|
||||
|
||||
req <- readRequest identifier context
|
||||
@@ -367,7 +387,7 @@ handleInvoke invMethod proc context@RequestContext{..} = do
|
||||
(returnsSingle iTarget)
|
||||
(QueryBuilder.requestToCallProcQuery
|
||||
(QualifiedIdentifier (pdSchema proc) (pdName proc))
|
||||
(specifiedProcArgs iColumns proc)
|
||||
(Proc.specifiedProcArgs iColumns proc)
|
||||
iPayload
|
||||
(returnsScalar iTarget)
|
||||
iPreferParameters
|
||||
@@ -405,7 +425,7 @@ handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure
|
||||
|
||||
return $
|
||||
Wai.responseLBS HTTP.status200
|
||||
(toHeader CTOpenAPI : maybeToList (profileHeader apiRequest))
|
||||
(ContentType.toHeader CTOpenAPI : maybeToList (profileHeader apiRequest))
|
||||
(if headersOnly then mempty else toS body)
|
||||
|
||||
txMode :: ApiRequest -> SQL.Mode
|
||||
@@ -491,7 +511,7 @@ shouldCount preferCount =
|
||||
preferCount == Just ExactCount || preferCount == Just EstimatedCount
|
||||
|
||||
returnsScalar :: ApiRequest.Target -> Bool
|
||||
returnsScalar (TargetProc proc _) = procReturnsScalar proc
|
||||
returnsScalar (TargetProc proc _) = Proc.procReturnsScalar proc
|
||||
returnsScalar _ = False
|
||||
|
||||
readRequest :: Monad m => QualifiedIdentifier -> RequestContext -> Handler m ReadRequest
|
||||
@@ -503,7 +523,7 @@ readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure ap
|
||||
|
||||
contentTypeHeaders :: RequestContext -> [HTTP.Header]
|
||||
contentTypeHeaders RequestContext{..} =
|
||||
toHeader ctxContentType : maybeToList (profileHeader ctxApiRequest)
|
||||
ContentType.toHeader ctxContentType : maybeToList (profileHeader ctxApiRequest)
|
||||
|
||||
requestContentTypes :: AppConfig -> ApiRequest -> [ContentType]
|
||||
requestContentTypes conf ApiRequest{..} =
|
||||
@@ -542,7 +562,7 @@ binaryField RequestContext{..} readReq
|
||||
|
||||
rawContentTypes :: AppConfig -> [ContentType]
|
||||
rawContentTypes AppConfig{..} =
|
||||
(decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain]
|
||||
(ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain]
|
||||
|
||||
profileHeader :: ApiRequest -> Maybe HTTP.Header
|
||||
profileHeader ApiRequest{..} =
|
||||
|
||||
@@ -11,7 +11,11 @@ In the test suite there is an example of simple login function that can be used
|
||||
very simple authentication system inside the PostgreSQL database.
|
||||
-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module PostgREST.Auth (containsRole, jwtClaims, JWTClaims) where
|
||||
module PostgREST.Auth
|
||||
( containsRole
|
||||
, jwtClaims
|
||||
, JWTClaims
|
||||
) where
|
||||
|
||||
import qualified Crypto.JWT as JWT
|
||||
import qualified Data.Aeson as JSON
|
||||
@@ -23,9 +27,8 @@ import Control.Monad.Except (liftEither)
|
||||
import Data.Either.Combinators (mapLeft)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.Config (AppConfig (..), JSPath, JSPathExp (..))
|
||||
import PostgREST.Error (Error (..))
|
||||
import PostgREST.Types (JSPath, JSPathExp (..))
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
+54
-43
@@ -24,9 +24,11 @@ Other hardcoded options such as the minimum version number also belong here.
|
||||
module PostgREST.Config
|
||||
( prettyVersion
|
||||
, docsVersion
|
||||
, LogLevel(..)
|
||||
, CLI (..)
|
||||
, Command (..)
|
||||
, AppConfig (..)
|
||||
, Proxy(..)
|
||||
, configDbPoolTimeout'
|
||||
, dumpAppConfig
|
||||
, Environment
|
||||
@@ -36,6 +38,10 @@ module PostgREST.Config
|
||||
, readDbUriFile
|
||||
, readSecretFile
|
||||
, parseSecret
|
||||
, JSPath
|
||||
, JSPathExp(..)
|
||||
, isMalformedProxyUri
|
||||
, toURI
|
||||
) where
|
||||
|
||||
import qualified Crypto.JOSE.Types as JOSE
|
||||
@@ -46,6 +52,9 @@ import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.Configurator as C
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
|
||||
import qualified GHC.Show (show)
|
||||
|
||||
import Control.Lens (preview)
|
||||
import Control.Monad (fail)
|
||||
@@ -56,31 +65,25 @@ import Data.List (lookup)
|
||||
import Data.List.NonEmpty (fromList, toList)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Scientific (floatingOrInteger)
|
||||
import Data.Text (dropEnd, dropWhileEnd, filter,
|
||||
intercalate, pack, replace, splitOn,
|
||||
strip, stripPrefix, take, toLower,
|
||||
toTitle, unpack)
|
||||
import Data.Version (versionBranch)
|
||||
import Development.GitRev (gitHash)
|
||||
import Numeric (readOct, showOct)
|
||||
import Options.Applicative (Parser, customExecParser, flag,
|
||||
footer, fullDesc, help, helper, info,
|
||||
infoOption, long, metavar, prefs,
|
||||
progDesc, short, showHelpOnEmpty,
|
||||
showHelpOnError, strArgument)
|
||||
import Paths_postgrest (version)
|
||||
import System.Environment (getEnvironment)
|
||||
import System.Posix.Types (FileMode)
|
||||
import Text.Heredoc (str)
|
||||
|
||||
import Control.Applicative
|
||||
import Data.Monoid
|
||||
import Options.Applicative hiding (str)
|
||||
import Text.Heredoc (str)
|
||||
import PostgREST.Config.JSPath (JSPath, JSPathExp (..), pRoleClaimKey)
|
||||
import PostgREST.Config.Proxy (Proxy (..), isMalformedProxyUri,
|
||||
toURI)
|
||||
|
||||
import PostgREST.Parsers (pRoleClaimKey)
|
||||
import PostgREST.Private.ProxyUri (isMalformedProxyUri)
|
||||
import PostgREST.Types (JSPath, JSPathExp (..),
|
||||
LogLevel (..))
|
||||
import Protolude hiding (concat, filter, hPutStrLn,
|
||||
intercalate, null, replace, take,
|
||||
toList, toLower, toS, toTitle,
|
||||
(<>))
|
||||
import Protolude.Conv (toS)
|
||||
import Protolude hiding (Proxy, toList, toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
-- | Command line interface options
|
||||
data CLI = CLI
|
||||
@@ -128,19 +131,27 @@ configDbPoolTimeout' :: (Fractional a) => AppConfig -> a
|
||||
configDbPoolTimeout' =
|
||||
fromRational . toRational . configDbPoolTimeout
|
||||
|
||||
data LogLevel = LogCrit | LogError | LogWarn | LogInfo
|
||||
|
||||
instance Show LogLevel where
|
||||
show LogCrit = "crit"
|
||||
show LogError = "error"
|
||||
show LogWarn = "warn"
|
||||
show LogInfo = "info"
|
||||
|
||||
-- | User friendly version number
|
||||
prettyVersion :: Text
|
||||
prettyVersion =
|
||||
intercalate "." (map show $ versionBranch version) <> gitRev
|
||||
T.intercalate "." (map show $ versionBranch version) <> gitRev
|
||||
where
|
||||
gitRev =
|
||||
if $(gitHash) == "UNKNOWN"
|
||||
then mempty
|
||||
else " (" <> take 7 $(gitHash) <> ")"
|
||||
else " (" <> T.take 7 $(gitHash) <> ")"
|
||||
|
||||
-- | Version number used in docs
|
||||
docsVersion :: Text
|
||||
docsVersion = "v" <> dropEnd 1 (dropWhileEnd (/= '.') prettyVersion)
|
||||
docsVersion = "v" <> T.dropEnd 1 (T.dropWhileEnd (/= '.') prettyVersion)
|
||||
|
||||
-- | Read command line interface options. Also prints help.
|
||||
readCLIShowHelp :: Environment -> IO CLI
|
||||
@@ -280,36 +291,36 @@ dumpAppConfig conf =
|
||||
pgrstSettings = (\(k, v) -> (k, v conf)) <$>
|
||||
[("db-anon-role", q . configDbAnonRole)
|
||||
,("db-channel", q . configDbChannel)
|
||||
,("db-channel-enabled", toLower . show . configDbChannelEnabled)
|
||||
,("db-extra-search-path", q . intercalate "," . configDbExtraSearchPath)
|
||||
,("db-channel-enabled", T.toLower . show . configDbChannelEnabled)
|
||||
,("db-extra-search-path", q . T.intercalate "," . configDbExtraSearchPath)
|
||||
,("db-max-rows", maybe "\"\"" show . configDbMaxRows)
|
||||
,("db-pool", show . configDbPoolSize)
|
||||
,("db-pool-timeout", show . configDbPoolTimeout)
|
||||
,("db-pre-request", q . fromMaybe mempty . configDbPreRequest)
|
||||
,("db-prepared-statements", toLower . show . configDbPreparedStatements)
|
||||
,("db-prepared-statements", T.toLower . show . configDbPreparedStatements)
|
||||
,("db-root-spec", q . fromMaybe mempty . configDbRootSpec)
|
||||
,("db-schemas", q . intercalate "," . toList . configDbSchemas)
|
||||
,("db-config", q . toLower . show . configDbConfig)
|
||||
,("db-schemas", q . T.intercalate "," . toList . configDbSchemas)
|
||||
,("db-config", q . T.toLower . show . configDbConfig)
|
||||
,("db-tx-end", q . showTxEnd)
|
||||
,("db-uri", q . configDbUri)
|
||||
,("jwt-aud", toS . encode . maybe "" toJSON . configJwtAudience)
|
||||
,("jwt-role-claim-key", q . intercalate mempty . fmap show . configJwtRoleClaimKey)
|
||||
,("jwt-role-claim-key", q . T.intercalate mempty . fmap show . configJwtRoleClaimKey)
|
||||
,("jwt-secret", q . toS . showJwtSecret)
|
||||
,("jwt-secret-is-base64", toLower . show . configJwtSecretIsBase64)
|
||||
,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)
|
||||
,("log-level", q . show . configLogLevel)
|
||||
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
|
||||
,("raw-media-types", q . toS . B.intercalate "," . configRawMediaTypes)
|
||||
,("server-host", q . configServerHost)
|
||||
,("server-port", show . configServerPort)
|
||||
,("server-unix-socket", q . maybe mempty pack . configServerUnixSocket)
|
||||
,("server-unix-socket-mode", q . pack . showSocketMode)
|
||||
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
|
||||
,("server-unix-socket-mode", q . T.pack . showSocketMode)
|
||||
]
|
||||
|
||||
-- quote all app.settings
|
||||
appSettings = second q <$> configAppSettings conf
|
||||
|
||||
-- quote strings and replace " with \"
|
||||
q s = "\"" <> replace "\"" "\\\"" s <> "\""
|
||||
q s = "\"" <> T.replace "\"" "\\\"" s <> "\""
|
||||
|
||||
showTxEnd c = case (configDbTxRollbackAll c, configDbTxAllowOverride c) of
|
||||
( False, False ) -> "commit"
|
||||
@@ -384,7 +395,7 @@ readAppConfig dbSettings env optPath dbUriFile secretFile = do
|
||||
<*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types")
|
||||
<*> (fromMaybe "!4" <$> optString "server-host")
|
||||
<*> (fromMaybe 3000 <$> optInt "server-port")
|
||||
<*> (fmap unpack <$> optString "server-unix-socket")
|
||||
<*> (fmap T.unpack <$> optString "server-unix-socket")
|
||||
<*> parseSocketFileMode "server-unix-socket-mode"
|
||||
|
||||
parseDbUri :: C.Key -> C.Parser C.Config Text
|
||||
@@ -397,11 +408,11 @@ readAppConfig dbSettings env optPath dbUriFile secretFile = do
|
||||
let secStr = encodeUtf8 sec
|
||||
secFile = fromMaybe secStr secretFile
|
||||
-- replace because the JWT is actually base64url encoded which must be turned into just base64 before decoding.
|
||||
replaceUrlChars = replace "_" "/" . replace "-" "+" . replace "." "="
|
||||
replaceUrlChars = T.replace "_" "/" . T.replace "-" "+" . T.replace "." "="
|
||||
willBeFile = isPrefixOf "@" (toS secStr) && isNothing secretFile
|
||||
in
|
||||
if isB64 && not willBeFile -- don't decode in bas64 if the secret will be a file or it will err. The secFile will be filled with the file contents in a later stage.
|
||||
then case B64.decode $ encodeUtf8 $ strip $ replaceUrlChars $ decodeUtf8 secFile of
|
||||
then case B64.decode . encodeUtf8 . T.strip . replaceUrlChars $ decodeUtf8 secFile of
|
||||
Left errMsg -> fail errMsg
|
||||
Right bs -> pure $ Just bs
|
||||
else pure $ Just secFile
|
||||
@@ -411,14 +422,14 @@ readAppConfig dbSettings env optPath dbUriFile secretFile = do
|
||||
where
|
||||
addFromEnv f = M.toList $ M.union fromEnv $ M.fromList f
|
||||
fromEnv = M.mapKeys fromJust $ M.filterWithKey (\k _ -> isJust k) $ M.mapKeys normalize env
|
||||
normalize k = ("app.settings." <>) <$> stripPrefix "PGRST_APP_SETTINGS_" (toS k)
|
||||
normalize k = ("app.settings." <>) <$> T.stripPrefix "PGRST_APP_SETTINGS_" (toS k)
|
||||
|
||||
parseSocketFileMode :: C.Key -> C.Parser C.Config FileMode
|
||||
parseSocketFileMode k =
|
||||
optString k >>= \case
|
||||
Nothing -> pure 432 -- return default 660 mode if no value was provided
|
||||
Just fileModeText ->
|
||||
case (readOct . unpack) fileModeText of
|
||||
case readOct $ T.unpack fileModeText of
|
||||
[] ->
|
||||
fail "Invalid server-unix-socket-mode: not an octal"
|
||||
(fileMode, _):_ ->
|
||||
@@ -437,7 +448,7 @@ readAppConfig dbSettings env optPath dbUriFile secretFile = do
|
||||
parseJwtAudience k =
|
||||
optString k >>= \case
|
||||
Nothing -> pure Nothing -- no audience in config file
|
||||
Just aud -> case preview stringOrUri (unpack aud) of
|
||||
Just aud -> case preview stringOrUri (T.unpack aud) of
|
||||
Nothing -> fail "Invalid Jwt audience. Check your configuration."
|
||||
aud' -> pure aud'
|
||||
|
||||
@@ -510,7 +521,7 @@ readAppConfig dbSettings env optPath dbUriFile secretFile = do
|
||||
dashToUnderscore c = c
|
||||
envVarName = "PGRST_" <> (toUpper . dashToUnderscore <$> toS key)
|
||||
reloadableDbSetting =
|
||||
let dbSettingName = pack $ dashToUnderscore <$> toS key in
|
||||
let dbSettingName = T.pack $ dashToUnderscore <$> toS key in
|
||||
if dbSettingName `notElem` [
|
||||
"server_host", "server_port", "server_unix_socket", "server_unix_socket_mode", "log_level",
|
||||
"db_anon_role", "db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_pool_timeout", "db_config"]
|
||||
@@ -530,14 +541,14 @@ readAppConfig dbSettings env optPath dbUriFile secretFile = do
|
||||
coerceBool (C.Bool b) = Just b
|
||||
coerceBool (C.String s) =
|
||||
-- parse all kinds of text: True, true, TRUE, "true", ...
|
||||
case readMaybe . toS $ toTitle $ filter isAlpha $ toS s of
|
||||
case readMaybe . toS $ T.toTitle $ T.filter isAlpha $ toS s of
|
||||
Just b -> Just b
|
||||
-- numeric instead?
|
||||
Nothing -> (> 0) <$> (readMaybe $ toS s :: Maybe Integer)
|
||||
coerceBool _ = Nothing
|
||||
|
||||
splitOnCommas :: C.Value -> [Text]
|
||||
splitOnCommas (C.String s) = strip <$> splitOn "," s
|
||||
splitOnCommas (C.String s) = T.strip <$> T.splitOn "," s
|
||||
splitOnCommas _ = []
|
||||
|
||||
{-|
|
||||
@@ -562,13 +573,13 @@ type Environment = M.Map [Char] Text
|
||||
readEnvironment :: IO Environment
|
||||
readEnvironment = getEnvironment <&> pgrst
|
||||
where
|
||||
pgrst env = M.filterWithKey (\k _ -> "PGRST_" `isPrefixOf` k) $ M.map pack $ M.fromList env
|
||||
pgrst env = M.filterWithKey (\k _ -> "PGRST_" `isPrefixOf` k) $ M.map T.pack $ M.fromList env
|
||||
|
||||
-- | Read the JWT secret from a file if configJwtSecret is actually a filepath(has @ as its prefix).
|
||||
-- | To check if the JWT secret is provided is in fact a file path, it must be decoded as 'Text' to be processed.
|
||||
readSecretFile :: Maybe B.ByteString -> IO (Maybe B.ByteString)
|
||||
readSecretFile mSecret =
|
||||
case (stripPrefix "@" . decodeUtf8) =<< mSecret of
|
||||
case (T.stripPrefix "@" . decodeUtf8) =<< mSecret of
|
||||
Nothing -> return Nothing
|
||||
Just filename -> Just . chomp <$> BS.readFile (toS filename)
|
||||
where
|
||||
@@ -576,6 +587,6 @@ readSecretFile mSecret =
|
||||
|
||||
-- | Read database uri from a separate file if `db-uri` is a filepath.
|
||||
readDbUriFile :: Text -> IO (Maybe Text)
|
||||
readDbUriFile dbUri = case stripPrefix "@" dbUri of
|
||||
readDbUriFile dbUri = case T.stripPrefix "@" dbUri of
|
||||
Nothing -> return Nothing
|
||||
Just filename -> Just . strip <$> readFile (toS filename)
|
||||
Just filename -> Just . T.strip <$> readFile (toS filename)
|
||||
|
||||
@@ -0,0 +1,59 @@
|
||||
{-|
|
||||
Module : PostgREST.Types
|
||||
Description : PostgREST common types and functions used by the rest of the modules
|
||||
-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
|
||||
module PostgREST.Config.JSPath
|
||||
( JSPath
|
||||
, JSPathExp(..)
|
||||
, pRoleClaimKey
|
||||
) where
|
||||
|
||||
import qualified Text.ParserCombinators.Parsec as P
|
||||
|
||||
import Data.Either.Combinators (mapLeft)
|
||||
import Text.ParserCombinators.Parsec ((<?>))
|
||||
import Text.Read (read)
|
||||
|
||||
import qualified GHC.Show (show)
|
||||
|
||||
import Protolude hiding (toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
|
||||
-- | full jspath, e.g. .property[0].attr.detail
|
||||
type JSPath = [JSPathExp]
|
||||
|
||||
-- | jspath expression, e.g. .property, .property[0] or ."property-dash"
|
||||
data JSPathExp
|
||||
= JSPKey Text
|
||||
| JSPIdx Int
|
||||
|
||||
instance Show JSPathExp where
|
||||
-- TODO: this needs to be quoted properly for special chars
|
||||
show (JSPKey k) = "." <> show k
|
||||
show (JSPIdx i) = "[" <> show i <> "]"
|
||||
|
||||
-- Used for the config value "role-claim-key"
|
||||
pRoleClaimKey :: Text -> Either Text JSPath
|
||||
pRoleClaimKey selStr =
|
||||
mapLeft show $ P.parse pJSPath ("failed to parse role-claim-key value (" <> toS selStr <> ")") (toS selStr)
|
||||
|
||||
pJSPath :: P.Parser JSPath
|
||||
pJSPath = toJSPath <$> (period *> pPath `P.sepBy` period <* P.eof)
|
||||
where
|
||||
toJSPath :: [(Text, Maybe Int)] -> JSPath
|
||||
toJSPath = concatMap (\(key, idx) -> JSPKey key : maybeToList (JSPIdx <$> idx))
|
||||
period = P.char '.' <?> "period (.)"
|
||||
pPath :: P.Parser (Text, Maybe Int)
|
||||
pPath = (,) <$> pJSPKey <*> P.optionMaybe pJSPIdx
|
||||
|
||||
pJSPKey :: P.Parser Text
|
||||
pJSPKey = toS <$> P.many1 (P.alphaNum <|> P.oneOf "_$@") <|> pQuotedValue <?> "attribute name [a..z0..9_$@])"
|
||||
|
||||
pJSPIdx :: P.Parser Int
|
||||
pJSPIdx = P.char '[' *> (read <$> P.many1 P.digit) <* P.char ']' <?> "array index [0..n]"
|
||||
|
||||
pQuotedValue :: P.Parser Text
|
||||
pQuotedValue = toS <$> (P.char '"' *> P.many (P.noneOf "\"") <* P.char '"')
|
||||
@@ -3,10 +3,11 @@
|
||||
Module : PostgREST.Private.ProxyUri
|
||||
Description : Proxy Uri validator
|
||||
-}
|
||||
module PostgREST.Private.ProxyUri (
|
||||
isMalformedProxyUri
|
||||
, toURI
|
||||
) where
|
||||
module PostgREST.Config.Proxy
|
||||
( Proxy(..)
|
||||
, isMalformedProxyUri
|
||||
, toURI
|
||||
) where
|
||||
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Text (pack, toLower)
|
||||
@@ -16,6 +17,13 @@ import Protolude hiding (Proxy, dropWhile, get, intercalate,
|
||||
toLower, toS, (&))
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
data Proxy = Proxy
|
||||
{ proxyScheme :: Text
|
||||
, proxyHost :: Text
|
||||
, proxyPort :: Integer
|
||||
, proxyPath :: Text
|
||||
}
|
||||
|
||||
{-|
|
||||
Test whether a proxy uri is malformed or not.
|
||||
A valid proxy uri should be an absolute uri without query and user info,
|
||||
@@ -0,0 +1,64 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
|
||||
module PostgREST.ContentType
|
||||
( ContentType(..)
|
||||
, toHeader
|
||||
, toMime
|
||||
, decodeContentType
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Internal as BS (c2w)
|
||||
|
||||
import Network.HTTP.Types.Header (Header, hContentType)
|
||||
|
||||
import Protolude
|
||||
|
||||
-- | Enumeration of currently supported response content types
|
||||
data ContentType
|
||||
= CTApplicationJSON
|
||||
| CTSingularJSON
|
||||
| CTTextCSV
|
||||
| CTTextPlain
|
||||
| CTOpenAPI
|
||||
| CTUrlEncoded
|
||||
| CTOctetStream
|
||||
| CTAny
|
||||
| CTOther ByteString
|
||||
deriving (Eq)
|
||||
|
||||
-- | Convert from ContentType to a full HTTP Header
|
||||
toHeader :: ContentType -> Header
|
||||
toHeader ct = (hContentType, toMime ct <> charset)
|
||||
where
|
||||
charset = case ct of
|
||||
CTOctetStream -> mempty
|
||||
CTOther _ -> mempty
|
||||
_ -> "; charset=utf-8"
|
||||
|
||||
-- | Convert from ContentType to a ByteString representing the mime type
|
||||
toMime :: ContentType -> ByteString
|
||||
toMime CTApplicationJSON = "application/json"
|
||||
toMime CTTextCSV = "text/csv"
|
||||
toMime CTTextPlain = "text/plain"
|
||||
toMime CTOpenAPI = "application/openapi+json"
|
||||
toMime CTSingularJSON = "application/vnd.pgrst.object+json"
|
||||
toMime CTUrlEncoded = "application/x-www-form-urlencoded"
|
||||
toMime CTOctetStream = "application/octet-stream"
|
||||
toMime CTAny = "*/*"
|
||||
toMime (CTOther ct) = ct
|
||||
|
||||
-- | Convert from ByteString to ContentType. Warning: discards MIME parameters
|
||||
decodeContentType :: BS.ByteString -> ContentType
|
||||
decodeContentType ct =
|
||||
case BS.takeWhile (/= BS.c2w ';') ct of
|
||||
"application/json" -> CTApplicationJSON
|
||||
"text/csv" -> CTTextCSV
|
||||
"text/plain" -> CTTextPlain
|
||||
"application/openapi+json" -> CTOpenAPI
|
||||
"application/vnd.pgrst.object+json" -> CTSingularJSON
|
||||
"application/vnd.pgrst.object" -> CTSingularJSON
|
||||
"application/x-www-form-urlencoded" -> CTUrlEncoded
|
||||
"application/octet-stream" -> CTOctetStream
|
||||
"*/*" -> CTAny
|
||||
ct' -> CTOther ct'
|
||||
@@ -8,6 +8,8 @@ The schema cache is necessary for resource embedding, foreign keys are used for
|
||||
|
||||
These queries are executed once at startup or when PostgREST is reloaded.
|
||||
-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
@@ -16,14 +18,18 @@ These queries are executed once at startup or when PostgREST is reloaded.
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
|
||||
module PostgREST.DbStructure (
|
||||
getDbStructure
|
||||
, accessibleTables
|
||||
, accessibleProcs
|
||||
, schemaDescription
|
||||
, getPgVersion
|
||||
) where
|
||||
module PostgREST.DbStructure
|
||||
( DbStructure(..)
|
||||
, getDbStructure
|
||||
, accessibleTables
|
||||
, accessibleProcs
|
||||
, schemaDescription
|
||||
, getPgVersion
|
||||
, tableCols
|
||||
, tablePKCols
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.List as L
|
||||
import qualified Hasql.Decoders as HD
|
||||
@@ -35,13 +41,52 @@ import qualified Hasql.Transaction as HT
|
||||
import Contravariant.Extras (contrazip2)
|
||||
import Data.Set as S (fromList)
|
||||
import Data.Text (split)
|
||||
import Protolude hiding (toS)
|
||||
import Protolude.Conv (toS)
|
||||
import Protolude.Unsafe (unsafeHead)
|
||||
import Text.InterpolatedString.Perl6 (q)
|
||||
|
||||
import PostgREST.Private.Common
|
||||
import PostgREST.Types
|
||||
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
|
||||
Schema, TableName)
|
||||
import PostgREST.DbStructure.PgVersion (PgVersion (..))
|
||||
import PostgREST.DbStructure.Proc (PgArg (..), PgType (..),
|
||||
ProcDescription (..),
|
||||
ProcVolatility (..),
|
||||
ProcsMap, RetType (..))
|
||||
import PostgREST.DbStructure.Relation (Cardinality (..),
|
||||
ForeignKey (..), Link (..),
|
||||
PrimaryKey (..),
|
||||
Relation (..))
|
||||
import PostgREST.DbStructure.Table (Column (..), Table (..))
|
||||
|
||||
import Protolude hiding (toS)
|
||||
import Protolude.Conv (toS)
|
||||
import Protolude.Unsafe (unsafeHead)
|
||||
|
||||
|
||||
data DbStructure = DbStructure
|
||||
{ dbTables :: [Table]
|
||||
, dbColumns :: [Column]
|
||||
, dbRelations :: [Relation]
|
||||
, dbPrimaryKeys :: [PrimaryKey]
|
||||
, dbProcs :: ProcsMap
|
||||
, pgVersion :: PgVersion
|
||||
}
|
||||
deriving (Generic, JSON.ToJSON)
|
||||
|
||||
-- TODO Table could hold references to all its Columns
|
||||
tableCols :: DbStructure -> Schema -> TableName -> [Column]
|
||||
tableCols dbs tSchema tName = filter (\Column{colTable=Table{tableSchema=s, tableName=t}} -> s==tSchema && t==tName) $ dbColumns dbs
|
||||
|
||||
-- TODO Table could hold references to all its PrimaryKeys
|
||||
tablePKCols :: DbStructure -> Schema -> TableName -> [Text]
|
||||
tablePKCols dbs tSchema tName = pkName <$> filter (\pk -> tSchema == (tableSchema . pkTable) pk && tName == (tableName . pkTable) pk) (dbPrimaryKeys dbs)
|
||||
|
||||
|
||||
|
||||
-- | The source table column a view column refers to
|
||||
type SourceColumn = (Column, ViewColumn)
|
||||
type ViewColumn = Column
|
||||
|
||||
-- | A SQL query that can be executed independently
|
||||
type SqlQuery = ByteString
|
||||
|
||||
getDbStructure :: [Schema] -> [Schema] -> PgVersion -> Bool -> HT.Transaction DbStructure
|
||||
getDbStructure schemas extraSearchPath pgVer prepared = do
|
||||
@@ -839,3 +884,24 @@ getPgVersion = H.statement mempty $ H.Statement sql HE.noParams versionRow False
|
||||
where
|
||||
sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
|
||||
versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text
|
||||
|
||||
param :: HE.Value a -> HE.Params a
|
||||
param = HE.param . HE.nonNullable
|
||||
|
||||
arrayParam :: HE.Value a -> HE.Params [a]
|
||||
arrayParam = param . HE.foldableArray . HE.nonNullable
|
||||
|
||||
compositeArrayColumn :: HD.Composite a -> HD.Row [a]
|
||||
compositeArrayColumn = arrayColumn . HD.composite
|
||||
|
||||
compositeField :: HD.Value a -> HD.Composite a
|
||||
compositeField = HD.field . HD.nonNullable
|
||||
|
||||
column :: HD.Value a -> HD.Row a
|
||||
column = HD.column . HD.nonNullable
|
||||
|
||||
nullableColumn :: HD.Value a -> HD.Row (Maybe a)
|
||||
nullableColumn = HD.column . HD.nullable
|
||||
|
||||
arrayColumn :: HD.Value a -> HD.Row [a]
|
||||
arrayColumn = column . HD.listArray . HD.nonNullable
|
||||
|
||||
@@ -0,0 +1,28 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module PostgREST.DbStructure.Identifiers
|
||||
( QualifiedIdentifier(..)
|
||||
, Schema
|
||||
, TableName
|
||||
, FieldName
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
-- | Represents a pg identifier with a prepended schema name "schema.table".
|
||||
-- When qiSchema is "", the schema is defined by the pg search_path.
|
||||
data QualifiedIdentifier = QualifiedIdentifier
|
||||
{ qiSchema :: Schema
|
||||
, qiName :: TableName
|
||||
}
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey)
|
||||
|
||||
instance Hashable QualifiedIdentifier
|
||||
|
||||
type Schema = Text
|
||||
type TableName = Text
|
||||
type FieldName = Text
|
||||
@@ -0,0 +1,60 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
module PostgREST.DbStructure.PgVersion
|
||||
( PgVersion(..)
|
||||
, minimumPgVersion
|
||||
, pgVersion95
|
||||
, pgVersion96
|
||||
, pgVersion100
|
||||
, pgVersion109
|
||||
, pgVersion110
|
||||
, pgVersion112
|
||||
, pgVersion114
|
||||
, pgVersion121
|
||||
, pgVersion130
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
data PgVersion = PgVersion
|
||||
{ pgvNum :: Int32
|
||||
, pgvName :: Text
|
||||
}
|
||||
deriving (Eq, Generic, JSON.ToJSON)
|
||||
|
||||
instance Ord PgVersion where
|
||||
(PgVersion v1 _) `compare` (PgVersion v2 _) = v1 `compare` v2
|
||||
|
||||
-- | Tells the minimum PostgreSQL version required by this version of PostgREST
|
||||
minimumPgVersion :: PgVersion
|
||||
minimumPgVersion = pgVersion95
|
||||
|
||||
pgVersion95 :: PgVersion
|
||||
pgVersion95 = PgVersion 90500 "9.5"
|
||||
|
||||
pgVersion96 :: PgVersion
|
||||
pgVersion96 = PgVersion 90600 "9.6"
|
||||
|
||||
pgVersion100 :: PgVersion
|
||||
pgVersion100 = PgVersion 100000 "10"
|
||||
|
||||
pgVersion109 :: PgVersion
|
||||
pgVersion109 = PgVersion 100009 "10.9"
|
||||
|
||||
pgVersion110 :: PgVersion
|
||||
pgVersion110 = PgVersion 110000 "11.0"
|
||||
|
||||
pgVersion112 :: PgVersion
|
||||
pgVersion112 = PgVersion 110002 "11.2"
|
||||
|
||||
pgVersion114 :: PgVersion
|
||||
pgVersion114 = PgVersion 110004 "11.4"
|
||||
|
||||
pgVersion121 :: PgVersion
|
||||
pgVersion121 = PgVersion 120001 "12.1"
|
||||
|
||||
pgVersion130 :: PgVersion
|
||||
pgVersion130 = PgVersion 130000 "13.0"
|
||||
@@ -0,0 +1,120 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module PostgREST.DbStructure.Proc
|
||||
( PgArg(..)
|
||||
, PgType(..)
|
||||
, ProcDescription(..)
|
||||
, ProcVolatility(..)
|
||||
, ProcsMap
|
||||
, RetType(..)
|
||||
, findProc
|
||||
, procReturnsScalar
|
||||
, procReturnsSingle
|
||||
, procTableName
|
||||
, specifiedProcArgs
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema, TableName)
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
data PgArg = PgArg
|
||||
{ pgaName :: Text
|
||||
, pgaType :: Text
|
||||
, pgaReq :: Bool
|
||||
, pgaVar :: Bool
|
||||
}
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data PgType
|
||||
= Scalar
|
||||
| Composite QualifiedIdentifier
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data RetType
|
||||
= Single PgType
|
||||
| SetOf PgType
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data ProcVolatility
|
||||
= Volatile
|
||||
| Stable
|
||||
| Immutable
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data ProcDescription = ProcDescription
|
||||
{ pdSchema :: Schema
|
||||
, pdName :: Text
|
||||
, pdDescription :: Maybe Text
|
||||
, pdArgs :: [PgArg]
|
||||
, pdReturnType :: RetType
|
||||
, pdVolatility :: ProcVolatility
|
||||
, pdHasVariadic :: Bool
|
||||
}
|
||||
deriving (Eq, Generic, JSON.ToJSON)
|
||||
|
||||
-- Order by least number of args in the case of overloaded functions
|
||||
instance Ord ProcDescription where
|
||||
ProcDescription schema1 name1 des1 args1 rt1 vol1 hasVar1 `compare` ProcDescription schema2 name2 des2 args2 rt2 vol2 hasVar2
|
||||
| schema1 == schema2 && name1 == name2 && length args1 < length args2 = LT
|
||||
| schema2 == schema2 && name1 == name2 && length args1 > length args2 = GT
|
||||
| otherwise = (schema1, name1, des1, args1, rt1, vol1, hasVar1) `compare` (schema2, name2, des2, args2, rt2, vol2, hasVar2)
|
||||
|
||||
-- | A map of all procs, all of which can be overloaded(one entry will have more than one ProcDescription).
|
||||
-- | It uses a HashMap for a faster lookup.
|
||||
type ProcsMap = M.HashMap QualifiedIdentifier [ProcDescription]
|
||||
|
||||
{-|
|
||||
Search a pg procedure by its parameters. Since a function can be overloaded, the name is not enough to find it.
|
||||
An overloaded function can have a different volatility or even a different return type.
|
||||
Ideally, handling overloaded functions should be left to pg itself. But we need to know certain proc attributes in advance.
|
||||
-}
|
||||
findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> ProcDescription
|
||||
findProc qi payloadKeys paramsAsSingleObject allProcs = fromMaybe fallback bestMatch
|
||||
where
|
||||
-- instead of passing Maybe ProcDescription around, we create a fallback description here when we can't find a matching function
|
||||
-- args is empty, but because "specifiedProcArgs" will fill the missing arguments with default type text, this is not a problem
|
||||
fallback = ProcDescription (qiSchema qi) (qiName qi) Nothing mempty (SetOf $ Composite $ QualifiedIdentifier mempty "record") Volatile False
|
||||
bestMatch =
|
||||
case M.lookup qi allProcs of
|
||||
Nothing -> Nothing
|
||||
Just [proc] -> Just proc -- if it's not an overloaded function then immediately get the ProcDescription
|
||||
Just procs -> find matches procs -- Handle overloaded functions case
|
||||
matches proc =
|
||||
if paramsAsSingleObject
|
||||
-- if the arg is not of json type let the db give the err
|
||||
then length (pdArgs proc) == 1
|
||||
else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs proc)
|
||||
|
||||
{-|
|
||||
Search the procedure parameters by matching them with the specified keys.
|
||||
If the key doesn't match a parameter, a parameter with a default type "text" is assumed.
|
||||
-}
|
||||
specifiedProcArgs :: S.Set FieldName -> ProcDescription -> [PgArg]
|
||||
specifiedProcArgs keys proc =
|
||||
(\k -> fromMaybe (PgArg k "text" True False) (find ((==) k . pgaName) (pdArgs proc))) <$> S.toList keys
|
||||
|
||||
procReturnsScalar :: ProcDescription -> Bool
|
||||
procReturnsScalar proc = case proc of
|
||||
ProcDescription{pdReturnType = (Single Scalar)} -> True
|
||||
ProcDescription{pdReturnType = (SetOf Scalar)} -> True
|
||||
_ -> False
|
||||
|
||||
procReturnsSingle :: ProcDescription -> Bool
|
||||
procReturnsSingle proc = case proc of
|
||||
ProcDescription{pdReturnType = (Single _)} -> True
|
||||
_ -> False
|
||||
|
||||
procTableName :: ProcDescription -> Maybe TableName
|
||||
procTableName proc = case pdReturnType proc of
|
||||
SetOf (Composite qi) -> Just $ qiName qi
|
||||
Single (Composite qi) -> Just $ qiName qi
|
||||
_ -> Nothing
|
||||
@@ -0,0 +1,76 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module PostgREST.DbStructure.Relation
|
||||
( Cardinality(..)
|
||||
, Constraint
|
||||
, ForeignKey(..)
|
||||
, Link(..)
|
||||
, PrimaryKey(..)
|
||||
, Relation(..)
|
||||
, isSelfReference
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
|
||||
import PostgREST.DbStructure.Table (Column (..), ForeignKey (..),
|
||||
Table (..))
|
||||
|
||||
import qualified GHC.Show (show)
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
-- | "Relation"ship between two tables.
|
||||
--
|
||||
-- The order of the relColumns and relFColumns should be maintained to get the
|
||||
-- join conditions right.
|
||||
--
|
||||
-- TODO merge relColumns and relFColumns to a tuple or Data.Bimap
|
||||
data Relation = Relation
|
||||
{ relTable :: Table
|
||||
, relColumns :: [Column]
|
||||
, relFTable :: Table
|
||||
, relFColumns :: [Column]
|
||||
, relType :: Cardinality
|
||||
, relLink :: Link -- ^ Constraint on O2M/M2O, Junction for M2M Cardinality
|
||||
}
|
||||
deriving (Eq, Generic, JSON.ToJSON)
|
||||
|
||||
type ConstraintName = Text
|
||||
|
||||
-- | Junction table on an M2M relationship
|
||||
data Link
|
||||
= Constraint
|
||||
{ constName :: ConstraintName }
|
||||
| Junction
|
||||
{ junTable :: Table
|
||||
, junLink1 :: Link
|
||||
, junCols1 :: [Column]
|
||||
, junLink2 :: Link
|
||||
, junCols2 :: [Column]
|
||||
}
|
||||
deriving (Eq, Generic, JSON.ToJSON)
|
||||
|
||||
data PrimaryKey = PrimaryKey
|
||||
{ pkTable :: Table
|
||||
, pkName :: Text
|
||||
}
|
||||
deriving (Generic, JSON.ToJSON)
|
||||
|
||||
-- | The relationship
|
||||
-- [cardinality](https://en.wikipedia.org/wiki/Cardinality_(data_modeling)).
|
||||
-- TODO: missing one-to-one
|
||||
data Cardinality
|
||||
= O2M -- ^ one-to-many, previously known as Parent
|
||||
| M2O -- ^ many-to-one, previously known as Child
|
||||
| M2M -- ^ many-to-many, previously known as Many
|
||||
deriving (Eq, Generic, JSON.ToJSON)
|
||||
|
||||
instance Show Cardinality where
|
||||
show O2M = "o2m"
|
||||
show M2O = "m2o"
|
||||
show M2M = "m2m"
|
||||
|
||||
isSelfReference :: Relation -> Bool
|
||||
isSelfReference r = relTable r == relFTable r
|
||||
@@ -0,0 +1,58 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module PostgREST.DbStructure.Table
|
||||
( Column(..)
|
||||
, ForeignKey(..)
|
||||
, Table(..)
|
||||
, tableQi
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema, TableName)
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
data Table = Table
|
||||
{ tableSchema :: Schema
|
||||
, tableName :: TableName
|
||||
, tableDescription :: Maybe Text
|
||||
, tableInsertable :: Bool
|
||||
}
|
||||
deriving (Show, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
instance Eq Table where
|
||||
Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
|
||||
|
||||
tableQi :: Table -> QualifiedIdentifier
|
||||
tableQi Table{tableSchema=s, tableName=n} = QualifiedIdentifier s n
|
||||
|
||||
newtype ForeignKey = ForeignKey
|
||||
{ fkCol :: Column }
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data Column = Column
|
||||
{ colTable :: Table
|
||||
, colName :: FieldName
|
||||
, colDescription :: Maybe Text
|
||||
, colNullable :: Bool
|
||||
, colType :: Text
|
||||
, colMaxLen :: Maybe Int32
|
||||
, colDefault :: Maybe Text
|
||||
, colEnum :: [Text]
|
||||
, colFK :: Maybe ForeignKey
|
||||
}
|
||||
deriving (Ord, Generic, JSON.ToJSON)
|
||||
|
||||
instance Eq Column where
|
||||
Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
|
||||
|
||||
data PrimaryKey = PrimaryKey
|
||||
{ pkTable :: Table
|
||||
, pkName :: Text
|
||||
}
|
||||
deriving (Generic, JSON.ToJSON)
|
||||
+26
-21
@@ -5,15 +5,15 @@ Description : PostgREST error HTTP responses
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module PostgREST.Error (
|
||||
errorResponseFor
|
||||
, ApiRequestError(..)
|
||||
, PgError(..)
|
||||
, Error(..)
|
||||
, errorPayload
|
||||
, checkIsFatal
|
||||
, singularityError
|
||||
) where
|
||||
module PostgREST.Error
|
||||
( errorResponseFor
|
||||
, ApiRequestError(..)
|
||||
, PgError(..)
|
||||
, Error(..)
|
||||
, errorPayload
|
||||
, checkIsFatal
|
||||
, singularityError
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.Text as T
|
||||
@@ -24,11 +24,16 @@ import qualified Network.HTTP.Types.Status as HT
|
||||
import Data.Aeson ((.=))
|
||||
import Network.Wai (Response, responseLBS)
|
||||
|
||||
import Network.HTTP.Types.Header
|
||||
import Network.HTTP.Types.Header (Header)
|
||||
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (toS)
|
||||
import Protolude.Conv (toS, toSL)
|
||||
import PostgREST.ContentType (ContentType (..))
|
||||
import qualified PostgREST.ContentType as ContentType
|
||||
|
||||
import PostgREST.DbStructure.Relation (Link (..), Relation (..))
|
||||
import PostgREST.DbStructure.Table (Column (..), Table (..))
|
||||
|
||||
import Protolude hiding (toS)
|
||||
import Protolude.Conv (toS, toSL)
|
||||
|
||||
|
||||
class (JSON.ToJSON a) => PgrstError a where
|
||||
@@ -67,7 +72,7 @@ instance PgrstError ApiRequestError where
|
||||
status AmbiguousRelBetween{} = HT.status300
|
||||
status (UnacceptableSchema _) = HT.status406
|
||||
|
||||
headers _ = [toHeader CTApplicationJSON]
|
||||
headers _ = [ContentType.toHeader CTApplicationJSON]
|
||||
|
||||
instance JSON.ToJSON ApiRequestError where
|
||||
toJSON (ParseRequestError message details) = JSON.object [
|
||||
@@ -120,8 +125,8 @@ instance PgrstError PgError where
|
||||
|
||||
headers err =
|
||||
if status err == HT.status401
|
||||
then [toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
|
||||
else [toHeader CTApplicationJSON]
|
||||
then [ContentType.toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
|
||||
else [ContentType.toHeader CTApplicationJSON]
|
||||
|
||||
instance JSON.ToJSON PgError where
|
||||
toJSON (PgError _ usageError) = JSON.toJSON usageError
|
||||
@@ -249,11 +254,11 @@ instance PgrstError Error where
|
||||
status (PgErr err) = status err
|
||||
status (ApiRequestError err) = status err
|
||||
|
||||
headers (SingularityError _) = [toHeader CTSingularJSON]
|
||||
headers (JwtTokenInvalid m) = [toHeader CTApplicationJSON, invalidTokenHeader m]
|
||||
headers (SingularityError _) = [ContentType.toHeader CTSingularJSON]
|
||||
headers (JwtTokenInvalid m) = [ContentType.toHeader CTApplicationJSON, invalidTokenHeader m]
|
||||
headers (PgErr err) = headers err
|
||||
headers (ApiRequestError err) = headers err
|
||||
headers _ = [toHeader CTApplicationJSON]
|
||||
headers _ = [ContentType.toHeader CTApplicationJSON]
|
||||
|
||||
instance JSON.ToJSON Error where
|
||||
toJSON GucHeadersError = JSON.object [
|
||||
@@ -261,7 +266,7 @@ instance JSON.ToJSON Error where
|
||||
toJSON GucStatusError = JSON.object [
|
||||
"message" .= ("response.status guc must be a valid status code" :: Text)]
|
||||
toJSON (BinaryFieldError ct) = JSON.object [
|
||||
"message" .= ((toS (toMime ct) <> " requested but more than one column was selected") :: Text)]
|
||||
"message" .= ((toS (ContentType.toMime ct) <> " requested but more than one column was selected") :: Text)]
|
||||
toJSON ConnectionLostError = JSON.object [
|
||||
"message" .= ("Database connection lost. Retrying the connection." :: Text)]
|
||||
|
||||
@@ -274,7 +279,7 @@ instance JSON.ToJSON Error where
|
||||
"message" .= ("None of these Content-Types are available: " <> (toS . intercalate ", " . map toS) cts :: Text)]
|
||||
toJSON (SingularityError n) = JSON.object [
|
||||
"message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
|
||||
"details" .= T.unwords ["Results contain", show n, "rows,", toS (toMime CTSingularJSON), "requires 1 row"]]
|
||||
"details" .= T.unwords ["Results contain", show n, "rows,", toS (ContentType.toMime CTSingularJSON), "requires 1 row"]]
|
||||
|
||||
toJSON JwtTokenMissing = JSON.object [
|
||||
"message" .= ("Server lacks JWT secret" :: Text)]
|
||||
|
||||
@@ -0,0 +1,37 @@
|
||||
module PostgREST.GucHeader
|
||||
( GucHeader
|
||||
, unwrapGucHeader
|
||||
, addHeadersIfNotIncluded
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.HashMap.Strict as M
|
||||
|
||||
import Network.HTTP.Types.Header (Header)
|
||||
|
||||
import Protolude hiding (toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
|
||||
{-|
|
||||
Custom guc header, it's obtained by parsing the json in a:
|
||||
`SET LOCAL "response.headers" = '[{"Set-Cookie": ".."}]'
|
||||
-}
|
||||
newtype GucHeader = GucHeader (CI.CI ByteString, ByteString)
|
||||
|
||||
instance JSON.FromJSON GucHeader where
|
||||
parseJSON (JSON.Object o) = case headMay (M.toList o) of
|
||||
Just (k, JSON.String s) | M.size o == 1 -> pure $ GucHeader (CI.mk $ toS k, toS s)
|
||||
| otherwise -> mzero
|
||||
_ -> mzero
|
||||
parseJSON _ = mzero
|
||||
|
||||
unwrapGucHeader :: GucHeader -> Header
|
||||
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
|
||||
+68
-64
@@ -12,50 +12,49 @@ module PostgREST.Middleware
|
||||
, optionalRollback
|
||||
) where
|
||||
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.DynamicStatements.Statement as H
|
||||
import PostgREST.Private.Common
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.DynamicStatements.Snippet as H hiding
|
||||
(sql)
|
||||
import qualified Hasql.DynamicStatements.Statement as H
|
||||
import qualified Hasql.Transaction as H
|
||||
import qualified Network.HTTP.Types.Header as HTTP
|
||||
import qualified Network.Wai as Wai
|
||||
import qualified Network.Wai.Logger as Wai
|
||||
import qualified Network.Wai.Middleware.Cors as Wai
|
||||
import qualified Network.Wai.Middleware.Gzip as Wai
|
||||
import qualified Network.Wai.Middleware.RequestLogger as Wai
|
||||
import qualified Network.Wai.Middleware.Static as Wai
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import Data.Function (id)
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import Data.List (lookup)
|
||||
import Data.Scientific (FPFormat (..),
|
||||
formatScientific,
|
||||
isInteger)
|
||||
import qualified Data.Text as T
|
||||
import qualified Hasql.Transaction as H
|
||||
import qualified Network.HTTP.Types.Header as HTTP
|
||||
import Network.HTTP.Types.Status (Status, status400,
|
||||
status500, statusCode)
|
||||
import qualified Network.Wai as Wai
|
||||
import Network.Wai.Logger (showSockAddr)
|
||||
import System.Log.FastLogger (toLogStr)
|
||||
import Data.Function (id)
|
||||
import Data.List (lookup)
|
||||
import Data.Scientific (FPFormat (..), formatScientific,
|
||||
isInteger)
|
||||
import Network.HTTP.Types.Status (Status, status400, status500,
|
||||
statusCode)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import System.Log.FastLogger (toLogStr)
|
||||
|
||||
import Network.Wai
|
||||
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..),
|
||||
cors)
|
||||
import Network.Wai.Middleware.Gzip (def, gzip)
|
||||
import Network.Wai.Middleware.RequestLogger
|
||||
import Network.Wai.Middleware.Static (only, staticPolicy)
|
||||
import PostgREST.Config (AppConfig (..), LogLevel (..))
|
||||
import PostgREST.Error (Error, errorResponseFor)
|
||||
import PostgREST.GucHeader (addHeadersIfNotIncluded)
|
||||
import PostgREST.Query.SqlFragment (intercalateSnippet,
|
||||
unknownLiteral)
|
||||
import PostgREST.Request.ApiRequest (ApiRequest (..))
|
||||
|
||||
import qualified PostgREST.Types as Types
|
||||
import PostgREST.Request.Preferences
|
||||
|
||||
import PostgREST.ApiRequest (ApiRequest (..))
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.Error (Error, errorResponseFor)
|
||||
import PostgREST.QueryBuilder (setConfigLocal)
|
||||
import PostgREST.Types (LogLevel (..))
|
||||
import Protolude hiding (head, toS)
|
||||
import Protolude.Conv (toS)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Protolude hiding (head, toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
|
||||
runPgLocals :: AppConfig -> M.HashMap Text JSON.Value ->
|
||||
(ApiRequest -> ExceptT Error H.Transaction Response) ->
|
||||
ApiRequest -> ExceptT Error H.Transaction Response
|
||||
(ApiRequest -> ExceptT Error H.Transaction Wai.Response) ->
|
||||
ApiRequest -> ExceptT Error H.Transaction Wai.Response
|
||||
runPgLocals conf claims app req = do
|
||||
lift $ H.statement mempty $ H.dynamicallyParameterized
|
||||
("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql))
|
||||
@@ -78,11 +77,16 @@ runPgLocals conf claims app req = do
|
||||
setConfigLocal mempty ("search_path", schemas)
|
||||
preReqSql = (\f -> "select " <> toS f <> "();") <$> configDbPreRequest conf
|
||||
|
||||
-- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
|
||||
setConfigLocal :: Text -> (Text, Text) -> H.Snippet
|
||||
setConfigLocal prefix (k, v) =
|
||||
"set_config(" <> unknownLiteral (prefix <> k) <> ", " <> unknownLiteral v <> ", true)"
|
||||
|
||||
-- | Log in apache format. Only requests that have a status greater than minStatus are logged.
|
||||
-- | There's no way to filter logs in the apache format on wai-extra: https://hackage.haskell.org/package/wai-extra-3.0.29.2/docs/Network-Wai-Middleware-RequestLogger.html#t:OutputFormat.
|
||||
-- | So here we copy wai-logger apacheLogStr function: https://github.com/kazu-yamamoto/logger/blob/a4f51b909a099c51af7a3f75cf16e19a06f9e257/wai-logger/Network/Wai/Logger/Apache.hs#L45
|
||||
-- | TODO: Add the ability to filter apache logs on wai-extra and remove this function.
|
||||
pgrstFormat :: Status -> OutputFormatter
|
||||
pgrstFormat :: Status -> Wai.OutputFormatter
|
||||
pgrstFormat minStatus date req status responseSize =
|
||||
if status < minStatus
|
||||
then mempty
|
||||
@@ -90,55 +94,55 @@ pgrstFormat minStatus date req status responseSize =
|
||||
<> " - - ["
|
||||
<> toLogStr date
|
||||
<> "] \""
|
||||
<> toLogStr (requestMethod req)
|
||||
<> toLogStr (Wai.requestMethod req)
|
||||
<> " "
|
||||
<> toLogStr (rawPathInfo req <> rawQueryString req)
|
||||
<> toLogStr (Wai.rawPathInfo req <> Wai.rawQueryString req)
|
||||
<> " "
|
||||
<> toLogStr (show (httpVersion req)::Text)
|
||||
<> toLogStr (show (Wai.httpVersion req)::Text)
|
||||
<> "\" "
|
||||
<> toLogStr (show (statusCode status)::Text)
|
||||
<> " "
|
||||
<> toLogStr (maybe "-" show responseSize::Text)
|
||||
<> " \""
|
||||
<> toLogStr (fromMaybe mempty $ requestHeaderReferer req)
|
||||
<> toLogStr (fromMaybe mempty $ Wai.requestHeaderReferer req)
|
||||
<> "\" \""
|
||||
<> toLogStr (fromMaybe mempty $ requestHeaderUserAgent req)
|
||||
<> toLogStr (fromMaybe mempty $ Wai.requestHeaderUserAgent req)
|
||||
<> "\"\n"
|
||||
where
|
||||
getSourceFromSocket = BS.pack . showSockAddr . remoteHost
|
||||
getSourceFromSocket = BS.pack . Wai.showSockAddr . Wai.remoteHost
|
||||
|
||||
pgrstMiddleware :: LogLevel -> Application -> Application
|
||||
pgrstMiddleware :: LogLevel -> Wai.Application -> Wai.Application
|
||||
pgrstMiddleware logLevel =
|
||||
logger
|
||||
. gzip def
|
||||
. cors corsPolicy
|
||||
. staticPolicy (only [("favicon.ico", "static/favicon.ico")])
|
||||
. Wai.gzip Wai.def
|
||||
. Wai.cors corsPolicy
|
||||
. Wai.staticPolicy (Wai.only [("favicon.ico", "static/favicon.ico")])
|
||||
where
|
||||
logger = case logLevel of
|
||||
LogCrit -> id
|
||||
LogError -> unsafePerformIO $ mkRequestLogger def { outputFormat = CustomOutputFormat $ pgrstFormat status500}
|
||||
LogWarn -> unsafePerformIO $ mkRequestLogger def { outputFormat = CustomOutputFormat $ pgrstFormat status400}
|
||||
LogInfo -> logStdout
|
||||
LogError -> unsafePerformIO $ Wai.mkRequestLogger Wai.def { Wai.outputFormat = Wai.CustomOutputFormat $ pgrstFormat status500}
|
||||
LogWarn -> unsafePerformIO $ Wai.mkRequestLogger Wai.def { Wai.outputFormat = Wai.CustomOutputFormat $ pgrstFormat status400}
|
||||
LogInfo -> Wai.logStdout
|
||||
|
||||
defaultCorsPolicy :: CorsResourcePolicy
|
||||
defaultCorsPolicy = CorsResourcePolicy Nothing
|
||||
defaultCorsPolicy :: Wai.CorsResourcePolicy
|
||||
defaultCorsPolicy = Wai.CorsResourcePolicy Nothing
|
||||
["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"] ["Authorization"] Nothing
|
||||
(Just $ 60*60*24) False False True
|
||||
|
||||
-- | CORS policy to be used in by Wai Cors middleware
|
||||
corsPolicy :: Request -> Maybe CorsResourcePolicy
|
||||
corsPolicy :: Wai.Request -> Maybe Wai.CorsResourcePolicy
|
||||
corsPolicy req = case lookup "origin" headers of
|
||||
Just origin -> Just defaultCorsPolicy {
|
||||
corsOrigins = Just ([origin], True)
|
||||
, corsRequestHeaders = "Authentication":accHeaders
|
||||
, corsExposedHeaders = Just [
|
||||
Wai.corsOrigins = Just ([origin], True)
|
||||
, Wai.corsRequestHeaders = "Authentication" : accHeaders
|
||||
, Wai.corsExposedHeaders = Just [
|
||||
"Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
|
||||
, "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
|
||||
]
|
||||
}
|
||||
Nothing -> Nothing
|
||||
where
|
||||
headers = requestHeaders req
|
||||
headers = Wai.requestHeaders req
|
||||
accHeaders = case lookup "access-control-request-headers" headers of
|
||||
Just hdrs -> map (CI.mk . toS . T.strip . toS) $ BS.split ',' hdrs
|
||||
Nothing -> []
|
||||
@@ -164,15 +168,15 @@ optionalRollback AppConfig{..} ApiRequest{..} transaction = do
|
||||
return $ Wai.mapResponseHeaders preferenceApplied resp
|
||||
where
|
||||
shouldCommit =
|
||||
configDbTxAllowOverride && iPreferTransaction == Just Types.Commit
|
||||
configDbTxAllowOverride && iPreferTransaction == Just Commit
|
||||
shouldRollback =
|
||||
configDbTxAllowOverride && iPreferTransaction == Just Types.Rollback
|
||||
configDbTxAllowOverride && iPreferTransaction == Just Rollback
|
||||
preferenceApplied
|
||||
| shouldCommit =
|
||||
Types.addHeadersIfNotIncluded
|
||||
[(HTTP.hPreferenceApplied, BS.pack (show Types.Commit))]
|
||||
addHeadersIfNotIncluded
|
||||
[(HTTP.hPreferenceApplied, BS.pack (show Commit))]
|
||||
| shouldRollback =
|
||||
Types.addHeadersIfNotIncluded
|
||||
[(HTTP.hPreferenceApplied, BS.pack (show Types.Rollback))]
|
||||
addHeadersIfNotIncluded
|
||||
[(HTTP.hPreferenceApplied, BS.pack (show Rollback))]
|
||||
| otherwise =
|
||||
identity
|
||||
|
||||
+46
-44
@@ -9,32 +9,34 @@ import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import qualified Data.HashSet.InsOrd as Set
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Control.Arrow ((&&&))
|
||||
import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.String (IsString (..))
|
||||
import Data.Text (append, breakOn, dropWhile, init,
|
||||
intercalate, pack, tail, toLower,
|
||||
unpack)
|
||||
import Network.URI (URI (..), URIAuth (..))
|
||||
|
||||
import Control.Lens
|
||||
import Control.Lens (at, (.~), (?~))
|
||||
|
||||
import Data.Swagger
|
||||
|
||||
import PostgREST.ApiRequest (ContentType (..))
|
||||
import PostgREST.Config (AppConfig (..), docsVersion,
|
||||
prettyVersion)
|
||||
import PostgREST.Private.ProxyUri (isMalformedProxyUri, toURI)
|
||||
import PostgREST.Types (Column (..), DbStructure (..),
|
||||
ForeignKey (..), PgArg (..),
|
||||
PrimaryKey (..),
|
||||
ProcDescription (..), Proxy (..),
|
||||
Table (..), tableCols, tableName,
|
||||
tablePKCols, tableSchema, toMime)
|
||||
import Protolude hiding (Proxy, dropWhile, get,
|
||||
intercalate, toLower, toS, (&))
|
||||
import Protolude.Conv (toS)
|
||||
import PostgREST.Config (AppConfig (..), Proxy (..),
|
||||
docsVersion,
|
||||
isMalformedProxyUri,
|
||||
prettyVersion, toURI)
|
||||
import PostgREST.DbStructure (DbStructure (..), tableCols,
|
||||
tablePKCols)
|
||||
import PostgREST.DbStructure.Proc (PgArg (..),
|
||||
ProcDescription (..))
|
||||
import PostgREST.DbStructure.Relation (PrimaryKey (..))
|
||||
import PostgREST.DbStructure.Table (Column (..), ForeignKey (..),
|
||||
Table (..))
|
||||
|
||||
import PostgREST.ContentType
|
||||
|
||||
import Protolude hiding (Proxy, get, toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
encode :: AppConfig -> DbStructure -> [Table] -> Maybe Text -> HashMap.HashMap k [ProcDescription] -> LBS.ByteString
|
||||
encode conf dbStructure tables schemaDescription procs =
|
||||
@@ -47,7 +49,7 @@ encode conf dbStructure tables schemaDescription procs =
|
||||
(dbPrimaryKeys dbStructure)
|
||||
|
||||
makeMimeList :: [ContentType] -> MimeList
|
||||
makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
|
||||
makeMimeList cs = MimeList $ fmap (fromString . toS . toMime) cs
|
||||
|
||||
toSwaggerType :: Text -> SwaggerType t
|
||||
toSwaggerType "character varying" = SwaggerString
|
||||
@@ -68,15 +70,15 @@ makeTableDef pks (t, cs, _) =
|
||||
(tn, (mempty :: Schema)
|
||||
& description .~ tableDescription t
|
||||
& type_ ?~ SwaggerObject
|
||||
& properties .~ fromList (map (makeProperty pks) cs)
|
||||
& required .~ map colName (filter (not . colNullable) cs))
|
||||
& properties .~ fromList (fmap (makeProperty pks) cs)
|
||||
& required .~ fmap colName (filter (not . colNullable) cs))
|
||||
|
||||
makeProperty :: [PrimaryKey] -> Column -> (Text, Referenced Schema)
|
||||
makeProperty pks c = (colName c, Inline s)
|
||||
where
|
||||
e = if null $ colEnum c then Nothing else JSON.decode $ JSON.encode $ colEnum c
|
||||
fk ForeignKey{fkCol=Column{colTable=Table{tableName=a}, colName=b}} =
|
||||
intercalate "" ["This is a Foreign Key to `", a, ".", b, "`.<fk table='", a, "' column='", b, "'/>"]
|
||||
T.intercalate "" ["This is a Foreign Key to `", a, ".", b, "`.<fk table='", a, "' column='", b, "'/>"]
|
||||
pk :: Bool
|
||||
pk = any (\p -> pkTable p == colTable c && pkName p == colName c) pks
|
||||
n = catMaybes
|
||||
@@ -86,7 +88,7 @@ makeProperty pks c = (colName c, Inline s)
|
||||
]
|
||||
d =
|
||||
if length n > 1 then
|
||||
Just $ append (maybe "" (`append` "\n\n") $ colDescription c) (intercalate "\n" n)
|
||||
Just $ T.append (maybe "" (`T.append` "\n\n") $ colDescription c) (T.intercalate "\n" n)
|
||||
else
|
||||
colDescription c
|
||||
s =
|
||||
@@ -103,8 +105,8 @@ makeProcSchema pd =
|
||||
(mempty :: Schema)
|
||||
& description .~ pdDescription pd
|
||||
& type_ ?~ SwaggerObject
|
||||
& properties .~ fromList (map makeProcProperty (pdArgs pd))
|
||||
& required .~ map pgaName (filter pgaReq (pdArgs pd))
|
||||
& properties .~ fromList (fmap makeProcProperty (pdArgs pd))
|
||||
& required .~ fmap pgaName (filter pgaReq (pdArgs pd))
|
||||
|
||||
makeProcProperty :: PgArg -> (Text, Referenced Schema)
|
||||
makeProcProperty (PgArg n t _ _) = (n, Inline s)
|
||||
@@ -203,7 +205,7 @@ makeObjectBody tn =
|
||||
|
||||
makeRowFilter :: Text -> Column -> (Text, Param)
|
||||
makeRowFilter tn c =
|
||||
(intercalate "." ["rowFilter", tn, colName c], (mempty :: Param)
|
||||
(T.intercalate "." ["rowFilter", tn, colName c], (mempty :: Param)
|
||||
& name .~ colName c
|
||||
& description .~ colDescription c
|
||||
& required ?~ False
|
||||
@@ -213,21 +215,21 @@ makeRowFilter tn c =
|
||||
& format ?~ colType c))
|
||||
|
||||
makeRowFilters :: Text -> [Column] -> [(Text, Param)]
|
||||
makeRowFilters tn = map (makeRowFilter tn)
|
||||
makeRowFilters tn = fmap (makeRowFilter tn)
|
||||
|
||||
makePathItem :: (Table, [Column], [Text]) -> (FilePath, PathItem)
|
||||
makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t)
|
||||
makePathItem (t, cs, _) = ("/" ++ T.unpack tn, p $ tableInsertable t)
|
||||
where
|
||||
-- Use first line of table description as summary; rest as description (if present)
|
||||
-- We strip leading newlines from description so that users can include a blank line between summary and description
|
||||
(tSum, tDesc) = fmap fst &&& fmap (dropWhile (=='\n') . snd) $
|
||||
breakOn "\n" <$> tableDescription t
|
||||
(tSum, tDesc) = fmap fst &&& fmap (T.dropWhile (=='\n') . snd) $
|
||||
T.breakOn "\n" <$> tableDescription t
|
||||
tOp = (mempty :: Operation)
|
||||
& tags .~ Set.fromList [tn]
|
||||
& summary .~ tSum
|
||||
& description .~ mfilter (/="") tDesc
|
||||
getOp = tOp
|
||||
& parameters .~ map ref (rs <> ["select", "order", "range", "rangeUnit", "offset", "limit", "preferCount"])
|
||||
& parameters .~ fmap ref (rs <> ["select", "order", "range", "rangeUnit", "offset", "limit", "preferCount"])
|
||||
& at 206 ?~ "Partial Content"
|
||||
& at 200 ?~ Inline ((mempty :: Response)
|
||||
& description .~ "OK"
|
||||
@@ -237,20 +239,20 @@ makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t)
|
||||
)
|
||||
)
|
||||
postOp = tOp
|
||||
& parameters .~ map ref ["body." <> tn, "select", "preferReturn"]
|
||||
& parameters .~ fmap ref ["body." <> tn, "select", "preferReturn"]
|
||||
& at 201 ?~ "Created"
|
||||
patchOp = tOp
|
||||
& parameters .~ map ref (rs <> ["body." <> tn, "preferReturn"])
|
||||
& parameters .~ fmap ref (rs <> ["body." <> tn, "preferReturn"])
|
||||
& at 204 ?~ "No Content"
|
||||
deletOp = tOp
|
||||
& parameters .~ map ref (rs <> ["preferReturn"])
|
||||
& parameters .~ fmap ref (rs <> ["preferReturn"])
|
||||
& at 204 ?~ "No Content"
|
||||
pr = (mempty :: PathItem) & get ?~ getOp
|
||||
pw = pr & post ?~ postOp & patch ?~ patchOp & delete ?~ deletOp
|
||||
p False = pr
|
||||
p True = pw
|
||||
tn = tableName t
|
||||
rs = [ intercalate "." ["rowFilter", tn, colName c ] | c <- cs ]
|
||||
rs = [ T.intercalate "." ["rowFilter", tn, colName c ] | c <- cs ]
|
||||
ref = Ref . Reference
|
||||
|
||||
makeProcPathItem :: ProcDescription -> (FilePath, PathItem)
|
||||
@@ -258,8 +260,8 @@ makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
|
||||
where
|
||||
-- Use first line of proc description as summary; rest as description (if present)
|
||||
-- We strip leading newlines from description so that users can include a blank line between summary and description
|
||||
(pSum, pDesc) = fmap fst &&& fmap (dropWhile (=='\n') . snd) $
|
||||
breakOn "\n" <$> pdDescription pd
|
||||
(pSum, pDesc) = fmap fst &&& fmap (T.dropWhile (=='\n') . snd) $
|
||||
T.breakOn "\n" <$> pdDescription pd
|
||||
postOp = (mempty :: Operation)
|
||||
& summary .~ pSum
|
||||
& description .~ mfilter (/="") pDesc
|
||||
@@ -282,7 +284,7 @@ makeRootPathItem = ("/", p)
|
||||
|
||||
makePathItems :: [ProcDescription] -> [(Table, [Column], [Text])] -> InsOrdHashMap FilePath PathItem
|
||||
makePathItems pds ti = fromList $ makeRootPathItem :
|
||||
map makePathItem ti ++ map makeProcPathItem pds
|
||||
fmap makePathItem ti ++ fmap makeProcPathItem pds
|
||||
|
||||
escapeHostName :: Text -> Text
|
||||
escapeHostName "*" = "0.0.0.0"
|
||||
@@ -294,7 +296,7 @@ escapeHostName h = h
|
||||
|
||||
postgrestSpec :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> Swagger
|
||||
postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
|
||||
& basePath ?~ unpack b
|
||||
& basePath ?~ T.unpack b
|
||||
& schemes ?~ [s']
|
||||
& info .~ ((mempty :: Info)
|
||||
& version .~ prettyVersion
|
||||
@@ -304,14 +306,14 @@ postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
|
||||
& description ?~ "PostgREST Documentation"
|
||||
& url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
|
||||
& host .~ h'
|
||||
& definitions .~ fromList (map (makeTableDef pks) ti)
|
||||
& definitions .~ fromList (makeTableDef pks <$> ti)
|
||||
& parameters .~ fromList (makeParamDefs ti)
|
||||
& paths .~ makePathItems pds ti
|
||||
& produces .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
|
||||
& consumes .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
|
||||
where
|
||||
s' = if s == "http" then Http else Https
|
||||
h' = Just $ Host (unpack $ escapeHostName h) (Just (fromInteger p))
|
||||
h' = Just $ Host (T.unpack $ escapeHostName h) (Just (fromInteger p))
|
||||
d = fromMaybe "This is a dynamic API generated by PostgREST" sd
|
||||
|
||||
pickProxy :: Maybe Text -> Maybe Proxy
|
||||
@@ -329,19 +331,19 @@ pickProxy proxy
|
||||
}
|
||||
where
|
||||
uri = toURI $ fromJust proxy
|
||||
scheme = init $ toLower $ pack $ uriScheme uri
|
||||
scheme = T.init $ T.toLower $ T.pack $ uriScheme uri
|
||||
path URI {uriPath = ""} = "/"
|
||||
path URI {uriPath = p} = p
|
||||
path' = pack $ path uri
|
||||
path' = T.pack $ path uri
|
||||
authority = fromJust $ uriAuthority uri
|
||||
host' = pack $ uriRegName authority
|
||||
host' = T.pack $ uriRegName authority
|
||||
port' = uriPort authority
|
||||
readPort = fromMaybe 80 . readMaybe
|
||||
port'' :: Integer
|
||||
port'' = case (port', scheme) of
|
||||
("", "http") -> 80
|
||||
("", "https") -> 443
|
||||
_ -> readPort $ unpack $ tail $ pack port'
|
||||
_ -> readPort $ T.unpack $ T.tail $ T.pack port'
|
||||
|
||||
proxyUri :: AppConfig -> (Text, Text, Integer, Text)
|
||||
proxyUri AppConfig{..} =
|
||||
|
||||
@@ -1,22 +1,18 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-|
|
||||
Module : PostgREST.QueryBuilder
|
||||
Module : PostgREST.Query.QueryBuilder
|
||||
Description : PostgREST SQL queries generating functions.
|
||||
|
||||
This module provides functions to consume data types that
|
||||
represent database queries (e.g. ReadRequest, MutateRequest) and SqlFragment
|
||||
to produce SqlQuery type outputs.
|
||||
-}
|
||||
module PostgREST.QueryBuilder (
|
||||
readRequestToQuery
|
||||
module PostgREST.Query.QueryBuilder
|
||||
( readRequestToQuery
|
||||
, mutateRequestToQuery
|
||||
, readRequestToCountQuery
|
||||
, requestToCallProcQuery
|
||||
, limitedQuery
|
||||
, setConfigLocal
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
@@ -25,12 +21,20 @@ import qualified Hasql.DynamicStatements.Snippet as H
|
||||
|
||||
import Data.Tree (Tree (..))
|
||||
|
||||
import Data.Maybe
|
||||
import PostgREST.Private.Common
|
||||
import PostgREST.Private.QueryFragment
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (cast, intercalate,
|
||||
replace)
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..))
|
||||
import PostgREST.DbStructure.Proc (PgArg (..))
|
||||
import PostgREST.DbStructure.Relation (Cardinality (..),
|
||||
Relation (..))
|
||||
import PostgREST.DbStructure.Table (Table (..))
|
||||
import PostgREST.Request.ApiRequest (PayloadJSON (..))
|
||||
import PostgREST.Request.Preferences (PreferParameters (..),
|
||||
PreferResolution (..))
|
||||
|
||||
import PostgREST.Query.SqlFragment
|
||||
import PostgREST.Request.Types
|
||||
|
||||
import Protolude
|
||||
|
||||
readRequestToQuery :: ReadRequest -> H.Snippet
|
||||
readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
|
||||
@@ -175,8 +179,3 @@ readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) =
|
||||
|
||||
limitedQuery :: H.Snippet -> Maybe Integer -> H.Snippet
|
||||
limitedQuery query maxRows = query <> H.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
|
||||
|
||||
-- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
|
||||
setConfigLocal :: Text -> (Text, Text) -> H.Snippet
|
||||
setConfigLocal prefix (k, v) =
|
||||
"set_config(" <> unknownLiteral (prefix <> k) <> ", " <> unknownLiteral v <> ", true)"
|
||||
@@ -1,42 +1,106 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-|
|
||||
Module : PostgREST.Private.QueryFragment
|
||||
Module : PostgREST.Query.SqlFragment
|
||||
Description : Helper functions for PostgREST.QueryBuilder.
|
||||
|
||||
Any function that outputs a SqlFragment should be in this module.
|
||||
-}
|
||||
module PostgREST.Private.QueryFragment where
|
||||
module PostgREST.Query.SqlFragment
|
||||
( noLocationF
|
||||
, SqlFragment
|
||||
, asBinaryF
|
||||
, asCsvF
|
||||
, asJsonF
|
||||
, asJsonSingleF
|
||||
, countF
|
||||
, fromQi
|
||||
, ftsOperators
|
||||
, jsonPlaceHolder
|
||||
, limitOffsetF
|
||||
, locationF
|
||||
, normalizedBody
|
||||
, operators
|
||||
, pgFmtColumn
|
||||
, pgFmtIdent
|
||||
, pgFmtJoinCondition
|
||||
, pgFmtLogicTree
|
||||
, pgFmtOrderTerm
|
||||
, pgFmtSelectItem
|
||||
, responseHeadersF
|
||||
, responseStatusF
|
||||
, returningF
|
||||
, selectBody
|
||||
, sourceCTEName
|
||||
, unknownLiteral
|
||||
, intercalateSnippet
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS (intercalate,
|
||||
pack, unwords)
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T (intercalate,
|
||||
isInfixOf, map,
|
||||
null, replace,
|
||||
takeWhile,
|
||||
toLower)
|
||||
import qualified Data.Text as T
|
||||
import qualified Hasql.DynamicStatements.Snippet as H
|
||||
import PostgREST.RangeQuery (NonnegRange,
|
||||
allRange,
|
||||
rangeLimit,
|
||||
rangeOffset)
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (cast,
|
||||
intercalate,
|
||||
replace, toLower,
|
||||
toS)
|
||||
import Protolude.Conv (toS)
|
||||
import Text.InterpolatedString.Perl6 (qc)
|
||||
import qualified Hasql.Encoders as HE
|
||||
|
||||
import qualified Hasql.Encoders as HE
|
||||
import PostgREST.Private.Common
|
||||
import Data.Foldable (foldr1)
|
||||
import Text.InterpolatedString.Perl6 (qc)
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..))
|
||||
import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion96)
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
rangeLimit, rangeOffset)
|
||||
import PostgREST.Request.Types (Alias, Field, Filter (..),
|
||||
JoinCondition (..),
|
||||
JsonOperand (..),
|
||||
JsonOperation (..),
|
||||
JsonPath, LogicTree (..),
|
||||
OpExpr (..), Operation (..),
|
||||
OrderTerm (..), SelectItem)
|
||||
|
||||
import Protolude hiding (cast, toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
|
||||
-- | A part of a SQL query that cannot be executed independently
|
||||
type SqlFragment = ByteString
|
||||
|
||||
noLocationF :: SqlFragment
|
||||
noLocationF = "array[]::text[]"
|
||||
|
||||
sourceCTEName :: SqlFragment
|
||||
sourceCTEName = "pgrst_source"
|
||||
|
||||
operators :: HM.HashMap Text SqlFragment
|
||||
operators = HM.union (HM.fromList [
|
||||
("eq", "="),
|
||||
("gte", ">="),
|
||||
("gt", ">"),
|
||||
("lte", "<="),
|
||||
("lt", "<"),
|
||||
("neq", "<>"),
|
||||
("like", "LIKE"),
|
||||
("ilike", "ILIKE"),
|
||||
("in", "IN"),
|
||||
("is", "IS"),
|
||||
("cs", "@>"),
|
||||
("cd", "<@"),
|
||||
("ov", "&&"),
|
||||
("sl", "<<"),
|
||||
("sr", ">>"),
|
||||
("nxr", "&<"),
|
||||
("nxl", "&>"),
|
||||
("adj", "-|-")]) ftsOperators
|
||||
|
||||
ftsOperators :: HM.HashMap Text SqlFragment
|
||||
ftsOperators = HM.fromList [
|
||||
("fts", "@@ to_tsquery"),
|
||||
("plfts", "@@ plainto_tsquery"),
|
||||
("phfts", "@@ phraseto_tsquery"),
|
||||
("wfts", "@@ websearch_to_tsquery")
|
||||
]
|
||||
|
||||
-- |
|
||||
-- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads
|
||||
-- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays
|
||||
@@ -245,9 +309,13 @@ currentSettingF setting =
|
||||
-- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
|
||||
"nullif(current_setting(" <> pgFmtLit setting <> ", true), '')"
|
||||
|
||||
-- Hasql Snippet utilitarians
|
||||
-- Hasql Snippet utilities
|
||||
unknownEncoder :: ByteString -> H.Snippet
|
||||
unknownEncoder = H.encoderAndParam (HE.nonNullable HE.unknown)
|
||||
|
||||
unknownLiteral :: Text -> H.Snippet
|
||||
unknownLiteral = unknownEncoder . encodeUtf8
|
||||
|
||||
intercalateSnippet :: ByteString -> [H.Snippet] -> H.Snippet
|
||||
intercalateSnippet _ [] = mempty
|
||||
intercalateSnippet frag snippets = foldr1 (\a b -> a <> H.sql frag <> b) snippets
|
||||
@@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-|
|
||||
Module : PostgREST.Statements
|
||||
Module : PostgREST.Query.Statements
|
||||
Description : PostgREST single SQL statements.
|
||||
|
||||
This module constructs single SQL statements that can be parametrized and prepared.
|
||||
@@ -10,38 +10,41 @@ This module constructs single SQL statements that can be parametrized and prepar
|
||||
|
||||
TODO: Currently, createReadStatement is not using prepared statements. See https://github.com/PostgREST/postgrest/issues/718.
|
||||
-}
|
||||
module PostgREST.Statements (
|
||||
createWriteStatement
|
||||
module PostgREST.Query.Statements
|
||||
( createWriteStatement
|
||||
, createReadStatement
|
||||
, callProcStatement
|
||||
, createExplainStatement
|
||||
, dbSettingsStatement
|
||||
) where
|
||||
|
||||
|
||||
import Control.Lens ((^?))
|
||||
import Data.Aeson as JSON
|
||||
import qualified Data.Aeson.Lens as L
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import Data.Maybe
|
||||
import Data.Text.Read (decimal)
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.Encoders as HE
|
||||
import qualified Hasql.Statement as H
|
||||
import Network.HTTP.Types.Status
|
||||
import PostgREST.Error
|
||||
import PostgREST.Private.Common
|
||||
import PostgREST.Private.QueryFragment
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (cast,
|
||||
replace, toS)
|
||||
import Protolude.Conv (toS)
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.Aeson.Lens as L
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Hasql.Decoders as HD
|
||||
import qualified Hasql.DynamicStatements.Snippet as H
|
||||
import qualified Hasql.DynamicStatements.Statement as H
|
||||
import qualified Hasql.Encoders as HE
|
||||
import qualified Hasql.Statement as H
|
||||
|
||||
import Control.Lens ((^?))
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Text.Read (decimal)
|
||||
import Network.HTTP.Types.Status (Status)
|
||||
import Text.InterpolatedString.Perl6 (q)
|
||||
|
||||
import PostgREST.DbStructure.PgVersion (PgVersion)
|
||||
import PostgREST.Error (Error (..))
|
||||
import PostgREST.GucHeader (GucHeader)
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName)
|
||||
import PostgREST.Query.SqlFragment
|
||||
import PostgREST.Request.Preferences
|
||||
|
||||
import Protolude hiding (toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
|
||||
{-| The generic query result format used by API responses. The location header
|
||||
is represented as a list of strings containing variable bindings like
|
||||
@"k1=eq.42"@, or the empty list if there is no location header.
|
||||
@@ -216,3 +219,12 @@ dbSettingsStatement = H.Statement sql HE.noParams decodeSettings False
|
||||
order by key, setdatabase desc;
|
||||
|]
|
||||
decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text
|
||||
|
||||
column :: HD.Value a -> HD.Row a
|
||||
column = HD.column . HD.nonNullable
|
||||
|
||||
nullableColumn :: HD.Value a -> HD.Row (Maybe a)
|
||||
nullableColumn = HD.column . HD.nullable
|
||||
|
||||
arrayColumn :: HD.Value a -> HD.Row [a]
|
||||
arrayColumn = column . HD.listArray . HD.nonNullable
|
||||
@@ -1,20 +1,21 @@
|
||||
{-|
|
||||
Module : PostgREST.ApiRequest
|
||||
Module : PostgREST.Request.ApiRequest
|
||||
Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
|
||||
-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
|
||||
module PostgREST.ApiRequest (
|
||||
ApiRequest(..)
|
||||
, InvokeMethod(..)
|
||||
, ContentType(..)
|
||||
, Action(..)
|
||||
, Target(..)
|
||||
, mutuallyAgreeable
|
||||
, userApiRequest
|
||||
) where
|
||||
module PostgREST.Request.ApiRequest
|
||||
( ApiRequest(..)
|
||||
, InvokeMethod(..)
|
||||
, ContentType(..)
|
||||
, Action(..)
|
||||
, Target(..)
|
||||
, PayloadJSON(..)
|
||||
, mutuallyAgreeable
|
||||
, userApiRequest
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString as BS
|
||||
@@ -32,6 +33,7 @@ import Data.Aeson.Types (emptyArray, emptyObject)
|
||||
import Data.List (last, lookup, partition)
|
||||
import Data.List.NonEmpty (head)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Ranged.Boundaries (Boundary (..))
|
||||
import Data.Ranged.Ranges (Range (..), emptyRange,
|
||||
rangeIntersection)
|
||||
import Network.HTTP.Base (urlEncodeVars)
|
||||
@@ -42,20 +44,48 @@ import Network.Wai (Request (..))
|
||||
import Network.Wai.Parse (parseHttpAccept)
|
||||
import Web.Cookie (parseCookiesText)
|
||||
|
||||
import PostgREST.ContentType (ContentType (..))
|
||||
import PostgREST.DbStructure (DbStructure (..))
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema)
|
||||
import PostgREST.DbStructure.Proc (PgArg (..),
|
||||
ProcDescription (..),
|
||||
findProc)
|
||||
import PostgREST.Error (ApiRequestError (..))
|
||||
import PostgREST.Query.SqlFragment (ftsOperators, operators)
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
rangeGeq, rangeLimit,
|
||||
rangeOffset, rangeRequested,
|
||||
restrictRange)
|
||||
import PostgREST.Request.Parsers (pRequestColumns)
|
||||
import PostgREST.Request.Preferences (PreferCount (..),
|
||||
PreferParameters (..),
|
||||
PreferRepresentation (..),
|
||||
PreferResolution (..),
|
||||
PreferTransaction (..))
|
||||
|
||||
import Data.Ranged.Boundaries
|
||||
import qualified PostgREST.ContentType as ContentType
|
||||
|
||||
import Protolude hiding (head, toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
import PostgREST.Error (ApiRequestError (..))
|
||||
import PostgREST.Parsers (pRequestColumns)
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange, rangeGeq,
|
||||
rangeLimit, rangeOffset, rangeRequested,
|
||||
restrictRange)
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (head, toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
type RequestBody = BL.ByteString
|
||||
|
||||
data PayloadJSON
|
||||
= ProcessedJSON -- ^ Cached attributes of a JSON payload
|
||||
{ pjRaw :: BL.ByteString
|
||||
-- ^ This is the raw ByteString that comes from the request body. We
|
||||
-- cache this instead of an Aeson Value because it was detected that for
|
||||
-- large payloads the encoding had high memory usage, see
|
||||
-- https://github.com/PostgREST/postgrest/pull/1005 for more details
|
||||
, pjKeys :: S.Set Text
|
||||
-- ^ Keys of the object or if it's an array these keys are guaranteed to
|
||||
-- be the same across all its objects
|
||||
}
|
||||
| RawJSON { pjRaw :: BL.ByteString }
|
||||
|
||||
data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
|
||||
-- | Types of things a user wants to do to tables/views/procs
|
||||
data Action = ActionCreate | ActionRead{isHead :: Bool}
|
||||
@@ -143,7 +173,7 @@ userApiRequest confSchemas rootSpec dbStructure req reqBody
|
||||
, iTarget = target
|
||||
, iRange = ranges
|
||||
, iTopLevelRange = topLevelRange
|
||||
, iAccepts = maybe [CTAny] (map decodeContentType . parseHttpAccept) $ lookupHeader "accept"
|
||||
, iAccepts = maybe [CTAny] (map ContentType.decodeContentType . parseHttpAccept) $ lookupHeader "accept"
|
||||
, iPayload = relevantPayload
|
||||
, iPreferRepresentation = representation
|
||||
, iPreferParameters = if | hasPrefer (show SingleObject) -> Just SingleObject
|
||||
@@ -202,7 +232,7 @@ userApiRequest confSchemas rootSpec dbStructure req reqBody
|
||||
isTargetingDefaultSpec = case target of
|
||||
TargetDefaultSpec _ -> True
|
||||
_ -> False
|
||||
contentType = decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type"
|
||||
contentType = ContentType.decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type"
|
||||
columns
|
||||
| action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams)
|
||||
| otherwise = Nothing
|
||||
@@ -236,7 +266,7 @@ userApiRequest confSchemas rootSpec dbStructure req reqBody
|
||||
let paramsMap = M.fromList $ (toS *** JSON.String . toS) <$> urlEncodedBody in
|
||||
Right $ ProcessedJSON (JSON.encode paramsMap) $ S.fromList (M.keys paramsMap)
|
||||
ct ->
|
||||
Left $ toS $ "Content-Type not acceptable: " <> toMime ct
|
||||
Left $ toS $ "Content-Type not acceptable: " <> ContentType.toMime ct
|
||||
topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges -- if no limit is specified, get all the request rows
|
||||
action =
|
||||
case method of
|
||||
@@ -1,21 +1,25 @@
|
||||
{-|
|
||||
Module : PostgREST.DbRequestBuilder
|
||||
Module : PostgREST.Request.DbRequestBuilder
|
||||
Description : PostgREST database request builder
|
||||
|
||||
This module is in charge of building an intermediate representation(ReadRequest, MutateRequest) between the HTTP request and the final resulting SQL query.
|
||||
This module is in charge of building an intermediate
|
||||
representation(ReadRequest, MutateRequest) between the HTTP request and the
|
||||
final resulting SQL query.
|
||||
|
||||
A query tree is built in case of resource embedding. By inferring the relationship between tables, join conditions are added for every embedded resource.
|
||||
A query tree is built in case of resource embedding. By inferring the
|
||||
relationship between tables, join conditions are added for every embedded
|
||||
resource.
|
||||
-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module PostgREST.DbRequestBuilder (
|
||||
readRequest
|
||||
, mutateRequest
|
||||
, returningCols
|
||||
) where
|
||||
module PostgREST.Request.DbRequestBuilder
|
||||
( readRequest
|
||||
, mutateRequest
|
||||
, returningCols
|
||||
) where
|
||||
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Set as S
|
||||
@@ -24,16 +28,31 @@ import Control.Arrow ((***))
|
||||
import Data.Either.Combinators (mapLeft)
|
||||
import Data.List (delete)
|
||||
import Data.Text (isInfixOf)
|
||||
import Data.Tree (Tree (..))
|
||||
|
||||
import Control.Applicative
|
||||
import Data.Tree
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier (..),
|
||||
Schema, TableName)
|
||||
import PostgREST.DbStructure.Relation (Cardinality (..), Link (..),
|
||||
Relation (..))
|
||||
import PostgREST.DbStructure.Table (Column (..), Table (..),
|
||||
tableQi)
|
||||
import PostgREST.Error (ApiRequestError (..),
|
||||
Error (..))
|
||||
import PostgREST.Query.SqlFragment (sourceCTEName)
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
restrictRange)
|
||||
import PostgREST.Request.ApiRequest (Action (..),
|
||||
ApiRequest (..),
|
||||
PayloadJSON (..))
|
||||
|
||||
import PostgREST.ApiRequest (Action (..), ApiRequest (..))
|
||||
import PostgREST.Error (ApiRequestError (..), Error (..))
|
||||
import PostgREST.Parsers
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange, restrictRange)
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (from)
|
||||
import PostgREST.Request.Parsers
|
||||
import PostgREST.Request.Preferences
|
||||
import PostgREST.Request.Types
|
||||
|
||||
import qualified PostgREST.DbStructure.Relation as Relation
|
||||
|
||||
import Protolude hiding (from)
|
||||
|
||||
-- | Builds the ReadRequest tree on a number of stages.
|
||||
-- | Adds filters, order, limits on its respective nodes.
|
||||
@@ -50,23 +69,27 @@ readRequest schema rootTableName maxRows allRels apiRequest =
|
||||
(rootName, rootRels) = rootWithRels schema rootTableName allRels (iAction apiRequest)
|
||||
|
||||
-- Get the root table name with its relationships according to the Action type.
|
||||
-- This is done because of the shape of the final SQL Query. The mutation cases are wrapped in a WITH {sourceCTEName}(see Statements.hs).
|
||||
-- So we need a FROM {sourceCTEName} instead of FROM {tableName}.
|
||||
-- This is done because of the shape of the final SQL Query. The mutation cases
|
||||
-- are wrapped in a WITH {sourceCTEName}(see Statements.hs). So we need a FROM
|
||||
-- {sourceCTEName} instead of FROM {tableName}.
|
||||
rootWithRels :: Schema -> TableName -> [Relation] -> Action -> (QualifiedIdentifier, [Relation])
|
||||
rootWithRels schema rootTableName allRels action = case action of
|
||||
ActionRead _ -> (QualifiedIdentifier schema rootTableName, allRels) -- normal read case
|
||||
_ -> (QualifiedIdentifier mempty _sourceCTEName, mapMaybe toSourceRel allRels ++ allRels) -- mutation cases and calling proc
|
||||
where
|
||||
_sourceCTEName = decodeUtf8 sourceCTEName
|
||||
-- To enable embedding in the sourceCTEName cases we need to replace the foreign key tableName in the Relation
|
||||
-- with {sourceCTEName}. This way findRel can find relationships with sourceCTEName.
|
||||
-- To enable embedding in the sourceCTEName cases we need to replace the
|
||||
-- foreign key tableName in the Relation with {sourceCTEName}. This way
|
||||
-- findRel can find relationships with sourceCTEName.
|
||||
toSourceRel :: Relation -> Maybe Relation
|
||||
toSourceRel r@Relation{relTable=t}
|
||||
| rootTableName == tableName t = Just $ r {relTable=t {tableName=_sourceCTEName}}
|
||||
| otherwise = Nothing
|
||||
|
||||
-- Build the initial tree with a Depth attribute so when a self join occurs we can differentiate the parent and child tables by having
|
||||
-- an alias like "table_depth", this is related to http://github.com/PostgREST/postgrest/issues/987.
|
||||
-- Build the initial tree with a Depth attribute so when a self join occurs we
|
||||
-- can differentiate the parent and child tables by having an alias like
|
||||
-- "table_depth", this is related to
|
||||
-- http://github.com/PostgREST/postgrest/issues/987.
|
||||
initReadRequest :: QualifiedIdentifier -> [Tree SelectItem] -> ReadRequest
|
||||
initReadRequest rootQi =
|
||||
foldr (treeEntry rootDepth) initial
|
||||
@@ -114,10 +137,12 @@ addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, a
|
||||
updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
|
||||
updateForest rq = addRels schema allRels rq `traverse` forest
|
||||
|
||||
-- Finds a relationship between an origin and a target in the request: /origin?select=target(*)
|
||||
-- If more than one relationship is found then the request is ambiguous and we return an error.
|
||||
-- In that case the request can be disambiguated by adding precision to the target or by using a hint: /origin?select=target!hint(*)
|
||||
-- The elements will be matched according to these rules:
|
||||
-- Finds a relationship between an origin and a target in the request:
|
||||
-- /origin?select=target(*) If more than one relationship is found then the
|
||||
-- request is ambiguous and we return an error. In that case the request can
|
||||
-- be disambiguated by adding precision to the target or by using a hint:
|
||||
-- /origin?select=target!hint(*) The elements will be matched according to
|
||||
-- these rules:
|
||||
-- origin = table / view
|
||||
-- target = table / view / constraint / column-from-origin
|
||||
-- hint = table / view / constraint / column-from-origin / column-from-target
|
||||
@@ -128,11 +153,14 @@ findRel schema allRels origin target hint =
|
||||
[] -> Left $ NoRelBetween origin target
|
||||
[r] -> Right r
|
||||
rs ->
|
||||
-- Return error if more than one relationship is found, unless we're in a self reference case.
|
||||
-- Return error if more than one relationship is found, unless we're in a
|
||||
-- self reference case.
|
||||
--
|
||||
-- Here we handle a self reference relationship to not cause a breaking change:
|
||||
-- In a self reference we get two relationships with the same foreign key and relTable/relFtable but with different cardinalities(m2o/o2m)
|
||||
-- We output the O2M rel, the M2O rel can be obtained by using the origin column as an embed hint.
|
||||
-- Here we handle a self reference relationship to not cause a breaking
|
||||
-- change: In a self reference we get two relationships with the same
|
||||
-- foreign key and relTable/relFtable but with different
|
||||
-- cardinalities(m2o/o2m) We output the O2M rel, the M2O rel can be
|
||||
-- obtained by using the origin column as an embed hint.
|
||||
let [rel0, rel1] = take 2 rs in
|
||||
if length rs == 2 && relLink rel0 == relLink rel1 && relTable rel0 == relTable rel1 && relFTable rel0 == relFTable rel1
|
||||
then note (NoRelBetween origin target) (find (\r -> relType r == O2M) rs)
|
||||
@@ -189,7 +217,7 @@ addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_
|
||||
Just r -> Node (augmentQuery r, nodeProps) <$> updatedForest
|
||||
Nothing -> Node node <$> updatedForest
|
||||
where
|
||||
newAlias = case isSelfReference <$> rel of
|
||||
newAlias = case Relation.isSelfReference <$> rel of
|
||||
Just True
|
||||
| depth /= 0 -> Just (qiName tbl <> "_" <> show depth) -- root node doesn't get aliased
|
||||
| otherwise -> Nothing
|
||||
@@ -217,9 +245,10 @@ getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, ta
|
||||
JoinCondition (maybe qi1 (QualifiedIdentifier mempty) previousAlias, colName c)
|
||||
(maybe qi2 (QualifiedIdentifier mempty) newAlias, colName fc)
|
||||
|
||||
-- On mutation and calling proc cases we wrap the target table in a WITH {sourceCTEName}
|
||||
-- if this happens remove the schema `FROM "schema"."{sourceCTEName}"` and use only the
|
||||
-- `FROM "{sourceCTEName}"`. If the schema remains the FROM would be invalid.
|
||||
-- On mutation and calling proc cases we wrap the target table in a WITH
|
||||
-- {sourceCTEName} if this happens remove the schema `FROM
|
||||
-- "schema"."{sourceCTEName}"` and use only the `FROM "{sourceCTEName}"`.
|
||||
-- If the schema remains the FROM would be invalid.
|
||||
removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
|
||||
removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == decodeUtf8 sourceCTEName then mempty else schema) tbl
|
||||
|
||||
@@ -318,16 +347,19 @@ mutateRequest schema tName apiRequest pkCols readReq = mapLeft ApiRequestError $
|
||||
|
||||
returningCols :: ReadRequest -> [FieldName] -> [FieldName]
|
||||
returningCols rr@(Node _ forest) pkCols
|
||||
-- if * is part of the select, we must not add pk or fk columns manually - otherwise those would be selected and output twice
|
||||
-- if * is part of the select, we must not add pk or fk columns manually -
|
||||
-- otherwise those would be selected and output twice
|
||||
| "*" `elem` fldNames = ["*"]
|
||||
| otherwise = returnings
|
||||
where
|
||||
fldNames = fstFieldNames rr
|
||||
-- Without fkCols, when a mutateRequest to /projects?select=name,clients(name) occurs, the RETURNING SQL part would be
|
||||
-- `RETURNING name`(see QueryBuilder).
|
||||
-- This would make the embedding fail because the following JOIN would need the "client_id" column from projects.
|
||||
-- So this adds the foreign key columns to ensure the embedding succeeds, result would be `RETURNING name, client_id`.
|
||||
-- This also works for the other relType's.
|
||||
-- Without fkCols, when a mutateRequest to
|
||||
-- /projects?select=name,clients(name) occurs, the RETURNING SQL part would
|
||||
-- be `RETURNING name`(see QueryBuilder). This would make the embedding
|
||||
-- fail because the following JOIN would need the "client_id" column from
|
||||
-- projects. So this adds the foreign key columns to ensure the embedding
|
||||
-- succeeds, result would be `RETURNING name, client_id`. This also works
|
||||
-- for the other relType's.
|
||||
fkCols = concat $ mapMaybe (\case
|
||||
Node (_, (_, Just Relation{relColumns=cols, relType=relTyp}, _, _, _)) _ -> case relTyp of
|
||||
O2M -> Just cols
|
||||
@@ -335,10 +367,13 @@ returningCols rr@(Node _ forest) pkCols
|
||||
M2M -> Just cols
|
||||
_ -> Nothing
|
||||
) forest
|
||||
-- However if the "client_id" is present, e.g. mutateRequest to /projects?select=client_id,name,clients(name)
|
||||
-- we would get `RETURNING client_id, name, client_id` and then we would produce the "column reference \"client_id\" is ambiguous"
|
||||
-- error from PostgreSQL. So we deduplicate with Set:
|
||||
-- We are adding the primary key columns as well to make sure, that a proper location header can always be built for INSERT/POST
|
||||
-- However if the "client_id" is present, e.g. mutateRequest to
|
||||
-- /projects?select=client_id,name,clients(name) we would get `RETURNING
|
||||
-- client_id, name, client_id` and then we would produce the "column
|
||||
-- reference \"client_id\" is ambiguous" error from PostgreSQL. So we
|
||||
-- deduplicate with Set: We are adding the primary key columns as well to
|
||||
-- make sure, that a proper location header can always be built for
|
||||
-- INSERT/POST
|
||||
returnings = S.toList . S.fromList $ fldNames ++ (colName <$> fkCols) ++ pkCols
|
||||
|
||||
-- Traditional filters(e.g. id=eq.1) are added as root nodes of the LogicTree
|
||||
@@ -1,30 +1,54 @@
|
||||
{-|
|
||||
Module : PostgREST.Parsers
|
||||
Module : PostgREST.Request.Parsers
|
||||
Description : PostgREST parser combinators
|
||||
|
||||
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`.
|
||||
-}
|
||||
module PostgREST.Parsers where
|
||||
module PostgREST.Request.Parsers
|
||||
( pColumns
|
||||
, pLogicPath
|
||||
, pLogicSingleVal
|
||||
, pLogicTree
|
||||
, pOrder
|
||||
, pOrderTerm
|
||||
, pRequestColumns
|
||||
, pRequestFilter
|
||||
, pRequestLogicTree
|
||||
, pRequestOnConflict
|
||||
, pRequestOrder
|
||||
, pRequestRange
|
||||
, pRequestSelect
|
||||
, pSingleVal
|
||||
, pTreePath
|
||||
) where
|
||||
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
import Data.Either.Combinators (mapLeft)
|
||||
import Data.Foldable (foldl1)
|
||||
import Data.List (init, last)
|
||||
import Data.Text (intercalate, replace, strip)
|
||||
import Text.Read (read)
|
||||
import Data.Either.Combinators (mapLeft)
|
||||
import Data.Foldable (foldl1)
|
||||
import Data.List (init, last)
|
||||
import Data.Text (intercalate, replace, strip)
|
||||
import Data.Tree (Tree (..))
|
||||
import Text.Parsec.Error (errorMessages,
|
||||
showErrorMessages)
|
||||
import Text.ParserCombinators.Parsec (GenParser, ParseError, Parser,
|
||||
anyChar, between, char, digit,
|
||||
eof, errorPos, letter,
|
||||
lookAhead, many1, noneOf,
|
||||
notFollowedBy, oneOf, option,
|
||||
optionMaybe, parse, sepBy1,
|
||||
string, try, (<?>))
|
||||
|
||||
import Data.Tree
|
||||
import Text.Parsec.Error
|
||||
import Text.ParserCombinators.Parsec hiding (many, (<|>))
|
||||
import PostgREST.DbStructure.Identifiers (FieldName)
|
||||
import PostgREST.Error (ApiRequestError (ParseRequestError))
|
||||
import PostgREST.Query.SqlFragment (ftsOperators, operators)
|
||||
import PostgREST.RangeQuery (NonnegRange)
|
||||
|
||||
import PostgREST.Error (ApiRequestError (ParseRequestError))
|
||||
import PostgREST.RangeQuery (NonnegRange)
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (intercalate, option, replace, toS,
|
||||
try)
|
||||
import Protolude.Conv (toS)
|
||||
import PostgREST.Request.Types
|
||||
|
||||
import Protolude hiding (intercalate, option, replace, toS, try)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem]
|
||||
pRequestSelect selStr =
|
||||
@@ -250,23 +274,3 @@ mapError = mapLeft translateError
|
||||
message = show $ errorPos e
|
||||
details = strip $ replace "\n" " " $ toS
|
||||
$ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
|
||||
|
||||
-- Used for the config value "role-claim-key"
|
||||
pRoleClaimKey :: Text -> Either Text JSPath
|
||||
pRoleClaimKey selStr =
|
||||
mapLeft show $ parse pJSPath ("failed to parse role-claim-key value (" <> toS selStr <> ")") (toS selStr)
|
||||
|
||||
pJSPath :: Parser JSPath
|
||||
pJSPath = toJSPath <$> (period *> pPath `sepBy` period <* eof)
|
||||
where
|
||||
toJSPath :: [(Text, Maybe Int)] -> JSPath
|
||||
toJSPath = concatMap (\(key, idx) -> JSPKey key : maybeToList (JSPIdx <$> idx))
|
||||
period = char '.' <?> "period (.)"
|
||||
pPath :: Parser (Text, Maybe Int)
|
||||
pPath = (,) <$> pJSPKey <*> optionMaybe pJSPIdx
|
||||
|
||||
pJSPKey :: Parser Text
|
||||
pJSPKey = toS <$> many1 (alphaNum <|> oneOf "_$@") <|> pQuotedValue <?> "attribute name [a..z0..9_$@])"
|
||||
|
||||
pJSPIdx :: Parser Int
|
||||
pJSPIdx = char '[' *> (read <$> many1 digit) <* char ']' <?> "array index [0..n]"
|
||||
@@ -0,0 +1,54 @@
|
||||
module PostgREST.Request.Preferences where
|
||||
|
||||
import GHC.Show
|
||||
import Protolude
|
||||
|
||||
|
||||
data PreferResolution
|
||||
= MergeDuplicates
|
||||
| IgnoreDuplicates
|
||||
|
||||
instance Show PreferResolution where
|
||||
show MergeDuplicates = "resolution=merge-duplicates"
|
||||
show IgnoreDuplicates = "resolution=ignore-duplicates"
|
||||
|
||||
-- | How to return the mutated data. From https://tools.ietf.org/html/rfc7240#section-4.2
|
||||
data PreferRepresentation
|
||||
= Full -- ^ Return the body plus the Location header(in case of POST).
|
||||
| HeadersOnly -- ^ Return the Location header(in case of POST). This needs a SELECT privilege on the pk.
|
||||
| None -- ^ Return nothing from the mutated data.
|
||||
deriving Eq
|
||||
|
||||
instance Show PreferRepresentation where
|
||||
show Full = "return=representation"
|
||||
show None = "return=minimal"
|
||||
show HeadersOnly = mempty
|
||||
|
||||
data PreferParameters
|
||||
= SingleObject -- ^ Pass all parameters as a single json object to a stored procedure
|
||||
| MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure
|
||||
deriving Eq
|
||||
|
||||
instance Show PreferParameters where
|
||||
show SingleObject = "params=single-object"
|
||||
show MultipleObjects = "params=multiple-objects"
|
||||
|
||||
data PreferCount
|
||||
= ExactCount -- ^ exact count(slower)
|
||||
| PlannedCount -- ^ PostgreSQL query planner rows count guess. Done by using EXPLAIN {query}.
|
||||
| EstimatedCount -- ^ use the query planner rows if the count is superior to max-rows, otherwise get the exact count.
|
||||
deriving Eq
|
||||
|
||||
instance Show PreferCount where
|
||||
show ExactCount = "count=exact"
|
||||
show PlannedCount = "count=planned"
|
||||
show EstimatedCount = "count=estimated"
|
||||
|
||||
data PreferTransaction
|
||||
= Commit -- Commit transaction - the default.
|
||||
| Rollback -- Rollback transaction after sending the response - does not persist changes, e.g. for running tests.
|
||||
deriving Eq
|
||||
|
||||
instance Show PreferTransaction where
|
||||
show Commit = "tx=commit"
|
||||
show Rollback = "tx=rollback"
|
||||
@@ -0,0 +1,211 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
module PostgREST.Request.Types
|
||||
( Alias
|
||||
, Depth
|
||||
, EmbedHint
|
||||
, EmbedPath
|
||||
, Field
|
||||
, Filter(..)
|
||||
, JoinCondition(..)
|
||||
, JsonOperand(..)
|
||||
, JsonOperation(..)
|
||||
, JsonPath
|
||||
, ListVal
|
||||
, LogicOperator(..)
|
||||
, LogicTree(..)
|
||||
, MutateQuery(..)
|
||||
, MutateRequest
|
||||
, NodeName
|
||||
, OpExpr(..)
|
||||
, Operation (..)
|
||||
, OrderDirection(..)
|
||||
, OrderNulls(..)
|
||||
, OrderTerm(..)
|
||||
, ReadNode
|
||||
, ReadQuery(..)
|
||||
, ReadRequest
|
||||
, SelectItem
|
||||
, SingleVal
|
||||
, fstFieldNames
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Set as S
|
||||
|
||||
import Data.Tree (Tree (..))
|
||||
|
||||
import qualified GHC.Show (show)
|
||||
|
||||
import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
QualifiedIdentifier)
|
||||
import PostgREST.DbStructure.Relation (Relation)
|
||||
import PostgREST.RangeQuery (NonnegRange)
|
||||
import PostgREST.Request.Preferences (PreferResolution)
|
||||
|
||||
import Protolude
|
||||
|
||||
|
||||
type ReadRequest = Tree ReadNode
|
||||
type MutateRequest = MutateQuery
|
||||
|
||||
type ReadNode =
|
||||
(ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe EmbedHint, Depth))
|
||||
|
||||
type NodeName = Text
|
||||
type Depth = Integer
|
||||
|
||||
data ReadQuery = Select
|
||||
{ select :: [SelectItem]
|
||||
, from :: QualifiedIdentifier
|
||||
-- ^ A table alias is used in case of self joins
|
||||
, fromAlias :: Maybe Alias
|
||||
-- ^ Only used for Many to Many joins. Parent and Child joins use explicit joins.
|
||||
, implicitJoins :: [QualifiedIdentifier]
|
||||
, where_ :: [LogicTree]
|
||||
, joinConditions :: [JoinCondition]
|
||||
, order :: [OrderTerm]
|
||||
, range_ :: NonnegRange
|
||||
}
|
||||
deriving (Eq)
|
||||
|
||||
data JoinCondition =
|
||||
JoinCondition
|
||||
(QualifiedIdentifier, FieldName)
|
||||
(QualifiedIdentifier, FieldName)
|
||||
deriving (Eq)
|
||||
|
||||
data OrderTerm = OrderTerm
|
||||
{ otTerm :: Field
|
||||
, otDirection :: Maybe OrderDirection
|
||||
, otNullOrder :: Maybe OrderNulls
|
||||
}
|
||||
deriving (Eq)
|
||||
|
||||
data OrderDirection
|
||||
= OrderAsc
|
||||
| OrderDesc
|
||||
deriving (Eq)
|
||||
|
||||
instance Show OrderDirection where
|
||||
show OrderAsc = "ASC"
|
||||
show OrderDesc = "DESC"
|
||||
|
||||
data OrderNulls
|
||||
= OrderNullsFirst
|
||||
| OrderNullsLast
|
||||
deriving (Eq)
|
||||
|
||||
instance Show OrderNulls where
|
||||
show OrderNullsFirst = "NULLS FIRST"
|
||||
show OrderNullsLast = "NULLS LAST"
|
||||
|
||||
data MutateQuery
|
||||
= Insert
|
||||
{ in_ :: QualifiedIdentifier
|
||||
, insCols :: S.Set FieldName
|
||||
, insBody :: Maybe BL.ByteString
|
||||
, onConflict :: Maybe (PreferResolution, [FieldName])
|
||||
, where_ :: [LogicTree]
|
||||
, returning :: [FieldName]
|
||||
}
|
||||
| Update
|
||||
{ in_ :: QualifiedIdentifier
|
||||
, updCols :: S.Set FieldName
|
||||
, updBody :: Maybe BL.ByteString
|
||||
, where_ :: [LogicTree]
|
||||
, returning :: [FieldName]
|
||||
}
|
||||
| Delete
|
||||
{ in_ :: QualifiedIdentifier
|
||||
, where_ :: [LogicTree]
|
||||
, returning :: [FieldName]
|
||||
}
|
||||
|
||||
-- | This type will hold information about which particular 'Relation' between
|
||||
-- two tables to choose when there are multiple ones.
|
||||
-- Specifically, it will contain the name of the foreign key or the join table
|
||||
-- in many to many relations.
|
||||
type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe EmbedHint)
|
||||
|
||||
type Field = (FieldName, JsonPath)
|
||||
type Cast = Text
|
||||
type Alias = Text
|
||||
|
||||
-- | Disambiguates an embedding operation when there's multiple relationships
|
||||
-- between two tables. Can be the name of a foreign key constraint, column
|
||||
-- name or the junction in an m2m relationship.
|
||||
type EmbedHint = Text
|
||||
|
||||
-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path
|
||||
-- ["clients", "projects"]
|
||||
type EmbedPath = [Text]
|
||||
|
||||
-- | Json path operations as specified in
|
||||
-- https://www.postgresql.org/docs/current/static/functions-json.html
|
||||
type JsonPath = [JsonOperation]
|
||||
|
||||
-- | Represents the single arrow `->` or double arrow `->>` operators
|
||||
data JsonOperation
|
||||
= JArrow { jOp :: JsonOperand }
|
||||
| J2Arrow { jOp :: JsonOperand }
|
||||
deriving (Eq)
|
||||
|
||||
-- | Represents the key(`->'key'`) or index(`->'1`::int`), the index is Text
|
||||
-- because we reuse our escaping functons and let pg do the casting with
|
||||
-- '1'::int
|
||||
data JsonOperand
|
||||
= JKey { jVal :: Text }
|
||||
| JIdx { jVal :: Text }
|
||||
deriving (Eq)
|
||||
|
||||
-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
|
||||
fstFieldNames :: ReadRequest -> [FieldName]
|
||||
fstFieldNames (Node (sel, _) _) =
|
||||
fst . (\(f, _, _, _) -> f) <$> select sel
|
||||
|
||||
|
||||
-- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
|
||||
--
|
||||
-- And
|
||||
-- / \
|
||||
-- name.eq.N Or
|
||||
-- / \
|
||||
-- id.eq.1 id.eq.2
|
||||
data LogicTree
|
||||
= Expr Bool LogicOperator [LogicTree]
|
||||
| Stmnt Filter
|
||||
deriving (Eq)
|
||||
|
||||
data LogicOperator
|
||||
= And
|
||||
| Or
|
||||
deriving Eq
|
||||
|
||||
instance Show LogicOperator where
|
||||
show And = "AND"
|
||||
show Or = "OR"
|
||||
|
||||
data Filter = Filter
|
||||
{ field :: Field
|
||||
, opExpr :: OpExpr
|
||||
}
|
||||
deriving (Eq)
|
||||
|
||||
data OpExpr =
|
||||
OpExpr Bool Operation
|
||||
deriving (Eq)
|
||||
|
||||
data Operation
|
||||
= Op Operator SingleVal
|
||||
| In ListVal
|
||||
| Fts Operator (Maybe Language) SingleVal
|
||||
deriving (Eq)
|
||||
|
||||
type Operator = Text
|
||||
type Language = Text
|
||||
|
||||
-- | Represents a single value in a filter, e.g. id=eq.singleval
|
||||
type SingleVal = Text
|
||||
|
||||
-- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3)
|
||||
type ListVal = [Text]
|
||||
@@ -1,580 +0,0 @@
|
||||
{-|
|
||||
Module : PostgREST.Types
|
||||
Description : PostgREST common types and functions used by the rest of the modules
|
||||
-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
|
||||
module PostgREST.Types where
|
||||
|
||||
import Control.Lens.Getter (view)
|
||||
import Control.Lens.Tuple (_1)
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Internal as BS (c2w)
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Set as S
|
||||
import qualified GHC.Show
|
||||
|
||||
import Network.HTTP.Types.Header (Header, hContentType)
|
||||
|
||||
import Data.Tree
|
||||
|
||||
import PostgREST.RangeQuery (NonnegRange)
|
||||
import Protolude hiding (toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
-- | Enumeration of currently supported response content types
|
||||
data ContentType = CTApplicationJSON | CTSingularJSON
|
||||
| CTTextCSV | CTTextPlain
|
||||
| CTOpenAPI | CTUrlEncoded | CTOctetStream
|
||||
| CTAny | CTOther ByteString deriving (Eq)
|
||||
|
||||
-- | Convert from ContentType to a full HTTP Header
|
||||
toHeader :: ContentType -> Header
|
||||
toHeader ct = (hContentType, toMime ct <> charset)
|
||||
where
|
||||
charset = case ct of
|
||||
CTOctetStream -> mempty
|
||||
CTOther _ -> mempty
|
||||
_ -> "; charset=utf-8"
|
||||
|
||||
-- | Convert from ContentType to a ByteString representing the mime type
|
||||
toMime :: ContentType -> ByteString
|
||||
toMime CTApplicationJSON = "application/json"
|
||||
toMime CTTextCSV = "text/csv"
|
||||
toMime CTTextPlain = "text/plain"
|
||||
toMime CTOpenAPI = "application/openapi+json"
|
||||
toMime CTSingularJSON = "application/vnd.pgrst.object+json"
|
||||
toMime CTUrlEncoded = "application/x-www-form-urlencoded"
|
||||
toMime CTOctetStream = "application/octet-stream"
|
||||
toMime CTAny = "*/*"
|
||||
toMime (CTOther ct) = ct
|
||||
|
||||
-- | Convert from ByteString to ContentType. Warning: discards MIME parameters
|
||||
decodeContentType :: BS.ByteString -> ContentType
|
||||
decodeContentType ct = case BS.takeWhile (/= BS.c2w ';') ct of
|
||||
"application/json" -> CTApplicationJSON
|
||||
"text/csv" -> CTTextCSV
|
||||
"text/plain" -> CTTextPlain
|
||||
"application/openapi+json" -> CTOpenAPI
|
||||
"application/vnd.pgrst.object+json" -> CTSingularJSON
|
||||
"application/vnd.pgrst.object" -> CTSingularJSON
|
||||
"application/x-www-form-urlencoded" -> CTUrlEncoded
|
||||
"application/octet-stream" -> CTOctetStream
|
||||
"*/*" -> CTAny
|
||||
ct' -> CTOther ct'
|
||||
|
||||
-- | A SQL query that can be executed independently
|
||||
type SqlQuery = ByteString
|
||||
|
||||
-- | A part of a SQL query that cannot be executed independently
|
||||
type SqlFragment = ByteString
|
||||
|
||||
data PreferResolution = MergeDuplicates | IgnoreDuplicates
|
||||
instance Show PreferResolution where
|
||||
show MergeDuplicates = "resolution=merge-duplicates"
|
||||
show IgnoreDuplicates = "resolution=ignore-duplicates"
|
||||
|
||||
-- | How to return the mutated data. From https://tools.ietf.org/html/rfc7240#section-4.2
|
||||
data PreferRepresentation = Full -- ^ Return the body plus the Location header(in case of POST).
|
||||
| HeadersOnly -- ^ Return the Location header(in case of POST). This needs a SELECT privilege on the pk.
|
||||
| None -- ^ Return nothing from the mutated data.
|
||||
deriving Eq
|
||||
instance Show PreferRepresentation where
|
||||
show Full = "return=representation"
|
||||
show None = "return=minimal"
|
||||
show HeadersOnly = mempty
|
||||
|
||||
data PreferParameters
|
||||
= SingleObject -- ^ Pass all parameters as a single json object to a stored procedure
|
||||
| MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure
|
||||
deriving Eq
|
||||
|
||||
instance Show PreferParameters where
|
||||
show SingleObject = "params=single-object"
|
||||
show MultipleObjects = "params=multiple-objects"
|
||||
|
||||
data PreferCount
|
||||
= ExactCount -- ^ exact count(slower)
|
||||
| PlannedCount -- ^ PostgreSQL query planner rows count guess. Done by using EXPLAIN {query}.
|
||||
| EstimatedCount -- ^ use the query planner rows if the count is superior to max-rows, otherwise get the exact count.
|
||||
deriving Eq
|
||||
|
||||
instance Show PreferCount where
|
||||
show ExactCount = "count=exact"
|
||||
show PlannedCount = "count=planned"
|
||||
show EstimatedCount = "count=estimated"
|
||||
|
||||
data PreferTransaction
|
||||
= Commit -- Commit transaction - the default.
|
||||
| Rollback -- Rollback transaction after sending the response - does not persist changes, e.g. for running tests.
|
||||
deriving Eq
|
||||
|
||||
instance Show PreferTransaction where
|
||||
show Commit = "tx=commit"
|
||||
show Rollback = "tx=rollback"
|
||||
|
||||
data DbStructure = DbStructure {
|
||||
dbTables :: [Table]
|
||||
, dbColumns :: [Column]
|
||||
, dbRelations :: [Relation]
|
||||
, dbPrimaryKeys :: [PrimaryKey]
|
||||
, dbProcs :: ProcsMap
|
||||
, pgVersion :: PgVersion
|
||||
} deriving (Generic, JSON.ToJSON)
|
||||
|
||||
-- TODO Table could hold references to all its Columns
|
||||
tableCols :: DbStructure -> Schema -> TableName -> [Column]
|
||||
tableCols dbs tSchema tName = filter (\Column{colTable=Table{tableSchema=s, tableName=t}} -> s==tSchema && t==tName) $ dbColumns dbs
|
||||
|
||||
-- TODO Table could hold references to all its PrimaryKeys
|
||||
tablePKCols :: DbStructure -> Schema -> TableName -> [Text]
|
||||
tablePKCols dbs tSchema tName = pkName <$> filter (\pk -> tSchema == (tableSchema . pkTable) pk && tName == (tableName . pkTable) pk) (dbPrimaryKeys dbs)
|
||||
|
||||
data PgArg = PgArg {
|
||||
pgaName :: Text
|
||||
, pgaType :: Text
|
||||
, pgaReq :: Bool
|
||||
, pgaVar :: Bool
|
||||
} deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data PgType = Scalar | Composite QualifiedIdentifier deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data RetType = Single PgType | SetOf PgType deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data ProcVolatility = Volatile | Stable | Immutable
|
||||
deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data ProcDescription = ProcDescription {
|
||||
pdSchema :: Schema
|
||||
, pdName :: Text
|
||||
, pdDescription :: Maybe Text
|
||||
, pdArgs :: [PgArg]
|
||||
, pdReturnType :: RetType
|
||||
, pdVolatility :: ProcVolatility
|
||||
, pdHasVariadic :: Bool
|
||||
} deriving (Eq, Generic, JSON.ToJSON)
|
||||
|
||||
-- Order by least number of args in the case of overloaded functions
|
||||
instance Ord ProcDescription where
|
||||
ProcDescription schema1 name1 des1 args1 rt1 vol1 hasVar1 `compare` ProcDescription schema2 name2 des2 args2 rt2 vol2 hasVar2
|
||||
| schema1 == schema2 && name1 == name2 && length args1 < length args2 = LT
|
||||
| schema2 == schema2 && name1 == name2 && length args1 > length args2 = GT
|
||||
| otherwise = (schema1, name1, des1, args1, rt1, vol1, hasVar1) `compare` (schema2, name2, des2, args2, rt2, vol2, hasVar2)
|
||||
|
||||
-- | A map of all procs, all of which can be overloaded(one entry will have more than one ProcDescription).
|
||||
-- | It uses a HashMap for a faster lookup.
|
||||
type ProcsMap = M.HashMap QualifiedIdentifier [ProcDescription]
|
||||
|
||||
{-|
|
||||
Search a pg procedure by its parameters. Since a function can be overloaded, the name is not enough to find it.
|
||||
An overloaded function can have a different volatility or even a different return type.
|
||||
Ideally, handling overloaded functions should be left to pg itself. But we need to know certain proc attributes in advance.
|
||||
-}
|
||||
findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> ProcDescription
|
||||
findProc qi payloadKeys paramsAsSingleObject allProcs = fromMaybe fallback bestMatch
|
||||
where
|
||||
-- instead of passing Maybe ProcDescription around, we create a fallback description here when we can't find a matching function
|
||||
-- args is empty, but because "specifiedProcArgs" will fill the missing arguments with default type text, this is not a problem
|
||||
fallback = ProcDescription (qiSchema qi) (qiName qi) Nothing mempty (SetOf $ Composite $ QualifiedIdentifier mempty "record") Volatile False
|
||||
bestMatch =
|
||||
case M.lookup qi allProcs of
|
||||
Nothing -> Nothing
|
||||
Just [proc] -> Just proc -- if it's not an overloaded function then immediately get the ProcDescription
|
||||
Just procs -> find matches procs -- Handle overloaded functions case
|
||||
matches proc =
|
||||
if paramsAsSingleObject
|
||||
-- if the arg is not of json type let the db give the err
|
||||
then length (pdArgs proc) == 1
|
||||
else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs proc)
|
||||
|
||||
{-|
|
||||
Search the procedure parameters by matching them with the specified keys.
|
||||
If the key doesn't match a parameter, a parameter with a default type "text" is assumed.
|
||||
-}
|
||||
specifiedProcArgs :: S.Set FieldName -> ProcDescription -> [PgArg]
|
||||
specifiedProcArgs keys proc =
|
||||
(\k -> fromMaybe (PgArg k "text" True False) (find ((==) k . pgaName) (pdArgs proc))) <$> S.toList keys
|
||||
|
||||
procReturnsScalar :: ProcDescription -> Bool
|
||||
procReturnsScalar proc = case proc of
|
||||
ProcDescription{pdReturnType = (Single Scalar)} -> True
|
||||
ProcDescription{pdReturnType = (SetOf Scalar)} -> True
|
||||
_ -> False
|
||||
|
||||
procReturnsSingle :: ProcDescription -> Bool
|
||||
procReturnsSingle proc = case proc of
|
||||
ProcDescription{pdReturnType = (Single _)} -> True
|
||||
_ -> False
|
||||
|
||||
procTableName :: ProcDescription -> Maybe TableName
|
||||
procTableName proc = case pdReturnType proc of
|
||||
SetOf (Composite qi) -> Just $ qiName qi
|
||||
Single (Composite qi) -> Just $ qiName qi
|
||||
_ -> Nothing
|
||||
|
||||
type Schema = Text
|
||||
type TableName = Text
|
||||
|
||||
data Table = Table {
|
||||
tableSchema :: Schema
|
||||
, tableName :: TableName
|
||||
, tableDescription :: Maybe Text
|
||||
, tableInsertable :: Bool
|
||||
} deriving (Show, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
instance Eq Table where
|
||||
Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
|
||||
|
||||
tableQi :: Table -> QualifiedIdentifier
|
||||
tableQi Table{tableSchema=s, tableName=n} = QualifiedIdentifier s n
|
||||
|
||||
newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Eq, Ord, Generic, JSON.ToJSON)
|
||||
|
||||
data Column =
|
||||
Column {
|
||||
colTable :: Table
|
||||
, colName :: FieldName
|
||||
, colDescription :: Maybe Text
|
||||
, colNullable :: Bool
|
||||
, colType :: Text
|
||||
, colMaxLen :: Maybe Int32
|
||||
, colDefault :: Maybe Text
|
||||
, colEnum :: [Text]
|
||||
, colFK :: Maybe ForeignKey
|
||||
} deriving (Ord, Generic, JSON.ToJSON)
|
||||
|
||||
instance Eq Column where
|
||||
Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
|
||||
|
||||
-- | The source table column a view column refers to
|
||||
type SourceColumn = (Column, ViewColumn)
|
||||
type ViewColumn = Column
|
||||
|
||||
data PrimaryKey = PrimaryKey {
|
||||
pkTable :: Table
|
||||
, pkName :: Text
|
||||
} deriving (Generic, JSON.ToJSON)
|
||||
|
||||
data OrderDirection = OrderAsc | OrderDesc deriving (Eq)
|
||||
instance Show OrderDirection where
|
||||
show OrderAsc = "ASC"
|
||||
show OrderDesc = "DESC"
|
||||
|
||||
data OrderNulls = OrderNullsFirst | OrderNullsLast deriving (Eq)
|
||||
instance Show OrderNulls where
|
||||
show OrderNullsFirst = "NULLS FIRST"
|
||||
show OrderNullsLast = "NULLS LAST"
|
||||
|
||||
data OrderTerm = OrderTerm {
|
||||
otTerm :: Field
|
||||
, otDirection :: Maybe OrderDirection
|
||||
, otNullOrder :: Maybe OrderNulls
|
||||
} deriving (Eq)
|
||||
|
||||
{-|
|
||||
Represents a pg identifier with a prepended schema name "schema.table"
|
||||
When qiSchema is "", the schema is defined by the pg search_path
|
||||
-}
|
||||
data QualifiedIdentifier = QualifiedIdentifier {
|
||||
qiSchema :: Schema
|
||||
, qiName :: TableName
|
||||
} deriving (Eq, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey)
|
||||
instance Hashable QualifiedIdentifier
|
||||
|
||||
-- | The relationship [cardinality](https://en.wikipedia.org/wiki/Cardinality_(data_modeling)).
|
||||
-- | TODO: missing one-to-one
|
||||
data Cardinality = O2M -- ^ one-to-many, previously known as Parent
|
||||
| M2O -- ^ many-to-one, previously known as Child
|
||||
| M2M -- ^ many-to-many, previously known as Many
|
||||
deriving (Eq, Generic, JSON.ToJSON)
|
||||
instance Show Cardinality where
|
||||
show O2M = "o2m"
|
||||
show M2O = "m2o"
|
||||
show M2M = "m2m"
|
||||
|
||||
{-|
|
||||
"Relation"ship between two tables.
|
||||
The order of the relColumns and relFColumns should be maintained to get the join conditions right.
|
||||
TODO merge relColumns and relFColumns to a tuple or Data.Bimap
|
||||
-}
|
||||
data Relation = Relation {
|
||||
relTable :: Table
|
||||
, relColumns :: [Column]
|
||||
, relFTable :: Table
|
||||
, relFColumns :: [Column]
|
||||
, relType :: Cardinality
|
||||
, relLink :: Link -- ^ Constraint on O2M/M2O, Junction for M2M Cardinality
|
||||
} deriving (Eq, Generic, JSON.ToJSON)
|
||||
|
||||
type ConstraintName = Text
|
||||
|
||||
-- | Junction table on an M2M relationship
|
||||
data Link
|
||||
= Constraint { constName :: ConstraintName }
|
||||
| Junction {
|
||||
junTable :: Table
|
||||
, junLink1 :: Link
|
||||
, junCols1 :: [Column]
|
||||
, junLink2 :: Link
|
||||
, junCols2 :: [Column]
|
||||
}
|
||||
deriving (Eq, Generic, JSON.ToJSON)
|
||||
|
||||
isSelfReference :: Relation -> Bool
|
||||
isSelfReference r = relTable r == relFTable r
|
||||
|
||||
data PayloadJSON =
|
||||
-- | Cached attributes of a JSON payload
|
||||
ProcessedJSON {
|
||||
-- | This is the raw ByteString that comes from the request body.
|
||||
-- We cache this instead of an Aeson Value because it was detected that for large payloads the encoding
|
||||
-- had high memory usage, see https://github.com/PostgREST/postgrest/pull/1005 for more details
|
||||
pjRaw :: BL.ByteString
|
||||
-- | Keys of the object or if it's an array these keys are guaranteed to be the same across all its objects
|
||||
, pjKeys :: S.Set Text
|
||||
}|
|
||||
RawJSON {
|
||||
pjRaw :: BL.ByteString
|
||||
}
|
||||
|
||||
data PJType = PJArray { pjaLength :: Int } | PJObject
|
||||
|
||||
data Proxy = Proxy {
|
||||
proxyScheme :: Text
|
||||
, proxyHost :: Text
|
||||
, proxyPort :: Integer
|
||||
, proxyPath :: Text
|
||||
}
|
||||
|
||||
type Operator = Text
|
||||
operators :: M.HashMap Operator SqlFragment
|
||||
operators = M.union (M.fromList [
|
||||
("eq", "="),
|
||||
("gte", ">="),
|
||||
("gt", ">"),
|
||||
("lte", "<="),
|
||||
("lt", "<"),
|
||||
("neq", "<>"),
|
||||
("like", "LIKE"),
|
||||
("ilike", "ILIKE"),
|
||||
("in", "IN"),
|
||||
("is", "IS"),
|
||||
("cs", "@>"),
|
||||
("cd", "<@"),
|
||||
("ov", "&&"),
|
||||
("sl", "<<"),
|
||||
("sr", ">>"),
|
||||
("nxr", "&<"),
|
||||
("nxl", "&>"),
|
||||
("adj", "-|-")]) ftsOperators
|
||||
|
||||
ftsOperators :: M.HashMap Operator SqlFragment
|
||||
ftsOperators = M.fromList [
|
||||
("fts", "@@ to_tsquery"),
|
||||
("plfts", "@@ plainto_tsquery"),
|
||||
("phfts", "@@ phraseto_tsquery"),
|
||||
("wfts", "@@ websearch_to_tsquery")
|
||||
]
|
||||
|
||||
data OpExpr = OpExpr Bool Operation deriving (Eq)
|
||||
data Operation = Op Operator SingleVal |
|
||||
In ListVal |
|
||||
Fts Operator (Maybe Language) SingleVal deriving (Eq)
|
||||
type Language = Text
|
||||
|
||||
-- | Represents a single value in a filter, e.g. id=eq.singleval
|
||||
type SingleVal = Text
|
||||
-- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3)
|
||||
type ListVal = [Text]
|
||||
|
||||
data LogicOperator = And | Or deriving Eq
|
||||
instance Show LogicOperator where
|
||||
show And = "AND"
|
||||
show Or = "OR"
|
||||
{-|
|
||||
Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
|
||||
|
||||
And
|
||||
/ \
|
||||
name.eq.N Or
|
||||
/ \
|
||||
id.eq.1 id.eq.2
|
||||
-}
|
||||
data LogicTree = Expr Bool LogicOperator [LogicTree] | Stmnt Filter deriving (Eq)
|
||||
|
||||
type FieldName = Text
|
||||
{-|
|
||||
Json path operations as specified in https://www.postgresql.org/docs/current/static/functions-json.html
|
||||
-}
|
||||
type JsonPath = [JsonOperation]
|
||||
-- | Represents the single arrow `->` or double arrow `->>` operators
|
||||
data JsonOperation = JArrow{jOp :: JsonOperand} | J2Arrow{jOp :: JsonOperand} deriving (Eq)
|
||||
-- | Represents the key(`->'key'`) or index(`->'1`::int`), the index is Text because we reuse our escaping functons and let pg do the casting with '1'::int
|
||||
data JsonOperand = JKey{jVal :: Text} | JIdx{jVal :: Text} deriving (Eq)
|
||||
|
||||
type Field = (FieldName, JsonPath)
|
||||
type Alias = Text
|
||||
type Cast = Text
|
||||
type NodeName = Text
|
||||
|
||||
|
||||
{-|
|
||||
Custom guc header, it's obtained by parsing the json in a:
|
||||
`SET LOCAL "response.headers" = '[{"Set-Cookie": ".."}]'
|
||||
-}
|
||||
newtype GucHeader = GucHeader (CI.CI ByteString, ByteString)
|
||||
|
||||
instance JSON.FromJSON GucHeader where
|
||||
parseJSON (JSON.Object o) = case headMay (M.toList o) of
|
||||
Just (k, JSON.String s) | M.size o == 1 -> pure $ GucHeader (CI.mk $ toS k, toS s)
|
||||
| otherwise -> mzero
|
||||
_ -> mzero
|
||||
parseJSON _ = mzero
|
||||
|
||||
unwrapGucHeader :: GucHeader -> Header
|
||||
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
|
||||
|
||||
{-|
|
||||
This type will hold information about which particular 'Relation' between two tables to choose when there are multiple ones.
|
||||
Specifically, it will contain the name of the foreign key or the join table in many to many relations.
|
||||
-}
|
||||
type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe EmbedHint)
|
||||
-- | Disambiguates an embedding operation when there's multiple relationships between two tables.
|
||||
-- | Can be the name of a foreign key constraint, column name or the junction in an m2m relationship.
|
||||
type EmbedHint = Text
|
||||
-- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path ["clients", "projects"]
|
||||
type EmbedPath = [Text]
|
||||
data Filter = Filter { field::Field, opExpr::OpExpr } deriving (Eq)
|
||||
data JoinCondition = JoinCondition (QualifiedIdentifier, FieldName)
|
||||
(QualifiedIdentifier, FieldName) deriving (Eq)
|
||||
|
||||
data ReadQuery = Select {
|
||||
select :: [SelectItem]
|
||||
, from :: QualifiedIdentifier
|
||||
-- | A table alias is used in case of self joins
|
||||
, fromAlias :: Maybe Alias
|
||||
-- | Only used for Many to Many joins. Parent and Child joins use explicit joins.
|
||||
, implicitJoins :: [QualifiedIdentifier]
|
||||
, where_ :: [LogicTree]
|
||||
, joinConditions :: [JoinCondition]
|
||||
, order :: [OrderTerm]
|
||||
, range_ :: NonnegRange
|
||||
} deriving (Eq)
|
||||
|
||||
data MutateQuery =
|
||||
Insert {
|
||||
in_ :: QualifiedIdentifier
|
||||
, insCols :: S.Set FieldName
|
||||
, insBody :: Maybe BL.ByteString
|
||||
, onConflict :: Maybe (PreferResolution, [FieldName])
|
||||
, where_ :: [LogicTree]
|
||||
, returning :: [FieldName]
|
||||
}|
|
||||
Update {
|
||||
in_ :: QualifiedIdentifier
|
||||
, updCols :: S.Set FieldName
|
||||
, updBody :: Maybe BL.ByteString
|
||||
, where_ :: [LogicTree]
|
||||
, returning :: [FieldName]
|
||||
}|
|
||||
Delete {
|
||||
in_ :: QualifiedIdentifier
|
||||
, where_ :: [LogicTree]
|
||||
, returning :: [FieldName]
|
||||
}
|
||||
|
||||
type ReadRequest = Tree ReadNode
|
||||
type MutateRequest = MutateQuery
|
||||
|
||||
type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe EmbedHint, Depth))
|
||||
type Depth = Integer
|
||||
|
||||
-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
|
||||
fstFieldNames :: ReadRequest -> [FieldName]
|
||||
fstFieldNames (Node (sel, _) _) =
|
||||
fst . view _1 <$> select sel
|
||||
|
||||
data PgVersion = PgVersion {
|
||||
pgvNum :: Int32
|
||||
, pgvName :: Text
|
||||
} deriving (Eq, Generic, JSON.ToJSON)
|
||||
|
||||
instance Ord PgVersion where
|
||||
(PgVersion v1 _) `compare` (PgVersion v2 _) = v1 `compare` v2
|
||||
|
||||
-- | Tells the minimum PostgreSQL version required by this version of PostgREST
|
||||
minimumPgVersion :: PgVersion
|
||||
minimumPgVersion = pgVersion95
|
||||
|
||||
pgVersion95 :: PgVersion
|
||||
pgVersion95 = PgVersion 90500 "9.5"
|
||||
|
||||
pgVersion96 :: PgVersion
|
||||
pgVersion96 = PgVersion 90600 "9.6"
|
||||
|
||||
pgVersion100 :: PgVersion
|
||||
pgVersion100 = PgVersion 100000 "10"
|
||||
|
||||
pgVersion109 :: PgVersion
|
||||
pgVersion109 = PgVersion 100009 "10.9"
|
||||
|
||||
pgVersion110 :: PgVersion
|
||||
pgVersion110 = PgVersion 110000 "11.0"
|
||||
|
||||
pgVersion112 :: PgVersion
|
||||
pgVersion112 = PgVersion 110002 "11.2"
|
||||
|
||||
pgVersion114 :: PgVersion
|
||||
pgVersion114 = PgVersion 110004 "11.4"
|
||||
|
||||
pgVersion121 :: PgVersion
|
||||
pgVersion121 = PgVersion 120001 "12.1"
|
||||
|
||||
pgVersion130 :: PgVersion
|
||||
pgVersion130 = PgVersion 130000 "13.0"
|
||||
|
||||
sourceCTEName :: SqlFragment
|
||||
sourceCTEName = "pgrst_source"
|
||||
|
||||
-- | full jspath, e.g. .property[0].attr.detail
|
||||
type JSPath = [JSPathExp]
|
||||
-- | jspath expression, e.g. .property, .property[0] or ."property-dash"
|
||||
data JSPathExp = JSPKey Text | JSPIdx Int
|
||||
|
||||
instance Show JSPathExp where
|
||||
-- TODO: this needs to be quoted properly for special chars
|
||||
show (JSPKey k) = "." <> show k
|
||||
show (JSPIdx i) = "[" <> show i <> "]"
|
||||
|
||||
-- | Current database connection status data ConnectionStatus
|
||||
data ConnectionStatus
|
||||
= NotConnected
|
||||
| Connected PgVersion
|
||||
| FatalConnectionError Text
|
||||
deriving (Eq)
|
||||
|
||||
-- | Schema cache status
|
||||
data SCacheStatus
|
||||
= SCLoaded
|
||||
| SCOnRetry
|
||||
| SCFatalFail
|
||||
|
||||
data LogLevel = LogCrit | LogError | LogWarn | LogInfo
|
||||
|
||||
instance Show LogLevel where
|
||||
show LogCrit = "crit"
|
||||
show LogError = "error"
|
||||
show LogWarn = "warn"
|
||||
show LogInfo = "info"
|
||||
@@ -7,8 +7,9 @@ import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
|
||||
import PostgREST.Types (PgVersion, pgVersion112)
|
||||
import Protolude hiding (get)
|
||||
import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion112)
|
||||
|
||||
import Protolude hiding (get)
|
||||
import SpecHelper
|
||||
|
||||
spec :: PgVersion -> SpecWith ((), Application)
|
||||
|
||||
@@ -7,8 +7,9 @@ import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
|
||||
import PostgREST.Types (PgVersion, pgVersion112)
|
||||
import Protolude hiding (get)
|
||||
import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion112)
|
||||
|
||||
import Protolude hiding (get)
|
||||
import SpecHelper
|
||||
|
||||
spec :: PgVersion -> SpecWith ((), Application)
|
||||
|
||||
@@ -11,8 +11,10 @@ import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
import Text.Heredoc
|
||||
|
||||
import PostgREST.Types (PgVersion, pgVersion112, pgVersion130)
|
||||
import Protolude hiding (get)
|
||||
import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion112,
|
||||
pgVersion130)
|
||||
|
||||
import Protolude hiding (get)
|
||||
import SpecHelper
|
||||
|
||||
spec :: PgVersion -> SpecWith ((), Application)
|
||||
|
||||
@@ -7,9 +7,10 @@ import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
|
||||
import PostgREST.Types (PgVersion, pgVersion112, pgVersion121,
|
||||
pgVersion95)
|
||||
import Protolude hiding (get)
|
||||
import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion112,
|
||||
pgVersion121, pgVersion95)
|
||||
|
||||
import Protolude hiding (get)
|
||||
import SpecHelper
|
||||
|
||||
spec :: PgVersion -> SpecWith ((), Application)
|
||||
|
||||
@@ -15,7 +15,7 @@ import Test.Hspec.Wai.JSON
|
||||
import Protolude
|
||||
import SpecHelper
|
||||
|
||||
import PostgREST.Types (PgVersion, pgVersion96)
|
||||
import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion96)
|
||||
|
||||
spec :: PgVersion -> SpecWith ((), Application)
|
||||
spec actualPgVersion =
|
||||
|
||||
@@ -8,9 +8,9 @@ import Test.Hspec hiding (pendingWith)
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
|
||||
import PostgREST.Types (PgVersion, pgVersion112, pgVersion121,
|
||||
pgVersion96)
|
||||
import Protolude hiding (get)
|
||||
import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion112,
|
||||
pgVersion121, pgVersion96)
|
||||
import Protolude hiding (get)
|
||||
import SpecHelper
|
||||
|
||||
spec :: PgVersion -> SpecWith ((), Application)
|
||||
|
||||
@@ -11,10 +11,12 @@ import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
import Text.Heredoc
|
||||
|
||||
import PostgREST.Types (PgVersion, pgVersion100, pgVersion109,
|
||||
pgVersion110, pgVersion112, pgVersion114,
|
||||
pgVersion96)
|
||||
import Protolude hiding (get)
|
||||
import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion100,
|
||||
pgVersion109, pgVersion110,
|
||||
pgVersion112, pgVersion114,
|
||||
pgVersion96)
|
||||
|
||||
import Protolude hiding (get)
|
||||
import SpecHelper
|
||||
|
||||
spec :: PgVersion -> SpecWith ((), Application)
|
||||
|
||||
+6
-6
@@ -12,12 +12,12 @@ import Data.Time.Clock (getCurrentTime)
|
||||
import Data.IORef
|
||||
import Test.Hspec
|
||||
|
||||
import PostgREST.App (postgrest)
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.DbStructure (getDbStructure, getPgVersion)
|
||||
import PostgREST.Types (LogLevel (..), pgVersion96)
|
||||
import Protolude hiding (toList, toS)
|
||||
import Protolude.Conv (toS)
|
||||
import PostgREST.App (postgrest)
|
||||
import PostgREST.Config (AppConfig (..), LogLevel (..))
|
||||
import PostgREST.DbStructure (getDbStructure, getPgVersion)
|
||||
import PostgREST.DbStructure.PgVersion (pgVersion96)
|
||||
import Protolude hiding (toList, toS)
|
||||
import Protolude.Conv (toS)
|
||||
import SpecHelper
|
||||
|
||||
import qualified Feature.AndOrParamsSpec
|
||||
|
||||
+6
-2
@@ -14,8 +14,12 @@ import Text.Heredoc
|
||||
import Protolude hiding (get, toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
import PostgREST.QueryBuilder (requestToCallProcQuery)
|
||||
import PostgREST.Types
|
||||
import PostgREST.Query.QueryBuilder (requestToCallProcQuery)
|
||||
import PostgREST.Request.ApiRequest (PayloadJSON (..))
|
||||
|
||||
import PostgREST.DbStructure.Identifiers
|
||||
import PostgREST.DbStructure.Proc
|
||||
import PostgREST.Request.Preferences
|
||||
|
||||
import SpecHelper (getEnvVarWithDefault)
|
||||
|
||||
|
||||
+2
-2
@@ -22,8 +22,8 @@ import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Text.Heredoc
|
||||
|
||||
import PostgREST.Config (AppConfig (..), parseSecret)
|
||||
import PostgREST.Types (JSPathExp (..), LogLevel (..))
|
||||
import PostgREST.Config (AppConfig (..), JSPathExp (..),
|
||||
LogLevel (..), parseSecret)
|
||||
import Protolude hiding (toS)
|
||||
import Protolude.Conv (toS)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user