refactor: Make import aliases consistent across the codebase
This commit is contained in:
+11
-11
@@ -26,10 +26,10 @@ import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
|
|||||||
setServerName)
|
setServerName)
|
||||||
import System.Posix.Types (FileMode)
|
import System.Posix.Types (FileMode)
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BS8
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.HashMap.Strict as Map
|
import qualified Data.HashMap.Strict as M
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as S
|
||||||
import qualified Hasql.DynamicStatements.Snippet as SQL
|
import qualified Hasql.DynamicStatements.Snippet as SQL
|
||||||
import qualified Hasql.Pool as SQL
|
import qualified Hasql.Pool as SQL
|
||||||
import qualified Hasql.Transaction as SQL
|
import qualified Hasql.Transaction as SQL
|
||||||
@@ -163,7 +163,7 @@ postgrest logLev appState connWorker =
|
|||||||
addRetryHint :: Bool -> AppState -> Wai.Response -> IO Wai.Response
|
addRetryHint :: Bool -> AppState -> Wai.Response -> IO Wai.Response
|
||||||
addRetryHint shouldAdd appState response = do
|
addRetryHint shouldAdd appState response = do
|
||||||
delay <- AppState.getRetryNextIn appState
|
delay <- AppState.getRetryNextIn appState
|
||||||
let h = ("Retry-After", BS8.pack $ show delay)
|
let h = ("Retry-After", BS.pack $ show delay)
|
||||||
return $ Wai.mapResponseHeaders (\hs -> if shouldAdd then h:hs else hs) response
|
return $ Wai.mapResponseHeaders (\hs -> if shouldAdd then h:hs else hs) response
|
||||||
|
|
||||||
postgrestResponse
|
postgrestResponse
|
||||||
@@ -271,7 +271,7 @@ handleRead headersOnly identifier context@RequestContext{..} = do
|
|||||||
, ( "Content-Location"
|
, ( "Content-Location"
|
||||||
, "/"
|
, "/"
|
||||||
<> toS (qiName identifier)
|
<> toS (qiName identifier)
|
||||||
<> if BS8.null iCanonicalQS then mempty else "?" <> toS iCanonicalQS
|
<> if BS.null iCanonicalQS then mempty else "?" <> toS iCanonicalQS
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
++ contentTypeHeaders context
|
++ contentTypeHeaders context
|
||||||
@@ -322,7 +322,7 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
|
|||||||
, if null pkCols && isNothing iOnConflict then
|
, if null pkCols && isNothing iOnConflict then
|
||||||
Nothing
|
Nothing
|
||||||
else
|
else
|
||||||
(\x -> ("Preference-Applied", BS8.pack $ show x)) <$> iPreferResolution
|
(\x -> ("Preference-Applied", BS.pack $ show x)) <$> iPreferResolution
|
||||||
]
|
]
|
||||||
|
|
||||||
failNotSingular iAcceptContentType resQueryTotal $
|
failNotSingular iAcceptContentType resQueryTotal $
|
||||||
@@ -338,7 +338,7 @@ handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
|
|||||||
let
|
let
|
||||||
response = gucResponse resGucStatus resGucHeaders
|
response = gucResponse resGucStatus resGucHeaders
|
||||||
fullRepr = iPreferRepresentation == Full
|
fullRepr = iPreferRepresentation == Full
|
||||||
updateIsNoOp = Set.null iColumns
|
updateIsNoOp = S.null iColumns
|
||||||
status
|
status
|
||||||
| resQueryTotal == 0 && not updateIsNoOp = HTTP.status404
|
| resQueryTotal == 0 && not updateIsNoOp = HTTP.status404
|
||||||
| fullRepr = HTTP.status200
|
| fullRepr = HTTP.status200
|
||||||
@@ -406,7 +406,7 @@ handleInfo identifier RequestContext{..} =
|
|||||||
allOrigins = ("Access-Control-Allow-Origin", "*")
|
allOrigins = ("Access-Control-Allow-Origin", "*")
|
||||||
allowH table =
|
allowH table =
|
||||||
( HTTP.hAllow
|
( HTTP.hAllow
|
||||||
, BS8.intercalate "," $
|
, BS.intercalate "," $
|
||||||
["OPTIONS,GET,HEAD"]
|
["OPTIONS,GET,HEAD"]
|
||||||
++ ["POST" | tableInsertable table]
|
++ ["POST" | tableInsertable table]
|
||||||
++ ["PUT" | tableInsertable table && tableUpdatable table && hasPK]
|
++ ["PUT" | tableInsertable table && tableUpdatable table && hasPK]
|
||||||
@@ -473,7 +473,7 @@ handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure
|
|||||||
OAIgnorePriv ->
|
OAIgnorePriv ->
|
||||||
OpenAPI.encode conf dbStructure
|
OpenAPI.encode conf dbStructure
|
||||||
(filter (\x -> tableSchema x == tSchema) $ DbStructure.dbTables dbStructure)
|
(filter (\x -> tableSchema x == tSchema) $ DbStructure.dbTables dbStructure)
|
||||||
(Map.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure)
|
(M.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure)
|
||||||
<$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
<$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements)
|
||||||
OADisabled ->
|
OADisabled ->
|
||||||
pure mempty
|
pure mempty
|
||||||
@@ -609,6 +609,6 @@ profileHeader ApiRequest{..} =
|
|||||||
|
|
||||||
splitKeyValue :: ByteString -> (ByteString, ByteString)
|
splitKeyValue :: ByteString -> (ByteString, ByteString)
|
||||||
splitKeyValue kv =
|
splitKeyValue kv =
|
||||||
(k, BS8.tail v)
|
(k, BS.tail v)
|
||||||
where
|
where
|
||||||
(k, v) = BS8.break (== '=') kv
|
(k, v) = BS.break (== '=') kv
|
||||||
|
|||||||
@@ -25,7 +25,7 @@ module PostgREST.AppState
|
|||||||
, waitListener
|
, waitListener
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Hasql.Pool as P
|
import qualified Hasql.Pool as SQL
|
||||||
|
|
||||||
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
|
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
|
||||||
updateAction)
|
updateAction)
|
||||||
@@ -44,7 +44,7 @@ import Protolude.Conv (toS)
|
|||||||
|
|
||||||
|
|
||||||
data AppState = AppState
|
data AppState = AppState
|
||||||
{ statePool :: P.Pool -- | Connection pool, either a 'Connection' or a 'ConnectionError'
|
{ statePool :: SQL.Pool -- | Connection pool, either a 'Connection' or a 'ConnectionError'
|
||||||
, statePgVersion :: IORef PgVersion
|
, statePgVersion :: IORef PgVersion
|
||||||
-- | No schema cache at the start. Will be filled in by the connectionWorker
|
-- | No schema cache at the start. Will be filled in by the connectionWorker
|
||||||
, stateDbStructure :: IORef (Maybe DbStructure)
|
, stateDbStructure :: IORef (Maybe DbStructure)
|
||||||
@@ -71,7 +71,7 @@ init conf = do
|
|||||||
newPool <- initPool conf
|
newPool <- initPool conf
|
||||||
initWithPool newPool conf
|
initWithPool newPool conf
|
||||||
|
|
||||||
initWithPool :: P.Pool -> AppConfig -> IO AppState
|
initWithPool :: SQL.Pool -> AppConfig -> IO AppState
|
||||||
initWithPool newPool conf =
|
initWithPool newPool conf =
|
||||||
AppState newPool
|
AppState newPool
|
||||||
<$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step
|
<$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step
|
||||||
@@ -85,15 +85,15 @@ initWithPool newPool conf =
|
|||||||
<*> myThreadId
|
<*> myThreadId
|
||||||
<*> newIORef 0
|
<*> newIORef 0
|
||||||
|
|
||||||
initPool :: AppConfig -> IO P.Pool
|
initPool :: AppConfig -> IO SQL.Pool
|
||||||
initPool AppConfig{..} =
|
initPool AppConfig{..} =
|
||||||
P.acquire (configDbPoolSize, configDbPoolTimeout, toS configDbUri)
|
SQL.acquire (configDbPoolSize, configDbPoolTimeout, toS configDbUri)
|
||||||
|
|
||||||
getPool :: AppState -> P.Pool
|
getPool :: AppState -> SQL.Pool
|
||||||
getPool = statePool
|
getPool = statePool
|
||||||
|
|
||||||
releasePool :: AppState -> IO ()
|
releasePool :: AppState -> IO ()
|
||||||
releasePool AppState{..} = P.release statePool >> throwTo stateMainThreadId UserInterrupt
|
releasePool AppState{..} = SQL.release statePool >> throwTo stateMainThreadId UserInterrupt
|
||||||
|
|
||||||
getPgVersion :: AppState -> IO PgVersion
|
getPgVersion :: AppState -> IO PgVersion
|
||||||
getPgVersion = readIORef . statePgVersion
|
getPgVersion = readIORef . statePgVersion
|
||||||
|
|||||||
@@ -8,10 +8,10 @@ module PostgREST.CLI
|
|||||||
, readCLIShowHelp
|
, readCLIShowHelp
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Hasql.Pool as P
|
import qualified Hasql.Pool as SQL
|
||||||
import qualified Hasql.Transaction.Sessions as HT
|
import qualified Hasql.Transaction.Sessions as SQL
|
||||||
import qualified Options.Applicative as O
|
import qualified Options.Applicative as O
|
||||||
import qualified Protolude.Conv as Conv
|
import qualified Protolude.Conv as Conv
|
||||||
|
|
||||||
@@ -54,19 +54,19 @@ dumpSchema :: AppState -> IO LBS.ByteString
|
|||||||
dumpSchema appState = do
|
dumpSchema appState = do
|
||||||
AppConfig{..} <- AppState.getConfig appState
|
AppConfig{..} <- AppState.getConfig appState
|
||||||
result <-
|
result <-
|
||||||
let transaction = if configDbPreparedStatements then HT.transaction else HT.unpreparedTransaction in
|
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
|
||||||
P.use (AppState.getPool appState) $
|
SQL.use (AppState.getPool appState) $
|
||||||
transaction HT.ReadCommitted HT.Read $
|
transaction SQL.ReadCommitted SQL.Read $
|
||||||
queryDbStructure
|
queryDbStructure
|
||||||
(toList configDbSchemas)
|
(toList configDbSchemas)
|
||||||
configDbExtraSearchPath
|
configDbExtraSearchPath
|
||||||
configDbPreparedStatements
|
configDbPreparedStatements
|
||||||
P.release $ AppState.getPool appState
|
SQL.release $ AppState.getPool appState
|
||||||
case result of
|
case result of
|
||||||
Left e -> do
|
Left e -> do
|
||||||
hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
|
hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
|
||||||
exitFailure
|
exitFailure
|
||||||
Right dbStructure -> return $ Aeson.encode dbStructure
|
Right dbStructure -> return $ JSON.encode dbStructure
|
||||||
|
|
||||||
-- | Command line interface options
|
-- | Command line interface options
|
||||||
data CLI = CLI
|
data CLI = CLI
|
||||||
|
|||||||
@@ -29,9 +29,8 @@ module PostgREST.Config
|
|||||||
import qualified Crypto.JOSE.Types as JOSE
|
import qualified Crypto.JOSE.Types as JOSE
|
||||||
import qualified Crypto.JWT as JWT
|
import qualified Crypto.JWT as JWT
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Base64 as B64
|
import qualified Data.ByteString.Base64 as B64
|
||||||
import qualified Data.ByteString.Char8 as BS
|
|
||||||
import qualified Data.Configurator as C
|
import qualified Data.Configurator as C
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
@@ -86,12 +85,12 @@ data AppConfig = AppConfig
|
|||||||
, configJWKS :: Maybe JWKSet
|
, configJWKS :: Maybe JWKSet
|
||||||
, configJwtAudience :: Maybe StringOrURI
|
, configJwtAudience :: Maybe StringOrURI
|
||||||
, configJwtRoleClaimKey :: JSPath
|
, configJwtRoleClaimKey :: JSPath
|
||||||
, configJwtSecret :: Maybe B.ByteString
|
, configJwtSecret :: Maybe BS.ByteString
|
||||||
, configJwtSecretIsBase64 :: Bool
|
, configJwtSecretIsBase64 :: Bool
|
||||||
, configLogLevel :: LogLevel
|
, configLogLevel :: LogLevel
|
||||||
, configOpenApiMode :: OpenAPIMode
|
, configOpenApiMode :: OpenAPIMode
|
||||||
, configOpenApiServerProxyUri :: Maybe Text
|
, configOpenApiServerProxyUri :: Maybe Text
|
||||||
, configRawMediaTypes :: [B.ByteString]
|
, configRawMediaTypes :: [BS.ByteString]
|
||||||
, configServerHost :: Text
|
, configServerHost :: Text
|
||||||
, configServerPort :: Int
|
, configServerPort :: Int
|
||||||
, configServerUnixSocket :: Maybe FilePath
|
, configServerUnixSocket :: Maybe FilePath
|
||||||
@@ -144,7 +143,7 @@ toText conf =
|
|||||||
,("log-level", q . show . configLogLevel)
|
,("log-level", q . show . configLogLevel)
|
||||||
,("openapi-mode", q . show . configOpenApiMode)
|
,("openapi-mode", q . show . configOpenApiMode)
|
||||||
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
|
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
|
||||||
,("raw-media-types", q . toS . B.intercalate "," . configRawMediaTypes)
|
,("raw-media-types", q . toS . BS.intercalate "," . configRawMediaTypes)
|
||||||
,("server-host", q . configServerHost)
|
,("server-host", q . configServerHost)
|
||||||
,("server-port", show . configServerPort)
|
,("server-port", show . configServerPort)
|
||||||
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
|
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
|
||||||
|
|||||||
@@ -9,31 +9,31 @@ import PostgREST.Config.PgVersion (PgVersion (..))
|
|||||||
|
|
||||||
import qualified Hasql.Decoders as HD
|
import qualified Hasql.Decoders as HD
|
||||||
import qualified Hasql.Encoders as HE
|
import qualified Hasql.Encoders as HE
|
||||||
import qualified Hasql.Pool as P
|
import qualified Hasql.Pool as SQL
|
||||||
import qualified Hasql.Session as H
|
import Hasql.Session (Session, statement)
|
||||||
import qualified Hasql.Statement as H
|
import qualified Hasql.Statement as SQL
|
||||||
import qualified Hasql.Transaction as HT
|
import qualified Hasql.Transaction as SQL
|
||||||
import qualified Hasql.Transaction.Sessions as HT
|
import qualified Hasql.Transaction.Sessions as SQL
|
||||||
|
|
||||||
import Text.InterpolatedString.Perl6 (q)
|
import Text.InterpolatedString.Perl6 (q)
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
queryPgVersion :: H.Session PgVersion
|
queryPgVersion :: Session PgVersion
|
||||||
queryPgVersion = H.statement mempty $ H.Statement sql HE.noParams versionRow False
|
queryPgVersion = statement mempty $ SQL.Statement sql HE.noParams versionRow False
|
||||||
where
|
where
|
||||||
sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
|
sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
|
||||||
versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text
|
versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text
|
||||||
|
|
||||||
queryDbSettings :: P.Pool -> Bool -> IO (Either P.UsageError [(Text, Text)])
|
queryDbSettings :: SQL.Pool -> Bool -> IO (Either SQL.UsageError [(Text, Text)])
|
||||||
queryDbSettings pool prepared =
|
queryDbSettings pool prepared =
|
||||||
let transaction = if prepared then HT.transaction else HT.unpreparedTransaction in
|
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
|
||||||
P.use pool . transaction HT.ReadCommitted HT.Read $
|
SQL.use pool . transaction SQL.ReadCommitted SQL.Read $
|
||||||
HT.statement mempty dbSettingsStatement
|
SQL.statement mempty dbSettingsStatement
|
||||||
|
|
||||||
-- | Get db settings from the connection role. Global settings will be overridden by database specific settings.
|
-- | Get db settings from the connection role. Global settings will be overridden by database specific settings.
|
||||||
dbSettingsStatement :: H.Statement () [(Text, Text)]
|
dbSettingsStatement :: SQL.Statement () [(Text, Text)]
|
||||||
dbSettingsStatement = H.Statement sql HE.noParams decodeSettings False
|
dbSettingsStatement = SQL.Statement sql HE.noParams decodeSettings False
|
||||||
where
|
where
|
||||||
sql = [q|
|
sql = [q|
|
||||||
with
|
with
|
||||||
|
|||||||
@@ -33,8 +33,8 @@ import qualified Data.HashMap.Strict as M
|
|||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
import qualified Hasql.Decoders as HD
|
import qualified Hasql.Decoders as HD
|
||||||
import qualified Hasql.Encoders as HE
|
import qualified Hasql.Encoders as HE
|
||||||
import qualified Hasql.Statement as H
|
import qualified Hasql.Statement as SQL
|
||||||
import qualified Hasql.Transaction as HT
|
import qualified Hasql.Transaction as SQL
|
||||||
|
|
||||||
import Contravariant.Extras (contrazip2)
|
import Contravariant.Extras (contrazip2)
|
||||||
import Data.Set as S (fromList)
|
import Data.Set as S (fromList)
|
||||||
@@ -83,15 +83,15 @@ type ViewColumn = Column
|
|||||||
-- | A SQL query that can be executed independently
|
-- | A SQL query that can be executed independently
|
||||||
type SqlQuery = ByteString
|
type SqlQuery = ByteString
|
||||||
|
|
||||||
queryDbStructure :: [Schema] -> [Schema] -> Bool -> HT.Transaction DbStructure
|
queryDbStructure :: [Schema] -> [Schema] -> Bool -> SQL.Transaction DbStructure
|
||||||
queryDbStructure schemas extraSearchPath prepared = do
|
queryDbStructure schemas extraSearchPath prepared = do
|
||||||
HT.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object
|
SQL.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object
|
||||||
tabs <- HT.statement mempty $ allTables prepared
|
tabs <- SQL.statement mempty $ allTables prepared
|
||||||
cols <- HT.statement schemas $ allColumns tabs prepared
|
cols <- SQL.statement schemas $ allColumns tabs prepared
|
||||||
srcCols <- HT.statement (schemas, extraSearchPath) $ pfkSourceColumns cols prepared
|
srcCols <- SQL.statement (schemas, extraSearchPath) $ pfkSourceColumns cols prepared
|
||||||
m2oRels <- HT.statement mempty $ allM2ORels tabs cols prepared
|
m2oRels <- SQL.statement mempty $ allM2ORels tabs cols prepared
|
||||||
keys <- HT.statement mempty $ allPrimaryKeys tabs prepared
|
keys <- SQL.statement mempty $ allPrimaryKeys tabs prepared
|
||||||
procs <- HT.statement schemas $ allProcs prepared
|
procs <- SQL.statement schemas $ allProcs prepared
|
||||||
|
|
||||||
let rels = addO2MRels . addM2MRels $ addViewM2ORels srcCols m2oRels
|
let rels = addO2MRels . addM2MRels $ addViewM2ORels srcCols m2oRels
|
||||||
keys' = addViewPrimaryKeys srcCols keys
|
keys' = addViewPrimaryKeys srcCols keys
|
||||||
@@ -224,13 +224,13 @@ decodeProcs =
|
|||||||
| v == 's' = Stable
|
| v == 's' = Stable
|
||||||
| otherwise = Volatile -- only 'v' can happen here
|
| otherwise = Volatile -- only 'v' can happen here
|
||||||
|
|
||||||
allProcs :: Bool -> H.Statement [Schema] ProcsMap
|
allProcs :: Bool -> SQL.Statement [Schema] ProcsMap
|
||||||
allProcs = H.Statement (toS sql) (arrayParam HE.text) decodeProcs
|
allProcs = SQL.Statement (toS sql) (arrayParam HE.text) decodeProcs
|
||||||
where
|
where
|
||||||
sql = procsSqlQuery <> " WHERE pn.nspname = ANY($1)"
|
sql = procsSqlQuery <> " WHERE pn.nspname = ANY($1)"
|
||||||
|
|
||||||
accessibleProcs :: Bool -> H.Statement Schema ProcsMap
|
accessibleProcs :: Bool -> SQL.Statement Schema ProcsMap
|
||||||
accessibleProcs = H.Statement (toS sql) (param HE.text) decodeProcs
|
accessibleProcs = SQL.Statement (toS sql) (param HE.text) decodeProcs
|
||||||
where
|
where
|
||||||
sql = procsSqlQuery <> " WHERE pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
|
sql = procsSqlQuery <> " WHERE pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
|
||||||
|
|
||||||
@@ -299,9 +299,9 @@ procsSqlQuery = [q|
|
|||||||
LEFT JOIN pg_catalog.pg_description as d ON d.objoid = p.oid
|
LEFT JOIN pg_catalog.pg_description as d ON d.objoid = p.oid
|
||||||
|]
|
|]
|
||||||
|
|
||||||
schemaDescription :: Bool -> H.Statement Schema (Maybe Text)
|
schemaDescription :: Bool -> SQL.Statement Schema (Maybe Text)
|
||||||
schemaDescription =
|
schemaDescription =
|
||||||
H.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text))
|
SQL.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text))
|
||||||
where
|
where
|
||||||
sql = [q|
|
sql = [q|
|
||||||
select
|
select
|
||||||
@@ -312,9 +312,9 @@ schemaDescription =
|
|||||||
where
|
where
|
||||||
n.nspname = $1 |]
|
n.nspname = $1 |]
|
||||||
|
|
||||||
accessibleTables :: Bool -> H.Statement Schema [Table]
|
accessibleTables :: Bool -> SQL.Statement Schema [Table]
|
||||||
accessibleTables =
|
accessibleTables =
|
||||||
H.Statement sql (param HE.text) decodeTables
|
SQL.Statement sql (param HE.text) decodeTables
|
||||||
where
|
where
|
||||||
sql = [q|
|
sql = [q|
|
||||||
select
|
select
|
||||||
@@ -446,9 +446,9 @@ addViewPrimaryKeys srcCols = concatMap (\pk ->
|
|||||||
filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) srcCols in
|
filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) srcCols in
|
||||||
pk : viewPks)
|
pk : viewPks)
|
||||||
|
|
||||||
allTables :: Bool -> H.Statement () [Table]
|
allTables :: Bool -> SQL.Statement () [Table]
|
||||||
allTables =
|
allTables =
|
||||||
H.Statement sql HE.noParams decodeTables
|
SQL.Statement sql HE.noParams decodeTables
|
||||||
where
|
where
|
||||||
sql = [q|
|
sql = [q|
|
||||||
SELECT
|
SELECT
|
||||||
@@ -488,9 +488,9 @@ allTables =
|
|||||||
AND n.nspname NOT IN ('pg_catalog', 'information_schema')
|
AND n.nspname NOT IN ('pg_catalog', 'information_schema')
|
||||||
ORDER BY table_schema, table_name |]
|
ORDER BY table_schema, table_name |]
|
||||||
|
|
||||||
allColumns :: [Table] -> Bool -> H.Statement [Schema] [Column]
|
allColumns :: [Table] -> Bool -> SQL.Statement [Schema] [Column]
|
||||||
allColumns tabs =
|
allColumns tabs =
|
||||||
H.Statement sql (arrayParam HE.text) (decodeColumns tabs)
|
SQL.Statement sql (arrayParam HE.text) (decodeColumns tabs)
|
||||||
where
|
where
|
||||||
sql = [q|
|
sql = [q|
|
||||||
SELECT DISTINCT
|
SELECT DISTINCT
|
||||||
@@ -621,9 +621,9 @@ columnFromRow tabs (s, t, n, desc, nul, typ, l, d, e) = buildColumn <$> table
|
|||||||
parseEnum :: Maybe Text -> [Text]
|
parseEnum :: Maybe Text -> [Text]
|
||||||
parseEnum = maybe [] (split (==','))
|
parseEnum = maybe [] (split (==','))
|
||||||
|
|
||||||
allM2ORels :: [Table] -> [Column] -> Bool -> H.Statement () [Relationship]
|
allM2ORels :: [Table] -> [Column] -> Bool -> SQL.Statement () [Relationship]
|
||||||
allM2ORels tabs cols =
|
allM2ORels tabs cols =
|
||||||
H.Statement sql HE.noParams (decodeRels tabs cols)
|
SQL.Statement sql HE.noParams (decodeRels tabs cols)
|
||||||
where
|
where
|
||||||
sql = [q|
|
sql = [q|
|
||||||
SELECT ns1.nspname AS table_schema,
|
SELECT ns1.nspname AS table_schema,
|
||||||
@@ -659,9 +659,9 @@ relFromRow allTabs allCols (rs, rt, cn, rcs, frs, frt, frcs) =
|
|||||||
cols = mapM (findCol rs rt) rcs
|
cols = mapM (findCol rs rt) rcs
|
||||||
colsF = mapM (findCol frs frt) frcs
|
colsF = mapM (findCol frs frt) frcs
|
||||||
|
|
||||||
allPrimaryKeys :: [Table] -> Bool -> H.Statement () [PrimaryKey]
|
allPrimaryKeys :: [Table] -> Bool -> SQL.Statement () [PrimaryKey]
|
||||||
allPrimaryKeys tabs =
|
allPrimaryKeys tabs =
|
||||||
H.Statement sql HE.noParams (decodePks tabs)
|
SQL.Statement sql HE.noParams (decodePks tabs)
|
||||||
where
|
where
|
||||||
sql = [q|
|
sql = [q|
|
||||||
-- CTE to replace information_schema.table_constraints to remove owner limit
|
-- CTE to replace information_schema.table_constraints to remove owner limit
|
||||||
@@ -740,9 +740,9 @@ pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
|
|||||||
where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
|
where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
|
||||||
|
|
||||||
-- returns all the primary and foreign key columns which are referenced in views
|
-- returns all the primary and foreign key columns which are referenced in views
|
||||||
pfkSourceColumns :: [Column] -> Bool -> H.Statement ([Schema], [Schema]) [SourceColumn]
|
pfkSourceColumns :: [Column] -> Bool -> SQL.Statement ([Schema], [Schema]) [SourceColumn]
|
||||||
pfkSourceColumns cols =
|
pfkSourceColumns cols =
|
||||||
H.Statement sql (contrazip2 (arrayParam HE.text) (arrayParam HE.text)) (decodeSourceColumns cols)
|
SQL.Statement sql (contrazip2 (arrayParam HE.text) (arrayParam HE.text)) (decodeSourceColumns cols)
|
||||||
-- query explanation at:
|
-- query explanation at:
|
||||||
-- * rationale: https://gist.github.com/wolfgangwalther/5425d64e7b0d20aad71f6f68474d9f19
|
-- * rationale: https://gist.github.com/wolfgangwalther/5425d64e7b0d20aad71f6f68474d9f19
|
||||||
-- * json transformation: https://gist.github.com/wolfgangwalther/3a8939da680c24ad767e93ad2c183089
|
-- * json transformation: https://gist.github.com/wolfgangwalther/3a8939da680c24ad767e93ad2c183089
|
||||||
|
|||||||
+81
-81
@@ -17,9 +17,9 @@ module PostgREST.Error
|
|||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Hasql.Pool as P
|
import qualified Hasql.Pool as SQL
|
||||||
import qualified Hasql.Session as H
|
import qualified Hasql.Session as SQL
|
||||||
import qualified Network.HTTP.Types.Status as HT
|
import qualified Network.HTTP.Types.Status as HTTP
|
||||||
|
|
||||||
import Data.Aeson ((.=))
|
import Data.Aeson ((.=))
|
||||||
import Network.Wai (Response, responseLBS)
|
import Network.Wai (Response, responseLBS)
|
||||||
@@ -41,7 +41,7 @@ import Protolude.Conv (toS, toSL)
|
|||||||
|
|
||||||
|
|
||||||
class (JSON.ToJSON a) => PgrstError a where
|
class (JSON.ToJSON a) => PgrstError a where
|
||||||
status :: a -> HT.Status
|
status :: a -> HTTP.Status
|
||||||
headers :: a -> [Header]
|
headers :: a -> [Header]
|
||||||
|
|
||||||
errorPayload :: a -> LByteString
|
errorPayload :: a -> LByteString
|
||||||
@@ -67,18 +67,18 @@ data ApiRequestError
|
|||||||
| UnsupportedVerb -- Unreachable?
|
| UnsupportedVerb -- Unreachable?
|
||||||
|
|
||||||
instance PgrstError ApiRequestError where
|
instance PgrstError ApiRequestError where
|
||||||
status InvalidRange = HT.status416
|
status InvalidRange = HTTP.status416
|
||||||
status InvalidFilters = HT.status405
|
status InvalidFilters = HTTP.status405
|
||||||
status (InvalidBody _) = HT.status400
|
status (InvalidBody _) = HTTP.status400
|
||||||
status UnsupportedVerb = HT.status405
|
status UnsupportedVerb = HTTP.status405
|
||||||
status ActionInappropriate = HT.status405
|
status ActionInappropriate = HTTP.status405
|
||||||
status (ParseRequestError _ _) = HT.status400
|
status (ParseRequestError _ _) = HTTP.status400
|
||||||
status (NoRelBetween _ _) = HT.status400
|
status (NoRelBetween _ _) = HTTP.status400
|
||||||
status AmbiguousRelBetween{} = HT.status300
|
status AmbiguousRelBetween{} = HTTP.status300
|
||||||
status (AmbiguousRpc _) = HT.status300
|
status (AmbiguousRpc _) = HTTP.status300
|
||||||
status NoRpc{} = HT.status404
|
status NoRpc{} = HTTP.status404
|
||||||
status (UnacceptableSchema _) = HT.status406
|
status (UnacceptableSchema _) = HTTP.status406
|
||||||
status (ContentTypeError _) = HT.status415
|
status (ContentTypeError _) = HTTP.status415
|
||||||
|
|
||||||
headers _ = [ContentType.toHeader CTApplicationJSON]
|
headers _ = [ContentType.toHeader CTApplicationJSON]
|
||||||
|
|
||||||
@@ -145,32 +145,32 @@ compressedRel Relationship{..} =
|
|||||||
, "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))
|
, "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))
|
||||||
]
|
]
|
||||||
|
|
||||||
data PgError = PgError Authenticated P.UsageError
|
data PgError = PgError Authenticated SQL.UsageError
|
||||||
type Authenticated = Bool
|
type Authenticated = Bool
|
||||||
|
|
||||||
instance PgrstError PgError where
|
instance PgrstError PgError where
|
||||||
status (PgError authed usageError) = pgErrorStatus authed usageError
|
status (PgError authed usageError) = pgErrorStatus authed usageError
|
||||||
|
|
||||||
headers err =
|
headers err =
|
||||||
if status err == HT.status401
|
if status err == HTTP.status401
|
||||||
then [ContentType.toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
|
then [ContentType.toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
|
||||||
else [ContentType.toHeader CTApplicationJSON]
|
else [ContentType.toHeader CTApplicationJSON]
|
||||||
|
|
||||||
instance JSON.ToJSON PgError where
|
instance JSON.ToJSON PgError where
|
||||||
toJSON (PgError _ usageError) = JSON.toJSON usageError
|
toJSON (PgError _ usageError) = JSON.toJSON usageError
|
||||||
|
|
||||||
instance JSON.ToJSON P.UsageError where
|
instance JSON.ToJSON SQL.UsageError where
|
||||||
toJSON (P.ConnectionError e) = JSON.object [
|
toJSON (SQL.ConnectionError e) = JSON.object [
|
||||||
"code" .= ("" :: Text),
|
"code" .= ("" :: Text),
|
||||||
"message" .= ("Database connection error. Retrying the connection." :: Text),
|
"message" .= ("Database connection error. Retrying the connection." :: Text),
|
||||||
"details" .= (toSL $ fromMaybe "" e :: Text)]
|
"details" .= (toSL $ fromMaybe "" e :: Text)]
|
||||||
toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
|
toJSON (SQL.SessionError e) = JSON.toJSON e -- SQL.Error
|
||||||
|
|
||||||
instance JSON.ToJSON H.QueryError where
|
instance JSON.ToJSON SQL.QueryError where
|
||||||
toJSON (H.QueryError _ _ e) = JSON.toJSON e
|
toJSON (SQL.QueryError _ _ e) = JSON.toJSON e
|
||||||
|
|
||||||
instance JSON.ToJSON H.CommandError where
|
instance JSON.ToJSON SQL.CommandError where
|
||||||
toJSON (H.ResultError (H.ServerError c m d h)) = case toS c of
|
toJSON (SQL.ResultError (SQL.ServerError c m d h)) = case toS c of
|
||||||
'P':'T':_ -> JSON.object [
|
'P':'T':_ -> JSON.object [
|
||||||
"details" .= (fmap toS d :: Maybe Text),
|
"details" .= (fmap toS d :: Maybe Text),
|
||||||
"hint" .= (fmap toS h :: Maybe Text)]
|
"hint" .= (fmap toS h :: Maybe Text)]
|
||||||
@@ -181,86 +181,86 @@ instance JSON.ToJSON H.CommandError where
|
|||||||
"details" .= (fmap toS d :: Maybe Text),
|
"details" .= (fmap toS d :: Maybe Text),
|
||||||
"hint" .= (fmap toS h :: Maybe Text)]
|
"hint" .= (fmap toS h :: Maybe Text)]
|
||||||
|
|
||||||
toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
|
toJSON (SQL.ResultError (SQL.UnexpectedResult m)) = JSON.object [
|
||||||
"message" .= (m :: Text)]
|
"message" .= (m :: Text)]
|
||||||
toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
|
toJSON (SQL.ResultError (SQL.RowError i SQL.EndOfInput)) = JSON.object [
|
||||||
"message" .= ("Row error: end of input" :: Text),
|
"message" .= ("Row error: end of input" :: Text),
|
||||||
"details" .= ("Attempt to parse more columns than there are in the result" :: Text),
|
"details" .= ("Attempt to parse more columns than there are in the result" :: Text),
|
||||||
"hint" .= (("Row number " <> show i) :: Text)]
|
"hint" .= (("Row number " <> show i) :: Text)]
|
||||||
toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
|
toJSON (SQL.ResultError (SQL.RowError i SQL.UnexpectedNull)) = JSON.object [
|
||||||
"message" .= ("Row error: unexpected null" :: Text),
|
"message" .= ("Row error: unexpected null" :: Text),
|
||||||
"details" .= ("Attempt to parse a NULL as some value." :: Text),
|
"details" .= ("Attempt to parse a NULL as some value." :: Text),
|
||||||
"hint" .= (("Row number " <> show i) :: Text)]
|
"hint" .= (("Row number " <> show i) :: Text)]
|
||||||
toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
|
toJSON (SQL.ResultError (SQL.RowError i (SQL.ValueError d))) = JSON.object [
|
||||||
"message" .= ("Row error: Wrong value parser used" :: Text),
|
"message" .= ("Row error: Wrong value parser used" :: Text),
|
||||||
"details" .= d,
|
"details" .= d,
|
||||||
"hint" .= (("Row number " <> show i) :: Text)]
|
"hint" .= (("Row number " <> show i) :: Text)]
|
||||||
toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [
|
toJSON (SQL.ResultError (SQL.UnexpectedAmountOfRows i)) = JSON.object [
|
||||||
"message" .= ("Unexpected amount of rows" :: Text),
|
"message" .= ("Unexpected amount of rows" :: Text),
|
||||||
"details" .= i]
|
"details" .= i]
|
||||||
toJSON (H.ClientError d) = JSON.object [
|
toJSON (SQL.ClientError d) = JSON.object [
|
||||||
"message" .= ("Database client error. Retrying the connection." :: Text),
|
"message" .= ("Database client error. Retrying the connection." :: Text),
|
||||||
"details" .= (fmap toS d :: Maybe Text)]
|
"details" .= (fmap toS d :: Maybe Text)]
|
||||||
|
|
||||||
pgErrorStatus :: Bool -> P.UsageError -> HT.Status
|
pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status
|
||||||
pgErrorStatus _ (P.ConnectionError _) = HT.status503
|
pgErrorStatus _ (SQL.ConnectionError _) = HTTP.status503
|
||||||
pgErrorStatus _ (P.SessionError (H.QueryError _ _ (H.ClientError _))) = HT.status503
|
pgErrorStatus _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503
|
||||||
pgErrorStatus authed (P.SessionError (H.QueryError _ _ (H.ResultError rError))) =
|
pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rError))) =
|
||||||
case rError of
|
case rError of
|
||||||
(H.ServerError c m _ _) ->
|
(SQL.ServerError c m _ _) ->
|
||||||
case toS c of
|
case toS c of
|
||||||
'0':'8':_ -> HT.status503 -- pg connection err
|
'0':'8':_ -> HTTP.status503 -- pg connection err
|
||||||
'0':'9':_ -> HT.status500 -- triggered action exception
|
'0':'9':_ -> HTTP.status500 -- triggered action exception
|
||||||
'0':'L':_ -> HT.status403 -- invalid grantor
|
'0':'L':_ -> HTTP.status403 -- invalid grantor
|
||||||
'0':'P':_ -> HT.status403 -- invalid role specification
|
'0':'P':_ -> HTTP.status403 -- invalid role specification
|
||||||
"23503" -> HT.status409 -- foreign_key_violation
|
"23503" -> HTTP.status409 -- foreign_key_violation
|
||||||
"23505" -> HT.status409 -- unique_violation
|
"23505" -> HTTP.status409 -- unique_violation
|
||||||
"25006" -> HT.status405 -- read_only_sql_transaction
|
"25006" -> HTTP.status405 -- read_only_sql_transaction
|
||||||
'2':'5':_ -> HT.status500 -- invalid tx state
|
'2':'5':_ -> HTTP.status500 -- invalid tx state
|
||||||
'2':'8':_ -> HT.status403 -- invalid auth specification
|
'2':'8':_ -> HTTP.status403 -- invalid auth specification
|
||||||
'2':'D':_ -> HT.status500 -- invalid tx termination
|
'2':'D':_ -> HTTP.status500 -- invalid tx termination
|
||||||
'3':'8':_ -> HT.status500 -- external routine exception
|
'3':'8':_ -> HTTP.status500 -- external routine exception
|
||||||
'3':'9':_ -> HT.status500 -- external routine invocation
|
'3':'9':_ -> HTTP.status500 -- external routine invocation
|
||||||
'3':'B':_ -> HT.status500 -- savepoint exception
|
'3':'B':_ -> HTTP.status500 -- savepoint exception
|
||||||
'4':'0':_ -> HT.status500 -- tx rollback
|
'4':'0':_ -> HTTP.status500 -- tx rollback
|
||||||
'5':'3':_ -> HT.status503 -- insufficient resources
|
'5':'3':_ -> HTTP.status503 -- insufficient resources
|
||||||
'5':'4':_ -> HT.status413 -- too complex
|
'5':'4':_ -> HTTP.status413 -- too complex
|
||||||
'5':'5':_ -> HT.status500 -- obj not on prereq state
|
'5':'5':_ -> HTTP.status500 -- obj not on prereq state
|
||||||
'5':'7':_ -> HT.status500 -- operator intervention
|
'5':'7':_ -> HTTP.status500 -- operator intervention
|
||||||
'5':'8':_ -> HT.status500 -- system error
|
'5':'8':_ -> HTTP.status500 -- system error
|
||||||
'F':'0':_ -> HT.status500 -- conf file error
|
'F':'0':_ -> HTTP.status500 -- conf file error
|
||||||
'H':'V':_ -> HT.status500 -- foreign data wrapper error
|
'H':'V':_ -> HTTP.status500 -- foreign data wrapper error
|
||||||
"P0001" -> HT.status400 -- default code for "raise"
|
"P0001" -> HTTP.status400 -- default code for "raise"
|
||||||
'P':'0':_ -> HT.status500 -- PL/pgSQL Error
|
'P':'0':_ -> HTTP.status500 -- PL/pgSQL Error
|
||||||
'X':'X':_ -> HT.status500 -- internal Error
|
'X':'X':_ -> HTTP.status500 -- internal Error
|
||||||
"42883" -> HT.status404 -- undefined function
|
"42883" -> HTTP.status404 -- undefined function
|
||||||
"42P01" -> HT.status404 -- undefined table
|
"42P01" -> HTTP.status404 -- undefined table
|
||||||
"42501" -> if authed then HT.status403 else HT.status401 -- insufficient privilege
|
"42501" -> if authed then HTTP.status403 else HTTP.status401 -- insufficient privilege
|
||||||
'P':'T':n -> fromMaybe HT.status500 (HT.mkStatus <$> readMaybe n <*> pure m)
|
'P':'T':n -> fromMaybe HTTP.status500 (HTTP.mkStatus <$> readMaybe n <*> pure m)
|
||||||
_ -> HT.status400
|
_ -> HTTP.status400
|
||||||
|
|
||||||
_ -> HT.status500
|
_ -> HTTP.status500
|
||||||
|
|
||||||
checkIsFatal :: PgError -> Maybe Text
|
checkIsFatal :: PgError -> Maybe Text
|
||||||
checkIsFatal (PgError _ (P.ConnectionError e))
|
checkIsFatal (PgError _ (SQL.ConnectionError e))
|
||||||
| isAuthFailureMessage = Just $ toS failureMessage
|
| isAuthFailureMessage = Just $ toS failureMessage
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` toS failureMessage
|
where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` toS failureMessage
|
||||||
failureMessage = fromMaybe mempty e
|
failureMessage = fromMaybe mempty e
|
||||||
checkIsFatal (PgError _ (P.SessionError (H.QueryError _ _ (H.ResultError serverError))))
|
checkIsFatal (PgError _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError serverError))))
|
||||||
= case serverError of
|
= case serverError of
|
||||||
-- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal.
|
-- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal.
|
||||||
H.ServerError "42601" _ _ _
|
SQL.ServerError "42601" _ _ _
|
||||||
-> Just "Hint: This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues"
|
-> Just "Hint: This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues"
|
||||||
-- Check for a "prepared statement <name> already exists" error (Code 42P05: duplicate_prepared_statement).
|
-- Check for a "prepared statement <name> already exists" error (Code 42P05: duplicate_prepared_statement).
|
||||||
-- This would mean that a connection pooler in transaction mode is being used
|
-- This would mean that a connection pooler in transaction mode is being used
|
||||||
-- while prepared statements are enabled in the PostgREST configuration,
|
-- while prepared statements are enabled in the PostgREST configuration,
|
||||||
-- both of which are incompatible with each other.
|
-- both of which are incompatible with each other.
|
||||||
H.ServerError "42P05" _ _ _
|
SQL.ServerError "42P05" _ _ _
|
||||||
-> Just "Hint: If you are using connection poolers in transaction mode, try setting db-prepared-statements to false."
|
-> Just "Hint: If you are using connection poolers in transaction mode, try setting db-prepared-statements to false."
|
||||||
-- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation).
|
-- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation).
|
||||||
-- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.
|
-- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.
|
||||||
H.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _
|
SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _
|
||||||
-> Just "Hint: Connection poolers in statement mode are not supported."
|
-> Just "Hint: Connection poolers in statement mode are not supported."
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
checkIsFatal _ = Nothing
|
checkIsFatal _ = Nothing
|
||||||
@@ -281,16 +281,16 @@ data Error
|
|||||||
| PgErr PgError
|
| PgErr PgError
|
||||||
|
|
||||||
instance PgrstError Error where
|
instance PgrstError Error where
|
||||||
status GucHeadersError = HT.status500
|
status GucHeadersError = HTTP.status500
|
||||||
status GucStatusError = HT.status500
|
status GucStatusError = HTTP.status500
|
||||||
status (BinaryFieldError _) = HT.status406
|
status (BinaryFieldError _) = HTTP.status406
|
||||||
status ConnectionLostError = HT.status503
|
status ConnectionLostError = HTTP.status503
|
||||||
status PutMatchingPkError = HT.status400
|
status PutMatchingPkError = HTTP.status400
|
||||||
status PutRangeNotAllowedError = HT.status400
|
status PutRangeNotAllowedError = HTTP.status400
|
||||||
status JwtTokenMissing = HT.status500
|
status JwtTokenMissing = HTTP.status500
|
||||||
status (JwtTokenInvalid _) = HT.unauthorized401
|
status (JwtTokenInvalid _) = HTTP.unauthorized401
|
||||||
status (SingularityError _) = HT.status406
|
status (SingularityError _) = HTTP.status406
|
||||||
status NotFound = HT.status404
|
status NotFound = HTTP.status404
|
||||||
status (PgErr err) = status err
|
status (PgErr err) = status err
|
||||||
status (ApiRequestError err) = status err
|
status (ApiRequestError err) = status err
|
||||||
|
|
||||||
|
|||||||
+13
-13
@@ -19,10 +19,10 @@ import qualified Data.CaseInsensitive as CI
|
|||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as M
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Hasql.Decoders as HD
|
import qualified Hasql.Decoders as HD
|
||||||
import qualified Hasql.DynamicStatements.Snippet as H hiding
|
import qualified Hasql.DynamicStatements.Snippet as SQL hiding
|
||||||
(sql)
|
(sql)
|
||||||
import qualified Hasql.DynamicStatements.Statement as H
|
import qualified Hasql.DynamicStatements.Statement as SQL
|
||||||
import qualified Hasql.Transaction as H
|
import qualified Hasql.Transaction as SQL
|
||||||
import qualified Network.HTTP.Types.Header as HTTP
|
import qualified Network.HTTP.Types.Header as HTTP
|
||||||
import qualified Network.Wai as Wai
|
import qualified Network.Wai as Wai
|
||||||
import qualified Network.Wai.Logger as Wai
|
import qualified Network.Wai.Logger as Wai
|
||||||
@@ -57,13 +57,13 @@ import Protolude.Conv (toS)
|
|||||||
|
|
||||||
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
|
-- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function
|
||||||
runPgLocals :: AppConfig -> M.HashMap Text JSON.Value ->
|
runPgLocals :: AppConfig -> M.HashMap Text JSON.Value ->
|
||||||
(ApiRequest -> ExceptT Error H.Transaction Wai.Response) ->
|
(ApiRequest -> ExceptT Error SQL.Transaction Wai.Response) ->
|
||||||
ApiRequest -> ByteString -> PgVersion -> ExceptT Error H.Transaction Wai.Response
|
ApiRequest -> ByteString -> PgVersion -> ExceptT Error SQL.Transaction Wai.Response
|
||||||
runPgLocals conf claims app req jsonDbS actualPgVersion = do
|
runPgLocals conf claims app req jsonDbS actualPgVersion = do
|
||||||
lift $ H.statement mempty $ H.dynamicallyParameterized
|
lift $ SQL.statement mempty $ SQL.dynamicallyParameterized
|
||||||
("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql ++ specSql))
|
("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql ++ specSql))
|
||||||
HD.noResult (configDbPreparedStatements conf)
|
HD.noResult (configDbPreparedStatements conf)
|
||||||
lift $ traverse_ H.sql preReqSql
|
lift $ traverse_ SQL.sql preReqSql
|
||||||
app req
|
app req
|
||||||
where
|
where
|
||||||
methodSql = setConfigLocal mempty ("request.method", iMethod req)
|
methodSql = setConfigLocal mempty ("request.method", iMethod req)
|
||||||
@@ -167,12 +167,12 @@ unquoted v = toS $ JSON.encode v
|
|||||||
optionalRollback
|
optionalRollback
|
||||||
:: AppConfig
|
:: AppConfig
|
||||||
-> ApiRequest
|
-> ApiRequest
|
||||||
-> ExceptT Error H.Transaction Wai.Response
|
-> ExceptT Error SQL.Transaction Wai.Response
|
||||||
-> ExceptT Error H.Transaction Wai.Response
|
-> ExceptT Error SQL.Transaction Wai.Response
|
||||||
optionalRollback AppConfig{..} ApiRequest{..} transaction = do
|
optionalRollback AppConfig{..} ApiRequest{..} transaction = do
|
||||||
resp <- catchError transaction $ return . errorResponseFor
|
resp <- catchError transaction $ return . errorResponseFor
|
||||||
when (shouldRollback || (configDbTxRollbackAll && not shouldCommit))
|
when (shouldRollback || (configDbTxRollbackAll && not shouldCommit))
|
||||||
(lift H.condemn)
|
(lift SQL.condemn)
|
||||||
return $ Wai.mapResponseHeaders preferenceApplied resp
|
return $ Wai.mapResponseHeaders preferenceApplied resp
|
||||||
where
|
where
|
||||||
shouldCommit =
|
shouldCommit =
|
||||||
@@ -190,13 +190,13 @@ optionalRollback AppConfig{..} ApiRequest{..} transaction = do
|
|||||||
identity
|
identity
|
||||||
|
|
||||||
-- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
|
-- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
|
||||||
setConfigLocal :: ByteString -> (ByteString, ByteString) -> H.Snippet
|
setConfigLocal :: ByteString -> (ByteString, ByteString) -> SQL.Snippet
|
||||||
setConfigLocal prefix (k, v) =
|
setConfigLocal prefix (k, v) =
|
||||||
"set_config(" <> unknownEncoder (prefix <> k) <> ", " <> unknownEncoder v <> ", true)"
|
"set_config(" <> unknownEncoder (prefix <> k) <> ", " <> unknownEncoder v <> ", true)"
|
||||||
|
|
||||||
-- | Starting from PostgreSQL v14, some characters are not allowed for config names (mostly affecting headers with "-").
|
-- | Starting from PostgreSQL v14, some characters are not allowed for config names (mostly affecting headers with "-").
|
||||||
-- | A JSON format string is used to avoid this problem. See https://github.com/PostgREST/postgrest/issues/1857
|
-- | A JSON format string is used to avoid this problem. See https://github.com/PostgREST/postgrest/issues/1857
|
||||||
setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [H.Snippet]
|
setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [SQL.Snippet]
|
||||||
setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)]
|
setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)]
|
||||||
where
|
where
|
||||||
gucJsonVal :: [(ByteString, ByteString)] -> ByteString
|
gucJsonVal :: [(ByteString, ByteString)] -> ByteString
|
||||||
|
|||||||
@@ -9,7 +9,7 @@ module PostgREST.OpenAPI (encode) where
|
|||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
import qualified Data.HashMap.Strict as M
|
||||||
import qualified Data.HashSet.InsOrd as Set
|
import qualified Data.HashSet.InsOrd as Set
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
@@ -40,12 +40,12 @@ import PostgREST.ContentType
|
|||||||
import Protolude hiding (Proxy, get, toS)
|
import Protolude hiding (Proxy, get, toS)
|
||||||
import Protolude.Conv (toS)
|
import Protolude.Conv (toS)
|
||||||
|
|
||||||
encode :: AppConfig -> DbStructure -> [Table] -> HashMap.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
|
encode :: AppConfig -> DbStructure -> [Table] -> M.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString
|
||||||
encode conf dbStructure tables procs schemaDescription =
|
encode conf dbStructure tables procs schemaDescription =
|
||||||
JSON.encode $
|
JSON.encode $
|
||||||
postgrestSpec
|
postgrestSpec
|
||||||
(dbRelationships dbStructure)
|
(dbRelationships dbStructure)
|
||||||
(concat $ HashMap.elems procs)
|
(concat $ M.elems procs)
|
||||||
(openApiTableInfo dbStructure <$> tables)
|
(openApiTableInfo dbStructure <$> tables)
|
||||||
(proxyUri conf)
|
(proxyUri conf)
|
||||||
schemaDescription
|
schemaDescription
|
||||||
|
|||||||
@@ -17,7 +17,7 @@ module PostgREST.Query.QueryBuilder
|
|||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import qualified Hasql.DynamicStatements.Snippet as H
|
import qualified Hasql.DynamicStatements.Snippet as SQL
|
||||||
|
|
||||||
import Data.Tree (Tree (..))
|
import Data.Tree (Tree (..))
|
||||||
|
|
||||||
@@ -33,11 +33,11 @@ import PostgREST.Request.Types
|
|||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
readRequestToQuery :: ReadRequest -> H.Snippet
|
readRequestToQuery :: ReadRequest -> SQL.Snippet
|
||||||
readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
|
readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
|
||||||
"SELECT " <>
|
"SELECT " <>
|
||||||
intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <>
|
intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <>
|
||||||
"FROM " <> H.sql (BS.intercalate ", " (tabl : implJs)) <> " " <>
|
"FROM " <> SQL.sql (BS.intercalate ", " (tabl : implJs)) <> " " <>
|
||||||
intercalateSnippet " " joins <> " " <>
|
intercalateSnippet " " joins <> " " <>
|
||||||
(if null logicForest && null joinConditions_ then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_))
|
(if null logicForest && null joinConditions_ then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_))
|
||||||
<> " " <>
|
<> " " <>
|
||||||
@@ -49,16 +49,16 @@ readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicFores
|
|||||||
qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias
|
qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias
|
||||||
(joins, selects) = foldr getJoinsSelects ([],[]) forest
|
(joins, selects) = foldr getJoinsSelects ([],[]) forest
|
||||||
|
|
||||||
getJoinsSelects :: ReadRequest -> ([H.Snippet], [H.Snippet]) -> ([H.Snippet], [H.Snippet])
|
getJoinsSelects :: ReadRequest -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet])
|
||||||
getJoinsSelects rr@(Node (_, (name, Just Relationship{relCardinality=card,relTable=Table{tableName=table}}, alias, _, Just joinType, _)) _) (joins,selects) =
|
getJoinsSelects rr@(Node (_, (name, Just Relationship{relCardinality=card,relTable=Table{tableName=table}}, alias, _, Just joinType, _)) _) (joins,selects) =
|
||||||
let subquery = readRequestToQuery rr in
|
let subquery = readRequestToQuery rr in
|
||||||
case card of
|
case card of
|
||||||
M2O _ ->
|
M2O _ ->
|
||||||
let aliasOrName = fromMaybe name alias
|
let aliasOrName = fromMaybe name alias
|
||||||
localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
|
localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
|
||||||
sel = H.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)
|
sel = SQL.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName)
|
||||||
joi = (if joinType == JTInner then " INNER" else " LEFT")
|
joi = (if joinType == JTInner then " INNER" else " LEFT")
|
||||||
<> " JOIN LATERAL( " <> subquery <> " ) AS " <> H.sql localTableName <> " ON TRUE " in
|
<> " JOIN LATERAL( " <> subquery <> " ) AS " <> SQL.sql localTableName <> " ON TRUE " in
|
||||||
(joi:joins,sel:selects)
|
(joi:joins,sel:selects)
|
||||||
_ -> case joinType of
|
_ -> case joinType of
|
||||||
JTInner ->
|
JTInner ->
|
||||||
@@ -66,29 +66,29 @@ getJoinsSelects rr@(Node (_, (name, Just Relationship{relCardinality=card,relTab
|
|||||||
locTblName = table <> "_" <> aliasOrName
|
locTblName = table <> "_" <> aliasOrName
|
||||||
localTableName = pgFmtIdent locTblName
|
localTableName = pgFmtIdent locTblName
|
||||||
internalTableName = pgFmtIdent $ "_" <> locTblName
|
internalTableName = pgFmtIdent $ "_" <> locTblName
|
||||||
sel = H.sql $ localTableName <> "." <> internalTableName <> " AS " <> pgFmtIdent aliasOrName
|
sel = SQL.sql $ localTableName <> "." <> internalTableName <> " AS " <> pgFmtIdent aliasOrName
|
||||||
joi = "INNER JOIN LATERAL(" <>
|
joi = "INNER JOIN LATERAL(" <>
|
||||||
"SELECT json_agg(" <> H.sql internalTableName <> ") AS " <> H.sql internalTableName <>
|
"SELECT json_agg(" <> SQL.sql internalTableName <> ") AS " <> SQL.sql internalTableName <>
|
||||||
"FROM (" <> subquery <> " ) AS " <> H.sql internalTableName <>
|
"FROM (" <> subquery <> " ) AS " <> SQL.sql internalTableName <>
|
||||||
") AS " <> H.sql localTableName <> " ON " <> H.sql localTableName <> "IS NOT NULL" in
|
") AS " <> SQL.sql localTableName <> " ON " <> SQL.sql localTableName <> "IS NOT NULL" in
|
||||||
(joi:joins,sel:selects)
|
(joi:joins,sel:selects)
|
||||||
JTLeft ->
|
JTLeft ->
|
||||||
let sel = "COALESCE (("
|
let sel = "COALESCE (("
|
||||||
<> "SELECT json_agg(" <> H.sql (pgFmtIdent table) <> ".*) "
|
<> "SELECT json_agg(" <> SQL.sql (pgFmtIdent table) <> ".*) "
|
||||||
<> "FROM (" <> subquery <> ") " <> H.sql (pgFmtIdent table) <> " "
|
<> "FROM (" <> subquery <> ") " <> SQL.sql (pgFmtIdent table) <> " "
|
||||||
<> "), '[]') AS " <> H.sql (pgFmtIdent (fromMaybe name alias)) in
|
<> "), '[]') AS " <> SQL.sql (pgFmtIdent (fromMaybe name alias)) in
|
||||||
(joins,sel:selects)
|
(joins,sel:selects)
|
||||||
getJoinsSelects _ _ = ([], [])
|
getJoinsSelects _ _ = ([], [])
|
||||||
|
|
||||||
mutateRequestToQuery :: MutateRequest -> H.Snippet
|
mutateRequestToQuery :: MutateRequest -> SQL.Snippet
|
||||||
mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) =
|
mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) =
|
||||||
"WITH " <> normalizedBody body <> " " <>
|
"WITH " <> normalizedBody body <> " " <>
|
||||||
"INSERT INTO " <> H.sql (fromQi mainQi) <> H.sql (if S.null iCols then " " else "(" <> cols <> ") ") <>
|
"INSERT INTO " <> SQL.sql (fromQi mainQi) <> SQL.sql (if S.null iCols then " " else "(" <> cols <> ") ") <>
|
||||||
"SELECT " <> H.sql cols <> " " <>
|
"SELECT " <> SQL.sql cols <> " " <>
|
||||||
H.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <>
|
SQL.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <>
|
||||||
-- Only used for PUT
|
-- Only used for PUT
|
||||||
(if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) <>
|
(if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) <>
|
||||||
H.sql (BS.unwords [
|
SQL.sql (BS.unwords [
|
||||||
maybe "" (\(oncDo, oncCols) ->
|
maybe "" (\(oncDo, oncCols) ->
|
||||||
if null oncCols then
|
if null oncCols then
|
||||||
mempty
|
mempty
|
||||||
@@ -110,13 +110,13 @@ mutateRequestToQuery (Update mainQi uCols body logicForest returnings) =
|
|||||||
-- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
|
-- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
|
||||||
-- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select=
|
-- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select=
|
||||||
-- the select has to be based on "returnings" to make computed overloaded functions not throw
|
-- the select has to be based on "returnings" to make computed overloaded functions not throw
|
||||||
then H.sql ("SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false")
|
then SQL.sql ("SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false")
|
||||||
else
|
else
|
||||||
"WITH " <> normalizedBody body <> " " <>
|
"WITH " <> normalizedBody body <> " " <>
|
||||||
"UPDATE " <> H.sql (fromQi mainQi) <> " SET " <> H.sql cols <> " " <>
|
"UPDATE " <> SQL.sql (fromQi mainQi) <> " SET " <> SQL.sql cols <> " " <>
|
||||||
"FROM (SELECT * FROM json_populate_recordset (null::" <> H.sql (fromQi mainQi) <> " , " <> H.sql selectBody <> " )) _ " <>
|
"FROM (SELECT * FROM json_populate_recordset (null::" <> SQL.sql (fromQi mainQi) <> " , " <> SQL.sql selectBody <> " )) _ " <>
|
||||||
(if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)) <> " " <>
|
(if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)) <> " " <>
|
||||||
H.sql (returningF mainQi returnings)
|
SQL.sql (returningF mainQi returnings)
|
||||||
where
|
where
|
||||||
cols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
|
cols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
|
||||||
emptyBodyReturnedColumns :: SqlFragment
|
emptyBodyReturnedColumns :: SqlFragment
|
||||||
@@ -124,11 +124,11 @@ mutateRequestToQuery (Update mainQi uCols body logicForest returnings) =
|
|||||||
| null returnings = "NULL"
|
| null returnings = "NULL"
|
||||||
| otherwise = BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
|
| otherwise = BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings)
|
||||||
mutateRequestToQuery (Delete mainQi logicForest returnings) =
|
mutateRequestToQuery (Delete mainQi logicForest returnings) =
|
||||||
"DELETE FROM " <> H.sql (fromQi mainQi) <> " " <>
|
"DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <>
|
||||||
(if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree mainQi) logicForest)) <> " " <>
|
(if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree mainQi) logicForest)) <> " " <>
|
||||||
H.sql (returningF mainQi returnings)
|
SQL.sql (returningF mainQi returnings)
|
||||||
|
|
||||||
requestToCallProcQuery :: CallRequest -> H.Snippet
|
requestToCallProcQuery :: CallRequest -> SQL.Snippet
|
||||||
requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall returnings) =
|
requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall returnings) =
|
||||||
prmsCTE <> argsBody
|
prmsCTE <> argsBody
|
||||||
where
|
where
|
||||||
@@ -137,12 +137,12 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r
|
|||||||
KeyParams [] -> (mempty, mempty)
|
KeyParams [] -> (mempty, mempty)
|
||||||
KeyParams prms -> (
|
KeyParams prms -> (
|
||||||
"WITH " <> normalizedBody args <> ", " <>
|
"WITH " <> normalizedBody args <> ", " <>
|
||||||
H.sql (
|
SQL.sql (
|
||||||
BS.unwords [
|
BS.unwords [
|
||||||
"pgrst_args AS (",
|
"pgrst_args AS (",
|
||||||
"SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtParams prms (const mempty) (\a -> " " <> encodeUtf8 (ppType a)) <> ")",
|
"SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtParams prms (const mempty) (\a -> " " <> encodeUtf8 (ppType a)) <> ")",
|
||||||
")"])
|
")"])
|
||||||
, H.sql $ if multipleCall
|
, SQL.sql $ if multipleCall
|
||||||
then fmtParams prms varadicPrefix (\a -> " := pgrst_args." <> pgFmtIdent (ppName a))
|
then fmtParams prms varadicPrefix (\a -> " := pgrst_args." <> pgFmtIdent (ppName a))
|
||||||
else fmtParams prms varadicPrefix (\a -> " := (SELECT " <> pgFmtIdent (ppName a) <> " FROM pgrst_args LIMIT 1)")
|
else fmtParams prms varadicPrefix (\a -> " := (SELECT " <> pgFmtIdent (ppName a) <> " FROM pgrst_args LIMIT 1)")
|
||||||
)
|
)
|
||||||
@@ -154,7 +154,7 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r
|
|||||||
varadicPrefix :: ProcParam -> SqlFragment
|
varadicPrefix :: ProcParam -> SqlFragment
|
||||||
varadicPrefix a = if ppVar a then "VARIADIC " else mempty
|
varadicPrefix a = if ppVar a then "VARIADIC " else mempty
|
||||||
|
|
||||||
argsBody :: H.Snippet
|
argsBody :: SQL.Snippet
|
||||||
argsBody
|
argsBody
|
||||||
| multipleCall =
|
| multipleCall =
|
||||||
if returnsScalar
|
if returnsScalar
|
||||||
@@ -166,23 +166,23 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r
|
|||||||
then "SELECT " <> callIt <> " AS pgrst_scalar"
|
then "SELECT " <> callIt <> " AS pgrst_scalar"
|
||||||
else "SELECT " <> returnedColumns <> " FROM " <> callIt
|
else "SELECT " <> returnedColumns <> " FROM " <> callIt
|
||||||
|
|
||||||
callIt :: H.Snippet
|
callIt :: SQL.Snippet
|
||||||
callIt = H.sql (fromQi qi) <> "(" <> argFrag <> ")"
|
callIt = SQL.sql (fromQi qi) <> "(" <> argFrag <> ")"
|
||||||
|
|
||||||
returnedColumns :: H.Snippet
|
returnedColumns :: SQL.Snippet
|
||||||
returnedColumns
|
returnedColumns
|
||||||
| null returnings = "*"
|
| null returnings = "*"
|
||||||
| otherwise = H.sql $ BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings)
|
| otherwise = SQL.sql $ BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings)
|
||||||
|
|
||||||
|
|
||||||
-- | SQL query meant for COUNTing the root node of the Tree.
|
-- | SQL query meant for COUNTing the root node of the Tree.
|
||||||
-- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT.
|
-- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT.
|
||||||
-- SELECT 1 is done instead of SELECT * to prevent doing expensive operations(like functions based on the columns)
|
-- SELECT 1 is done instead of SELECT * to prevent doing expensive operations(like functions based on the columns)
|
||||||
-- inside the FROM target.
|
-- inside the FROM target.
|
||||||
readRequestToCountQuery :: ReadRequest -> H.Snippet
|
readRequestToCountQuery :: ReadRequest -> SQL.Snippet
|
||||||
readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) =
|
readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) =
|
||||||
"SELECT 1 " <> "FROM " <> H.sql (fromQi qi) <> " " <>
|
"SELECT 1 " <> "FROM " <> SQL.sql (fromQi qi) <> " " <>
|
||||||
if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest)
|
if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest)
|
||||||
|
|
||||||
limitedQuery :: H.Snippet -> Maybe Integer -> H.Snippet
|
limitedQuery :: SQL.Snippet -> Maybe Integer -> SQL.Snippet
|
||||||
limitedQuery query maxRows = query <> H.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
|
limitedQuery query maxRows = query <> SQL.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
|
||||||
|
|||||||
@@ -37,10 +37,10 @@ module PostgREST.Query.SqlFragment
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.HashMap.Strict as HM
|
import qualified Data.HashMap.Strict as M
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Hasql.DynamicStatements.Snippet as H
|
import qualified Hasql.DynamicStatements.Snippet as SQL
|
||||||
import qualified Hasql.Encoders as HE
|
import qualified Hasql.Encoders as HE
|
||||||
|
|
||||||
import Data.Foldable (foldr1)
|
import Data.Foldable (foldr1)
|
||||||
@@ -72,8 +72,8 @@ noLocationF = "array[]::text[]"
|
|||||||
sourceCTEName :: SqlFragment
|
sourceCTEName :: SqlFragment
|
||||||
sourceCTEName = "pgrst_source"
|
sourceCTEName = "pgrst_source"
|
||||||
|
|
||||||
operators :: HM.HashMap Text SqlFragment
|
operators :: M.HashMap Text SqlFragment
|
||||||
operators = HM.union (HM.fromList [
|
operators = M.union (M.fromList [
|
||||||
("eq", "="),
|
("eq", "="),
|
||||||
("gte", ">="),
|
("gte", ">="),
|
||||||
("gt", ">"),
|
("gt", ">"),
|
||||||
@@ -93,8 +93,8 @@ operators = HM.union (HM.fromList [
|
|||||||
("nxl", "&>"),
|
("nxl", "&>"),
|
||||||
("adj", "-|-")]) ftsOperators
|
("adj", "-|-")]) ftsOperators
|
||||||
|
|
||||||
ftsOperators :: HM.HashMap Text SqlFragment
|
ftsOperators :: M.HashMap Text SqlFragment
|
||||||
ftsOperators = HM.fromList [
|
ftsOperators = M.fromList [
|
||||||
("fts", "@@ to_tsquery"),
|
("fts", "@@ to_tsquery"),
|
||||||
("plfts", "@@ plainto_tsquery"),
|
("plfts", "@@ plainto_tsquery"),
|
||||||
("phfts", "@@ phraseto_tsquery"),
|
("phfts", "@@ phraseto_tsquery"),
|
||||||
@@ -106,10 +106,10 @@ ftsOperators = HM.fromList [
|
|||||||
-- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays
|
-- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays
|
||||||
-- We do this in SQL to avoid processing the JSON in application code
|
-- We do this in SQL to avoid processing the JSON in application code
|
||||||
-- TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body
|
-- TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body
|
||||||
normalizedBody :: Maybe BL.ByteString -> H.Snippet
|
normalizedBody :: Maybe LBS.ByteString -> SQL.Snippet
|
||||||
normalizedBody body =
|
normalizedBody body =
|
||||||
"pgrst_payload AS (SELECT " <> jsonPlaceHolder <> " AS json_data), " <>
|
"pgrst_payload AS (SELECT " <> jsonPlaceHolder <> " AS json_data), " <>
|
||||||
H.sql (BS.unwords [
|
SQL.sql (BS.unwords [
|
||||||
"pgrst_body AS (",
|
"pgrst_body AS (",
|
||||||
"SELECT",
|
"SELECT",
|
||||||
"CASE WHEN json_typeof(json_data) = 'array'",
|
"CASE WHEN json_typeof(json_data) = 'array'",
|
||||||
@@ -118,14 +118,14 @@ normalizedBody body =
|
|||||||
"END AS val",
|
"END AS val",
|
||||||
"FROM pgrst_payload)"])
|
"FROM pgrst_payload)"])
|
||||||
where
|
where
|
||||||
jsonPlaceHolder = H.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::json"
|
jsonPlaceHolder = SQL.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::json"
|
||||||
|
|
||||||
singleParameter :: Maybe BL.ByteString -> ByteString -> H.Snippet
|
singleParameter :: Maybe LBS.ByteString -> ByteString -> SQL.Snippet
|
||||||
singleParameter body typ =
|
singleParameter body typ =
|
||||||
if typ == "bytea"
|
if typ == "bytea"
|
||||||
-- TODO: Hasql fails when using HE.unknown with bytea(pg tries to utf8 encode).
|
-- TODO: Hasql fails when using HE.unknown with bytea(pg tries to utf8 encode).
|
||||||
then H.encoderAndParam (HE.nullable HE.bytea) (toS <$> body)
|
then SQL.encoderAndParam (HE.nullable HE.bytea) (toS <$> body)
|
||||||
else H.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::" <> H.sql typ
|
else SQL.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::" <> SQL.sql typ
|
||||||
|
|
||||||
selectBody :: SqlFragment
|
selectBody :: SqlFragment
|
||||||
selectBody = "(SELECT val FROM pgrst_body)"
|
selectBody = "(SELECT val FROM pgrst_body)"
|
||||||
@@ -202,24 +202,24 @@ pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
|
|||||||
pgFmtColumn table "*" = fromQi table <> ".*"
|
pgFmtColumn table "*" = fromQi table <> ".*"
|
||||||
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
|
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
|
||||||
|
|
||||||
pgFmtField :: QualifiedIdentifier -> Field -> H.Snippet
|
pgFmtField :: QualifiedIdentifier -> Field -> SQL.Snippet
|
||||||
pgFmtField table (c, jp) = H.sql (pgFmtColumn table c) <> pgFmtJsonPath jp
|
pgFmtField table (c, jp) = SQL.sql (pgFmtColumn table c) <> pgFmtJsonPath jp
|
||||||
|
|
||||||
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> H.Snippet
|
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet
|
||||||
pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> H.sql (pgFmtAs fName jp alias)
|
pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias)
|
||||||
-- Ideally we'd quote the cast with "pgFmtIdent cast". However, that would invalidate common casts such as "int", "bigint", etc.
|
-- Ideally we'd quote the cast with "pgFmtIdent cast". However, that would invalidate common casts such as "int", "bigint", etc.
|
||||||
-- Try doing: `select 1::"bigint"` - it'll err, using "int8" will work though. There's some parser magic that pg does that's invalidated when quoting.
|
-- Try doing: `select 1::"bigint"` - it'll err, using "int8" will work though. There's some parser magic that pg does that's invalidated when quoting.
|
||||||
-- Not quoting should be fine, we validate the input on Parsers.
|
-- Not quoting should be fine, we validate the input on Parsers.
|
||||||
pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _, _) = "CAST (" <> pgFmtField table f <> " AS " <> H.sql (encodeUtf8 cast) <> " )" <> H.sql (pgFmtAs fName jp alias)
|
pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _, _) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias)
|
||||||
|
|
||||||
pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> H.Snippet
|
pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SQL.Snippet
|
||||||
pgFmtOrderTerm qi ot =
|
pgFmtOrderTerm qi ot =
|
||||||
pgFmtField qi (otTerm ot) <> " " <>
|
pgFmtField qi (otTerm ot) <> " " <>
|
||||||
H.sql (BS.unwords [
|
SQL.sql (BS.unwords [
|
||||||
BS.pack $ maybe mempty show $ otDirection ot,
|
BS.pack $ maybe mempty show $ otDirection ot,
|
||||||
BS.pack $ maybe mempty show $ otNullOrder ot])
|
BS.pack $ maybe mempty show $ otNullOrder ot])
|
||||||
|
|
||||||
pgFmtFilter :: QualifiedIdentifier -> Filter -> H.Snippet
|
pgFmtFilter :: QualifiedIdentifier -> Filter -> SQL.Snippet
|
||||||
pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
|
pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
|
||||||
Op op val -> pgFmtFieldOp op <> " " <> case op of
|
Op op val -> pgFmtFieldOp op <> " " <> case op of
|
||||||
"like" -> unknownLiteral (T.map star val)
|
"like" -> unknownLiteral (T.map star val)
|
||||||
@@ -239,27 +239,27 @@ pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper
|
|||||||
where
|
where
|
||||||
ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ")
|
ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ")
|
||||||
pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
|
pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
|
||||||
sqlOperator o = H.sql $ HM.lookupDefault "=" o operators
|
sqlOperator o = SQL.sql $ M.lookupDefault "=" o operators
|
||||||
notOp = if hasNot then "NOT" else mempty
|
notOp = if hasNot then "NOT" else mempty
|
||||||
star c = if c == '*' then '%' else c
|
star c = if c == '*' then '%' else c
|
||||||
-- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error.
|
-- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error.
|
||||||
-- The above can be fixed by using `PREPARE boolplan AS SELECT * FROM projects where id IS NOT DISTINCT FROM $1;`
|
-- The above can be fixed by using `PREPARE boolplan AS SELECT * FROM projects where id IS NOT DISTINCT FROM $1;`
|
||||||
-- However that would not accept the TRUE/FALSE/NULL keywords. See: https://stackoverflow.com/questions/6133525/proper-way-to-set-preparedstatement-parameter-to-null-under-postgres.
|
-- However that would not accept the TRUE/FALSE/NULL keywords. See: https://stackoverflow.com/questions/6133525/proper-way-to-set-preparedstatement-parameter-to-null-under-postgres.
|
||||||
isAllowed :: Text -> H.Snippet
|
isAllowed :: Text -> SQL.Snippet
|
||||||
isAllowed v = H.sql $ maybe
|
isAllowed v = SQL.sql $ maybe
|
||||||
(pgFmtLit v <> "::unknown") encodeUtf8
|
(pgFmtLit v <> "::unknown") encodeUtf8
|
||||||
(find ((==) . T.toLower $ v) ["null","true","false"])
|
(find ((==) . T.toLower $ v) ["null","true","false"])
|
||||||
|
|
||||||
pgFmtJoinCondition :: JoinCondition -> H.Snippet
|
pgFmtJoinCondition :: JoinCondition -> SQL.Snippet
|
||||||
pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) =
|
pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) =
|
||||||
H.sql $ pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
|
SQL.sql $ pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
|
||||||
|
|
||||||
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> H.Snippet
|
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SQL.Snippet
|
||||||
pgFmtLogicTree qi (Expr hasNot op forest) = H.sql notOp <> " (" <> intercalateSnippet (" " <> BS.pack (show op) <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
|
pgFmtLogicTree qi (Expr hasNot op forest) = SQL.sql notOp <> " (" <> intercalateSnippet (" " <> BS.pack (show op) <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
|
||||||
where notOp = if hasNot then "NOT" else mempty
|
where notOp = if hasNot then "NOT" else mempty
|
||||||
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
|
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
|
||||||
|
|
||||||
pgFmtJsonPath :: JsonPath -> H.Snippet
|
pgFmtJsonPath :: JsonPath -> SQL.Snippet
|
||||||
pgFmtJsonPath = \case
|
pgFmtJsonPath = \case
|
||||||
[] -> mempty
|
[] -> mempty
|
||||||
(JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
|
(JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
|
||||||
@@ -280,7 +280,7 @@ pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
|
|||||||
Nothing -> mempty
|
Nothing -> mempty
|
||||||
pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
|
pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
|
||||||
|
|
||||||
countF :: H.Snippet -> Bool -> (H.Snippet, SqlFragment)
|
countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SqlFragment)
|
||||||
countF countQuery shouldCount =
|
countF countQuery shouldCount =
|
||||||
if shouldCount
|
if shouldCount
|
||||||
then (
|
then (
|
||||||
@@ -296,7 +296,7 @@ returningF qi returnings =
|
|||||||
then "RETURNING 1" -- For mutation cases where there's no ?select, we return 1 to know how many rows were modified
|
then "RETURNING 1" -- For mutation cases where there's no ?select, we return 1 to know how many rows were modified
|
||||||
else "RETURNING " <> BS.intercalate ", " (pgFmtColumn qi <$> returnings)
|
else "RETURNING " <> BS.intercalate ", " (pgFmtColumn qi <$> returnings)
|
||||||
|
|
||||||
limitOffsetF :: NonnegRange -> H.Snippet
|
limitOffsetF :: NonnegRange -> SQL.Snippet
|
||||||
limitOffsetF range =
|
limitOffsetF range =
|
||||||
if range == allRange then mempty else "LIMIT " <> limit <> " OFFSET " <> offset
|
if range == allRange then mempty else "LIMIT " <> limit <> " OFFSET " <> offset
|
||||||
where
|
where
|
||||||
@@ -321,12 +321,12 @@ currentSettingF setting =
|
|||||||
"nullif(current_setting(" <> pgFmtLit setting <> ", true), '')"
|
"nullif(current_setting(" <> pgFmtLit setting <> ", true), '')"
|
||||||
|
|
||||||
-- Hasql Snippet utilities
|
-- Hasql Snippet utilities
|
||||||
unknownEncoder :: ByteString -> H.Snippet
|
unknownEncoder :: ByteString -> SQL.Snippet
|
||||||
unknownEncoder = H.encoderAndParam (HE.nonNullable HE.unknown)
|
unknownEncoder = SQL.encoderAndParam (HE.nonNullable HE.unknown)
|
||||||
|
|
||||||
unknownLiteral :: Text -> H.Snippet
|
unknownLiteral :: Text -> SQL.Snippet
|
||||||
unknownLiteral = unknownEncoder . encodeUtf8
|
unknownLiteral = unknownEncoder . encodeUtf8
|
||||||
|
|
||||||
intercalateSnippet :: ByteString -> [H.Snippet] -> H.Snippet
|
intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet
|
||||||
intercalateSnippet _ [] = mempty
|
intercalateSnippet _ [] = mempty
|
||||||
intercalateSnippet frag snippets = foldr1 (\a b -> a <> H.sql frag <> b) snippets
|
intercalateSnippet frag snippets = foldr1 (\a b -> a <> SQL.sql frag <> b) snippets
|
||||||
|
|||||||
@@ -20,9 +20,9 @@ import qualified Data.Aeson as JSON
|
|||||||
import qualified Data.Aeson.Lens as L
|
import qualified Data.Aeson.Lens as L
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Hasql.Decoders as HD
|
import qualified Hasql.Decoders as HD
|
||||||
import qualified Hasql.DynamicStatements.Snippet as H
|
import qualified Hasql.DynamicStatements.Snippet as SQL
|
||||||
import qualified Hasql.DynamicStatements.Statement as H
|
import qualified Hasql.DynamicStatements.Statement as SQL
|
||||||
import qualified Hasql.Statement as H
|
import qualified Hasql.Statement as SQL
|
||||||
|
|
||||||
import Control.Lens ((^?))
|
import Control.Lens ((^?))
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
@@ -46,15 +46,15 @@ import Protolude.Conv (toS)
|
|||||||
-}
|
-}
|
||||||
type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Error [GucHeader], Either Error (Maybe Status))
|
type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Error [GucHeader], Either Error (Maybe Status))
|
||||||
|
|
||||||
createWriteStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool ->
|
createWriteStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool ->
|
||||||
PreferRepresentation -> [Text] -> PgVersion -> Bool ->
|
PreferRepresentation -> [Text] -> PgVersion -> Bool ->
|
||||||
H.Statement () ResultsWithCount
|
SQL.Statement () ResultsWithCount
|
||||||
createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys pgVer =
|
createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys pgVer =
|
||||||
H.dynamicallyParameterized snippet decodeStandard
|
SQL.dynamicallyParameterized snippet decodeStandard
|
||||||
where
|
where
|
||||||
snippet =
|
snippet =
|
||||||
"WITH " <> H.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
|
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
|
||||||
H.sql (
|
SQL.sql (
|
||||||
"SELECT " <>
|
"SELECT " <>
|
||||||
"'' AS total_result_set, " <>
|
"'' AS total_result_set, " <>
|
||||||
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
||||||
@@ -82,23 +82,23 @@ createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys
|
|||||||
|
|
||||||
selectF
|
selectF
|
||||||
-- prevent using any of the column names in ?select= when no response is returned from the CTE
|
-- prevent using any of the column names in ?select= when no response is returned from the CTE
|
||||||
| rep `elem` [None, HeadersOnly] = H.sql ("SELECT * FROM " <> sourceCTEName)
|
| rep `elem` [None, HeadersOnly] = SQL.sql ("SELECT * FROM " <> sourceCTEName)
|
||||||
| otherwise = selectQuery
|
| otherwise = selectQuery
|
||||||
|
|
||||||
decodeStandard :: HD.Result ResultsWithCount
|
decodeStandard :: HD.Result ResultsWithCount
|
||||||
decodeStandard =
|
decodeStandard =
|
||||||
fromMaybe (Nothing, 0, [], mempty, Right [], Right Nothing) <$> HD.rowMaybe standardRow
|
fromMaybe (Nothing, 0, [], mempty, Right [], Right Nothing) <$> HD.rowMaybe standardRow
|
||||||
|
|
||||||
createReadStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->
|
createReadStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->
|
||||||
H.Statement () ResultsWithCount
|
SQL.Statement () ResultsWithCount
|
||||||
createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField pgVer =
|
createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField pgVer =
|
||||||
H.dynamicallyParameterized snippet decodeStandard
|
SQL.dynamicallyParameterized snippet decodeStandard
|
||||||
where
|
where
|
||||||
snippet =
|
snippet =
|
||||||
"WITH " <>
|
"WITH " <>
|
||||||
H.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <>
|
SQL.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <>
|
||||||
countCTEF <> " " <>
|
countCTEF <> " " <>
|
||||||
H.sql ("SELECT " <>
|
SQL.sql ("SELECT " <>
|
||||||
countResultF <> " AS total_result_set, " <>
|
countResultF <> " AS total_result_set, " <>
|
||||||
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
||||||
noLocationF <> " AS header, " <>
|
noLocationF <> " AS header, " <>
|
||||||
@@ -131,16 +131,16 @@ standardRow = (,,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
|
|||||||
|
|
||||||
type ProcResults = (Maybe Int64, Int64, ByteString, Either Error [GucHeader], Either Error (Maybe Status))
|
type ProcResults = (Maybe Int64, Int64, ByteString, Either Error [GucHeader], Either Error (Maybe Status))
|
||||||
|
|
||||||
callProcStatement :: Bool -> Bool -> H.Snippet -> H.Snippet -> H.Snippet -> Bool ->
|
callProcStatement :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
|
||||||
Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->
|
Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->
|
||||||
H.Statement () ProcResults
|
SQL.Statement () ProcResults
|
||||||
callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal asSingle asCsv multObjects binaryField pgVer =
|
callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal asSingle asCsv multObjects binaryField pgVer =
|
||||||
H.dynamicallyParameterized snippet decodeProc
|
SQL.dynamicallyParameterized snippet decodeProc
|
||||||
where
|
where
|
||||||
snippet =
|
snippet =
|
||||||
"WITH " <> H.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
|
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
|
||||||
countCTEF <>
|
countCTEF <>
|
||||||
H.sql (
|
SQL.sql (
|
||||||
"SELECT " <>
|
"SELECT " <>
|
||||||
countResultF <> " AS total_result_set, " <>
|
countResultF <> " AS total_result_set, " <>
|
||||||
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
"pg_catalog.count(_postgrest_t) AS page_total, " <>
|
||||||
@@ -170,9 +170,9 @@ callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQue
|
|||||||
<*> (fromMaybe defGucHeaders <$> nullableColumn decodeGucHeaders)
|
<*> (fromMaybe defGucHeaders <$> nullableColumn decodeGucHeaders)
|
||||||
<*> (fromMaybe defGucStatus <$> nullableColumn decodeGucStatus)
|
<*> (fromMaybe defGucStatus <$> nullableColumn decodeGucStatus)
|
||||||
|
|
||||||
createExplainStatement :: H.Snippet -> Bool -> H.Statement () (Maybe Int64)
|
createExplainStatement :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
|
||||||
createExplainStatement countQuery =
|
createExplainStatement countQuery =
|
||||||
H.dynamicallyParameterized snippet decodeExplain
|
SQL.dynamicallyParameterized snippet decodeExplain
|
||||||
where
|
where
|
||||||
snippet = "EXPLAIN (FORMAT JSON) " <> countQuery
|
snippet = "EXPLAIN (FORMAT JSON) " <> countQuery
|
||||||
-- |
|
-- |
|
||||||
|
|||||||
@@ -19,7 +19,7 @@ module PostgREST.Request.ApiRequest
|
|||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.Csv as CSV
|
import qualified Data.Csv as CSV
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as M
|
||||||
@@ -72,11 +72,11 @@ import Protolude hiding (head, toS)
|
|||||||
import Protolude.Conv (toS)
|
import Protolude.Conv (toS)
|
||||||
|
|
||||||
|
|
||||||
type RequestBody = BL.ByteString
|
type RequestBody = LBS.ByteString
|
||||||
|
|
||||||
data Payload
|
data Payload
|
||||||
= ProcessedJSON -- ^ Cached attributes of a JSON payload
|
= ProcessedJSON -- ^ Cached attributes of a JSON payload
|
||||||
{ payRaw :: BL.ByteString
|
{ payRaw :: LBS.ByteString
|
||||||
-- ^ This is the raw ByteString that comes from the request body. We
|
-- ^ 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
|
-- cache this instead of an Aeson Value because it was detected that for
|
||||||
-- large payloads the encoding had high memory usage, see
|
-- large payloads the encoding had high memory usage, see
|
||||||
@@ -85,8 +85,8 @@ data Payload
|
|||||||
-- ^ Keys of the object or if it's an array these keys are guaranteed to
|
-- ^ Keys of the object or if it's an array these keys are guaranteed to
|
||||||
-- be the same across all its objects
|
-- be the same across all its objects
|
||||||
}
|
}
|
||||||
| RawJSON { payRaw :: BL.ByteString }
|
| RawJSON { payRaw :: LBS.ByteString }
|
||||||
| RawPay { payRaw :: BL.ByteString }
|
| RawPay { payRaw :: LBS.ByteString }
|
||||||
|
|
||||||
data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
|
data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
|
||||||
-- | Types of things a user wants to do to tables/views/procs
|
-- | Types of things a user wants to do to tables/views/procs
|
||||||
@@ -273,7 +273,7 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
|||||||
if isJust columns
|
if isJust columns
|
||||||
then Right $ RawJSON reqBody
|
then Right $ RawJSON reqBody
|
||||||
else note "All object keys must match" . payloadAttributes reqBody
|
else note "All object keys must match" . payloadAttributes reqBody
|
||||||
=<< if BL.null reqBody && isTargetingProc
|
=<< if LBS.null reqBody && isTargetingProc
|
||||||
then Right emptyObject
|
then Right emptyObject
|
||||||
else JSON.eitherDecode reqBody
|
else JSON.eitherDecode reqBody
|
||||||
CTTextCSV -> do
|
CTTextCSV -> do
|
||||||
@@ -406,7 +406,7 @@ mutuallyAgreeable sProduces cAccepts =
|
|||||||
then listToMaybe sProduces
|
then listToMaybe sProduces
|
||||||
else exact
|
else exact
|
||||||
|
|
||||||
type CsvData = V.Vector (M.HashMap Text BL.ByteString)
|
type CsvData = V.Vector (M.HashMap Text LBS.ByteString)
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Converts CSV like
|
Converts CSV like
|
||||||
|
|||||||
@@ -34,7 +34,7 @@ module PostgREST.Request.Types
|
|||||||
, fstFieldNames
|
, fstFieldNames
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
||||||
import Data.Tree (Tree (..))
|
import Data.Tree (Tree (..))
|
||||||
@@ -110,7 +110,7 @@ data MutateQuery
|
|||||||
= Insert
|
= Insert
|
||||||
{ in_ :: QualifiedIdentifier
|
{ in_ :: QualifiedIdentifier
|
||||||
, insCols :: S.Set FieldName
|
, insCols :: S.Set FieldName
|
||||||
, insBody :: Maybe BL.ByteString
|
, insBody :: Maybe LBS.ByteString
|
||||||
, onConflict :: Maybe (PreferResolution, [FieldName])
|
, onConflict :: Maybe (PreferResolution, [FieldName])
|
||||||
, where_ :: [LogicTree]
|
, where_ :: [LogicTree]
|
||||||
, returning :: [FieldName]
|
, returning :: [FieldName]
|
||||||
@@ -118,7 +118,7 @@ data MutateQuery
|
|||||||
| Update
|
| Update
|
||||||
{ in_ :: QualifiedIdentifier
|
{ in_ :: QualifiedIdentifier
|
||||||
, updCols :: S.Set FieldName
|
, updCols :: S.Set FieldName
|
||||||
, updBody :: Maybe BL.ByteString
|
, updBody :: Maybe LBS.ByteString
|
||||||
, where_ :: [LogicTree]
|
, where_ :: [LogicTree]
|
||||||
, returning :: [FieldName]
|
, returning :: [FieldName]
|
||||||
}
|
}
|
||||||
@@ -131,7 +131,7 @@ data MutateQuery
|
|||||||
data CallQuery = FunctionCall
|
data CallQuery = FunctionCall
|
||||||
{ funCQi :: QualifiedIdentifier
|
{ funCQi :: QualifiedIdentifier
|
||||||
, funCParams :: CallParams
|
, funCParams :: CallParams
|
||||||
, funCArgs :: Maybe BL.ByteString
|
, funCArgs :: Maybe LBS.ByteString
|
||||||
, funCScalar :: Bool
|
, funCScalar :: Bool
|
||||||
, funCMultipleCall :: Bool
|
, funCMultipleCall :: Bool
|
||||||
, funCReturning :: [FieldName]
|
, funCReturning :: [FieldName]
|
||||||
|
|||||||
+13
-13
@@ -9,13 +9,13 @@ module PostgREST.Workers
|
|||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Hasql.Connection as C
|
import qualified Hasql.Notifications as SQL
|
||||||
import qualified Hasql.Notifications as N
|
import qualified Hasql.Pool as SQL
|
||||||
import qualified Hasql.Pool as P
|
import qualified Hasql.Transaction.Sessions as SQL
|
||||||
import qualified Hasql.Transaction.Sessions as HT
|
|
||||||
|
|
||||||
import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
|
import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
|
||||||
retrying, rsPreviousDelay)
|
retrying, rsPreviousDelay)
|
||||||
|
import Hasql.Connection (acquire)
|
||||||
|
|
||||||
import PostgREST.AppState (AppState)
|
import PostgREST.AppState (AppState)
|
||||||
import PostgREST.Config (AppConfig (..), readAppConfig)
|
import PostgREST.Config (AppConfig (..), readAppConfig)
|
||||||
@@ -108,7 +108,7 @@ connectionWorker appState = do
|
|||||||
connectionStatus :: AppState -> IO ConnectionStatus
|
connectionStatus :: AppState -> IO ConnectionStatus
|
||||||
connectionStatus appState =
|
connectionStatus appState =
|
||||||
retrying retrySettings shouldRetry $
|
retrying retrySettings shouldRetry $
|
||||||
const $ P.release pool >> getConnectionStatus
|
const $ SQL.release pool >> getConnectionStatus
|
||||||
where
|
where
|
||||||
pool = AppState.getPool appState
|
pool = AppState.getPool appState
|
||||||
retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds
|
retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds
|
||||||
@@ -117,7 +117,7 @@ connectionStatus appState =
|
|||||||
|
|
||||||
getConnectionStatus :: IO ConnectionStatus
|
getConnectionStatus :: IO ConnectionStatus
|
||||||
getConnectionStatus = do
|
getConnectionStatus = do
|
||||||
pgVersion <- P.use pool queryPgVersion
|
pgVersion <- SQL.use pool queryPgVersion
|
||||||
case pgVersion of
|
case pgVersion of
|
||||||
Left e -> do
|
Left e -> do
|
||||||
let err = PgError False e
|
let err = PgError False e
|
||||||
@@ -152,8 +152,8 @@ loadSchemaCache :: AppState -> IO SCacheStatus
|
|||||||
loadSchemaCache appState = do
|
loadSchemaCache appState = do
|
||||||
AppConfig{..} <- AppState.getConfig appState
|
AppConfig{..} <- AppState.getConfig appState
|
||||||
result <-
|
result <-
|
||||||
let transaction = if configDbPreparedStatements then HT.transaction else HT.unpreparedTransaction in
|
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
|
||||||
P.use (AppState.getPool appState) . transaction HT.ReadCommitted HT.Read $
|
SQL.use (AppState.getPool appState) . transaction SQL.ReadCommitted SQL.Read $
|
||||||
queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
|
queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
|
||||||
case result of
|
case result of
|
||||||
Left e -> do
|
Left e -> do
|
||||||
@@ -194,12 +194,12 @@ listener appState = do
|
|||||||
|
|
||||||
-- forkFinally allows to detect if the thread dies
|
-- forkFinally allows to detect if the thread dies
|
||||||
void . flip forkFinally (handleFinally dbChannel) $ do
|
void . flip forkFinally (handleFinally dbChannel) $ do
|
||||||
dbOrError <- C.acquire $ toS configDbUri
|
dbOrError <- acquire $ toS configDbUri
|
||||||
case dbOrError of
|
case dbOrError of
|
||||||
Right db -> do
|
Right db -> do
|
||||||
AppState.logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel"
|
AppState.logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel"
|
||||||
N.listen db $ N.toPgIdentifier dbChannel
|
SQL.listen db $ SQL.toPgIdentifier dbChannel
|
||||||
N.waitForNotifications handleNotification db
|
SQL.waitForNotifications handleNotification db
|
||||||
_ ->
|
_ ->
|
||||||
die $ "Could not listen for notifications on the " <> dbChannel <> " channel"
|
die $ "Could not listen for notifications on the " <> dbChannel <> " channel"
|
||||||
where
|
where
|
||||||
|
|||||||
Reference in New Issue
Block a user