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

refactor: Make import aliases consistent across the codebase

Browse Source
This commit is contained in:
monacoremo
2021-11-05 08:08:00 +01:00
committed by Remo
parent 71262fbc5c
commit 5cd7d35966
15 changed files with 285 additions and 286 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+11 -11
View File
@@ -26,10 +26,10 @@ import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
setServerName)
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.HashMap.Strict as Map
import qualified Data.Set as Set
import qualified Data.HashMap.Strict as M
import qualified Data.Set as S
import qualified Hasql.DynamicStatements.Snippet as SQL
import qualified Hasql.Pool 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 shouldAdd appState response = do
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
postgrestResponse
@@ -271,7 +271,7 @@ handleRead headersOnly identifier context@RequestContext{..} = do
, ( "Content-Location"
, "/"
<> toS (qiName identifier)
<> if BS8.null iCanonicalQS then mempty else "?" <> toS iCanonicalQS
<> if BS.null iCanonicalQS then mempty else "?" <> toS iCanonicalQS
)
]
++ contentTypeHeaders context
@@ -322,7 +322,7 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
, if null pkCols && isNothing iOnConflict then
Nothing
else
(\x -> ("Preference-Applied", BS8.pack $ show x)) <$> iPreferResolution
(\x -> ("Preference-Applied", BS.pack $ show x)) <$> iPreferResolution
]
failNotSingular iAcceptContentType resQueryTotal $
@@ -338,7 +338,7 @@ handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
let
response = gucResponse resGucStatus resGucHeaders
fullRepr = iPreferRepresentation == Full
updateIsNoOp = Set.null iColumns
updateIsNoOp = S.null iColumns
status
| resQueryTotal == 0 && not updateIsNoOp = HTTP.status404
| fullRepr = HTTP.status200
@@ -406,7 +406,7 @@ handleInfo identifier RequestContext{..} =
allOrigins = ("Access-Control-Allow-Origin", "*")
allowH table =
( HTTP.hAllow
, BS8.intercalate "," $
, BS.intercalate "," $
["OPTIONS,GET,HEAD"]
++ ["POST" | tableInsertable table]
++ ["PUT" | tableInsertable table && tableUpdatable table && hasPK]
@@ -473,7 +473,7 @@ handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure
OAIgnorePriv ->
OpenAPI.encode conf 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)
OADisabled ->
pure mempty
@@ -609,6 +609,6 @@ profileHeader ApiRequest{..} =
splitKeyValue :: ByteString -> (ByteString, ByteString)
splitKeyValue kv =
(k, BS8.tail v)
(k, BS.tail v)
where
(k, v) = BS8.break (== '=') kv
(k, v) = BS.break (== '=') kv
src/PostgREST/AppState.hs
+7 -7
View File
@@ -25,7 +25,7 @@ module PostgREST.AppState
, waitListener
) where
import qualified Hasql.Pool as P
import qualified Hasql.Pool as SQL
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
updateAction)
@@ -44,7 +44,7 @@ import Protolude.Conv (toS)
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
-- | No schema cache at the start. Will be filled in by the connectionWorker
, stateDbStructure :: IORef (Maybe DbStructure)
@@ -71,7 +71,7 @@ init conf = do
newPool <- initPool conf
initWithPool newPool conf
initWithPool :: P.Pool -> AppConfig -> IO AppState
initWithPool :: SQL.Pool -> AppConfig -> IO AppState
initWithPool newPool conf =
AppState newPool
<$> 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
<*> newIORef 0
initPool :: AppConfig -> IO P.Pool
initPool :: AppConfig -> IO SQL.Pool
initPool AppConfig{..} =
P.acquire (configDbPoolSize, configDbPoolTimeout, toS configDbUri)
SQL.acquire (configDbPoolSize, configDbPoolTimeout, toS configDbUri)
getPool :: AppState -> P.Pool
getPool :: AppState -> SQL.Pool
getPool = statePool
releasePool :: AppState -> IO ()
releasePool AppState{..} = P.release statePool >> throwTo stateMainThreadId UserInterrupt
releasePool AppState{..} = SQL.release statePool >> throwTo stateMainThreadId UserInterrupt
getPgVersion :: AppState -> IO PgVersion
getPgVersion = readIORef . statePgVersion
src/PostgREST/CLI.hs
+8 -8
View File
@@ -8,10 +8,10 @@ module PostgREST.CLI
, readCLIShowHelp
) where
import qualified Data.Aeson as Aeson
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Lazy as LBS
import qualified Hasql.Pool as P
import qualified Hasql.Transaction.Sessions as HT
import qualified Hasql.Pool as SQL
import qualified Hasql.Transaction.Sessions as SQL
import qualified Options.Applicative as O
import qualified Protolude.Conv as Conv
@@ -54,19 +54,19 @@ dumpSchema :: AppState -> IO LBS.ByteString
dumpSchema appState = do
AppConfig{..} <- AppState.getConfig appState
result <-
let transaction = if configDbPreparedStatements then HT.transaction else HT.unpreparedTransaction in
P.use (AppState.getPool appState) $
transaction HT.ReadCommitted HT.Read $
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
SQL.use (AppState.getPool appState) $
transaction SQL.ReadCommitted SQL.Read $
queryDbStructure
(toList configDbSchemas)
configDbExtraSearchPath
configDbPreparedStatements
P.release $ AppState.getPool appState
SQL.release $ AppState.getPool appState
case result of
Left e -> do
hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e
exitFailure
Right dbStructure -> return $ Aeson.encode dbStructure
Right dbStructure -> return $ JSON.encode dbStructure
-- | Command line interface options
data CLI = CLI
src/PostgREST/Config.hs
+4 -5
View File
@@ -29,9 +29,8 @@ module PostgREST.Config
import qualified Crypto.JOSE.Types as JOSE
import qualified Crypto.JWT as JWT
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.Char8 as BS
import qualified Data.Configurator as C
import qualified Data.Map.Strict as M
import qualified Data.Text as T
@@ -86,12 +85,12 @@ data AppConfig = AppConfig
, configJWKS :: Maybe JWKSet
, configJwtAudience :: Maybe StringOrURI
, configJwtRoleClaimKey :: JSPath
, configJwtSecret :: Maybe B.ByteString
, configJwtSecret :: Maybe BS.ByteString
, configJwtSecretIsBase64 :: Bool
, configLogLevel :: LogLevel
, configOpenApiMode :: OpenAPIMode
, configOpenApiServerProxyUri :: Maybe Text
, configRawMediaTypes :: [B.ByteString]
, configRawMediaTypes :: [BS.ByteString]
, configServerHost :: Text
, configServerPort :: Int
, configServerUnixSocket :: Maybe FilePath
@@ -144,7 +143,7 @@ toText conf =
,("log-level", q . show . configLogLevel)
,("openapi-mode", q . show . configOpenApiMode)
,("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-port", show . configServerPort)
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
src/PostgREST/Config/Database.hs
+13 -13
View File
@@ -9,31 +9,31 @@ import PostgREST.Config.PgVersion (PgVersion (..))
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
import qualified Hasql.Pool as P
import qualified Hasql.Session as H
import qualified Hasql.Statement as H
import qualified Hasql.Transaction as HT
import qualified Hasql.Transaction.Sessions as HT
import qualified Hasql.Pool as SQL
import Hasql.Session (Session, statement)
import qualified Hasql.Statement as SQL
import qualified Hasql.Transaction as SQL
import qualified Hasql.Transaction.Sessions as SQL
import Text.InterpolatedString.Perl6 (q)
import Protolude
queryPgVersion :: H.Session PgVersion
queryPgVersion = H.statement mempty $ H.Statement sql HE.noParams versionRow False
queryPgVersion :: Session PgVersion
queryPgVersion = statement mempty $ SQL.Statement sql HE.noParams versionRow False
where
sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text
queryDbSettings :: P.Pool -> Bool -> IO (Either P.UsageError [(Text, Text)])
queryDbSettings :: SQL.Pool -> Bool -> IO (Either SQL.UsageError [(Text, Text)])
queryDbSettings pool prepared =
let transaction = if prepared then HT.transaction else HT.unpreparedTransaction in
P.use pool . transaction HT.ReadCommitted HT.Read $
HT.statement mempty dbSettingsStatement
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
SQL.use pool . transaction SQL.ReadCommitted SQL.Read $
SQL.statement mempty dbSettingsStatement
-- | Get db settings from the connection role. Global settings will be overridden by database specific settings.
dbSettingsStatement :: H.Statement () [(Text, Text)]
dbSettingsStatement = H.Statement sql HE.noParams decodeSettings False
dbSettingsStatement :: SQL.Statement () [(Text, Text)]
dbSettingsStatement = SQL.Statement sql HE.noParams decodeSettings False
where
sql = [q|
with
src/PostgREST/DbStructure.hs
+28 -28
View File
@@ -33,8 +33,8 @@ import qualified Data.HashMap.Strict as M
import qualified Data.List as L
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
import qualified Hasql.Statement as H
import qualified Hasql.Transaction as HT
import qualified Hasql.Statement as SQL
import qualified Hasql.Transaction as SQL
import Contravariant.Extras (contrazip2)
import Data.Set as S (fromList)
@@ -83,15 +83,15 @@ type ViewColumn = Column
-- | A SQL query that can be executed independently
type SqlQuery = ByteString
queryDbStructure :: [Schema] -> [Schema] -> Bool -> HT.Transaction DbStructure
queryDbStructure :: [Schema] -> [Schema] -> Bool -> SQL.Transaction DbStructure
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
tabs <- HT.statement mempty $ allTables prepared
cols <- HT.statement schemas $ allColumns tabs prepared
srcCols <- HT.statement (schemas, extraSearchPath) $ pfkSourceColumns cols prepared
m2oRels <- HT.statement mempty $ allM2ORels tabs cols prepared
keys <- HT.statement mempty $ allPrimaryKeys tabs prepared
procs <- HT.statement schemas $ allProcs prepared
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 <- SQL.statement mempty $ allTables prepared
cols <- SQL.statement schemas $ allColumns tabs prepared
srcCols <- SQL.statement (schemas, extraSearchPath) $ pfkSourceColumns cols prepared
m2oRels <- SQL.statement mempty $ allM2ORels tabs cols prepared
keys <- SQL.statement mempty $ allPrimaryKeys tabs prepared
procs <- SQL.statement schemas $ allProcs prepared
let rels = addO2MRels . addM2MRels $ addViewM2ORels srcCols m2oRels
keys' = addViewPrimaryKeys srcCols keys
@@ -224,13 +224,13 @@ decodeProcs =
| v == 's' = Stable
| otherwise = Volatile -- only 'v' can happen here
allProcs :: Bool -> H.Statement [Schema] ProcsMap
allProcs = H.Statement (toS sql) (arrayParam HE.text) decodeProcs
allProcs :: Bool -> SQL.Statement [Schema] ProcsMap
allProcs = SQL.Statement (toS sql) (arrayParam HE.text) decodeProcs
where
sql = procsSqlQuery <> " WHERE pn.nspname = ANY($1)"
accessibleProcs :: Bool -> H.Statement Schema ProcsMap
accessibleProcs = H.Statement (toS sql) (param HE.text) decodeProcs
accessibleProcs :: Bool -> SQL.Statement Schema ProcsMap
accessibleProcs = SQL.Statement (toS sql) (param HE.text) decodeProcs
where
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
|]
schemaDescription :: Bool -> H.Statement Schema (Maybe Text)
schemaDescription :: Bool -> SQL.Statement Schema (Maybe Text)
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
sql = [q|
select
@@ -312,9 +312,9 @@ schemaDescription =
where
n.nspname = $1 |]
accessibleTables :: Bool -> H.Statement Schema [Table]
accessibleTables :: Bool -> SQL.Statement Schema [Table]
accessibleTables =
H.Statement sql (param HE.text) decodeTables
SQL.Statement sql (param HE.text) decodeTables
where
sql = [q|
select
@@ -446,9 +446,9 @@ addViewPrimaryKeys srcCols = concatMap (\pk ->
filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) srcCols in
pk : viewPks)
allTables :: Bool -> H.Statement () [Table]
allTables :: Bool -> SQL.Statement () [Table]
allTables =
H.Statement sql HE.noParams decodeTables
SQL.Statement sql HE.noParams decodeTables
where
sql = [q|
SELECT
@@ -488,9 +488,9 @@ allTables =
AND n.nspname NOT IN ('pg_catalog', 'information_schema')
ORDER BY table_schema, table_name |]
allColumns :: [Table] -> Bool -> H.Statement [Schema] [Column]
allColumns :: [Table] -> Bool -> SQL.Statement [Schema] [Column]
allColumns tabs =
H.Statement sql (arrayParam HE.text) (decodeColumns tabs)
SQL.Statement sql (arrayParam HE.text) (decodeColumns tabs)
where
sql = [q|
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 [] (split (==','))
allM2ORels :: [Table] -> [Column] -> Bool -> H.Statement () [Relationship]
allM2ORels :: [Table] -> [Column] -> Bool -> SQL.Statement () [Relationship]
allM2ORels tabs cols =
H.Statement sql HE.noParams (decodeRels tabs cols)
SQL.Statement sql HE.noParams (decodeRels tabs cols)
where
sql = [q|
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
colsF = mapM (findCol frs frt) frcs
allPrimaryKeys :: [Table] -> Bool -> H.Statement () [PrimaryKey]
allPrimaryKeys :: [Table] -> Bool -> SQL.Statement () [PrimaryKey]
allPrimaryKeys tabs =
H.Statement sql HE.noParams (decodePks tabs)
SQL.Statement sql HE.noParams (decodePks tabs)
where
sql = [q|
-- 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
-- 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 =
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:
-- * rationale: https://gist.github.com/wolfgangwalther/5425d64e7b0d20aad71f6f68474d9f19
-- * json transformation: https://gist.github.com/wolfgangwalther/3a8939da680c24ad767e93ad2c183089
src/PostgREST/Error.hs
+81 -81
View File
@@ -17,9 +17,9 @@ module PostgREST.Error
import qualified Data.Aeson as JSON
import qualified Data.Text as T
import qualified Hasql.Pool as P
import qualified Hasql.Session as H
import qualified Network.HTTP.Types.Status as HT
import qualified Hasql.Pool as SQL
import qualified Hasql.Session as SQL
import qualified Network.HTTP.Types.Status as HTTP
import Data.Aeson ((.=))
import Network.Wai (Response, responseLBS)
@@ -41,7 +41,7 @@ import Protolude.Conv (toS, toSL)
class (JSON.ToJSON a) => PgrstError a where
status :: a -> HT.Status
status :: a -> HTTP.Status
headers :: a -> [Header]
errorPayload :: a -> LByteString
@@ -67,18 +67,18 @@ data ApiRequestError
| UnsupportedVerb -- Unreachable?
instance PgrstError ApiRequestError where
status InvalidRange = HT.status416
status InvalidFilters = HT.status405
status (InvalidBody _) = HT.status400
status UnsupportedVerb = HT.status405
status ActionInappropriate = HT.status405
status (ParseRequestError _ _) = HT.status400
status (NoRelBetween _ _) = HT.status400
status AmbiguousRelBetween{} = HT.status300
status (AmbiguousRpc _) = HT.status300
status NoRpc{} = HT.status404
status (UnacceptableSchema _) = HT.status406
status (ContentTypeError _) = HT.status415
status InvalidRange = HTTP.status416
status InvalidFilters = HTTP.status405
status (InvalidBody _) = HTTP.status400
status UnsupportedVerb = HTTP.status405
status ActionInappropriate = HTTP.status405
status (ParseRequestError _ _) = HTTP.status400
status (NoRelBetween _ _) = HTTP.status400
status AmbiguousRelBetween{} = HTTP.status300
status (AmbiguousRpc _) = HTTP.status300
status NoRpc{} = HTTP.status404
status (UnacceptableSchema _) = HTTP.status406
status (ContentTypeError _) = HTTP.status415
headers _ = [ContentType.toHeader CTApplicationJSON]
@@ -145,32 +145,32 @@ compressedRel Relationship{..} =
, "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns))
]
data PgError = PgError Authenticated P.UsageError
data PgError = PgError Authenticated SQL.UsageError
type Authenticated = Bool
instance PgrstError PgError where
status (PgError authed usageError) = pgErrorStatus authed usageError
headers err =
if status err == HT.status401
if status err == HTTP.status401
then [ContentType.toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
else [ContentType.toHeader CTApplicationJSON]
instance JSON.ToJSON PgError where
toJSON (PgError _ usageError) = JSON.toJSON usageError
instance JSON.ToJSON P.UsageError where
toJSON (P.ConnectionError e) = JSON.object [
instance JSON.ToJSON SQL.UsageError where
toJSON (SQL.ConnectionError e) = JSON.object [
"code" .= ("" :: Text),
"message" .= ("Database connection error. Retrying the connection." :: 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
toJSON (H.QueryError _ _ e) = JSON.toJSON e
instance JSON.ToJSON SQL.QueryError where
toJSON (SQL.QueryError _ _ e) = JSON.toJSON e
instance JSON.ToJSON H.CommandError where
toJSON (H.ResultError (H.ServerError c m d h)) = case toS c of
instance JSON.ToJSON SQL.CommandError where
toJSON (SQL.ResultError (SQL.ServerError c m d h)) = case toS c of
'P':'T':_ -> JSON.object [
"details" .= (fmap toS d :: Maybe Text),
"hint" .= (fmap toS h :: Maybe Text)]
@@ -181,86 +181,86 @@ instance JSON.ToJSON H.CommandError where
"details" .= (fmap toS d :: 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)]
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),
"details" .= ("Attempt to parse more columns than there are in the result" :: 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),
"details" .= ("Attempt to parse a NULL as some value." :: 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),
"details" .= d,
"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),
"details" .= i]
toJSON (H.ClientError d) = JSON.object [
toJSON (SQL.ClientError d) = JSON.object [
"message" .= ("Database client error. Retrying the connection." :: Text),
"details" .= (fmap toS d :: Maybe Text)]
pgErrorStatus :: Bool -> P.UsageError -> HT.Status
pgErrorStatus _ (P.ConnectionError _) = HT.status503
pgErrorStatus _ (P.SessionError (H.QueryError _ _ (H.ClientError _))) = HT.status503
pgErrorStatus authed (P.SessionError (H.QueryError _ _ (H.ResultError rError))) =
pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status
pgErrorStatus _ (SQL.ConnectionError _) = HTTP.status503
pgErrorStatus _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503
pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rError))) =
case rError of
(H.ServerError c m _ _) ->
(SQL.ServerError c m _ _) ->
case toS c of
'0':'8':_ -> HT.status503 -- pg connection err
'0':'9':_ -> HT.status500 -- triggered action exception
'0':'L':_ -> HT.status403 -- invalid grantor
'0':'P':_ -> HT.status403 -- invalid role specification
"23503" -> HT.status409 -- foreign_key_violation
"23505" -> HT.status409 -- unique_violation
"25006" -> HT.status405 -- read_only_sql_transaction
'2':'5':_ -> HT.status500 -- invalid tx state
'2':'8':_ -> HT.status403 -- invalid auth specification
'2':'D':_ -> HT.status500 -- invalid tx termination
'3':'8':_ -> HT.status500 -- external routine exception
'3':'9':_ -> HT.status500 -- external routine invocation
'3':'B':_ -> HT.status500 -- savepoint exception
'4':'0':_ -> HT.status500 -- tx rollback
'5':'3':_ -> HT.status503 -- insufficient resources
'5':'4':_ -> HT.status413 -- too complex
'5':'5':_ -> HT.status500 -- obj not on prereq state
'5':'7':_ -> HT.status500 -- operator intervention
'5':'8':_ -> HT.status500 -- system error
'F':'0':_ -> HT.status500 -- conf file error
'H':'V':_ -> HT.status500 -- foreign data wrapper error
"P0001" -> HT.status400 -- default code for "raise"
'P':'0':_ -> HT.status500 -- PL/pgSQL Error
'X':'X':_ -> HT.status500 -- internal Error
"42883" -> HT.status404 -- undefined function
"42P01" -> HT.status404 -- undefined table
"42501" -> if authed then HT.status403 else HT.status401 -- insufficient privilege
'P':'T':n -> fromMaybe HT.status500 (HT.mkStatus <$> readMaybe n <*> pure m)
_ -> HT.status400
'0':'8':_ -> HTTP.status503 -- pg connection err
'0':'9':_ -> HTTP.status500 -- triggered action exception
'0':'L':_ -> HTTP.status403 -- invalid grantor
'0':'P':_ -> HTTP.status403 -- invalid role specification
"23503" -> HTTP.status409 -- foreign_key_violation
"23505" -> HTTP.status409 -- unique_violation
"25006" -> HTTP.status405 -- read_only_sql_transaction
'2':'5':_ -> HTTP.status500 -- invalid tx state
'2':'8':_ -> HTTP.status403 -- invalid auth specification
'2':'D':_ -> HTTP.status500 -- invalid tx termination
'3':'8':_ -> HTTP.status500 -- external routine exception
'3':'9':_ -> HTTP.status500 -- external routine invocation
'3':'B':_ -> HTTP.status500 -- savepoint exception
'4':'0':_ -> HTTP.status500 -- tx rollback
'5':'3':_ -> HTTP.status503 -- insufficient resources
'5':'4':_ -> HTTP.status413 -- too complex
'5':'5':_ -> HTTP.status500 -- obj not on prereq state
'5':'7':_ -> HTTP.status500 -- operator intervention
'5':'8':_ -> HTTP.status500 -- system error
'F':'0':_ -> HTTP.status500 -- conf file error
'H':'V':_ -> HTTP.status500 -- foreign data wrapper error
"P0001" -> HTTP.status400 -- default code for "raise"
'P':'0':_ -> HTTP.status500 -- PL/pgSQL Error
'X':'X':_ -> HTTP.status500 -- internal Error
"42883" -> HTTP.status404 -- undefined function
"42P01" -> HTTP.status404 -- undefined table
"42501" -> if authed then HTTP.status403 else HTTP.status401 -- insufficient privilege
'P':'T':n -> fromMaybe HTTP.status500 (HTTP.mkStatus <$> readMaybe n <*> pure m)
_ -> HTTP.status400
_ -> HT.status500
_ -> HTTP.status500
checkIsFatal :: PgError -> Maybe Text
checkIsFatal (PgError _ (P.ConnectionError e))
checkIsFatal (PgError _ (SQL.ConnectionError e))
| isAuthFailureMessage = Just $ toS failureMessage
| otherwise = Nothing
where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` toS failureMessage
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
-- 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"
-- 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
-- while prepared statements are enabled in the PostgREST configuration,
-- 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."
-- 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.
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."
_ -> Nothing
checkIsFatal _ = Nothing
@@ -281,16 +281,16 @@ data Error
| PgErr PgError
instance PgrstError Error where
status GucHeadersError = HT.status500
status GucStatusError = HT.status500
status (BinaryFieldError _) = HT.status406
status ConnectionLostError = HT.status503
status PutMatchingPkError = HT.status400
status PutRangeNotAllowedError = HT.status400
status JwtTokenMissing = HT.status500
status (JwtTokenInvalid _) = HT.unauthorized401
status (SingularityError _) = HT.status406
status NotFound = HT.status404
status GucHeadersError = HTTP.status500
status GucStatusError = HTTP.status500
status (BinaryFieldError _) = HTTP.status406
status ConnectionLostError = HTTP.status503
status PutMatchingPkError = HTTP.status400
status PutRangeNotAllowedError = HTTP.status400
status JwtTokenMissing = HTTP.status500
status (JwtTokenInvalid _) = HTTP.unauthorized401
status (SingularityError _) = HTTP.status406
status NotFound = HTTP.status404
status (PgErr err) = status err
status (ApiRequestError err) = status err
src/PostgREST/Middleware.hs
+13 -13
View File
@@ -19,10 +19,10 @@ import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
import qualified Hasql.Decoders as HD
import qualified Hasql.DynamicStatements.Snippet as H hiding
(sql)
import qualified Hasql.DynamicStatements.Statement as H
import qualified Hasql.Transaction as H
import qualified Hasql.DynamicStatements.Snippet as SQL hiding
(sql)
import qualified Hasql.DynamicStatements.Statement as SQL
import qualified Hasql.Transaction as SQL
import qualified Network.HTTP.Types.Header as HTTP
import qualified Network.Wai 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
runPgLocals :: AppConfig -> M.HashMap Text JSON.Value ->
(ApiRequest -> ExceptT Error H.Transaction Wai.Response) ->
ApiRequest -> ByteString -> PgVersion -> ExceptT Error H.Transaction Wai.Response
(ApiRequest -> ExceptT Error SQL.Transaction Wai.Response) ->
ApiRequest -> ByteString -> PgVersion -> ExceptT Error SQL.Transaction Wai.Response
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))
HD.noResult (configDbPreparedStatements conf)
lift $ traverse_ H.sql preReqSql
lift $ traverse_ SQL.sql preReqSql
app req
where
methodSql = setConfigLocal mempty ("request.method", iMethod req)
@@ -167,12 +167,12 @@ unquoted v = toS $ JSON.encode v
optionalRollback
:: AppConfig
-> ApiRequest
-> ExceptT Error H.Transaction Wai.Response
-> ExceptT Error H.Transaction Wai.Response
-> ExceptT Error SQL.Transaction Wai.Response
-> ExceptT Error SQL.Transaction Wai.Response
optionalRollback AppConfig{..} ApiRequest{..} transaction = do
resp <- catchError transaction $ return . errorResponseFor
when (shouldRollback || (configDbTxRollbackAll && not shouldCommit))
(lift H.condemn)
(lift SQL.condemn)
return $ Wai.mapResponseHeaders preferenceApplied resp
where
shouldCommit =
@@ -190,13 +190,13 @@ optionalRollback AppConfig{..} ApiRequest{..} transaction = do
identity
-- | 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) =
"set_config(" <> unknownEncoder (prefix <> k) <> ", " <> unknownEncoder v <> ", true)"
-- | 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
setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [H.Snippet]
setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [SQL.Snippet]
setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)]
where
gucJsonVal :: [(ByteString, ByteString)] -> ByteString
src/PostgREST/OpenAPI.hs
+3 -3
View File
@@ -9,7 +9,7 @@ module PostgREST.OpenAPI (encode) where
import qualified Data.Aeson as JSON
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.Text as T
@@ -40,12 +40,12 @@ import PostgREST.ContentType
import Protolude hiding (Proxy, get, 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 =
JSON.encode $
postgrestSpec
(dbRelationships dbStructure)
(concat $ HashMap.elems procs)
(concat $ M.elems procs)
(openApiTableInfo dbStructure <$> tables)
(proxyUri conf)
schemaDescription
src/PostgREST/Query/QueryBuilder.hs
+36 -36
View File
@@ -17,7 +17,7 @@ module PostgREST.Query.QueryBuilder
import qualified Data.ByteString.Char8 as BS
import qualified Data.Set as S
import qualified Hasql.DynamicStatements.Snippet as H
import qualified Hasql.DynamicStatements.Snippet as SQL
import Data.Tree (Tree (..))
@@ -33,11 +33,11 @@ import PostgREST.Request.Types
import Protolude
readRequestToQuery :: ReadRequest -> H.Snippet
readRequestToQuery :: ReadRequest -> SQL.Snippet
readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
"SELECT " <>
intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <>
"FROM " <> H.sql (BS.intercalate ", " (tabl : implJs)) <> " " <>
"FROM " <> SQL.sql (BS.intercalate ", " (tabl : implJs)) <> " " <>
intercalateSnippet " " joins <> " " <>
(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
(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) =
let subquery = readRequestToQuery rr in
case card of
M2O _ ->
let aliasOrName = fromMaybe name alias
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")
<> " JOIN LATERAL( " <> subquery <> " ) AS " <> H.sql localTableName <> " ON TRUE " in
<> " JOIN LATERAL( " <> subquery <> " ) AS " <> SQL.sql localTableName <> " ON TRUE " in
(joi:joins,sel:selects)
_ -> case joinType of
JTInner ->
@@ -66,29 +66,29 @@ getJoinsSelects rr@(Node (_, (name, Just Relationship{relCardinality=card,relTab
locTblName = table <> "_" <> aliasOrName
localTableName = 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(" <>
"SELECT json_agg(" <> H.sql internalTableName <> ") AS " <> H.sql internalTableName <>
"FROM (" <> subquery <> " ) AS " <> H.sql internalTableName <>
") AS " <> H.sql localTableName <> " ON " <> H.sql localTableName <> "IS NOT NULL" in
"SELECT json_agg(" <> SQL.sql internalTableName <> ") AS " <> SQL.sql internalTableName <>
"FROM (" <> subquery <> " ) AS " <> SQL.sql internalTableName <>
") AS " <> SQL.sql localTableName <> " ON " <> SQL.sql localTableName <> "IS NOT NULL" in
(joi:joins,sel:selects)
JTLeft ->
let sel = "COALESCE (("
<> "SELECT json_agg(" <> H.sql (pgFmtIdent table) <> ".*) "
<> "FROM (" <> subquery <> ") " <> H.sql (pgFmtIdent table) <> " "
<> "), '[]') AS " <> H.sql (pgFmtIdent (fromMaybe name alias)) in
<> "SELECT json_agg(" <> SQL.sql (pgFmtIdent table) <> ".*) "
<> "FROM (" <> subquery <> ") " <> SQL.sql (pgFmtIdent table) <> " "
<> "), '[]') AS " <> SQL.sql (pgFmtIdent (fromMaybe name alias)) in
(joins,sel:selects)
getJoinsSelects _ _ = ([], [])
mutateRequestToQuery :: MutateRequest -> H.Snippet
mutateRequestToQuery :: MutateRequest -> SQL.Snippet
mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) =
"WITH " <> normalizedBody body <> " " <>
"INSERT INTO " <> H.sql (fromQi mainQi) <> H.sql (if S.null iCols then " " else "(" <> cols <> ") ") <>
"SELECT " <> H.sql cols <> " " <>
H.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <>
"INSERT INTO " <> SQL.sql (fromQi mainQi) <> SQL.sql (if S.null iCols then " " else "(" <> cols <> ") ") <>
"SELECT " <> SQL.sql cols <> " " <>
SQL.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <>
-- Only used for PUT
(if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) <>
H.sql (BS.unwords [
SQL.sql (BS.unwords [
maybe "" (\(oncDo, oncCols) ->
if null oncCols then
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
-- 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
then H.sql ("SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false")
then SQL.sql ("SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false")
else
"WITH " <> normalizedBody body <> " " <>
"UPDATE " <> H.sql (fromQi mainQi) <> " SET " <> H.sql cols <> " " <>
"FROM (SELECT * FROM json_populate_recordset (null::" <> H.sql (fromQi mainQi) <> " , " <> H.sql selectBody <> " )) _ " <>
"UPDATE " <> SQL.sql (fromQi mainQi) <> " SET " <> SQL.sql cols <> " " <>
"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)) <> " " <>
H.sql (returningF mainQi returnings)
SQL.sql (returningF mainQi returnings)
where
cols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
emptyBodyReturnedColumns :: SqlFragment
@@ -124,11 +124,11 @@ mutateRequestToQuery (Update mainQi uCols body logicForest returnings) =
| null returnings = "NULL"
| otherwise = BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> 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)) <> " " <>
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) =
prmsCTE <> argsBody
where
@@ -137,12 +137,12 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r
KeyParams [] -> (mempty, mempty)
KeyParams prms -> (
"WITH " <> normalizedBody args <> ", " <>
H.sql (
SQL.sql (
BS.unwords [
"pgrst_args AS (",
"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))
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 a = if ppVar a then "VARIADIC " else mempty
argsBody :: H.Snippet
argsBody :: SQL.Snippet
argsBody
| multipleCall =
if returnsScalar
@@ -166,23 +166,23 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r
then "SELECT " <> callIt <> " AS pgrst_scalar"
else "SELECT " <> returnedColumns <> " FROM " <> callIt
callIt :: H.Snippet
callIt = H.sql (fromQi qi) <> "(" <> argFrag <> ")"
callIt :: SQL.Snippet
callIt = SQL.sql (fromQi qi) <> "(" <> argFrag <> ")"
returnedColumns :: H.Snippet
returnedColumns :: SQL.Snippet
returnedColumns
| 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.
-- 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)
-- inside the FROM target.
readRequestToCountQuery :: ReadRequest -> H.Snippet
readRequestToCountQuery :: ReadRequest -> SQL.Snippet
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)
limitedQuery :: H.Snippet -> Maybe Integer -> H.Snippet
limitedQuery query maxRows = query <> H.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
limitedQuery :: SQL.Snippet -> Maybe Integer -> SQL.Snippet
limitedQuery query maxRows = query <> SQL.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
src/PostgREST/Query/SqlFragment.hs
+36 -36
View File
@@ -37,10 +37,10 @@ module PostgREST.Query.SqlFragment
) where
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.HashMap.Strict as HM
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as M
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 Data.Foldable (foldr1)
@@ -72,8 +72,8 @@ noLocationF = "array[]::text[]"
sourceCTEName :: SqlFragment
sourceCTEName = "pgrst_source"
operators :: HM.HashMap Text SqlFragment
operators = HM.union (HM.fromList [
operators :: M.HashMap Text SqlFragment
operators = M.union (M.fromList [
("eq", "="),
("gte", ">="),
("gt", ">"),
@@ -93,8 +93,8 @@ operators = HM.union (HM.fromList [
("nxl", "&>"),
("adj", "-|-")]) ftsOperators
ftsOperators :: HM.HashMap Text SqlFragment
ftsOperators = HM.fromList [
ftsOperators :: M.HashMap Text SqlFragment
ftsOperators = M.fromList [
("fts", "@@ to_tsquery"),
("plfts", "@@ plainto_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
-- 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
normalizedBody :: Maybe BL.ByteString -> H.Snippet
normalizedBody :: Maybe LBS.ByteString -> SQL.Snippet
normalizedBody body =
"pgrst_payload AS (SELECT " <> jsonPlaceHolder <> " AS json_data), " <>
H.sql (BS.unwords [
SQL.sql (BS.unwords [
"pgrst_body AS (",
"SELECT",
"CASE WHEN json_typeof(json_data) = 'array'",
@@ -118,14 +118,14 @@ normalizedBody body =
"END AS val",
"FROM pgrst_payload)"])
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 =
if typ == "bytea"
-- TODO: Hasql fails when using HE.unknown with bytea(pg tries to utf8 encode).
then H.encoderAndParam (HE.nullable HE.bytea) (toS <$> body)
else H.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::" <> H.sql typ
then SQL.encoderAndParam (HE.nullable HE.bytea) (toS <$> body)
else SQL.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::" <> SQL.sql typ
selectBody :: SqlFragment
selectBody = "(SELECT val FROM pgrst_body)"
@@ -202,24 +202,24 @@ pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
pgFmtColumn table "*" = fromQi table <> ".*"
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
pgFmtField :: QualifiedIdentifier -> Field -> H.Snippet
pgFmtField table (c, jp) = H.sql (pgFmtColumn table c) <> pgFmtJsonPath jp
pgFmtField :: QualifiedIdentifier -> Field -> SQL.Snippet
pgFmtField table (c, jp) = SQL.sql (pgFmtColumn table c) <> pgFmtJsonPath jp
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> H.Snippet
pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> H.sql (pgFmtAs fName jp alias)
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet
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.
-- 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.
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 =
pgFmtField qi (otTerm ot) <> " " <>
H.sql (BS.unwords [
SQL.sql (BS.unwords [
BS.pack $ maybe mempty show $ otDirection 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
Op op val -> pgFmtFieldOp op <> " " <> case op of
"like" -> unknownLiteral (T.map star val)
@@ -239,27 +239,27 @@ pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper
where
ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ")
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
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.
-- 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.
isAllowed :: Text -> H.Snippet
isAllowed v = H.sql $ maybe
isAllowed :: Text -> SQL.Snippet
isAllowed v = SQL.sql $ maybe
(pgFmtLit v <> "::unknown") encodeUtf8
(find ((==) . T.toLower $ v) ["null","true","false"])
pgFmtJoinCondition :: JoinCondition -> H.Snippet
pgFmtJoinCondition :: JoinCondition -> SQL.Snippet
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 qi (Expr hasNot op forest) = H.sql notOp <> " (" <> intercalateSnippet (" " <> BS.pack (show op) <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SQL.Snippet
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
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
pgFmtJsonPath :: JsonPath -> H.Snippet
pgFmtJsonPath :: JsonPath -> SQL.Snippet
pgFmtJsonPath = \case
[] -> mempty
(JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs
@@ -280,7 +280,7 @@ pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of
Nothing -> mempty
pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
countF :: H.Snippet -> Bool -> (H.Snippet, SqlFragment)
countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SqlFragment)
countF countQuery shouldCount =
if shouldCount
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
else "RETURNING " <> BS.intercalate ", " (pgFmtColumn qi <$> returnings)
limitOffsetF :: NonnegRange -> H.Snippet
limitOffsetF :: NonnegRange -> SQL.Snippet
limitOffsetF range =
if range == allRange then mempty else "LIMIT " <> limit <> " OFFSET " <> offset
where
@@ -321,12 +321,12 @@ currentSettingF setting =
"nullif(current_setting(" <> pgFmtLit setting <> ", true), '')"
-- Hasql Snippet utilities
unknownEncoder :: ByteString -> H.Snippet
unknownEncoder = H.encoderAndParam (HE.nonNullable HE.unknown)
unknownEncoder :: ByteString -> SQL.Snippet
unknownEncoder = SQL.encoderAndParam (HE.nonNullable HE.unknown)
unknownLiteral :: Text -> H.Snippet
unknownLiteral :: Text -> SQL.Snippet
unknownLiteral = unknownEncoder . encodeUtf8
intercalateSnippet :: ByteString -> [H.Snippet] -> H.Snippet
intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet
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
src/PostgREST/Query/Statements.hs
+21 -21
View File
@@ -20,9 +20,9 @@ import qualified Data.Aeson as JSON
import qualified Data.Aeson.Lens as L
import qualified Data.ByteString.Char8 as BS
import qualified Hasql.Decoders as HD
import qualified Hasql.DynamicStatements.Snippet as H
import qualified Hasql.DynamicStatements.Statement as H
import qualified Hasql.Statement as H
import qualified Hasql.DynamicStatements.Snippet as SQL
import qualified Hasql.DynamicStatements.Statement as SQL
import qualified Hasql.Statement as SQL
import Control.Lens ((^?))
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))
createWriteStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool ->
createWriteStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool ->
PreferRepresentation -> [Text] -> PgVersion -> Bool ->
H.Statement () ResultsWithCount
SQL.Statement () ResultsWithCount
createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys pgVer =
H.dynamicallyParameterized snippet decodeStandard
SQL.dynamicallyParameterized snippet decodeStandard
where
snippet =
"WITH " <> H.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
H.sql (
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
SQL.sql (
"SELECT " <>
"'' AS total_result_set, " <>
"pg_catalog.count(_postgrest_t) AS page_total, " <>
@@ -82,23 +82,23 @@ createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys
selectF
-- 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
decodeStandard :: HD.Result ResultsWithCount
decodeStandard =
fromMaybe (Nothing, 0, [], mempty, Right [], Right Nothing) <$> HD.rowMaybe standardRow
createReadStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->
H.Statement () ResultsWithCount
createReadStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool ->
SQL.Statement () ResultsWithCount
createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField pgVer =
H.dynamicallyParameterized snippet decodeStandard
SQL.dynamicallyParameterized snippet decodeStandard
where
snippet =
"WITH " <>
H.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <>
SQL.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <>
countCTEF <> " " <>
H.sql ("SELECT " <>
SQL.sql ("SELECT " <>
countResultF <> " AS total_result_set, " <>
"pg_catalog.count(_postgrest_t) AS page_total, " <>
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))
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 ->
H.Statement () ProcResults
SQL.Statement () ProcResults
callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal asSingle asCsv multObjects binaryField pgVer =
H.dynamicallyParameterized snippet decodeProc
SQL.dynamicallyParameterized snippet decodeProc
where
snippet =
"WITH " <> H.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
"WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
countCTEF <>
H.sql (
SQL.sql (
"SELECT " <>
countResultF <> " AS total_result_set, " <>
"pg_catalog.count(_postgrest_t) AS page_total, " <>
@@ -170,9 +170,9 @@ callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQue
<*> (fromMaybe defGucHeaders <$> nullableColumn decodeGucHeaders)
<*> (fromMaybe defGucStatus <$> nullableColumn decodeGucStatus)
createExplainStatement :: H.Snippet -> Bool -> H.Statement () (Maybe Int64)
createExplainStatement :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
createExplainStatement countQuery =
H.dynamicallyParameterized snippet decodeExplain
SQL.dynamicallyParameterized snippet decodeExplain
where
snippet = "EXPLAIN (FORMAT JSON) " <> countQuery
-- |
src/PostgREST/Request/ApiRequest.hs
+7 -7
View File
@@ -19,7 +19,7 @@ module PostgREST.Request.ApiRequest
import qualified Data.Aeson as JSON
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.Csv as CSV
import qualified Data.HashMap.Strict as M
@@ -72,11 +72,11 @@ import Protolude hiding (head, toS)
import Protolude.Conv (toS)
type RequestBody = BL.ByteString
type RequestBody = LBS.ByteString
data 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
-- cache this instead of an Aeson Value because it was detected that for
-- 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
-- be the same across all its objects
}
| RawJSON { payRaw :: BL.ByteString }
| RawPay { payRaw :: BL.ByteString }
| RawJSON { payRaw :: LBS.ByteString }
| RawPay { payRaw :: LBS.ByteString }
data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
-- | 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
then Right $ RawJSON reqBody
else note "All object keys must match" . payloadAttributes reqBody
=<< if BL.null reqBody && isTargetingProc
=<< if LBS.null reqBody && isTargetingProc
then Right emptyObject
else JSON.eitherDecode reqBody
CTTextCSV -> do
@@ -406,7 +406,7 @@ mutuallyAgreeable sProduces cAccepts =
then listToMaybe sProduces
else exact
type CsvData = V.Vector (M.HashMap Text BL.ByteString)
type CsvData = V.Vector (M.HashMap Text LBS.ByteString)
{-|
Converts CSV like
src/PostgREST/Request/Types.hs
+4 -4
View File
@@ -34,7 +34,7 @@ module PostgREST.Request.Types
, fstFieldNames
) where
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Set as S
import Data.Tree (Tree (..))
@@ -110,7 +110,7 @@ data MutateQuery
= Insert
{ in_ :: QualifiedIdentifier
, insCols :: S.Set FieldName
, insBody :: Maybe BL.ByteString
, insBody :: Maybe LBS.ByteString
, onConflict :: Maybe (PreferResolution, [FieldName])
, where_ :: [LogicTree]
, returning :: [FieldName]
@@ -118,7 +118,7 @@ data MutateQuery
| Update
{ in_ :: QualifiedIdentifier
, updCols :: S.Set FieldName
, updBody :: Maybe BL.ByteString
, updBody :: Maybe LBS.ByteString
, where_ :: [LogicTree]
, returning :: [FieldName]
}
@@ -131,7 +131,7 @@ data MutateQuery
data CallQuery = FunctionCall
{ funCQi :: QualifiedIdentifier
, funCParams :: CallParams
, funCArgs :: Maybe BL.ByteString
, funCArgs :: Maybe LBS.ByteString
, funCScalar :: Bool
, funCMultipleCall :: Bool
, funCReturning :: [FieldName]
src/PostgREST/Workers.hs
+13 -13
View File
@@ -9,13 +9,13 @@ module PostgREST.Workers
import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS
import qualified Hasql.Connection as C
import qualified Hasql.Notifications as N
import qualified Hasql.Pool as P
import qualified Hasql.Transaction.Sessions as HT
import qualified Hasql.Notifications as SQL
import qualified Hasql.Pool as SQL
import qualified Hasql.Transaction.Sessions as SQL
import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
retrying, rsPreviousDelay)
import Control.Retry (RetryStatus, capDelay, exponentialBackoff,
retrying, rsPreviousDelay)
import Hasql.Connection (acquire)
import PostgREST.AppState (AppState)
import PostgREST.Config (AppConfig (..), readAppConfig)
@@ -108,7 +108,7 @@ connectionWorker appState = do
connectionStatus :: AppState -> IO ConnectionStatus
connectionStatus appState =
retrying retrySettings shouldRetry $
const $ P.release pool >> getConnectionStatus
const $ SQL.release pool >> getConnectionStatus
where
pool = AppState.getPool appState
retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds
@@ -117,7 +117,7 @@ connectionStatus appState =
getConnectionStatus :: IO ConnectionStatus
getConnectionStatus = do
pgVersion <- P.use pool queryPgVersion
pgVersion <- SQL.use pool queryPgVersion
case pgVersion of
Left e -> do
let err = PgError False e
@@ -152,8 +152,8 @@ loadSchemaCache :: AppState -> IO SCacheStatus
loadSchemaCache appState = do
AppConfig{..} <- AppState.getConfig appState
result <-
let transaction = if configDbPreparedStatements then HT.transaction else HT.unpreparedTransaction in
P.use (AppState.getPool appState) . transaction HT.ReadCommitted HT.Read $
let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
SQL.use (AppState.getPool appState) . transaction SQL.ReadCommitted SQL.Read $
queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
case result of
Left e -> do
@@ -194,12 +194,12 @@ listener appState = do
-- forkFinally allows to detect if the thread dies
void . flip forkFinally (handleFinally dbChannel) $ do
dbOrError <- C.acquire $ toS configDbUri
dbOrError <- acquire $ toS configDbUri
case dbOrError of
Right db -> do
AppState.logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel"
N.listen db $ N.toPgIdentifier dbChannel
N.waitForNotifications handleNotification db
SQL.listen db $ SQL.toPgIdentifier dbChannel
SQL.waitForNotifications handleNotification db
_ ->
die $ "Could not listen for notifications on the " <> dbChannel <> " channel"
where